From 578ed1ba98510058cf48f897a9bf4e3391684120 Mon Sep 17 00:00:00 2001 From: William Carroll Date: Thu, 30 Jan 2020 16:00:29 +0000 Subject: Move move .emacs.d out of configs/shared Moving all of my Emacs-related files into their own directory at the root of this repository. --- configs/shared/.emacs.d/init.el | 59 - configs/shared/.emacs.d/opam-user-setup.el | 145 - .../shared/.emacs.d/snippets/c-mode/.yas-parents | 1 - configs/shared/.emacs.d/snippets/c-mode/stdio | 5 - configs/shared/.emacs.d/snippets/c-mode/stdlib | 5 - configs/shared/.emacs.d/snippets/c-mode/struct | 7 - .../.emacs.d/snippets/emacs-lisp-mode/.yas-parents | 1 - .../snippets/emacs-lisp-mode/elisp-module-docs | 11 - .../.emacs.d/snippets/emacs-lisp-mode/function | 8 - .../snippets/emacs-lisp-mode/generic-header | 7 - .../snippets/emacs-lisp-mode/library-header | 7 - .../snippets/emacs-lisp-mode/provide-footer | 6 - .../.emacs.d/snippets/haskell-mode/.yas-parents | 1 - .../snippets/haskell-mode/derive-safe-copy | 5 - .../snippets/haskell-mode/import-qualified | 5 - .../.emacs.d/snippets/haskell-mode/instance-defn | 6 - .../snippets/haskell-mode/language-extension | 5 - .../.emacs.d/snippets/haskell-mode/separator | 5 - .../.emacs.d/snippets/haskell-mode/undefined | 5 - .../.emacs.d/snippets/html-mode/.yas-parents | 1 - .../.emacs.d/snippets/html-mode/index-boilerplate | 18 - .../.emacs.d/snippets/java-mode/.yas-parents | 1 - .../snippets/java-mode/public-static-void-main | 7 - .../.emacs.d/snippets/lisp-mode/.yas-parents | 1 - .../shared/.emacs.d/snippets/lisp-mode/defpackage | 9 - .../shared/.emacs.d/snippets/lisp-mode/function | 7 - .../.emacs.d/snippets/lisp-mode/typed-function | 8 - .../shared/.emacs.d/snippets/nix-mode/.yas-parents | 1 - .../shared/.emacs.d/snippets/nix-mode/shell-nix | 12 - .../shared/.emacs.d/snippets/org-mode/.yas-parents | 1 - .../shared/.emacs.d/snippets/org-mode/code-snippet | 7 - configs/shared/.emacs.d/snippets/org-mode/href | 5 - .../.emacs.d/snippets/python-mode/.yas-parents | 1 - .../.emacs.d/snippets/python-mode/dunder-main | 6 - .../shared/.emacs.d/snippets/python-mode/function | 6 - .../shared/.emacs.d/snippets/python-mode/header | 7 - configs/shared/.emacs.d/snippets/python-mode/init | 6 - .../shared/.emacs.d/snippets/python-mode/shebang | 6 - configs/shared/.emacs.d/snippets/python-mode/utf-8 | 5 - .../.emacs.d/snippets/racket-mode/.yas-parents | 1 - .../shared/.emacs.d/snippets/racket-mode/function | 5 - .../shared/.emacs.d/snippets/racket-mode/lambda | 5 - .../.emacs.d/snippets/racket-mode/lambda-symbol | 5 - .../.emacs.d/snippets/reason-mode/.yas-parents | 1 - .../shared/.emacs.d/snippets/reason-mode/function | 7 - .../shared/.emacs.d/snippets/reason-mode/switch | 7 - .../.emacs.d/snippets/rjsx-mode/.yas-parents | 1 - .../.emacs.d/snippets/rjsx-mode/action-extractor | 5 - .../shared/.emacs.d/snippets/rjsx-mode/console-log | 5 - .../shared/.emacs.d/snippets/rjsx-mode/const-defn | 5 - .../.emacs.d/snippets/rjsx-mode/const-function | 7 - .../.emacs.d/snippets/rjsx-mode/destructure-const | 5 - .../shared/.emacs.d/snippets/rjsx-mode/fat-arrow | 5 - .../.emacs.d/snippets/rjsx-mode/fat-arrow-function | 7 - .../snippets/rjsx-mode/import-destructured | 5 - .../.emacs.d/snippets/rjsx-mode/import-react | 5 - .../shared/.emacs.d/snippets/rjsx-mode/import-type | 5 - .../.emacs.d/snippets/rjsx-mode/import-x-from-y | 5 - .../shared/.emacs.d/snippets/rjsx-mode/import-y | 5 - .../.emacs.d/snippets/rjsx-mode/jest-describe-test | 10 - .../shared/.emacs.d/snippets/rjsx-mode/jest-test | 7 - .../snippets/rjsx-mode/react-class-component | 11 - .../.emacs.d/snippets/rjsx-mode/redux-action | 5 - .../.emacs.d/snippets/rjsx-mode/typed-redux-action | 5 - .../.emacs.d/snippets/rust-mode/.yas-parents | 1 - .../shared/.emacs.d/snippets/rust-mode/for-loop | 7 - configs/shared/.emacs.d/snippets/rust-mode/match | 7 - .../shared/.emacs.d/snippets/sh-mode/.yas-parents | 1 - configs/shared/.emacs.d/snippets/sh-mode/function | 7 - .../.emacs.d/snippets/text-mode/.yas-parents | 1 - .../shared/.emacs.d/snippets/text-mode/check-mark | 5 - configs/shared/.emacs.d/snippets/text-mode/x-mark | 5 - .../shared/.emacs.d/snippets/web-mode/.yas-parents | 1 - configs/shared/.emacs.d/snippets/web-mode/header | 7 - .../.emacs.d/snippets/web-mode/index-boilerplate | 18 - configs/shared/.emacs.d/tramp | 27 - configs/shared/.emacs.d/vendor/dired+.el | 13696 ------------------- configs/shared/.emacs.d/vendor/org-clubhouse.el | 365 - configs/shared/.emacs.d/vendor/reason-indent.el | 304 - .../shared/.emacs.d/vendor/reason-interaction.el | 216 - configs/shared/.emacs.d/vendor/reason-mode.el | 242 - configs/shared/.emacs.d/vendor/refmt.el | 231 - configs/shared/.emacs.d/vendor/slack-snippets.el | 228 - configs/shared/.emacs.d/vendor/wpgtk-theme.el | 536 - configs/shared/.emacs.d/wpc/alist.el | 277 - configs/shared/.emacs.d/wpc/bag.el | 66 - configs/shared/.emacs.d/wpc/bills.el | 26 - configs/shared/.emacs.d/wpc/bookmark.el | 145 - configs/shared/.emacs.d/wpc/buffer.el | 198 - configs/shared/.emacs.d/wpc/bytes.el | 109 - configs/shared/.emacs.d/wpc/cache.el | 80 - configs/shared/.emacs.d/wpc/chrome.el | 82 - configs/shared/.emacs.d/wpc/clipboard.el | 44 - configs/shared/.emacs.d/wpc/colorscheme.el | 96 - configs/shared/.emacs.d/wpc/constants.el | 41 - configs/shared/.emacs.d/wpc/cycle.el | 155 - configs/shared/.emacs.d/wpc/device.el | 38 - configs/shared/.emacs.d/wpc/display.el | 98 - configs/shared/.emacs.d/wpc/do.el | 54 - configs/shared/.emacs.d/wpc/dotfiles.el | 53 - configs/shared/.emacs.d/wpc/dotted.el | 49 - configs/shared/.emacs.d/wpc/email.el | 11 - configs/shared/.emacs.d/wpc/entr.el | 115 - configs/shared/.emacs.d/wpc/enum.el | 98 - configs/shared/.emacs.d/wpc/finance.el | 119 - configs/shared/.emacs.d/wpc/fonts.el | 153 - configs/shared/.emacs.d/wpc/fs.el | 65 - configs/shared/.emacs.d/wpc/functions.el | 133 - configs/shared/.emacs.d/wpc/google-stuff.el | 215 - configs/shared/.emacs.d/wpc/graph.el | 91 - configs/shared/.emacs.d/wpc/imdb.el | 128 - configs/shared/.emacs.d/wpc/irc.el | 177 - configs/shared/.emacs.d/wpc/iso.el | 95 - configs/shared/.emacs.d/wpc/ivy-clipmenu.el | 134 - configs/shared/.emacs.d/wpc/ivy-helpers.el | 31 - configs/shared/.emacs.d/wpc/kaomoji.el | 45 - configs/shared/.emacs.d/wpc/kbd.el | 90 - configs/shared/.emacs.d/wpc/keybindings.el | 46 - configs/shared/.emacs.d/wpc/keyboard.el | 152 - configs/shared/.emacs.d/wpc/keymap.el | 25 - configs/shared/.emacs.d/wpc/laptop-battery.el | 60 - configs/shared/.emacs.d/wpc/list.el | 235 - configs/shared/.emacs.d/wpc/list.nix | 8 - configs/shared/.emacs.d/wpc/macros.el | 95 - configs/shared/.emacs.d/wpc/math.el | 59 - configs/shared/.emacs.d/wpc/maybe.el | 102 - configs/shared/.emacs.d/wpc/me-seconds.el | 245 - configs/shared/.emacs.d/wpc/monoid.el | 30 - configs/shared/.emacs.d/wpc/number.el | 153 - configs/shared/.emacs.d/wpc/org-helpers.el | 29 - .../shared/.emacs.d/wpc/packages/wpc-clojure.el | 85 - .../shared/.emacs.d/wpc/packages/wpc-company.el | 28 - configs/shared/.emacs.d/wpc/packages/wpc-dired.el | 41 - configs/shared/.emacs.d/wpc/packages/wpc-docker.el | 16 - configs/shared/.emacs.d/wpc/packages/wpc-elixir.el | 13 - .../shared/.emacs.d/wpc/packages/wpc-flycheck.el | 14 - .../shared/.emacs.d/wpc/packages/wpc-haskell.el | 56 - configs/shared/.emacs.d/wpc/packages/wpc-java.el | 42 - .../shared/.emacs.d/wpc/packages/wpc-javascript.el | 83 - .../.emacs.d/wpc/packages/wpc-keybindings.el | 229 - configs/shared/.emacs.d/wpc/packages/wpc-lisp.el | 111 - configs/shared/.emacs.d/wpc/packages/wpc-misc.el | 248 - configs/shared/.emacs.d/wpc/packages/wpc-nix.el | 56 - configs/shared/.emacs.d/wpc/packages/wpc-ocaml.el | 43 - configs/shared/.emacs.d/wpc/packages/wpc-org.el | 70 - .../shared/.emacs.d/wpc/packages/wpc-package.el | 27 - configs/shared/.emacs.d/wpc/packages/wpc-prolog.el | 16 - configs/shared/.emacs.d/wpc/packages/wpc-python.el | 21 - .../shared/.emacs.d/wpc/packages/wpc-reasonml.el | 29 - configs/shared/.emacs.d/wpc/packages/wpc-rust.el | 34 - configs/shared/.emacs.d/wpc/packages/wpc-shell.el | 17 - .../shared/.emacs.d/wpc/packages/wpc-terminal.el | 70 - configs/shared/.emacs.d/wpc/packages/wpc-ui.el | 179 - configs/shared/.emacs.d/wpc/playback.el | 41 - configs/shared/.emacs.d/wpc/polymorphism.el | 37 - configs/shared/.emacs.d/wpc/prelude.el | 149 - configs/shared/.emacs.d/wpc/prelude.nix | 11 - configs/shared/.emacs.d/wpc/pulse-audio.el | 66 - configs/shared/.emacs.d/wpc/pushover.el | 75 - configs/shared/.emacs.d/wpc/random.el | 73 - configs/shared/.emacs.d/wpc/region.el | 20 - configs/shared/.emacs.d/wpc/scheduler.el | 22 - configs/shared/.emacs.d/wpc/scope.el | 99 - configs/shared/.emacs.d/wpc/screen-brightness.el | 45 - configs/shared/.emacs.d/wpc/scrot.el | 64 - configs/shared/.emacs.d/wpc/sequence.el | 105 - configs/shared/.emacs.d/wpc/series.el | 89 - configs/shared/.emacs.d/wpc/set.el | 171 - configs/shared/.emacs.d/wpc/sre.el | 26 - configs/shared/.emacs.d/wpc/ssh.el | 31 - configs/shared/.emacs.d/wpc/stack.el | 93 - configs/shared/.emacs.d/wpc/string.el | 128 - configs/shared/.emacs.d/wpc/string.nix | 8 - configs/shared/.emacs.d/wpc/struct.el | 88 - configs/shared/.emacs.d/wpc/symbol.el | 43 - configs/shared/.emacs.d/wpc/terminator-themes.json | 1794 --- configs/shared/.emacs.d/wpc/terminator.el | 94 - configs/shared/.emacs.d/wpc/themes.el | 204 - configs/shared/.emacs.d/wpc/todo.el | 293 - configs/shared/.emacs.d/wpc/tree.el | 193 - configs/shared/.emacs.d/wpc/tuple.el | 86 - configs/shared/.emacs.d/wpc/vector.el | 81 - configs/shared/.emacs.d/wpc/wallpaper.el | 92 - configs/shared/.emacs.d/wpc/window-manager.el | 647 - configs/shared/.emacs.d/wpc/window.el | 37 - configs/shared/.emacs.d/wpc/wpgtk.el | 45 - configs/shared/.emacs.d/wpc/ynab.el | 56 - configs/shared/.emacs.d/wpc/zle.el | 90 - emacs.nix | 140 - emacs/.emacs.d/init.el | 61 + emacs/.emacs.d/opam-user-setup.el | 145 + emacs/.emacs.d/snippets/c-mode/.yas-parents | 1 + emacs/.emacs.d/snippets/c-mode/stdio | 5 + emacs/.emacs.d/snippets/c-mode/stdlib | 5 + emacs/.emacs.d/snippets/c-mode/struct | 7 + .../.emacs.d/snippets/emacs-lisp-mode/.yas-parents | 1 + .../snippets/emacs-lisp-mode/elisp-module-docs | 11 + emacs/.emacs.d/snippets/emacs-lisp-mode/function | 8 + .../snippets/emacs-lisp-mode/generic-header | 7 + .../snippets/emacs-lisp-mode/library-header | 7 + .../snippets/emacs-lisp-mode/provide-footer | 6 + emacs/.emacs.d/snippets/haskell-mode/.yas-parents | 1 + .../snippets/haskell-mode/derive-safe-copy | 5 + .../snippets/haskell-mode/import-qualified | 5 + emacs/.emacs.d/snippets/haskell-mode/instance-defn | 6 + .../snippets/haskell-mode/language-extension | 5 + emacs/.emacs.d/snippets/haskell-mode/separator | 5 + emacs/.emacs.d/snippets/haskell-mode/undefined | 5 + emacs/.emacs.d/snippets/html-mode/.yas-parents | 1 + .../.emacs.d/snippets/html-mode/index-boilerplate | 18 + emacs/.emacs.d/snippets/java-mode/.yas-parents | 1 + .../snippets/java-mode/public-static-void-main | 7 + emacs/.emacs.d/snippets/lisp-mode/.yas-parents | 1 + emacs/.emacs.d/snippets/lisp-mode/defpackage | 9 + emacs/.emacs.d/snippets/lisp-mode/function | 7 + emacs/.emacs.d/snippets/lisp-mode/typed-function | 8 + emacs/.emacs.d/snippets/nix-mode/.yas-parents | 1 + emacs/.emacs.d/snippets/nix-mode/shell-nix | 12 + emacs/.emacs.d/snippets/org-mode/.yas-parents | 1 + emacs/.emacs.d/snippets/org-mode/code-snippet | 7 + emacs/.emacs.d/snippets/org-mode/href | 5 + emacs/.emacs.d/snippets/python-mode/.yas-parents | 1 + emacs/.emacs.d/snippets/python-mode/dunder-main | 6 + emacs/.emacs.d/snippets/python-mode/function | 6 + emacs/.emacs.d/snippets/python-mode/header | 7 + emacs/.emacs.d/snippets/python-mode/init | 6 + emacs/.emacs.d/snippets/python-mode/shebang | 6 + emacs/.emacs.d/snippets/python-mode/utf-8 | 5 + emacs/.emacs.d/snippets/racket-mode/.yas-parents | 1 + emacs/.emacs.d/snippets/racket-mode/function | 5 + emacs/.emacs.d/snippets/racket-mode/lambda | 5 + emacs/.emacs.d/snippets/racket-mode/lambda-symbol | 5 + emacs/.emacs.d/snippets/reason-mode/.yas-parents | 1 + emacs/.emacs.d/snippets/reason-mode/function | 7 + emacs/.emacs.d/snippets/reason-mode/switch | 7 + emacs/.emacs.d/snippets/rjsx-mode/.yas-parents | 1 + emacs/.emacs.d/snippets/rjsx-mode/action-extractor | 5 + emacs/.emacs.d/snippets/rjsx-mode/console-log | 5 + emacs/.emacs.d/snippets/rjsx-mode/const-defn | 5 + emacs/.emacs.d/snippets/rjsx-mode/const-function | 7 + .../.emacs.d/snippets/rjsx-mode/destructure-const | 5 + emacs/.emacs.d/snippets/rjsx-mode/fat-arrow | 5 + .../.emacs.d/snippets/rjsx-mode/fat-arrow-function | 7 + .../snippets/rjsx-mode/import-destructured | 5 + emacs/.emacs.d/snippets/rjsx-mode/import-react | 5 + emacs/.emacs.d/snippets/rjsx-mode/import-type | 5 + emacs/.emacs.d/snippets/rjsx-mode/import-x-from-y | 5 + emacs/.emacs.d/snippets/rjsx-mode/import-y | 5 + .../.emacs.d/snippets/rjsx-mode/jest-describe-test | 10 + emacs/.emacs.d/snippets/rjsx-mode/jest-test | 7 + .../snippets/rjsx-mode/react-class-component | 11 + emacs/.emacs.d/snippets/rjsx-mode/redux-action | 5 + .../.emacs.d/snippets/rjsx-mode/typed-redux-action | 5 + emacs/.emacs.d/snippets/rust-mode/.yas-parents | 1 + emacs/.emacs.d/snippets/rust-mode/for-loop | 7 + emacs/.emacs.d/snippets/rust-mode/match | 7 + emacs/.emacs.d/snippets/sh-mode/.yas-parents | 1 + emacs/.emacs.d/snippets/sh-mode/function | 7 + emacs/.emacs.d/snippets/text-mode/.yas-parents | 1 + emacs/.emacs.d/snippets/text-mode/check-mark | 5 + emacs/.emacs.d/snippets/text-mode/x-mark | 5 + emacs/.emacs.d/snippets/web-mode/.yas-parents | 1 + emacs/.emacs.d/snippets/web-mode/header | 7 + emacs/.emacs.d/snippets/web-mode/index-boilerplate | 18 + emacs/.emacs.d/vendor/dired+.el | 13696 +++++++++++++++++++ emacs/.emacs.d/vendor/org-clubhouse.el | 365 + emacs/.emacs.d/vendor/reason-indent.el | 304 + emacs/.emacs.d/vendor/reason-interaction.el | 216 + emacs/.emacs.d/vendor/reason-mode.el | 242 + emacs/.emacs.d/vendor/refmt.el | 231 + emacs/.emacs.d/vendor/slack-snippets.el | 228 + emacs/.emacs.d/vendor/wpgtk-theme.el | 536 + emacs/.emacs.d/wpc/alist.el | 277 + emacs/.emacs.d/wpc/bag.el | 66 + emacs/.emacs.d/wpc/bills.el | 26 + emacs/.emacs.d/wpc/bookmark.el | 145 + emacs/.emacs.d/wpc/buffer.el | 198 + emacs/.emacs.d/wpc/bytes.el | 109 + emacs/.emacs.d/wpc/cache.el | 80 + emacs/.emacs.d/wpc/chrome.el | 82 + emacs/.emacs.d/wpc/clipboard.el | 44 + emacs/.emacs.d/wpc/colorscheme.el | 96 + emacs/.emacs.d/wpc/constants.el | 41 + emacs/.emacs.d/wpc/cycle.el | 155 + emacs/.emacs.d/wpc/device.el | 38 + emacs/.emacs.d/wpc/display.el | 98 + emacs/.emacs.d/wpc/do.el | 54 + emacs/.emacs.d/wpc/dotfiles.el | 53 + emacs/.emacs.d/wpc/dotted.el | 49 + emacs/.emacs.d/wpc/email.el | 11 + emacs/.emacs.d/wpc/entr.el | 115 + emacs/.emacs.d/wpc/enum.el | 98 + emacs/.emacs.d/wpc/finance.el | 119 + emacs/.emacs.d/wpc/fonts.el | 153 + emacs/.emacs.d/wpc/fs.el | 65 + emacs/.emacs.d/wpc/functions.el | 133 + emacs/.emacs.d/wpc/graph.el | 91 + emacs/.emacs.d/wpc/imdb.el | 128 + emacs/.emacs.d/wpc/irc.el | 177 + emacs/.emacs.d/wpc/iso.el | 95 + emacs/.emacs.d/wpc/ivy-clipmenu.el | 134 + emacs/.emacs.d/wpc/ivy-helpers.el | 31 + emacs/.emacs.d/wpc/kaomoji.el | 45 + emacs/.emacs.d/wpc/kbd.el | 90 + emacs/.emacs.d/wpc/keybindings.el | 46 + emacs/.emacs.d/wpc/keyboard.el | 152 + emacs/.emacs.d/wpc/keymap.el | 25 + emacs/.emacs.d/wpc/laptop-battery.el | 60 + emacs/.emacs.d/wpc/list.el | 235 + emacs/.emacs.d/wpc/list.nix | 8 + emacs/.emacs.d/wpc/macros.el | 95 + emacs/.emacs.d/wpc/math.el | 59 + emacs/.emacs.d/wpc/maybe.el | 102 + emacs/.emacs.d/wpc/me-seconds.el | 245 + emacs/.emacs.d/wpc/monoid.el | 30 + emacs/.emacs.d/wpc/number.el | 153 + emacs/.emacs.d/wpc/org-helpers.el | 29 + emacs/.emacs.d/wpc/playback.el | 41 + emacs/.emacs.d/wpc/polymorphism.el | 37 + emacs/.emacs.d/wpc/prelude.el | 149 + emacs/.emacs.d/wpc/prelude.nix | 11 + emacs/.emacs.d/wpc/pulse-audio.el | 66 + emacs/.emacs.d/wpc/pushover.el | 75 + emacs/.emacs.d/wpc/random.el | 73 + emacs/.emacs.d/wpc/region.el | 20 + emacs/.emacs.d/wpc/scheduler.el | 22 + emacs/.emacs.d/wpc/scope.el | 99 + emacs/.emacs.d/wpc/screen-brightness.el | 45 + emacs/.emacs.d/wpc/scrot.el | 64 + emacs/.emacs.d/wpc/sequence.el | 105 + emacs/.emacs.d/wpc/series.el | 89 + emacs/.emacs.d/wpc/set.el | 171 + emacs/.emacs.d/wpc/ssh.el | 31 + emacs/.emacs.d/wpc/stack.el | 93 + emacs/.emacs.d/wpc/string.el | 128 + emacs/.emacs.d/wpc/string.nix | 8 + emacs/.emacs.d/wpc/struct.el | 88 + emacs/.emacs.d/wpc/symbol.el | 43 + emacs/.emacs.d/wpc/terminator-themes.json | 1794 +++ emacs/.emacs.d/wpc/terminator.el | 94 + emacs/.emacs.d/wpc/themes.el | 204 + emacs/.emacs.d/wpc/todo.el | 293 + emacs/.emacs.d/wpc/tree.el | 193 + emacs/.emacs.d/wpc/tuple.el | 86 + emacs/.emacs.d/wpc/vector.el | 81 + emacs/.emacs.d/wpc/wallpaper.el | 92 + emacs/.emacs.d/wpc/window-manager.el | 647 + emacs/.emacs.d/wpc/window.el | 37 + emacs/.emacs.d/wpc/wpc-clojure.el | 85 + emacs/.emacs.d/wpc/wpc-company.el | 28 + emacs/.emacs.d/wpc/wpc-dired.el | 41 + emacs/.emacs.d/wpc/wpc-docker.el | 16 + emacs/.emacs.d/wpc/wpc-elixir.el | 13 + emacs/.emacs.d/wpc/wpc-flycheck.el | 14 + emacs/.emacs.d/wpc/wpc-haskell.el | 56 + emacs/.emacs.d/wpc/wpc-java.el | 42 + emacs/.emacs.d/wpc/wpc-javascript.el | 83 + emacs/.emacs.d/wpc/wpc-keybindings.el | 229 + emacs/.emacs.d/wpc/wpc-lisp.el | 111 + emacs/.emacs.d/wpc/wpc-misc.el | 248 + emacs/.emacs.d/wpc/wpc-nix.el | 56 + emacs/.emacs.d/wpc/wpc-ocaml.el | 43 + emacs/.emacs.d/wpc/wpc-org.el | 70 + emacs/.emacs.d/wpc/wpc-package.el | 27 + emacs/.emacs.d/wpc/wpc-prolog.el | 16 + emacs/.emacs.d/wpc/wpc-python.el | 21 + emacs/.emacs.d/wpc/wpc-reasonml.el | 29 + emacs/.emacs.d/wpc/wpc-rust.el | 34 + emacs/.emacs.d/wpc/wpc-shell.el | 17 + emacs/.emacs.d/wpc/wpc-terminal.el | 70 + emacs/.emacs.d/wpc/wpc-ui.el | 179 + emacs/.emacs.d/wpc/wpgtk.el | 45 + emacs/.emacs.d/wpc/ynab.el | 56 + emacs/.emacs.d/wpc/zle.el | 90 + emacs/default.nix | 140 + utils.nix | 5 + 376 files changed, 27601 insertions(+), 27862 deletions(-) delete mode 100644 configs/shared/.emacs.d/init.el delete mode 100644 configs/shared/.emacs.d/opam-user-setup.el delete mode 100644 configs/shared/.emacs.d/snippets/c-mode/.yas-parents delete mode 100644 configs/shared/.emacs.d/snippets/c-mode/stdio delete mode 100644 configs/shared/.emacs.d/snippets/c-mode/stdlib delete mode 100644 configs/shared/.emacs.d/snippets/c-mode/struct delete mode 100644 configs/shared/.emacs.d/snippets/emacs-lisp-mode/.yas-parents delete mode 100644 configs/shared/.emacs.d/snippets/emacs-lisp-mode/elisp-module-docs delete mode 100644 configs/shared/.emacs.d/snippets/emacs-lisp-mode/function delete mode 100644 configs/shared/.emacs.d/snippets/emacs-lisp-mode/generic-header delete mode 100644 configs/shared/.emacs.d/snippets/emacs-lisp-mode/library-header delete mode 100644 configs/shared/.emacs.d/snippets/emacs-lisp-mode/provide-footer delete mode 100644 configs/shared/.emacs.d/snippets/haskell-mode/.yas-parents delete mode 100644 configs/shared/.emacs.d/snippets/haskell-mode/derive-safe-copy delete mode 100644 configs/shared/.emacs.d/snippets/haskell-mode/import-qualified delete mode 100644 configs/shared/.emacs.d/snippets/haskell-mode/instance-defn delete mode 100644 configs/shared/.emacs.d/snippets/haskell-mode/language-extension delete mode 100644 configs/shared/.emacs.d/snippets/haskell-mode/separator delete mode 100644 configs/shared/.emacs.d/snippets/haskell-mode/undefined delete mode 100644 configs/shared/.emacs.d/snippets/html-mode/.yas-parents delete mode 100644 configs/shared/.emacs.d/snippets/html-mode/index-boilerplate delete mode 100644 configs/shared/.emacs.d/snippets/java-mode/.yas-parents delete mode 100644 configs/shared/.emacs.d/snippets/java-mode/public-static-void-main delete mode 100644 configs/shared/.emacs.d/snippets/lisp-mode/.yas-parents delete mode 100644 configs/shared/.emacs.d/snippets/lisp-mode/defpackage delete mode 100644 configs/shared/.emacs.d/snippets/lisp-mode/function delete mode 100644 configs/shared/.emacs.d/snippets/lisp-mode/typed-function delete mode 100644 configs/shared/.emacs.d/snippets/nix-mode/.yas-parents delete mode 100644 configs/shared/.emacs.d/snippets/nix-mode/shell-nix delete mode 100644 configs/shared/.emacs.d/snippets/org-mode/.yas-parents delete mode 100644 configs/shared/.emacs.d/snippets/org-mode/code-snippet delete mode 100644 configs/shared/.emacs.d/snippets/org-mode/href delete mode 100644 configs/shared/.emacs.d/snippets/python-mode/.yas-parents delete mode 100644 configs/shared/.emacs.d/snippets/python-mode/dunder-main delete mode 100644 configs/shared/.emacs.d/snippets/python-mode/function delete mode 100644 configs/shared/.emacs.d/snippets/python-mode/header delete mode 100644 configs/shared/.emacs.d/snippets/python-mode/init delete mode 100644 configs/shared/.emacs.d/snippets/python-mode/shebang delete mode 100644 configs/shared/.emacs.d/snippets/python-mode/utf-8 delete mode 100644 configs/shared/.emacs.d/snippets/racket-mode/.yas-parents delete mode 100644 configs/shared/.emacs.d/snippets/racket-mode/function delete mode 100644 configs/shared/.emacs.d/snippets/racket-mode/lambda delete mode 100644 configs/shared/.emacs.d/snippets/racket-mode/lambda-symbol delete mode 100644 configs/shared/.emacs.d/snippets/reason-mode/.yas-parents delete mode 100644 configs/shared/.emacs.d/snippets/reason-mode/function delete mode 100644 configs/shared/.emacs.d/snippets/reason-mode/switch delete mode 100644 configs/shared/.emacs.d/snippets/rjsx-mode/.yas-parents delete mode 100644 configs/shared/.emacs.d/snippets/rjsx-mode/action-extractor delete mode 100644 configs/shared/.emacs.d/snippets/rjsx-mode/console-log delete mode 100644 configs/shared/.emacs.d/snippets/rjsx-mode/const-defn delete mode 100644 configs/shared/.emacs.d/snippets/rjsx-mode/const-function delete mode 100644 configs/shared/.emacs.d/snippets/rjsx-mode/destructure-const delete mode 100644 configs/shared/.emacs.d/snippets/rjsx-mode/fat-arrow delete mode 100644 configs/shared/.emacs.d/snippets/rjsx-mode/fat-arrow-function delete mode 100644 configs/shared/.emacs.d/snippets/rjsx-mode/import-destructured delete mode 100644 configs/shared/.emacs.d/snippets/rjsx-mode/import-react delete mode 100644 configs/shared/.emacs.d/snippets/rjsx-mode/import-type delete mode 100644 configs/shared/.emacs.d/snippets/rjsx-mode/import-x-from-y delete mode 100644 configs/shared/.emacs.d/snippets/rjsx-mode/import-y delete mode 100644 configs/shared/.emacs.d/snippets/rjsx-mode/jest-describe-test delete mode 100644 configs/shared/.emacs.d/snippets/rjsx-mode/jest-test delete mode 100644 configs/shared/.emacs.d/snippets/rjsx-mode/react-class-component delete mode 100644 configs/shared/.emacs.d/snippets/rjsx-mode/redux-action delete mode 100644 configs/shared/.emacs.d/snippets/rjsx-mode/typed-redux-action delete mode 100644 configs/shared/.emacs.d/snippets/rust-mode/.yas-parents delete mode 100644 configs/shared/.emacs.d/snippets/rust-mode/for-loop delete mode 100644 configs/shared/.emacs.d/snippets/rust-mode/match delete mode 100644 configs/shared/.emacs.d/snippets/sh-mode/.yas-parents delete mode 100644 configs/shared/.emacs.d/snippets/sh-mode/function delete mode 100644 configs/shared/.emacs.d/snippets/text-mode/.yas-parents delete mode 100644 configs/shared/.emacs.d/snippets/text-mode/check-mark delete mode 100644 configs/shared/.emacs.d/snippets/text-mode/x-mark delete mode 100644 configs/shared/.emacs.d/snippets/web-mode/.yas-parents delete mode 100644 configs/shared/.emacs.d/snippets/web-mode/header delete mode 100644 configs/shared/.emacs.d/snippets/web-mode/index-boilerplate delete mode 100644 configs/shared/.emacs.d/tramp delete mode 100644 configs/shared/.emacs.d/vendor/dired+.el delete mode 100644 configs/shared/.emacs.d/vendor/org-clubhouse.el delete mode 100644 configs/shared/.emacs.d/vendor/reason-indent.el delete mode 100644 configs/shared/.emacs.d/vendor/reason-interaction.el delete mode 100644 configs/shared/.emacs.d/vendor/reason-mode.el delete mode 100644 configs/shared/.emacs.d/vendor/refmt.el delete mode 100644 configs/shared/.emacs.d/vendor/slack-snippets.el delete mode 100644 configs/shared/.emacs.d/vendor/wpgtk-theme.el delete mode 100644 configs/shared/.emacs.d/wpc/alist.el delete mode 100644 configs/shared/.emacs.d/wpc/bag.el delete mode 100644 configs/shared/.emacs.d/wpc/bills.el delete mode 100644 configs/shared/.emacs.d/wpc/bookmark.el delete mode 100644 configs/shared/.emacs.d/wpc/buffer.el delete mode 100644 configs/shared/.emacs.d/wpc/bytes.el delete mode 100644 configs/shared/.emacs.d/wpc/cache.el delete mode 100644 configs/shared/.emacs.d/wpc/chrome.el delete mode 100644 configs/shared/.emacs.d/wpc/clipboard.el delete mode 100644 configs/shared/.emacs.d/wpc/colorscheme.el delete mode 100644 configs/shared/.emacs.d/wpc/constants.el delete mode 100644 configs/shared/.emacs.d/wpc/cycle.el delete mode 100644 configs/shared/.emacs.d/wpc/device.el delete mode 100644 configs/shared/.emacs.d/wpc/display.el delete mode 100644 configs/shared/.emacs.d/wpc/do.el delete mode 100644 configs/shared/.emacs.d/wpc/dotfiles.el delete mode 100644 configs/shared/.emacs.d/wpc/dotted.el delete mode 100644 configs/shared/.emacs.d/wpc/email.el delete mode 100644 configs/shared/.emacs.d/wpc/entr.el delete mode 100644 configs/shared/.emacs.d/wpc/enum.el delete mode 100644 configs/shared/.emacs.d/wpc/finance.el delete mode 100644 configs/shared/.emacs.d/wpc/fonts.el delete mode 100644 configs/shared/.emacs.d/wpc/fs.el delete mode 100644 configs/shared/.emacs.d/wpc/functions.el delete mode 100644 configs/shared/.emacs.d/wpc/google-stuff.el delete mode 100644 configs/shared/.emacs.d/wpc/graph.el delete mode 100644 configs/shared/.emacs.d/wpc/imdb.el delete mode 100644 configs/shared/.emacs.d/wpc/irc.el delete mode 100644 configs/shared/.emacs.d/wpc/iso.el delete mode 100644 configs/shared/.emacs.d/wpc/ivy-clipmenu.el delete mode 100644 configs/shared/.emacs.d/wpc/ivy-helpers.el delete mode 100644 configs/shared/.emacs.d/wpc/kaomoji.el delete mode 100644 configs/shared/.emacs.d/wpc/kbd.el delete mode 100644 configs/shared/.emacs.d/wpc/keybindings.el delete mode 100644 configs/shared/.emacs.d/wpc/keyboard.el delete mode 100644 configs/shared/.emacs.d/wpc/keymap.el delete mode 100644 configs/shared/.emacs.d/wpc/laptop-battery.el delete mode 100644 configs/shared/.emacs.d/wpc/list.el delete mode 100644 configs/shared/.emacs.d/wpc/list.nix delete mode 100644 configs/shared/.emacs.d/wpc/macros.el delete mode 100644 configs/shared/.emacs.d/wpc/math.el delete mode 100644 configs/shared/.emacs.d/wpc/maybe.el delete mode 100644 configs/shared/.emacs.d/wpc/me-seconds.el delete mode 100644 configs/shared/.emacs.d/wpc/monoid.el delete mode 100644 configs/shared/.emacs.d/wpc/number.el delete mode 100644 configs/shared/.emacs.d/wpc/org-helpers.el delete mode 100644 configs/shared/.emacs.d/wpc/packages/wpc-clojure.el delete mode 100644 configs/shared/.emacs.d/wpc/packages/wpc-company.el delete mode 100644 configs/shared/.emacs.d/wpc/packages/wpc-dired.el delete mode 100644 configs/shared/.emacs.d/wpc/packages/wpc-docker.el delete mode 100644 configs/shared/.emacs.d/wpc/packages/wpc-elixir.el delete mode 100644 configs/shared/.emacs.d/wpc/packages/wpc-flycheck.el delete mode 100644 configs/shared/.emacs.d/wpc/packages/wpc-haskell.el delete mode 100644 configs/shared/.emacs.d/wpc/packages/wpc-java.el delete mode 100644 configs/shared/.emacs.d/wpc/packages/wpc-javascript.el delete mode 100644 configs/shared/.emacs.d/wpc/packages/wpc-keybindings.el delete mode 100644 configs/shared/.emacs.d/wpc/packages/wpc-lisp.el delete mode 100644 configs/shared/.emacs.d/wpc/packages/wpc-misc.el delete mode 100644 configs/shared/.emacs.d/wpc/packages/wpc-nix.el delete mode 100644 configs/shared/.emacs.d/wpc/packages/wpc-ocaml.el delete mode 100644 configs/shared/.emacs.d/wpc/packages/wpc-org.el delete mode 100644 configs/shared/.emacs.d/wpc/packages/wpc-package.el delete mode 100644 configs/shared/.emacs.d/wpc/packages/wpc-prolog.el delete mode 100644 configs/shared/.emacs.d/wpc/packages/wpc-python.el delete mode 100644 configs/shared/.emacs.d/wpc/packages/wpc-reasonml.el delete mode 100644 configs/shared/.emacs.d/wpc/packages/wpc-rust.el delete mode 100644 configs/shared/.emacs.d/wpc/packages/wpc-shell.el delete mode 100644 configs/shared/.emacs.d/wpc/packages/wpc-terminal.el delete mode 100644 configs/shared/.emacs.d/wpc/packages/wpc-ui.el delete mode 100644 configs/shared/.emacs.d/wpc/playback.el delete mode 100644 configs/shared/.emacs.d/wpc/polymorphism.el delete mode 100644 configs/shared/.emacs.d/wpc/prelude.el delete mode 100644 configs/shared/.emacs.d/wpc/prelude.nix delete mode 100644 configs/shared/.emacs.d/wpc/pulse-audio.el delete mode 100644 configs/shared/.emacs.d/wpc/pushover.el delete mode 100644 configs/shared/.emacs.d/wpc/random.el delete mode 100644 configs/shared/.emacs.d/wpc/region.el delete mode 100644 configs/shared/.emacs.d/wpc/scheduler.el delete mode 100644 configs/shared/.emacs.d/wpc/scope.el delete mode 100644 configs/shared/.emacs.d/wpc/screen-brightness.el delete mode 100644 configs/shared/.emacs.d/wpc/scrot.el delete mode 100644 configs/shared/.emacs.d/wpc/sequence.el delete mode 100644 configs/shared/.emacs.d/wpc/series.el delete mode 100644 configs/shared/.emacs.d/wpc/set.el delete mode 100644 configs/shared/.emacs.d/wpc/sre.el delete mode 100644 configs/shared/.emacs.d/wpc/ssh.el delete mode 100644 configs/shared/.emacs.d/wpc/stack.el delete mode 100644 configs/shared/.emacs.d/wpc/string.el delete mode 100644 configs/shared/.emacs.d/wpc/string.nix delete mode 100644 configs/shared/.emacs.d/wpc/struct.el delete mode 100644 configs/shared/.emacs.d/wpc/symbol.el delete mode 100644 configs/shared/.emacs.d/wpc/terminator-themes.json delete mode 100644 configs/shared/.emacs.d/wpc/terminator.el delete mode 100644 configs/shared/.emacs.d/wpc/themes.el delete mode 100644 configs/shared/.emacs.d/wpc/todo.el delete mode 100644 configs/shared/.emacs.d/wpc/tree.el delete mode 100644 configs/shared/.emacs.d/wpc/tuple.el delete mode 100644 configs/shared/.emacs.d/wpc/vector.el delete mode 100644 configs/shared/.emacs.d/wpc/wallpaper.el delete mode 100644 configs/shared/.emacs.d/wpc/window-manager.el delete mode 100644 configs/shared/.emacs.d/wpc/window.el delete mode 100644 configs/shared/.emacs.d/wpc/wpgtk.el delete mode 100644 configs/shared/.emacs.d/wpc/ynab.el delete mode 100644 configs/shared/.emacs.d/wpc/zle.el delete mode 100644 emacs.nix create mode 100644 emacs/.emacs.d/init.el create mode 100644 emacs/.emacs.d/opam-user-setup.el create mode 100644 emacs/.emacs.d/snippets/c-mode/.yas-parents create mode 100644 emacs/.emacs.d/snippets/c-mode/stdio create mode 100644 emacs/.emacs.d/snippets/c-mode/stdlib create mode 100644 emacs/.emacs.d/snippets/c-mode/struct create mode 100644 emacs/.emacs.d/snippets/emacs-lisp-mode/.yas-parents create mode 100644 emacs/.emacs.d/snippets/emacs-lisp-mode/elisp-module-docs create mode 100644 emacs/.emacs.d/snippets/emacs-lisp-mode/function create mode 100644 emacs/.emacs.d/snippets/emacs-lisp-mode/generic-header create mode 100644 emacs/.emacs.d/snippets/emacs-lisp-mode/library-header create mode 100644 emacs/.emacs.d/snippets/emacs-lisp-mode/provide-footer create mode 100644 emacs/.emacs.d/snippets/haskell-mode/.yas-parents create mode 100644 emacs/.emacs.d/snippets/haskell-mode/derive-safe-copy create mode 100644 emacs/.emacs.d/snippets/haskell-mode/import-qualified create mode 100644 emacs/.emacs.d/snippets/haskell-mode/instance-defn create mode 100644 emacs/.emacs.d/snippets/haskell-mode/language-extension create mode 100644 emacs/.emacs.d/snippets/haskell-mode/separator create mode 100644 emacs/.emacs.d/snippets/haskell-mode/undefined create mode 100644 emacs/.emacs.d/snippets/html-mode/.yas-parents create mode 100644 emacs/.emacs.d/snippets/html-mode/index-boilerplate create mode 100644 emacs/.emacs.d/snippets/java-mode/.yas-parents create mode 100644 emacs/.emacs.d/snippets/java-mode/public-static-void-main create mode 100644 emacs/.emacs.d/snippets/lisp-mode/.yas-parents create mode 100644 emacs/.emacs.d/snippets/lisp-mode/defpackage create mode 100644 emacs/.emacs.d/snippets/lisp-mode/function create mode 100644 emacs/.emacs.d/snippets/lisp-mode/typed-function create mode 100644 emacs/.emacs.d/snippets/nix-mode/.yas-parents create mode 100644 emacs/.emacs.d/snippets/nix-mode/shell-nix create mode 100644 emacs/.emacs.d/snippets/org-mode/.yas-parents create mode 100644 emacs/.emacs.d/snippets/org-mode/code-snippet create mode 100644 emacs/.emacs.d/snippets/org-mode/href create mode 100644 emacs/.emacs.d/snippets/python-mode/.yas-parents create mode 100644 emacs/.emacs.d/snippets/python-mode/dunder-main create mode 100644 emacs/.emacs.d/snippets/python-mode/function create mode 100644 emacs/.emacs.d/snippets/python-mode/header create mode 100644 emacs/.emacs.d/snippets/python-mode/init create mode 100644 emacs/.emacs.d/snippets/python-mode/shebang create mode 100644 emacs/.emacs.d/snippets/python-mode/utf-8 create mode 100644 emacs/.emacs.d/snippets/racket-mode/.yas-parents create mode 100644 emacs/.emacs.d/snippets/racket-mode/function create mode 100644 emacs/.emacs.d/snippets/racket-mode/lambda create mode 100644 emacs/.emacs.d/snippets/racket-mode/lambda-symbol create mode 100644 emacs/.emacs.d/snippets/reason-mode/.yas-parents create mode 100644 emacs/.emacs.d/snippets/reason-mode/function create mode 100644 emacs/.emacs.d/snippets/reason-mode/switch create mode 100644 emacs/.emacs.d/snippets/rjsx-mode/.yas-parents create mode 100644 emacs/.emacs.d/snippets/rjsx-mode/action-extractor create mode 100644 emacs/.emacs.d/snippets/rjsx-mode/console-log create mode 100644 emacs/.emacs.d/snippets/rjsx-mode/const-defn create mode 100644 emacs/.emacs.d/snippets/rjsx-mode/const-function create mode 100644 emacs/.emacs.d/snippets/rjsx-mode/destructure-const create mode 100644 emacs/.emacs.d/snippets/rjsx-mode/fat-arrow create mode 100644 emacs/.emacs.d/snippets/rjsx-mode/fat-arrow-function create mode 100644 emacs/.emacs.d/snippets/rjsx-mode/import-destructured create mode 100644 emacs/.emacs.d/snippets/rjsx-mode/import-react create mode 100644 emacs/.emacs.d/snippets/rjsx-mode/import-type create mode 100644 emacs/.emacs.d/snippets/rjsx-mode/import-x-from-y create mode 100644 emacs/.emacs.d/snippets/rjsx-mode/import-y create mode 100644 emacs/.emacs.d/snippets/rjsx-mode/jest-describe-test create mode 100644 emacs/.emacs.d/snippets/rjsx-mode/jest-test create mode 100644 emacs/.emacs.d/snippets/rjsx-mode/react-class-component create mode 100644 emacs/.emacs.d/snippets/rjsx-mode/redux-action create mode 100644 emacs/.emacs.d/snippets/rjsx-mode/typed-redux-action create mode 100644 emacs/.emacs.d/snippets/rust-mode/.yas-parents create mode 100644 emacs/.emacs.d/snippets/rust-mode/for-loop create mode 100644 emacs/.emacs.d/snippets/rust-mode/match create mode 100644 emacs/.emacs.d/snippets/sh-mode/.yas-parents create mode 100644 emacs/.emacs.d/snippets/sh-mode/function create mode 100644 emacs/.emacs.d/snippets/text-mode/.yas-parents create mode 100644 emacs/.emacs.d/snippets/text-mode/check-mark create mode 100644 emacs/.emacs.d/snippets/text-mode/x-mark create mode 100644 emacs/.emacs.d/snippets/web-mode/.yas-parents create mode 100644 emacs/.emacs.d/snippets/web-mode/header create mode 100644 emacs/.emacs.d/snippets/web-mode/index-boilerplate create mode 100644 emacs/.emacs.d/vendor/dired+.el create mode 100644 emacs/.emacs.d/vendor/org-clubhouse.el create mode 100644 emacs/.emacs.d/vendor/reason-indent.el create mode 100644 emacs/.emacs.d/vendor/reason-interaction.el create mode 100644 emacs/.emacs.d/vendor/reason-mode.el create mode 100644 emacs/.emacs.d/vendor/refmt.el create mode 100644 emacs/.emacs.d/vendor/slack-snippets.el create mode 100644 emacs/.emacs.d/vendor/wpgtk-theme.el create mode 100644 emacs/.emacs.d/wpc/alist.el create mode 100644 emacs/.emacs.d/wpc/bag.el create mode 100644 emacs/.emacs.d/wpc/bills.el create mode 100644 emacs/.emacs.d/wpc/bookmark.el create mode 100644 emacs/.emacs.d/wpc/buffer.el create mode 100644 emacs/.emacs.d/wpc/bytes.el create mode 100644 emacs/.emacs.d/wpc/cache.el create mode 100644 emacs/.emacs.d/wpc/chrome.el create mode 100644 emacs/.emacs.d/wpc/clipboard.el create mode 100644 emacs/.emacs.d/wpc/colorscheme.el create mode 100644 emacs/.emacs.d/wpc/constants.el create mode 100644 emacs/.emacs.d/wpc/cycle.el create mode 100644 emacs/.emacs.d/wpc/device.el create mode 100644 emacs/.emacs.d/wpc/display.el create mode 100644 emacs/.emacs.d/wpc/do.el create mode 100644 emacs/.emacs.d/wpc/dotfiles.el create mode 100644 emacs/.emacs.d/wpc/dotted.el create mode 100644 emacs/.emacs.d/wpc/email.el create mode 100644 emacs/.emacs.d/wpc/entr.el create mode 100644 emacs/.emacs.d/wpc/enum.el create mode 100644 emacs/.emacs.d/wpc/finance.el create mode 100644 emacs/.emacs.d/wpc/fonts.el create mode 100644 emacs/.emacs.d/wpc/fs.el create mode 100644 emacs/.emacs.d/wpc/functions.el create mode 100644 emacs/.emacs.d/wpc/graph.el create mode 100644 emacs/.emacs.d/wpc/imdb.el create mode 100644 emacs/.emacs.d/wpc/irc.el create mode 100644 emacs/.emacs.d/wpc/iso.el create mode 100644 emacs/.emacs.d/wpc/ivy-clipmenu.el create mode 100644 emacs/.emacs.d/wpc/ivy-helpers.el create mode 100644 emacs/.emacs.d/wpc/kaomoji.el create mode 100644 emacs/.emacs.d/wpc/kbd.el create mode 100644 emacs/.emacs.d/wpc/keybindings.el create mode 100644 emacs/.emacs.d/wpc/keyboard.el create mode 100644 emacs/.emacs.d/wpc/keymap.el create mode 100644 emacs/.emacs.d/wpc/laptop-battery.el create mode 100644 emacs/.emacs.d/wpc/list.el create mode 100644 emacs/.emacs.d/wpc/list.nix create mode 100644 emacs/.emacs.d/wpc/macros.el create mode 100644 emacs/.emacs.d/wpc/math.el create mode 100644 emacs/.emacs.d/wpc/maybe.el create mode 100644 emacs/.emacs.d/wpc/me-seconds.el create mode 100644 emacs/.emacs.d/wpc/monoid.el create mode 100644 emacs/.emacs.d/wpc/number.el create mode 100644 emacs/.emacs.d/wpc/org-helpers.el create mode 100644 emacs/.emacs.d/wpc/playback.el create mode 100644 emacs/.emacs.d/wpc/polymorphism.el create mode 100644 emacs/.emacs.d/wpc/prelude.el create mode 100644 emacs/.emacs.d/wpc/prelude.nix create mode 100644 emacs/.emacs.d/wpc/pulse-audio.el create mode 100644 emacs/.emacs.d/wpc/pushover.el create mode 100644 emacs/.emacs.d/wpc/random.el create mode 100644 emacs/.emacs.d/wpc/region.el create mode 100644 emacs/.emacs.d/wpc/scheduler.el create mode 100644 emacs/.emacs.d/wpc/scope.el create mode 100644 emacs/.emacs.d/wpc/screen-brightness.el create mode 100644 emacs/.emacs.d/wpc/scrot.el create mode 100644 emacs/.emacs.d/wpc/sequence.el create mode 100644 emacs/.emacs.d/wpc/series.el create mode 100644 emacs/.emacs.d/wpc/set.el create mode 100644 emacs/.emacs.d/wpc/ssh.el create mode 100644 emacs/.emacs.d/wpc/stack.el create mode 100644 emacs/.emacs.d/wpc/string.el create mode 100644 emacs/.emacs.d/wpc/string.nix create mode 100644 emacs/.emacs.d/wpc/struct.el create mode 100644 emacs/.emacs.d/wpc/symbol.el create mode 100644 emacs/.emacs.d/wpc/terminator-themes.json create mode 100644 emacs/.emacs.d/wpc/terminator.el create mode 100644 emacs/.emacs.d/wpc/themes.el create mode 100644 emacs/.emacs.d/wpc/todo.el create mode 100644 emacs/.emacs.d/wpc/tree.el create mode 100644 emacs/.emacs.d/wpc/tuple.el create mode 100644 emacs/.emacs.d/wpc/vector.el create mode 100644 emacs/.emacs.d/wpc/wallpaper.el create mode 100644 emacs/.emacs.d/wpc/window-manager.el create mode 100644 emacs/.emacs.d/wpc/window.el create mode 100644 emacs/.emacs.d/wpc/wpc-clojure.el create mode 100644 emacs/.emacs.d/wpc/wpc-company.el create mode 100644 emacs/.emacs.d/wpc/wpc-dired.el create mode 100644 emacs/.emacs.d/wpc/wpc-docker.el create mode 100644 emacs/.emacs.d/wpc/wpc-elixir.el create mode 100644 emacs/.emacs.d/wpc/wpc-flycheck.el create mode 100644 emacs/.emacs.d/wpc/wpc-haskell.el create mode 100644 emacs/.emacs.d/wpc/wpc-java.el create mode 100644 emacs/.emacs.d/wpc/wpc-javascript.el create mode 100644 emacs/.emacs.d/wpc/wpc-keybindings.el create mode 100644 emacs/.emacs.d/wpc/wpc-lisp.el create mode 100644 emacs/.emacs.d/wpc/wpc-misc.el create mode 100644 emacs/.emacs.d/wpc/wpc-nix.el create mode 100644 emacs/.emacs.d/wpc/wpc-ocaml.el create mode 100644 emacs/.emacs.d/wpc/wpc-org.el create mode 100644 emacs/.emacs.d/wpc/wpc-package.el create mode 100644 emacs/.emacs.d/wpc/wpc-prolog.el create mode 100644 emacs/.emacs.d/wpc/wpc-python.el create mode 100644 emacs/.emacs.d/wpc/wpc-reasonml.el create mode 100644 emacs/.emacs.d/wpc/wpc-rust.el create mode 100644 emacs/.emacs.d/wpc/wpc-shell.el create mode 100644 emacs/.emacs.d/wpc/wpc-terminal.el create mode 100644 emacs/.emacs.d/wpc/wpc-ui.el create mode 100644 emacs/.emacs.d/wpc/wpgtk.el create mode 100644 emacs/.emacs.d/wpc/ynab.el create mode 100644 emacs/.emacs.d/wpc/zle.el create mode 100644 emacs/default.nix create mode 100644 utils.nix diff --git a/configs/shared/.emacs.d/init.el b/configs/shared/.emacs.d/init.el deleted file mode 100644 index 68401d48db..0000000000 --- a/configs/shared/.emacs.d/init.el +++ /dev/null @@ -1,59 +0,0 @@ -(require 'wpc-package "~/.emacs.d/wpc/packages/wpc-package.el") - -;; load order is intentional -(require 'constants) -(require 'wpc-misc) - -;; my libraries -(require 'functions) -(require 'prelude) -(require 'macros) -(require 'kaomoji) - -;; Google -;; (require 'google-stuff) - -;; Laptop XF-functionality -(require 'pulse-audio) -(require 'screen-brightness) - -;; miscellaneous -(require 'clipboard) -(require 'battery) -(require 'dotfiles) -(require 'bookmark) -(require 'keyboard) -(require 'irc) -(require 'email) -;; TODO: Consider renaming entr.el. -(require 'entr) -(require 'scrot) -;; TODO: Remove path once published to MELPA. -(require 'egg-timer "~/programming/egg-timer.el/egg-timer.el") - -;; TODO: Reconcile kbd.el, keybindings.el, wpc-keybindings.el, keyboard.el. -(require 'keybindings) -(require 'wpc-keybindings) -(require 'window-manager) -(require 'wpc-ui) -(require 'wpc-dired) -(require 'wpc-terminal) -(require 'wpc-org) -(require 'wpc-company) -;; TODO: Re-enable flycheck for all languages besides Elisp once I learn more -;; about the issue with the `emacs-lisp' `flycheck-checker'. -;; (require 'wpc-flycheck) -(require 'wpc-shell) -(require 'wpc-docker) -(require 'wpc-lisp) -(require 'wpc-haskell) -(require 'wpc-reasonml) -(require 'wpc-ocaml) -(require 'wpc-elixir) -(require 'wpc-nix) -(require 'wpc-rust) -(require 'wpc-clojure) -(require 'wpc-python) -(require 'wpc-javascript) -(require 'wpc-java) -(require 'wpc-prolog) diff --git a/configs/shared/.emacs.d/opam-user-setup.el b/configs/shared/.emacs.d/opam-user-setup.el deleted file mode 100644 index a23addefaf..0000000000 --- a/configs/shared/.emacs.d/opam-user-setup.el +++ /dev/null @@ -1,145 +0,0 @@ -;; ## added by OPAM user-setup for emacs / base ## cfd3c9b7837c85cffd0c59de521990f0 ## you can edit, but keep this line -(provide 'opam-user-setup) - -;; Base configuration for OPAM - -(defun opam-shell-command-to-string (command) - "Similar to shell-command-to-string, but returns nil unless the process - returned 0, and ignores stderr (shell-command-to-string ignores return value)" - (let* ((return-value 0) - (return-string - (with-output-to-string - (setq return-value - (with-current-buffer standard-output - (process-file shell-file-name nil '(t nil) nil - shell-command-switch command)))))) - (if (= return-value 0) return-string nil))) - -(defun opam-update-env (switch) - "Update the environment to follow current OPAM switch configuration" - (interactive - (list - (let ((default - (car (split-string (opam-shell-command-to-string "opam switch show --safe"))))) - (completing-read - (concat "opam switch (" default "): ") - (split-string (opam-shell-command-to-string "opam switch list -s --safe") "\n") - nil t nil nil default)))) - (let* ((switch-arg (if (= 0 (length switch)) "" (concat "--switch " switch))) - (command (concat "opam config env --safe --sexp " switch-arg)) - (env (opam-shell-command-to-string command))) - (when (and env (not (string= env ""))) - (dolist (var (car (read-from-string env))) - (setenv (car var) (cadr var)) - (when (string= (car var) "PATH") - (setq exec-path (split-string (cadr var) path-separator))))))) - -(opam-update-env nil) - -(defvar opam-share - (let ((reply (opam-shell-command-to-string "opam config var share --safe"))) - (when reply (substring reply 0 -1)))) - -(add-to-list 'load-path (concat opam-share "/emacs/site-lisp")) -;; OPAM-installed tools automated detection and initialisation - -(defun opam-setup-tuareg () - (add-to-list 'load-path (concat opam-share "/tuareg") t) - (load "tuareg-site-file")) - -(defun opam-setup-add-ocaml-hook (h) - (add-hook 'tuareg-mode-hook h t) - (add-hook 'caml-mode-hook h t)) - -(defun opam-setup-complete () - (if (require 'company nil t) - (opam-setup-add-ocaml-hook - (lambda () - (company-mode) - (defalias 'auto-complete 'company-complete))) - (require 'auto-complete nil t))) - -(defun opam-setup-ocp-indent () - (opam-setup-complete) - (autoload 'ocp-setup-indent "ocp-indent" "Improved indentation for Tuareg mode") - (autoload 'ocp-indent-caml-mode-setup "ocp-indent" "Improved indentation for Caml mode") - (add-hook 'tuareg-mode-hook 'ocp-setup-indent t) - (add-hook 'caml-mode-hook 'ocp-indent-caml-mode-setup t)) - -(defun opam-setup-ocp-index () - (autoload 'ocp-index-mode "ocp-index" "OCaml code browsing, documentation and completion based on build artefacts") - (opam-setup-add-ocaml-hook 'ocp-index-mode)) - -(defun opam-setup-merlin () - (opam-setup-complete) - (require 'merlin) - (opam-setup-add-ocaml-hook 'merlin-mode) - - (defcustom ocp-index-use-auto-complete nil - "Use auto-complete with ocp-index (disabled by default by opam-user-setup because merlin is in use)" - :group 'ocp_index) - (defcustom merlin-ac-setup 'easy - "Use auto-complete with merlin (enabled by default by opam-user-setup)" - :group 'merlin-ac) - - ;; So you can do it on a mac, where `C-` and `C-` are used - ;; by spaces. - (define-key merlin-mode-map - (kbd "C-c ") 'merlin-type-enclosing-go-up) - (define-key merlin-mode-map - (kbd "C-c ") 'merlin-type-enclosing-go-down) - (set-face-background 'merlin-type-face "skyblue")) - -(defun opam-setup-utop () - (autoload 'utop "utop" "Toplevel for OCaml" t) - (autoload 'utop-minor-mode "utop" "Minor mode for utop" t) - (add-hook 'tuareg-mode-hook 'utop-minor-mode)) - -(defvar opam-tools - '(("tuareg" . opam-setup-tuareg) - ("ocp-indent" . opam-setup-ocp-indent) - ("ocp-index" . opam-setup-ocp-index) - ("merlin" . opam-setup-merlin) - ("utop" . opam-setup-utop))) - -(defun opam-detect-installed-tools () - (let* - ((command "opam list --installed --short --safe --color=never") - (names (mapcar 'car opam-tools)) - (command-string (mapconcat 'identity (cons command names) " ")) - (reply (opam-shell-command-to-string command-string))) - (when reply (split-string reply)))) - -(defvar opam-tools-installed (opam-detect-installed-tools)) - -(defun opam-auto-tools-setup () - (interactive) - (dolist (tool opam-tools) - (when (member (car tool) opam-tools-installed) - (funcall (symbol-function (cdr tool)))))) - -(opam-auto-tools-setup) -;; ## end of OPAM user-setup addition for emacs / base ## keep this line -;; ## added by OPAM user-setup for emacs / tuareg ## b10f42abebd2259b784b70d1a7f7e426 ## you can edit, but keep this line -;; Set to autoload tuareg from its original switch when not found in current -;; switch (don't load tuareg-site-file as it adds unwanted load-paths) -(defun opam-tuareg-autoload (fct file doc args) - (let ((load-path (cons "/home/wpcarro/.opam/default/share/emacs/site-lisp" load-path))) - (load file)) - (apply fct args)) -(when (not (member "tuareg" opam-tools-installed)) - (defun tuareg-mode (&rest args) - (opam-tuareg-autoload 'tuareg-mode "tuareg" "Major mode for editing OCaml code" args)) - (defun tuareg-run-ocaml (&rest args) - (opam-tuareg-autoload 'tuareg-run-ocaml "tuareg" "Run an OCaml toplevel process" args)) - (defun ocamldebug (&rest args) - (opam-tuareg-autoload 'ocamldebug "ocamldebug" "Run the OCaml debugger" args)) - (defalias 'run-ocaml 'tuareg-run-ocaml) - (defalias 'camldebug 'ocamldebug) - (add-to-list 'auto-mode-alist '("\\.ml[iylp]?\\'" . tuareg-mode)) - (add-to-list 'auto-mode-alist '("\\.eliomi?\\'" . tuareg-mode)) - (add-to-list 'interpreter-mode-alist '("ocamlrun" . tuareg-mode)) - (add-to-list 'interpreter-mode-alist '("ocaml" . tuareg-mode)) - (dolist (ext '(".cmo" ".cmx" ".cma" ".cmxa" ".cmxs" ".cmt" ".cmti" ".cmi" ".annot")) - (add-to-list 'completion-ignored-extensions ext))) -;; ## end of OPAM user-setup addition for emacs / tuareg ## keep this line diff --git a/configs/shared/.emacs.d/snippets/c-mode/.yas-parents b/configs/shared/.emacs.d/snippets/c-mode/.yas-parents deleted file mode 100644 index d58dacb7a0..0000000000 --- a/configs/shared/.emacs.d/snippets/c-mode/.yas-parents +++ /dev/null @@ -1 +0,0 @@ -text-mode \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/c-mode/stdio b/configs/shared/.emacs.d/snippets/c-mode/stdio deleted file mode 100644 index 52bc717e47..0000000000 --- a/configs/shared/.emacs.d/snippets/c-mode/stdio +++ /dev/null @@ -1,5 +0,0 @@ -# -*- mode: snippet -*- -# name: -# key: sio -# -- -#include \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/c-mode/stdlib b/configs/shared/.emacs.d/snippets/c-mode/stdlib deleted file mode 100644 index 5d44e8ed79..0000000000 --- a/configs/shared/.emacs.d/snippets/c-mode/stdlib +++ /dev/null @@ -1,5 +0,0 @@ -# -*- mode: snippet -*- -# name: -# key: slb -# -- -#include \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/c-mode/struct b/configs/shared/.emacs.d/snippets/c-mode/struct deleted file mode 100644 index 6e9282f83c..0000000000 --- a/configs/shared/.emacs.d/snippets/c-mode/struct +++ /dev/null @@ -1,7 +0,0 @@ -# -*- mode: snippet -*- -# name: struct -# key: struct -# -- -typedef struct $1 { - $2 -} $1_t; \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/emacs-lisp-mode/.yas-parents b/configs/shared/.emacs.d/snippets/emacs-lisp-mode/.yas-parents deleted file mode 100644 index d58dacb7a0..0000000000 --- a/configs/shared/.emacs.d/snippets/emacs-lisp-mode/.yas-parents +++ /dev/null @@ -1 +0,0 @@ -text-mode \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/emacs-lisp-mode/elisp-module-docs b/configs/shared/.emacs.d/snippets/emacs-lisp-mode/elisp-module-docs deleted file mode 100644 index 8ea7b8f077..0000000000 --- a/configs/shared/.emacs.d/snippets/emacs-lisp-mode/elisp-module-docs +++ /dev/null @@ -1,11 +0,0 @@ -# -*- mode: snippet -*- -# name: Elisp module docs -# key: emd -# -- -;;; `(-> (buffer-file-name) f-filename)` --- $2 -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; $3 - -;;; Code: \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/emacs-lisp-mode/function b/configs/shared/.emacs.d/snippets/emacs-lisp-mode/function deleted file mode 100644 index bfa888d526..0000000000 --- a/configs/shared/.emacs.d/snippets/emacs-lisp-mode/function +++ /dev/null @@ -1,8 +0,0 @@ -# -*- mode: snippet -*- -# name: Function -# key: fn -# expand-env: ((yas-indent-line 'fixed)) -# -- -(defun $1 ($2) - "$3" - $4) \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/emacs-lisp-mode/generic-header b/configs/shared/.emacs.d/snippets/emacs-lisp-mode/generic-header deleted file mode 100644 index bf6e525f8c..0000000000 --- a/configs/shared/.emacs.d/snippets/emacs-lisp-mode/generic-header +++ /dev/null @@ -1,7 +0,0 @@ -# -*- mode: snippet -*- -# name: Header -# key: hdr -# -- -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; $1 -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/configs/shared/.emacs.d/snippets/emacs-lisp-mode/library-header b/configs/shared/.emacs.d/snippets/emacs-lisp-mode/library-header deleted file mode 100644 index 0f0ad5c4fc..0000000000 --- a/configs/shared/.emacs.d/snippets/emacs-lisp-mode/library-header +++ /dev/null @@ -1,7 +0,0 @@ -# -*- mode: snippet -*- -# name: Library header -# key: lib -# -- -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/emacs-lisp-mode/provide-footer b/configs/shared/.emacs.d/snippets/emacs-lisp-mode/provide-footer deleted file mode 100644 index 2a0bcc33f7..0000000000 --- a/configs/shared/.emacs.d/snippets/emacs-lisp-mode/provide-footer +++ /dev/null @@ -1,6 +0,0 @@ -# -*- mode: snippet -*- -# name: Provide footer -# key: elf -# -- -(provide '`(-> (buffer-file-name) f-filename f-no-ext)`) -;;; `(-> (buffer-file-name) f-filename)` ends here \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/haskell-mode/.yas-parents b/configs/shared/.emacs.d/snippets/haskell-mode/.yas-parents deleted file mode 100644 index d58dacb7a0..0000000000 --- a/configs/shared/.emacs.d/snippets/haskell-mode/.yas-parents +++ /dev/null @@ -1 +0,0 @@ -text-mode \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/haskell-mode/derive-safe-copy b/configs/shared/.emacs.d/snippets/haskell-mode/derive-safe-copy deleted file mode 100644 index 95f7d9deec..0000000000 --- a/configs/shared/.emacs.d/snippets/haskell-mode/derive-safe-copy +++ /dev/null @@ -1,5 +0,0 @@ -# -*- mode: snippet -*- -# name: Derive Safe Copy -# key: dsc -# -- -deriveSafeCopy 0 'base ''$1 \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/haskell-mode/import-qualified b/configs/shared/.emacs.d/snippets/haskell-mode/import-qualified deleted file mode 100644 index 4c4db62a8a..0000000000 --- a/configs/shared/.emacs.d/snippets/haskell-mode/import-qualified +++ /dev/null @@ -1,5 +0,0 @@ -# -*- mode: snippet -*- -# name: Import qualified -# key: iq -# -- -import qualified $1 as $2 \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/haskell-mode/instance-defn b/configs/shared/.emacs.d/snippets/haskell-mode/instance-defn deleted file mode 100644 index 10d194ce41..0000000000 --- a/configs/shared/.emacs.d/snippets/haskell-mode/instance-defn +++ /dev/null @@ -1,6 +0,0 @@ -# -*- mode: snippet -*- -# name: Instance -# key: inst -# -- -instance $1 where - $2 = $3 \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/haskell-mode/language-extension b/configs/shared/.emacs.d/snippets/haskell-mode/language-extension deleted file mode 100644 index 9d6084acb4..0000000000 --- a/configs/shared/.emacs.d/snippets/haskell-mode/language-extension +++ /dev/null @@ -1,5 +0,0 @@ -# -*- mode: snippet -*- -# name: language extension -# key: lang -# -- -{-# LANGUAGE $1 #-} \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/haskell-mode/separator b/configs/shared/.emacs.d/snippets/haskell-mode/separator deleted file mode 100644 index 1ab0d762b6..0000000000 --- a/configs/shared/.emacs.d/snippets/haskell-mode/separator +++ /dev/null @@ -1,5 +0,0 @@ -# -*- mode: snippet -*- -# name: Separator -# key: - -# -- --------------------------------------------------------------------------------- \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/haskell-mode/undefined b/configs/shared/.emacs.d/snippets/haskell-mode/undefined deleted file mode 100644 index 7609f801f2..0000000000 --- a/configs/shared/.emacs.d/snippets/haskell-mode/undefined +++ /dev/null @@ -1,5 +0,0 @@ -# -*- mode: snippet -*- -# name: Undefiend -# key: nd -# -- -undefined \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/html-mode/.yas-parents b/configs/shared/.emacs.d/snippets/html-mode/.yas-parents deleted file mode 100644 index d58dacb7a0..0000000000 --- a/configs/shared/.emacs.d/snippets/html-mode/.yas-parents +++ /dev/null @@ -1 +0,0 @@ -text-mode \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/html-mode/index-boilerplate b/configs/shared/.emacs.d/snippets/html-mode/index-boilerplate deleted file mode 100644 index 3cea6ce003..0000000000 --- a/configs/shared/.emacs.d/snippets/html-mode/index-boilerplate +++ /dev/null @@ -1,18 +0,0 @@ -# -*- mode: snippet -*- -# name: HTML index.html starter -# key: html -# -- - - - - - - $1 - - - - - - - - \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/java-mode/.yas-parents b/configs/shared/.emacs.d/snippets/java-mode/.yas-parents deleted file mode 100644 index d58dacb7a0..0000000000 --- a/configs/shared/.emacs.d/snippets/java-mode/.yas-parents +++ /dev/null @@ -1 +0,0 @@ -text-mode \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/java-mode/public-static-void-main b/configs/shared/.emacs.d/snippets/java-mode/public-static-void-main deleted file mode 100644 index 1839a27eb5..0000000000 --- a/configs/shared/.emacs.d/snippets/java-mode/public-static-void-main +++ /dev/null @@ -1,7 +0,0 @@ -# -*- mode: snippet -*- -# name: public static void main -# key: psvm -# -- -public static void main(String[] args) { - $1 -} \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/lisp-mode/.yas-parents b/configs/shared/.emacs.d/snippets/lisp-mode/.yas-parents deleted file mode 100644 index d58dacb7a0..0000000000 --- a/configs/shared/.emacs.d/snippets/lisp-mode/.yas-parents +++ /dev/null @@ -1 +0,0 @@ -text-mode \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/lisp-mode/defpackage b/configs/shared/.emacs.d/snippets/lisp-mode/defpackage deleted file mode 100644 index 7f110a9718..0000000000 --- a/configs/shared/.emacs.d/snippets/lisp-mode/defpackage +++ /dev/null @@ -1,9 +0,0 @@ -# -*- mode: snippet -*- -# name: Define package -# key: defp -# -- -(in-package #:cl-user) -(defpackage #:$1 - (:documentation "$2") - (:use #:cl)) -(in-package #:$1) \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/lisp-mode/function b/configs/shared/.emacs.d/snippets/lisp-mode/function deleted file mode 100644 index b1769cd3d1..0000000000 --- a/configs/shared/.emacs.d/snippets/lisp-mode/function +++ /dev/null @@ -1,7 +0,0 @@ -# -*- mode: snippet -*- -# name: Function -# key: fn -# -- -(defun $1 ($2) - "$3" - $4) \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/lisp-mode/typed-function b/configs/shared/.emacs.d/snippets/lisp-mode/typed-function deleted file mode 100644 index a3c236821e..0000000000 --- a/configs/shared/.emacs.d/snippets/lisp-mode/typed-function +++ /dev/null @@ -1,8 +0,0 @@ -# -*- mode: snippet -*- -# name: Typed function -# key: tfn -# -- -(type $1 ($3) $4) -(defun $1 ($2) - "$5" - $6) \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/nix-mode/.yas-parents b/configs/shared/.emacs.d/snippets/nix-mode/.yas-parents deleted file mode 100644 index d58dacb7a0..0000000000 --- a/configs/shared/.emacs.d/snippets/nix-mode/.yas-parents +++ /dev/null @@ -1 +0,0 @@ -text-mode \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/nix-mode/shell-nix b/configs/shared/.emacs.d/snippets/nix-mode/shell-nix deleted file mode 100644 index 4c308bb51b..0000000000 --- a/configs/shared/.emacs.d/snippets/nix-mode/shell-nix +++ /dev/null @@ -1,12 +0,0 @@ -# -*- mode: snippet -*- -# name: shell.nix boilerplate -# key: import -# -- -with import {}; - -stdenv.mkDerivation { - name = "$1"; - buildInputs = [ - $2 - ]; -} \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/org-mode/.yas-parents b/configs/shared/.emacs.d/snippets/org-mode/.yas-parents deleted file mode 100644 index d58dacb7a0..0000000000 --- a/configs/shared/.emacs.d/snippets/org-mode/.yas-parents +++ /dev/null @@ -1 +0,0 @@ -text-mode \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/org-mode/code-snippet b/configs/shared/.emacs.d/snippets/org-mode/code-snippet deleted file mode 100644 index 4215b15992..0000000000 --- a/configs/shared/.emacs.d/snippets/org-mode/code-snippet +++ /dev/null @@ -1,7 +0,0 @@ -# -*- mode: snippet -*- -# name: Code Snippet -# key: src -# -- -#+BEGIN_SRC $1 -$2 -#+END_SRC \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/org-mode/href b/configs/shared/.emacs.d/snippets/org-mode/href deleted file mode 100644 index ac65ea2e49..0000000000 --- a/configs/shared/.emacs.d/snippets/org-mode/href +++ /dev/null @@ -1,5 +0,0 @@ -# -*- mode: snippet -*- -# name: Org mode URL -# key: href -# -- -[[$1][$2]] \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/python-mode/.yas-parents b/configs/shared/.emacs.d/snippets/python-mode/.yas-parents deleted file mode 100644 index d58dacb7a0..0000000000 --- a/configs/shared/.emacs.d/snippets/python-mode/.yas-parents +++ /dev/null @@ -1 +0,0 @@ -text-mode \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/python-mode/dunder-main b/configs/shared/.emacs.d/snippets/python-mode/dunder-main deleted file mode 100644 index 4dd22dc0b2..0000000000 --- a/configs/shared/.emacs.d/snippets/python-mode/dunder-main +++ /dev/null @@ -1,6 +0,0 @@ -# -*- mode: snippet -*- -# name: Dunder main (__main__) -# key: mn -# -- -if __name__ == "__main__": - main() \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/python-mode/function b/configs/shared/.emacs.d/snippets/python-mode/function deleted file mode 100644 index 379ceda1a3..0000000000 --- a/configs/shared/.emacs.d/snippets/python-mode/function +++ /dev/null @@ -1,6 +0,0 @@ -# -*- mode: snippet -*- -# name: Function -# key: fn -# -- -def $1($2): - $3 \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/python-mode/header b/configs/shared/.emacs.d/snippets/python-mode/header deleted file mode 100644 index db48adfec7..0000000000 --- a/configs/shared/.emacs.d/snippets/python-mode/header +++ /dev/null @@ -1,7 +0,0 @@ -# -*- mode: snippet -*- -# name: Header -# key: hdr -# -- -################################################################################ -# $1 -################################################################################ \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/python-mode/init b/configs/shared/.emacs.d/snippets/python-mode/init deleted file mode 100644 index 5c407495f5..0000000000 --- a/configs/shared/.emacs.d/snippets/python-mode/init +++ /dev/null @@ -1,6 +0,0 @@ -# -*- mode: snippet -*- -# name: dunder init -# key: ctor -# -- -def __init__(self$1): - $2 \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/python-mode/shebang b/configs/shared/.emacs.d/snippets/python-mode/shebang deleted file mode 100644 index 0f45ae782d..0000000000 --- a/configs/shared/.emacs.d/snippets/python-mode/shebang +++ /dev/null @@ -1,6 +0,0 @@ -# -*- mode: snippet -*- -# name: shebang -# key: shb -# -- -#!/usr/bin/env python -# -*- coding: utf-8 -*- diff --git a/configs/shared/.emacs.d/snippets/python-mode/utf-8 b/configs/shared/.emacs.d/snippets/python-mode/utf-8 deleted file mode 100644 index 3babc73030..0000000000 --- a/configs/shared/.emacs.d/snippets/python-mode/utf-8 +++ /dev/null @@ -1,5 +0,0 @@ -# -*- mode: snippet -*- -# name: utf-8 -# key: utf -# -- -# -*- coding: utf-8 -*- \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/racket-mode/.yas-parents b/configs/shared/.emacs.d/snippets/racket-mode/.yas-parents deleted file mode 100644 index d58dacb7a0..0000000000 --- a/configs/shared/.emacs.d/snippets/racket-mode/.yas-parents +++ /dev/null @@ -1 +0,0 @@ -text-mode \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/racket-mode/function b/configs/shared/.emacs.d/snippets/racket-mode/function deleted file mode 100644 index 882c48ded3..0000000000 --- a/configs/shared/.emacs.d/snippets/racket-mode/function +++ /dev/null @@ -1,5 +0,0 @@ -# -*- mode: snippet -*- -# name: Function -# key: fn -# -- -(define ($1) $2) \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/racket-mode/lambda b/configs/shared/.emacs.d/snippets/racket-mode/lambda deleted file mode 100644 index b9a684588b..0000000000 --- a/configs/shared/.emacs.d/snippets/racket-mode/lambda +++ /dev/null @@ -1,5 +0,0 @@ -# -*- mode: snippet -*- -# name: Lambda function -# key: ld -# -- -(λ ($1) $2) \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/racket-mode/lambda-symbol b/configs/shared/.emacs.d/snippets/racket-mode/lambda-symbol deleted file mode 100644 index 254b9fd96b..0000000000 --- a/configs/shared/.emacs.d/snippets/racket-mode/lambda-symbol +++ /dev/null @@ -1,5 +0,0 @@ -# -*- mode: snippet -*- -# name: Lambda symbol -# key: l -# -- -λ \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/reason-mode/.yas-parents b/configs/shared/.emacs.d/snippets/reason-mode/.yas-parents deleted file mode 100644 index d58dacb7a0..0000000000 --- a/configs/shared/.emacs.d/snippets/reason-mode/.yas-parents +++ /dev/null @@ -1 +0,0 @@ -text-mode \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/reason-mode/function b/configs/shared/.emacs.d/snippets/reason-mode/function deleted file mode 100644 index 6b4b6a5db2..0000000000 --- a/configs/shared/.emacs.d/snippets/reason-mode/function +++ /dev/null @@ -1,7 +0,0 @@ -# -*- mode: snippet -*- -# name: Function -# key: fn -# -- -let $1 = (~$2:$3) => { - $4 -}; \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/reason-mode/switch b/configs/shared/.emacs.d/snippets/reason-mode/switch deleted file mode 100644 index 40f34ff8d1..0000000000 --- a/configs/shared/.emacs.d/snippets/reason-mode/switch +++ /dev/null @@ -1,7 +0,0 @@ -# -*- mode: snippet -*- -# name: Switch statement -# key: sw -# -- -switch ($1) { -| $2 => -} \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/rjsx-mode/.yas-parents b/configs/shared/.emacs.d/snippets/rjsx-mode/.yas-parents deleted file mode 100644 index d58dacb7a0..0000000000 --- a/configs/shared/.emacs.d/snippets/rjsx-mode/.yas-parents +++ /dev/null @@ -1 +0,0 @@ -text-mode \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/rjsx-mode/action-extractor b/configs/shared/.emacs.d/snippets/rjsx-mode/action-extractor deleted file mode 100644 index 62834a29ab..0000000000 --- a/configs/shared/.emacs.d/snippets/rjsx-mode/action-extractor +++ /dev/null @@ -1,5 +0,0 @@ -# -*- mode: snippet -*- -# name: exactness -# key: $x -# -- -$Exact<$Call> \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/rjsx-mode/console-log b/configs/shared/.emacs.d/snippets/rjsx-mode/console-log deleted file mode 100644 index 82ec3fd8e3..0000000000 --- a/configs/shared/.emacs.d/snippets/rjsx-mode/console-log +++ /dev/null @@ -1,5 +0,0 @@ -# -*- mode: snippet -*- -# name: Console.log helper -# key: clg -# -- -console.log($1) \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/rjsx-mode/const-defn b/configs/shared/.emacs.d/snippets/rjsx-mode/const-defn deleted file mode 100644 index 8e35e61fc2..0000000000 --- a/configs/shared/.emacs.d/snippets/rjsx-mode/const-defn +++ /dev/null @@ -1,5 +0,0 @@ -# -*- mode: snippet -*- -# name: const definition -# key: cn -# -- -const $1 = '$2' \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/rjsx-mode/const-function b/configs/shared/.emacs.d/snippets/rjsx-mode/const-function deleted file mode 100644 index 13f2018f22..0000000000 --- a/configs/shared/.emacs.d/snippets/rjsx-mode/const-function +++ /dev/null @@ -1,7 +0,0 @@ -# -*- mode: snippet -*- -# name: const function -# key: cfn -# -- -const $1 = ($2) => { - $3 -} \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/rjsx-mode/destructure-const b/configs/shared/.emacs.d/snippets/rjsx-mode/destructure-const deleted file mode 100644 index 2a52c57c75..0000000000 --- a/configs/shared/.emacs.d/snippets/rjsx-mode/destructure-const +++ /dev/null @@ -1,5 +0,0 @@ -# -*- mode: snippet -*- -# name: Destructuring a const -# key: cds -# -- -const { $1 } = $2 \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/rjsx-mode/fat-arrow b/configs/shared/.emacs.d/snippets/rjsx-mode/fat-arrow deleted file mode 100644 index 187a2efc5a..0000000000 --- a/configs/shared/.emacs.d/snippets/rjsx-mode/fat-arrow +++ /dev/null @@ -1,5 +0,0 @@ -# -*- mode: snippet -*- -# name: Fat arrow function -# key: fa -# -- -=> \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/rjsx-mode/fat-arrow-function b/configs/shared/.emacs.d/snippets/rjsx-mode/fat-arrow-function deleted file mode 100644 index 694914a83c..0000000000 --- a/configs/shared/.emacs.d/snippets/rjsx-mode/fat-arrow-function +++ /dev/null @@ -1,7 +0,0 @@ -# -*- mode: snippet -*- -# name: Fat arrow function -# key: faf -# -- -() => { - $1 -} \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/rjsx-mode/import-destructured b/configs/shared/.emacs.d/snippets/rjsx-mode/import-destructured deleted file mode 100644 index ded3ce163a..0000000000 --- a/configs/shared/.emacs.d/snippets/rjsx-mode/import-destructured +++ /dev/null @@ -1,5 +0,0 @@ -# -*- mode: snippet -*- -# name: Import destructured -# key: ids -# -- -import { $1 } from '$2' \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/rjsx-mode/import-react b/configs/shared/.emacs.d/snippets/rjsx-mode/import-react deleted file mode 100644 index 0463f5cd55..0000000000 --- a/configs/shared/.emacs.d/snippets/rjsx-mode/import-react +++ /dev/null @@ -1,5 +0,0 @@ -# -*- mode: snippet -*- -# name: Import React dependency (ES6) -# key: ir -# -- -import React from 'react' diff --git a/configs/shared/.emacs.d/snippets/rjsx-mode/import-type b/configs/shared/.emacs.d/snippets/rjsx-mode/import-type deleted file mode 100644 index fcd51f687b..0000000000 --- a/configs/shared/.emacs.d/snippets/rjsx-mode/import-type +++ /dev/null @@ -1,5 +0,0 @@ -# -*- mode: snippet -*- -# name: import type -# key: ixt -# -- -import type { $1 } from '$2' \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/rjsx-mode/import-x-from-y b/configs/shared/.emacs.d/snippets/rjsx-mode/import-x-from-y deleted file mode 100644 index 09fa6df505..0000000000 --- a/configs/shared/.emacs.d/snippets/rjsx-mode/import-x-from-y +++ /dev/null @@ -1,5 +0,0 @@ -# -*- mode: snippet -*- -# name: import x from y -# key: ix -# -- -import $1 from '$2' \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/rjsx-mode/import-y b/configs/shared/.emacs.d/snippets/rjsx-mode/import-y deleted file mode 100644 index 9f550e300d..0000000000 --- a/configs/shared/.emacs.d/snippets/rjsx-mode/import-y +++ /dev/null @@ -1,5 +0,0 @@ -# -*- mode: snippet -*- -# name: import y -# key: iy -# -- -import '$1' \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/rjsx-mode/jest-describe-test b/configs/shared/.emacs.d/snippets/rjsx-mode/jest-describe-test deleted file mode 100644 index ed382d4f74..0000000000 --- a/configs/shared/.emacs.d/snippets/rjsx-mode/jest-describe-test +++ /dev/null @@ -1,10 +0,0 @@ -# -*- mode: snippet -*- -# name: Jest describe/test block -# key: dsc -# -- -describe('$1', () => { - test('$2', () => { - - expect($3).toEqual($4) - }) -}) \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/rjsx-mode/jest-test b/configs/shared/.emacs.d/snippets/rjsx-mode/jest-test deleted file mode 100644 index 12ca2e786d..0000000000 --- a/configs/shared/.emacs.d/snippets/rjsx-mode/jest-test +++ /dev/null @@ -1,7 +0,0 @@ -# -*- mode: snippet -*- -# name: Jest / Jasmine test -# key: tst -# -- -test('$1', () => { - expect($2).toBe($3) -}) \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/rjsx-mode/react-class-component b/configs/shared/.emacs.d/snippets/rjsx-mode/react-class-component deleted file mode 100644 index f2a93a31d9..0000000000 --- a/configs/shared/.emacs.d/snippets/rjsx-mode/react-class-component +++ /dev/null @@ -1,11 +0,0 @@ -# -*- mode: snippet -*- -# name: React class extends -# key: clz -# -- -class $1 extends React.Component { - render() { - $2 - } -} - -export default $1 \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/rjsx-mode/redux-action b/configs/shared/.emacs.d/snippets/rjsx-mode/redux-action deleted file mode 100644 index 7d24ffee41..0000000000 --- a/configs/shared/.emacs.d/snippets/rjsx-mode/redux-action +++ /dev/null @@ -1,5 +0,0 @@ -# -*- mode: snippet -*- -# name: redux-action -# key: rax -# -- -export const ${1:$$(string/lower->caps yas-text)} = '`(downcase (buffer-dirname))`/${1:$(string/caps->kebab yas-text)}' \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/rjsx-mode/typed-redux-action b/configs/shared/.emacs.d/snippets/rjsx-mode/typed-redux-action deleted file mode 100644 index c50e1f9d2e..0000000000 --- a/configs/shared/.emacs.d/snippets/rjsx-mode/typed-redux-action +++ /dev/null @@ -1,5 +0,0 @@ -# -*- mode: snippet -*- -# name: typed-redux-action -# key: trax -# -- -export const ${1:$$(string/lower->caps yas-text)}: '`(downcase (buffer-dirname))`/${1:$(string/caps->kebab yas-text)}' = '`(downcase (buffer-dirname))`/${1:$(string/caps->kebab yas-text)}' \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/rust-mode/.yas-parents b/configs/shared/.emacs.d/snippets/rust-mode/.yas-parents deleted file mode 100644 index d58dacb7a0..0000000000 --- a/configs/shared/.emacs.d/snippets/rust-mode/.yas-parents +++ /dev/null @@ -1 +0,0 @@ -text-mode \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/rust-mode/for-loop b/configs/shared/.emacs.d/snippets/rust-mode/for-loop deleted file mode 100644 index 4d8e0e3bbd..0000000000 --- a/configs/shared/.emacs.d/snippets/rust-mode/for-loop +++ /dev/null @@ -1,7 +0,0 @@ -# -*- mode: snippet -*- -# name: for-loop -# key: for -# -- -for $1 in $2 { - $3 -} \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/rust-mode/match b/configs/shared/.emacs.d/snippets/rust-mode/match deleted file mode 100644 index bf0e876e2b..0000000000 --- a/configs/shared/.emacs.d/snippets/rust-mode/match +++ /dev/null @@ -1,7 +0,0 @@ -# -*- mode: snippet -*- -# name: match -# key: match -# -- -match $1 { - $2 => $3, -} \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/sh-mode/.yas-parents b/configs/shared/.emacs.d/snippets/sh-mode/.yas-parents deleted file mode 100644 index d58dacb7a0..0000000000 --- a/configs/shared/.emacs.d/snippets/sh-mode/.yas-parents +++ /dev/null @@ -1 +0,0 @@ -text-mode \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/sh-mode/function b/configs/shared/.emacs.d/snippets/sh-mode/function deleted file mode 100644 index efa946bb27..0000000000 --- a/configs/shared/.emacs.d/snippets/sh-mode/function +++ /dev/null @@ -1,7 +0,0 @@ -# -*- mode: snippet -*- -# name: Create function -# key: fn -# -- -$1() { - $2 -} \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/text-mode/.yas-parents b/configs/shared/.emacs.d/snippets/text-mode/.yas-parents deleted file mode 100644 index d58dacb7a0..0000000000 --- a/configs/shared/.emacs.d/snippets/text-mode/.yas-parents +++ /dev/null @@ -1 +0,0 @@ -text-mode \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/text-mode/check-mark b/configs/shared/.emacs.d/snippets/text-mode/check-mark deleted file mode 100644 index 7977819688..0000000000 --- a/configs/shared/.emacs.d/snippets/text-mode/check-mark +++ /dev/null @@ -1,5 +0,0 @@ -# -*- mode: snippet -*- -# name: Unicode checkmark -# key: uck -# -- -✓ \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/text-mode/x-mark b/configs/shared/.emacs.d/snippets/text-mode/x-mark deleted file mode 100644 index bc3c356a61..0000000000 --- a/configs/shared/.emacs.d/snippets/text-mode/x-mark +++ /dev/null @@ -1,5 +0,0 @@ -# -*- mode: snippet -*- -# name: Unicode ex-mark -# key: ux -# -- -✗ \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/web-mode/.yas-parents b/configs/shared/.emacs.d/snippets/web-mode/.yas-parents deleted file mode 100644 index d58dacb7a0..0000000000 --- a/configs/shared/.emacs.d/snippets/web-mode/.yas-parents +++ /dev/null @@ -1 +0,0 @@ -text-mode \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/web-mode/header b/configs/shared/.emacs.d/snippets/web-mode/header deleted file mode 100644 index ae59c7a50f..0000000000 --- a/configs/shared/.emacs.d/snippets/web-mode/header +++ /dev/null @@ -1,7 +0,0 @@ -# -*- mode: snippet -*- -# name: Header -# key: hdr -# -- -/******************************************************************************* - * $1 - ******************************************************************************/ \ No newline at end of file diff --git a/configs/shared/.emacs.d/snippets/web-mode/index-boilerplate b/configs/shared/.emacs.d/snippets/web-mode/index-boilerplate deleted file mode 100644 index b791cdf86f..0000000000 --- a/configs/shared/.emacs.d/snippets/web-mode/index-boilerplate +++ /dev/null @@ -1,18 +0,0 @@ -# -*- mode: snippet -*- -# name: HTML index.html starter -# key: html -# -- - - - - - - $1 - - - - - - - - diff --git a/configs/shared/.emacs.d/tramp b/configs/shared/.emacs.d/tramp deleted file mode 100644 index d924501ed1..0000000000 --- a/configs/shared/.emacs.d/tramp +++ /dev/null @@ -1,27 +0,0 @@ -;; -*- emacs-lisp -*- <19/12/10 12:42:49 /home/wpcarro/.emacs.d/tramp> -;; Tramp connection history. Don't change this file. -;; You can delete it, forcing Tramp to reapply the checks. - -(((tramp-file-name "ssh" "wpcarro" nil "desktop" nil nil nil) - ("uname" "Linux 5.2.17-1rodete3-amd64") - ("locale" "LC_ALL=en_US.utf8") - ("test" "test") - ("remote-path" - ("/bin" "/usr/bin" "/sbin" "/usr/sbin" "/usr/local/bin" "/usr/local/sbin")) - ("remote-shell" "/bin/sh") - ("file-exists" "test -e") - ("case-insensitive" nil) - ("ls" "/bin/ls --color=never") - ("ls-quoting-style" t) - ("ls-dired" t) - ("stat" "env QUOTING_STYLE=locale \\stat") - ("id" "/bin/id") - ("gid-integer" 89939) - ("readlink" "\\readlink") - ("gid-string" "primarygroup") - ("perl-file-spec" t) - ("perl-cwd-realpath" t) - ("perl" "\\perl") - ("bzr" nil) - ("git" "\\git") - ("hg" "\\hg"))) diff --git a/configs/shared/.emacs.d/vendor/dired+.el b/configs/shared/.emacs.d/vendor/dired+.el deleted file mode 100644 index 2403b0af9c..0000000000 --- a/configs/shared/.emacs.d/vendor/dired+.el +++ /dev/null @@ -1,13696 +0,0 @@ -;;; dired+.el --- Extensions to Dired. -;; -;; Filename: dired+.el -;; Description: Extensions to Dired. -;; Author: Drew Adams -;; Maintainer: Drew Adams (concat "drew.adams" "@" "oracle" ".com") -;; Copyright (C) 1999-2019, Drew Adams, all rights reserved. -;; Created: Fri Mar 19 15:58:58 1999 -;; Version: 2019.04.21 -;; Package-Requires: () -;; Last-Updated: Sun Jul 21 09:47:33 2019 (-0700) -;; By: dradams -;; Update #: 11727 -;; URL: https://www.emacswiki.org/emacs/download/dired%2b.el -;; Doc URL: https://www.emacswiki.org/emacs/DiredPlus -;; Keywords: unix, mouse, directories, diredp, dired -;; Compatibility: GNU Emacs: 20.x, 21.x, 22.x, 23.x, 24.x, 25.x, 26.x -;; -;; Features that might be required by this library: -;; -;; `apropos', `apropos+', `autofit-frame', `avoid', `backquote', -;; `bookmark', `bookmark+', `bookmark+-1', `bookmark+-bmu', -;; `bookmark+-key', `bookmark+-lit', `button', `bytecomp', `cconv', -;; `cl', `cl-lib', `cmds-menu', `col-highlight', `crosshairs', -;; `dired', `dired+', `dired-aux', `dired-loaddefs', `dired-x', -;; `easymenu', `fit-frame', `font-lock', `font-lock+', -;; `format-spec', `frame-fns', `gv', `help+', `help-fns', -;; `help-fns+', `help-macro', `help-macro+', `help-mode', -;; `highlight', `hl-line', `hl-line+', `image', `image-dired', -;; `image-file', `image-mode', `info', `info+', `kmacro', -;; `macroexp', `menu-bar', `menu-bar+', `misc-cmds', `misc-fns', -;; `naked', `pp', `pp+', `radix-tree', `replace', `second-sel', -;; `strings', `syntax', `text-mode', `thingatpt', `thingatpt+', -;; `vline', `w32-browser', `w32browser-dlgopen', `wid-edit', -;; `wid-edit+', `widget'. -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: -;; -;; Extensions to Dired. -;; -;; This file extends functionalities provided by standard GNU Emacs -;; files `dired.el', `dired-aux.el', and `dired-x.el'. -;; -;; Key bindings changed. Menus redefined. `diredp-mouse-3-menu' -;; popup menu added. New commands. Some commands enhanced. -;; -;; All of the new functions, variables, and faces defined here have -;; the prefix `diredp-' (for Dired Plus) in their names. -;; -;; -;; Wraparound Navigation -;; --------------------- -;; -;; In vanilla Dired, `dired-next-marked-file' (`M-}' or `* C-n') and -;; `dired-previous-marked-file' (`M-{' or `* C-p') wrap around when -;; you get to the end or the beginning of the Dired buffer. Handy. -;; -;; But the other navigation commands do not wrap around. In `Dired+' -;; they do, provided option `diredp-wrap-around-flag' is non-nil, -;; which it is by default. This means the following commands: -;; -;; `diredp-next-line' - `n', `C-n', `down', `SPC' -;; `diredp-previous-line' - `p', `C-p', `up' -;; `diredp-next-dirline' - `>' -;; `diredp-prev-dirline' - `<' -;; `diredp-next-subdir' - `C-M-n' -;; `diredp-prev-subdir' - `C-M-p' -;; -;; -;; Quick Viewing While Navigating -;; ------------------------------ -;; -;; You can use key `C-down' or `C-up' to navigate to the next or -;; previous file line, respectively, and at the same time show its -;; file in another window. The focus remains on the Dired buffer. -;; A numeric prefix arg means move that many lines first. -;; -;; Names of files and directories that match either of the options -;; `diredp-visit-ignore-extensions' or `diredp-visit-ignore-regexps' -;; are skipped. -;; -;; You can use `e' to show the file of the current line. If it is -;; already shown in the same frame, and if Dired is the only other -;; window there, then the file is hidden (its window is deleted). -;; -;; -;; Font-Lock Highlighting -;; ---------------------- -;; -;; If you want a maximum or minimum fontification for Dired mode, -;; then customize option `font-lock-maximum-decoration'. If you want -;; a different fontification level for Dired than for other modes, -;; you can do this too by customizing -;; `font-lock-maximize-decoration'. -;; -;; A few of the user options defined here have an effect on -;; font-locking, and this effect is established only when Dired+ is -;; loaded, which defines the font-lock keywords for Dired. These -;; options include `diredp-compressed-extensions', -;; `diredp-ignore-compressed-flag', `dired-omit-extensions', and -;; `diredp-omit-files-regexp'. This means that if you change the -;; value of such an option then you will see the change only in a new -;; Emacs session. -;; -;; (You can see the effect in the same session if you use `C-M-x' on -;; the `defvar' sexp for `diredp-font-lock-keywords-1', and then you -;; toggle font-lock off and back on.) -;; -;; -;; Act on All Files -;; ---------------- -;; -;; Most of the commands (such as `C' and `M-g') that operate on the -;; marked files have the added feature here that multiple `C-u' use -;; not the files that are marked or the next or previous N files, but -;; *all* of the files in the Dired buffer. Just what "all" files -;; means changes with the number of `C-u', as follows: -;; -;; `C-u C-u' - Use all files present, but no directories. -;; `C-u C-u C-u' - Use all files and dirs except `.' and `..'. -;; `C-u C-u C-u C-u' - use all files and dirs, `.' and `..'. -;; -;; (More than four `C-u' act the same as two.) -;; -;; This feature can be particularly useful when you have a Dired -;; buffer with files chosen from multiple directories. -;; -;; Note that in most cases this behavior is described only in the doc -;; string of function `dired-get-marked-files'. It is generally -;; *not* described in the doc strings of the various commands, -;; because that would require redefining each command separately -;; here. Instead, we redefine macro `dired-map-over-marks' and -;; function `dired-get-filename' in order to achieve this effect. -;; -;; Commands such as `dired-do-load' for which it does not make sense -;; to act on directories generally treat more than two `C-u' the same -;; as two `C-u'. -;; -;; Exceptions to the general behavior described here are called out -;; in the doc strings. In particular, the behavior of a prefix arg -;; for `dired-do-query-replace-regexp' is different, so that you can -;; use it also to specify word-delimited replacement. -;; -;; -;; Act on Marked (or All) Files Here and Below -;; ------------------------------------------- -;; -;; The prefix argument behavior just described does not apply to the -;; `diredp-*-recursive' commands. These commands act on the marked -;; files in the current Dired buffer or on all files in the directory -;; if none are marked. -;; -;; But these commands also handle marked subdirectories recursively, -;; in the same way. That is, they act also on the marked files in -;; any marked subdirectories, found recursively. If such a -;; descendant directory is listed in a Dired buffer then its marked -;; files and subdirs are handled the same way. If there is no Dired -;; buffer that lists a given marked subdirectory then all of its -;; files and subdirs are acted on. -;; -;; For most such here-and-below commands, a prefix argument means -;; ignore all marks. The commands then act on all files in the -;; current Dired buffer and all of its subdirectories, recursively. -;; -;; But here-and-below commands that unmark or change marks act -;; differently for different kinds of prefix argument: -;; -;; * A non-positive prefix arg means ignore subdir markings and act -;; instead on ALL subdirs. -;; -;; * A non-negative prefix arg means do not change marks on subdirs -;; themselves. -;; -;; For example, `M-+ U' removes all marks, including from marked -;; subdirs, recursively. `C-- M-+ U' removes them from all files in -;; all subdirs (marked or not), recursively. `C-9 M-+ U' removes all -;; marks, recursively, except the marks on subdirs themselves. `C-0 -;; M-+ U' acts like those two combined: it descends everywhere, -;; ignoring which subdirs are marked, but it does not remove marks -;; from subdirs themselves. -;; -;; All of the `diredp-*-recursive' commands are on prefix key `M-+', -;; and most are available on submenu `Marked Here and Below' of the -;; `Multiple' menu-bar menu. The commands that unmark and change -;; marks are also in submenu `Here and Below' of menu-bar menu -;; `Marks'. -;; -;; If you use library `Icicles' then you have the following -;; additional commands/keys that act recursively on marked files. -;; They are in the `Icicles' submenu of menu `Multiple' > `Marked -;; Here and Below'. -;; -;; * `M-+ M-s M-s' or `M-s M-s m' - Use Icicles search (and its -;; on-demand replace) on the marked files. -;; -;; * Save the names of the marked files: -;; -;; `M-+ C-M->' - Save as a completion set, for use during -;; completion (e.g. with `C-x C-f'). -;; -;; `M-+ C->' - Add marked names to the names in the current saved -;; completion set. -;; -;; `M-+ C-}' - Save persistently to an Icicles cache file, for -;; use during completion in another session. -;; -;; `icicle-dired-save-marked-to-fileset-recursive' - Like `M-+ -;; C-}', but save persistently to an Emacs fileset. -;; -;; `M-+ C-M-}' - Save to a Lisp variable. -;; -;; -;; In the other direction, if you have a saved set of file names then -;; you can use `C-M-<' (`icicle-dired-chosen-files-other-window') in -;; Dired to open a Dired buffer for just those files. So you can -;; mark some files and subdirs in a hierarchy of Dired buffers, use -;; `M-+ C-}' to save their names persistently, then later use `C-{' -;; to retrieve them, and `C-M-<' (in Dired) to open Dired on them. -;; -;; -;; Image Files -;; ----------- -;; -;; `Dired+' provides several enhancements regarding image files. -;; Most of these require standard library `image-dired.el'. One of -;; them, command `diredp-do-display-images', which displays all of -;; the marked image files, requires standard library `image-file.el'. -;; -;; `Dired+' loads these libraries automatically, if available, which -;; means an Emacs version that supports image display (Emacs 22 or -;; later). (You must of course have installed whatever else your -;; Emacs version needs to display images.) -;; -;; Besides command `diredp-do-display-images', see the commands whose -;; names have prefix `diredp-image-'. And see options -;; `diredp-image-preview-in-tooltip' and -;; `diredp-auto-focus-frame-for-thumbnail-tooltip-flag'. -;; -;; -;; Inserted Subdirs, Multiple Dired Buffers, Files from Anywhere,... -;; ----------------------------------------------------------------- -;; -;; These three standard Dired features are worth pointing out. The -;; third in particular is little known because (a) it is limited in -;; vanilla Dired and (b) you cannot use it interactively. -;; -;; * You can pass a glob pattern with wildcards to `dired' -;; interactively, as the file name. -;; -;; * You can insert multiple subdirectory listings into a single -;; Dired buffer using `i' on each subdir line. Use `C-u i' to -;; specify `ls' switches. Specifying switch `R' inserts the -;; inserted subdirectory's subdirs also, recursively. You can -;; also use `i' to bounce between a subdirectory line and its -;; inserted-listing header line. You can delete a subdir listing -;; using `C-u k' on its header line. You can hide/show an -;; inserted subdir using `$'. You can use `C-_' to undo any of -;; these operations. -;; -;; * You can open a Dired buffer for an arbitrary set of files from -;; different directories. You do this by invoking `dired' -;; non-interactively, passing it a cons of a Dired buffer name and -;; the file names. Relative file names are interpreted relative -;; to the value of `default-directory'. Use absolute file names -;; when appropriate. -;; -;; `Dired+' makes these features more useful. -;; -;; `$' is improved: It is a simple toggle - it does not move the -;; cursor forward. `M-$' advances the cursor, in addition to -;; toggling like `$'. `C-u $' does hide/show all (what `M-$' does in -;; vanilla Dired). -;; -;; `i' is improved in these ways: -;; -;; * Once a subdir has been inserted, `i' bounces between the subdir -;; listing and the subdir line in the parent listing. If the -;; parent dir is hidden, then `i' from a subdir opens the parent -;; listing so it can move to the subdir line there (Emacs 24+). -;; -;; * Vanilla Dired lets you create a Dired listing with files and -;; directories from arbitrary locations, but you cannot insert -;; (`i') such a directory if it is not in the same directory tree -;; as the `default-directory' used to create the Dired buffer. -;; `Dired+' removes this limitation; you can insert any non-root -;; directories (that is, not `/', `c:/', etc.). -;; -;; `Dired+' lets you create Dired buffers that contain arbitrary -;; files and directories interactively, not just using Lisp. Just -;; use a non-positive prefix arg (e.g., `C--') when invoking `dired'. -;; -;; You are then prompted for the Dired buffer name (anything you -;; like, not necessarily a directory name) and the individual files -;; and directories that you want listed. -;; -;; A non-negative prefix arg still prompts you for the `ls' switches -;; to use. (So `C-0' does both: prompts for `ls' switches and for -;; the Dired buffer name and the files to list.) -;; -;; `Dired+' adds commands for combining and augmenting Dired -;; listings: -;; -;; * `diredp-add-to-dired-buffer', bound globally to `C-x D A', lets -;; you add arbitrary file and directory names to an existing Dired -;; buffer. -;; -;; * `diredp-dired-union', bound globally to `C-x D U', lets you -;; take the union of multiple Dired listings, or convert an -;; ordinary Dired listing to an explicit list of absolute file -;; names. With a non-positive prefix arg, you can add extra file -;; and directory names, just as for `diredp-add-to-dired-buffer'. -;; -;; You can optionally add a header line to a Dired buffer using -;; toggle command `diredp-breadcrumbs-in-header-line-mode'. (A -;; header line remains at the top of the window - no need to scroll -;; to see it.) If you want to show the header line automatically in -;; all Dired buffers, you can do this: -;; -;; (add-hook 'dired-before-readin-hook -;; 'diredp-breadcrumbs-in-header-line-mode) -;; -;; Some other libraries, such as `Bookmark+' and `Icicles', make it -;; easy to create or re-create Dired buffers that list specific files -;; and have a particular set of markings. `Bookmark+' records Dired -;; buffers persistently, remembering `ls' switches, markings, subdir -;; insertions, and hidden subdirs. If you use `Icicles' then `dired' -;; is a multi-command: you can open multiple Dired buffers with one -;; `dired' invocation. -;; -;; Dired can help you manage projects. You might have multiple Dired -;; buffers with quite specific contents. You might have some -;; subdirectories inserted in the same Dired buffer, and you might -;; have separate Dired buffers for some subdirectories. Sometimes it -;; is useful to have both for the same subdirectory. And sometimes -;; it is useful to move from one presentation to the other. -;; -;; This is one motivation for the `Dired+' `diredp-*-recursive' -;; commands, which act on the marked files in marked subdirectories, -;; recursively. In one sense, these commands are an alternative to -;; using a single Dired buffer with inserted subdirectories. They -;; let you use the same operations on the files in a set of Dired -;; directories, without inserting those directories into an ancestor -;; Dired buffer. -;; -;; You can use command `diredp-dired-inserted-subdirs' to open a -;; separate Dired buffer for each of the subdirs that is inserted in -;; the current Dired buffer. Markings and Dired switches are -;; preserved. -;; -;; In the opposite direction, if you use `Icicles' then you can use -;; multi-command `icicle-dired-insert-as-subdir', which lets you -;; insert any number of directories you choose interactively into a -;; Dired ancestor directory listing. If a directory you choose to -;; insert already has its own Dired buffer, then its markings and -;; switches are preserved for the new, subdirectory listing in the -;; ancestor Dired buffer. -;; -;; -;; Hide/Show Details -;; ----------------- -;; -;; Starting with Emacs 24.4, listing details are hidden by default. -;; Note that this is different from the vanilla Emacs behavior, which -;; is to show details by default. -;; -;; Use `(' anytime to toggle this hiding. You can use option -;; `diredp-hide-details-initially-flag' to change the default/initial -;; state. See also option `diredp-hide-details-propagate-flag'. -;; -;; NOTE: If you do not want to hide details initially then you must -;; either (1) change `diredp-hide-details-initially-flag' using -;; Customize (recommended) or (2) set it to `nil' (e.g., using -;; `setq') *BEFORE* loading `dired+.el'. -;; -;; If you have an Emacs version older than 24.4, you can use library -;; `dired-details+.el' (plus `dired-details.el') to get similar -;; behavior. -;; -;; -;; Mode-Line -;; --------- -;; -;; The number of files and dirs that are marked with `*', and the -;; number that are flagged for deletion (marked `D') are indicated in -;; the mode-line. When the cursor is on such a line the indication -;; tells you how many more there are. For example, if the cursor is -;; on the line of the third file that is marked `*', and there are -;; seven of them total, then the mode-line shows `3/7*'. -;; -;; The mode-line also indicates, for the current listing (which could -;; be a subdir listing), how many files and dirs are listed. If the -;; cursor is on the 27th file in a listing of 78 files then the -;; mode-line shows 27/78. -;; -;; For counting files and dirs in a listing, option -;; `diredp-count-.-and-..-flag' controls whether to count the lines -;; for `.' and `..'. By default it is nil, meaning they are not -;; counted. -;; -;; -;; If You Use Dired+ in Terminal Mode -;; ---------------------------------- -;; -;; By default, Dired+ binds some keys that can be problematic in some -;; terminals when you use Emacs in terminal mode (i.e., `emacs -nw'). -;; This is controlled by option -;; `diredp-bind-problematic-terminal-keys'. -;; -;; In particular, keys that use modifiers Meta and Shift together can -;; be problematic. If you use Dired+ in text-only terminal, and you -;; find that your terminal does not support such keys, then you might -;; want to customize the option to set the value to `nil', and then -;; bind the commands to some other keys, which your terminal -;; supports. -;; -;; The problematic keys used by Dired+ include these: -;; -;; `M-M' (aka `M-S-m') - `diredp-chmod-this-file' -;; `M-O' (aka `M-S-o') - `diredp-chown-this-file' -;; `M-T' (aka `M-S-t') - `diredp-touch-this-file' -;; `C-M-B' (aka `C-M-S-b') - `diredp-do-bookmark-in-bookmark-file' -;; `C-M-G' (aka `C-M-S-g') - `diredp-chgrp-this-file' -;; `C-M-R' (aka `C-M-S-r') - `diredp-toggle-find-file-reuse-dir' -;; `C-M-T' (aka `C-M-S-t') - `dired-do-touch' -;; `M-+ M-B' (aka `M-+ M-S-b') - -;; `diredp-do-bookmark-dirs-recursive' -;; `M-+ C-M-B' (aka `M-+ C-M-S-b') - -;; `diredp-do-bookmark-in-bookmark-file-recursive' -;; `M-+ C-M-T' (aka `M-+ C-M-S-t') - `diredp-do-touch-recursive' -;; -;; (See also `(info "(org) TTY keys")' for more information about -;; keys that can be problematic in a text-only terminal.) -;; -;; -;; Faces defined here: -;; -;; `diredp-autofile-name', `diredp-compressed-file-suffix', -;; `diredp-date-time', `diredp-deletion', -;; `diredp-deletion-file-name', `diredp-dir-heading', -;; `diredp-dir-priv', `diredp-exec-priv', `diredp-executable-tag', -;; `diredp-file-name', `diredp-file-suffix', `diredp-flag-mark', -;; `diredp-flag-mark-line', `diredp-get-file-or-dir-name', -;; `diredp-ignored-file-name', `diredp-link-priv', -;; `diredp-mode-line-flagged', `diredp-mode-line-marked' -;; `diredp-omit-file-name', `diredp-no-priv', `diredp-number', -;; `diredp-other-priv', `diredp-rare-priv', `diredp-read-priv', -;; `diredp-symlink', `diredp-tagged-autofile-name', -;; `diredp-write-priv'. -;; -;; Commands defined here: -;; -;; `diredp-add-to-dired-buffer', `diredp-add-to-this-dired-buffer', -;; `diredp-do-apply-function', -;; `diredp-do-apply-function-recursive', -;; `diredp-async-shell-command-this-file', -;; `diredp-bookmark-this-file', -;; `diredp-breadcrumbs-in-header-line-mode' (Emacs 22+), -;; `diredp-byte-compile-this-file', `diredp-capitalize', -;; `diredp-capitalize-recursive', `diredp-capitalize-this-file', -;; `diredp-change-marks-recursive' (Emacs 22+), -;; `diredp-chgrp-this-file', `diredp-chmod-this-file', -;; `diredp-chown-this-file', -;; `diredp-compilation-files-other-window' (Emacs 24+), -;; `diredp-compress-this-file', -;; `diredp-copy-abs-filenames-as-kill', -;; `diredp-copy-abs-filenames-as-kill-recursive', -;; `diredp-copy-filename-as-kill-recursive', -;; `diredp-copy-tags-this-file', `diredp-copy-this-file', -;; `diredp-decrypt-this-file', `diredp-delete-this-file', -;; `diredp-describe-autofile', `diredp-describe-file', -;; `diredp-describe-marked-autofiles', `diredp-describe-mode', -;; `diredp-dired-for-files', `diredp-dired-for-files-other-window', -;; `diredp-dired-inserted-subdirs', `diredp-dired-plus-help', -;; `diredp-dired-recent-dirs', -;; `diredp-dired-recent-dirs-other-window', -;; `diredp-dired-this-subdir', `diredp-dired-union', -;; `diredp-do-async-shell-command-recursive', `diredp-do-bookmark', -;; `diredp-do-bookmark-dirs-recursive', -;; `diredp-do-bookmark-in-bookmark-file', -;; `diredp-do-bookmark-in-bookmark-file-recursive', -;; `diredp-do-bookmark-recursive', `diredp-do-chmod-recursive', -;; `diredp-do-chgrp-recursive', `diredp-do-chown-recursive', -;; `diredp-do-copy-recursive', `diredp-do-decrypt-recursive', -;; `diredp-do-delete-recursive', `diredp-do-display-images' (Emacs -;; 22+), `diredp-do-emacs-command', `diredp-do-encrypt-recursive', -;; `diredp-do-find-marked-files-recursive', `diredp-do-grep', -;; `diredp-do-grep-recursive', `diredp-do-hardlink-recursive', -;; `diredp-do-isearch-recursive', -;; `diredp-do-isearch-regexp-recursive', `diredp-do-lisp-sexp' -;; (Emacs 22+), `diredp-do-move-recursive', -;; `diredp-do-paste-add-tags', `diredp-do-paste-replace-tags', -;; `diredp-do-print-recursive', -;; `diredp-do-query-replace-regexp-recursive', -;; `diredp-do-redisplay-recursive', -;; `diredp-do-relsymlink-recursive', `diredp-do-remove-all-tags', -;; `diredp-do-search-recursive', `diredp-do-set-tag-value', -;; `diredp-do-shell-command-recursive', `diredp-do-sign-recursive', -;; `diredp-do-symlink-recursive', `diredp-do-tag', -;; `diredp-do-touch-recursive', `diredp-do-untag', -;; `diredp-do-verify-recursive', `diredp-downcase-recursive', -;; `diredp-downcase-this-file', `diredp-ediff', -;; `diredp-encrypt-this-file', `diredp-fileset', -;; `diredp-fileset-other-window', `diredp-find-a-file', -;; `diredp-find-a-file-other-frame', -;; `diredp-find-a-file-other-window', -;; `diredp-find-file-other-frame', -;; `diredp-find-file-reuse-dir-buffer', -;; `diredp-find-line-file-other-window', -;; `diredp-flag-auto-save-files-recursive', -;; `diredp-flag-region-files-for-deletion', -;; `diredp-grepped-files-other-window', `diredp-grep-this-file', -;; `diredp-hardlink-this-file', `diredp-highlight-autofiles-mode', -;; `diredp-image-dired-comment-file', -;; `diredp-image-dired-comment-files-recursive', -;; `diredp-image-dired-copy-with-exif-name', -;; `diredp-image-dired-create-thumb', -;; `diredp-image-dired-delete-tag', -;; `diredp-image-dired-delete-tag-recursive', -;; `diredp-image-dired-display-thumb', -;; `diredp-image-dired-display-thumbs-recursive', -;; `diredp-image-dired-edit-comment-and-tags', -;; `diredp-image-dired-tag-file', -;; `diredp-image-dired-tag-files-recursive', -;; `diredp-image-show-this-file', `diredp-insert-as-subdir', -;; `diredp-insert-subdirs', `diredp-insert-subdirs-recursive', -;; `diredp-kill-this-tree', `diredp-list-marked-recursive', -;; `diredp-load-this-file', `diredp-mark-autofiles', -;; `diredp-marked', `diredp-marked-other-window', -;; `diredp-marked-recursive', -;; `diredp-marked-recursive-other-window', -;; `diredp-mark-extension-recursive', -;; `diredp-mark-files-containing-regexp-recursive', -;; `diredp-mark-files-regexp-recursive', -;; `diredp-mark-files-tagged-all', `diredp-mark-files-tagged-none', -;; `diredp-mark-files-tagged-not-all', -;; `diredp-mark-files-tagged-some', -;; `diredp-mark-files-tagged-regexp', `diredp-mark-region-files', -;; `diredp-mark-sexp-recursive' (Emacs 22+), -;; `diredp-mark/unmark-autofiles', `diredp-mark/unmark-extension', -;; `diredp-mouse-3-menu', `diredp-mouse-backup-diff', -;; `diredp-mouse-copy-tags', `diredp-mouse-describe-autofile', -;; `diredp-mouse-describe-file', `diredp-mouse-diff', -;; `diredp-mouse-do-bookmark', `diredp-mouse-do-byte-compile', -;; `diredp-mouse-do-chgrp', `diredp-mouse-do-chmod', -;; `diredp-mouse-do-chown', `diredp-mouse-do-compress', -;; `diredp-mouse-do-copy', `diredp-mouse-do-delete', -;; `diredp-mouse-do-grep', `diredp-mouse-do-hardlink', -;; `diredp-mouse-do-load', `diredp-mouse-do-print', -;; `diredp-mouse-do-remove-all-tags', `diredp-mouse-do-rename', -;; `diredp-mouse-do-set-tag-value', -;; `diredp-mouse-do-shell-command', `diredp-mouse-do-symlink', -;; `diredp-mouse-do-tag', `diredp-mouse-do-untag', -;; `diredp-mouse-downcase', `diredp-mouse-ediff', -;; `diredp-mouse-find-line-file-other-window', -;; `diredp-mouse-find-file-other-frame', -;; `diredp-mouse-find-file-reuse-dir-buffer', -;; `diredp-mouse-flag-file-deletion', `diredp-mouse-mark', -;; `diredp-mouse-mark-region-files', `diredp-mouse-mark/unmark', -;; `diredp-mouse-unmark', `diredp-mouse-upcase', -;; `diredp-mouse-view-file', `diredp-move-file' (Emacs 24+), -;; `diredp-multiple-w32-browser-recursive', -;; `diredp-nb-marked-in-mode-name', `diredp-next-dirline', -;; `diredp-next-line', `diredp-next-subdir', `diredp-omit-marked', -;; `diredp-omit-unmarked', `diredp-paste-add-tags-this-file', -;; `diredp-paste-files', `diredp-paste-replace-tags-this-file', -;; `diredp-prev-dirline', `diredp-previous-line', -;; `diredp-prev-subdir', `diredp-print-this-file', -;; `diredp-relsymlink-this-file', -;; `diredp-remove-all-tags-this-file', `diredp-rename-this-file', -;; `diredp-send-bug-report', -;; `diredp-set-bookmark-file-bookmark-for-marked', -;; `diredp-set-bookmark-file-bookmark-for-marked-recursive', -;; `diredp-set-tag-value-this-file', -;; `diredp-shell-command-this-file', `diredp-show-metadata', -;; `diredp-show-metadata-for-marked', `diredp-sign-this-file', -;; `diredp-symlink-this-file', `diredp-tag-this-file', -;; `diredp-toggle-find-file-reuse-dir', -;; `diredp-toggle-marks-in-region', `diredp-touch-this-file', -;; `diredp-unmark-all-files-recursive' (Emacs 22+), -;; `diredp-unmark-all-marks-recursive' (Emacs 22+), -;; `diredp-unmark-autofiles', `diredp-unmark-files-tagged-all', -;; `diredp-unmark-files-tagged-none', -;; `diredp-unmark-files-tagged-not-all', -;; `diredp-unmark-files-tagged-some', `diredp-unmark-region-files', -;; `diredp-untag-this-file', `diredp-upcase-recursive', -;; `diredp-up-directory', `diredp-up-directory-reuse-dir-buffer', -;; `diredp-upcase-this-file', `diredp-verify-this-file', -;; `diredp-visit-next-file', `diredp-visit-previous-file', -;; `diredp-visit-this-file', `diredp-w32-drives', -;; `diredp-w32-drives-mode', `diredp-yank-files', -;; `global-dired-hide-details-mode' (Emacs 24.4+), -;; `toggle-diredp-find-file-reuse-dir'. -;; -;; User options defined here: -;; -;; `diredp-auto-focus-frame-for-thumbnail-tooltip-flag', -;; `diredp-bind-problematic-terminal-keys', -;; `diredp-compressed-extensions', `diredp-count-.-and-..-flag' -;; (Emacs 22+), `diredp-do-report-echo-limit', -;; `diredp-dwim-any-frame-flag' (Emacs 22+), -;; `diredp-image-preview-in-tooltip', `diff-switches', -;; `diredp-hide-details-initially-flag' (Emacs 24.4+), -;; `diredp-highlight-autofiles-mode', -;; `diredp-hide-details-propagate-flag' (Emacs 24.4+), -;; `diredp-ignore-compressed-flag', -;; `diredp-image-show-this-file-use-frame-flag' (Emacs 22+), -;; `diredp-list-file-attributes', `diredp-max-frames', -;; `diredp-move-file-dirs' (Emacs 24+), `diredp-omit-files-regexp' -;; `diredp-prompt-for-bookmark-prefix-flag', -;; `diredp-visit-ignore-extensions', `diredp-visit-ignore-regexps', -;; `diredp-w32-local-drives', `diredp-wrap-around-flag'. -;; -;; Non-interactive functions defined here: -;; -;; `derived-mode-p' (Emacs < 22), `diredp-all-files', -;; `diredp-ancestor-dirs', `diredp-apply-function-to-file-name', -;; `diredp-bookmark', -;; `diredp-create-files-non-directory-recursive', -;; `diredp-delete-dups', `diredp-delete-if', -;; `diredp-delete-if-not', `diredp-directories-within', -;; `diredp-dired-plus-description', -;; `diredp-dired-plus-description+links', -;; `diredp-dired-plus-help-link', `diredp-dired-union-1', -;; `diredp-dired-union-interactive-spec', `diredp-display-image' -;; (Emacs 22+), `diredp-do-chxxx-recursive', -;; `diredp-do-create-files-recursive', `diredp-do-grep-1', -;; `diredp-ensure-bookmark+', `diredp-ensure-mode', -;; `diredp-eval-lisp-sexp' (Emacs 22+), -;; `diredp-existing-dired-buffer-p', `diredp-fewer-than-2-files-p', -;; `diredp-fewer-than-echo-limit-files-p', -;; `diredp-fewer-than-N-files-p', `diredp-fileset-1', -;; `diredp-find-a-file-read-args', -;; `diredp-file-for-compilation-hit-at-point' (Emacs 24+), -;; `diredp-files-within', `diredp-files-within-1', -;; `diredp-fit-frame-unless-buffer-narrowed' (Emacs 24.4+), -;; `diredp-get-confirmation-recursive', `diredp-get-files', -;; `diredp-get-files-for-dir', `diredp-get-subdirs', -;; `diredp-hide-details-if-dired' (Emacs 24.4+), -;; `diredp-hide/show-details' (Emacs 24.4+), -;; `diredp-highlight-autofiles', `diredp-image-dired-required-msg', -;; `diredp-get-image-filename', `diredp-internal-do-deletions', -;; `diredp-invoke-emacs-command', `diredp-invoke-function-no-args', -;; `diredp-list-file', `diredp-list-files', `diredp-looking-at-p', -;; `diredp-make-find-file-keys-reuse-dirs', -;; `diredp-make-find-file-keys-not-reuse-dirs', `diredp-maplist', -;; `diredp-map-over-marks-and-report', `diredp-marked-here', -;; `diredp-mark-files-tagged-all/none', -;; `diredp-mark-files-tagged-some/not-all', -;; `diredp-nonempty-region-p', `diredp-parent-dir', -;; `diredp-paste-add-tags', `diredp-paste-replace-tags', -;; `diredp-read-bookmark-file-args', `diredp-read-command', -;; `diredp-read-expression' (Emacs 22+), -;; `diredp-read-include/exclude', `diredp-read-regexp', -;; `diredp-recent-dirs', `diredp-refontify-buffer', -;; `diredp-remove-if', `diredp-remove-if-not', -;; `diredp-report-file-result', `diredp--reuse-dir-buffer-helper', -;; `diredp-root-directory-p', `diredp-set-header-line-breadcrumbs' -;; (Emacs 22+), `diredp-set-tag-value', `diredp-set-union', -;; `diredp--set-up-font-locking', `diredp-string-match-p', -;; `diredp-tag', `diredp-this-file-marked-p', -;; `diredp-this-file-unmarked-p', `diredp-this-subdir', -;; `diredp-untag', `diredp-visit-ignore-regexp', -;; `diredp-y-or-n-files-p'. -;; -;; Variables defined here: -;; -;; `diredp-bookmark-menu', `diredp-file-line-overlay', -;; `diredp-files-within-dirs-done', `diredp-font-lock-keywords-1', -;; `diredp-hide-details-last-state' (Emacs 24.4+), -;; `diredp-hide-details-toggled' (Emacs 24.4+), -;; `diredp-hide/show-menu', `diredp-images-recursive-menu', -;; `diredp-last-copied-filenames', `diredp-list-files-map', -;; `diredp-loaded-p', `diredp-marks-recursive-menu', -;; `diredp-menu-bar-dir-menu', `diredp-menu-bar-marks-menu', -;; `diredp-menu-bar-multiple-menu', `diredp-menu-bar-regexp-menu', -;; `diredp-menu-bar-single-menu', `diredp-multiple-bookmarks-menu', -;; `diredp-multiple-delete-menu', `diredp-multiple-dired-menu', -;; `diredp-multiple-images-menu', -;; `diredp-multiple-encryption-menu', -;; `diredp-multiple-move-copy-link-menu', -;; `diredp-multiple-omit-menu', `diredp-multiple-recursive-menu', -;; `diredp-multiple-rename-menu', `diredp-multiple-search-menu', -;; `diredp-navigate-menu', `diredp-regexp-recursive-menu', -;; `diredp-re-no-dot', `diredp-single-bookmarks-menu', -;; `diredp-single-encryption-menu', `diredp-single-image-menu', -;; `diredp-single-move-copy-link-menu', `diredp-single-open-menu', -;; `diredp-single-rename-menu', `diredp-w32-drives-mode-map'. -;; -;; Macros defined here: -;; -;; `diredp-mark-if', `diredp-user-error', -;; `diredp-with-help-window'. -;; -;; -;; ***** NOTE: The following macros defined in `dired.el' have -;; been REDEFINED HERE: -;; -;; `dired-map-over-marks' - Treat multiple `C-u' specially. -;; -;; -;; ***** NOTE: The following functions defined in `dired.el' have -;; been REDEFINED or ADVISED HERE: -;; -;; `dired' - Handle non-positive prefix arg. -;; `dired-do-delete' - Display message to warn that marked, -;; not flagged, files will be deleted. -;; `dired-do-flagged-delete' - Display message to warn that flagged, -;; not marked, files will be deleted. -;; `dired-dwim-target-directory' - Uses `diredp-dwim-any-frame-flag'. -;; `dired-find-file' - Allow `.' and `..' (Emacs 20 only). -;; `dired-get-filename' - Test `./' and `../' (like `.', `..'). -;; `dired-get-marked-files' - Can include `.' and `..'. -;; Allow FILTER + DISTINGUISH-ONE-MARKED. -;; `dired-goto-file' - Fix Emacs bug #7126. -;; Remove `/' from dir before compare. -;; (Emacs < 24 only.) -;; `dired-hide-details-mode' - Respect new user options: -;; * `diredp-hide-details-initially-flag' -;; * `diredp-hide-details-propagate-flag' -;; (Emacs 24.4+) -;; `dired-insert-directory' - Compute WILDCARD arg for -;; `insert-directory' for individual file -;; (don't just use nil). (Emacs 23+, and -;; only for MS Windows) -;; `dired-insert-set-properties' - `mouse-face' on whole line. -;; `dired-flag-auto-save-files', `dired-mark-directories', -;; `dired-mark-executables', `dired-mark-files-containing-regexp', -;; `dired-mark-files-regexp', `dired-mark-symlinks' -;; - Use `diredp-mark-if', not `dired-mark-if'. -;; `dired-mark-files-regexp' - Add regexp to `regexp-search-ring'. -;; More matching possibilities. -;; Added optional arg LOCALP. -;; `dired-mark-pop-up' - Delete the window or frame popped up, -;; afterward, and bury its buffer. Do not -;; show a menu bar for pop-up frame. -;; `dired-other-frame' - Handle non-positive prefix arg. -;; `dired-other-window' - Handle non-positive prefix arg. -;; `dired-pop-to-buffer' - Put window point at bob (bug #12281). -;; (Emacs 22-24.1) -;; `dired-read-dir-and-switches' - Non-positive prefix arg behavior. -;; -;;; NOT YET: -;;; ;; `dired-readin-insert' - Use t as WILDCARD arg to -;;; ;; `dired-insert-directory'. (Emacs 23+, -;;; ;; and only for MS Windows) -;; -;; `dired-revert' - Reset `mode-line-process' to nil. -;; `dired-switches-escape-p' - Made compatible with Emacs 20, 21. -;; -;; -;; ***** NOTE: The following functions are included here with little -;; or no change to their definitions. They are here to -;; take advantage of the new definition of macro -;; `dired-map-over-marks': -;; -;; `dired-do-redisplay', `dired-map-over-marks-check', -;; `image-dired-dired-insert-marked-thumbs', -;; `image-dired-dired-toggle-marked-thumbs'. -;; -;; -;; ***** NOTE: The following functions defined in `dired-aux.el' have -;; been REDEFINED HERE: -;; -;; `dired-do-byte-compile', `dired-do-compress', `dired-do-load' - -;; Redisplay only if at most one file is being treated. -;; `dired-do-find-regexp', `dired-do-find-regexp-and-replace' - -;; Prefix arg lets you act on files other than those marked. -;; `dired-do-isearch', `dired-do-isearch-regexp', -;; `dired-do-query-replace-regexp', `dired-do-search' - -;; Use new `dired-get-marked-files'. -;; `dired-insert-subdir-newpos' - If not a descendant, put at eob. -;; `dired-insert-subdir-validate' - Do nothing: no restrictions. -;; `dired-maybe-insert-subdir' - Go back to subdir line if in listing. -;; `dired-handle-overwrite' - Added optional arg FROM, for listing. -;; `dired-copy-file(-recursive)', `dired-hardlink', `dired-query', -;; `dired-rename-file' - You can list (`l') the files involved. -;; -;; -;; ***** NOTE: The following functions defined in `dired-x.el' have -;; been REDEFINED HERE: -;; -;; `dired-copy-filename-as-kill' - -;; Put file names also in var `diredp-last-copied-filenames'. -;; `dired-do-find-marked-files' - -;; Call `dired-get-marked-files' with original ARG. -;; Added optional arg INTERACTIVEP - no error if nil and no files. -;; `dired-do-run-mail' - Require confirmation. -;; `dired-mark-sexp' - 1. Variable `s' -> `blks'. -;; 2. Fixes to `uid' and `gid'. -;; `dired-mark-unmarked-files' (Emacs < 24 only) - Emacs 24+ version. -;; `dired-simultaneous-find-file' - -;; Use separate frames instead of windows if `pop-up-frames' is -;; non-nil, or if prefix arg < 0. -;; -;; -;; ***** NOTE: (Emacs 20 only) The following variable defined in -;; `dired.el' has been REDEFINED HERE: -;; -;; `dired-move-to-filename-regexp' - Recognize file size in k etc. -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Change Log: -;; -;; 2019/07/03 dadams -;; dired-mark-unmarked-files: Apply fix for Emacs bug #27465. -;; diredp-mark-if, diredp-mark-sexp(-recursive), dired-mark-unmarked-files: -;; Use char-after, not diredp-looking-at-p. -;; 2019/07/19 dadams -;; diredp-change-marks-recursive, diredp-unmark-all-files-recursive, -;; diredp-mark-files(-containing)-regexp-recursive, diredp-mark-sexp-recursive, diredp-mark-recursive-1: -;; Added missing PREDICATE arg in calls to diredp-get-subdirs. -;; 2019/06/25 dadams -;; diredp-mark-if, diredp-this-file-(un)marked-p: Use regexp-quote for marker char. -;; 2019/06/03 dadams -;; Removed autoload cookie for diredp-omit-files-regexp - it evaluates dired-omit-files, from dired-x.el. -;; Hard-require dired-x.el. (No reason not to.) Removed fboundp guards for it. -;; 2019/04/22 dadams -;; Added diredp-move-files-named-in-kill-ring. Bound to C-w. -;; 2019/04/21 dadams -;; Added redefinitions of dired-do-find-regexp, dired-do-find-regexp-and-replace. -;; diredp-multiple-search-menu: Added "Using TAGS Table" for dired-do-(query-replace|search). -;; 2019/04/20 dadams -;; Added: -;; diredp-map-over-marks-and-report, diredp-do-emacs-command, diredp-invoke-emacs-command, -;; diredp-read-command, diredp-do-lisp-sexp, diredp-eval-lisp-sexp, diredp-report-file-result, -;; diredp-do-report-echo-limit, diredp-fewer-than-N-files-p, diredp-fewer-than-echo-limit-files-p, -;; diredp-apply-function-to-file-name, diredp-invoke-function-no-args, diredp-list-file-attributes. -;; diredp-do-apply-function: Redefine to use diredp-map-over-marks-and-report. -;; diredp-dired-plus-description, diredp-menu-bar-multiple-menu: -;; Added diredp-do-emacs-command, diredp-do-lisp-sexp. -;; diredp-menu-bar-multiple-menu: Reordered items. -;; diredp-list-marked, diredp-*-recursive, diredp-describe-marked-autofiles: -;; Use diredp-list-file-attributes for DETAILS arg interactively. -;; diredp-yank-files, dired-query: Use diredp-list-file-attributes, not harcoded list (5 8). -;; diredp-set-bookmark-file-bookmark-for-marked-recursive: Corrected interactive spec. -;; 2019/04/16 dadams -;; Added: diredp-delete-if. -;; dired-map-over-marks-check: Added &rest argument FUN-ARGS, so FUN can accept arguments. -;; 2019/04/12 dadams -;; dired-get-marked-files: Do not add t to RESULT. Thx to Jeff Spencer for bug report. -;; If all marked is (t) for some reason reset it to nil, per vanilla Emacs 24+. -;; diredp-compressed-extensions: Added .rar, .rev. -;; 2019/04/10 dadams -;; Added diredp-read-expression (forgot it when added diredp-mark-sexp-recursive). -;; diredp-mark-sexp-recursive is thus only for Emacs 22+. -;; 2019/03/20 dadams -;; Added option diredp-omit-files-regexp. -;; Face diredp-omit-file-name: Added strike-through. -;; diredp-font-lock-keywords-1, for face diredp-omit-file-name: -;; Move to file name. Use diredp-omit-files-regexp. Append * for executable flag. Highlight whole line. -;; 2019/03/17 dadams -;; diredp-font-lock-keywords-1: -;; Use just dired-omit-files as regexp - its components already have ^...$. -;; Removed superfluous execute *'s in regexps and superfluous concat for compressed extensions. -;; Face diredp-omit-file-name: Removed :strike-through for default value. -;; 2019/03/16 dadms -;; Added face diredp-omit-file-name. -;; diredp-font-lock-keywords-1: Use face diredp-omit-file-name for dired-omit-files matches. -;; 2019/03/15 dadams -;; diredp-font-lock-keywords-1: Treat dired-omit-files like dired-omit-extensions. -;; 2019/01/27 dadams -;; Added: diredp-mark-files-containing-regexp-recursive. -;; Bound to M-+ % g. Added to diredp-marks-recursive-menu, diredp-regexp-recursive-menu. -;; 2019/01/17 dadams -;; Added: diredp-mark-sexp-recursive. Bound to M-+ M-(, M-+ * (. Added to diredp-marks-recursive-menu. -;; dired-query: Use dired-query-alist only when available. -;; diredp-move-file: Fix format string in error call. -;; diredp-mark-symlinks-recursive: Added missing DETAILS arg for diredp-mark-recursive-1. -;; 2019/01/01 dadams -;; Added: diredp-list-file. -;; Added redefinitions of dired-query, dired-handle-overwrite, dired-copy-file(-recursive), dired-rename-file, -;; dired-hardlink. -;; Added optional arg DETAILS to these functions: diredp-get-(subdirs|files), diredp-y-or-n-files-p, -;; diredp-list-(marked|files), diredp-yank-files, diredp-describe-marked-autofiles, plus all functions with -;; "recursive" in their name except diredp-get-confirmation-recursive. -;; Added optional arg DETAILS. -;; diredp-get-(subdirs|files), diredp-y-or-n-files-p, diredp-list-(marked|files), diredp-yank-files, -;; diredp-describe-marked-autofiles: -;; Added optional arg DETAILS. -;; diredp-list-files: Use dired-list-file, to optionally show details. -;; diredp-yank-files: Non-positive prefix arg shows details now. -;; 2018/12/02 dadams -;; dired-mark-pop-up: Work around Emacs 22 bug in dired-pop-to-buffer which can exit in Dired buffer. -;; 2018/10/17 dadams -;; dired-read-dir-and-switches: Removed mention of icicle-file-sort-first-time-p (no longer used in Icicles). -;; 2018/09/21 dadams -;; diredp-image-dired-edit-comment-and-tags, diredp-w32-drives: -;; Use pop-to-buffer-same-window, not switch-to-buffer. -;; 2018/09/14 dadams -;; Added: diredp-move-file-dirs, diredp-move-file. -;; 2018/06/30 dadams -;; Added: diredp-delete-if-not. -;; 2018/06/16 dadams -;; Added: diredp-visit-ignore-extensions, diredp-visit-ignore-regexps, diredp-visit-next-file, -;; diredp-visit-previous-file, diredp-visit-this-file, diredp-visit-ignore-regexp. -;; Bind the commands to C-down, C-up, e. -;; 2018/03/25 dadams -;; Added: diredp-user-error. -;; Updated for Emacs 27-pretest-2 change in dired-get-marked-files signature. -;; dired-get-marked-files: Added optional arg ERROR-IF-NONE-P. -;; diredp-list-marked, diredp-insert-subdirs, dired-do-(i)search(-regexp), dired-do-query-replace-regexp, -;; dired-do-find-marked-files, diredp-describe-marked-autofiles: -;; Added optional arg INTERACTIVEP. -;; Pass non-nil ERROR-IF-NONE-P to dired-get-marked-files when INTERACTIVEP. (See Emacs bug #30938.) -;; 2018/03/23 dadams -;; Added diredp-mark-if. Removed: redefinition of dired-mark-if. -;; Differences: msg and return value include both number of matches and number of changes. -;; Added redefinitions (use diredp-mark-if) of dired-flag-auto-save-files, -;; dired-mark-(files-containing-regexp|symlinks|directories|executables). -;; Everywhere: Use diredp-mark-if, not dired-mark-if. -;; 2018/03/03 dadams -;; diredp-delete-dups: defalias the symbol, not its symbol-function (dunno why I did the latter). -;; 2018/02/28 dadams -;; Added: diredp-last-copied-filenames, diredp-copy-abs-filenames-as-kill-recursive, -;; and redefinition of vanilla diredp-last-copied-filenames. -;; diredp-copy-abs-filenames-as-kill: Use diredp-ensure-mode in interactive spec. -;; diredp-copy-filename-as-kill-recursive: Update diredp-last-copied-filenames with filenames string. -;; diredp-yank-files: Require confirmation for pasting, using diredp-y-or-n-files-p. -;; Get file names from variable diredp-last-copied-filenames, not kill-ring. -;; Added NO-CONFIRM-P arg. -;; diredp-ensure-mode: Added doc string. -;; diredp-do-grep, diredp-do-grep-recursive: Changed bindings to C-M-G and M-+ C-M-G, due to M-g conflict. -;; 2018/02/27 dadams -;; Added: diredp-copy-abs-filenames-as-kill, diredp-yank-files (aka diredp-paste-files) (bound to C-y). -;; diredp-menu-bar-multiple-menu: Added diredp-copy-abs-filenames-as-kill. -;; diredp-menu-bar-dir-menu: Added diredp-yank-files. -;; 2018/01/11 dadams -;; diredp-get-files: -;; Set IGNORE-MARKS-P to non-nil if nothing marked here. (It was not getting all if nothing marked.) -;; diredp-marked-recursive(-other-window): -;; Corrected interactive spec, which was missing nil DIRNAME arg. Corrected body: use DIRNAME. -;; diredp-get-files-for-dir, diredp-do-bookmark-dirs-recursive, diredp-change-marks-recursive, -;; diredp-unmark-all-files-recursive, diredp-mark-files-regexp-recursive, diredp-mark-recursive-1, -;; diredp-do-delete-recursive: -;; Factor out (dired-buffers-for-dir (expand-file-name directory)). -;; 2018/01/03 dadams -;; dired-mark-files-regexp: Corrected doc string wrt prefix args. Thx to John Mastro. -;; diredp-do-grep-recursive: Removed unused optional arg IGNORE-MARKS-P. -;; diredp-marked-recursive(-other-window): Moved handling of optional arg from interactive spec to body. -;; 2018/01/02 dadams -;; Added: diredp-flag-auto-save-files-recursive. Bound to M-+ #. -;; diredp-get-file-or-dir-name, diredp-marked-here: Doubled backslashes to escape dots. -;; diredp-marked-here: Fixed regexp to match only double-dot, not single-dot. -;; diredp-flag-auto-save-files-recursive: Updated to include more M-+ keys. -;; diredp-marks-recursive-menu: Added diredp-flag-auto-save-files-recursive. -;; 2017/12/31 dadams -;; diredp-get-files-for-dir: Pass non-nil NO-DOT-DOT-P arg to diredp-marked-here. -;; dired-get-marked-files: Allow use of FILTER and DISTINGUISH-ONE-MARKED together. -;; diredp-marked-here: Added optional arg NO-DOT-DOT-P. -;; diredp-change-marks-recursive, diredp-unmark-all-files-recursive: Removed unused vars include-dirs, files. -;; 2017/12/30 dadams -;; Added: diredp-change-marks-recursive, diredp-unmark-all-files-recursive, diredp-unmark-all-marks-recursive. -;; Bound to M-+ * c, M-+ M-DEL, M-+ U, respectively. -;; diredp-menu-bar-marks-menu: Rename item Change Marks to Change Mark. -;; diredp-marks-recursive-menu, diredp-multiple-recursive-menu: -;; Added diredp-change-marks-recursive, diredp-unmark-all-(files|marks)-recursive. -;; 2017/12/21 dadams -;; Added: diredp-mark-recursive-1. Forgot to add it last June. -;; 2017/12/17 dadams -;; Removed: diredp-display-graphic-p. -;; Do not use diredp-display-graphic-p to allow binding diredp-bind-problematic-terminal-keys by default. -;; 2017/11/25 dadams -;; diredp-nb-marked-in-mode-name: Wrap last :eval sexp in save-excursion. -;; Protect Call dired-current-directory only when dired-subdir-alist. -;; 2017/10/23 dadams -;; Added: diredp-count-.-and-..-flag, diredp--reuse-dir-buffer-helper. -;; Removed: diredp-mouse-find-file. -;; diredp-find-file-reuse-dir-buffer, diredp-mouse-find-file-reuse-dir-buffer, -;; diredp-up-directory-reuse-dir-buffer: -;; Use diredp--reuse-dir-buffer-helper. -;; diredp-find-file-reuse-dir-buffer: Changed logic: do find-alternate-file only if target is a dir not in -;; Dired and current Dired buffer is in only this window. -;; diredp-mouse-find-file-reuse-dir-buffer: Added optional args FIND-FILE-FUNC and FIND-DIR-FUNC. -;; diredp-up-directory, diredp-up-directory-reuse-dir-buffer: Pass OTHER-WINDOW arg to diredp-w32-drives. -;; diredp-nb-marked-in-mode-name: Show also number of lines in current listing, and listing-relative lineno, -;; respecting diredp-count-.-and-..-flag. -;; diredp-find-a-file*: Added autoload cookies. -;; 2017/08/18 dadams -;; Fixed emacswiki URLs everywhere. They changed the locations and changed http to https. -;; 2017/06/30 dadams -;; Added: diredp-bind-problematic-terminal-keys, diredp-display-graphic-p. -;; Guard bindings of problematic keys with diredp-display-graphic-p & diredp-bind-problematic-terminal-keys. -;; Documented problematic keys for terminal mode in commentary. -;; 2017/06/23 dadams -;; Added: diredp-read-regexp (removed alias to read-regexp), diredp-marks-recursive-menu, -;; diredp-mark-executables-recursive (bound to M-+ * *), -;; diredp-mark-directories-recursive (bound to M-+ * /), -;; diredp-mark-extension-recursive (bound to M-+ * .), -;; diredp-mark-autofiles-recursive (bound to M-+ * B), -;; diredp-mark-executables-recursive (bound to M-+ * *), -;; diredp-mark-directories-recursive (bound to M-+ * /), -;; diredp-mark-symlinks-recursive (bound to M-+ * @), -;; Bind diredp-mark-autofiles to * B. -;; diredp-marked-here: Bind dired-marker-char to ?*. -;; diredp-mark-files-regexp-recursive: Better msgs - show total count. -;; Everywhere: Use diredp-looking-at, not looking-at. Use diredp-read-regexp, not dired-read-regexp. -;; 2017/05/30 dadams -;; Fixed typo: direp--set-up-font-locking -> diredp--set-up-font-locking. -;; 2017/05/22 dadams -;; Added: direp--set-up-font-locking. -;; Use direp--set-up-font-locking instead of lambda in dired-mode-hook. -;; 2017/04/09 dadams -;; Version 2017.04.09. -;; Added: diredp-multiple-move-copy-link-menu, diredp-multiple-rename-menu, diredp-multiple-dired-menu, -;; diredp-multiple-omit-menu, diredp-multiple-delete-menu, diredp-single-bookmarks-menu, -;; diredp-single-encryption-menu, diredp-single-image-menu, diredp-single-open-menu, -;; diredp-single-move-copy-link-menu, diredp-single-rename-menu. -;; Moved single menu items there. -;; Renamed: diredp-menu-bar-encryption-menu to diredp-multiple-encryption-menu, -;; diredp-menu-bar-mark-menu to diredp-menu-bar-marks-menu, -;; diredp-menu-bar-operate-menu to diredp-menu-bar-multiple-menu, -;; diredp-menu-bar-operate-bookmarks-menu to diredp-multiple-bookmarks-menu, -;; diredp-menu-bar-operate-recursive-menu to diredp-multiple-recursive-menu, -;; diredp-menu-bar-operate-search-menu to diredp-multiple-search-menu, -;; diredp-menu-bar-images-menu to diredp-multiple-images-menu, -;; diredp-menu-bar-images-recursive-menu to diredp-images-recursive-menu, -;; diredp-menu-bar-immediate-menu to diredp-menu-bar-single-menu, -;; diredp-menu-bar-regexp-recursive-menu to diredp-regexp-recursive-menu, -;; diredp-menu-bar-subdir-menu to diredp-menu-bar-dir-menu. -;; Added dired-do-rename to diredp-multiple-rename-menu. -;; diredp-nonempty-region-p: Ensure (mark) also. -;; 2017/03/30 dadams -;; Moved key bindings to end of file. Moved defgroup before defcustoms. -;; Bind dired-multiple-w32-browser to C-M-RET, diredp-multiple-w32-browser-recursive to M-+ C-M-RET. -;; 2017/03/29 dadams -;; Added: diredp-dired-union-other-window, diredp-add-to-dired-buffer-other-window. -;; diredp-dired-union-1: Added optional arg OTHERWIN. -;; diredp-dired-plus-description: Updated doc string. -;; diredp-menu-bar-subdir-menu: Added diredp-dired-for-files. -;; Bind diredp-w32-drives to :/, diredp-dired-inserted-subdirs to C-M-i. -;; Bind diredp-add-to-dired-buffer to C-x D A (not C-x E), diredp-dired-union to C-x D U (not C-x D), -;; diredp-fileset to C-x D S (not C-M-f), diredp-dired-recent-dirs to C-x D R (not C-x R), -;; diredp-dired-for-files to C-x D F, plus other-window versions. -;; 2017/03/24 dadams -;; Added defalias for dired-read-regexp. -;; diredp-mouse-3-menu: Removed second arg to mouse-save-then-kill. -;; 2017/02/20 dadams -;; diredp-(next|previous)-line, diredp-(next|prev)-dirline, diredp-(next|prev)-subdir: -;; Update interactive spec to use (in effect) ^p for prefix arg (for shift-select-mode). -;; 2017/01/12 dadams -;; dired-mark-files-regexp: Swapped prefix-arg behavior for relative and absolute name matching. -;; 2017/01/01 dadams -;; dired-mark-files-regexp: Fix to prompt for no prefix arg. -;; 2016/12/28 dadams -;; dired-mark-files-regexp: Corrected prompt string for Mark/UNmark. Thx to Tino Calancha. -;; 2016/11/20 dadams -;; diredp-menu-bar-operate-search-menu: Added dired-do-find-regexp and dired-do-find-regexp-and-replace. -;; Bind dired-do-search to M-a and dired-do-query(-replace)-regexp to M-q. -;; diredp-dired-plus-description: Added dired-do-find-regexp and dired-do-find-regexp-and-replace. -;; 2016/10/12 dadams -;; diredp-compressed-extensions: Added extensions .xz and .lzma. Thx to xuhdev (https://www.topbug.net/). -;; 2016/09/20 dadams -;; Emacs 25.1: Bind M-z to dired-do-compress-to (replaces c). (Emacs bug #24484.) -;; diredp-menu-bar-operate-menu: Added item: Compress to (dired-do-compress-to). -;; 2016/09/15 dadams -;; Added: diredp-max-frames. -;; dired-do-find-marked-files: Pass non-nil ARG to dired-get-marked-files only if it is a cons. -;; Clarified doc string wrt prefix arg. -;; dired-simultaneous-find-file: Require confirmation if more files than diredp-max-frames. -;; diredp-do-find-marked-files-recursive: Clarified doc string wrt prefix arg. -;; Thx to Tino Calancha. -;; 2016/09/14 dadams -;; diredp-dired-plus-description: Added entry for dired-hide-details-mode - ( key. -;; 2016/08/26 dadams -;; diredp-y-or-n-files-p: pop-to-buffer only when the buffer was created. -;; Update wrt vanilla (scroll actions). -;; diredp-do-query-replace-regexp-recursive: -;; Call diredp-get-confirmation-recursive. -;; Use only diredp-get-files, not dired-get-marked-files. -;; Non-positive prefix arg means DELIMITED. -;; 2016/08/08 dadams -;; diredp-menu-bar-mark-menu: -;; Added: dired-mark-files-containing-regexp, dired-mark-sexp, image-dired-mark-tagged-files, -;; 2016/05/28 dadams -;; diredp-mark-files-regexp-recursive: Use nil for dired-get-filename LOCALP arg. -;; dired-mark-files-regexp: Corrected doc string: absolute filename matching by default. -;; 2016/05/24 dadams -;; dired-mark-files-regexp: Added optional arg LOCALP, so can mark/unmark matching different file-name forms. -;; 2016/05/15 dadams -;; Added: diredp-bookmark-menu, diredp-hide/show-menu, diredp-navigate-menu. -;; Move insert after revert and rename it to Insert/Move-To This Subdir. Move create-directory before revert. -;; 2016/04/29 dadams -;; diredp-next-line: Respect goal-column. -;; 2016/01/24 dadams -;; Added: diredp-ensure-bookmark+, diredp-mark-autofiles, diredp-unmark-autofiles, -;; diredp-mark/unmark-autofiles, diredp-describe-autofile, diredp-show-metadata, -;; diredp-mouse-describe-autofile, diredp-describe-marked-autofiles, diredp-show-metadata-for-marked -;; Soft-require help-fns+.el (Emacs 22+) or help+20.el (Emacs 20-21). -;; Add to menu-bar menus: -;; diredp-(un)mark-autofiles, diredp-describe-autofile, diredp-describe-marked-autofiles. -;; diredp-menu-bar-immediate-menu: Add diredp-describe-file only if defined. -;; Bind diredp-describe-file to keys only if defined. -;; Use diredp-ensure-bookmark+ everywhere, instead of its definition. -;; diredp(-mouse)-describe-file: Define only if describe-file is defined. Removed raising error if not. -;; diredp-mouse-3-menu: Use diredp-describe-autofile if diredp-describe-file is not defined. -;; diredp-dired-plus-description: Add diredp-mouse-describe-autofile, when bound. -;; dired-mark-if: Do not count non-changes. -;; 2015/12/15 dadams -;; diredp-font-lock-keywords-1: Follow # with optional [/ ], for face diredp-number. Thx to Tino Calancha. -;; 2015/11/10 dadams -;; diredp-fileset(-other-window): Separate error msgs for unloaded filesets.el and empty filesets-data. -;; 2015/10/02 dadams -;; dired-mark-sexp: Like vanilla, skip extended attributes marker before setting NLINK. Thx to Tino Calancha. -;; 2015/09/29 dadams -;; diredp-delete-this-file: Redefined to use delete-file instead of dired-do-delete. -;; 2015/09/07 dadams -;; diredp-font-lock-keywords-1: Do not test diredp-ignore-compressed-flag when highlighting file names. -;; Use separate entries for compressed and non-compressed file names. -;; Added missing \\| before ignored compressed extensions. -;; 2015/09/06 dadams -;; diredp-compressed-extensions: Added .tgz. Removed duplicate .gz. -;; diredp-font-lock-keywords-1: Use regexp-opt where possible, instead of mapcar regexp-quote. -;; 2015/09/05 dadams -;; Added: diredp-compressed-extensions, diredp-ignore-compressed-flag, diredp-compressed-file-name, -;; diredp-dir-name. -;; diredp-font-lock-keywords-1: -;; Allow spaces in symlink names. Highlight compressed-file names, if diredp-ignore-compressed-flag. -;; Use diredp-compressed-extensions instead of hardcoding extensions. -;; Highlight d with diredp-dir-priv (fix). -;; Treat l in third column the same as - and d there. -;; Highlight whole line for D-flagged files, with face diredp-deletion-file-name. -;; Thx to Nick Helm. -;; 2015/08/30 dadams -;; dired-mark-sexp: Updated per Emacs 25 code. -;; 2015/07/30 dadams -;; diredp-fileset(-other-window): Changed key binding from C-x F to C-x C-M-f (conflicted with find-function). -;; 2015/06/24 dadams -;; Added: diredp-parent-dir, diredp-breadcrumbs-in-header-line-mode, diredp-set-header-line-breadcrumbs. -;; 2015/06/06 dadams -;; Added dired-other-(frame|window). -;; diredp-font-lock-keywords-1: -;; Use dired-re-maybe-mark and dired-re-inode-size for permission matchings and directory names. -;; dired(-other-(frame|window)) advice: -;; Add interactive spec, to handle arg <= 0 (broken by change to dired-read-dir-and-switches 2015/02/02). -;; diredp-dired-for-files: Typo: pass empy string. -;; 2015/06/05 dadams -;; Added: diredp-grepped-files-other-window as alias for diredp-compilation-files-other-window. -;; diredp-compilation-files-other-window: Added SWITCHES optional arg (prefix arg). -;; 2015/06/04 dadams -;; diredp-dired-for-files(-other-window): -;; Updated to fit change to dired-read-dir-and-switches made 2015/02/02: addition of READ-EXTRA-FILES-P. -;; Use prefix arg to prompt for switches. -;; 2015/05/31 dadams -;; Added: diredp-image-show-this-file,diredp-image-show-this-file-use-frame-flag, diredp-get-image-filename. -;; image-dired-dired-toggle-marked-thumbs, diredp-menu-bar-immediate-menu [image]: -;; Use diredp-get-image-filename. -;; Bound diredp-image-show-this-file to C-t I. -;; diredp-menu-bar-immediate-image-menu: Added diredp-image-show-this-file and dired-find-file. -;; Added autoload cookies for image commands. -;; 2015/04/16 dadams -;; Added: diredp-do-apply-function, diredp-do-apply-function-recursive. Added to menus. Bind to @, M-+ @. -;; dired-do-query-replace-regexp: Handle nil ARG properly. -;; 2015/03/26 dadams -;; Added: redefinitions of dired-do-isearch, dired-do-isearch-regexp, dired-do-query-replace-regexp, -;; dired-do-search, to handle multi-C-u. -;; Added: dired-nondirectory-p (Emacs 20), diredp-refontify-buffer. -;; dired-do-byte-compile, dired-do-load, : Corrected interactive spec, to treat more than two C-u as two. -;; dired-after-readin-hook: Add diredp-refontify-buffer. In particular, this ensures that reverting Dired -;; for a listing of explicit file names gets refontified. (Just turn-on-font-lock does not refontify.) -;; 2015/03/24 dadams -;; Added: diredp-compilation-files-other-window, diredp-file-for-compilation-hit-at-point. -;; 2015/03/06 dadams -;; Renamed: diredp-menu-bar-recursive-marked-menu to diredp-menu-bar-operate-recursive-menu. -;; Added: diredp-do-delete-recursive: M-+ D. Added to diredp-menu-bar-operate-recursive-menu. -;; Added: diredp-mark-files-regexp-recursive: M-+ % m. Added to diredp-menu-bar-regexp-recursive-menu. -;; 2015/03/04 dadams -;; Added: diredp-dwim-any-frame-flag, (redefinition of) dired-dwim-target-directory. -;; 2015/02/22 dadams -;; diredp-bookmark: Corrected for use without Bookmark+ - bookmark-store signature. -;; Pass correct value to bmkp-autofile-set for its MSG-P arg. -;; diredp-mouse-do-bookmark: Do not pass non-nil NO-MSG-P arg to diredp-bookmark. -;; 2015/02/03 dadams -;; Added: diredp-add-to-this-dired-buffer. -;; Removed: diredp-add-to-dired-buffer-other-window, diredp-dired-union-other-window. -;; diredp-dired-union-1: Removed optional arg OTHER-WINDOW-P. -;; diredp-menu-bar-subdir-menu: Added diredp-add-to-this-dired-buffer. -;; dired-read-dir-and-switches, diredp-dired-union-interactive-spec: -;; Added optional arg DIRED-BUFFER. If nil, use current buffer name as default when reading buffer name. -;; 2015/02/02 dadams -;; Added: diredp-add-to-dired-buffer, diredp-add-to-dired-buffer-other-window, diredp-set-union, -;; diredp-existing-dired-buffer-p. -;; Bind diredp-add-to-dired-buffer(-other-window) globally to C-x E, C-x 4 E. -;; diredp-dired-union(-other-window): -;; Added args DIRNAME and EXTRA. Pass them to diredp-dired-union-1. Moved "UNION" to *-interactive-spec. -;; Pass values for new args NO-DIRED-BUFS and READ-EXTRA-FILES-P to diredp-dired-union-interactive-spec. -;; diredp-dired-union-interactive-spec: -;; Added args NO-DIRED-BUFS and READ-EXTRA-FILES-P. Use (updated) dired-read-dir-and-switches. -;; Delete dead buffers from dired-buffers. Remove DIRNAME buffer as candidate. -;; Apply expand-file-name to default-directory. Return list of DIRNAME BUFS SWITCHES EXTRA-FILES. -;; diredp-dired-union-1: -;; Added args DIRED-NAME and EXTRA. -;; For existing Dired buffer whose dired-directory is a cons: -;; Include its current listing. Replace buffer with new one of same name, after deleting its window. -;; dired-read-dir-and-switches: -;; Added arg READ-EXTRA-FILES-P. -;; If chosen Dired buffer exists and is an ordinary listing then start out with its directory-files. -;; diredp-dired-union, diredp-fileset, diredp-dired-recent-dirs: Bind globally, not just in Dired mode. -;; 2015/01/30 dadams -;; dired-read-dir-and-switches: Remove any killed buffers from dired-buffers, before using for completion. -;; 2014/10/25 dadams -;; diredp-dired-union-interactive-spec: Typo: quote buffer-name-history. Pass other-window STRING. -;; diredp-dired-union-other-window: Pass other-window STRING. -;; dired-read-dir-and-switches: Include STRING for reading buffer name also. -;; dired (defadvice): Corrected doc string for prefix arg >= and <= 0. -;; 2014/10/15 dadams -;; diredp-hide-details-initially-flag: -;; Added :set, to ensure that diredp-hide-details-last-state is kept up-to-date. -;; 2014/09/28 dadams -;; Added: diredp-recent-dirs, diredp-read-include/exclude, diredp-root-directory-p, diredp-remove-if. -;; diredp-dired-recent-dirs(-other-window): Added optional ARG. Use diredp-recent-dirs. Pass SWITCHES. -;; dired-read-dir-and-switches: Use diredp-root-directory-p. -;; Bound diredp-dired-recent-dirs(-other-window) to C-x R and C-x 4 R. -;; Added diredp-dired-recent-dirs to Dir menu. -;; 2014/09/27 dadams -;; Added: diredp-dired-recent-dirs, diredp-dired-recent-dirs-other-window, diredp-delete-dups. -;; 2014/09/26 dadams -;; diredp-mouseover-help: dired-get-filename etc. has to be inside the save-excursion. -;; diredp-image-dired-create-thumb: Added FILE arg. Use numeric prefix arg as the new thumbnail size. -;; 2014/09/22 dadams -;; diredp-mouse-3-menu: Do not place overlay unless on a file/dir name (i.e., dired-get-filename). -;; 2014/09/15 dadams -;; dired-read-dir-and-switches: Made it (thus dired too) an Icicles multi-command. -;; dired (defadvice): Added doc about using it with Icicles. -;; 2014/09/14 dadams -;; Added: diredp-kill-this-tree. -;; Removed: diredp-dired-files(-other-window), diredp-dired-files-interactive-spec. -;; dired-read-dir-and-switches: -;; Based on diredp-dired-files-interactive-spec implementation now, but: -;; Moved unwind-protect outside call to list. completing-read, not read-string, for DIRBUF. -;; Do not allow inclusion of root directories. Protected icicle-sort-comparer with boundp. -;; dired-insert-subdir-validate: Make it a no-op. -;; dired advice (doc string): Mention wildcards, Icicles. -;; diredp-dired-for-files(-other-window): -;; Use dired-read-dir-and-switches and dired, not diredp-dired-files-interactive-spec and -;; diredp-dired-files. -;; diredp-menu-bar-immediate-menu, diredp-mouse-3-menu: -;; Added item for diredp-kill-this-tree. -;; Corrected visible condition: expand-file-name, so ~/ compares with its expansion. -;; diredp-font-lock-keywords-1: Include period (.) for diredp(-compressed)-file-suffix. -;; 2014/09/09 dadams -;; Added: dired-read-dir-and-switches. -;; Advise dired, for doc string. -;; dired-get-filename: Hack for Emacs 20-22, to expand ~/... -;; 2014/09/07 dadams -;; Added: redefinitions of dired-insert-subdir-newpos, dired-insert-subdir-validate. -;; 2014/07/26 dadams -;; diredp-do-find-marked-files-recursive: -;; Only ARG >= 0 ignores marks now. And ARG <= 0 means find but do not display. -;; 2014/07/13 dadams -;; diredp-mouseover-help: Wrap (goto-char pos) in save-excursion (Emacs bug #18011). -;; 2014/07/12 dadams -;; Faces diredp(-tagged)-autofile-name: Made paler/darker (less saturated). -;; Moved diredp-highlight-autofiles before diredp-highlight-autofiles-mode, so will be -;; defined for first revert. -;; diredp-mouse-3-menu: Renamed items Tag, Untag to Add Tags, Remove Tags. -;; diredp-dired-plus-description: Updated. -;; 2014/07/11 dadams -;; Added: diredp-highlight-autofiles-mode, diredp-highlight-autofiles, -;; diredp-autofile-name, diredp-tagged-autofile-name. -;; Soft-require bookmark+.el. Soft-require highlight.el if bookmark+.el is provided. -;; diredp-menu-bar-subdir-menu: Added item Toggle Autofile Highlighting. -;; Removed unused face: diredp-display-msg. -;; 2014/06/29 dadams -;; dired-get-marked-files, diredp-internal-do-deletions: -;; Remove nils from dired-map-over-marks result. -;; 2014/05/28 dadams -;; diredp-mode-line-marked: Use DarkViolet for both light and dark background modes. -;; 2014/05/23 dadams -;; Added: diredp-with-help-window. -;; diredp-list-files, diredp-dired-plus-help: -;; Use diredp-with-help-window, not with-output-to-temp-buffer. See Emacs bug #17109. -;; 2014/05/06 dadams -;; Added: diredp-image-dired-required-msg, diredp-list-files-map, -;; diredp-find-line-file-other-window, diredp-mouse-find-line-file-other-window, -;; image-dired-dired-toggle-marked-thumbs, diredp-list-marked. -;; Soft-require image-dired.el and image-file.el. -;; diredp-image-dired-create-thumb: Define unconditionally. -;; image-dired-dired-insert-marked-thumbs, diredp-image-dired-comment-file, -;; diredp-image-dired-tag-file, diredp-image-dired-delete-tag, -;; diredp-image-dired-display-thumb, diredp-image-dired-copy-with-exif-name, -;; diredp-image-dired-edit-comment-and-tags, diredp-do-display-images: -;; Define unconditionally and raise error if no image-(dired|file).el. -;; diredp-menu-bar-immediate-image-menu, diredp-menu-bar-images-menu, -;; diredp-menu-bar-images-recursive-menu, image-dired-mark-tagged-files: -;; Define unconditionally and use :enable. -;; diredp-menu-bar-images-menu, diredp-menu-bar-images-recursive-menu: -;; Add defalias so can use menu-item with :enable. -;; diredp-list-files: Add properties mouse-face, keymap, and help-echo. -;; diredp-mouseover-help: Make it work also for diredp-list-files listings. -;; image-dired-dired-insert-marked-thumbs: Add autoload cookie. -;; dired-get-marked-files: Pass non-nil 2nd arg to dired-get-filename, to include . and .. . -;; Bind diredp-list-marked to C-M-l and diredp-list-marked-recursive to M+ C-M-l. -;; diredp-insert-subdirs: Exclude . and .., as dired-get-marked-files can now include them. -;; diredp-menu-bar-operate-menu: Add diredp-menu-bar-operate-menu to menu. -;; diredp-dired-plus-description: Mention diredp-list-marked*. -;; 2014/05/03 dadams -;; dired-switches-escape-p: Use dired-switches-check if available, based on bug #17218 fix. -;; 2014/04/25 dadams -;; diredp-image-dired-create-thumb: -;; Do not call diredp-image-dired-create-thumb twice: reuse THUMB-NAME. -;; 2014/04/24 dadams -;; Added: diredp-mouseover-help, diredp-auto-focus-frame-for-thumbnail-tooltip-flag, -;; diredp-image-preview-in-tooltip. -;; dired-insert-set-properties: Show image-file preview in tooltip. -;; diredp-image-dired-create-thumb: Return thumbnail file name or nil. -;; 2014/04/23 dadams -;; Added: diredp-looking-at-p. -;; dired-insert-set-properties: Applied fix for bug #17228. -;; 2014/04/05 dadams -;; Added: diredp-do-bookmark-dirs-recursive. -;; Renamed from bmkp-create-dired-bookmarks-recursive in bookmark+-1.el (removed). -;; Bound to M-B (aka M-S-b). -;; Added to menus *-subdir-menu, *-operate-bookmarks-menu, *-bookmarks-menu. -;; diredp-get-confirmation-recursive: Added optional TYPE arg. -;; diredp-insert-subdirs-recursive: Call diredp-get-confirmation-recursive with TYPE arg. -;; 2014/02/16 dadams -;; dired-pop-to-buffer: Do not redefine for Emacs > 24.1. -;; dired-mark-pop-up: Updated doc string. -;; 2014/02/13 dadams -;; Added: diredp-fileset-other-window, diredp-fileset-1. -;; diredp-fileset: Use diredp-fileset-1. -;; Bind diredp-dired-union(-other-window) to C-x D, C-x 4 D, -;; diredp-fileset(-other-window) to C-x F, C-x 4 F. -;; Use diredp-fileset-other-window, not diredp-fileset, in menu. -;; 2014/02/03 dadams -;; Added: diredp-hide-subdir-nomove. -;; Added: dired-goto-file for Emacs 24+ - open hidden parent dir, so can goto destination. -;; Replace bindings for dired-hide-subdir with diredp-hide-subdir-nomove. -;; Bind dired-hide-subdir to M-$ (not $). -;; 2014/02/02 dadams -;; dired-goto-file: Redefine only for Emacs < 24. -;; 2014/01/15 dadams -;; Bind diredp-toggle-find-file-reuse-dir to C-M-R (aka C-M-S-r). -;; 2014/01/05 dadams -;; Bind dired-omit-mode (aka dired-omit-toggle) to C-x M-o. -;; 2013/12/05 dadams -;; diredp-do-grep-1: Call grep-default-command with arg, if grep+.el is loaded. -;; 2013/11/05 dadams -;; Added: diredp-get-subdirs. -;; diredp-get-files, diredp-get-files-for-dir, diredp-marked-here: Added optional arg NIL-IF-NONE-P. -;; diredp-get-files: Pass INCLUDE-DIRS-P to diredp-files-within. -;; 2013/11/04 dadams -;; Renamed Bookmarks submenus to Bookmark. -;; Added Bookmark Dired Buffer to Dir menu. -;; Alias dired-toggle-marks to dired-do-toggle for Emacs 20, instead of backwards for others. -;; Use dired-toggle-marks everywhere instead of dired-do-toggle. -;; 2013/11/03 dadams -;; Created submenus of Multiple menu: Bookmarks, Search. -;; Created submenus of Multiple > Marked Here and Below menu: -;; Images, Encryption, Search, Bookmarks. -;; Reordered menus. -;; 2013/09/26 dadams -;; diredp-next-line: Use let*, so line-move sees let bindings. -;; 2013/08/11 dadams -;; diredp-dired-files-interactive-spec: -;; Protect icicle-file-sort with boundp. Thx to Vladimir Lomov. -;; 2013/08/06 dadams -;; diredp-display-image,diredp-menu-bar-immediate-image-menu (:enable's): -;; Protect diredp-string-match-p from nil argument. -;; 2013/07/24 dadams -;; Added: diredp-nonempty-region-p. Use everywhere, in place of its definition. -;; 2013/07/21 dadams -;; Added: diredp-image-dired-(comment-file|copy-with-exif-name|(create|display)-thumb| -;; delete-tag|edit-comment-and-tags|tag-file), -;; diredp-string-match-p, diredp-menu-bar-immediate-image-menu. -;; Put this-file image commands on new menu diredp-menu-bar-immediate-image-menu. -;; diredp-menu-bar-images-menu: Added diredp-do-display-images. -;; Use diredp-string-match-p instead of string-match where appropriate. -;; diredp-find-a-file-read-args: Removed #' from lambda. -;; 2013/07/19 dadams -;; Added redefinition of dired-hide-details-mode. -;; Added: diredp-hide-details-propagate-flag, diredp-hide-details-initially-flag, -;; diredp-hide-details-last-state, diredp-hide-details-toggled, -;; diredp-hide-details-if-dired, global-dired-hide-details-mode, -;; diredp-fit-frame-unless-buffer-narrowed, diredp-hide/show-details, -;; diredp-do-display-images, diredp-display-image. -;; On dired-after-readin-hook: diredp-hide/show-details. -;; On dired-hide-details-mode-hook: diredp-fit-frame-unless-buffer-narrowed. -;; diredp-maplist: Use diredp-maplist, not maplist, in recursive call. -;; diredp-next-line: Added bobp test for negative ARG. -;; Emacs 20 line-move returns nil, so use (progn ... t). -;; Soft-require autofit-frame.el. -;; 2013/07/18 dadams -;; diredp-next-line: Protect visible-p with fboundp for Emacs 20. -;; 2013/07/17 dadams -;; Added: diredp-menu-bar-encryption-menu, diredp-menu-bar-images-menu, -;; diredp-menu-bar-immediate-encryption-menu, -;; diredp-(decrypt|verify|sign|encrypt)-this-file. -;; Added diredp-(decrypt|verify|sign|encrypt)-this-file to *-immediate-encryption-menu. -;; Moved encryption and image-dired items to the new Multiple submenus from Multiple menu. -;; 2013/07/15 dadams -;; Added: diredp-async-shell-command-this-file, diredp-do-async-shell-command-recursive. -;; Added them to menus. Bind diredp-do-async-shell-command-recursive to M-+ &. -;; diredp-menu-bar-mark-menu, diredp-dired-plus-description: Added dired-mark-omitted. -;; diredp-menu-bar-subdir-menu: Added dired-omit-mode, dired-hide-details-mode. -;; diredp-menu-bar-regexp-menu: Added image-dired-mark-tagged-files. -;; diredp-menu-bar-subdir-menu: Added dired-hide-details-mode. -;; diredp-shell-command-this-file: Corrected: provide file list to dired-do-shell-command. -;; 2013/07/13 dadams -;; diredp-font-lock-keywords-1: -;; Ensure diredp-dir-priv is not used for directory header of d:/... (Windows drive name). -;; dired-insert-directory: -;; Update wrt Emacs 24.4: Do dired-insert-set-properties last; use saved CONTENT-POINT. -;; dired-insert-set-properties: Updated for Emacs 24.4, for dired-hide-details-mode. -;; Add frame-fitting to dired-hide-details-mode-hook. -;; dired-mouse-find-file(-other-window): Error msg if click off a file name. -;; 2013/07/12 dadams -;; Added: diredp-wrap-around-flag, diredp-(next|previous)-(subdir|(dir)line). -;; Renamed dired-up-directory to diredp-up-directory. -;; Replaced vanilla commands by these new commands everywhere. -;; 2013/07/11 dadams -;; Added: diredp-up-directory-reuse-dir-buffer. -;; diredp-make-find-file-keys(-not)-reuse-dirs: Added diredp-up-directory-reuse-dir-buffer. -;; 2013/02/06 dadams -;; dired-mark-pop-up: goto point-min, so show start of file list. Thx to Michael Heerdegen. -;; 2013/01/28 dadams -;; Added redefinition of dired-do-run-mail. Fixes Emacs bug #13561. -;; 2012/12/18 dadams -;; diredp-ediff: Better default for FILE2. Thx to Michael Heerdegen. -;; Require subr-21.el for Emacs 20. -;; 2012/11/17 dadams -;; Added: derived-mode-p (for Emacs < 22), diredp-ensure-mode. -;; Use diredp-ensure-mode everywhere for mode, so compatible with Sunrise Commander etc. -;; 2012/11/01 dadams -;; Do not require ediff.el. It is required in diredp-ediff itself. -;; 2012/10/06 dadams -;; Added: minibuffer-with-setup-hook for code byte-compiled using Emacs < 22. -;; 2012/09/28 dadams -;; Moved dired-*w32* bindings after normal mouse bindings, so they override them. -;; 2012/09/05 dadams -;; diredp-(rename|copy|(rel)symlink|hardlink)-this-file: Bind use-file-dialog to nil. -;; 2012/08/26 dadams -;; Set font-lock-defaults to a 3-element list, so it works with font-menus(-da).el. -;; 2012/08/25 dadams -;; Added: redefinition of dired-pop-to-buffer (fix for bug #12281). -;; dired-mark-pop-up: If buffer is shown in a separate frame, do not show menu bar. -;; 2012/07/10 dadams -;; Removed unneeded substitute-key-definition for (next|previous)-line. -;; 2012/07/09 dadams -;; Added redefinition of dired-mark-files-regexp: Push REGEXP onto regexp-search-ring. -;; 2012/06/21 dadams -;; diredp-nb-marked-in-mode-name: -;; Add marker numbers regardless of name match. -;; Use text property dired+-mode-name to tell whether mode-name was already changed. -;; 2012/06/20 dadams -;; Added: diredp-nb-marked-in-mode-name, diredp-mode-line-(flagged|marked). Added to hooks. -;; Thx to Michael Heerdegen. -;; 2012/06/14 dadams -;; dired-mark-pop-up: Wrap save-excursion around window/frame deletion. -;; dired-do-redisplay: Updated wrt Emacs 23: bind, (then run) dired-after-readin-hook. -;; diredp-y-or-n-files-p: Corrected construction of prompt wrt final SPC. -;; 2012/06/13 dadams -;; dired-buffers-for-dir: Updated wrt Emacs 23: -;; If dired-directory is a list then expand FILE in DIR & check whether in cdr of list. -;; diredp-get-files-for-dir, diredp-files-within-1, diredp-insert-as-subdir: -;; Expand dir name before passing it to dired-buffers-for-dir. -;; 2012/06/05 dadams -;; MS Windows: Just do not define commands that are inappropriate for Windows (instead of -;; defining them to raise an error or making them invisible in menus). -;; 2012/06/02 dadams -;; Added: diredp-do-(print|encrypt|decrypt|sign|verify)-recursive. Menus. Keys. -;; diredp-do-move-recursive: Corrected to use dired-rename-file, not dired-copy-file. -;; 2012/05/30 dadams -;; diredp-insert-as-subdir: Added optional arg IN-DIRED-NOW-P. Pick up markings & switches -;; from sole Dired buffer for CHILD if not in Dired now. -;; 2012/05/29 dadams -;; Added: diredp-do-(chxxx|chgrp|chown|touch)-recursive, diredp-touch-this-file, -;; diredp-menu-bar-(immediate|operate)-bookmarks-menu. Added to menus. Bound to keys. -;; Factored bookmark stuff into Bookmark(s) submenus. -;; diredp-menu-bar-immediate-menu: Added dired-kill-subdir, [goto-subdir]. -;; diredp-dired-this-subdir, dired-maybe-insert-subdir: Corrected :visible/enable. -;; diredp-dired-inserted-subdirs: Do dired-(remember-marks|mark-remembered) in this-buff. -;; diredp-mouse-3-menu: -;; Do not use save-excursion, because some commands move point on purpose. Just return to -;; original point unless command intends to MOVEP. -;; Added to menu dired-maybe-insert-subdir (two entries), dired-kill-subdir. -;; Use *-this-file*, not *-do-*: copy|symlink|shell-command|grep|load (don't use :keys). -;; 2012/05/26 dadams -;; diredp-dired-inserted-subdirs, diredp-insert-as-subdir: -;; Preserve markings and switches in target buffer. -;; dired-mark-pop-up: Use unwind-protect. Bury buffer too. -;; diredp-do-chmod-recursive: Use only 5 args if < Emacs 23. -;; 2012/05/25 dadams -;; Added: diredp-insert-as-subdir, diredp-ancestor-dirs, diredp-maplist, -;; diredp-do-redisplay-recursive, diredp-do-chmod-recursive. -;; Bound diredp-do-chmod-recursive. to M-+ M and added to menu. -;; diredp-get-files: Added optional arg DONT-ASKP. -;; diredp-y-or-n-files-p: Kill list buffer if it was never shown. -;; dired-mark-pop-up: ignore error when delete frame/window. -;; 2012/05/22 dadams -;; diredp-get-files(-for-dir): Added optional arg INCLUDE-DIRS-P. -;; Added: diredp-insert-subdirs(-recursive), diredp(-this)-dired-inserted-subdir(s). -;; Added to menus. Bound diredp-insert-subdirs* to (M-+) M-i. -;; Bound diredp-capitalize(-recursive) to (M-+) %c. -;; Added diredp-dired-union-other-window to Dirs menu. -;; Updated diredp-dired-plus-description. -;; 2012/05/19 dadams -;; Added: diredp-image-dired-*-recursive, diredp-*link-recursive, -;; diredp-do-isearch(-regexp)-recursive, diredp-do-query-replace-regexp-recursive, -;; diredp-do-search-recursive, diredp-(capitalize|(up|down)case)-recursive, -;; diredp-create-files-non-directory-recursive. -;; Bound on M-+ prefix key. Added to menus. -;; diredp-get-files, diredp-y-or-n-files-p, diredp-list-files, diredp-list-marked-recursive: -;; Added optional arg PREDICATE. -;; diredp-do-create-files-recursive: Removed MARKER-CHAR arg. Hard-code to keep markings. -;; diredp-do-(copy|move)-recursive: Use arg IGNORE-MARKS-P (forgot to use it). -;; Removed MARKER-CHAR arg in call to d-d-c-f-r. -;; Added missing autoload cookies. -;; 2012/05/06 dadsms -;; diredp-y-or-n-files-p: Do not kill buffer *Files* - just bury it. -;; 2012/05/05 dadams -;; Added: diredp-do-bookmark-recursive, diredp-do-bookmark-in-bookmark-file-recursive, -;; diredp-set-bookmark-file-bookmark-for-marked-recursive. -;; Bound to M-+ M-b, M-+ C-M-B (aka C-M-S-b), M-+ C-M-b, respectively. Added to menus. -;; diredp-bookmark: Added optional arg FILE. -;; diredp-do-bookmark-in-bookmark-file: Added optional arg FILES. -;; diredp-dired-plus-description: Updated. -;; diredp-get-confirmation-recursive: Raise error if not in Dired. -;; diredp-do-bookmark-recursive, diredp-marked-recursive(-other-window), -;; diredp-multiple-w32-browser-recursive: -;; Use diredp-get-confirmation-recursive. -;; 2012/05/04 dadams -;; Added: dired-mark-unmarked-files for Emacs < 24. -;; diredp-do-create-files-recursive: Corrected for Emacs < 24. -;; diredp-do-create-files-recursive, diredp-(un)mark-files-tagged-regexp, -;; diredp(-mouse)-do-(un)tag, diredp(-mouse)-do-remove-all-tags, -;; diredp(-mouse)-do-paste-(add|replace)-tags, diredp(-mouse)-do-set-tag-value, -;; diredp(-mouse)-do-bookmark(-in-bookmark-file), diredp-find-a-file-read-args, -;; diredp-mouse-do-shell-command: -;; Use lexical-let(*), to get closures for free vars in lambdas. -;; 2012/04/28 dadams -;; Added: -;; diredp-copy-filename-as-kill-recursive, diredp-do-copy-recursive, -;; diredp-do-find-marked-files-recursive, diredp-do-grep-recursive, -;; diredp-do-move-recursive, diredp-do-shell-command-recursive, -;; diredp-list-marked-recursive, diredp-marked-recursive(-other-window), -;; diredp-multiple-w32-browser-recursive, diredp-do-create-files-recursive, -;; diredp-get-confirmation-recursive, diredp-list-files, diredp-y-or-n-files-p, -;; diredp-menu-bar-recursive-marked-menu. -;; diredp-get-files: Use diredp-y-or-n-files-p, not y-or-n-p. -;; Commented out dired-readin-insert - see comment. -;; Moved bookmark menu items to submenu Bookmarks. -;; Added keys (with M-+ prefix) and menu items for new (*-recursive) commands. -;; Reordered w32-browser stuff in menus. -;; diredp-do-grep: Combined defs for diff Emacs versions - do version test at runtime. -;; 2012/04/25 dadams -;; dired-insert-directory: Updated per Emacs 24. -;; 2012/04/23 dadams -;; Added (moved here from Icicles, and renamed prefix): -;; diredp-re-no-dot, diredp-get-files, diredp-get-files-for-dir, diredp-files-within, -;; diredp-files-within-dirs-done. -;; 2012/04/05 dadams -;; Added redefinition of dired-mark-pop-up, to fix Emacs bug #7533. If they ever fix it -;; then remove this hack. -;; 2012/03/13 dadams -;; diredp-dired(-for)-files(-other-window): -;; Bind: icicle-sort-comparer, icicle-all-candidates-list-alt-action-fn. -;; Use icicle-(un)bind-file-candidate-keys. -;; diredp-dired-files-interactive-spec: Updated doc strings accordingly. -;; 2012/03/07 dadams -;; Added: dired-switches-escape-p. -;; dired-get-filename: Updated wrt Emacs 24: -;; whitespace quoting for bug #10469, filename quoting per Emacs 23.3+, -;; MS Windows conversion of \ to / per Emacs 23.3+. -;; dired-goto-file: Escape whitespace, per Emacs 24 (for bug #10469). -;; 2012/03/02 dadams -;; Require cl.el at compile time even for Emacs 22+, for case macro. -;; 2012/02/28 dadams -;; Do not bother to soft-require mkhtml.el anymore. -;; 2012/02/18 dadams -;; Swapped keys for dired-w32(-browser|explore), so the former is M-RET, as in Bookmark+. -;; 2012/01/10 dadams -;; diredp-font-lock-keywords-1: Corrected for date/time when locale is used, not iso. -;; 2011/12/19 dadams -;; dired-insert-set-properties, dired-mark-sexp, diredp-(un)mark-region-files, -;; diredp-flag-region-files-for-deletion, diredp-mouse-3-menu: -;; Use line-(beginning|end)-position. -;; 2011/12/16 dadams -;; diredp-menu-bar-mark-menu: Removed Revert item. -;; diredp-menu-bar-subdir-menu: Add image-dired-dired-toggle-marked-thumbs. -;; diredp-mouse-3-menu: -;; Use commands bound to keys, so the keys show up in the menu. Prefer *-this-file. -;; Correct the mark/unmark/flag menu-item visibility. Added Capitalize. -;; 2011/12/09 dadams -;; diredp-w32-drives: Use dolist, not mapcar. -;; diredp-mouse-3-menu: Use easymenu to build the menu. Conditionalize some items. -;; Bind down-mouse-3, not mouse-3, to diredp-mouse-3-menu. (bind mouse-3 to ignore). -;; Added eval-when-compile for easymenu.el. -;; 2011/12//02 dadams -;; Added diredp-internal-do-deletions. -;; dired(-mouse)-do(-flagged)-delete, : Use diredp-internal-do-deletions, for trash. -;; 2011/11/29 dadams -;; diredp-read-bookmark-file-args: Corrected use of list of default file names: > Emacs 23.1. -;; 2011/10/31 dadams -;; dired-mode-hook: Call font-lock-refresh-defaults - see Emacs 24 bugs #6662 and #9919. -;; 2011/10/24 dadams -;; Protect dired-show-file-type with fboundp. -;; 2011/09/03 dadams -;; diredp-do-grep-1: Map shell-quote-argument over file names. Thx to Joe Bloggs. -;; 2011/08/07 dadams -;; diredp-bookmark (need to keep in sync with bmkp-make-record-for-target-file): -;; Instead of image-bookmark-make-record, use explicit function that includes file, type. -;; 2011/07/25 dadams -;; Changed featurep to eval-after-load, for bookmark+-1.el and w32-browser.el. -;; 2011/07/01 dadams -;; Fixed typo: dired-toggle-find-file-reuse-dir -> ...diredp.... Thx to pasja on Emacs Wiki. -;; 2011/06/18 dadams -;; Added: diredp-describe-mode, diredp-dired-plus-help(-link), diredp-help-button, -;; diredp-dired-plus-description(+links), diredp-send-bug-report. -;; Bound diredp-describe-mode to whatever describe-mode is bound to. -;; All menus, :enable with mark-active: Added transient-mark-mode and mark != point. -;; toggle-diredp-find-file-reuse-dir: Swapped which one is the alias. -;; diredp-w32-list-mapped-drives: Display *Shell Command Output* at end. -;; diredp-mouse-(describe-file|3-menu|mark/unmark|(find|view)-file(-other-window)): -;; save-excursion set-buffer -> with-current-buffer. -;; 2011/06/08 dadams -;; Added: diredp-dired-for-files(-other-window). -;; 2011/06/07 dadams -;; Bound dired-show-file-type to _, since y is diredp-relsymlink-this-file. -;; 2011/04/25 dadams -;; Added (from files+.el): dired(-mouse)-describe-file. Bound to C-h (C-)RET, added to menus. -;; 2011/04/23 dadams -;; Added, bound (T c, T M-w, T 0, T v, T p, T C-y, T q), and added to menus: -;; diredp-copy-tags-this-file, diredp-mouse-copy-tags, -;; diredp(-mouse)(-do)-remove-all-tags(-this-file), -;; diredp(-mouse)(-do)-set-tag-value(-this-file), -;; diredp(-mouse)(-do)-paste-(add|replace)-tags(-this-file). -;; diredp-mark-files-tagged-(all/none|some/not-all): Bound free var presentp. -;; dired-map-over-marks: Corrected: Bind NEWARG and use that, not ARG. -;; dired-get-marked-files: let* -> let. -;; dired-do-redisplay, diredp-mouse-diff: when/if -> and. -;; dired-readin-insert, dired-get-filename: if -> unless/when. -;; diredp-mouse-find-file-reuse-dir-buffer: with-current-buffer, not save... -;; diredp-mouse-mark/unmark: Removed unused bol/eol vars. -;; 2011/04/19 dadams -;; Added: diredp-(un)mark-files-tagged-((not-)all|none|some|regexp|all/none|some/not-all), -;; dired-mark-if. Added Tagged submenu for Mark menu. -;; Put tags commands on prefix key T, as in Bookmark+. Removed C-(M-)+/- tags-cmd bindings. -;; diredp-untag-this-file: Added prefix-arg behavior. -;; 2011/04/18 dadams -;; Added: diredp-prompt-for-bookmark-prefix-flag. -;; Use it in diredp(-mouse)-do-(un)tag, diredp-read-bookmark-file-args, -;; diredp(-mouse)-do-bookmark, diredp-(bookmark|(un)tag)-this-file. -;; diredp-(bookmark|(un)tag)-this-file, diredp(-do)-bookmark, diredp-(un)tag, -;; diredp-do-bookmark-in-bookmark-file, diredp-set-bookmark-file-bookmark-for-marked: -;; Made PREFIX arg optional. -;; 2011/04/17 dadams -;; Added: diredp-(bookmark|(un)tag)-this-file, diredp(-mouse)(-do)-(un)tag. -;; diredp-mouse-3-menu: Added: diredp-mouse-do-(un)tag. -;; diredp-menu-bar-immediate-menu: Added diredp-(un)tag-this-file, diredp-bookmark-this-file. -;; diredp-menu-bar-operate-menu: Added diredp-do-(un)tag. -;; Bound diredp-do-tag to C-+, diredp-tag-this-file to C-M-+, diredp-do-untag to C--, -;; diredp-untag-this-file to C-M--, diredp-bookmark-this-file to C-B. -;; diredp-bookmark: Use bmkp-autofile-set, not bmkp-file-target-set, so get autofile. -;; diredp-read-bookmark-file-args, diredp(-mouse)-do-bookmark: -;; Default for prefix is now an empty string, not the directory. -;; diredp-mouse-do-bookmark: Removed optional second arg. -;; Corrected typo: direp-read-bookmark-file-args -> diredp-read-bookmark-file-args. -;; 2011/03/25 dadams -;; diredp-bookmark: Fixed typo: bmkp-file-indirect-set -> bmkp-file-target-set. -;; 2011/02/11 dadams -;; diredp-deletion, diredp-deletion-file-name, diredp-executable-tag: -;; Made default the same for dark background as for light. -;; diredp-ignored-file-name: Made default a bit darker for dark background. -;; 2011/02/03 dadams -;; All deffaces: Provided default values for dark-background screens too. -;; 2011/01/12 dadams -;; dired-do-flagged-delete: Removed sit-for added on 1/02. -;; 2011/01/04 dadams -;; defsubst -> defun everywhere. -;; Removed autoload cookies from non def* sexps, defvar, and non-interactive functions. -;; Added some missing autoload cookies for defcustom and commands. -;; 2011/01/02 dadams -;; Added: diredp-this-file-(un)marked-p, diredp-toggle-marks-in-region. -;; diredp-(un)mark-region-files, diredp-flag-region-files-for-deletion: -;; Act only on marked/unmarked files (opposite). Fix 2nd arg to dired-mark-if. -;; diredp-mouse-3-menu: -;; If region is active and mouse3.el was loaded, then use its popup. -;; Fix Toggle Marked/Unmarked: -;; Use diredp-toggle-marks-in-region, so widen, show details and use bol/eol. -;; dired-do-flagged-delete: Added sit-for. -;; 2010/11/28 dadams -;; diredp-mouse-3-menu: Added Toggle Marked/Unmarked for region menu. -;; 2010/10/20 dadams -;; Moved Emacs 20 tweak to recognize k in file sizes to var dired-move-to-filename-regexp. -;; Added diredp-loaded-p. -;; 2010/10/19 dadams -;; diredp-font-lock-keywords-1: -;; Handle decimal pt in file size. Thx to Michael Heerdegen. -;; Enable Emacs 20/21 to handle -h option (decimal point size). -;; Renamed: face diredp-inode+size to diredp-number. -;; 2010/10/01 dadams -;; dired-goto-file: Avoid infloop from looking for dir line. Thx to not-use.dilines.net. -;; 2010/09/29 dadams -;; Added: diredp-dired-union(-1|-other-window|-interactive-spec). -;; dired-goto-file: fix for Emacs bug #7126. -;; 2010/09/27 dadams -;; Renamed diredp-dired-interactive-spec to diredp-dired-files-interactive-spec. -;; diredp-dired-files-interactive-spec: Respect file-list arg: kill existing Dired buffer. -;; Fix use of prefix arg for switches. -;; 2010/09/26 dadams -;; Added: dired-insert-directory: Compute WILDCARD arg for individual files. -;; Added: dired-readin-insert: Use t as WILDCARD arg to dired-insert-directory. -;; Added: diredp-dired-files(-other-window), diredp-dired-interactive-spec. -;; 2010/08/27 dadams -;; Use diredp-font-lock-keywords-1 properly as a second level of fontification. -;; Added: diredp-w32-drives(-mode(-map)), dired-up-directory. -;; 2010/08/07 dadams -;; dired-map-over-marks: Removed loop that used dired-between-files. -;; diredp-get-file-or-dir-name: test against subdir/..? also. -;; dired-do-find-marked-files: Pass original ARG to dired-get-marked-files. -;; 2010/08/05 dadams -;; diredp-bookmark: -;; Handle image files (and sound files, if Bookmark+ is used). -;; Use bmkp-file-indirect-set if available. -;; Use error-message-string to get failure msg. -;; 2010/07/11 dadams -;; Added: diredp-set-bookmark-file-bookmark-for-marked (C-M-b), diredp-mouse-do-bookmark, -;; diredp-do-bookmark-in-bookmark-file (C-M-B, aka C-M-S-b), diredp-read-bookmark-file-args. -;; Added them to the operate menu. Added diredp-do-bookmark to mouse-3 menu. -;; 2010/07/07 dadams -;; dired-do-*: Updated doc strings for prefix arg treatment from dired-map-over-marks-check. -;; Added missing autoload cookies. -;; 2010/05/29 dadams -;; diredp-bookmark: Use relative file name in bookmark name. -;; Removed defvar of directory-listing-before-filename-regexp. -;; 2010/05/28 dadams -;; Changed menu item for dired-create-directory to New Directory. Moved it before Up Dir. -;; 2010/03/19 dadams -;; diredp-font-lock-keywords-1: Handle date+time wrt regexp changes for Emacs 23.2. -;; 2010/01/31 dadams -;; diredp-bookmark: -;; Don't use bookmark-set or find-file-noselect - inline the needed bookmark-store code. -;; Call bookmark-maybe-load-default-file. Use rudimentary bookmark-make-record-function. -;; 2010/01/21 dadams -;; Renamed: -;; diredp-subst-find-alternate-for-find to diredp-make-find-file-keys-reuse-dirs -;; diredp-subst-find-for-find-alternate to diredp-make-find-file-keys-not-reuse-dirs. -;; diredp-make-find-file-keys(-not)-reuse-dirs: Handle also dired(-mouse)-w32-browser. -;; 2010/01/10 dadams -;; Added: face diredp-inode+size. Use in diredp-font-lock-keywords-1. -;; diredp-font-lock-keywords-1: Allow decimal point in file size. Thx to Regis. -;; 2010/01/05 dadams -;; dired-insert-set-properties: -;; Add text property dired-filename to the file name (for Emacs 23). -;; 2009/10/23 dadams -;; diredp-font-lock-keywords-1: Override `l' and `t' matches in headings with default face. -;; 2009/10/13 dadams -;; Added: diredp(-do)-bookmark. Added to Multiple menu, and bound to M-b. -;; 2009/10/11 dadams -;; diredp-menu-bar-immediate-menu: -;; Added items: image display items, dired-maybe-insert-subdir. -;; Test dired-do-relsymlink, not diredp-relsymlink-this-file. -;; diredp-menu-bar-operate-menu: -;; Added items: epa encryption items, image items, isearch items. -;; diredp-menu-bar-subdir-menu: -;; Added items: revert, isearch file names, dired-compare-directories. -;; Removed macro menu-item-any-version - use menu-item everywhere (works for Emacs 20+). -;; Added wdired-change-to-wdired-mode to subdir menu even for Emacs 20, if defined. -;; 2009/07/09 dadams -;; dired-goto-file: Make sure we have a string before calling directory-file-name. -;; 2009/05/08 dadams -;; dired-find-file (Emacs 20): Raise error if dired-get-filename returns nil. -;; 2009/04/26 dadams -;; dired-insert-set-properties, diredp-(un)mark-region-files, -;; diredp-flag-region-files-for-deletion, diredp-mouse-3-menu, diredp-mouse-mark/unmark: -;; Bind inhibit-field-text-motion to t, to ensure real eol. -;; 2008/12/17 dadams -;; diredp-font-lock-keywords-1: Don't do diredp-deletion, diredp-flag-mark for empty lines. -;; 2008/09/22 dadams -;; Added: diredp-fileset, diredp-get-file-or-dir-name, and redefinitions of -;; dired-map-over-marks, dired-find-file, and dired-mouse-find-file-other-window. -;; Added vanilla code to pick up macro dired-map-over-marks: -;; dired-get-marked-files, dired-do-delete, dired-map-over-marks-check, -;; dired-do-redisplay, image-dired-dired-insert-marked-thumbs. -;; diredp-find-file-other-frame, diredp-mouse-(find|view)-file: -;; Added nil t args to dired-get-filename calls. -;; diredp-do-grep(-1): Use new dired-get-marked-files instead of ad-hoc treatment of C-u. -;; 2008/09/21 dadams -;; diredp-marked(-other-window): Don't treat zero prefix arg as numerical (no empty Dired). -;; Added dired-find-file redefinition for Emacs 20. -;; 2008/09/11 dadams -;; diredp-do-grep: Plain C-u means grep all files in Dired buffer. -;; diredp-do-grep-1: Treat 'all value of FILES arg. -;; Added: diredp-all-files. -;; 2008/09/09 dadams -;; Added: diredp-marked(-other-window). Added to menus. Bound *-other-window to C-M-*. -;; 2008/09/07 dadams -;; Added: diredp(-mouse)-do-grep(-1), diredp-grep-this-file. -;; Bound diredp-do-grep to M-g. Added grep commands to menus. -;; 2008/07/18 dadams -;; Soft-require w32-browser.el. Bind its commands in Dired map and menus. -;; 2008/03/08 dadams -;; dired-maybe-insert-subdir: Fit one-window frame after inserting subdir. -;; 2008/03/07 dadams -;; Added: redefinitions of dired-maybe-insert-subdir, dired-goto-file, dired-get-filename. -;; Added: diredp-this-subdir. -;; 2007/11/27 dadams -;; diredp-mouse(-backup)-diff: If available, use icicle-read-string-completing. -;; 2007/09/23 dadams -;; Removed second arg to undefine-killer-commands. -;; 2007/07/27 dadams -;; diredp-font-lock-keywords-1: Allow also for bz2 compressed files - Thx to Andreas Eder. -;; 2006/09/03 dadams -;; diredp-font-lock-keywords-1: Corrected file size and inode number. Thx to Peter Barabas. -;; 2006/08/20 dadams -;; Added: diredp-find-a-file*. -;; 2006/06/18 dadams -;; diredp-font-lock-keywords-1: Highlight file name (also) of flagged files. -;; Use dired-del-marker instead of literal D. -;; Added: diredp-deletion-file-name. -;; 2006/03/31 dadams -;; No longer use display-in-minibuffer. -;; 2006/01/07 dadams -;; Added: link for sending bug report. -;; 2006/01/06 dadams -;; Added defgroup Dired-Plus and used it. Added :link. -;; 2006/01/04 dadams -;; Added defvar of directory-listing-before-filename-regexp, for Emacs 22 compatibility. -;; 2005/12/29 dadams -;; Added: diredp-mouse-mark/unmark-mark-region-files. -;; 2005/12/26 dadams -;; Updated groups. -;; 2005/12/05 dadams -;; diredp-ignored-file-name: Made it slightly darker. -;; 2005/11/05 dadams -;; Renamed all stuff defined here to have diredp- prefix. -;; diredp-relsymlink-this-file: Protected with fboundp. -;; Changed to soft require: dired-x.el. -;; Removed comment to require this inside eval-after-load. -;; 2005/11/03 dadams -;; Added: dired-display-msg. Replace blue-foreground-face with it. -;; Alias dired-do-toggle to dired-toggle-marks, if defined. -;; 2005/11/02 dadams -;; Added: dired-get-file-for-visit, dired(-mouse)-find-alternate-file*, -;; togglep-dired-find-file-reuse-dir, dired+-subst-find-*. -;; Use defface for all faces. Renamed without "-face". No longer require def-face-const. -;; dired-simultaneous-find-file: Minor bug fix (typo). -;; 2005/07/10 dadams -;; dired-unmark-all-files-no-query -> dired-unmark-all-marks -;; (thanks to Sivaram Neelakantan for bug report). -;; 2005/05/25 dadams -;; string-to-int -> string-to-number everywhere. -;; 2005/05/17 dadams -;; Updated to work with Emacs 22.x. -;; 2005/02/16 dadams -;; Added dired-mark/unmark-extension. Replaced dired-mark-extension with it everywhere. -;; 2005/01/08 dadams -;; Bind [S-mouse-1], instead of [S-down-mouse-1], to dired-mouse-mark-region-files. -;; 2004/11/20 dadams -;; dired-mark-sexp: Search for literal month names only for versions before Emacs 20. -;; Refined to deal with Emacs 21 < 21.3.50 (soon to be 22.x) -;; 2004/11/14 dadams -;; Bound dired-no-confirm to non-nil for dired-mouse-*. -;; Updated for Emacs 21 and improved highlighting: -;; Spaces OK in file and directory names. Highlight date/time and size. -;; 2004/10/17 dadams -;; Require cl only for Emacs 20, and only when compile. -;; 2004/10/01 dadams -;; Updated to work with Emacs 21 also. -;; 2004/04/02 dadams -;; dired-font-lock-keywords-1: Prefer using dired-omit-extensions -;; to completion-ignored-extensions, if available. -;; 2004/03/22 dadams -;; Added dired-mouse-mark-region-files and dired-mouse-mark/unmark. -;; 2000/09/27 dadams -;; 1. dired-font-lock-keywords-1: fixed for spaces in dir names. -;; 2. Added: dired-buffers-for-dir. -;; 1999/09/06 dadams -;; Added S-*-mouse-2 bindings (same as C-*-mouse-2). -;; 1999/08/26 dadams -;; 1. Added *-face vars and dired-font-lock-keywords-1. -;; 2. Added possibility to use dired-font-lock-keywords-1 via hook. -;; 1999/08/26 dadams -;; Changed key binding of dired-mouse-find-file from down-mouse-2 to mouse-2. -;; 1999/08/25 dadams -;; Changed (C-)(M-)mouse-2 bindings. -;; 1999/08/25 dadams -;; 1. Added cmds & menu bar and key bindings: (dired-)find-file-other-frame. -;; 2. Changed binding for dired-display-file. -;; 1999/03/26 dadams -;; 1. Get rid of Edit menu-bar menu. -;; 2. dired-mouse-3-menu: Changed popup titles and item names. -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth -;; Floor, Boston, MA 02110-1301, USA. -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Code: - -(eval-when-compile (require 'cl)) ;; case (plus, for Emacs 20: dolist, pop, push) -(eval-when-compile (require 'easymenu)) ;; easy-menu-create-menu - -(require 'dired) ;; dired-revert -(require 'dired-aux) ;; dired-bunch-files, dired-do-chxxx, dired-do-create-files, - ;; dired-mark-read-string, dired-read-shell-command, - ;; dired-run-shell-command, dired-shell-stuff-it -(require 'dired-x) ;; dired-do-relsymlink -(require 'autofit-frame nil t) ;; (no error if not found) fit-frame-if-one-window -(require 'bookmark+ nil t) ;; (no error if not found) - ;; bmkp-autofile-add-tags, bmkp-autofile-remove-tags, bmkp-autofile-set, bmkp-copied-tags, - ;; bmkp-current-bookmark-file, bmkp-describe-bookmark, bmkp-empty-file, bmkp-get-autofile-bookmark, - ;; bmkp-get-bookmark-in-alist, bmkp-get-tags, bmkp-read-tag-completing, - ;; bmkp-read-tags-completing, bmkp-refresh/rebuild-menu-list, bmkp-remove-all-tags, - ;; bmkp-same-file-p, bmkp-set-bookmark-file-bookmark, bmkp-set-sequence-bookmark, - ;; bmkp-set-tag-value, bmkp-some, bmkp-switch-bookmark-file, bmkp-tag-name - -;; For now at least, `highlight.el' is needed only if you use `bookmark+.el'. -(when (featurep 'bookmark+) (require 'highlight nil t)) ;; (no error if not found): - ;; hlt-highlight-region - -(if (> emacs-major-version 21) (require 'help-fns+ nil t) (require 'help+20 nil t)) ;; (no error if not found): - ;; describe-file - -(require 'misc-fns nil t) ;; (no error if not found): undefine-killer-commands -(require 'image-file nil t) ;; (no error if not found): image-file-name-regexp -(require 'image-dired nil t) ;; (no error if not found): - ;; image-dired-create-thumb, image-dired-create-thumbnail-buffer, - ;; image-dired-dired-after-readin-hook, image-dired-delete-tag, image-dired-dired-comment-files, - ;; image-dired-dired-display-external, image-dired-dired-display-image, - ;; image-dired-display-thumbs, image-dired-get-comment, image-dired-get-exif-file-name, - ;; image-dired-get-thumbnail-image, image-dired-insert-thumbnail, image-dired-line-up, - ;; image-dired-line-up-dynamic, image-dired-line-up-interactive, image-dired-line-up-method, - ;; image-dired-list-tags, image-dired-main-image-directory, image-dired-mark-tagged-files, - ;; image-dired-read-comment, image-dired-remove-tag, image-dired-save-information-from-widgets, - ;; image-dired-tag-files, image-dired-thumb-height, image-dired-thumbnail-buffer, - ;; image-dired-thumb-name, image-dired-thumb-size, image-dired-thumb-width, - ;; image-dired-widget-list, image-dired-write-comments, image-dired-write-tags -(when (memq system-type '(windows-nt ms-dos)) - ;; (no error if not found): - (require 'w32-browser nil t));; dired-w32explore, dired-w32-browser, dired-mouse-w32-browser, - ;; dired-multiple-w32-browser -(when (< emacs-major-version 21) (require 'subr-21)) ;; replace-regexp-in-string - -;; Provide macro for code byte-compiled using Emacs < 22. -(eval-when-compile - (when (< emacs-major-version 22) - (defmacro minibuffer-with-setup-hook (fun &rest body) - "Temporarily add FUN to `minibuffer-setup-hook' while executing BODY. -BODY should use the minibuffer at most once. -Recursive uses of the minibuffer are unaffected (FUN is not -called additional times). - -This macro actually adds an auxiliary function that calls FUN, -rather than FUN itself, to `minibuffer-setup-hook'." - ;; (declare (indent 1) (debug t)) - (let ((hook (make-symbol "setup-hook"))) - `(let (,hook) - (setq ,hook (lambda () - ;; Clear out this hook so it does not interfere - ;; with any recursive minibuffer usage. - (remove-hook 'minibuffer-setup-hook ,hook) - (funcall ,fun))) - (unwind-protect - (progn (add-hook 'minibuffer-setup-hook ,hook) ,@body) - (remove-hook 'minibuffer-setup-hook ,hook))))))) - -(defmacro diredp-user-error (&rest args) - `(if (fboundp 'user-error) (user-error ,@args) (error ,@args))) - -;; Define these for Emacs 20 and 21. -(unless (fboundp 'dired-get-file-for-visit) ; Emacs 22+ - (defun dired-get-file-for-visit () ; Not bound - "Get the current line's file name, with an error if file does not exist." - (interactive) - (let ((raw (dired-get-filename nil t)) ; Pass t for second arg so no error for `.' and `..'. - file-name) - (unless raw (error "No file on this line")) - (setq file-name (file-name-sans-versions raw t)) - (if (file-exists-p file-name) - file-name - (if (file-symlink-p file-name) - (error "File is a symlink to a nonexistent target") - (error "File no longer exists; type `g' to update Dired buffer"))))) - - (defun dired-find-alternate-file () ; Not bound - "In Dired, visit this file or directory instead of the Dired buffer." - (interactive) - (set-buffer-modified-p nil) - (find-alternate-file (dired-get-file-for-visit)))) - -;;;;;;;;;;;;;;;;;;;;;;; - - -(provide 'dired+) -(require 'dired+) ; Ensure loaded before compile this. - -;; Quiet the byte-compiler. -(defvar bmkp-copied-tags) ; In `bookmark+-1.el' -(defvar bmkp-current-bookmark-file) ; In `bookmark+-1.el' -(defvar bookmark-default-file) ; In `bookmark.el' -(defvar compilation-current-error) ; In `compile.el' -(defvar delete-by-moving-to-trash) ; Built-in, Emacs 23+ -(defvar dired-always-read-filesystem) ; In `dired.el', Emacs 26+ -(defvar dired-auto-revert-buffer) ; In `dired.el', Emacs 23+ -(defvar dired-create-files-failures) ; In `dired-aux.el', Emacs 22+ -(defvar dired-details-state) ; In `dired-details+.el' -(defvar dired-keep-marker-hardlink) ; In `dired-x.el' -(defvar dired-overwrite-confirmed) ; In `dired-aux.el' -(defvar dired-query-alist) ; In `dired-aux.el', Emacs < 24 -(defvar dired-recursive-copies) ; In `dired-aux.el', Emacs 22+ -(defvar dired-recursive-deletes) ; In `dired.el', Emacs 22+ -(defvar dired-shrink-to-fit) ; In `dired.el' -(defvar dired-switches-alist) ; In `dired.el' -(defvar dired-subdir-switches) ; In `dired.el' -(defvar dired-touch-program) ; Emacs 22+ -(defvar dired-use-ls-dired) ; Emacs 22+ -(defvar diredp-count-.-and-..-flag) ; Here, Emacs 22+ -(defvar diredp-hide-details-initially-flag) ; Here, Emacs 24.4+ -(defvar diredp-hide-details-last-state) ; Here, Emacs 24.4+ -(defvar diredp-hide-details-propagate-flag) ; Here, Emacs 24.4+ -(defvar diredp-hide-details-toggled) ; Here, Emacs 24.4+ -(defvar diredp-highlight-autofiles-mode) ; Here, Emacs 22+ -(defvar diredp-menu-bar-encryption-menu) ; Here, Emacs 23+ -(defvar diredp-menu-bar-images-recursive-menu) ; Here (old name) -(defvar diredp-menu-bar-regexp-recursive-menu) ; Here (old name) -(defvar diredp-menu-bar-subdir-menu) ; Here (old name) -(defvar diredp-move-file-dirs) ; Here, Emacs 24+ -(defvar diredp-single-bookmarks-menu) ; Here, if Bookmark+ is available -(defvar filesets-data) ; In `filesets.el' -(defvar grep-use-null-device) ; In `grep.el' -(defvar header-line-format) ; Emacs 22+ -(defvar icicle-file-sort) ; In `icicles-opt.el' -;; $$$$ (defvar icicle-file-sort-first-time-p) ; In `icicles-var.el' -(defvar icicle-files-ido-like-flag) ; In `icicles-opt.el' -(defvar icicle-ignored-directories) ; In `icicles-opt.el' -(defvar icicle-sort-comparer) ; In `icicles-opt.el' -(defvar image-dired-display-image-buffer) ; In `image-dired.el' -(defvar image-dired-line-up-method) ; In `image-dired.el' -(defvar image-dired-main-image-directory) ; In `image-dired.el' -(defvar image-dired-thumbnail-buffer) ; In `image-dired.el' -(defvar image-dired-thumb-height) ; In `image-dired.el' -(defvar image-dired-thumb-width) ; In `image-dired.el' -(defvar image-dired-widget-list) ; In `image-dired.el' -(defvar ls-lisp-use-insert-directory-program) ; In `ls-lisp.el' -(defvar minibuffer-default-add-function) ; In `simple.el', Emacs 23+ -(defvar mouse3-dired-function) ; In `mouse3.el' -(defvar read-file-name-completion-ignore-case) ; In `minibuffer.el', Emacs 23+. In C code, Emacs 22. -(defvar recentf-list) ; In `recentf.el' -(defvar switch-to-buffer-preserve-window-point) ; In `window.el', Emacs 24+ -(defvar tooltip-mode) ; In `tooltip.el' -(defvar vc-directory-exclusion-list) ; In `vc' -(defvar w32-browser-wait-time) ; In `w32-browser.el' - -;;;;;;;;;;;;;;;;;;;;;;; - -(defgroup Dired-Plus nil - "Various enhancements to Dired." - :prefix "diredp-" :group 'dired - :link `(url-link :tag "Send Bug Report" - ,(concat "mailto:" "drew.adams" "@" "oracle" ".com?subject=\ -dired+.el bug: \ -&body=Describe bug here, starting with `emacs -q'. \ -Don't forget to mention your Emacs and library versions.")) - :link '(url-link :tag "Other Libraries by Drew" - "https://www.emacswiki.org/emacs/DrewsElispLibraries") - :link '(url-link :tag "Download" - "https://www.emacswiki.org/emacs/download/dired%2b.el") - :link '(url-link :tag "Description" - "https://www.emacswiki.org/emacs/DiredPlus") - :link '(emacs-commentary-link :tag "Commentary" "dired+")) - -;;; Variables - -;; `dired-do-toggle' was renamed to `dired-toggle-marks' after Emacs 20. -(unless (fboundp 'dired-toggle-marks) (defalias 'dired-toggle-marks 'dired-do-toggle)) - -;;; This is duplicated in `diff.el' and `vc.el'. -;;;###autoload -(defcustom diff-switches "-c" - "*A string or list of strings specifying switches to be passed to diff." - :type '(choice string (repeat string)) - :group 'dired :group 'diff) - -;;;###autoload -(defcustom diredp-auto-focus-frame-for-thumbnail-tooltip-flag nil - "*Non-nil means automatically focus the frame for a thumbnail tooltip. -If nil then you will not see a thumbnail image tooltip when you -mouseover an image-file name in Dired, unless you first give the frame -the input focus (e.g., by clicking its title bar). - -This option has no effect if `diredp-image-preview-in-tooltip' is nil. -It also has no effect for Emacs versions prior to Emacs 22." - :type 'boolean :group 'Dired-Plus) - -;;;###autoload -(defcustom diredp-bind-problematic-terminal-keys t - "*Non-nil means bind some keys that might not work in a text-only terminal. -This applies to keys that use modifiers Meta and Shift together. -If you use Emacs in text-only terminal and your terminal does not -support the use of such keys then customize this option to nil." - :type 'boolean :group 'Dired-Plus) - -;;;###autoload -(defcustom diredp-compressed-extensions '(".tar" ".taz" ".tgz" ".arj" ".lzh" - ".lzma" ".xz" ".zip" ".z" ".Z" ".gz" ".bz2" ".rar" ".rev") - "*List of compressed-file extensions, for highlighting. - -Note: If you change the value of this option then you need to restart -Emacs to see the effect of the new value on font-locking." - :type '(repeat string) :group 'Dired-Plus) - -(when (> emacs-major-version 21) ; Emacs 22+ - (defcustom diredp-count-.-and-..-flag nil - "Non-nil means count `.' and `..' when counting files for mode-line." - :type 'boolean :group 'Dired-Plus)) - -;;;###autoload -(defcustom diredp-do-report-echo-limit 5 - "Echo result for each file, for fewer than this many files. -If more than this many files are acted on then there is no echoing. - -Used by some do-and-report commands such as `diredp-do-emacs-command'. -Results that are not echoed are anyway reported by `dired-log', so you -can show them with `?' in the Dired buffer." - :type '(restricted-sexp :match-alternatives (wholenump)) :group 'Dired-Plus) - -;;;###autoload -(defcustom diredp-dwim-any-frame-flag pop-up-frames - "*Non-nil means the target directory can be in a window in another frame. -Only visible frames are considered. -This is used by ``dired-dwim-target-directory'. -This option has no effect for Emacs versions before Emacs 22." - :type 'boolean :group 'Dired-Plus) - -(when (fboundp 'dired-hide-details-mode) ; Emacs 24.4+ - (defcustom diredp-hide-details-initially-flag t - "*Non-nil means hide details in Dired from the outset." - :type 'boolean :group 'Dired-Plus - :set (lambda (sym defs) - (custom-set-default sym defs) - (setq diredp-hide-details-last-state diredp-hide-details-initially-flag))) - - (defcustom diredp-hide-details-propagate-flag t - "*Non-nil means display the next Dired buffer the same way as the last. -The last `dired-hide-details-mode' value set is used by the next Dired -buffer created." - :type 'boolean :group 'Dired-Plus)) - -;; Emacs 20 only. -;;;###autoload -(unless (fboundp 'define-minor-mode) - (defcustom diredp-highlight-autofiles-mode t - "*Non-nil means highlight names of files that are autofile bookmarks. -Autofiles that have tags are highlighted using face -`diredp-tagged-autofile-name'. Those with no tags are highlighted -using face `diredp-autofile-name'. - -Setting this option directly does not take effect; use either -\\[customize] or command `diredp-highlight-autofiles-mode'. - -NOTE: When `dired+.el' is loaded (for the first time per Emacs -session), the highlighting is turned ON, regardless of the option -value. To prevent this and have the highlighting OFF by default, you -must do one of the following: - - * Put (diredp-highlight-autofiles-mode -1) in your init file, AFTER - it loads `dired+.el'. - - * Customize the option to `nil', AND ensure that your `custom-file' - (or the `custom-saved-variables' part of your init file) is - evaluated before `dired+.el' is loaded. - -This option has no effect unless you use libraries `Bookmark and -`highlight.el'." - :set (lambda (symbol value) (diredp-highlight-autofiles-mode (if value 1 -1))) - :initialize 'custom-initialize-default - :type 'boolean :group 'Dired-Plus :require 'dired+)) - -;;;###autoload -(defcustom diredp-ignore-compressed-flag t - "*Non-nil means to font-lock names of compressed files as ignored files. -This applies to filenames whose extensions are in -`diredp-compressed-extensions'. If nil they are highlighted using -face `diredp-compressed-file-name'. - -Note: If you change the value of this option then you need to restart -Emacs to see the effect of the new value on font-locking." - :type 'boolean :group 'Dired-Plus) - -;;;###autoload -(defcustom diredp-image-preview-in-tooltip (or (and (boundp 'image-dired-thumb-size) image-dired-thumb-size) - 100) - "*Whether and what kind of image preview to show in a tooltip. -The possible values are: - - `nil' : do not show a tooltip preview - integer N>0 : show a thumbnail preview of that size - `full' : show a full-size preview of the image - -To enable tooltip image preview you must turn on `tooltip-mode' and -load library `image-dired.el'. See also option -`diredp-auto-focus-frame-for-thumbnail-tooltip-flag'. - -This option has no effect for Emacs versions prior to Emacs 22." - :type '(choice - (restricted-sexp :tag "Show a thumnail image of size" - :match-alternatives ((lambda (x) (and (wholenump x) (not (zerop x)))))) - (const :tag "Show a full-size image preview" full) - (const :tag "OFF: Do not show an image preview" nil)) - :group 'Dired-Plus) - -;;;###autoload -(defcustom diredp-image-show-this-file-use-frame-flag t - "Non-nil means `diredp-image-show-this-file' uses another frame. -If nil then it uses another window. Using another frame means you -have more control over the image size when you use a prefix arg. - -If it uses another window then the prefix arg controls only the -minimum window height, not necessarily the image scale (height). - -\(If the buffer displaying the image is already considered a -special-display buffer by your Emacs setup, then a nil value of this -option has no effect.)" - :type 'boolean :group 'Dired-Plus) - -;;;###autoload -(defcustom diredp-list-file-attributes (list '(5 8) 'auto) - "Which file attributes `diredp-list-file' uses, and when." - :group 'Dired-Plus :type '(list (repeat integer) - (choice - (const :tag "Show automatically, immediately" 'auto) - (const :tag "Show on demand via `l'" 'on-demand)))) - -;;;###autoload -(defcustom diredp-max-frames 200 - "*Max number of frames, for commands that find files in separate frames. -These commands are `dired-do-find-marked-files' and -`diredp-do-find-marked-files-recursive'. See their descriptions for -the circumstances in which they show the files in separate frames." - :type '(restricted-sexp :match-alternatives ((lambda (x) (and (wholenump x) (not (zerop x)))))) - :group 'Dired-Plus) - -(when (fboundp 'file-equal-p) ; Emacs 24+ - (defcustom diredp-move-file-dirs () - "Alist of names of files and preferred directories to move them to. -File names should be relative (no directory component). -Target directory names should be absolute." - :group 'files :type '(alist :key-type file :value-type directory))) - -;; (Not used - just use the body directly in the option default value. -;; (defun diredp-omit-files-regexp () -;; "Return regexp to use for font-locking, using `dired-omit-files' as base." -;; (let* ((strg dired-omit-files) -;; (strg (if (eq ?^ (aref strg 0)) (substring strg 1) strg)) ; Remove initial ^ -;; (strg (replace-regexp-in-string "\\(\\\\[|]\\)\\^" "\\1" strg 'FIXEDCASE nil)) ; Remove other ^'s -;; (strg (replace-regexp-in-string "\\([$]\\)" "" strg 'FIXEDCASE nil))) ; Remove $'s -;; strg)) - -(defcustom diredp-omit-files-regexp (let* ((strg dired-omit-files) - (strg (if (eq ?^ (aref strg 0)) ; Remove initial ^ - (substring strg 1) - strg)) - (strg (replace-regexp-in-string "\\(\\\\[|]\\)\\^" ; Remove other ^'s - "\\1" - strg - 'FIXEDCASE - nil)) - (strg (replace-regexp-in-string "\\([$]\\)" ; Remove $'s - "" - strg - 'FIXEDCASE - nil))) - strg) - "Regexp for font-locking file names to be omitted by `dired-omit-mode'. -The regexp is matched only against the file name, but the entire line -is highlighted (with face `diredp-omit-file-name'). - -The default value of this option differs from that of -`dired-omit-files' by removing \"^\" from the beginning, and \"$\" -from the end, of each regexp choice. (The default value of -`dired-omit-files', at least prior to Emacs 27, uses \"^\" and \"$\", -but it should not.) - -If you want to control the beginning and end of choice matches then -use \"\\`\" and \"\\'\" instead of \"^\" and \"$\". - -Note: If you change the value of this option then you need to restart -Emacs to see the effect of the new value on font-locking." - :group 'Dired-Plus :type 'regexp) - -;;;###autoload -(defcustom diredp-prompt-for-bookmark-prefix-flag nil - "*Non-nil means prompt for a prefix string for bookmark names." - :type 'boolean :group 'Dired-Plus) - -;;;###autoload -(defcustom diredp-visit-ignore-regexps () - "Regexps matching file names for `diredp-visit-(next|previous)' to skip. -A file or directory name matching one of these regexps is skipped, -along with those with an extension in `diredp-visit-ignore-extensions'." - :type '(repeat regexp) :group 'Dired-Plus) - -;;;###autoload -(defcustom diredp-visit-ignore-extensions '("elc") - "Extensions of file names for `diredp-visit-(next|previous)' to skip. -A file name with one of these extensions is skipped, along with those -matching a regexp in `diredp-visit-ignore-regexps'." - :type '(repeat string) :group 'Dired-Plus) - -;;;###autoload -(defcustom diredp-w32-local-drives '(("C:" "Local disk")) - "*Local MS Windows drives that you want to use for `diredp-w32-drives'. -Each entry is a list (DRIVE DESCRIPTION), where DRIVE is the drive -name and DESCRIPTION describes DRIVE." - :type '(alist - :key-type (string :tag "Drive name") - :value-type (group (string :tag "Drive description"))) - :group 'Dired-Plus) - -;;;###autoload -(defcustom diredp-wrap-around-flag t - "*Non-nil means Dired \"next\" commands wrap around to buffer beginning." - :type 'boolean :group 'Dired-Plus) - -(when (fboundp 'dired-hide-details-mode) ; Emacs 24.4+ - (defvar diredp-hide-details-last-state diredp-hide-details-initially-flag - "Last `dired-hide-details-mode' value. -Initialized to the value of option `diredp-hide-details-initially-flag'.") - - (defvar diredp-hide-details-toggled nil - "Non-nil means you have already toggled hiding details in this buffer.") - (make-variable-buffer-local 'diredp-hide-details-toggled)) - -;; Same value as the default value of `icicle-re-no-dot'. -(defvar diredp-re-no-dot "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*" - "Regexp that matches anything except `.' and `..'.") - -(defvar diredp-w32-drives-mode-map (let ((map (make-sparse-keymap))) - (define-key map "q" 'bury-buffer) - (define-key map "\r" 'widget-button-press) - (define-key map [mouse-2] 'widget-button-click) - map) - "Keymap for `diredp-w32-drives-mode'.") - -;;; $$$$$$ Starting with Emacs 22, *-move-to* is defvaraliased to *-listing-before*. -;;; But `files+.el' defines *-listing-before*, so we define it here too. -;;; (unless (> emacs-major-version 21) -;;; (defvar directory-listing-before-filename-regexp dired-move-to-filename-regexp -;;; "Regular expression to match up to the file name in a directory listing. -;;; The default value is designed to recognize dates and times -;;; regardless of the language.")) - -;;; Macros - - -;; Unlike `dired-mark-if': -;; -;; 1. Value returned and message indicate both the number matched and the number changed. -;; 2. Added optional arg PLURAL, for irregular plurals (e.g. "directories"). -;; -(defmacro diredp-mark-if (predicate singular &optional plural) - "Mark files for PREDICATE, according to `dired-marker-char'. -PREDICATE is evaluated on each line, with point at beginning of line. -SINGULAR is a singular noun phrase for the type of files being marked. -Optional arg PLURAL is a plural noun phrase for the type of files - being marked. -If PLURAL is nil then SINGULAR should end with a noun that can be -pluralized by adding `s'. - -Return nil if no files matched PREDICATE. -Otherwise return a cons (CHANGED . MATCHED), where: - CHANGED is the number of markings that were changed by the operation. - MATCHED is the number of files that matched PREDICATE." - `(let ((inhibit-read-only t) - changed matched) - (save-excursion - (setq matched 0 - changed 0) - (when ,singular (message "%s %s%s..." - (cond ((eq dired-marker-char ?\040) "Unmarking") - ((eq dired-del-marker dired-marker-char) "Flagging") - (t "Marking")) - (or ,plural (concat ,singular "s")) - (if (eq dired-del-marker dired-marker-char) " for deletion" ""))) - (goto-char (point-min)) - (while (not (eobp)) - (when ,predicate - (setq matched (1+ matched)) - (unless (eq dired-marker-char (char-after)) - (delete-char 1) (insert dired-marker-char) (setq changed (1+ changed)))) - (forward-line 1)) - (when ,singular (message "%s %s%s%s newly %s%s" - matched - (if (= matched 1) ,singular (or ,plural (concat ,singular "s"))) - (if (not (= matched changed)) " matched, " "") - (if (not (= matched changed)) changed "") - (if (eq dired-marker-char ?\040) "un" "") - (if (eq dired-marker-char dired-del-marker) "flagged" "marked")))) - (and (> matched 0) (cons changed matched)))) - - -;; Just a helper function for `dired-map-over-marks'. -(defun diredp-get-file-or-dir-name (arg) - "Return name of next file or directory or nil if none. -Argument ARG: - `all-files-no-dirs' or nil means skip directories. - `all-files-no-dots' means skip `.' and `..'." - (let ((fname nil)) - (while (and (not fname) (not (eobp))) - (setq fname (dired-get-filename t t)) - (when (and fname (or (not arg) (eq arg 'all-files-no-dirs)) (file-directory-p fname)) - (setq fname nil)) - (when (and fname (eq arg 'all-files-no-dots) (or (member fname '("." "..")) - (diredp-string-match-p "/\\.\\.?$" fname))) - (setq fname nil)) - (forward-line 1)) - (forward-line -1) - fname)) - - -;; REPLACE ORIGINAL in `dired.el'. -;; -;; Treat multiple `C-u' specially. -;; -(defmacro dired-map-over-marks (body arg &optional show-progress - distinguish-one-marked) - "Eval BODY with point on each marked line. Return a list of BODY's results. -If no marked file could be found, execute BODY on the current line. -ARG, if non-nil, specifies the files to use instead of the marked files. - If ARG is an integer, use the next ARG files (previous -ARG, if < 0). - In that case, point is dragged along. This is so that commands on - the next ARG (instead of the marked) files can be easily chained. - If ARG is a cons with element 16, 64, or 256, corresponding to - `C-u C-u', `C-u C-u C-u', or `C-u C-u C-u C-u', then use all files - in the Dired buffer, where: - 16 includes NO directories (including `.' and `..') - 64 includes directories EXCEPT `.' and `..' - 256 includes ALL directories (including `.' and `..') - If ARG is otherwise non-nil, use the current file. -If optional third arg SHOW-PROGRESS evaluates to non-nil, - redisplay the Dired buffer after each file is processed. - -No guarantee is made about the position on the marked line. BODY must -ensure this itself, if it depends on this. - -Search starts at the beginning of the buffer, thus the car of the list -corresponds to the line nearest the end of the buffer. This is also -true for (positive and negative) integer values of ARG. - -BODY should not be too long, because it is expanded four times. - -If DISTINGUISH-ONE-MARKED is non-nil, then return (t FILENAME) instead - of (FILENAME), if only one file is marked." - ;; WARNING: BODY must not add new lines before point - this may cause an - ;; endless loop. This warning should not apply any longer, sk 2-Sep-1991 14:10. - `(prog1 - (let ((inhibit-read-only t) - (newarg ,arg) - multi-C-u case-fold-search found results) - (when (and (consp newarg) (> (prefix-numeric-value newarg) 4)) - (setq newarg (case (prefix-numeric-value newarg) - (16 'all-files-no-dirs) ; `C-u C-u' - (64 'all-files-no-dots) ; `C-u C-u C-u' - (256 'all-files) ; `C-u C-u C-u C-u' - (t 'all-files-no-dirs)) - multi-C-u t)) - (if (and newarg (not multi-C-u)) - (if (integerp newarg) - (progn ; No `save-excursion', want to move point. - (dired-repeat-over-lines newarg #'(lambda () - (when ,show-progress (sit-for 0)) - (setq results (cons ,body results)))) - (if (< newarg 0) (nreverse results) results)) - ;; Non-nil, non-integer ARG means use current file: - (list ,body)) - (let ((regexp (dired-marker-regexp)) - next-position) - (save-excursion - (goto-char (point-min)) - ;; Remember position of next marked file before BODY can insert lines before the - ;; just found file, confusing us by finding the same marked file again and again... - (setq next-position (and (if multi-C-u - (diredp-get-file-or-dir-name newarg) - (re-search-forward regexp nil t)) - (point-marker)) - found (not (null next-position))) - (while next-position - (goto-char next-position) - (when ,show-progress (sit-for 0)) - (setq results (cons ,body results)) - ;; move after last match - (goto-char next-position) - (forward-line 1) - (set-marker next-position nil) - (setq next-position (and (if multi-C-u - (diredp-get-file-or-dir-name newarg) - (re-search-forward regexp nil t)) - (point-marker))))) - (when (and ,distinguish-one-marked (= (length results) 1)) - (setq results (cons t results))) - (if found results (list ,body))))) - ;; `save-excursion' loses, again - (dired-move-to-filename))) - -;; Same as `icicle-with-help-window' in `icicles-mac.el' -;; and `bmkp-with-help-window' in `bookmark+-mac.el'. -(defmacro diredp-with-help-window (buffer &rest body) - "`with-help-window', if available; else `with-output-to-temp-buffer'." - (if (fboundp 'with-help-window) - `(with-help-window ,buffer ,@body) - `(with-output-to-temp-buffer ,buffer ,@body))) - -(put 'diredp-with-help-window 'common-lisp-indent-function '(4 &body)) - -;;; Utility functions - -;; Same as `imenup-delete-if-not'. -;; -(defun diredp-delete-if-not (predicate xs) - "Remove all elements of list XS that do not satisfy PREDICATE. -This operation is destructive, reusing conses of XS whenever possible." - (while (and xs (not (funcall predicate (car xs)))) - (setq xs (cdr xs))) - (let ((cl-p xs)) - (while (cdr cl-p) - (if (not (funcall predicate (cadr cl-p))) (setcdr cl-p (cddr cl-p)) (setq cl-p (cdr cl-p))))) - xs) - -;; Same as `imenup-delete-if'. -;; -(defun diredp-delete-if (predicate xs) - "Remove all elements of list XS that satisfy PREDICATE. -This operation is destructive, reusing conses of XS whenever possible." - (while (and xs (funcall predicate (car xs))) - (setq xs (cdr xs))) - (let ((cl-p xs)) - (while (cdr cl-p) - (if (funcall predicate (cadr cl-p)) - (setcdr cl-p (cddr cl-p)) - (setq cl-p (cdr cl-p))))) - xs) - -;; Same as `tap-string-match-p' in `thingatpt+.el'. -(if (fboundp 'string-match-p) - (defalias 'diredp-string-match-p 'string-match-p) ; Emacs 23+ - (defun diredp-string-match-p (regexp string &optional start) - "Like `string-match', but this saves and restores the match data." - (save-match-data (string-match regexp string start)))) - -(if (fboundp 'looking-at-p) - (defalias 'diredp-looking-at-p 'looking-at-p) ; Emacs 23+ - (defun diredp-looking-at-p (regexp) - "Like `looking-at', but this saves and restores the match data." - (save-match-data (looking-at regexp)))) - -;; `dired-read-regexp' does not accept DEFAULT and HISTORY for older Emacsen, so use this. -(defun diredp-read-regexp (prompt &optional default history) - "Read a regexp. -HISTORY defaults to `dired-regexp-history'." - (setq history (or history 'dired-regexp-history)) - (if (fboundp 'read-regexp) - (read-regexp prompt default history) - (read-from-minibuffer prompt nil nil nil history default))) - -(if (fboundp 'delete-dups) - (defalias 'diredp-delete-dups 'delete-dups) - (defun diredp-delete-dups (list) - "Destructively remove `equal' duplicates from LIST. -Store the result in LIST and return it. LIST must be a proper list. -Of several `equal' occurrences of an element in LIST, the first -one is kept." - (let ((tail list)) - (while tail - (setcdr tail (delete (car tail) (cdr tail))) - (setq tail (cdr tail)))) - list)) - -(defun diredp-nonempty-region-p () - "Return non-nil if region is active and non-empty." - (and transient-mark-mode mark-active (mark) (> (region-end) (region-beginning)))) - -(defun diredp-get-image-filename (&optional localp no-error-if-not-filep) - "Return the image-file name on this line, or nil if no image file. -If not in Dired (or a mode derived from Dired), then test the entire -text of the current line as the file name. - -The optional args are the same as for `dired-get-filename'. They are -ignored if not in a Dired mode. - -\(Prior to Emacs 22, this function just returns nil.)" - (let ((file (if (derived-mode-p 'dired-mode) - (dired-get-filename localp no-error-if-not-filep) - ;; Make it work also for `diredp-list-files' listings. - (buffer-substring-no-properties (line-beginning-position) (line-end-position))))) - (and file - (fboundp 'image-file-name-regexp) ; Emacs 22+, `image-file.el'. - (diredp-string-match-p (image-file-name-regexp) file) - file))) - -(defun diredp-root-directory-p (file) - "Return non-nil if FILE is a root directory." - (if (fboundp 'ange-ftp-root-dir-p) - (ange-ftp-root-dir-p (file-name-as-directory file)) - ;; This is essentially `ange-ftp-root-dir-p' applied to `file-name-as-directory'. - ;; If `ange-ftp-root-dir-p' changes, update this code. - (or (and (eq system-type 'windows-nt) (diredp-string-match-p "\\`[a-zA-Z]:[/\\]\\'" - (file-name-as-directory file))) - (string= "/" file)))) - -(defun diredp-parent-dir (file &optional relativep) - "Return the parent directory of FILE, or nil if none. -Optional arg RELATIVEP non-nil means return a relative name, that is, -just the parent component." - (let ((parent (file-name-directory (directory-file-name (expand-file-name file)))) - relparent) - (when relativep (setq relparent (file-name-nondirectory (directory-file-name parent)))) - (and (not (equal parent file)) (or relparent parent)))) - -(unless (fboundp 'derived-mode-p) ; Emacs 20, 21. - (defun derived-mode-p (&rest modes) - "Non-nil if the current major mode is derived from one of MODES. -Uses the `derived-mode-parent' property of the symbol to trace backwards." - (let ((parent major-mode)) - (while (and (not (memq parent modes)) (setq parent (get parent 'derived-mode-parent)))) - parent))) - -(defun diredp-ensure-mode () - "Raise an error if not in Dired or a mode derived from it." - (unless (derived-mode-p 'dired-mode) - (error "You must be in Dired or a mode derived from it to use this command"))) - -(defun diredp-ensure-bookmark+ () - (unless (require 'bookmark+ nil t) (error "This command requires library `bookmark+.el'"))) - - -(unless (fboundp 'dired-nondirectory-p) ; Emacs 20, 21. - (defun dired-nondirectory-p (file) - "Return non-nil if FILE is not a directory." - (not (file-directory-p file)))) - - -;;; Some of the redefinitions that follow are essentially unaltered vanilla Emacs code to be -;;; reloaded, to use the new definition of `dired-map-over-marks' here. - - -;; REPLACE ORIGINAL in `dired.el'. -;; -;; 1. Pass non-nil second arg to `dired-get-filename' so we can include `.' and `..'. -;; 2. Doc string is updated to reflect the new ARG behavior. -;; 3. Allow, unlike vanilla Emacs, use of FILTER and DISTINGUISH-ONE-MARKED together. -;; -(defun dired-get-marked-files (&optional localp arg filter distinguish-one-marked error-if-none-p) - "Return names of the marked files and directories as a list of strings. -The list is in the same order as the buffer, that is, the car is the - first marked file. -Values returned are normally absolute file names. -Optional arg LOCALP as in `dired-get-filename'. -Optional second argument ARG specifies files to use instead of marked. - Usually ARG comes from the command's prefix arg. - If ARG is an integer, use the next ARG files (previous -ARG, if < 0). - If ARG is a cons with element 16, 64, or 256, corresponding to - `C-u C-u', `C-u C-u C-u', or `C-u C-u C-u C-u', then use all files - in the Dired buffer, where: - 16 includes NO directories (including `.' and `..') - 64 includes directories EXCEPT `.' and `..' - 256 includes ALL directories (including `.' and `..') - If ARG is otherwise non-nil, use the current file. -Optional third argument FILTER, if non-nil, is a function to select - some of the files: those for which (funcall FILTER FILENAME) is - non-nil. -If DISTINGUISH-ONE-MARKED is non-nil, then return (t FILENAME) instead - of (FILENAME) if only one file is marked (after any filtering by - FILTER). -If ERROR-IF-NONE-P is non-nil, signal an error if the list of files is - empty. If ERROR-IF-NONE-P is a string then it is the error message. - -Note that the Dired+ version of this function differs from the vanilla -version in these respects: - -* There are more possibilities for argument ARG (prefix argument). -* Directories `.' and `..' can be included as marked. -* You can use arguments FILTER and DISTINGUISH-ONE-MARKED together." - (let ((all (delq nil (save-excursion (dired-map-over-marks (dired-get-filename localp 'NO-ERROR-IF-NOT-FILEP) - arg - nil - distinguish-one-marked)))) - result) - (when (equal all '(t)) (setq all nil)) ; Added by vanilla Emacs 24+. - (if (and distinguish-one-marked (eq (car all) t)) - (if (not filter) - all - (and (funcall filter (cadr all)) (list t (cadr all)))) - (dolist (file all) - (when (or (not filter) (funcall filter file)) (push file result))) - (when (and (null result) error-if-none-p) - (diredp-user-error (if (stringp error-if-none-p) error-if-none-p "No files specified"))) - result))) - - -;; REPLACE ORIGINAL in `dired-aux.el'. -;; -;; 1. Define here to make use of my `dired-map-over-marks'. -;; 2. Added &rest arg FUN-ARGS. -;; 3. Added doc string. -;; -(defun dired-map-over-marks-check (fun mark-arg op-symbol &optional show-progress &rest fun-args) - "Map FUN over marked lines and display failures. -FUN returns non-nil (the offending object, e.g. the short form of the -filename) for a failure and probably logs a detailed error explanation -using function `dired-log'. - -MARK-ARG is as the second argument of `dired-map-over-marks'. - -OP-SYMBOL is a symbol describing the operation performed (e.g. -`compress'). It is used with `dired-mark-pop-up' to prompt the user -\(e.g. with `Compress * [2 files]? ') and to display errors (e.g. -`Failed to compress 1 of 2 files - type ? for details (\"foo\")') - -SHOW-PROGRESS if non-nil means redisplay Dired after each file. - -FUN-ARGS is the list of any remaining args to -`dired-map-over-marks-check'. Function FUN is applied to these -arguments." - (and (dired-mark-confirm op-symbol mark-arg) - (let* ((results (dired-map-over-marks (apply fun fun-args) mark-arg show-progress)) ; FUN return vals. - (nb-results (length results)) - (failures (delq nil results)) - (nb-fail (length failures)) - (op-strg (if (eq op-symbol 'compress) "Compress or uncompress" (capitalize - (symbol-name op-symbol))))) - (if (null failures) - (message "%s: %d file%s." op-strg nb-results (dired-plural-s nb-results)) - (dired-log-summary (format "Failed to %s %d of %d file%s" - (downcase op-strg) nb-fail nb-results (dired-plural-s nb-results)) - failures))))) - -;; Like `dired-map-over-marks-check', but `dired-log-summary' is always called, and first arg passed is different. -;; -(defun diredp-map-over-marks-and-report (fun mark-arg op-symbol &optional show-progress &rest fun-args) - "Map FUN over marked lines and report the results. -FUN returns non-nil (the offending object, e.g. the short form of the -filename) for a failure and probably logs a detailed error explanation -using function `dired-log'. - -MARK-ARG is as the second argument of `dired-map-over-marks'. - -OP-SYMBOL is a symbol describing the operation performed (e.g. -`compress'). It is used with `dired-mark-pop-up' to prompt the user -\(e.g. with `Compress * [2 files]? ') and to display errors (e.g. -`Failed to compress 1 of 2 files - type ? to see why (\"foo\")') - -SHOW-PROGRESS if non-nil means redisplay Dired after each file. - -FUN-ARGS is the list of any remaining args to -`diredp-map-over-marks-and-report'. Function FUN is applied to these -arguments." - (and (dired-mark-confirm op-symbol mark-arg) - (let* ((results (dired-map-over-marks (apply fun fun-args) mark-arg show-progress)) ; FUN return vals. - (nb-results (length results)) - (failures (delq nil results)) - (nb-fail (length failures)) - (op-strg (capitalize (symbol-name op-symbol)))) - (dired-log-summary (format "%s for %d file%s%s" - op-strg nb-results (dired-plural-s nb-results) - (if failures (format ": %d failures" nb-fail) "")) - failures)))) - - -;; REPLACE ORIGINAL in `dired-aux.el'. -;; -(when (boundp 'dired-subdir-switches) ; Emacs 22+ - (defun dired-do-redisplay (&optional arg test-for-subdir) ; Bound to `l' - "Redisplay all marked (or next ARG) files. -If on a subdir line, redisplay that subdirectory. In that case, -a prefix arg lets you edit the `ls' switches used for the new listing. - -Dired remembers switches specified with a prefix arg, so that reverting -the buffer will not reset them. However, using `dired-undo' to re-insert -or delete subdirectories can bypass this machinery. Hence, you sometimes -may have to reset some subdirectory switches after a `dired-undo'. -You can reset all subdirectory switches to the default using -\\\\[dired-reset-subdir-switches]. -See Info node `(emacs)Subdir switches' for more details." - ;; Moves point if the next ARG files are redisplayed. - (interactive "P\np") - (if (and test-for-subdir (dired-get-subdir)) - (let* ((dir (dired-get-subdir)) - (switches (cdr (assoc-string dir dired-switches-alist)))) - (dired-insert-subdir dir (and arg (read-string "Switches for listing: " - (or switches - dired-subdir-switches - dired-actual-switches))))) - (message "Redisplaying...") - ;; `message' is much faster than making `dired-map-over-marks' show progress - (dired-uncache (if (consp dired-directory) (car dired-directory) dired-directory)) - (dired-map-over-marks (let ((fname (dired-get-filename)) - ;; Postpone readin hook map over all marked files (Bug#6810). - (dired-after-readin-hook nil)) - (message "Redisplaying... `%s'" fname) - (dired-update-file-line fname)) - arg) - (run-hooks 'dired-after-readin-hook) - (dired-move-to-filename) - (message "Redisplaying...done")))) - - -;; REPLACE ORIGINAL in `dired-aux.el'. -;; -(unless (boundp 'dired-subdir-switches) ; Emacs 20, 21 - (defun dired-do-redisplay (&optional arg test-for-subdir) ; Bound to `l' - "Redisplay all marked (or next ARG) files. -If on a subdir line, redisplay that subdirectory. In that case, -a prefix arg lets you edit the `ls' switches used for the new listing." - ;; Moves point if the next ARG files are redisplayed. - (interactive "P\np") - (if (and test-for-subdir (dired-get-subdir)) - (dired-insert-subdir (dired-get-subdir) - (and arg (read-string "Switches for listing: " dired-actual-switches))) - (message "Redisplaying...") - ;; `message' is much faster than making dired-map-over-marks show progress - (dired-uncache (if (consp dired-directory) (car dired-directory) dired-directory)) - (dired-map-over-marks (let ((fname (dired-get-filename))) - (message "Redisplaying... `%s'" fname) - (dired-update-file-line fname)) - arg) - (dired-move-to-filename) - (message "Redisplaying...done")))) - - -;; REPLACE ORIGINAL in `dired.el'. -;; -(when (fboundp 'get-window-with-predicate) ; Emacs 22+ - (defun dired-dwim-target-directory () - "Guess a target directory to use for Dired. -If there is a Dired buffer displayed in another window, use its -current subdir, else use current subdir of this Dired buffer." - (let ((this-dir (and (eq major-mode 'dired-mode) (dired-current-directory)))) - ;; Non-dired buffer may want to profit from this function, e.g. `vm-uudecode'. - (if dired-dwim-target - (let* ((other-win (get-window-with-predicate (lambda (window) - (with-current-buffer (window-buffer window) - (eq major-mode 'dired-mode))) - nil - (and diredp-dwim-any-frame-flag 'visible))) - (other-dir (and other-win (with-current-buffer (window-buffer other-win) - (and (eq major-mode 'dired-mode) (dired-current-directory)))))) - (or other-dir this-dir)) - this-dir)))) - - -;; REPLACE ORIGINAL in `dired.el'. -;; -;; 1. Added behavior for non-positive prefix arg: -;; * Construct a cons DIRNAME arg. -;; * Read a Dired buffer name (not a directory) for its car. -;; * If READ-EXTRA-FILES-P is non-nil then read any number of file and dir names, to be included as its cdr. -;; * If chosen Dired buffer exists and is an ordinary listing then start out with its `directory-files'. -;; -;; 2. If you use Icicles then this is a multi-command - see doc for `dired' defadvice. -;; -(defun dired-read-dir-and-switches (string &optional read-extra-files-p dired-buffer) - "Read arguments for `dired' commands. -STRING is added to the prompt after \"Dired \". If not \"\", it should -end with a space. - -With a non-negative prefix arg, read the `ls' switches. -With a non-negative prefix arg or none, read the directory to Dired. - -With a non-positive prefix arg: -* If DIRED-BUFFER is non-nil, it is the name of the Dired buffer to - use. Otherwise, read it (it is not necessarily a directory name). - If in Dired now, the current buffer name is the default. -* If READ-EXTRA-FILES-P is non-nil then read any number of directory - or file names, to make up the Dired arbitrary-files listing. You - can use file-name wildcards (i.e., `*' for globbing), to include the - matching files and directories. Use `C-g' when done entering the - files and directories to list. - -Return a list of arguments for `dired': (DIRNAME SWITCHES). DIRNAME -here has the same form as `dired-directory'. When a non-positive -prefix arg is used, DIRNAME is a cons of the buffer name and the list -of file names. - -If you use Icicles then reading uses Icicles completion, with -additional multi-command keys. See `dired' (defadvice doc)." - (let* ((switchs (and current-prefix-arg - (natnump (prefix-numeric-value current-prefix-arg)) - (read-string "Dired listing switches: " - dired-listing-switches))) - (icicle-candidate-action-fn - (lambda (cand) - (dired-other-window cand (and current-prefix-arg (read-string "Dired listing switches: " - dired-listing-switches))) - (select-window (minibuffer-window)) - (select-frame-set-input-focus (selected-frame)))) -;;; $$$$$$ Alternative: Could choose no-op for non-dir candidate. -;;; (icicle-candidate-action-fn -;;; (lambda (cand) -;;; (cond ((file-directory-p cand) -;;; (dired-other-window cand (and current-prefix-arg (read-string "Dired listing switches: " -;;; dired-listing-switches))) -;;; (select-window (minibuffer-window)) -;;; (select-frame-set-input-focus (selected-frame))) -;;; (t -;;; (message "Not a directory: `%s'" cand) (sit-for 2))))) - (icicle-all-candidates-list-alt-action-fn ; M-|' - (lambda (files) - (let ((enable-recursive-minibuffers t)) - (dired-other-window (cons (read-string (format "Dired %s(buffer name): " string)) files))))) - (icicle-sort-comparer (or (and (boundp 'icicle-file-sort) ; If not reading files - icicle-file-sort) ; then dirs first. - (and (> (prefix-numeric-value current-prefix-arg) 0) - 'icicle-dirs-first-p) - (and (boundp 'icicle-sort-comparer) - icicle-sort-comparer))) - - ;; The rest of the bindings are from `icicle-file-bindings', in `icicles-mac.el'. - (completion-ignore-case - (or (and (boundp 'read-file-name-completion-ignore-case) read-file-name-completion-ignore-case) - completion-ignore-case)) - (icicle-show-Completions-initially-flag (and (boundp 'icicle-show-Completions-initially-flag) - (or icicle-show-Completions-initially-flag - icicle-files-ido-like-flag))) - (icicle-top-level-when-sole-completion-flag (and (boundp 'icicle-top-level-when-sole-completion-flag) - (or icicle-top-level-when-sole-completion-flag - icicle-files-ido-like-flag))) - (icicle-default-value (and (boundp 'icicle-default-value) - (if (and icicle-files-ido-like-flag - icicle-default-value) - icicle-files-ido-like-flag - ;; Get default via `M-n', but do not insert it. - (and (memq icicle-default-value '(t nil)) - icicle-default-value)))) - (icicle-must-match-regexp (and (boundp 'icicle-file-match-regexp) - icicle-file-match-regexp)) - (icicle-must-not-match-regexp (and (boundp 'icicle-file-no-match-regexp) - icicle-file-no-match-regexp)) - (icicle-must-pass-after-match-predicate (and (boundp 'icicle-file-predicate) - icicle-file-predicate)) - (icicle-require-match-flag (and (boundp 'icicle-file-require-match-flag) - icicle-file-require-match-flag)) - (icicle-file-completing-p t) - (icicle-extra-candidates (and (boundp 'icicle-file-extras) icicle-file-extras)) - (icicle-transform-function 'icicle-remove-dups-if-extras) - ;; Put `icicle-file-sort' first. If already in the list, move it, else add it, to beginning. - (icicle--temp-orders (and (boundp 'icicle-sort-orders-alist) - (copy-sequence icicle-sort-orders-alist))) - (icicle-candidate-help-fn (lambda (cand) - (icicle-describe-file cand current-prefix-arg t))) - (icicle-candidate-alt-action-fn (and (boundp 'icicle-candidate-alt-action-fn) - (or icicle-candidate-alt-action-fn - (icicle-alt-act-fn-for-type "file")))) - (icicle-delete-candidate-object 'icicle-delete-file-or-directory) - (icicle-sort-orders-alist - (and (boundp 'icicle-sort-orders-alist) - (progn (when t ; $$$$ (and icicle-file-sort-first-time-p icicle-file-sort) - (setq icicle-sort-comparer icicle-file-sort)) - ; $$$$ (setq icicle-file-sort-first-time-p nil)) - (if icicle-file-sort - (let ((already-there (rassq icicle-file-sort icicle--temp-orders))) - (if already-there - (cons already-there (setq icicle--temp-orders (delete already-there - icicle--temp-orders))) - (cons `("by `icicle-file-sort'" ,@icicle-file-sort) icicle--temp-orders))) - icicle--temp-orders))))) - (when (fboundp 'icicle-bind-file-candidate-keys) (icicle-bind-file-candidate-keys)) - (unwind-protect - (list - (if (> (prefix-numeric-value current-prefix-arg) 0) - ;; If a dialog box is about to be used, call `read-directory-name' so the dialog - ;; code knows we want directories. Some dialog boxes can only select directories - ;; or files when popped up, not both. If no dialog box is used, call `read-file-name' - ;; because the user may want completion of file names for use in a wildcard pattern. - (funcall (if (and (fboundp 'read-directory-name) (next-read-file-uses-dialog-p)) - #'read-directory-name - #'read-file-name) - (format "Dired %s(directory): " string) nil default-directory nil) - (dolist (db dired-buffers) ; Remove any killed buffers from `dired-buffers' (even if DIRED-BUFFER). - (unless (buffer-name (cdr db)) (setq dired-buffers (delq db dired-buffers)))) - (let* ((dbufs (and (not dired-buffer) - (mapcar (lambda (db) (list (buffer-name (cdr db)))) dired-buffers))) - (dirbuf (or dired-buffer - (completing-read (format "Dired %s(buffer name): " string) dbufs nil nil nil nil - (and (derived-mode-p 'dired-mode) (buffer-name))))) - (files (and (diredp-existing-dired-buffer-p dirbuf) - (with-current-buffer (get-buffer dirbuf) - (and (not (consp dired-directory)) - (directory-files dired-directory 'FULL diredp-re-no-dot))))) - file) - (when read-extra-files-p - (while (condition-case nil ; Use lax completion, to allow wildcards. - (setq file (read-file-name "File or dir (C-g when done): ")) - (quit nil)) - ;; Do not allow root dir (`/' or a Windows drive letter, e.g. `d:/'). - (if (diredp-root-directory-p file) - (progn (message "Cannot choose root directory") (sit-for 1)) - (push file files)))) - (cons dirbuf files))) - switchs) - (when (fboundp 'icicle-unbind-file-candidate-keys) (icicle-unbind-file-candidate-keys))))) - - -;;; $$$$$$$$ An alternative implementation - different behavior. -;;; -;;; ;; REPLACE ORIGINAL in `dired.el'. -;;; ;; -;;; ;; Non-positive prefix arg means construct cons DIRNAME arg: Read Dired name and files/dirs. -;;; ;; -;;; (defun dired-read-dir-and-switches (string) -;;; "Read arguments for `dired'. -;;; With a non-negative prefix arg, prompt first for `ls' switches. -;;; With a non-positive prefix arg, read the Dired buffer name and then -;;; read any number of dir or file names, to make up the Dired listing. - -;;; STRING is appended to the prompt, unless prefix arg is non-positive. -;;; If non-empty, STRING should begin with a SPC." -;;; (let ((switches (and current-prefix-arg -;;; (>= (prefix-numeric-value current-prefix-arg) 0) -;;; (read-string "Dired listing switches: " dired-listing-switches))) -;;; (formt (format "Dired %s(directory): " string)) -;;; (entries ()) -;;; (curr-entry "")) -;;; (when (and current-prefix-arg (<= (prefix-numeric-value current-prefix-arg) 0)) -;;; (push (completing-read "Dired buffer name: " dired-buffers) entries) -;;; (setq curr-entry (read-file-name (format "Dir or file: ") nil "" 'MUST-MATCH)) -;;; (while (not (equal "" curr-entry)) -;;; (push curr-entry entries) -;;; (setq curr-entry (read-file-name (format "Dir or file: ") nil "" 'MUST-MATCH))) -;;; (unless (cadr entries) (push default-directory entries))) -;;; (list (or (nreverse entries) (if (and (fboundp 'next-read-file-uses-dialog-p) -;;; (next-read-file-uses-dialog-p)) -;;; (read-directory-name formt nil default-directory nil) -;;; (read-file-name formt nil default-directory nil))) -;;; switches))) - - -;; ADVISE ORIGINAL in `dired.el'. -;; -;; Add to doc string, to document non-positive prefix arg. -;; -(defadvice dired (before diredp-doc-cons-arg activate) - "Interactively, a prefix argument changes the behavior as follows: - -* If >= 0, you are first prompted for the `ls' switches to use. - -* If <= 0, you are prompted first for the name of the Dired buffer. - Then you are prompted repeatedly for the names of the directories - or files to list in the buffer. You can use file-name wildcards - (i.e., `*' for globbing), to include the matching files and - directories. Use `C-g' to end. - - In other words, instead of listing a single directory, the Dired - buffer can list any number of directories and file names, which can - even belong to different directory trees. - -The rest of this description applies only if you use Icicles. - -In Icicle mode this is a multi-command: You can cycle among file-name -completion candidates and act individually on those that name -directories. The action is to open Dired for the directory. While -cycling, these keys are active: - -\\\ -`C-mouse-2', `C-return' - Act on current completion candidate only -`C-down', `C-wheel-down' - Move to next completion candidate and act -`C-up', `C-wheel-up' - Move to previous completion candidate and act -`C-next' - Move to next apropos-completion candidate and act -`C-prior' - Move to previous apropos-completion candidate and act -`C-end' - Move to next prefix-completion candidate and act -`C-home' - Move to previous prefix-completion candidate and act -`\\[icicle-all-candidates-action]' - Act on *all* candidates, successively (careful!) -`\\[icicle-all-candidates-list-alt-action]' - Open Dired on all candidates - -When candidate action and cycling are combined (e.g. `C-next'), user -option `icicle-act-before-cycle-flag' determines which occurs first. - -With prefix `C-M-' instead of `C-', the same keys (`C-M-mouse-2', -`C-M-RET', `C-M-down', and so on) provide help about candidates. - -Use `mouse-2', `RET', or `S-RET' to finally choose a candidate, or -`C-g' to quit. - -These keys are also bound in the minibuffer during completion (`*' -means the key requires library `Bookmark+'): - - S-delete - Delete candidate file or (empty) dir - C-c + - Create a new directory - C-backspace - Go up one directory level - * C-x C-t * - Narrow to files with all of the tags you specify - * C-x C-t + - Narrow to files with some of the tags you specify - * C-x C-t % * - Narrow to files with all tags matching a regexp - * C-x C-t % + - Narrow to files with some tags matching a regexp - * C-x a + - Add tags to the current-candidate file - * C-x a - - Remove tags from the current-candidate file - * C-x m - Access file bookmarks (not just autofiles)" - (interactive (dired-read-dir-and-switches "" 'READ-EXTRA-FILES-P))) - - -;; ADVISE ORIGINAL in `dired.el'. -;; -;; Add to doc string, to document non-positive prefix arg. -;; -(defadvice dired-other-window (before diredp-doc-cons-arg activate) - "Interactively, a prefix argument changes the behavior. -A non-positive prefix arg lets you choose an explicit set of files and -directories to list. See the advice for `dired' for more information." - (interactive (dired-read-dir-and-switches "" 'READ-EXTRA-FILES-P))) - - -;; ADVISE ORIGINAL in `dired.el'. -;; -;; Add to doc string, to document non-positive prefix arg. -;; -(defadvice dired-other-frame (before diredp-doc-cons-arg activate) - "Interactively, a prefix argument changes the behavior. -A non-positive prefix arg lets you choose an explicit set of files and -directories to list. See the advice for `dired' for more information." - (interactive (dired-read-dir-and-switches "" 'READ-EXTRA-FILES-P))) - - -;; REPLACE ORIGINAL in `dired.el'. -;; -;; Made compatible with Emacs 20, 21, which do not have [:alnum]. -;; Also, this is defined here because it is used elsewhere in the file. -;; -(defun dired-switches-escape-p (switches) - "Return non-nil if the string SWITCHES contains `-b' or `--escape'." - (if (fboundp 'dired-switches-check) ; Emacs 24.4+ - see Emacs bug #17218. - (dired-switches-check switches "escape" "b") - ;; Do not match things like "--block-size" that happen to contain "b". - (if (> emacs-major-version 21) ; SWITCHES must be a string here, not nil. - (diredp-string-match-p "\\(\\`\\| \\)-[[:alnum:]]*b\\|--escape\\>" switches) - (diredp-string-match-p "\\(\\`\\| \\)-\\(\w\\|[0-9]\\)*b\\|--escape\\>" switches)))) - - -;; From `dired.el' - -(when (and (> emacs-major-version 22) (featurep 'ls-lisp+)) - -;;; 2012/04/26: Commented this out. -;;; Might need it again when update `ls-lisp+.el' to fix other things. -;;; -;;; ;; Use t as WILDCARD arg to `dired-insert-directory'. -;;; ;; -;;; (defun dired-readin-insert () -;;; ;; Insert listing for the specified dir (and maybe file list) -;;; ;; already in dired-directory, assuming a clean buffer. -;;; (let (dir file-list) -;;; (if (consp dired-directory) -;;; (setq dir (car dired-directory) -;;; file-list (cdr dired-directory)) -;;; (setq dir dired-directory -;;; file-list ())) -;;; (setq dir (expand-file-name dir)) -;;; (if (and (equal "" (file-name-nondirectory dir)) (not file-list)) -;;; ;; If we are reading a whole single directory... -;;; (dired-insert-directory dir dired-actual-switches nil nil t) -;;; (unless (file-readable-p (directory-file-name (file-name-directory dir))) -;;; (error "Directory `%s' inaccessible or nonexistent" dir)) -;;; ;; Else treat it as a wildcard spec. -;;; (dired-insert-directory dir dired-actual-switches file-list t t)))) - - - ;; REPLACE ORIGINAL in `dired.el'. - ;; - ;; Compute WILDCARD arg for `insert-directory' for individual file (don't just use nil). - ;; - (defun dired-insert-directory (dir switches &optional file-list wildcard hdr) - "Insert a directory listing of DIR, Dired style. -Use SWITCHES to make the listings. -If FILE-LIST is non-nil, list only those files. -Otherwise, if WILDCARD is non-nil, expand wildcards; - in that case, DIR should be a file name that uses wildcards. -In other cases, DIR should be a directory name or a directory filename. -If HDR is non-nil, insert a header line with the directory name." - (let ((opoint (point)) - (process-environment (copy-sequence process-environment)) - end) - (when (and - ;; Do not try to invoke `ls' if on DOS/Windows, where `ls-lisp' is used, unless - ;; the user really wants to use `ls', as indicated by - ;; `ls-lisp-use-insert-directory-program'. - (or (not (featurep 'ls-lisp)) ls-lisp-use-insert-directory-program) - (or (if (eq dired-use-ls-dired 'unspecified) - ;; Check if "ls --dired" gives exit code 0. Put it in `dired-use-ls-dired'. - (or (setq dired-use-ls-dired (eq 0 (call-process insert-directory-program - nil nil nil "--dired"))) - (progn (message "Command `ls' does not support switch `--dired' - see \ -`dired-use-ls-dired'.") - nil)) - dired-use-ls-dired) - (file-remote-p dir))) - (setq switches (concat "--dired " switches))) - ;; We used to specify the C locale here, to force English month names. This should not be - ;; necessary any more with the new value of `directory-listing-before-filename-regexp'. - (if file-list - (dolist (f file-list) - (let ((beg (point))) - ;; Compute wildcard arg for this file. - (insert-directory f switches (diredp-string-match-p "[[?*]" f) nil) - ;; Re-align fields, if necessary. - (dired-align-file beg (point)))) - (insert-directory dir switches wildcard (not wildcard))) - ;; Quote certain characters, unless `ls' quoted them for us. - (unless (dired-switches-escape-p dired-actual-switches) - (save-excursion - (setq end (point-marker)) - (goto-char opoint) - (while (search-forward "\\" end t) - (replace-match (apply #'propertize "\\\\" (text-properties-at (match-beginning 0))) - nil t)) - (goto-char opoint) - (while (search-forward "\^m" end t) - (replace-match (apply #'propertize "\\015" (text-properties-at (match-beginning 0))) - nil t)) - (set-marker end nil)) - ;; Comment in original, from some Emacs Dev developer: - ;; - ;; Replace any newlines in DIR with literal "\n" for the sake of the header line. To - ;; disambiguate a literal "\n" in the actual dirname, we also replace "\" with "\\". - ;; I think this should always be done, irrespective of the value of - ;; dired-actual-switches, because: - ;; i) Dired does not work with an unescaped newline in the directory name used in the - ;; header (bug=10469#28), and - ;; ii) "\" is always replaced with "\\" in the listing, so doing it in the header as - ;; well makes things consistent. - ;; But at present it is done only if "-b" is in ls-switches, because newlines in dirnames - ;; are uncommon, and people may have gotten used to seeing unescaped "\" in the headers. - ;; Note: adjust `dired-build-subdir-alist' if you change this. - (setq dir (replace-regexp-in-string "\\\\" "\\\\" dir nil t) - dir (replace-regexp-in-string "\n" "\\n" dir nil t))) - ;; If we used `--dired' and it worked, the lines are already indented. Else indent them. - (unless (save-excursion (goto-char opoint) (diredp-looking-at-p " ")) - (let ((indent-tabs-mode nil)) (indent-rigidly opoint (point) 2))) - ;; Insert text at the beginning to standardize things. - (let ((content-point opoint)) - (save-excursion - (goto-char opoint) - (when (and (or hdr wildcard) (not (and (looking-at "^ \\(.*\\):$") - (file-name-absolute-p (match-string 1))))) - ;; `dired-build-subdir-alist' will replace the name by its expansion, so it does not - ;; matter whether what we insert here is fully expanded, but it should be absolute. - (insert " " (directory-file-name (file-name-directory dir)) ":\n") - (setq content-point (point))) - (when wildcard - ;; Insert "wildcard" line where "total" line would be for a full dir. - (insert " wildcard " (file-name-nondirectory dir) "\n"))) - (dired-insert-set-properties content-point (point)))))) - - -;;; Image stuff. - -(defun diredp-image-dired-required-msg () - "Raise an error if `image-dired.el' is not loaded." - (unless (require 'image-dired nil t) (error "This command requires library `image-dired.el'"))) - -;; See `image-dired-create-thumb'. -;; Define this even if `image-dired.el' is not loaded. -;; Do NOT raise an error if not loaded, because this is used in `diredp-mouseover-help'. -;;;###autoload -(defun diredp-image-dired-create-thumb (file &optional arg) - "Create thumbnail image file for FILE (default: file on current line). -With a prefix arg, replace any existing thumbnail for FILE. -With a numeric prefix arg (not a cons), use it as the thumbnail size. -Return the name of the thumbnail image file, or nil if none." - (interactive (list (if (derived-mode-p 'dired-mode) - (dired-get-filename nil 'NO-ERROR) - ;; Make it work also for `diredp-list-files' listings. - (buffer-substring-no-properties (line-beginning-position) (line-end-position))) - current-prefix-arg)) - (and (fboundp 'image-dired-thumb-name) ; No-op (return nil) if `image-dired.el' not loaded. - (let ((thumb-name (image-dired-thumb-name file))) - (when arg (clear-image-cache)) - (when (or arg (not (file-exists-p thumb-name))) - (let ((image-dired-thumb-width (or (and arg (atom arg) arg) image-dired-thumb-width)) - (image-dired-thumb-height (or (and arg (atom arg) arg) image-dired-thumb-height))) - (unless (zerop (image-dired-create-thumb file thumb-name)) - (error "Thumbnail image file could not be created")))) - (and (file-exists-p thumb-name) thumb-name)))) - - -;; REPLACE ORIGINAL in `image-dired.el' (Emacs 22-23). -;; -;; 1. Raise an error if `image-dired.el' is not available. -;; 2. Repro it here so it picks up `Dired+' version of `dired-map-over-marks'. -;; -;;;###autoload -(defun image-dired-dired-insert-marked-thumbs () ; Bound to `C-t C-t' (Emacs 22-23) - "Insert thumbnails before file names of marked files in the Dired buffer." - (interactive (progn (diredp-image-dired-required-msg) ())) - (dired-map-over-marks - (let* ((image-pos (dired-move-to-filename)) - (image-file (dired-get-filename)) - (thumb-file (image-dired-get-thumbnail-image image-file)) - overlay) - ;; If image is not already added, then add it. - (unless (delq nil (mapcar (lambda (o) (overlay-get o 'put-image)) - ;; Can't use (overlays-at (point)), BUG? - (overlays-in (point) (1+ (point))))) - (put-image thumb-file image-pos) - (setq overlay (car (delq nil (mapcar (lambda (ov) (and (overlay-get ov 'put-image) ov)) - (overlays-in (point) (1+ (point))))))) - (overlay-put overlay 'image-file image-file) - (overlay-put overlay 'thumb-file thumb-file))) - nil) - (add-hook 'dired-after-readin-hook 'image-dired-dired-after-readin-hook nil t)) - - -;; REPLACE ORIGINAL in `image-dired.el' (Emacs 24+). -;; -;; 1. Raise an error if `image-dired.el' is not available. -;; 2. Repro it here so it picks up `Dired+' version of `dired-map-over-marks'. -;; -;;;###autoload -(defun image-dired-dired-toggle-marked-thumbs (&optional arg) ; Bound to `C-t C-t' (Emacs 24+) - "Toggle thumbnails in front of file names in Dired. -If no files are marked, insert or hide thumbnails on the current line. -With a numeric prefix arg N, ignore marked files and act on the next N -files (previous -N files, if N < 0)." - (interactive (progn (diredp-image-dired-required-msg) (list current-prefix-arg))) - (dired-map-over-marks - (let* ((image-pos (dired-move-to-filename)) - (image-file (diredp-get-image-filename nil 'NO-ERROR)) - thumb-file overlay) - (when image-file - (setq thumb-file (image-dired-get-thumbnail-image image-file)) - ;; If image is not already added, then add it. - (let* ((cur-ovs (overlays-in (point) (1+ (point)))) - (thumb-ov (car (diredp-remove-if-not (lambda (ov) (overlay-get ov 'thumb-file)) - cur-ovs)))) - (if thumb-ov - (delete-overlay thumb-ov) - (put-image thumb-file image-pos) - (setq overlay (car (delq nil (mapcar (lambda (ov) (and (overlay-get ov 'put-image) ov)) - (overlays-in (point) (1+ (point))))))) - (overlay-put overlay 'image-file image-file) - (overlay-put overlay 'thumb-file thumb-file))))) - arg - 'SHOW-PROGRESS) - (add-hook 'dired-after-readin-hook 'image-dired-dired-after-readin-hook nil t)) - -;; Corresponds to `image-dired-dired-comment-files'. -;;;###autoload -(defun diredp-image-dired-comment-file () - "Add comment to this image file." - (interactive (progn (diredp-image-dired-required-msg) ())) - (image-dired-write-comments (cons (dired-get-filename) (image-dired-read-comment)))) - -;; Corresponds to `image-dired-tag-files'. -;;;###autoload -(defun diredp-image-dired-tag-file () - "Tag this image file with an `image-dired' tag." - (interactive (progn (diredp-image-dired-required-msg) ())) - (image-dired-write-tags (cons (dired-get-filename) - (read-string "Tags to add (use `;' to separate): ")))) - -;; Corresponds to `image-dired-delete-tag'. -;;;###autoload -(defun diredp-image-dired-delete-tag () - "Remove an `image-dired' tag from this image file." - (interactive (progn (diredp-image-dired-required-msg) ())) - (image-dired-remove-tag (list (dired-get-filename)) (read-string "Tag to remove: "))) - -;; Corresponds to `image-dired-display-thumbs'. -;;;###autoload -(defun diredp-image-dired-display-thumb (&optional append) - "Pop to thumbnail of this image file, in `image-dired-thumbnail-buffer'. -If a thumbnail image does not yet exist for this file, create it. -With a prefix arg, append the thumbnail to the thumbnails buffer, -instead of clearing the buffer first." - (interactive (progn (diredp-image-dired-required-msg) (list current-prefix-arg))) - (let* ((dired-buf (current-buffer)) - (curr-file (dired-get-filename)) - (thumb-name (image-dired-thumb-name curr-file))) - (with-current-buffer (image-dired-create-thumbnail-buffer) - (let ((inhibit-read-only t)) - (if (not append) (erase-buffer) (goto-char (point-max))) - (if (and (not (file-exists-p thumb-name)) - (not (zerop (image-dired-create-thumb curr-file thumb-name)))) - (message "Cannot create thumbnail image for file `%s'" curr-file) - (image-dired-insert-thumbnail thumb-name curr-file dired-buf))) - (cond ((eq 'dynamic image-dired-line-up-method) (image-dired-line-up-dynamic)) - ((eq 'fixed image-dired-line-up-method) (image-dired-line-up)) - ((eq 'interactive image-dired-line-up-method) (image-dired-line-up-interactive)) - ((eq 'none image-dired-line-up-method) nil) - (t (image-dired-line-up-dynamic)))) - (pop-to-buffer image-dired-thumbnail-buffer))) - -;; Corresponds to `image-dired-copy-with-exif-file-name'. -;;;###autoload -(defun diredp-image-dired-copy-with-exif-name () - "Copy this image file to your main image directory. -Uses `image-dired-get-exif-file-name' to name the new file." - (interactive (progn (diredp-image-dired-required-msg) ())) - (let* ((curr-file (dired-get-filename)) - (new-name (format "%s/%s" (file-name-as-directory - (expand-file-name image-dired-main-image-directory)) - (image-dired-get-exif-file-name curr-file)))) - (message "Copying `%s' to `%s'..." curr-file new-name) - (copy-file curr-file new-name) - (message "Copying `%s' to `%s'...done" curr-file new-name))) - -;; Corresponds to `image-dired-dired-edit-comment-and-tags'. -;;;###autoload -(defun diredp-image-dired-edit-comment-and-tags () - "Edit comment and tags for this image file." - (interactive (progn (diredp-image-dired-required-msg) ())) - (setq image-dired-widget-list ()) - (let ((file (dired-get-filename))) - (if (fboundp 'pop-to-buffer-same-window) - (pop-to-buffer-same-window "*Image-Dired Edit Meta Data*") - (switch-to-buffer "*Image-Dired Edit Meta Data*")) - (kill-all-local-variables) - (make-local-variable 'widget-example-repeat) - (let ((inhibit-read-only t)) - (erase-buffer) - (remove-overlays) - (widget-insert - "\nEdit comment and tags for the image. Separate multiple tags -with a comma (`,'). Move forward among fields using `TAB' or `RET'. -Move backward using `S-TAB'. Click `Save' to save your edits or -`Cancel' to abandon them.\n\n") - (let* ((thumb-file (image-dired-thumb-name file)) - (img (create-image thumb-file)) - comment-widget tag-widget) - (insert-image img) - (widget-insert "\n\nComment: ") - (setq comment-widget (widget-create 'editable-field :size 60 :format "%v " - :value (or (image-dired-get-comment file) ""))) - (widget-insert "\nTags: ") - (setq tag-widget (widget-create 'editable-field :size 60 :format "%v " - :value (or (mapconcat #'identity (image-dired-list-tags file) ",") ""))) - ;; Save info in widgets to use when the user saves the form. - (setq image-dired-widget-list (append image-dired-widget-list - (list (list file comment-widget tag-widget)))) - (widget-insert "\n\n"))) - (widget-insert "\n") - (widget-create 'push-button :notify (lambda (&rest _ignore) - (image-dired-save-information-from-widgets) - (bury-buffer) - (message "Done")) - "Save") - (widget-insert " ") - (widget-create 'push-button :notify (lambda (&rest _ignore) - (bury-buffer) - (message "Operation canceled")) - "Cancel") - (widget-insert "\n") - (use-local-map widget-keymap) - (widget-setup) - (widget-forward 1))) ; Jump to the first widget. - -;;;###autoload -(defun diredp-do-display-images (&optional arg) - "Display the marked image files. -A prefix argument ARG specifies files to use instead of those marked. - An integer means use the next ARG files (previous -ARG, if < 0). - `C-u': Use the current file (whether or not any files are marked). - More than one `C-u' means use all files in the Dired buffer, as if - they were all marked." - (interactive (progn (unless (require 'image-file nil t) - (error "This command requires library `image-file.el'")) - (diredp-ensure-mode) - (list current-prefix-arg))) - (dired-map-over-marks-check #'diredp-display-image arg 'display\ image - (diredp-fewer-than-2-files-p arg))) - -(defun diredp-display-image () - "Display image file at point. Log an error using `dired-log'." - (let ((file (dired-get-filename 'LOCAL 'NO-ERROR)) - (failure nil)) - (save-excursion - (if (let ((inhibit-changing-match-data t)) - (and file (diredp-string-match-p (image-file-name-regexp) file))) - (condition-case err - (let ((find-file-run-dired nil)) (find-file-other-window file)) - (error (setq failure (error-message-string err)))) - (dired-log (format "Not an image file: `%s'" file)) - (setq failure t))) - (and failure ; Return nil for success. - (prog1 file ; Return file name for failure. - (unless (eq t failure) (dired-log "Cannot display image file `%s':\n%s\n" file failure) t))))) - -;;;###autoload -(defun diredp-image-show-this-file (&optional arg) - "Show the image file named on this line in another frame or window. -Option `diredp-image-show-this-file-use-frame-flag' which is used. - -With a prefix arg, shrink the image to fit a frame that many lines -high or a window at least that many lines high. -Otherwise, show the image full size. -Note: - * To show the image full size, you can also use `\\\\[dired-find-file]'. - * To show the image in another window, at whatever scale fits there, - you can use `\\[image-dired-dired-display-image]'." - (interactive (progn (diredp-image-dired-required-msg) (list current-prefix-arg))) - (image-dired-create-display-image-buffer) - (let ((fit-frame-inhibit-fitting-flag t) ; In `fit-frame.el'. - (img-file (diredp-get-image-filename))) - (if img-file - (with-current-buffer image-dired-display-image-buffer - (let* ((window-min-height (if arg - (prefix-numeric-value arg) - (ceiling (cdr (image-size (create-image img-file)))))) - (special-display-frame-alist (if diredp-image-show-this-file-use-frame-flag - (cons `(height . ,window-min-height) - special-display-frame-alist) - special-display-frame-alist)) - (special-display-buffer-names (if diredp-image-show-this-file-use-frame-flag - (cons image-dired-display-image-buffer - special-display-buffer-names) - special-display-buffer-names))) - (display-buffer image-dired-display-image-buffer) - (image-dired-display-image img-file (not arg)))) - (message "No image file here")))) ; An error is handled by `diredp-get-image-filename'. - -(defun diredp-report-file-result (file result failure echop) - (cond (failure - (when echop (message "Error for %s:\n%s\n" file failure) (sit-for 1)) - (dired-log "Error for %s:\n%s\n" file failure) - (dired-make-relative file)) ; Return file name for failure. - (t - (when echop (message "Result for %s:\n%s\n" file result) (sit-for 1)) - (dired-log "Result for %s:\n%s\n" file result) - nil))) ; Return nil for success. - -;;;###autoload -(defun diredp-do-emacs-command (command &optional arg) - "Invoke an Emacs COMMAND in each marked file. -Visit each marked file at its beginning, then invoke COMMAND. -You are prompted for the COMMAND. - -The result returned for each file is logged by `dired-log'. Use `?' -to see all such results and any error messages. If there are fewer -marked files than `diredp-do-report-echo-limit' then each result is -also echoed momentarily. - -A prefix argument behaves according to the ARG argument of -`dired-get-marked-files'. In particular, `C-u C-u' operates on all -files in the Dired buffer." - (interactive (progn (diredp-ensure-mode) - (list (diredp-read-command) current-prefix-arg))) - (save-selected-window - (diredp-map-over-marks-and-report - #'diredp-invoke-emacs-command arg 'invoke\ emacs\ command (diredp-fewer-than-2-files-p arg) - command (diredp-fewer-than-echo-limit-files-p arg)))) - -(defun diredp-invoke-emacs-command (command &optional echop) - "Visit file of this line at its beginning, then invoke COMMAND. -Log the result returned or any error. -Non-nil optional arg ECHOP means also echo the result." - (let* ((file (dired-get-filename)) - (failure (not (file-exists-p file))) - result) - (unless failure - (condition-case err - (with-current-buffer (find-file-noselect file) - (save-excursion - (goto-char (point-min)) - (setq result (call-interactively command)))) - (error (setq failure err)))) - (diredp-report-file-result file result failure echop))) - -(defun diredp-read-command (&optional prompt default) - "Read the name of a command and return a symbol with that name. -\(A command is anything that satisfies predicate `commandp'.) -Prompt with PROMPT, which defaults to \"Command: \". -By default, return the command named DEFAULT (or, with Emacs 23+, its -first element if DEFAULT is a list). (If DEFAULT does not name a -command then it is ignored.)" - (setq prompt (or prompt "Command: ")) - (let ((name (completing-read prompt obarray #'commandp t nil - 'extended-command-history default))) - (while (string= "" name) - (setq name (completing-read prompt obarray #'commandp t nil - 'extended-command-history default))) - (intern name))) - -(when (fboundp 'diredp-read-expression) ; Emacs 22+ - - (defun diredp-do-lisp-sexp (sexp &optional arg) - "Evaluate an Emacs-Lisp SEXP in each marked file. -Visit each marked file at its beginning, then evaluate SEXP. -You are prompted for the SEXP. - -The result returned for each file is logged by `dired-log'. Use `?' -to see all such results and any error messages. If there are fewer -marked files than `diredp-do-report-echo-limit' then each result is -also echoed momentarily. - -A prefix argument behaves according to the ARG argument of -`dired-get-marked-files'. In particular, `C-u C-u' operates on all -files in the Dired buffer." - (interactive (progn (diredp-ensure-mode) - (list (diredp-read-expression "Sexp: ") current-prefix-arg))) - (save-selected-window - (diredp-map-over-marks-and-report - #'diredp-eval-lisp-sexp arg 'eval\ elisp\ sexp (diredp-fewer-than-2-files-p arg) - sexp (diredp-fewer-than-echo-limit-files-p arg)))) - - (defun diredp-eval-lisp-sexp (sexp &optional echop) - "Visit file of this line at its beginning, then evaluate SEXP. -Log the result returned or any error. -Non-nil optional arg ECHOP means also echo the result." - (let* ((file (dired-get-filename)) - (failure (not (file-exists-p file))) - result) - (unless failure - (condition-case err - (with-current-buffer (find-file-noselect file) - (save-excursion - (goto-char (point-min)) - (setq result (eval-expression sexp)))) - (error (setq failure err)))) - (diredp-report-file-result file result failure echop))) - - ) - -;;; Face Definitions - -(defface diredp-autofile-name - '((((background dark)) (:background "#111313F03181")) ; Very dark blue - (t (:background "#EEECEC0FCE7E"))) ; Very pale goldenrod - "*Face used in Dired for names of files that are autofile bookmarks." - :group 'Dired-Plus :group 'font-lock-highlighting-faces) -(defvar diredp-autofile-name 'diredp-autofile-name) - -(defface diredp-compressed-file-name - '((((background dark)) (:foreground "Blue")) - (t (:foreground "Brown"))) - "*Face used for compressed file names." - :group 'Dired-Plus :group 'font-lock-highlighting-faces) -(defvar diredp-compressed-file-name 'diredp-compressed-file-name) - -(defface diredp-compressed-file-suffix - '((((background dark)) (:foreground "Blue")) - (t (:foreground "Yellow"))) - "*Face used for compressed file suffixes in Dired buffers. -This means the `.' plus the file extension. Example: `.zip'." - :group 'Dired-Plus :group 'font-lock-highlighting-faces) -(defvar diredp-compressed-file-suffix 'diredp-compressed-file-suffix) - -(defface diredp-date-time - '((((background dark)) (:foreground "#74749A9AF7F7")) ; ~ med blue - (t (:foreground "DarkGoldenrod4"))) - "*Face used for date and time in Dired buffers." - :group 'Dired-Plus :group 'font-lock-highlighting-faces) -(defvar diredp-date-time 'diredp-date-time) - -(defface diredp-deletion - '((t (:foreground "Yellow" :background "Red"))) - "*Face used for deletion flags (D) in Dired buffers." - :group 'Dired-Plus :group 'font-lock-highlighting-faces) -(defvar diredp-deletion 'diredp-deletion) - -(defface diredp-deletion-file-name - '((t (:foreground "Red"))) - "*Face used for names of deleted files in Dired buffers." - :group 'Dired-Plus :group 'font-lock-highlighting-faces) -(defvar diredp-deletion-file-name 'diredp-deletion-file-name) - -(defface diredp-dir-heading - '((((background dark)) (:foreground "Yellow" :background "#00003F3F3434")) ; ~ dark green - (t (:foreground "Blue" :background "Pink"))) - "*Face used for directory headings in Dired buffers." - :group 'Dired-Plus :group 'font-lock-highlighting-faces) -(defvar diredp-dir-heading 'diredp-dir-heading) - -(defface diredp-dir-name - '((((background dark)) - (:foreground "#7474FFFFFFFF" :background "#2C2C2C2C2C2C")) ; ~ cyan, dark gray - (t (:foreground "DarkRed" :background "LightGray"))) - "*Face used for directory names." - :group 'Dired-Plus :group 'font-lock-highlighting-faces) -(defvar diredp-dir-name 'diredp-dir-name) - -(defface diredp-dir-priv - '((((background dark)) - (:foreground "#7474FFFFFFFF" :background "#2C2C2C2C2C2C")) ; ~ cyan, dark gray - (t (:foreground "DarkRed" :background "LightGray"))) - "*Face used for directory privilege indicator (d) in Dired buffers." - :group 'Dired-Plus :group 'font-lock-highlighting-faces) -(defvar diredp-dir-priv 'diredp-dir-priv) - -(defface diredp-exec-priv - '((((background dark)) (:background "#4F4F3B3B2121")) ; ~ dark brown - (t (:background "LightSteelBlue"))) - "*Face used for execute privilege indicator (x) in Dired buffers." - :group 'Dired-Plus :group 'font-lock-highlighting-faces) -(defvar diredp-exec-priv 'diredp-exec-priv) - -;; For this to show up, you need `F' among the options in `dired-listing-switches'. -;; For example, I use "-alF" for `dired-listing-switches'. -(defface diredp-executable-tag - '((t (:foreground "Red"))) - "*Face used for executable tag (*) on file names in Dired buffers." - :group 'Dired-Plus :group 'font-lock-highlighting-faces) -(defvar diredp-executable-tag 'diredp-executable-tag) - -(defface diredp-file-name - '((((background dark)) (:foreground "Yellow")) - (t (:foreground "Blue"))) - "*Face used for file names (without suffixes) in Dired buffers. -This means the base name. It does not include the `.'." - :group 'Dired-Plus :group 'font-lock-highlighting-faces) -(defvar diredp-file-name 'diredp-file-name) - -(defface diredp-file-suffix - '((((background dark)) (:foreground "#7474FFFF7474")) ; ~ light green - (t (:foreground "DarkMagenta"))) - "*Face used for file suffixes in Dired buffers. -This means the `.' plus the file extension. Example: `.elc'." - :group 'Dired-Plus :group 'font-lock-highlighting-faces) -(defvar diredp-file-suffix 'diredp-file-suffix) - -(defface diredp-flag-mark - '((((background dark)) (:foreground "Blue" :background "#7575D4D41D1D")) ; ~ olive green - (t (:foreground "Yellow" :background "Blueviolet"))) - "*Face used for flags and marks (except D) in Dired buffers." - :group 'Dired-Plus :group 'font-lock-highlighting-faces) -(defvar diredp-flag-mark 'diredp-flag-mark) - -(defface diredp-flag-mark-line - '((((background dark)) (:background "#787831311414")) ; ~ dark red brown - (t (:background "Skyblue"))) - "*Face used for flagged and marked lines in Dired buffers." - :group 'Dired-Plus :group 'font-lock-highlighting-faces) -(defvar diredp-flag-mark-line 'diredp-flag-mark-line) - -(defface diredp-ignored-file-name - '((((background dark)) (:foreground "#C29D6F156F15")) ; ~ salmon - (t (:foreground "#00006DE06DE0"))) ; ~ dark cyan - "*Face used for files whose names are omitted based on the extension. -See also face `diredp-omit-file-name'." - :group 'Dired-Plus :group 'font-lock-highlighting-faces) -(defvar diredp-ignored-file-name 'diredp-ignored-file-name) - -(defface diredp-link-priv - '((((background dark)) (:foreground "#00007373FFFF")) ; ~ blue - (t (:foreground "DarkOrange"))) - "*Face used for link privilege indicator (l) in Dired buffers." - :group 'Dired-Plus :group 'font-lock-highlighting-faces) -(defvar diredp-link-priv 'diredp-link-priv) - -(when (> emacs-major-version 21) - (defface diredp-mode-line-marked - '((t (:foreground "DarkViolet"))) - "*Face for marked number in mode-line `mode-name' for Dired buffers." - :group 'Dired-Plus :group 'font-lock-highlighting-faces) - - (defface diredp-mode-line-flagged - '((t (:foreground "Red"))) - "*Face for flagged number in mode-line `mode-name' for Dired buffers." - :group 'Dired-Plus :group 'font-lock-highlighting-faces)) - -(defface diredp-no-priv - '((((background dark)) (:background "#2C2C2C2C2C2C")) ; ~ dark gray - (t (:background "LightGray"))) - "*Face used for no privilege indicator (-) in Dired buffers." - :group 'Dired-Plus :group 'font-lock-highlighting-faces) -(defvar diredp-no-priv 'diredp-no-priv) - -(defface diredp-number - '((((background dark)) (:foreground "#FFFFFFFF7474")) ; ~ light yellow - (t (:foreground "DarkBlue"))) - "*Face used for numerical fields in Dired buffers. -In particular, inode number, number of hard links, and file size." - :group 'Dired-Plus :group 'font-lock-highlighting-faces) -(defvar diredp-number 'diredp-number) - -(defface diredp-omit-file-name - (if (assq :inherit custom-face-attributes) ; Emacs 22+ - '((((background dark)) (:inherit diredp-ignored-file-name :strike-through "#555555555555")) ; ~ dark gray - (t (:inherit diredp-ignored-file-name :strike-through "#AAAAAAAAAAAA"))) ; ~ light gray - '((((background dark)) (:foreground "#C29D6F156F15")) ; ~ salmon - (t (:foreground "#00006DE06DE0")))) ; ~ dark cyan - "*Face used for files whose names will be omitted in `dired-omit-mode'. -This means file names that match regexp `diredp-omit-files-regexp'. -\(File names matching `dired-omit-extensions' are highlighted with face -`diredp-ignored-file-name' instead.)" - :group 'Dired-Plus :group 'font-lock-highlighting-faces) -(defvar diredp-omit-file-name 'diredp-omit-file-name) - -(defface diredp-other-priv - '((((background dark)) (:background "#111117175555")) ; ~ dark blue - (t (:background "PaleGoldenrod"))) - "*Face used for l,s,S,t,T privilege indicators in Dired buffers." - :group 'Dired-Plus :group 'font-lock-highlighting-faces) -(defvar diredp-other-priv 'diredp-other-priv) - -(defface diredp-rare-priv - '((((background dark)) (:foreground "Green" :background "#FFFF00008080")) ; ~ hot pink - (t (:foreground "Magenta" :background "SpringGreen"))) - "*Face used for rare privilege indicators (b,c,s,m,p,S) in Dired buffers." - :group 'Dired-Plus :group 'font-lock-highlighting-faces) -(defvar diredp-rare-priv 'diredp-rare-priv) - -(defface diredp-read-priv - '((((background dark)) (:background "#999932325555")) ; ~ burgundy / dark magenta - (t (:background "MediumAquamarine"))) - "*Face used for read privilege indicator (w) in Dired buffers." - :group 'Dired-Plus :group 'font-lock-highlighting-faces) -(defvar diredp-read-priv 'diredp-read-priv) - -(defface diredp-symlink - '((((background dark)) (:foreground "#00007373FFFF")) ; ~ blue - (t (:foreground "DarkOrange"))) - "*Face used for symbolic links in Dired buffers." - :group 'Dired-Plus :group 'font-lock-highlighting-faces) -(defvar diredp-symlink 'diredp-symlink) - -(defface diredp-tagged-autofile-name - '((((background dark)) (:background "#328C0411328C")) ; Very dark magenta - (t (:background "#CD73FBEECD73"))) ; Very pale green - "*Face used in Dired for names of files that are autofile bookmarks." - :group 'Dired-Plus :group 'font-lock-highlighting-faces) -(defvar diredp-tagged-autofile-name 'diredp-tagged-autofile-name) - -(defface diredp-write-priv - '((((background dark)) (:background "#25258F8F2929")) ; ~ dark green - (t (:background "Orchid"))) - "*Face used for write privilege indicator (w) in Dired buffers." - :group 'Dired-Plus :group 'font-lock-highlighting-faces) -(defvar diredp-write-priv 'diredp-write-priv) - -;; Fix Emacs 20 recognition of fields up through file name when size is expressed using `k' etc. -(when (and (< emacs-major-version 21) (not (boundp 'diredp-loaded-p)) - dired-move-to-filename-regexp ; These last two checks are just in case. - (eq (aref dired-move-to-filename-regexp 7) ?\ )) - (setq dired-move-to-filename-regexp (concat "[0-9][BkKMGTPEZY]?" - (substring dired-move-to-filename-regexp 7)))) - -;;; Define second level of fontifying. -(defvar diredp-font-lock-keywords-1 - (list - '("^ \\(.+:\\)$" 1 diredp-dir-heading) ; Directory headers - '("^ wildcard.*$" 0 'default) ; Override others, e.g. `l' for `diredp-other-priv'. - '("^ (No match).*$" 0 'default) ; Override others, e.g. `t' for `diredp-other-priv'. - '("[^ .]\\(\\.[^. /]+\\)$" 1 diredp-file-suffix) ; Suffix, including `.'. - '("\\([^ ]+\\) -> .+$" 1 diredp-symlink) ; Symbolic links - - ;; 1) Date/time and 2) filename w/o suffix. - ;; This is a bear, and it is fragile - Emacs can change `dired-move-to-filename-regexp'. - (if (or (not (fboundp 'version<)) (version< emacs-version "23.2")) - (list dired-move-to-filename-regexp - (list 1 'diredp-date-time t t) ; Date/time - (list (concat "\\(.+\\)\\(" (concat (funcall #'regexp-opt diredp-compressed-extensions) - "\\)[*]?$")) ; Compressed-file name - nil nil (list 0 diredp-compressed-file-name 'keep t))) - `(,dired-move-to-filename-regexp - (7 diredp-date-time t t) ; Date/time, locale (western or eastern) - (2 diredp-date-time t t) ; Date/time, ISO - (,(concat "\\(.+\\)\\(" (concat (funcall #'regexp-opt diredp-compressed-extensions) - "\\)[*]?$")) - nil nil (0 diredp-compressed-file-name keep t)))) ; Compressed-file suffix - (if (or (not (fboundp 'version<)) (version< emacs-version "23.2")) - (list dired-move-to-filename-regexp - (list 1 'diredp-date-time t t) ; Date/time - (list "\\(.+\\)$" nil nil (list 0 diredp-file-name 'keep t))) ; Filename - `(,dired-move-to-filename-regexp - (7 diredp-date-time t t) ; Date/time, locale (western or eastern) - (2 diredp-date-time t t) ; Date/time, ISO - ("\\(.+\\)$" nil nil (0 diredp-file-name keep t)))) ; Filename (not a compressed file) - - ;; Files to ignore. - ;; Use face `diredp-ignored-file-name' for omission by file-name extension. - ;; Use face `diredp-omit-file-name' for omission by entire file name. - (let* ((omit-exts (or (and (boundp 'dired-omit-extensions) dired-omit-extensions) - completion-ignored-extensions)) - (omit-exts (and omit-exts (mapconcat #'regexp-quote omit-exts "\\|"))) - (compr-exts (and diredp-ignore-compressed-flag - (concat "\\|" (mapconcat #'regexp-quote diredp-compressed-extensions "\\|"))))) - (list (concat "^ \\(.*\\(" omit-exts compr-exts "\\)[*]?\\)$") ; [*]? allows for executable flag (*). - 1 diredp-ignored-file-name t)) - `(,(concat "^.*" dired-move-to-filename-regexp - "\\(" diredp-omit-files-regexp "\\).*[*]?$") ; [*]? allows for executable flag (*). - (0 diredp-omit-file-name t)) - - ;; Compressed-file (suffix) - (list (concat "\\(" (funcall #'regexp-opt diredp-compressed-extensions) "\\)[*]?$") - 1 diredp-compressed-file-suffix t) - '("\\([*]\\)$" 1 diredp-executable-tag t) ; Executable (*) - - ;; Inode, hard-links, & file size (. and , are for the decimal point, depending on locale) - ;; See comment for `directory-listing-before-filename-regexp' in `files.el' or `files+.el'. - '("\\(\\([0-9]+\\([.,][0-9]+\\)?\\)[BkKMGTPEZY]?[ /]?\\)" 1 diredp-number) - - ;; Directory names - exclude d:/..., Windows drive letter in a dir heading. - (list (concat dired-re-maybe-mark dired-re-inode-size "\\(d\\)[^:]") - '(1 diredp-dir-priv t) '(".+" (dired-move-to-filename) nil (0 diredp-dir-name t))) - - (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]........\\(x\\)") ; o x - '(1 diredp-exec-priv)) - (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]........\\([lsStT]\\)") ; o misc - '(1 diredp-other-priv)) - (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl].......\\(w\\).") ; o w - '(1 diredp-write-priv)) - (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]......\\(r\\)..") ; o r - '(1 diredp-read-priv)) - (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl].....\\(x\\)...") ; g x - '(1 diredp-exec-priv)) - (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl].....\\([lsStT]\\)...") ; g misc - '(1 diredp-other-priv)) - (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]....\\(w\\)....") ; g w - '(1 diredp-write-priv)) - (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]...\\(r\\).....") ; g r - '(1 diredp-read-priv)) - (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]..\\(x\\)...") ; u x - '(1 diredp-exec-priv)) - (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]..\\([lsStT]\\)...") ; u misc - '(1 diredp-other-priv)) - (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl].\\(w\\)....") ; u w - '(1 diredp-write-priv)) - (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]\\(r\\).....") ; u r - '(1 diredp-read-priv)) - - (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]........\\([-rwxlsStT]\\)") ; o - - '(1 diredp-no-priv keep)) - (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl].......\\([-rwxlsStT]\\).") ; g - - '(1 diredp-no-priv keep)) - (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]......\\([-rwxlsStT]\\)..") ; u - - '(1 diredp-no-priv keep)) - (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl].....\\([-rwxlsStT]\\)...") ; o - - '(1 diredp-no-priv keep)) - (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]....\\([-rwxlsStT]\\)....") ; g - - '(1 diredp-no-priv keep)) - (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]...\\([-rwxlsStT]\\).....") ; u - - '(1 diredp-no-priv keep)) - (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]..\\([-rwxlsStT]\\)......") ; o - - '(1 diredp-no-priv keep)) - (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl].\\([-rwxlsStT]\\).......") ; g - - '(1 diredp-no-priv keep)) - (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]\\([-rwxlsStT]\\)........") ; u - - '(1 diredp-no-priv keep)) - - (list (concat dired-re-maybe-mark dired-re-inode-size "\\([bcsmpS]\\)") ; (rare) - '(1 diredp-rare-priv keep)) - (list (concat dired-re-maybe-mark dired-re-inode-size "\\(l\\)[-rwxlsStT]") ; l - '(1 diredp-rare-priv keep)) - - (list (concat "^\\([^\n " (char-to-string dired-del-marker) "].*$\\)") - 1 diredp-flag-mark-line t) ; Flag/mark lines - (list (concat "^\\([^\n " (char-to-string dired-del-marker) "]\\)") ; Flags, marks (except D) - 1 diredp-flag-mark t) - - (list (concat "^\\([" (char-to-string dired-del-marker) "].*$\\)") ; Deletion-flagged lines - 1 diredp-deletion-file-name t) - (list (concat "^\\([" (char-to-string dired-del-marker) "]\\)") ; Deletion flags (D) - 1 diredp-deletion t) - - ) "2nd level of Dired highlighting. See `font-lock-maximum-decoration'.") - - -(defun diredp--set-up-font-locking () - "Add this to `dired-mode-hook' to provide for second-level fontifying." - (set (make-local-variable 'font-lock-defaults) - ;; Two levels. Use 3-element list, since it is standard to have one more - ;; than the number of levels. This is necessary for it to work with - ;; `font(-lock)-menus.el'. - '((dired-font-lock-keywords - dired-font-lock-keywords - diredp-font-lock-keywords-1) - t nil nil beginning-of-line)) - ;; Refresh `font-lock-keywords' from `font-lock-defaults' - (when (fboundp 'font-lock-refresh-defaults) (font-lock-refresh-defaults))) - -;;; Provide for the second level of fontifying. -(add-hook 'dired-mode-hook 'diredp--set-up-font-locking) - -;; Ensure that Dired buffers are refontified when you use `g' or otherwise read in the file list. -(defun diredp-refontify-buffer () - "Turn `font-lock-mode' off, then on." - (setq font-lock-mode nil) - (font-lock-mode)) -(add-hook 'dired-after-readin-hook 'diredp-refontify-buffer) - -;;; Function Definitions - -;;; $$$$$$$$ -;;; (defun diredp-dired-files (arg &optional switches) ; Not bound -;;; "Like `dired', but non-positive prefix arg prompts for files to list. -;;; This is like `dired' unless you use a non-positive prefix arg. -;;; In that case, you are prompted for names of files and directories to -;;; list, and then you are prompted for the name of the Dired buffer that -;;; lists them. Use `C-g' when you are done entering file names to list. - -;;; In all cases, when inputting a file or directory name you can use -;;; shell wildcards. - -;;; If you use Icicles, then in Icicle mode the following keys are bound -;;; in the minibuffer during completion (`*' means the key requires -;;; library `Bookmark+'): - -;;; M-| - Open Dired on the file names matching your input -;;; C-c + - Create a new directory -;;; *C-x a + - Add tags to the current-candidate file -;;; *C-x a - - Remove tags from the current-candidate file -;;; *C-x m - Access file bookmarks (not just autofiles)" -;;; (interactive (diredp-dired-files-interactive-spec "")) -;;; (when (consp arg) -;;; (let ((buf (dired-find-buffer-nocreate (car arg)))) ; Respect file list. -;;; (when buf (kill-buffer buf)))) -;;; (if (fboundp 'pop-to-buffer-same-window) -;;; (pop-to-buffer-same-window (dired-noselect arg switches)) -;;; (switch-to-buffer (dired-noselect arg switches)))) - -;;; (defun diredp-dired-files-other-window (arg &optional switches) ; Not bound -;;; "Same as `diredp-dired-files' except uses another window." -;;; (interactive (diredp-dired-files-interactive-spec "in other window ")) -;;; (when (consp arg) -;;; (let ((buf (dired-find-buffer-nocreate (car arg)))) ; Respect file list. -;;; (when buf (kill-buffer buf)))) -;;; (dired-other-window arg switches)) - -;;;###autoload -(defun diredp-dired-for-files (arg &optional switches) ; Bound to `C-x D F' - "Dired file names that you enter, in a Dired buffer that you name. -You are prompted for the name of the Dired buffer to use. -You are then prompted for names of files and directories to list, - which can be located anywhere. -Use `C-g' when you are done. - -With a prefix arg you are first prompted for the `ls' switches to use. - -See also `dired' (including the advice)." - (interactive (let ((current-prefix-arg (if current-prefix-arg 0 -1))) - (dired-read-dir-and-switches "" 'READ-EXTRA-FILES-P))) - (dired arg switches)) - -;;;###autoload -(defun diredp-dired-for-files-other-window (arg &optional switches) ; Bound to `C-x 4 D F' - "Same as `diredp-dired-for-files', except uses another window." - (interactive (let ((current-prefix-arg (if current-prefix-arg 0 -1))) - (dired-read-dir-and-switches "in other window " 'READ-EXTRA-FILES-P))) - (dired-other-window arg switches)) - -;;;###autoload -(defun diredp-dired-recent-dirs (buffer &optional arg) ; Bound to `C-x D R' - "Open Dired in BUFFER, showing recently used directories. -You are prompted for BUFFER. - -No prefix arg or a plain prefix arg (`C-u', `C-u C-u', etc.) means -list all of the recently used directories. - -With a prefix arg: -* If 0, `-', or plain (`C-u') then you are prompted for the `ls' - switches to use. -* If not plain (`C-u') then: - * If >= 0 then the directories to include are read, one by one. - * If < 0 then the directories to exclude are read, one by one. - -When entering directories to include or exclude, use `C-g' to end." - (interactive (list (completing-read "Dired buffer name: " dired-buffers) current-prefix-arg)) - (unless (require 'recentf nil t) (error "This command requires library `recentf.el'")) - (let ((switches (and (or (zerop (prefix-numeric-value arg)) (consp arg)) - (read-string "Dired listing switches: " dired-listing-switches)))) - (dired (cons (generate-new-buffer-name buffer) (diredp-recent-dirs arg)) switches))) - -;;;###autoload -(defun diredp-dired-recent-dirs-other-window (buffer &optional arg) ; Bound to `C-x 4 D R' - "Same as `diredp-dired-recent-dirs', but use other window." - (interactive (list (completing-read "Dired buffer name: " dired-buffers) current-prefix-arg)) - (unless (require 'recentf nil t) (error "This command requires library `recentf.el'")) - (let ((switches (and (or (zerop (prefix-numeric-value arg)) (consp arg) (eq '- arg)) - (read-string "Dired listing switches: " dired-listing-switches)))) - (dired-other-window (cons (generate-new-buffer-name buffer) (diredp-recent-dirs arg)) switches))) - -(defun diredp-recent-dirs (arg) - "Return a list of recently used directories. -ARG is as for `diredp-dired-recent-dirs'." - (let ((recent-dirs (diredp-remove-if #'diredp-root-directory-p - (diredp-delete-dups - (mapcar (lambda (f/d) - (if (file-directory-p f/d) f/d (file-name-directory f/d))) - recentf-list))))) - (if (and arg (atom arg)) - (diredp-read-include/exclude 'Dir recent-dirs (not (natnump (prefix-numeric-value arg)))) - recent-dirs))) - -(defun diredp-read-include/exclude (thing things &optional exclude) - "Read which THINGs to include (or to EXCLUDE, if non-nil) from list THINGS. -The things are read one by one. `C-g' stops reading. - -THING is a string or symbol naming the type of thing to read, e.g., -`File' or `Directory'. It is used only in the prompt, which is THING -followed by \" to exclude\" or \" to include\" and a reminder about `C-g'. - -A new list is returned - list THINGS is not modified." - (let* ((thgs (if exclude (copy-sequence things) ())) - (prompt (format "%s to %s (C-g when done): " thing (if exclude 'EXCLUDE 'INCLUDE))) - (completion-ignore-case (or (and (boundp 'read-file-name-completion-ignore-case) - (memq thing '(Dir Directory File "Dir" "Directory" "File")) ; Hack - read-file-name-completion-ignore-case) - completion-ignore-case)) - thing) - (while (condition-case nil - (setq thing (completing-read prompt (mapcar #'list things) nil t)) - (quit nil)) - (if exclude (delete thing thgs) - (push thing thgs))) - thgs)) - -;;; $$$$$$$$ -;;; (defun diredp-dired-files-interactive-spec (str) -;;; "`interactive' spec for `diredp-dired-files' commands. -;;; STR is a string appended to the prompt. -;;; With non-negative prefix arg, read switches. -;;; With non-positive prefix arg, read files and dirs to list and then the -;;; Dired buffer name. User uses `C-g' when done reading files and dirs. - -;;; If you use Icicles, then in Icicle mode the following keys are bound -;;; in the minibuffer during completion (`*' means the key requires -;;; library `Bookmark+'): - -;;; M-| - Open Dired on the file names matching your input -;;; C-c + - Create a new directory -;;; *C-x a + - Add tags to the current-candidate file -;;; *C-x a - - Remove tags from the current-candidate file -;;; *C-x m - Access file bookmarks (not just autofiles)" -;;; (list -;;; (unwind-protect -;;; (let ((icicle-sort-comparer (or (and (boundp 'icicle-file-sort) ;; If not reading files -;;; icicle-file-sort) ;; then dirs first. -;;; (and (> (prefix-numeric-value current-prefix-arg) 0) -;;; 'icicle-dirs-first-p) -;;; icicle-sort-comparer)) -;;; (icicle-all-candidates-list-alt-action-fn ; M-|' -;;; (lambda (files) -;;; (let ((enable-recursive-minibuffers t)) -;;; (dired-other-window (cons (read-string "Dired buffer name: ") files)))))) -;;; (when (fboundp 'icicle-bind-file-candidate-keys) (icicle-bind-file-candidate-keys)) -;;; (if (> (prefix-numeric-value current-prefix-arg) 0) -;;; ;; If a dialog box is about to be used, call `read-directory-name' so the dialog -;;; ;; code knows we want directories. Some dialog boxes can only select directories -;;; ;; or files when popped up, not both. -;;; (if (and (fboundp 'read-directory-name) (next-read-file-uses-dialog-p)) -;;; (read-directory-name (format "Dired %s(directory): " str) nil -;;; default-directory nil) -;;; (read-file-name (format "Dired %s(directory): " str) nil default-directory nil)) -;;; (let ((insert-default-directory nil) -;;; (files ()) -;;; file) -;;; (while (condition-case nil ; Use lax completion, to allow wildcards. -;;; (setq file (read-file-name "File or dir (C-g when done): ")) -;;; (quit nil)) -;;; (push file files)) -;;; (cons (read-string "Dired buffer name: " nil nil default-directory) files)))) -;;; (when (fboundp 'icicle-unbind-file-candidate-keys) -;;; (icicle-unbind-file-candidate-keys))) -;;; (and current-prefix-arg (natnump (prefix-numeric-value current-prefix-arg)) -;;; (read-string "Dired listing switches: " dired-listing-switches)))) - -;;;###autoload -(defun diredp-dired-union (dired-name dirbufs &optional switches extra) ; Bound to `C-x D U' - "Create a Dired buffer that is the union of some existing Dired buffers. -With a non-negative prefix arg, you are prompted for `ls' switches. -With a non-positive prefix arg, you are prompted for file and dir -names to add to the listing - see below. - -You are prompted for the name of the Dired union buffer. Completion -against names of existing Dired buffers is available, but you can -enter any other name to create a new Dired buffer of that name. - -If the union buffer name you choose names an existing Dired buffer, -then what happens depends on whether that buffer is an ordinary Dired -directory listing or a list of arbitrary file names. That is, it -depends on whether `dired-directory' is a directory name or a cons of -a Dired buffer name plus file names. - -* If the buffer is an ordinary Dired listing, then it is converted to - an explicit list of absolute file names, just as if these had been - chosen individually. The existing buffer and window are replaced by - new ones that show the explicit listing. (This replacement is - necessary because the list of files contained in an ordinary Dired - listing cannot be modified.) - -* If the buffer lists arbitrary file names explicitly, then it is - updated to include also the files from any Dired buffers and any - additional files that you specify. - -If the union buffer name you choose does not name an existing Dired -buffer, then its `default-directory' is the same as the -`default-directory' before invoking the command. - -If you use a non-positive prefix arg, then you can next choose -additional file and directory names to add to the listing. Use `C-g' -when done choosing them. - -Any directory names you choose this way are included as single entries -in the listing - the directory contents are not included (these -directories are not unioned). To instead include the contents of a -directory chosen this way, use a glob pattern: `/*' after the -directory name. - -You are then prompted for the Dired buffers to union. Use `C-g' when -done choosing them. These Dired listings to union are included in the -order that you chose them, and each entry is listed only once in the -new Dired buffer. - -The new Dired listing respects the markings, subdirectory insertions, -and hidden subdirectories of the selected Dired listings. However, in -case of conflict between marked or unmarked status for the same entry, -the entry is marked. Similarly, in case of conflict over an included -subdirectory between it being hidden or shown, it is hidden, but its -contained files are also listed. - -See also command `diredp-add-to-dired-buffer'. - -From Lisp: - DIRED-NAME is the name of the resulting Dired union buffer. - DIRBUFS is a list of the names of Dired buffers to union. - SWITCHES is a string of `ls' switches. - EXTRA is a list of files & directories to be included in the listing." - (interactive (diredp-dired-union-interactive-spec "UNION " - nil - (and current-prefix-arg - (<= (prefix-numeric-value current-prefix-arg) 0)))) - (diredp-dired-union-1 dired-name dirbufs switches extra)) - -;;;###autoload -(defun diredp-dired-union-other-window (dired-name dirbufs &optional switches extra) ; Bound to `C-x 4 D U' - "Same as `diredp-dired-union', except use other window." - (interactive (diredp-dired-union-interactive-spec "UNION " - nil - (and current-prefix-arg - (<= (prefix-numeric-value current-prefix-arg) 0)))) - (diredp-dired-union-1 dired-name dirbufs switches extra 'OTHERWIN)) - -;;;###autoload -(defun diredp-add-to-dired-buffer (dired-name to-add &optional switches) ; Bound to `C-x D A' - "Add individual file and directory names to a Dired buffer. -You are prompted for the buffer name. -With a prefix arg, you are also prompted for the `ls' switches. - -The buffer must either not exist yet or must list arbitrary file and -directory names. That is, it cannot be an ordinary Dired directory -listing - those cannot be modified. - -Any directory names you choose this way are included as single entries -in the listing - the directory contents are not included (these -directories are not unioned). To instead include the contents of a -directory chosen this way, use a glob pattern: `/*' after the -directory name. - -See also command `diredp-dired-union'. - -From Lisp: - DIRED-NAME is the name of the Dired buffer to modify. - TO-ADD is the list of files and dirs to add to it. - SWITCHES is the string of `ls' switches." - ;; Bind `current-prefix-arg' to force reading file/dir names. - ;; Read `ls' switches too, if user used prefix arg. - (interactive - (let* ((current-prefix-arg (if current-prefix-arg 0 -1)) - (all (diredp-dired-union-interactive-spec "add files/dirs " - 'NO-DIRED-BUFS - 'READ-EXTRA-FILES-P))) - (list (nth 0 all) (nth 3 all) (nth 2 all)))) - (diredp-dired-union-1 dired-name () switches to-add)) - -;;;###autoload -(defun diredp-add-to-dired-buffer-other-window (dired-name to-add &optional switches) ; Bound to `C-x 4 D A' - "Same as `diredp-add-to-dired-buffer', except use other window." - ;; Bind `current-prefix-arg' to force reading file/dir names. - ;; Read `ls' switches too, if user used prefix arg. - (interactive - (let* ((current-prefix-arg (if current-prefix-arg 0 -1)) - (all (diredp-dired-union-interactive-spec "add files/dirs " - 'NO-DIRED-BUFS - 'READ-EXTRA-FILES-P))) - (list (nth 0 all) (nth 3 all) (nth 2 all)))) - (diredp-dired-union-1 dired-name () switches to-add 'OTHERWIN)) - -;;;###autoload -(defun diredp-add-to-this-dired-buffer (dired-name to-add &optional switches) ; Not bound by default - "Same as `diredp-add-to-dired-buffer' for this Dired buffer." - ;; Bind `current-prefix-arg' to force reading file/dir names. - ;; Read `ls' switches too, if user used prefix arg. - (interactive - (progn (unless (derived-mode-p 'dired-mode) (error "Not in a Dired buffer")) - (let* ((current-prefix-arg (if current-prefix-arg 0 -1)) - (all (diredp-dired-union-interactive-spec "add files/dirs here " - 'NO-DIRED-BUFS - 'READ-EXTRA-FILES-P - (buffer-name)))) - (list (nth 0 all) (nth 3 all) (nth 2 all))))) - (diredp-dired-union-1 dired-name () switches to-add)) - -;; $$$$$ Maybe I should set `dired-sort-inhibit' to t for now (?), -;; since there is an Emacs bug (at least on Windows) that prevents -;; sorting from working for a Dired buffer with an explicit file list. -(defun diredp-dired-union-1 (dired-name dirbufs switches extra &optional otherwin) - "Helper for `diredp-dired-union' and `diredp-add-to-dired-buffer'. -Non-nil optional OTHERWIN means use other window for the Dired buffer. -See `diredp-dired-union' for the other argument descriptions." - (let ((dbuf (get-buffer dired-name)) - (files extra) - (marked ()) - (subdirs ()) - (hidden-dirs ()) - hid-here files-here) - (dolist (buf (reverse dirbufs)) - (with-current-buffer buf - (unwind-protect - (progn (setq hid-here (save-excursion (dired-remember-hidden)) - files-here (if (consp dired-directory) - (reverse (cdr dired-directory)) ; Reverse bc will push. - ())) - (unless files-here - (save-excursion ; This bit is more or less from `dired-toggle-marks'. - (goto-char (point-min)) - (while (not (eobp)) - (or (diredp-looking-at-p dired-re-dot) - (push (dired-get-filename nil 'NO-ERROR-P) files-here)) - (forward-line 1))) - (setq files-here (delq nil files-here))) - (dolist (hid-here hid-here) (push hid-here hidden-dirs)) - (dolist (sub (cdr (reverse dired-subdir-alist))) - (push (list (car sub)) subdirs)) - (dolist (mkd (dired-remember-marks (point-min) (point-max))) ; This unhides. - (push (car mkd) marked)) - (dolist (file files-here) - (when (or (not (file-name-absolute-p file)) (not (member file files))) - (push file files)))) - (save-excursion ; Hide subdirs that were hidden. - (dolist (dir hid-here) (when (dired-goto-subdir dir) (dired-hide-subdir 1))))))) - ;; For an existing Dired buffer having this name whose `dired-directory' is a cons: - ;; 1. Include the files and dirs already listed there. - ;; 2. Kill the current buffer and delete its window. A new buffer of the same name is created and shown. - (when dbuf - (with-current-buffer dbuf - (when (consp dired-directory) (setq files (diredp-set-union (cdr dired-directory) files))) - (let ((win (get-buffer-window dbuf 0))) (when win (delete-window win))) - (kill-buffer dbuf))) - (setq dbuf (dired-other-window (cons dired-name files) switches)) - (with-current-buffer dbuf - (let ((inhibit-read-only t)) - (dired-insert-old-subdirs subdirs) - (dired-mark-remembered ; Don't really need `expand-file-name' - already abs. - (mapcar (lambda (mf) (cons (expand-file-name mf dired-directory) 42)) marked)) - (save-excursion - (dolist (hdir hidden-dirs) (when (dired-goto-subdir hdir) (dired-hide-subdir 1)))))))) - -(defun diredp-dired-union-interactive-spec (string &optional no-dired-bufs read-extra-files-p dired-buffer) - "Read arguments for `diredp-dired-union' and `diredp-add-to-dired-buffer'. -STRING is appended to the prompt for the listing buffer name. -Non-nil NO-DIRED-BUFS means do not read Dired buffers to union. -Non-nil READ-EXTRA-FILES-P is passed to `dired-read-dir-and-switches', - and means read extra files to add to the listing. -Non-nil DIRED-BUFFER is passed to `dired-read-dir-and-switches'. - It is the name of the Dired union buffer." - (let* ((current-prefix-arg -1) - (dir+switches (dired-read-dir-and-switches string read-extra-files-p dired-buffer)) - (dirname (car dir+switches)) - (switches (cadr dir+switches)) - (dirbufs ()) - (bufs ()) - (extra-files ()) - buf) - (when (consp dirname) (setq extra-files (cdr dirname) - dirname (car dirname))) - (unless no-dired-bufs - ;; Remove any killed buffers from `dired-buffers'. Then use all but the target buffer as candidates. - (dolist (db dired-buffers) - (if (buffer-live-p (cdr db)) - (unless (equal dirname (buffer-name (cdr db))) - (push (cons (buffer-name (cdr db)) (car db)) dirbufs)) - (setq dired-buffers (delq db dired-buffers)))) - (while (and dirbufs (condition-case nil - (setq buf (completing-read "Existing Dired buffer to include (C-g when done): " - dirbufs nil t nil 'buffer-name-history - (and dirbufs (car (assoc (buffer-name) dirbufs))))) - (quit nil))) - (push buf bufs) - (setq dirbufs (delete (cons buf (with-current-buffer buf (expand-file-name default-directory))) - dirbufs))) - (setq bufs (nreverse bufs))) - (list dirname bufs switches extra-files))) - -(when (> emacs-major-version 23) ; `compilation--loc->file-struct' - - (defalias 'diredp-grepped-files-other-window 'diredp-compilation-files-other-window) - (defun diredp-compilation-files-other-window (&optional switches) - "Open Dired on the files indicated by compilation (e.g., `grep') hits. -Applies to any `compilation-mode'-derived buffer, such as `*grep*'. -You are prompted for the name of the new Dired buffer. -With a prefix arg you are first prompted for the `ls' switches. - -\(However, Emacs bug #20739 means that the switches are ignored.)" - (interactive (list (and current-prefix-arg (read-string "Dired listing switches: " dired-listing-switches)))) - (unless (compilation-buffer-p (current-buffer)) (error "Not in a buffer derived from `compilation-mode'")) - (let ((files ())) - (save-excursion (goto-char (point-min)) - (while (condition-case nil (compilation-next-file 1) (error nil)) - (setq compilation-current-error (point)) - (push (diredp-file-for-compilation-hit-at-point) files))) - (setq files (nreverse files)) - (dired-other-window - (cons (read-string "Dired buffer name: " nil nil (generate-new-buffer-name default-directory)) files) - switches))) - - (defun diredp-file-for-compilation-hit-at-point () - "Return the name of the file for the compilation hit at point. -The name is expanded in the directory for the last directory change." - (let* ((msg (compilation-next-error 0)) - (loc (compilation--message->loc msg)) - (filestruct (compilation--loc->file-struct loc)) - (file (caar filestruct)) - (dir (cadr (car filestruct)))) - (when dir (setq file (expand-file-name file dir))) - file)) - ) - -;;;###autoload -(defun diredp-fileset (flset-name) ; Bound to `C-x D S' - "Open Dired on the files in fileset FLSET-NAME." - (interactive - (progn (unless (require 'filesets nil t) (error "Feature `filesets' not provided")) - (unless filesets-data (error "`filesets-data' is empty")) - (list (completing-read "Open Dired on fileset: " filesets-data)))) - (diredp-fileset-1 flset-name)) - -;;;###autoload -(defun diredp-fileset-other-window (flset-name) ; Bound to `C-x 4 D S' - "Open Dired in another window on the files in fileset FLSET-NAME." - (interactive - (progn (unless (require 'filesets nil t) (error "Feature `filesets' not provided")) - (unless filesets-data (error "`filesets-data' is empty")) - (list (completing-read "Open Dired on fileset, in other window: " filesets-data)))) - (diredp-fileset-1 flset-name 'OTHER-WINDOW)) - -(defun diredp-fileset-1 (flset-name &optional other-window-p) - "Helper for `diredp-fileset(-other-window)'." - (let ((flset (filesets-get-fileset-from-name flset-name)) - (files ()) - (mode nil) - (dirfun (if other-window-p #'dired-other-window #'dired))) - (unless (or (setq mode (filesets-entry-mode flset)) ; ("my-fs" (:files "a" "b")) - (setq flset (cons "dummy" flset) ; (:files "a" "b") - mode (filesets-entry-mode flset))) - (error "Bad fileset: %S" flset-name)) - (message "Gathering file names...") - (dolist (file (filesets-get-filelist flset mode)) (push file files)) - (funcall dirfun (cons (generate-new-buffer-name flset-name) - (nreverse (mapcar (lambda (file) - (if (file-name-absolute-p file) - (expand-file-name file) - file)) - files)))))) - -;;;###autoload -(defun diredp-dired-this-subdir (&optional tear-off-p msgp) - "Open Dired for the subdir at or above point. -If point is not on a subdir line, but is in an inserted subdir -listing, then use that subdir. - -With a prefix arg: - If the subdir is inserted and point is in the inserted listing then - remove that listing and move to the ordinary subdir line. In other - words, when in an inserted listing, a prefix arg tears off the - inserted subdir to its own Dired buffer." - (interactive "P\np") - (diredp-ensure-mode) - (let* ((this-dir default-directory) - (this-subdir (diredp-this-subdir)) - (on-dir-line-p (atom this-subdir))) - (unless on-dir-line-p ; Subdir header line or non-directory file. - (setq this-subdir (car this-subdir))) - (unless (string= this-subdir this-dir) - (when tear-off-p - (unless on-dir-line-p - (dired-kill-subdir) ; Tear it off. - (dired-goto-file this-subdir))) ; Move to normal subdir line. - (dired-other-window this-subdir)))) - -;;;###autoload -(defun diredp-dired-inserted-subdirs (&optional no-show-p msgp) ; Bound to `C-M-i' - "Open Dired for each of the subdirs inserted in this Dired buffer. -A separate Dired buffer is used for each of them. -With a prefix arg, create the Dired buffers but do not display them. -Markings and current Dired switches are preserved." - (interactive "P\np") - (diredp-ensure-mode) - (let ((this-dir default-directory) - (this-buff (current-buffer)) - (this-frame (selected-frame)) - marked) - (unwind-protect - (save-selected-window - (dolist (entry dired-subdir-alist) - (unless (string= (car entry) this-dir) - (setq marked (with-current-buffer this-buff - (dired-remember-marks (dired-get-subdir-min entry) (dired-get-subdir-max entry)))) - (if (not no-show-p) - (dired-other-window (car entry) dired-actual-switches) - (dired-noselect (car entry) dired-actual-switches) - (when msgp (message "Dired buffers created but not shown"))) - (set-buffer this-buff) - (let ((inhibit-read-only t)) - (dired-mark-remembered marked)) - (set-buffer-modified-p nil)))) - (select-frame-set-input-focus this-frame)))) - - -;;; Actions on marked files and subdirs, recursively. - -(defun diredp-get-subdirs (&optional ignore-marks-p predicate details) - "Return subdirs from this Dired buffer and from marked subdirs, recursively. -If optional arg IGNORE-MARKS-P is non-nil then include all -subdirectories. Otherwise, include only those that are marked. - -Non-nil optional arg PREDICATE means include only subdirectory names -for which the PREDICATE returns non-nil. PREDICATE must accept a file -name as its only required argument. - -Optional arg DETAILS is passed to `diredp-get-files'." - (diredp-get-files ignore-marks-p (if predicate - `(lambda (name) (and (file-directory-p name) (funcall ,predicate name))) - #'file-directory-p) - 'INCLUDE-DIRS-P 'DONT-ASKP 'ONLY-MARKED-P details)) - -(defun diredp-get-files (&optional ignore-marks-p predicate include-dirs-p dont-askp only-marked-p details) - "Return file names from this Dired buffer and subdirectories, recursively. -The names are those that are marked in the current Dired buffer, or -all files in the directory if none are marked. Marked subdirectories -are handled recursively in the same way. - -If there is some included subdirectory that has a Dired buffer with -marked files, then (unless DONT-ASKP is non-nil) this asks you whether -to use the marked files in Dired buffers, as opposed to using all of -the files in included directories. To this y-or-n question you can -hit `l' to see the list of files that will be included (using -`diredp-list-files'). In that `l' listing you can mouseover to see -image-file previews or use `RET' or `mouse-2' to visit files. - -\(Directories in `icicle-ignored-directories' are skipped, if you use -Icicles. Otherwise, directories in `vc-directory-exclusion-list' are -skipped.) - -Non-nil IGNORE-MARKS-P means ignore all Dired markings: just get all -of the files in the current directory (and all of the subdirectories, -if INCLUDE-DIRS-P is non-nil). - -Non-nil PREDICATE means include only file names for which the -PREDICATE returns non-nil. PREDICATE must accept a file name as its -only required argument. - -Non-nil INCLUDE-DIRS-P means include marked subdirectory names (but -also handle those subdirs recursively, picking up their marked files -and subdirs). - -Non-nil DONT-ASKP means do not ask the user whether to use marked -instead of all. Act as if the user was asked and replied `y'. - -Non-nil optional arg ONLY-MARKED-P means collect only marked files, -instead of collecting all files if none are marked. This argument is -ignored if IGNORE-MARKS-P is non-nil. - -Optional arg DETAILS is passed to `diredp-y-or-n-files-p'." - (let ((askp (list nil))) ; The cons's car will be set to `t' if need to ask user. - (if ignore-marks-p - (diredp-files-within (directory-files default-directory 'FULL diredp-re-no-dot) - () nil include-dirs-p predicate) - ;; Pass FILES and ASKP to `diredp-get-files-for-dir', so we don't have to use them as - ;; free vars there. But that means that they each need to be a cons cell that we can - ;; modify, so we can get back the updated info. - (let ((files (list 'DUMMY))) ; The files picked up will be added to this list. - (diredp-get-files-for-dir default-directory files askp include-dirs-p only-marked-p) - (setq files (cdr files)) ; Remove `DUMMY' from the modifed list. - (if (or dont-askp - (not (car askp)) - (diredp-y-or-n-files-p "Use marked (instead of all) in subdir Dired buffers? " - files predicate details)) - (if predicate (diredp-remove-if-not predicate files) files) - (setq files ()) - (dolist (file (diredp-marked-here)) - (if (not (file-directory-p file)) - (when (or (not predicate) (funcall predicate file)) - (add-to-list 'files file)) - (when include-dirs-p (setq files (nconc files (list file)))) - (setq files (nconc files (diredp-files-within (directory-files file 'FULL diredp-re-no-dot) - () nil include-dirs-p predicate))))) - (nreverse files)))))) - -(defun diredp-get-files-for-dir (directory accum askp &optional include-dirs-p only-marked-p) - "Return marked file names for DIRECTORY and subdirectories, recursively. -Pick up names of all marked files in DIRECTORY if it has a Dired -buffer, or all files in DIRECTORY if not. Handle subdirs recursively -\(only marked subdirs, if Dired). - -ACCUM is an accumulator list: the files picked up in this call are -nconc'd to it. - -ASKP is a one-element list, the element indicating whether to ask the -user about respecting Dired markings. It is set here to `t' if there -is a Dired buffer for DIRECTORY. - -Non-nil optional arg INCLUDE-DIRS-P means include marked subdirectory -names (but also handle those subdirs recursively). - -Non-nil optional arg ONLY-MARKED-P means collect only marked files, -instead of collecting all files if none are marked. - -If there is more than one Dired buffer for DIRECTORY then raise an -error." - (let ((dbufs (dired-buffers-for-dir (expand-file-name directory)))) - (dolist (file (if (not dbufs) - (and (not only-marked-p) (directory-files directory 'FULL diredp-re-no-dot)) - (when (cadr dbufs) (error "More than one Dired buffer for `%s'" directory)) - (unless (equal directory default-directory) (setcar askp t)) - (with-current-buffer (car dbufs) (diredp-marked-here only-marked-p 'NO-DOT-DOT)))) - (if (not (file-directory-p file)) - (setcdr (last accum) (list file)) - (when include-dirs-p (setcdr (last accum) (list file))) - (diredp-get-files-for-dir file accum askp include-dirs-p only-marked-p))))) - -(defun diredp-marked-here (&optional only-marked-p no-dot-dot-p) - "Marked files and subdirs in this Dired buffer, or all if none are marked. -Non-nil optional arg ONLY-MARKED-P means return nil if none are -marked. -Non-nil optional arg NO-DOT-DOT-P means do not include marked `..'." - ;; If no file is marked, exclude `(FILENAME)': the unmarked file at cursor. - ;; If there are no marked files as a result, return all files and subdirs in the dir. - (let* ((dired-marker-char ?*) - (ff (condition-case nil ; Ignore error if on `.' or `..' and no file is marked. - (dired-get-marked-files - nil nil (and no-dot-dot-p - (lambda (mf) (not (diredp-string-match-p "/\\.\\.$" mf)))) - 'DISTINGUISH-ONE-MARKED) - (error nil)))) - (cond ((eq t (car ff)) (cdr ff)) ; Single marked - ((cadr ff) ff) ; Multiple marked - (t (and (not only-marked-p) ; None marked - (directory-files default-directory 'FULL diredp-re-no-dot 'NOSORT)))))) - -(defun diredp-y-or-n-files-p (prompt files &optional predicate details) - "PROMPT user with a \"y or n\" question about a list of FILES. -Return t if answer is \"y\". Otherwise, return nil. - -Like `y-or-n-p', but you can also hit `l' to display the list of files -that the confirmation is for, in buffer `*Files'. In that `'l' -listing you can mouseover to see image-file previews or use `RET' or -`mouse-2' to visit files. - -When finished, buffer `*Files*' is killed if it was never shown, or is -hidden and buried otherwise. Thus, if it was shown then it is still -available to revisit afterward (even if you quit using `C-g'). - -PREDICATE is passed to `diredp-list-files', to list only file names -for which it returns non-nil. - -DETAILS is passed to `diredp-list-files', to show details about FILES." - (let ((answer 'recenter)) - (cond (noninteractive - (setq prompt (concat prompt - (and (not (eq ?\ (aref prompt (1- (length prompt))))) " ") - "(y or n; l to show file list) ")) - (let ((temp-prompt prompt)) - (while (not (memq answer '(act skip))) - (let ((str (read-string temp-prompt))) - (cond ((member str '("y" "Y")) (setq answer 'act)) - ((member str '("n" "N")) (setq answer 'skip)) - (t (setq temp-prompt (concat "Please answer y or n. " prompt)))))))) - ((if (not (fboundp 'display-popup-menus-p)) - (and window-system (listp last-nonmenu-event) use-dialog-box) - (and (display-popup-menus-p) (listp last-nonmenu-event) use-dialog-box)) - (setq answer (x-popup-dialog t `(,prompt ("Yes" . act) ("No" . skip))))) - (t - (let ((list-buf (generate-new-buffer-name "*Files*")) - (list-was-shown nil)) - (unwind-protect - (progn - (define-key query-replace-map "l" 'show) - (setq prompt (concat prompt - (and (eq ?\ (aref prompt (1- (length prompt)))) - "" " ") - "(y or n; l to show file list) ")) - (while (let* ((reprompt-actions '(recenter scroll-up scroll-down - scroll-other-window scroll-other-window-down)) - (key (let ((cursor-in-echo-area t)) - (when minibuffer-auto-raise - (raise-frame (window-frame (minibuffer-window)))) - (if (fboundp 'read-key) - (read-key (propertize - (if (memq answer reprompt-actions) - prompt - (concat "Please answer y or n. " prompt)) - 'face 'minibuffer-prompt)) - (read-char-exclusive - (if (memq answer reprompt-actions) - prompt - (concat "Please answer y or n. " prompt))))))) - (setq answer (lookup-key query-replace-map (vector key) t)) - (case answer - ((skip act) nil) - (recenter (recenter) t) - (show (diredp-list-files files nil list-buf predicate details) - (setq list-was-shown t)) ; Record showing it. - (help (message "Use `l' to show file list") (sit-for 1)) - (scroll-up (condition-case nil (scroll-up-command) (error nil)) t) - (scroll-down (condition-case nil (scroll-down-command) (error nil)) t) - (scroll-other-window (condition-case nil (scroll-other-window) (error nil)) t) - (scroll-other-window-down (condition-case nil (scroll-other-window-down nil) - (error nil)) t) - ((exit-prefix quit) (signal 'quit nil) t) - (t (or (not (eq key ?\e)) (progn (signal 'quit nil) t))))) - (ding) - (discard-input))) - (when (get-buffer list-buf) - (save-window-excursion (pop-to-buffer list-buf) - (condition-case nil ; Ignore error if user already deleted. - (if (one-window-p) (delete-frame) (delete-window)) - (error nil)) - (if list-was-shown (bury-buffer list-buf) (kill-buffer list-buf)))) - (define-key query-replace-map "l" nil))))) - (let ((ret (eq answer 'act))) - (unless noninteractive (message "%s %s" prompt (if ret "y" "n"))) - ret))) - -(defvar diredp-list-files-map - (let ((map (make-sparse-keymap))) - (define-key map "q" 'quit-window) - (define-key map "\r" 'diredp-find-line-file-other-window) - (define-key map [mouse-2] 'diredp-mouse-find-line-file-other-window) - map) - "Keymap for `diredp-list-files' output.") -(fset 'diredp-list-files-map diredp-list-files-map) - -;;;###autoload -(defun diredp-find-line-file-other-window () - "Visit file named by current line, in another window. -The full text of the line is used as the file name." - (interactive) - (let ((file (buffer-substring-no-properties (line-beginning-position) (line-end-position)))) - (when file (find-file-other-window file)))) - -;;;###autoload -(defun diredp-mouse-find-line-file-other-window (e) - "Visit file named by clicked line, in another window. -The full text of the line is used as the file name." - (interactive "e") - (save-excursion (mouse-set-point e) (diredp-find-line-file-other-window))) - -;;;###autoload -(defun diredp-list-marked (&optional arg predicate interactivep details) ; Bound to `C-M-l' - "List the marked files in this Dired buffer. -A prefix arg specifies files to use instead of the marked files: - - * Numeric prefix arg N: The next N files (previous -N, if < 0). - * C-u C-u: All files, but no directories. - * C-u C-u C-u: All files and directories, except `.' and `..' - * C-u C-u C-u C-u: All files and directories, including `.' and `..' - * Any other prefix arg: The current line's file only. - -You can use `RET' or `mouse-2' to visit any of the files. -If `tooltip-mode' is on then moving the mouse over image-file names -shows image previews. - -When called from Lisp: - Non-nil optional arg PREDICATE is a file-name predicate. List only - the files for which it returns non-nil. - Non-nil optional arg DETAILS is passed to `diredp-list-files'." - (interactive (progn (diredp-ensure-mode) (list current-prefix-arg nil t diredp-list-file-attributes))) - (let ((files (dired-get-marked-files nil arg predicate 'DISTINGUISH-ONE interactivep))) - (diredp-list-files files nil nil nil details))) - -(defun diredp-list-files (files &optional dir bufname predicate details) - "Display FILES, a list of file names. Wildcard patterns are expanded. -The files are shown in a new buffer, `*Files*' by default. - -Optional arg DIR serves as the default directory for expanding file - names that are not absolute. It defaults to `default-directory'. - -Optional arg BUFNAME is the name of the buffer for the display. - It defaults to `*Files*' (or `*Files*' if `*Files*' exists). - -Optional arg PREDICATE is a predicate used to filter FILES: only files - satisfying PREDICATE are listed. - -Non-nil arg DETAILS means show details about each file, in addition to -the file name. It is passed to `diredp-list-file' (which see). - -File names listed are absolute. Mouseover gives help or an image-file -preview, and you can use `RET' or `mouse-2' to visit files." - (unless bufname (setq bufname (generate-new-buffer-name "*Files*"))) - (diredp-with-help-window - bufname - (princ "Files\n-----\n\n") - (let ((all-files-no-wildcards ()) - file-alist file-dir) - (dolist (file files) - (unless (or (string= file "") ; Ignore empty file names. - (and predicate (not (funcall predicate file)))) - (if (not (diredp-string-match-p "[[?*]" file)) - (add-to-list 'all-files-no-wildcards (diredp-list-file file details)) - (setq file-dir (or (file-name-directory file) default-directory) - file-alist (directory-files-and-attributes file-dir 'FULL "[[?*]" 'NOSORT)) - (dolist (ff file-alist) - (add-to-list 'all-files-no-wildcards (diredp-list-file file details)))))) - (save-excursion (dolist (fff (nreverse all-files-no-wildcards)) - (princ fff) (terpri))))) - (with-current-buffer bufname - (let ((buffer-read-only nil)) - (save-excursion - (goto-char (point-min)) - (forward-line 3) - (while (not (eobp)) - (add-text-properties (line-beginning-position) (line-end-position) - '(mouse-face highlight help-echo diredp-mouseover-help dired-filename t - ;; `keymap' does not work for Emacs 20. Could use `local-map' - ;; but that still leaves `RET' bound to `help-follow'. - keymap diredp-list-files-map)) - (forward-line 1)))) - (set-buffer-modified-p nil) - (setq buffer-read-only t) - (buffer-enable-undo))) - -(defun diredp-list-file (file &optional details) - "Return FILE name, expanded. -Non-nil optional arg DETAILS means append details about FILE to the -returned string. - -If DETAILS is a list of file attribute numbers then include only the -values of those attributes. Otherwise, include all attribute values." - (let ((file-dir (and details (or (file-name-directory file) default-directory))) - attrs) - (setq file (expand-file-name file file-dir)) - (when (and details (atom details)) (setq details '(0 1 2 3 4 5 6 7 8 9 10 11))) - (concat - file - (and details - (setq attrs (file-attributes file)) - (concat - "\n" - (and (memq 0 details) - (format " File Type: %s\n" - (cond ((eq t (nth 0 attrs)) "Directory") - ((stringp (nth 0 attrs)) (format "Symbolic link to `%s'" (nth 0 attrs))) - (t "Normal file")))) - (and (memq 8 details) - (format " Permissions: %s\n" (nth 8 attrs))) - (and (memq 7 details) (not (eq t (nth 0 attrs))) - (format " Size in bytes: %g\n" (nth 7 attrs))) - (and (memq 4 details) - (format-time-string " Time of last access: %a %b %e %T %Y (%Z)\n" (nth 4 attrs))) - (and (memq 5 details) - (format-time-string " Time of last modification: %a %b %e %T %Y (%Z)\n" (nth 5 attrs))) - (and (memq 6 details) - (format-time-string " Time of last status change: %a %b %e %T %Y (%Z)\n" (nth 6 attrs))) - (and (memq 1 details) - (format " Number of links: %d\n" (nth 1 attrs))) - (and (memq 2 details) - (format " User ID (UID): %s\n" (nth 2 attrs))) - (and (memq 3 details) - (format " Group ID (GID): %s\n" (nth 3 attrs))) - (and (memq 10 details) - (format " Inode: %S\n" (nth 10 attrs))) - (and (memq 11 details) - (format " Device number: %s\n" (nth 11 attrs)))))))) - -(defvar diredp-files-within-dirs-done () - "Directories already processed by `diredp-files-within'.") - - -;; Not used in the `Dired+' code yet. -(defun diredp-directories-within (&optional directory no-symlinks-p predicate) - "List of accessible directories within DIRECTORY. -Directories in `icicle-ignored-directories' are skipped, if you use -Icicles. Otherwise, directories in `vc-directory-exclusion-list' are -skipped. - -Optional arg DIRECTORY defaults to the value of `default-directory'. -Non-nil optional arg NO-SYMLINKS-P means do not follow symbolic links. -Non-nil optional arg PREDICATE must be a function that accepts a - file-name argument. Only directories that satisfy PREDICATE are - included in the result." - (unless directory (setq directory default-directory)) - (let ((dirs (diredp-files-within (directory-files directory 'FULL diredp-re-no-dot) - () no-symlinks-p 'INCLUDE-DIRS-P - #'file-directory-p))) - (if predicate (diredp-remove-if-not predicate dirs) dirs))) - -;; Args INCLUDE-DIRS-P and PREDICATE are not used in the `Dired+' code yet -;; (except in `diredp-directories-within', which also is not used yet). -;; -(defun diredp-files-within (file-list accum &optional no-symlinks-p include-dirs-p predicate) - "List of readable files in FILE-LIST, handling directories recursively. -FILE-LIST is a list of file names or a function that returns such. -If a function then invoke it with no args to get the list of files. - -Accessible directories in the list of files are processed recursively -to include their files and the files in their subdirectories. The -directories themselves are not included, unless optional arg -INCLUDE-DIRS-P is non-nil. (Directories in -`icicle-ignored-directories' are skipped, if you use Icicles. -Otherwise, directories in `vc-directory-exclusion-list' are skipped.) - -But if there is a Dired buffer for such a directory, and if FILE-LIST -is a function, then it is invoked in that Dired buffer to return the -list of files to use. E.g., if FILE-LIST is `dired-get-marked-files' -then only the marked files and subdirectories are included. If you -have more than one Dired buffer for a directory that is processed -here, then only the first one in `dired-buffers' is used. - -The list of files is accumulated in ACCUM, which is used for recursive -calls. - -Non-nil optional arg NO-SYMLINKS-P means do not follow symbolic links. - -Non-nil optional arg INCLUDE-DIRS-P means include directory names -along with the names of non-directories. - -Non-nil optional arg PREDICATE must be a function that accepts a -file-name argument. Only files (and possibly directories) that -satisfy PREDICATE are included in the result." - ;; Bind `diredp-files-within-dirs-done' for use as a free var in `diredp-files-within-1'. - (let ((diredp-files-within-dirs-done ())) - (nreverse (diredp-files-within-1 file-list accum no-symlinks-p include-dirs-p predicate)))) - -;; `diredp-files-within-dirs-done' is free here, bound in `diredp-files-within'. -(defun diredp-files-within-1 (file-list accum no-symlinks-p include-dirs-p predicate) - "Helper for `diredp-files-within'." - (let ((files (if (functionp file-list) (funcall file-list) file-list)) - (res accum) - file) - (when (and files predicate) (setq files (diredp-remove-if-not predicate files))) - (while files - (setq file (car files)) - (unless (and no-symlinks-p (file-symlink-p file)) - (if (file-directory-p file) - ;; Skip directory if ignored, already treated, or inaccessible. - (when (and (not (member (file-name-nondirectory file) - (if (boundp 'icicle-ignored-directories) - icicle-ignored-directories - (and (boundp 'vc-directory-exclusion-list) - vc-directory-exclusion-list)))) - (not (member (file-truename file) diredp-files-within-dirs-done)) - (file-accessible-directory-p file)) - (setq res (diredp-files-within-1 (or (and (functionp file-list) - (dired-buffers-for-dir - (expand-file-name file)) ; Removes killed buffers. - (with-current-buffer - (cdr (assoc (file-name-as-directory file) - dired-buffers)) - (funcall file-list))) - (directory-files file 'FULL diredp-re-no-dot)) - res no-symlinks-p include-dirs-p predicate)) - (when include-dirs-p (push file res)) - (push (file-truename file) diredp-files-within-dirs-done)) - (when (file-readable-p file) (push file res)))) - (pop files)) - res)) - -(defun diredp-remove-if (pred xs) - "A copy of list XS with no elements that satisfy predicate PRED." - (let ((result ())) - (dolist (x xs) (unless (funcall pred x) (push x result))) - (nreverse result))) - -(defun diredp-remove-if-not (pred xs) - "A copy of list XS with only elements that satisfy predicate PRED." - (let ((result ())) - (dolist (x xs) (when (funcall pred x) (push x result))) - (nreverse result))) - -(when (> emacs-major-version 21) ; Emacs 20 has no PREDICATE arg to `read-file-name'. - (defun diredp-insert-as-subdir (child ancestor &optional in-dired-now-p) - "Insert the current Dired dir into a Dired listing of an ancestor dir. -Ancestor means parent, grandparent, etc. at any level. -You are prompted for the ancestor directory. -The ancestor Dired buffer is selected. - -Markings and switches in the current Dired buffer are preserved for -the subdir listing in the ancestor Dired buffer. - -Note: If you use Icicles, then you can use -`icicle-dired-insert-as-subdir' instead: it is a multi-command. It -does the same thing, but it lets you insert any number of descendant -directories into a given ancestor-directory Dired buffer. - -Non-interactively: - Insert CHILD dir into Dired listing for ANCESTOR dir. - - Non-nil optional arg IN-DIRED-NOW-P means to use the current buffer - as the Dired buffer from which to pick up markings and switches. - Otherwise, pick them up from a Dired buffer for CHILD, if there is - exactly one such buffer." - (interactive (progn (diredp-ensure-mode) - (list default-directory - (completing-read - "Insert this dir into ancestor dir: " - (mapcar #'list (diredp-ancestor-dirs default-directory))) - t))) - (let ((child-dired-buf (if in-dired-now-p - (current-buffer) - (dired-buffers-for-dir (expand-file-name child)))) - (switches ()) - (marked ())) - (when (consp child-dired-buf) - (setq child-dired-buf (and (= 1 (length child-dired-buf)) (car child-dired-buf)))) - (when child-dired-buf - (with-current-buffer child-dired-buf - (setq switches dired-actual-switches - marked (dired-remember-marks (point-min) (point-max))))) - (dired-other-window ancestor) - (dired-insert-subdir child switches) - (when marked (let ((inhibit-read-only t)) (dired-mark-remembered marked))) - (set-buffer-modified-p nil)))) - -(defun diredp-ancestor-dirs (dir) - "Return a list of the ancestor directories of directory DIR." - (mapcar #'file-name-as-directory - (diredp-maplist (lambda (dd) (mapconcat #'identity (reverse dd) "/")) - (cdr (nreverse (split-string dir "/" t)))))) - -(defun diredp-maplist (function list) - "Map FUNCTION over LIST and its cdrs. -A simple, recursive version of the classic `maplist'." - (and list (cons (funcall function list) (diredp-maplist function (cdr list))))) - -(defun diredp-existing-dired-buffer-p (buffer-name) - "Return non-nil if BUFFER-NAME names a live, existing Dired buffer." - (let ((dbuf (get-buffer buffer-name))) - (and dbuf (buffer-live-p dbuf) (rassq dbuf dired-buffers)))) - -;; From `cl-seq.el', function `union', without keyword treatment. -;; (Same as `icicle-set-union' in `icicles-fn.el'.) -(defun diredp-set-union (list1 list2) - "Combine LIST1 and LIST2 using a set-union operation. -The result list contains all items that appear in either LIST1 or -LIST2. Comparison is done using `equal'. This is a non-destructive -function; it copies the data if necessary." - (cond ((null list1) list2) - ((null list2) list1) - ((equal list1 list2) list1) - (t - (unless (>= (length list1) (length list2)) - (setq list1 (prog1 list2 (setq list2 list1)))) ; Swap them. - (while list2 - (unless (member (car list2) list1) (setq list1 (cons (car list2) list1))) - (setq list2 (cdr list2))) - list1))) - -(when (fboundp 'file-equal-p) ; Emacs 24+ - (defun diredp-move-file (file &optional prompt-anyway) - "Move FILE to associated directory in `diredp-move-file-dirs'. -If no association, or if you use a prefix arg, prompt for directory." - (interactive (list (dired-get-filename) current-prefix-arg)) - (unless file (error "No file specified")) - (let* ((file-sans (file-name-nondirectory file)) - (dir (file-name-as-directory - (or (and (not prompt-anyway) - (cdr (assoc file-sans diredp-move-file-dirs))) - (read-directory-name "Move to: "))))) - (when (file-equal-p dir (file-name-directory file)) - (error "Cannot move to same directory: %s" dir)) - (dired-rename-file file dir nil) - (dired-add-file (expand-file-name file-sans dir)) - (message "Moved `%s' to `%s'" file-sans dir)))) - -(defvar diredp-last-copied-filenames () - "String list of file names last copied to the `kill-ring'. -Copying is done by `dired-copy-filename-as-kill' and related commands.") - - -;; REPLACE ORIGINAL in `dired-x.el'. -;; -;; Put text copied to kill ring in variable `diredp-last-copied-filenames'. -;; -(defun dired-copy-filename-as-kill (&optional arg) - "Copy names of marked (or next ARG) files into the kill ring. -The names are separated by a space. -With a zero prefix arg, use the absolute file name of each marked file. -With \\[universal-argument], use the file name relative to the Dired buffer's -`default-directory'. (This still may contain slashes if in a subdirectory.) - -If on a subdir headerline, use absolute subdirname instead; -prefix arg and marked files are ignored in this case. - -You can then feed the file name(s) to other commands with \\[yank]. - -The value of global variable `diredp-last-copied-filenames' is updated -to the string list of file name(s), so you can obtain it even after -the kill ring is modified." - (interactive "P") - (let* ((num-arg (prefix-numeric-value arg)) - (string (or (dired-get-subdir) - (mapconcat #'identity - (cond ((not arg) (dired-get-marked-files 'no-dir)) - ((zerop num-arg) (dired-get-marked-files)) - ((consp arg) (dired-get-marked-files t)) - (t (dired-get-marked-files 'no-dir num-arg))) - " ")))) - (unless (string= "" string) - (if (eq last-command 'kill-region) (kill-append string nil) (kill-new string)) - (setq diredp-last-copied-filenames (car kill-ring-yank-pointer)) - (message "%s" string)))) - -(defun diredp-copy-abs-filenames-as-kill () ; Not bound. - "Copy absolute names of marked files in Dired to the kill ring. -Also set variable `diredp-last-copied-filenames' to the string that -lists the file names. - -This is the same as using a zero prefix arg with command -`dired-copy-filename-as-kill', that is, \\`M-0 \\[dired-copy-filename-as-kill]'." - (interactive (diredp-ensure-mode)) - (dired-copy-filename-as-kill 0)) - -;;;###autoload -(defalias 'diredp-paste-files 'diredp-yank-files) ; Bound to `C-y'. -;;;###autoload -(defun diredp-yank-files (&optional dir no-confirm-p details) - "Paste files, whose absolute names you copied, to the current directory. -With a non-negative prefix arg you are instead prompted for the target - directory. -With a non-positive prefix arg you can see details about the files if - you hit `l' when prompted to confirm pasting. Otherwise you see only - the file names. The details you see are defined by option - `diredp-list-file-attributes'. - -You should have copied the list of file names as a string to the kill -ring using \\`M-0 \\[dired-copy-filename-as-kill]' or \ -\\[diredp-copy-abs-filenames-as-kill]. -Those commands also set variable `diredp-last-copied-filenames' to the -same string. `diredp-yank-files' uses the value of that variable, not -whatever is currently at the head of the kill ring. - -When called from Lisp: - -Optional arg NO-CONFIRM-P means do not ask for confirmation to copy. -Optional arg DETAILS is passed to `diredp-y-or-n-files-p'." - (interactive (list (and current-prefix-arg (natnump (prefix-numeric-value current-prefix-arg)) - (expand-file-name (read-directory-name "Yank files to directory: "))) - nil - (and current-prefix-arg - (<= (prefix-numeric-value current-prefix-arg) 0) - diredp-list-file-attributes))) - (setq dir (or dir (and (derived-mode-p 'dired-mode) (dired-current-directory)))) - (unless (file-directory-p dir) (error "Not a directory: `%s'" dir)) - (let ((files diredp-last-copied-filenames)) - (unless (stringp files) (error "No copied file names")) - (setq files (diredp-delete-if-not (lambda (file) (file-name-absolute-p file)) (split-string files))) - (unless files (error "No copied *absolute* file names (Did you use `M-0 w'?)")) - (if (and (not no-confirm-p) - (diredp-y-or-n-files-p "Paste files whose names you copied? " files nil details)) - (dired-create-files #'dired-copy-file "Copy" files - (lambda (from) (expand-file-name (file-name-nondirectory from) dir))) - (message "OK, file-pasting canceled")))) - -;;;###autoload -(defun diredp-move-files-named-in-kill-ring (&optional dir no-confirm-p details) ; Bound to `C-w' - "Move files, whose absolute names you copied, to the current directory. -With a non-negative prefix arg you are instead prompted for the target - directory. -With a non-positive prefix arg you can see details about the files if - you hit `l' when prompted to confirm pasting. Otherwise you see only - the file names. The details you see are defined by option - `diredp-list-file-attributes'. - -You should have copied the list of file names as a string to the kill -ring using \\`M-0 \\[dired-copy-filename-as-kill]' or \ -\\[diredp-copy-abs-filenames-as-kill]. -Those commands also set variable `diredp-last-copied-filenames' to the -same string. `diredp-move-files-named-in-kill-ring' uses the value of -that variable, not whatever is currently at the head of the kill ring. - -When called from Lisp: - -Optional arg NO-CONFIRM-P means do not ask for confirmation to move. -Optional arg DETAILS is passed to `diredp-y-or-n-files-p'." - (interactive (list (and current-prefix-arg (natnump (prefix-numeric-value current-prefix-arg)) - (expand-file-name (read-directory-name "Move files to directory: "))) - nil - (and current-prefix-arg - (<= (prefix-numeric-value current-prefix-arg) 0) - diredp-list-file-attributes))) - (setq dir (or dir (and (derived-mode-p 'dired-mode) (dired-current-directory)))) - (unless (file-directory-p dir) (error "Not a directory: `%s'" dir)) - (let ((files diredp-last-copied-filenames)) - (unless (stringp files) (error "No copied file names")) - (setq files (diredp-delete-if-not (lambda (file) (file-name-absolute-p file)) (split-string files))) - (unless files (error "No copied (absolute* file names (Did you use `M-0 w'?)")) - (if (and (not no-confirm-p) - (diredp-y-or-n-files-p "MOVE files whose names you copied? " files nil details)) - (dired-create-files #'dired-rename-file "Move" files - (lambda (from) (expand-file-name (file-name-nondirectory from) dir))) - (message "OK, file-moves canceled")))) - - -;;; Commands operating on marked at all levels below (recursively) - -(defun diredp-get-confirmation-recursive (&optional type) - "Get confirmation from user to act on all TYPE here and below. -If TYPE is nil use \"files\" in the confirmation prompt, else use TYPE. -Raise an error if not confirmed. -Raise an error first if not in Dired mode." - (diredp-ensure-mode) - (unless (y-or-n-p (format "Act on ALL %s (or all marked if any) in and UNDER this dir? " - (or type 'files))) - (error "OK, canceled"))) - -;;;###autoload -(when (> emacs-major-version 21) ; Emacs 22+ has KILL-ROOT parameter. - (defun diredp-kill-this-tree () - "Remove this subdir listing and lower listings." - (interactive) - (dired-kill-tree (dired-current-directory) nil 'KILL-ROOT))) - -;;;###autoload -(defun diredp-insert-subdirs (&optional switches interactivep) ; Bound to `M-i' - "Insert the marked subdirectories. -Like using \\`\\[dired-maybe-insert-subdir]' at each marked directory line." - (interactive (list (and current-prefix-arg - (read-string "Switches for listing: " - (or (and (boundp 'dired-subdir-switches) dired-subdir-switches) - dired-actual-switches))) - t)) - (dolist (subdir (dired-get-marked-files nil - nil - (lambda (fl) (and (file-directory-p fl) ; Exclude `.' and `..' - (not (diredp-string-match-p "/[.][.]?\\'" fl)))) - nil - interactivep)) - (dired-maybe-insert-subdir subdir switches))) - -;;;###autoload -(defun diredp-insert-subdirs-recursive (&optional ignore-marks-p details) ; Bound to `M-+ M-i' - "Insert the marked subdirs, including those in marked subdirs. -Like `diredp-insert-subdirs', but act recursively on subdirs. -The subdirs inserted are those that are marked in the current Dired -buffer, or ALL subdirs in the directory if none are marked. Marked -subdirectories are handled recursively in the same way (their marked -subdirs are inserted...). - -With a prefix argument, ignore all marks - include all files in this -Dired buffer and all subdirs, recursively. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-get-files'." - (interactive (progn (diredp-get-confirmation-recursive 'subdirs) - (list current-prefix-arg diredp-list-file-attributes))) - (dolist (subdir (diredp-get-files ignore-marks-p #'file-directory-p 'INCLUDE-SUBDIRS-P nil nil details)) - (dired-maybe-insert-subdir subdir))) - -;;;###autoload -(defun diredp-do-shell-command-recursive (command &optional ignore-marks-p details) ; Bound to `M-+ !' - "Run shell COMMAND on the marked files, including those in marked subdirs. -Like `dired-do-shell-command', but act recursively on subdirs. -The files included are those that are marked in the current Dired -buffer, or all files in the directory if none are marked. Marked -subdirectories are handled recursively in the same way. - -With a prefix argument, ignore all marks - include all files in this -Dired buffer and all subdirs, recursively. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-get-files'." - (interactive - (progn (diredp-get-confirmation-recursive) - (let* ((prompt "! on *: ") - (cmd (minibuffer-with-setup-hook - (lambda () - (set (make-local-variable 'minibuffer-default-add-function) - 'minibuffer-default-add-dired-shell-commands)) - (let ((dired-no-confirm t)) - (if (functionp 'dired-guess-shell-command) - ;; Guess cmd based only on files marked in current (top) dir. - (dired-guess-shell-command prompt (dired-get-marked-files t)) - (read-shell-command prompt nil nil)))))) - (list cmd current-prefix-arg diredp-list-file-attributes)))) - (dired-do-shell-command command nil (diredp-get-files ignore-marks-p nil nil nil nil details))) - -(when (fboundp 'dired-do-async-shell-command) ; Emacs 23+ - - (defun diredp-do-async-shell-command-recursive (command &optional ignore-marks-p details) - ; Bound to `M-+ &' - "Run async shell COMMAND on marked files, including in marked subdirs. -Like `dired-do-async-shell-command', but act recursively on subdirs. -The files included are those that are marked in the current Dired -buffer, or all files in the directory if none are marked. Marked -subdirectories are handled recursively in the same way. - -With a prefix argument, ignore all marks - include all files in this -Dired buffer and all subdirs, recursively. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-get-files'." - (interactive - (progn (diredp-get-confirmation-recursive) - (let* ((prompt "! on *: ") - (cmd (minibuffer-with-setup-hook - (lambda () - (set (make-local-variable 'minibuffer-default-add-function) - 'minibuffer-default-add-dired-shell-commands)) - (let ((dired-no-confirm t)) - (if (functionp 'dired-guess-shell-command) - ;; Guess cmd based only on files marked in current (top) dir. - (dired-guess-shell-command prompt (dired-get-marked-files t)) - (read-shell-command prompt nil nil)))))) - (list cmd current-prefix-arg diredp-list-file-attributes)))) - (dired-do-async-shell-command command nil (diredp-get-files ignore-marks-p nil nil nil nil details)))) - -;;;###autoload -(defun diredp-do-symlink-recursive (&optional ignore-marks-p details) ; Bound to `M-+ S' - "Make symbolic links to marked files, including those in marked subdirs. -Like `dired-do-symlink', but act recursively on subdirs to pick up the -files to link. - -The files included are those that are marked in the current Dired -buffer, or all files in the directory if none are marked. Marked -subdirectories are handled recursively in the same way. - -With a prefix argument, ignore all marks - include all files in this -Dired buffer and all subdirs, recursively. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-do-create-files-recursive'." - (interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg diredp-list-file-attributes))) - (diredp-do-create-files-recursive #'make-symbolic-link "Symlink" ignore-marks-p details)) - -(defun diredp-do-relsymlink-recursive (&optional ignore-marks-p details) ; Bound to `M-+ Y' - "Relative symlink all marked files, including those in marked subdirs into a dir. -Like `dired-do-relsymlink', but act recursively on subdirs to pick up the -files to link. - -The files included are those that are marked in the current Dired -buffer, or all files in the directory if none are marked. Marked -subdirectories are handled recursively in the same way. - -With a prefix argument, ignore all marks - include all files in this -Dired buffer and all subdirs, recursively. - -For absolute symlinks, use \\[diredp-do-symlink-recursive]. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-do-create-files-recursive'." - (interactive (progn (diredp-get-confirmation-recursive) - (list current-prefix-arg diredp-list-file-attributes))) - (diredp-do-create-files-recursive #'dired-make-relative-symlink "RelSymLink" ignore-marks-p details)) - -;;;###autoload -(defun diredp-do-hardlink-recursive (&optional ignore-marks-p details) ; Bound to `M-+ H' - "Add hard links for marked files, including those in marked subdirs. -Like `dired-do-hardlink', but act recursively on subdirs to pick up the -files to link. - -The files included are those that are marked in the current Dired -buffer, or all files in the directory if none are marked. Marked -subdirectories are handled recursively in the same way. - -With a prefix argument, ignore all marks - include all files in this -Dired buffer and all subdirs, recursively. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-do-create-files-recursive'." - (interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg diredp-list-file-attributes))) - (diredp-do-create-files-recursive #'dired-hardlink "Hardlink" ignore-marks-p details)) - -;;;###autoload -(defun diredp-do-print-recursive (&optional ignore-marks-p details) ; Bound to `M-+ P' - "Print the marked files, including those in marked subdirs. -Like `dired-do-print', but act recursively on subdirs to pick up the -files to print. - -The files included are those that are marked in the current Dired -buffer, or all files in the directory if none are marked. Marked -subdirectories are handled recursively in the same way. - -With a prefix argument, ignore all marks - include all files in this -Dired buffer and all subdirs, recursively. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-get-files'." - (interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg diredp-list-file-attributes))) - (let* ((file-list (diredp-get-files ignore-marks-p nil nil nil nil details)) - (command (dired-mark-read-string - "Print %s with: " - (mapconcat #'identity - (cons lpr-command (if (stringp lpr-switches) (list lpr-switches) lpr-switches)) - " ") - 'print nil file-list))) - (dired-run-shell-command (dired-shell-stuff-it command file-list nil)))) - -;;;###autoload -(defun diredp-image-dired-display-thumbs-recursive (&optional ignore-marks-p append do-not-pop details) - ; Bound to `M-+ C-t d' - "Display thumbnails of marked files, including those in marked subdirs. -Like `image-dired-display-thumbs', but act recursively on subdirs. -Optional arguments APPEND and DO-NOT-POP are as for -`image-dired-display-thumbs'. - -The files included are those that are marked in the current Dired -buffer, or all files in the directory if none are marked. Marked -subdirectories are handled recursively in the same way. - -With a prefix argument, ignore all marks - include all files in this -Dired buffer and all subdirs, recursively. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-get-files'." - (interactive (progn (diredp-image-dired-required-msg) - (diredp-get-confirmation-recursive) - (list current-prefix-arg nil nil diredp-list-file-attributes))) - (let ((buf (image-dired-create-thumbnail-buffer)) - thumb-name files dired-buf) - (setq files (diredp-get-files ignore-marks-p nil nil nil nil details) - dired-buf (current-buffer)) - (with-current-buffer buf - (let ((inhibit-read-only t)) - (if append (goto-char (point-max)) (erase-buffer)) - (mapc (lambda (curr-file) - (setq thumb-name (image-dired-thumb-name curr-file)) - (if (and (not (file-exists-p thumb-name)) - (not (= 0 (image-dired-create-thumb curr-file thumb-name)))) - (message "Thumb could not be created for file %s" curr-file) - (image-dired-insert-thumbnail thumb-name curr-file dired-buf))) - files)) - (case image-dired-line-up-method - (dynamic (image-dired-line-up-dynamic)) - (fixed (image-dired-line-up)) - (interactive (image-dired-line-up-interactive)) - (none nil) - (t (image-dired-line-up-dynamic)))) - (if do-not-pop - (display-buffer image-dired-thumbnail-buffer) - (pop-to-buffer image-dired-thumbnail-buffer)))) - -;;;###autoload -(defun diredp-image-dired-tag-files-recursive (&optional ignore-marks-p details) ; Bound to `M-+ C-t t' - "Tag marked files with an `image-dired' tag, including in marked subdirs. -Like `image-dired-tag-files', but act recursively on subdirs. -The files included are those that are marked in the current Dired -buffer, or all files in the directory if none are marked. Marked -subdirectories are handled recursively in the same way. - -With a prefix argument, ignore all marks - include all files in this -Dired buffer and all subdirs, recursively. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-get-files'." - (interactive (progn (diredp-image-dired-required-msg) - (diredp-get-confirmation-recursive) - (list current-prefix-arg diredp-list-file-attributes))) - (let ((tag (read-string "Tags to add (separate tags with a semicolon): "))) - (image-dired-write-tags (mapcar (lambda (x) (cons x tag)) - (diredp-get-files ignore-marks-p nil nil nil nil details))))) - -;;;###autoload -(defun diredp-image-dired-delete-tag-recursive (&optional ignore-marks-p details) ; Bound to `M-+ C-t r' - "Remove `image-dired' tag for marked files, including in marked subdirs. -Like `image-dired-delete-tag', but act recursively on subdirs. -The files included are those that are marked in the current Dired -buffer, or all files in the directory if none are marked. Marked -subdirectories are handled recursively in the same way. - -With a prefix argument, ignore all marks - include all files in this -Dired buffer and all subdirs, recursively. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-get-files'." - (interactive (progn (diredp-image-dired-required-msg) - (diredp-get-confirmation-recursive) - (list current-prefix-arg diredp-list-file-attributes))) - (image-dired-remove-tag (diredp-get-files ignore-marks-p nil nil nil nil details) - (read-string "Tag to remove: "))) - -;;;###autoload -(defun diredp-image-dired-comment-files-recursive (&optional ignore-marks-p details) - ; Bound to `M-+ C-t c' - "Add comment to marked files in dired, including those in marked subdirs. -Like `image-dired-dired-comment-files' but act recursively on subdirs. -The files included are those that are marked in the current Dired -buffer, or all files in the directory if none are marked. Marked -subdirectories are handled recursively in the same way. - -With a prefix argument, ignore all marks - include all files in this -Dired buffer and all subdirs, recursively. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-get-files'." - (interactive (progn (diredp-image-dired-required-msg) - (diredp-get-confirmation-recursive) - (list current-prefix-arg diredp-list-file-attributes))) - (let ((comment (image-dired-read-comment))) - (image-dired-write-comments (mapcar (lambda (curr-file) (cons curr-file comment)) - (diredp-get-files ignore-marks-p nil nil nil nil details))))) - -(when (> emacs-major-version 22) - - (defun diredp-do-decrypt-recursive (&optional ignore-marks-p details) ; Bound to `M-+ : d' - "Decrypt marked files, including those in marked subdirs. -Like `epa-dired-do-decrypt', but act recursively on subdirs to pick up -the files to decrypt. - -The files included are those that are marked in the current Dired -buffer, or all files in the directory if none are marked. Marked -subdirectories are handled recursively in the same way. - -With a prefix argument, ignore all marks - include all files in this -Dired buffer and all subdirs, recursively. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-get-files'." - (interactive (progn (diredp-get-confirmation-recursive) - (list current-prefix-arg diredp-list-file-attributes))) - (dolist (file (diredp-get-files ignore-marks-p nil nil nil nil details)) - (epa-decrypt-file (expand-file-name file))) - (revert-buffer)) - - (defun diredp-do-verify-recursive (&optional ignore-marks-p details) ; Bound to `M-+ : v' - "Verify marked files, including those in marked subdirs. -Like `epa-dired-do-verify', but act recursively on subdirs to pick up -the files to verify. - -The files included are those that are marked in the current Dired -buffer, or all files in the directory if none are marked. Marked -subdirectories are handled recursively in the same way. - -With a prefix argument, ignore all marks - include all files in this -Dired buffer and all subdirs, recursively. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-get-files'." - (interactive (progn (diredp-get-confirmation-recursive) - (list current-prefix-arg diredp-list-file-attributes))) - (dolist (file (diredp-get-files ignore-marks-p nil nil nil nil details)) - (epa-verify-file (expand-file-name file))) - (revert-buffer)) - - (defun diredp-do-sign-recursive (&optional ignore-marks-p details) ; Bound to `M-+ : s' - "Sign marked files, including those in marked subdirs. -Like `epa-dired-do-sign', but act recursively on subdirs to pick up -the files to sign. - -The files included are those that are marked in the current Dired -buffer, or all files in the directory if none are marked. Marked -subdirectories are handled recursively in the same way. - -With a prefix argument, ignore all marks - include all files in this -Dired buffer and all subdirs, recursively. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-get-files'." - (interactive (progn (diredp-get-confirmation-recursive) - (list current-prefix-arg diredp-list-file-attributes))) - (dolist (file (diredp-get-files ignore-marks-p nil nil nil nil details)) - (epa-sign-file (expand-file-name file) - (epa-select-keys (epg-make-context) "Select keys for signing. -If none are selected, the default secret key is used. ") - (y-or-n-p "Make a detached signature? "))) - (revert-buffer)) - - (defun diredp-do-encrypt-recursive (&optional ignore-marks-p details) ; Bound to `M-+ : e' - "Encrypt marked files, including those in marked subdirs. -Like `epa-dired-do-encrypt', but act recursively on subdirs to pick up -the files to encrypt. - -The files included are those that are marked in the current Dired -buffer, or all files in the directory if none are marked. Marked -subdirectories are handled recursively in the same way. - -With a prefix argument, ignore all marks - include all files in this -Dired buffer and all subdirs, recursively. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-get-files'." - (interactive (progn (diredp-get-confirmation-recursive) - (list current-prefix-arg diredp-list-file-attributes))) - (dolist (file (diredp-get-files ignore-marks-p nil nil nil nil details)) - (epa-encrypt-file (expand-file-name file) - (epa-select-keys (epg-make-context) "Select recipients for encryption. -If none are selected, symmetric encryption is performed. "))) - (revert-buffer))) - -;;;###autoload -(defun diredp-do-bookmark-recursive (&optional ignore-marks-p prefix details) ; Bound to `M-+ M-b' - "Bookmark the marked files, including those in marked subdirs. -Like `diredp-do-bookmark', but act recursively on subdirs. -The files included are those that are marked in the current Dired -buffer, or all files in the directory if none are marked. Marked -subdirectories are handled recursively in the same way. - -With a prefix argument, ignore all marks - include all files in this -Dired buffer and all subdirs, recursively. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-get-files'." - (interactive (progn (diredp-get-confirmation-recursive) - (list current-prefix-arg - (and diredp-prompt-for-bookmark-prefix-flag - (read-string "Prefix for bookmark name: ")) - diredp-list-file-attributes))) - (dolist (file (diredp-get-files ignore-marks-p nil nil nil nil details)) - (diredp-bookmark prefix file 'NO-MSG-P))) - -;;;###autoload -(defun diredp-do-bookmark-dirs-recursive (ignore-marks-p &optional details msgp) - "Bookmark this Dired buffer and marked subdirectory Dired buffers, recursively. -Create a Dired bookmark for this directory and for each of its marked -subdirectories. Handle each of the marked subdirectory similarly: -bookmark it and its marked subdirectories, and so on, recursively. -Name each of these Dired bookmarks with the Dired buffer name. - -After creating the Dired bookmarks, create a sequence bookmark, named -`DIRBUF and subdirs', where DIRBUF is the name of the original buffer. -This bookmark represents the whole Dired tree rooted in the directory -where you invoked the command. Jumping to this sequence bookmark -restores all of the Dired buffers making up the tree, by jumping to -each of their bookmarks. - -With a prefix arg, bookmark the marked and unmarked subdirectory Dired -buffers, recursively, that is, ignore markings. - -Note: - -* If there is more than one Dired buffer for a given subdirectory then - only the first such is used. - -* This command creates new bookmarks. It never updates or overwrites - an existing bookmark. - -You need library `Bookmark+' for this command. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-get-subdirs'." - (interactive (progn (unless (featurep 'bookmark+) - (error "You need library `Bookmark+' for this command")) - (diredp-get-confirmation-recursive 'subdirs) - (list current-prefix-arg diredp-list-file-attributes t))) - (diredp-ensure-mode) - (let ((sdirs (diredp-get-subdirs ignore-marks-p nil details)) - (snames ()) - dbufs) - (when (and msgp sdirs) (message "Checking descendant directories...")) - (dolist (dir (cons default-directory sdirs)) - (when (setq dbufs (dired-buffers-for-dir (expand-file-name dir))) ; Dirs with Dired buffers only. - (with-current-buffer (car dbufs) - (let ((bname (bookmark-buffer-name)) - (count 2)) - (while (and (bmkp-get-bookmark-in-alist bname 'NOERROR) (setq bname (format "%s[%d]" bname count)))) - (bookmark-set bname nil nil 'NO-UPDATE-P) ; Inhibit updating displayed list. - (push bname snames))))) - (let ((bname (format "%s and subdirs" (bookmark-buffer-name))) - (count 2)) - (while (and (bmkp-get-bookmark-in-alist bname 'NOERROR) (setq bname (format "%s[%d]" bname count)))) - (bmkp-set-sequence-bookmark bname (nreverse snames) -1 'MSGP)) - (bmkp-refresh/rebuild-menu-list nil))) - -;;;###autoload -(defun diredp-do-bookmark-in-bookmark-file-recursive (bookmark-file ; Bound to `M-+ C-M-B', aka `M-+ C-M-S-b') - &optional prefix ignore-marks-p bfile-bookmarkp details) - "Bookmark files here and below in BOOKMARK-FILE and save BOOKMARK-FILE. -Like `diredp-do-bookmark-in-bookmark-file', but act recursively on -subdirs. The files included are those that are marked in the current -Dired buffer, or all files in the directory if none are marked. -Marked subdirectories are handled recursively in the same way. - -With a prefix argument, ignore all marks - include all files in this -Dired buffer and all subdirs, recursively. - -When called from Lisp: - * Optional arg BFILE-BOOKMARKP non-nil means create a bookmark-file - bookmark for BOOKMARK-FILE. - * Optional arg DETAILS is passed to `diredp-get-files'." - (interactive - (progn (diredp-get-confirmation-recursive) - (let ((d-r-b-f-args (diredp-read-bookmark-file-args))) - (list (car d-r-b-f-args) - (cadr d-r-b-f-args) - (car (cddr d-r-b-f-args)) - nil - diredp-list-file-attributes)))) - (diredp-do-bookmark-in-bookmark-file bookmark-file prefix nil bfile-bookmarkp - (diredp-get-files ignore-marks-p nil nil nil nil details))) - -;;;###autoload -(defun diredp-set-bookmark-file-bookmark-for-marked-recursive (bookmark-file - &optional prefix ignore-marks-p details) - ; Bound to `M-+ C-M-b' - "Bookmark the marked files and create a bookmark-file bookmark for them. -Like `diredp-set-bookmark-file-bookmark-for-marked', but act -recursively on subdirs. - -The files included are those that are marked in the current Dired -buffer, or all files in the directory if none are marked. Marked -subdirectories are handled recursively in the same way. - -With a prefix argument, ignore all marks - include all files in this -Dired buffer and all subdirs, recursively. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-do-bookmark-in-bookmark-file-recursive'." - (interactive (progn (diredp-get-confirmation-recursive) - (let ((d-r-b-f-args (diredp-read-bookmark-file-args))) - (list (car d-r-b-f-args) - (cadr d-r-b-f-args) - (car (cddr d-r-b-f-args)) - diredp-list-file-attributes)))) - (diredp-ensure-bookmark+) - (diredp-do-bookmark-in-bookmark-file-recursive - bookmark-file prefix ignore-marks-p 'CREATE-BOOKMARK-FILE-BOOKMARK details)) - -;;;###autoload -(defun diredp-do-find-marked-files-recursive (&optional arg details) ; Bound to `M-+ F' - "Find marked files simultaneously, including those in marked subdirs. -Like `dired-do-find-marked-files', but act recursively on subdirs. -The files included are those that are marked in the current Dired -buffer, or all files in the directory if none are marked. Marked -subdirectories are handled recursively in the same way. - -With (explicit) numeric prefix ARG >= 0, find the files but do not -display them. - -With numeric prefix ARG <= 0, ignore all marks - include all files in -this Dired buffer and all subdirs, recursively. - -Note that prefix-argument behavior is different for this command than -for `dired-do-find-marked-files'. In particular, a negative numeric -prefix arg does not cause the files to be shown in separate frames. -Only non-nil `pop-up-frames' (or equivalent configuration) causes -the files to be shown in separate frames. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-get-files'." - (interactive (progn (diredp-get-confirmation-recursive) - (list current-prefix-arg diredp-list-file-attributes))) - (let ((narg (prefix-numeric-value arg))) - (dired-simultaneous-find-file (diredp-get-files (<= narg 0) nil nil nil nil details) - (and arg (>= narg 0) narg)))) - -(when (fboundp 'dired-do-isearch-regexp) ; Emacs 23+ - - (defun diredp-do-isearch-recursive (&optional ignore-marks-p details) ; Bound to `M-+ M-s a C-s' - "Isearch the marked files, including those in marked subdirs. -With a prefix argument, ignore all marks - include all files in this -Dired buffer and all subdirs, recursively. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-get-files'." - (interactive (progn (diredp-get-confirmation-recursive) - (list current-prefix-arg diredp-list-file-attributes))) - (multi-isearch-files (diredp-get-files ignore-marks-p nil nil nil nil details))) - - (defun diredp-do-isearch-regexp-recursive (&optional ignore-marks-p details) ; `M-+ M-s a C-M-s' - "Regexp-Isearch the marked files, including those in marked subdirs. -With a prefix argument, ignore all marks - include all files in this -Dired buffer and all subdirs, recursively. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-get-files'." - (interactive (progn (diredp-get-confirmation-recursive) - (list current-prefix-arg diredp-list-file-attributes))) - (multi-isearch-files-regexp (diredp-get-files ignore-marks-p nil nil nil nil details)))) - -(defun diredp-do-search-recursive (regexp &optional ignore-marks-p details) ; Bound to `M-+ A' - "Regexp-search the marked files, including those in marked subdirs. -With a prefix argument, ignore all marks - include all files in this -Dired buffer and all subdirs, recursively. - -Stops when a match is found. -To continue searching for the next match, use `\\[tags-loop-continue]'. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-get-files'." - (interactive (progn (diredp-get-confirmation-recursive) - (list (read-string "Search marked files (regexp): ") - current-prefix-arg - diredp-list-file-attributes))) - (tags-search regexp '(diredp-get-files ignore-marks-p nil nil nil nil details))) - -;;;###autoload -(defun diredp-do-query-replace-regexp-recursive (from to &optional arg details) - ; Bound to `M-+ Q' - "Do `query-replace-regexp' on marked files, including in marked subdirs. -Query-replace FROM with TO. - -Like `dired-do-query-replace', but act recursively on subdirs. -The files included are those that are marked in the current Dired -buffer, or all files in the directory if none are marked. Marked -subdirectories are handled recursively in the same way. - -With an (explicit) numeric prefix argument: - -* >= 0 means ignore all marks - include ALL files in this Dired buffer - and all subdirs, recursively. - -* <= 0 means replace only word-delimited matches. - -If you exit (`\\[keyboard-quit]', `RET' or `q'), you can resume the query replacement -using `\\[tags-loop-continue]'. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-get-files'." - (interactive (progn (diredp-get-confirmation-recursive) - (let ((common (query-replace-read-args "Query replace regexp in marked files" t t))) - (list (nth 0 common) - (nth 1 common) - current-prefix-arg - diredp-list-file-attributes)))) - (let* ((narg (and arg (prefix-numeric-value arg))) - (delimited (and narg (<= narg 0))) - (ignore-marks-p (and narg (>= narg 0))) - (files (diredp-get-files ignore-marks-p nil nil nil nil details)) - (fit-frame-min-width 30) - (fit-frame-min-height 15)) - (dolist (file files) - (let ((buffer (get-file-buffer file))) - (when (and buffer (with-current-buffer buffer buffer-read-only)) - (error "File `%s' is visited read-only" file)))) - (tags-query-replace from to delimited `',files))) - -;;;###autoload -(defun diredp-do-grep-recursive (command-args &optional details) ; Bound to `M+ C-M-G' - "Run `grep' on marked files, including those in marked subdirs. -Like `diredp-do-grep', but act recursively on subdirs. -The files included are those that are marked in the current Dired -buffer, or all files in the directory if none are marked. Marked -subdirectories are handled recursively in the same way. - -With a prefix argument, ignore all marks - include all files in this -Dired buffer and all subdirs, recursively. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-get-files'." - (interactive (progn (diredp-get-confirmation-recursive) - (unless (if (< emacs-major-version 22) - grep-command - (and grep-command (or (not grep-use-null-device) (eq grep-use-null-device t)))) - (grep-compute-defaults)) - (list (diredp-do-grep-1 - (diredp-get-files current-prefix-arg nil nil nil nil diredp-list-file-attributes))))) - (grep command-args)) - -;;;###autoload -(defun diredp-marked-recursive (dirname &optional ignore-marks-p details) ; Not bound to a key - "Open Dired on marked files, including those in marked subdirs. -Like `diredp-marked', but act recursively on subdirs. - -See `diredp-do-find-marked-files-recursive' for a description of the -files included. In particular, if no files are marked here or in a -marked subdir, then all files in the directory are included. - -With a prefix argument, ignore all marks - include all files in this -Dired buffer and all subdirs, recursively. - -When called from Lisp, DIRNAME here must be a string, not a cons. It -is used as the name of the new Dired buffer. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-get-files'." - (interactive (progn (diredp-get-confirmation-recursive) - (list nil current-prefix-arg diredp-list-file-attributes))) - (dired (cons (or dirname (generate-new-buffer-name (buffer-name))) - (diredp-get-files ignore-marks-p nil nil nil nil details)))) - -;;;###autoload -(defun diredp-marked-recursive-other-window (dirname &optional ignore-marks-p details) ; Bound to `M-+ C-M-*' - "Same as `diredp-marked-recursive', but uses a different window. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-get-files'." - (interactive (progn (diredp-get-confirmation-recursive) - (list nil current-prefix-arg diredp-list-file-attributes))) - (dired-other-window - (cons (or dirname (generate-new-buffer-name (buffer-name))) - (diredp-get-files ignore-marks-p nil nil nil nil details)))) - -;;;###autoload -(defun diredp-list-marked-recursive (&optional ignore-marks-p predicate details) ; Bound to `M-+ C-M-l' - "List the files marked here and in marked subdirs, recursively. -The files included are those that are marked in the current Dired -buffer, or all files in the directory if none are marked. Marked -subdirectories are handled recursively in the same way. - -With a prefix argument, all marks are ignored: all files in this Dired -buffer and all descendant directories are included. - -You can use `RET' or `mouse-2' to visit any of the files. -If `tooltip-mode' is on then moving the mouse over image-file names -shows image previews. - -When called from Lisp: - Non-nil optional arg IGNORE-MARKS-P means ignore marks. - Non-nil optional arg PREDICATE is a file-name predicate. List only - the files for which it returns non-nil. - Non-nil optional arg DETAILS is passed to `diredp-list-files'." - (interactive ; No need for `diredp-get-confirmation-recursive' here. - (progn (diredp-ensure-mode) (list current-prefix-arg nil diredp-list-file-attributes))) - (let ((files (diredp-get-files ignore-marks-p predicate))) (diredp-list-files files nil nil nil details))) - -;;;###autoload -(defun diredp-flag-auto-save-files-recursive (&optional arg details) ; `M-+ #' - "Flag all auto-save files for deletion, including in marked subdirs. -A non-negative prefix arg means to unmark (unflag) them instead. - -A non-positive prefix arg means to ignore subdir markings and act -instead on ALL subdirs. That is, flag all in this directory and all -descendant directories. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-mark-recursive-1'." - (interactive (list current-prefix-arg diredp-list-file-attributes)) - (let ((dired-marker-char dired-del-marker)) - (diredp-mark-recursive-1 arg "auto-save files" "auto-save file" '(diredp-looking-at-p "^.* #.+#$") details))) - -(when (fboundp 'char-displayable-p) ; Emacs 22+ - - (defun diredp-change-marks-recursive (old new &optional arg predicate details) ; `M-+ * c' - "Change all OLD marks to NEW marks, including those in marked subdirs. -The files included are those that are marked in the current Dired -buffer, or all files in the directory if none are marked. Marked -subdirectories are handled recursively in the same way. - -* A non-positive prefix arg means ignore subdir markings and act - instead on ALL subdirs. - -* A non-negative prefix arg means do not change marks on subdirs - themselves. - -Note: If there is more than one Dired buffer for a given subdirectory -then only the first such is used. - -When called from Lisp: - Non-nil arg PREDICATE is a file-name predicate. Act on only the - files for which it returns non-nil. - DETAILS is passed to `diredp-get-subdirs'." - (interactive - (progn (diredp-get-confirmation-recursive) - (let* ((cursor-in-echo-area t) - (old (progn (message "Change (old mark): ") (read-char))) - (new (progn (message "Change `%c' marks to (new mark): " old) (read-char)))) - (list old new current-prefix-arg nil diredp-list-file-attributes)))) - (let* ((numarg (and arg (prefix-numeric-value arg))) - (nosubs (natnump numarg)) - (ignore-marks (and numarg (<= numarg 0))) - (dired-marker-char new) - (sdirs (diredp-get-subdirs ignore-marks predicate details)) - (old-strg (format "\n%c" old)) - (count 0) - dbufs) - (unless (char-displayable-p old) (error "Not a displayable character: `%c'" old)) - (unless (char-displayable-p new) (error "Not a displayable character: `%c'" new)) - (message "Changing mark `%c' to `%c'..." old new) - (dolist (dir (cons default-directory sdirs)) - (when (setq dbufs (dired-buffers-for-dir (expand-file-name dir))) ; Dirs with Dired buffers only. - (with-current-buffer (car dbufs) - (let ((inhibit-read-only t) - (file nil)) - (save-excursion - (goto-char (point-min)) - (while (search-forward old-strg nil t) - (save-match-data (setq file (dired-get-filename 'no-dir t))) - ;; Do nothing if changing from UNmarked and not on a file or dir name. - (unless (and (= old ? ) (not file)) - ;; Do nothing if marked subdir and not changing subdir marks. - (unless (and nosubs file (file-directory-p file)) - (subst-char-in-region (match-beginning 0) (match-end 0) old new) - (setq count (1+ count)))))))))) - (message "%d mark%s changed from `%c' to `%c'" count (dired-plural-s count) old new))) - - (defun diredp-unmark-all-marks-recursive (&optional arg details) ; `M-+ U' - "Remove ALL marks everywhere, including in marked subdirs. -A prefix arg is as for `diredp-unmark-all-files-recursive'. -Note that a negative prefix arg (e.g. `C--') removes all marks from -this Dired buffer and then does the same recursively for each of its -subdirs. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-unmark-all-files-recursive'." - (interactive (progn (diredp-get-confirmation-recursive) - (list current-prefix-arg diredp-list-file-attributes))) - (diredp-unmark-all-files-recursive ?\r arg details)) - - (defun diredp-unmark-all-files-recursive (mark &optional arg predicate details) ; `M-+ M-DEL' - "Remove a given mark (or ALL) everywhere, including in marked subdirs. -You are prompted for the mark character to remove. If you hit `RET' -instead then ALL mark characters are removed. - -The files included are those that are marked in the current Dired -buffer, or all files in the directory if none are marked. Marked -subdirectories are handled recursively in the same way. - -* A non-positive prefix arg means ignore subdir markings and act - instead on ALL subdirs. - -* A non-negative prefix arg means do not change marks on subdirs - themselves. - -Note: If there is more than one Dired buffer for a given subdirectory -then only the first such is used. - -When called from Lisp: - Non-nil arg PREDICATE is a file-name predicate. Act on only the - files for which it returns non-nil. - DETAILS is passed to `diredp-get-subdirs'." - (interactive - (progn (diredp-get-confirmation-recursive) - (let* ((cursor-in-echo-area t) - (mrk (progn (message "Remove marks (RET means all): ") (read-char)))) - (list mrk current-prefix-arg nil diredp-list-file-attributes)))) - (let* ((numarg (and arg (prefix-numeric-value arg))) - (nosubs (natnump numarg)) - (ignore-marks (and numarg (<= numarg 0))) - (dired-marker-char ?\ ) ; Unmark - (sdirs (diredp-get-subdirs ignore-marks predicate details)) - (mrk-strg (format "\n%c" mark)) - (count 0) - dbufs) - (unless (char-displayable-p mark) (error "Not a displayable character: `%c'" mark)) - (if (eq mark ?\r) - (message "Unmarking ALL marks here and below...") - (message "Unmarking mark `%c' here and below..." mark)) - (dolist (dir (cons default-directory sdirs)) - (when (setq dbufs (dired-buffers-for-dir (expand-file-name dir))) ; Dirs with Dired buffers only. - (with-current-buffer (car dbufs) - (let ((inhibit-read-only t) - (file nil)) - (save-excursion - (goto-char (point-min)) - (while (if (eq mark ?\r) - (re-search-forward dired-re-mark nil t) - (search-forward mrk-strg nil t)) - (save-match-data (setq file (dired-get-filename 'no-dir t))) - ;; Do nothing if marked subdir and not changing subdir marks. - (unless (and nosubs file (file-directory-p file)) - (subst-char-in-region (match-beginning 0) (match-end 0) (preceding-char) ?\ )) - (setq count (1+ count)))))))) - (message "%d mark%s UNmarked" count (dired-plural-s count)))) - - ) - -(when (and (memq system-type '(windows-nt ms-dos)) (fboundp 'w32-browser)) - - (defun diredp-multiple-w32-browser-recursive (&optional ignore-marks-p details) - "Run Windows apps for with marked files, including those in marked subdirs. -Like `dired-multiple-w32-browser', but act recursively on subdirs. - -See `diredp-do-find-marked-files-recursive' for a description of the -files included. In particular, if no files are marked here or in a -marked subdir, then all files in the directory are included. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-get-files'." - (interactive (progn (diredp-get-confirmation-recursive) - (list current-prefix-arg diredp-list-file-attributes))) - (let ((files (diredp-get-files ignore-marks-p nil nil nil nil details))) - (while files - (w32-browser (car files)) - (sleep-for w32-browser-wait-time) - (setq files (cdr files))))) - - ) - -;;;###autoload -(defun diredp-copy-filename-as-kill-recursive (&optional arg details) ; Bound to `M-+ M-w' - "Copy names of marked files here and in marked subdirs, to `kill-ring'. -The names are separated by a space. - -Like `dired-copy-filename-as-kill', but act recursively on subdirs. -\(Do not copy subdir names themselves.) - -With no prefix arg, use relative file names. -With a zero prefix arg, use absolute file names. -With a plain prefix arg (`C-u'), use names relative to the current -Dired directory. (This might contain slashes if in a subdirectory.) - -If on a subdir headerline, use absolute subdir name instead - prefix -arg and marked files are ignored in this case. - -The files included are those that are marked in the current Dired -buffer, or all files in the directory if none are marked. Marked -subdirectories are handled recursively in the same way. - -The names are copied to the kill ring and to variable -`diredp-last-copied-filenames'. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-get-files'." - (interactive ; No need for `diredp-get-confirmation-recursive' here. - (progn (diredp-ensure-mode) (list current-prefix-arg diredp-list-file-attributes))) - (let* ((files (mapcar (cond ((zerop (prefix-numeric-value arg)) #'identity) - ((consp arg) (lambda (fn) (concat (dired-current-directory t) - (file-name-nondirectory fn)))) - (t (lambda (fn) (file-name-nondirectory fn)))) - (diredp-get-files nil nil nil nil nil details))) - (string (mapconcat #'identity files " "))) - (unless (string= "" string) - (if (eq last-command 'kill-region) (kill-append string nil) (kill-new string)) - (setq diredp-last-copied-filenames (car kill-ring-yank-pointer))) - (message "%s" string))) - -;;;###autoload -(defun diredp-copy-abs-filenames-as-kill-recursive (&optional ignore-marks-p details) ; Not bound. - "Copy absolute names of files marked here and in marked subdirs, recursively. -The names are copied to the kill ring and to variable -`dired-copy-filename-as-kill'. - -The files whose names are copied are those that are marked in the -current Dired buffer, or all files in the directory if none are -marked. Marked subdirectories are handled recursively in the same -way. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-copy-filename-as-kill-recursive'." - (interactive ; No need for `diredp-get-confirmation-recursive' here. - (progn (diredp-ensure-mode) (list current-prefix-arg diredp-list-file-attributes))) - (diredp-copy-filename-as-kill-recursive 0 details) - (setq diredp-last-copied-filenames (car kill-ring-yank-pointer))) - -;;;###autoload -(defun diredp-mark-files-regexp-recursive (regexp - &optional marker-char ignore-marks-p details) ; Bound to `M-+ % m' - "Mark all files matching REGEXP, including those in marked subdirs. -Like `dired-mark-files-regexp' but act recursively on marked subdirs. - -The file names to be matched by this command are always absolute - -they include the full directory. Note that this does NOT correspond -to the default behavior for `dired-mark-files-regexp'. The other -matching possibilities offered by `dired-mark-files-regexp' are not -available for this command. - -Directories `.' and `..' are never marked. - -A non-negative prefix arg means to UNmark the files instead. - -A non-positive prefix arg means to ignore subdir markings and act -instead on ALL subdirs. That is, mark all matching files in this -directory and all descendant directories. - -REGEXP is an Emacs regexp, not a shell wildcard. Thus, use `\\.o$' for -object files--just `.o' will mark more than you might think. - -REGEXP is added to `regexp-search-ring', for regexp search. - -Note: If there is more than one Dired buffer for a given subdirectory -then only the first such is used. - -When called from Lisp, DETAILS is passed to `diredp-get-subdirs'." - (interactive (let* ((numarg (and current-prefix-arg (prefix-numeric-value current-prefix-arg))) - (unmark (and numarg (>= numarg 0))) - (ignorep (and numarg (<= numarg 0)))) - (list (diredp-read-regexp (concat (if unmark "UNmark" "Mark") " files (regexp): ")) - (and unmark ?\040) - ignorep - diredp-list-file-attributes))) - (add-to-list 'regexp-search-ring regexp) ; Add REGEXP to `regexp-search-ring'. - (let ((dired-marker-char (or marker-char dired-marker-char)) - (sdirs (diredp-get-subdirs ignore-marks-p nil details)) - (matched 0) - (changed 0) - dbufs chg.mtch) - (message "%s files..." (if (eq ?\040 dired-marker-char) "UNmarking" "Marking")) - (dolist (dir (cons default-directory sdirs)) - (when (setq dbufs (dired-buffers-for-dir (expand-file-name dir))) ; Dirs with Dired buffers only. - (with-current-buffer (car dbufs) - (setq chg.mtch (diredp-mark-if (and (not (diredp-looking-at-p dired-re-dot)) - (not (eolp)) ; Empty line - (let ((fn (dired-get-filename nil 'NO-ERROR))) - (and fn (diredp-string-match-p regexp fn)))) - "file") - changed (+ changed (or (car chg.mtch) 0)) - matched (+ matched (or (cdr chg.mtch) 0)))))) - (message "%s file%s%s%s newly %s" - matched - (dired-plural-s matched) - (if (not (= matched changed)) " matched, " "") - (if (not (= matched changed)) changed "") - (if (eq ?\040 dired-marker-char) "unmarked" "marked")))) - -;;;###autoload -(defun diredp-mark-files-containing-regexp-recursive (regexp - &optional marker-char ignore-marks-p details) ; `M-+ % g' - "Mark files with contents containing a REGEXP match, including in marked subdirs. -Like `dired-mark-files-containing-regexp' but act recursively on -marked subdirs. - -A non-negative prefix arg means to UNmark the files instead. - -A non-positive prefix arg means to ignore subdir markings and act -instead on ALL subdirs. That is, mark all matching files in this -directory and all descendant directories. - -REGEXP is added to `regexp-search-ring', for regexp search. - -Note: If there is more than one Dired buffer for a given subdirectory -then only the first such is used. - -If a file is visited in a buffer and `dired-always-read-filesystem' is -nil, this looks in the buffer without revisiting the file, so the -results might be inconsistent with the file on disk if its contents -have changed since it was last visited. - -When called from Lisp, DETAILS is passed to `diredp-get-subdirs'." - - (interactive (let* ((numarg (and current-prefix-arg (prefix-numeric-value current-prefix-arg))) - (unmark (and numarg (>= numarg 0))) - (ignorep (and numarg (<= numarg 0)))) - (list (diredp-read-regexp (concat (if unmark "UNmark" "Mark") " files containing (regexp): ")) - (and unmark ?\040) - ignorep - diredp-list-file-attributes))) - (add-to-list 'regexp-search-ring regexp) ; Add REGEXP to `regexp-search-ring'. - (let ((dired-marker-char (or marker-char dired-marker-char)) - (sdirs (diredp-get-subdirs ignore-marks-p nil details)) - (matched 0) - (changed 0) - dbufs chg.mtch) - (message "%s files..." (if (eq ?\040 dired-marker-char) "UNmarking" "Marking")) - (dolist (dir (cons default-directory sdirs)) - (when (setq dbufs (dired-buffers-for-dir (expand-file-name dir))) ; Dirs with Dired buffers only. - (with-current-buffer (car dbufs) - (setq chg.mtch - (diredp-mark-if - (and (not (diredp-looking-at-p dired-re-dot)) - (not (eolp)) - (let ((fname (dired-get-filename nil t))) - - (and fname - (file-readable-p fname) - (not (file-directory-p fname)) - (let ((prebuf (get-file-buffer fname))) - (message "Checking %s" fname) - ;; For now, do it inside Emacs. Grep might be better if there are lots of files. - (if (and prebuf (or (not (boundp 'dired-always-read-filesystem)) - (not dired-always-read-filesystem))) ; Emacs 26+ - (with-current-buffer prebuf - (save-excursion (goto-char (point-min)) (re-search-forward regexp nil t))) - (with-temp-buffer - (insert-file-contents fname) - (goto-char (point-min)) - (re-search-forward regexp nil t))))))) - "file") - changed (+ changed (or (car chg.mtch) 0)) - matched (+ matched (or (cdr chg.mtch) 0)))))) - (message "%s file%s%s%s newly %s" - matched - (dired-plural-s matched) - (if (not (= matched changed)) " matched, " "") - (if (not (= matched changed)) changed "") - (if (eq ?\040 dired-marker-char) "unmarked" "marked")))) - -(defun diredp-mark-extension-recursive (extension &optional arg details) ; Bound to `M-+ * .' - "Mark all files with a certain EXTENSION, including in marked subdirs. -A `.' is not automatically prepended to the string entered. - -This is like `diredp-mark/unmark-extension', but this acts recursively -on marked subdirs, and a non-positive prefix arg acts differently. - -A non-negative prefix arg means to unmark them instead. - -A non-positive prefix arg means to ignore subdir markings and act -instead on ALL subdirs. That is, mark all in this directory and all -descendant directories. - -Non-interactively, EXTENSION is the extension (a string). It can also -be a list of extension strings. -Optional argument ARG is the prefix arg. - -When called from Lisp, DETAILS is passed to `diredp-mark-files-regexp-recursive'." - (interactive (let* ((numarg (and current-prefix-arg (prefix-numeric-value current-prefix-arg))) - (unmark (and numarg (>= numarg 0)))) - (list (diredp-read-regexp (concat (if unmark "UNmark" "Mark") " extension: ")) - current-prefix-arg - diredp-list-file-attributes))) - (let* ((numarg (and arg (prefix-numeric-value arg))) - (unmark (and numarg (>= numarg 0))) - (ignorep (and numarg (<= numarg 0)))) - (or (listp extension) (setq extension (list extension))) - (diredp-mark-files-regexp-recursive (concat ".+[.]\\(" - (mapconcat #'regexp-quote extension "\\|") - "\\)$") - (if unmark ?\040 dired-marker-char) - ignorep - details))) - -;; FIXME: Factor out code that is common with `dired-mark-sexp'. -;; -(when (fboundp 'minibuffer-with-setup-hook) ; Emacs 22+ - - (defun diredp-mark-sexp-recursive (predicate &optional arg details) ; Bound to `M-+ M-(', `M-+ * (' - "Mark files here and below for which PREDICATE returns non-nil. -Like `diredp-mark-sexp', but act recursively on subdirs. - -A non-negative prefix arg means to unmark those files instead. - -A non-positive prefix arg means to ignore subdir markings and act -instead on ALL subdirs. That is, mark all in this directory and all -descendant directories. - -PREDICATE is a lisp sexp that can refer to the following symbols as -variables: - - `mode' [string] file permission bits, e.g. \"-rw-r--r--\" - `nlink' [integer] number of links to file - `size' [integer] file size in bytes - `uid' [string] owner - `gid' [string] group (If the gid is not displayed by `ls', - this will still be set (to the same as uid)) - `time' [string] the time that `ls' displays, e.g. \"Feb 12 14:17\" - `name' [string] the name of the file - `sym' [string] if file is a symbolic link, the linked-to name, - else \"\" - `inode' [integer] the inode of the file (only for `ls -i' output) - `blks' [integer] the size of the file for `ls -s' output - (ususally in blocks or, with `-k', in Kbytes) -Examples: - Mark zero-length files: `(equal 0 size)' - Mark files last modified on Feb 2: `(string-match \"Feb 2\" time)' - Mark uncompiled Emacs Lisp files (`.el' file without a `.elc' file): - First, Dired just the source files: `dired *.el'. - Then, use \\[diredp-mark-sexp-recursive] with this sexp: - (not (file-exists-p (concat name \"c\"))) - -There's an ambiguity when a single integer not followed by a unit -prefix precedes the file mode: It is then parsed as inode number -and not as block size (this always works for GNU coreutils ls). - -Another limitation is that the uid field is needed for the -function to work correctly. In particular, the field is not -present for some values of `ls-lisp-emulation'. - -This function operates only on the Dired buffer content. It does not -refer at all to the underlying file system. Contrast this with -`find-dired', which might be preferable for the task at hand. - -When called from Lisp, DETAILS is passed to `diredp-get-subdirs'." - ;; Using `sym' = "", instead of nil, for non-linked files avoids the trap of - ;; (string-match "foo" sym) into which a user would soon fall. - ;; Use `equal' instead of `=' in the example, as it works on integers and strings. - ;; (interactive "xMark if (vars: inode,blks,mode,nlink,uid,gid,size,time,name,sym): \nP") - - (interactive - (let* ((numarg (and current-prefix-arg (prefix-numeric-value current-prefix-arg))) - (unmark (and numarg (>= numarg 0)))) - (diredp-get-confirmation-recursive) - (list (diredp-read-expression (format "%s if (Lisp expr): " (if current-prefix-arg "UNmark" "Mark"))) - current-prefix-arg - diredp-list-file-attributes))) - (message "%s" predicate) - (let* ((numarg (and arg (prefix-numeric-value arg))) - (unmark (and numarg (>= numarg 0))) - (ignorep (and numarg (<= numarg 0))) - (dired-marker-char (if unmark ?\040 dired-marker-char)) - (inode nil) - (blks ()) - (matched 0) - (changed 0) - dbufs chg.mtch mode nlink uid gid size time name sym) - (dolist (dir (cons default-directory (diredp-get-subdirs ignorep nil details))) - (when (setq dbufs (dired-buffers-for-dir (expand-file-name dir))) ; Dirs with Dired buffers only. - (with-current-buffer (car dbufs) - (setq chg.mtch - (diredp-mark-if - (save-excursion - (and - ;; Sets vars INODE BLKS MODE NLINK UID GID SIZE TIME NAME and SYM - ;; according to current file line. Returns `t' for success, nil if - ;; there is no file line. Upon success, these vars are set, to either - ;; nil or the appropriate value, so they need not be initialized. - ;; Moves point within the current line. - (dired-move-to-filename) - (let ((mode-len 10) ; Length of `mode' string. - ;; As in `dired.el', but with subexpressions \1=inode, \2=blks: - ;; GNU `ls -hs' suffixes the block count with a unit and prints it as a float - ;; FreeBSD does neither. - ;; $$$$$$ (dired-re-inode-size "\\s *\\([0-9]*\\)\\s *\\([0-9]*\\) ?") - (dired-re-inode-size (if (> emacs-major-version 24) - "\\=\\s *\\([0-9]+\\s +\\)?\ -\\(?:\\([0-9]+\\(?:\\.[0-9]*\\)?[BkKMGTPEZY]?\\)? ?\\)" - "\\s *\\([0-9]*\\)\\s *\\([0-9]*\\) ?")) - pos) - (beginning-of-line) - (forward-char 2) - (search-forward-regexp dired-re-inode-size nil t) - ;; `INODE', `BLKS', `MODE' - ;; XXX Might be a size not followed by a unit prefix. - ;; Could set `blks' to `inode' if it were otherwise nil, with similar reasoning - ;; as for setting `gid' to `uid', but it would be even more whimsical. - (setq inode (and (match-string 1) (string-to-number (match-string 1))) - blks (and (match-string 2) (if (fboundp 'dired-x--string-to-number) ; Emacs 25+ - (dired-x--string-to-number (match-string 2)) - (string-to-number (match-string 2)))) - mode (buffer-substring (point) (+ mode-len (point)))) - (forward-char mode-len) - ;; Skip any extended attributes marker ("." or "+"). - (unless (eq (char-after) ?\ ) (forward-char 1)) - (setq nlink (read (current-buffer))) ; `NLINK' - - ;; `UID' - ;; Another issue is that GNU `ls -n' right-justifies numerical UIDs and GIDs, - ;; while FreeBSD left-justifies them, so do not rely on a specific whitespace - ;; layout. Both of them right-justify all other numbers, though. - ;; XXX Return a number if the `uid' or `gid' seems to be numerical? - ;; $$$$$$ (setq uid (buffer-substring (+ (point) 1) (progn (forward-word 1) (point)))) - (setq uid (buffer-substring (progn (skip-chars-forward " \t") (point)) - (progn (skip-chars-forward "^ \t") (point)))) - (cond ((> emacs-major-version 24) - (dired-move-to-filename) - (save-excursion - (setq time ; `TIME' - ;; The regexp below tries to match from the last digit of the size - ;; field through a space after the date. Also, dates may have - ;; different formats depending on file age, so the date column need - ;; not be aligned to the right. - (buffer-substring - (save-excursion (skip-chars-backward " \t") (point)) - (progn (re-search-backward directory-listing-before-filename-regexp) - (skip-chars-forward "^ \t") - (1+ (point)))) - - size ; `SIZE' - (dired-x--string-to-number - ;; We know that there's some kind of number before point because - ;; the regexp search above succeeded. Not worth doing an extra - ;; check for leading garbage. - (buffer-substring (point) (progn (skip-chars-backward "^ \t") (point)))) - ;; If no `gid' is displayed, `gid' will be set to `uid' but user - ;; will then not reference it anyway in PREDICATE. - - gid ; `GID' - (buffer-substring (progn (skip-chars-backward " \t") (point)) - (progn (skip-chars-backward "^ \t") (point))))) - ;; `NAME', `SYM' - (setq name (buffer-substring (point) - (or (dired-move-to-end-of-filename t) (point))) - sym (if (diredp-looking-at-p " -> ") - (buffer-substring (progn (forward-char 4) (point)) - (line-end-position)) - ""))) - (t - (re-search-forward - (if (< emacs-major-version 20) - "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)" - dired-move-to-filename-regexp)) - (goto-char (match-beginning 1)) - (forward-char -1) - (setq size ; `SIZE' - (string-to-number (buffer-substring (save-excursion (backward-word 1) - (setq pos (point))) - (point)))) - (goto-char pos) - (backward-word 1) - ;; `GID', `TIME', `NAME', `SYM' - ;; if no `gid' is displayed, `gid' will be set to `uid' but user will then - ;; not reference it anyway in PREDICATE. - (setq gid (buffer-substring (save-excursion (forward-word 1) (point)) (point)) - time (buffer-substring (match-beginning 1) (1- (dired-move-to-filename))) - name (buffer-substring (point) (or (dired-move-to-end-of-filename t) - (point))) - sym (if (diredp-looking-at-p " -> ") - (buffer-substring (progn (forward-char 4) (point)) - (line-end-position)) - ""))))) - ;; Vanilla Emacs uses `lexical-binding' = t, and it passes bindings to `eval' - ;; as a second arg. We use `lexical-binding' = nil, and anyway there should - ;; be no need to pass the bindings. - (eval predicate))) - (format "'%s file" predicate))) - (setq changed (+ changed (or (car chg.mtch) 0)) - matched (+ matched (or (cdr chg.mtch) 0)))))) - (message "%s file%s%s%s newly %s" matched (dired-plural-s matched) - (if (not (= matched changed)) " matched, " "") - (if (not (= matched changed)) changed "") - (if (eq ?\040 dired-marker-char) "unmarked" "marked")))) - - (if (fboundp 'read--expression) ; Emacs 24.4+ - (defalias 'diredp-read-expression 'read--expression) - (defun diredp-read-expression (prompt &optional initial-contents) - (let ((minibuffer-completing-symbol t)) - (minibuffer-with-setup-hook - (lambda () ; Vanilla Emacs FIXME: call `emacs-lisp-mode'? - (add-function :before-until (local 'eldoc-documentation-function) - #'elisp-eldoc-documentation-function) - (eldoc-mode 1) - (add-hook 'completion-at-point-functions #'elisp-completion-at-point nil t) - (run-hooks 'eval-expression-minibuffer-setup-hook)) - (read-from-minibuffer - prompt initial-contents (if (boundp 'pp-read-expression-map) - pp-read-expression-map - read-expression-map) - t 'read-expression-history))))) - - ) - -;;;###autoload -(defun diredp-mark-autofiles-recursive (&optional arg details) ; Bound to `M-+ * B' - "Mark all autofiles, including in marked subdirs. -Autofiles are files that have an autofile bookmark. -A non-negative prefix arg means to unmark them instead. - -A non-positive prefix arg means to ignore subdir markings and act -instead on ALL subdirs. That is, mark all in this directory and all -descendant directories. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-mark-recursive-1'." - (interactive (list current-prefix-arg diredp-list-file-attributes)) - (diredp-ensure-bookmark+) - (diredp-ensure-mode) - (diredp-mark-recursive-1 arg "autofiles" "autofile" - '(and (not (diredp-looking-at-p dired-re-dot)) (not (eolp)) - (let ((fname (dired-get-filename nil t))) - (and fname (bmkp-get-autofile-bookmark fname)))) - details)) - -;;;###autoload -(defun diredp-mark-executables-recursive (&optional arg details) ; Bound to `M-+ * *' - "Mark all executable files, including in marked subdirs. -The files included are those that are marked in the current Dired -buffer, or all files in the directory if none are marked. Marked -subdirectories are handled recursively in the same way. - -A non-negative prefix arg means to unmark them instead. - -A non-positive prefix arg means to ignore subdir markings and act -instead on ALL subdirs. That is, mark all in this directory and all -descendant directories. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-mark-recursive-1'." - (interactive (list current-prefix-arg diredp-list-file-attributes)) - (diredp-mark-recursive-1 arg "executable files" "executable file" '(diredp-looking-at-p dired-re-exe) details)) - -;;;###autoload -(defun diredp-mark-directories-recursive (&optional arg details) ; Bound to `M-+ * /' - "Mark all directories except `.' and `..', including in marked subdirs. -The directories included are those that are marked in the current -Dired buffer, or all subdirs in the directory if none are marked. -Marked subdirectories are handled recursively in the same way. - -A non-negative prefix arg means to unmark them instead. - -A non-positive prefix arg means to ignore subdir markings and act -instead on ALL subdirs. That is, mark all in this directory and all -descendant directories. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-mark-recursive-1'." - (interactive (list current-prefix-arg diredp-list-file-attributes)) - (diredp-mark-recursive-1 arg "directories" "directory" '(and (diredp-looking-at-p dired-re-dir) - (not (diredp-looking-at-p dired-re-dot))) - details)) -;;;###autoload -(defun diredp-mark-symlinks-recursive (&optional arg details) ; Bound to `M-+ * @' - "Mark all symbolic links, including in marked subdirs. -The symlinks included are those that are marked in the current Dired -buffer, or all symlinks in the directory if none are marked. Marked -subdirectories are handled recursively in the same way. - -A non-negative prefix arg means to unmark them instead. - -A non-positive prefix arg means to ignore subdir markings and act -instead on ALL subdirs. That is, mark all in this directory and all -descendant directories. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-get-subdirs'." - (interactive (list current-prefix-arg diredp-list-file-attributes)) - (diredp-mark-recursive-1 arg "symlinks" "symbolic link" '(diredp-looking-at-p dired-re-sym) details)) - -(defun diredp-mark-recursive-1 (arg plural singular predicate-sexp details) - "Helper for `diredp-mark-*-recursive' commands." - (let* ((numarg (and arg (prefix-numeric-value arg))) - (unmark (and numarg (>= numarg 0))) - (ignorep (and numarg (<= numarg 0))) - (dired-marker-char (if unmark ?\040 dired-marker-char)) - (sdirs (diredp-get-subdirs ignorep nil details)) - (changed 0) - (matched 0) - dbufs chg.mtch) - (message "%s %s..." (if (eq ?\040 dired-marker-char) "UNmarking" "Marking") plural) - (dolist (dir (cons default-directory sdirs)) - (when (setq dbufs (dired-buffers-for-dir (expand-file-name dir))) ; Dirs with Dired buffers only. - (with-current-buffer (car dbufs) - (setq chg.mtch (diredp-mark-if (eval predicate-sexp) singular) - changed (+ changed (or (car chg.mtch) 0)) - matched (+ matched (or (cdr chg.mtch) 0)))))) - (message "%s %s%s%s newly %s" - matched - (if (= 1 matched) singular plural) - (if (not (= matched changed)) " matched, " "") - (if (not (= matched changed)) changed "") - (if (eq ?\040 dired-marker-char) "unmarked" "marked")))) - -;;;###autoload -(defun diredp-capitalize-recursive (&optional ignore-marks-p details) ; Bound to `M-+ % c' - "Rename marked files, including in marked subdirs, by capitalizing them. -Like `diredp-capitalize', but act recursively on subdirs. - -The files included are those that are marked in the current Dired -buffer, or all files in the directory if none are marked. Marked -subdirectories are handled recursively in the same way. - -With a prefix argument, ignore all marks - include all files in this -Dired buffer and all subdirs, recursively. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-create-files-non-directory-recursive'." - (interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg diredp-list-file-attributes))) - (diredp-create-files-non-directory-recursive - #'dired-rename-file #'capitalize "Rename by capitalizing:" ignore-marks-p details)) - -;;;###autoload -(defun diredp-upcase-recursive (&optional ignore-marks-p details) ; Bound to `M-+ % u' - "Rename marked files, including in marked subdirs, making them uppercase. -Like `dired-upcase', but act recursively on subdirs. - -The files included are those that are marked in the current Dired -buffer, or all files in the directory if none are marked. Marked -subdirectories are handled recursively in the same way. - -With a prefix argument, ignore all marks - include all files in this -Dired buffer and all subdirs, recursively. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-create-files-non-directory-recursive'." - (interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg diredp-list-file-attributes))) - (diredp-create-files-non-directory-recursive - #'dired-rename-file #'upcase "Rename to uppercase:" ignore-marks-p details)) - -;;;###autoload -(defun diredp-downcase-recursive (&optional ignore-marks-p details) ; Bound to `M-+ % l' - "Rename marked files, including in marked subdirs, making them lowercase. -Like `dired-downcase', but act recursively on subdirs. - -The files included are those that are marked in the current Dired -buffer, or all files in the directory if none are marked. Marked -subdirectories are handled recursively in the same way. - -With a prefix argument, ignore all marks - include all files in this -Dired buffer and all subdirs, recursively. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-create-files-non-directory-recursive'." - (interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg diredp-list-file-attributes))) - (diredp-create-files-non-directory-recursive - #'dired-rename-file #'downcase "Rename to lowercase:" ignore-marks-p details)) - -;;;###autoload -(defun diredp-do-apply-function-recursive (function &optional arg details) ; Bound to `M-+ @' - "Apply FUNCTION to the marked files. -Like `diredp-do-apply-function' but act recursively on subdirs and do -no result or error logging or echoing. - -The files acted on are those that are marked in the current Dired -buffer, or all files in the directory if none are marked. Marked -subdirectories are handled recursively in the same way. - -With a plain prefix ARG (`C-u'), visit each file and invoke FUNCTION - with no arguments. -Otherwise, apply FUNCTION to each file name. - -Any other prefix arg behaves according to the ARG argument of -`dired-get-marked-files'. In particular, `C-u C-u' operates on all -files in the Dired buffer. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-get-files'." - (interactive (progn (diredp-get-confirmation-recursive) - (list (read (completing-read "Function: " obarray 'functionp nil nil - (and (boundp 'function-name-history) 'function-name-history))) - current-prefix-arg - diredp-list-file-attributes))) - (if (and (consp arg) (< (car arg) 16)) - (dolist (file (diredp-get-files)) (with-current-buffer (find-file-noselect file) (funcall function))) - (dolist (file (diredp-get-files arg nil nil nil nil details)) (funcall function file)))) - -;;;###autoload -(defun diredp-do-delete-recursive (arg &optional details) ; Bound to `M-+ D' - "Delete marked (not flagged) files, including in marked subdirs. -Like `dired-do-delete' but act recursively on subdirs. - -The files to be deleted are those that are marked in the current Dired -buffer, or all files in the directory if none are marked. Marked -subdirectories are handled recursively in the same way. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-get-files' and `diredp-get-subdirs'." - (interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg diredp-list-file-attributes))) - (unless arg - (ding) - (message "NOTE: Deletion of files marked `%c' (not those flagged `%c')." - dired-marker-char dired-del-marker)) - (let* ((files (diredp-get-files nil nil nil nil 'ONLY-MARKED-P details)) - (count (length files)) - (trashing (and (boundp 'delete-by-moving-to-trash) delete-by-moving-to-trash)) - (succ 0)) - (if (dired-mark-pop-up - " *Deletions*" 'delete files dired-deletion-confirmer - (format "%s %s " (if trashing "Trash" "Delete") (dired-mark-prompt arg files))) - (let ((progress-reporter (and (fboundp 'make-progress-reporter) - (make-progress-reporter (if trashing "Trashing..." "Deleting...") - succ - count))) - (failures ())) - (unless progress-reporter (message "Deleting...")) - (dolist (file files) - (condition-case err - (progn (if (fboundp 'dired-delete-file) ; Emacs 22+ - (dired-delete-file file dired-recursive-deletes trashing) - ;; This test is equivalent to (and (file-directory-p file) (not (file-symlink-p file))) - ;; but more efficient. - (if (eq t (car (file-attributes file))) (delete-directory file) (delete-file file))) - (setq succ (1+ succ)) - (when (fboundp 'progress-reporter-update) - (progress-reporter-update progress-reporter succ))) - (error (dired-log "%s\n" err) ; Catch errors from failed deletions. - (setq failures (cons file failures)))) - (dired-clean-up-after-deletion file)) - (if failures - (dired-log-summary (format "%d of %d deletion%s failed" - (length failures) count (dired-plural-s count)) - failures) - (if (fboundp 'progress-reporter-done) - (progress-reporter-done progress-reporter) - (message "Deleting...done"))) - (let ((sdirs (diredp-get-subdirs nil nil details)) - dbufs) - (dolist (dir (cons default-directory sdirs)) - (when (setq dbufs (dired-buffers-for-dir (expand-file-name dir))) ; Dirs with Dired buffers only. - (with-current-buffer (car dbufs) (dired-revert)))))) - (message "OK. NO deletions performed")))) - -;;;###autoload -(defun diredp-do-move-recursive (&optional ignore-marks-p details) ; Bound to `M-+ R' - "Move marked files, including in marked subdirs, to a given directory. -Like `dired-do-rename', but act recursively on subdirs to pick up the -files to move. - -The files included are those that are marked in the current Dired -buffer, or all files in the directory if none are marked. Marked -subdirectories are handled recursively in the same way. - -This means move the marked files of marked subdirs and their marked -subdirs, etc. It does not mean move or rename the subdirs themselves -recursively. - -With a prefix argument, ignore all marks - include all files in this -Dired buffer and all subdirs, recursively. - -Renames any buffers that are visiting the files. - -The default suggested for the target directory depends on the value of -`dired-dwim-target', which see." - (interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg diredp-list-file-attributes))) - (diredp-do-create-files-recursive #'dired-rename-file "Move" ignore-marks-p details)) - -;;;###autoload -(defun diredp-do-copy-recursive (&optional ignore-marks-p details) ; Bound to `M-+ C' - "Copy marked files, including in marked subdirs, to a given directory. -Like `dired-do-copy', but act recursively on subdirs to pick up the -files to copy. - -The files included are those that are marked in the current Dired -buffer, or all files in the directory if none are marked. Marked -subdirectories are handled recursively in the same way. - -This means copy the marked files of marked subdirs and their marked -subdirs, etc. It does not mean copy the subdirs themselves -recursively. - -With a prefix argument, ignore all marks - include all files in this -Dired buffer and all subdirs, recursively. - -Preserves the last-modified date when copying, unless -`dired-copy-preserve-time' is nil. - -The default suggested for the target directory depends on the value of -`dired-dwim-target', which see. - -This command copies symbolic links by creating new ones, like UNIX -command `cp -d'. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-do-create-files-recursive'." - (interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg diredp-list-file-attributes))) - (let ((dired-recursive-copies nil)) ; Doesn't have to be nil, but let's not go overboard now. - (diredp-do-create-files-recursive #'dired-copy-file "Copy" ignore-marks-p details))) - -(defun diredp-do-create-files-recursive (file-creator operation ignore-marks-p &optional details) - "Create a new file for each marked file, including those in marked subdirs. -Like `dired-do-create-files', but act recursively on subdirs, and -always keep markings. -Prompts for the target directory, in which to create the files. -FILE-CREATOR and OPERATION are as in `dired-create-files'. -Non-nil IGNORE-MARKS-P means ignore all marks - include all files in this -Dired buffer and all subdirs, recursively. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-get-files'." - (lexical-let* ((fn-list (diredp-get-files ignore-marks-p nil nil nil nil details)) - (target-dir (dired-dwim-target-directory)) - (defaults (and (fboundp 'dired-dwim-target-defaults) ; Emacs 23+ - (dired-dwim-target-defaults fn-list target-dir))) - (target (expand-file-name - (if (fboundp 'minibuffer-with-setup-hook) ; Emacs 22+ - (minibuffer-with-setup-hook - (lambda () - (set (make-local-variable 'minibuffer-default-add-function) - nil) - (setq minibuffer-default defaults)) - (funcall (if (fboundp 'read-directory-name) - #'read-directory-name - #'read-file-name) - (concat operation " files to: ") - default-directory default-directory)) - (funcall (if (fboundp 'read-directory-name) - #'read-directory-name - #'read-file-name) - (concat operation "files to: ") - default-directory default-directory))))) - (unless (file-directory-p target) (error "Target is not a directory: `%s'" target)) - (dired-create-files - file-creator operation fn-list - #'(lambda (from) (expand-file-name (file-name-nondirectory from) target)) - ;; Hard-code `*' marker, or else it will be removed in lower dirs because the code uses - ;; `dired-file-marker', which only works in the current Dired directory. - ?*))) - -(defun diredp-create-files-non-directory-recursive (file-creator basename-constructor operation - &optional ignore-marks-p details) - "Apply FILE-CREATOR + BASENAME-CONSTRUCTOR to non-dir part of marked names. -Like `dired-create-files-non-directory', but act recursively on subdirs. - -The files acted on are those marked in the current Dired buffer, or -all files in the directory if none are marked. Marked subdirectories -are handled recursively in the same way. - -With non-nil IGNORE-MARKS-P, ignore all marks - include all files in -this Dired buffer and all subdirs, recursively. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-get-files'." - (let (rename-non-directory-query) - (dired-create-files - file-creator - operation - (diredp-get-files ignore-marks-p nil nil nil nil details) - #'(lambda (from) - (let ((to (concat (file-name-directory from) - (funcall basename-constructor (file-name-nondirectory from))))) - (and (let ((help-form (format "\ -Type SPC or `y' to %s one file, DEL or `n' to skip to next, -`!' to %s all remaining matches with no more questions." - (downcase operation) - (downcase operation)))) - (dired-query 'rename-non-directory-query (concat operation " `%s' to `%s'") - (dired-make-relative from) (dired-make-relative to))) - to))) - ;; Hard-code `*' marker, or else it will be removed in lower dirs because the code uses - ;; `dired-file-marker', which only works in the current Dired directory. - ?*))) - -(defun diredp-do-chxxx-recursive (attribute-name program op-symbol &optional ignore-marks-p default details) - "Change attributes of the marked files, including those in marked subdirs. -Refresh their file lines. - -Like `dired-do-chxxx', but act recursively on subdirs. The subdirs -acted on are those that are marked in the current Dired buffer, or all -subdirs in the directory if none are marked. Marked subdirectories -are handled recursively in the same way. - -ATTRIBUTE-NAME is a string describing the attribute to the user. -PROGRAM is the program used to change the attribute. -OP-SYMBOL is the type of operation (for use in `dired-mark-pop-up'). -Non-nil IGNORE-MARKS-P means ignore all marks - include all files in this - Dired buffer and all subdirs, recursively. -DEFAULT is the default value for reading the mark string. -DETAILS is passed to `diredp-get-files' and - `diredp-do-redisplay-recursive'." - (let* ((this-buff (current-buffer)) - (files (diredp-get-files ignore-marks-p nil nil nil nil details)) - (prompt (concat "Change " attribute-name " of %s to: ")) - (new-attribute (if (> emacs-major-version 22) - (dired-mark-read-string prompt nil op-symbol ignore-marks-p files default) - (dired-mark-read-string prompt nil op-symbol ignore-marks-p files))) - (operation (concat program " " new-attribute)) - failures) - (setq failures (dired-bunch-files 10000 (function dired-check-process) - (append (list operation program) - (unless (string-equal new-attribute "") - (if (equal attribute-name "Timestamp") - (list "-t" new-attribute) - (list new-attribute))) - (and (diredp-string-match-p "gnu" system-configuration) - '("--"))) ; -------------------------------- - files)) - (with-current-buffer this-buff (diredp-do-redisplay-recursive details 'MSGP)) - (when failures (dired-log-summary (format "%s: error" operation) nil)))) - -;;;###autoload -(defun diredp-do-chmod-recursive (&optional ignore-marks-p details) ; Bound to `M-+ M' - "Change the mode of the marked files, including those in marked subdirs. -Symbolic modes like `g+w' are allowed. - -Note that marked subdirs are not changed. Their markings are used only -to indicate that some of their files are to be changed. - -With a prefix argument, ignore all marks - include all files in this -Dired buffer and all subdirs, recursively. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-get-files' and `diredp-do-redisplay-recursive'." - (interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg diredp-list-file-attributes))) - (let* ((files (diredp-get-files ignore-marks-p nil nil nil nil details)) - (modestr (and (stringp (car files)) (nth 8 (file-attributes (car files))))) - (default (and (stringp modestr) - (string-match "^.\\(...\\)\\(...\\)\\(...\\)$" modestr) - (replace-regexp-in-string "-" "" (format "u=%s,g=%s,o=%s" - (match-string 1 modestr) - (match-string 2 modestr) - (match-string 3 modestr))))) - (modes (if (> emacs-major-version 22) - (dired-mark-read-string - "Change mode of marked files here and below to: " nil 'chmod - nil files default) - (dired-mark-read-string - "Change mode of marked files here and below to: " nil 'chmod - nil files)))) - (when (equal modes "") (error "No file mode specified")) - (dolist (file files) - (set-file-modes file (or (and (diredp-string-match-p "^[0-7]+" modes) (string-to-number modes 8)) - (file-modes-symbolic-to-number modes (file-modes file))))) - (diredp-do-redisplay-recursive details 'MSGP))) - -(unless (memq system-type '(windows-nt ms-dos)) - (defun diredp-do-chgrp-recursive (&optional ignore-marks-p details) - "Change the group of the marked (or next ARG) files. -With a prefix argument, ignore all marks - include all files in this -Dired buffer and all subdirs, recursively. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-do-chxxx-recursive'." - (interactive (list current-prefix-arg diredp-list-file-attributes)) - (diredp-do-chxxx-recursive "Group" "chgrp" 'chgrp ignore-marks-p nil details))) - -(unless (memq system-type '(windows-nt ms-dos)) - (defun diredp-do-chown-recursive (&optional ignore-marks-p details) - "Change the owner of the marked (or next ARG) files. -With a prefix argument, ignore all marks - include all files in this -Dired buffer and all subdirs, recursively. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-do-chxxx-recursive'." - (interactive (list current-prefix-arg diredp-list-file-attributes)) - (diredp-do-chxxx-recursive "Owner" dired-chown-program 'chown ignore-marks-p nil details))) - -;;;###autoload -(defun diredp-do-touch-recursive (&optional ignore-marks-p details) - "Change the timestamp of marked files, including those in marked subdirs. -This calls `touch'. Like `dired-do-touch', but act recursively on -subdirs. The subdirs inserted are those that are marked in the -current Dired buffer, or all subdirs in the directory if none are -marked. Marked subdirectories are handled recursively in the same -way. - -With a prefix argument, ignore all marks - include all files in this -Dired buffer and all subdirs, recursively. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-do-chxxx-recursive'." - (interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg diredp-list-file-attributes))) - (diredp-do-chxxx-recursive "Timestamp" (if (boundp 'dired-touch-program) - dired-touch-program ; Emacs 22+ - "touch") - 'touch - ignore-marks-p - (format-time-string "%Y%m%d%H%M.%S" (current-time)) - details)) - -;;;###autoload -(defun diredp-do-redisplay-recursive (&optional details msgp) - "Redisplay marked file lines, including those in marked subdirs. -Non-nil MSGP means show status messages. -Like `dired-do-redisplay' with no args, but act recursively on -subdirs. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-get-files'." - (interactive (progn (diredp-ensure-mode) - (unless (y-or-n-p "Act on all marked file lines in and UNDER this dir? ") - (error "OK, canceled")) - (list diredp-list-file-attributes t))) - (when msgp (message "Redisplaying...")) - (dolist (dir (cons default-directory - (diredp-get-files nil #'file-directory-p 'INCLUDE-SUBDIRS 'DONT-ASK nil details))) - (with-current-buffer (dired-noselect dir) - ;; `message' is much faster than making `dired-map-over-marks' show progress - (dired-uncache (if (consp dired-directory) (car dired-directory) dired-directory)) - (dired-map-over-marks - (let ((fname (dired-get-filename)) - ;; Postpone readin hook till we map over all marked files (Bug#6810). - (dired-after-readin-hook nil)) - (message "Redisplaying... %s" fname) - (dired-update-file-line fname)) - nil) - (run-hooks 'dired-after-readin-hook) - (dired-move-to-filename))) - (when msgp (message "Redisplaying...done"))) - - -;;; `diredp-marked(-other-window)' tries to treat SWITCHES, but SWITCHES seems to be ignored -;;; by `dired' when the DIRNAME arg is a cons, at least on MS Windows. I filed Emacs bug #952 -;;; on 2008-09-10, but this doesn't work in Emacs 20, 21, 22, or 23, so I don't know if it will -;;; ever be fixed. If it is declared a non-bug and it doesn't work on any platforms, then I'll -;;; remove SWITCHES here, alas. - -;;;###autoload -(defun diredp-marked (dirname &optional n switches) ; Not bound - "Open Dired on only the marked files or the next N files. -With a non-zero numeric prefix arg N, use the next abs(N) files. -A plain (`C-u'), zero, or negative prefix arg prompts for listing -switches as in command `dired'. - -Note that the marked files can include files in inserted -subdirectories, so the Dired buffer that is opened can contain files -from multiple directories in the same tree." - (interactive (progn (diredp-ensure-mode) - (let ((num (and current-prefix-arg - (atom current-prefix-arg) - (not (zerop (prefix-numeric-value current-prefix-arg))) - (abs (prefix-numeric-value current-prefix-arg))))) - (list (cons (generate-new-buffer-name (buffer-name)) (dired-get-marked-files t num)) - num - (and current-prefix-arg ; Switches - (or (consp current-prefix-arg) - (< (prefix-numeric-value current-prefix-arg) 0)) - (read-string "Dired listing switches: " dired-listing-switches)))))) - (unless (or n (save-excursion (goto-char (point-min)) - (and (re-search-forward (dired-marker-regexp) nil t) - (re-search-forward (dired-marker-regexp) nil t)))) - (error "No marked files")) - (dired dirname switches)) - -;;;###autoload -(defun diredp-marked-other-window (dirname &optional n switches) ; Bound to `C-M-*' - "Same as `diredp-marked', but uses a different window." - (interactive (progn (diredp-ensure-mode) - (let ((num (and current-prefix-arg - (atom current-prefix-arg) - (not (zerop (prefix-numeric-value current-prefix-arg))) - (abs (prefix-numeric-value current-prefix-arg))))) - (list (cons (generate-new-buffer-name (buffer-name)) (dired-get-marked-files t num)) - num - (and current-prefix-arg ; Switches - (or (consp current-prefix-arg) - (< (prefix-numeric-value current-prefix-arg) 0)) - (read-string "Dired listing switches: " dired-listing-switches)))))) - (unless (or n (save-excursion (goto-char (point-min)) - (and (re-search-forward (dired-marker-regexp) nil t) - (re-search-forward (dired-marker-regexp) nil t)))) - (error "No marked files")) - (dired-other-window dirname switches)) - - -;; Similar to `dired-mark-extension' in `dired-x.el'. -;; The difference is that this uses prefix arg to unmark, not to determine the mark character. -;;;###autoload -(defun diredp-mark/unmark-extension (extension &optional unmark-p) ; Bound to `* .' - "Mark all files with a certain EXTENSION for use in later commands. -A `.' is not automatically prepended to the string entered. -Non-nil prefix argument UNMARK-P means unmark instead of mark. - -Non-interactively, EXTENSION is the extension (a string). It can also - be a list of extension strings. -Optional argument UNMARK-P is the prefix arg." - (interactive (list (diredp-read-regexp (concat (if current-prefix-arg "UNmark" "Mark") "ing extension: ")) - current-prefix-arg)) - (or (listp extension) (setq extension (list extension))) - (dired-mark-files-regexp (concat ".";; Do not match names with nothing but an extension - "\\(" - (mapconcat #'regexp-quote extension "\\|") - "\\)$") - (and current-prefix-arg ?\040))) - -(defun diredp-mark-files-tagged-all/none (tags &optional none-p unmarkp prefix) - "Mark or unmark files tagged with all or none of TAGS. -TAGS is a list of strings, the tag names. -NONEP non-nil means mark/unmark files that have none of the TAGS. -UNMARKP non-nil means unmark; nil means mark. -PREFIX non-nil is the prefix of the autofile bookmarks to check. - -As a special case, if TAGS is empty, then mark or unmark the files -that have any tags at all, or if NONEP is non-nil then mark or unmark -those that have no tags at all." - (let ((dired-marker-char (if unmarkp ?\040 dired-marker-char))) - (diredp-mark-if (and (not (diredp-looking-at-p dired-re-dot)) (not (eolp)) - (let* ((fname (dired-get-filename nil t)) - (bmk (and fname (bmkp-get-autofile-bookmark fname nil prefix))) - (btgs (and bmk (bmkp-get-tags bmk))) - (presentp nil) - (allp (and btgs (catch 'diredp-m-f-t-an - (dolist (tag tags) - (setq presentp (assoc-default tag btgs nil t)) - (unless (if none-p (not presentp) presentp) - (throw 'diredp-m-f-t-an nil))) - t)))) - (if (null tags) - (if none-p (not btgs) btgs) - allp))) - (if none-p "no-tags-matching file" "all-tags-matching file")))) - -(defun diredp-mark-files-tagged-some/not-all (tags &optional notallp unmarkp prefix) - "Mark or unmark files tagged with any or not all of TAGS. -TAGS is a list of strings, the tag names. -NOTALLP non-nil means mark/unmark files that do not have all TAGS. -UNMARKP non-nil means unmark; nil means mark. -PREFIX non-nil is the prefix of the autofile bookmarks to check. - -As a special case, if TAGS is empty, then mark or unmark the files -that have any tags at all, or if NOTALLP is non-nil then mark or -unmark those that have no tags at all." - (let ((dired-marker-char (if unmarkp ?\040 dired-marker-char))) - (diredp-mark-if (and (not (diredp-looking-at-p dired-re-dot)) (not (eolp)) - (let* ((fname (dired-get-filename nil t)) - (bmk (and fname - (bmkp-get-autofile-bookmark fname nil prefix))) - (btgs (and bmk (bmkp-get-tags bmk))) - (presentp nil) - (allp (and btgs (catch 'diredp-m-f-t-sna - (dolist (tag tags) - (setq presentp (assoc-default tag btgs nil t)) - (when (if notallp (not presentp) presentp) - (throw 'diredp-m-f-t-sna t))) - nil)))) - (if (null tags) (if notallp (not btgs) btgs) allp))) - (if notallp "some-tags-not-matching file" "some-tags-matching file")))) - -;;;###autoload -(defun diredp-mark-files-tagged-all (tags &optional none-p prefix) ; `T m *' - "Mark all files that are tagged with *each* tag in TAGS. -As a special case, if TAGS is empty, then mark the files that have - any tags at all (i.e., at least one tag). -With a prefix arg, mark all that are *not* tagged with *any* TAGS. -You need library `bookmark+.el' to use this command." - (interactive (list (and (fboundp 'bmkp-read-tags-completing) (bmkp-read-tags-completing)) - current-prefix-arg - (and diredp-prompt-for-bookmark-prefix-flag - (read-string "Prefix for autofile bookmark names: ")))) - (diredp-ensure-bookmark+) - (diredp-ensure-mode) - (diredp-mark-files-tagged-all/none tags none-p nil prefix)) - -;;;###autoload -(defun diredp-mark-files-tagged-none (tags &optional allp prefix) ; `T m ~ +' - "Mark all files that are not tagged with *any* tag in TAGS. -As a special case, if TAGS is empty, then mark the files that have - no tags at all. -With a prefix arg, mark all that are tagged with *each* tag in TAGS. -You need library `bookmark+.el' to use this command." - (interactive (list (and (fboundp 'bmkp-read-tags-completing) (bmkp-read-tags-completing)) - current-prefix-arg - (and diredp-prompt-for-bookmark-prefix-flag - (read-string "Prefix for autofile bookmark names: ")))) - (diredp-ensure-bookmark+) - (diredp-ensure-mode) - (diredp-mark-files-tagged-all/none tags (not allp) nil prefix)) - -;;;###autoload -(defun diredp-mark-files-tagged-some (tags &optional somenotp prefix) ; `T m +' - "Mark all files that are tagged with *some* tag in TAGS. -As a special case, if TAGS is empty, then mark the files that have - any tags at all (i.e., at least one tag). -With a prefix arg, mark all that are *not* tagged with *all* TAGS. -You need library `bookmark+.el' to use this command." - (interactive (list (and (fboundp 'bmkp-read-tags-completing) (bmkp-read-tags-completing)) - current-prefix-arg - (and diredp-prompt-for-bookmark-prefix-flag - (read-string "Prefix for autofile bookmark names: ")))) - (diredp-ensure-bookmark+) - (diredp-ensure-mode) - (diredp-mark-files-tagged-some/not-all tags somenotp nil prefix)) - -;;;###autoload -(defun diredp-mark-files-tagged-not-all (tags &optional somep prefix) ; `T m ~ *' - "Mark all files that are not tagged with *all* TAGS. -As a special case, if TAGS is empty, then mark the files that have - no tags at all. -With a prefix arg, mark all that are tagged with *some* TAGS. -You need library `bookmark+.el' to use this command." - (interactive (list (and (fboundp 'bmkp-read-tags-completing) (bmkp-read-tags-completing)) - current-prefix-arg - (and diredp-prompt-for-bookmark-prefix-flag - (read-string "Prefix for autofile bookmark names: ")))) - (diredp-ensure-bookmark+) - (diredp-ensure-mode) - (diredp-mark-files-tagged-some/not-all tags (not somep) nil prefix)) - -;;;###autoload -(defun diredp-mark-files-tagged-regexp (regexp &optional notp prefix) ; `T m %' - "Mark files that have at least one tag that matches REGEXP. -With a prefix arg, mark all that are tagged but have no matching tags. -You need library `bookmark+.el' to use this command." - (interactive (list (read-string "Regexp: ") - current-prefix-arg - (and diredp-prompt-for-bookmark-prefix-flag - (read-string "Prefix for autofile bookmark names: ")))) - (diredp-ensure-bookmark+) - (diredp-ensure-mode) - (diredp-mark-if (and (not (diredp-looking-at-p dired-re-dot)) (not (eolp)) - (lexical-let* ((fname (dired-get-filename nil t)) - (bmk (and fname - (bmkp-get-autofile-bookmark fname nil prefix))) - (btgs (and bmk (bmkp-get-tags bmk))) - (anyp (and btgs (bmkp-some #'(lambda (tag) - (diredp-string-match-p - regexp - (bmkp-tag-name tag))) - btgs)))) - (and btgs (if notp (not anyp) anyp)))) - "some-tag-matching-regexp file")) - -;;;###autoload -(defun diredp-unmark-files-tagged-regexp (regexp &optional notp prefix) ; `T u %' - "Unmark files that have at least one tag that matches REGEXP. -With a prefix arg, unmark all that are tagged but have no matching tags. -You need library `bookmark+.el' to use this command." - (interactive (list (read-string "Regexp: ") - current-prefix-arg - (and diredp-prompt-for-bookmark-prefix-flag - (read-string "Prefix for autofile bookmark names: ")))) - (diredp-ensure-bookmark+) - (diredp-ensure-mode) - (let ((dired-marker-char ?\040)) - (diredp-mark-if (and (not (diredp-looking-at-p dired-re-dot)) (not (eolp)) - (lexical-let* ((fname (dired-get-filename nil t)) - (bmk (and fname (bmkp-get-autofile-bookmark fname nil prefix))) - (btgs (and bmk (bmkp-get-tags bmk))) - (anyp (and btgs (bmkp-some #'(lambda (tag) - (diredp-string-match-p - regexp - (bmkp-tag-name tag))) - btgs)))) - (and btgs (if notp (not anyp) anyp)))) - "some-tag-matching-regexp file"))) - -;;;###autoload -(defun diredp-unmark-files-tagged-all (tags &optional none-p prefix) ; `T u *' - "Unmark all files that are tagged with *each* tag in TAGS. -As a special case, if TAGS is empty, then unmark the files that have - any tags at all (i.e., at least one tag). -With a prefix arg, unmark all that are *not* tagged with *any* TAGS. -You need library `bookmark+.el' to use this command." - (interactive (list (and (fboundp 'bmkp-read-tags-completing) (bmkp-read-tags-completing)) - current-prefix-arg - (and diredp-prompt-for-bookmark-prefix-flag - (read-string "Prefix for autofile bookmark names: ")))) - (diredp-ensure-bookmark+) - (diredp-ensure-mode) - (diredp-mark-files-tagged-all/none tags none-p 'UNMARK prefix)) - -;;;###autoload -(defun diredp-unmark-files-tagged-none (tags &optional allp prefix) ; `T u ~ +' - "Unmark all files that are *not* tagged with *any* tag in TAGS. -As a special case, if TAGS is empty, then unmark the files that have - no tags at all. -With a prefix arg, unmark all that are tagged with *each* tag in TAGS. -You need library `bookmark+.el' to use this command." - (interactive (list (and (fboundp 'bmkp-read-tags-completing) (bmkp-read-tags-completing)) - current-prefix-arg - (and diredp-prompt-for-bookmark-prefix-flag - (read-string "Prefix for autofile bookmark names: ")))) - (diredp-ensure-bookmark+) - (diredp-ensure-mode) - (diredp-mark-files-tagged-all/none tags (not allp) 'UNMARK prefix)) - -;;;###autoload -(defun diredp-unmark-files-tagged-some (tags &optional somenotp prefix) ; `T u +' - "Unmark all files that are tagged with *some* tag in TAGS. -As a special case, if TAGS is empty, then unmark the files that have - any tags at all. -With a prefix arg, unmark all that are *not* tagged with *all* TAGS. -You need library `bookmark+.el' to use this command." - (interactive (list (and (fboundp 'bmkp-read-tags-completing) (bmkp-read-tags-completing)) - current-prefix-arg - (and diredp-prompt-for-bookmark-prefix-flag - (read-string "Prefix for autofile bookmark names: ")))) - (diredp-ensure-bookmark+) - (diredp-ensure-mode) - (diredp-mark-files-tagged-some/not-all tags somenotp 'UNMARK prefix)) - -;;;###autoload -(defun diredp-unmark-files-tagged-not-all (tags &optional somep prefix) ; `T u ~ *' - "Unmark all files that are *not* tagged with *all* TAGS. -As a special case, if TAGS is empty, then unmark the files that have - no tags at all. -With a prefix arg, unmark all that are tagged with *some* TAGS. -You need library `bookmark+.el' to use this command." - (interactive (list (and (fboundp 'bmkp-read-tags-completing) (bmkp-read-tags-completing)) - current-prefix-arg - (and diredp-prompt-for-bookmark-prefix-flag - (read-string "Prefix for autofile bookmark names: ")))) - (diredp-ensure-bookmark+) - (diredp-ensure-mode) - (diredp-mark-files-tagged-some/not-all tags (not somep) 'UNMARK prefix)) - -;;;###autoload -(defun diredp-do-tag (tags &optional prefix arg) ; `T > +' - "Tag the marked (or the next prefix argument) files. -You need library `bookmark+.el' to use this command. - -Hit `RET' to enter each tag, then hit `RET' again after the last tag. -You can use completion to enter each tag. Completion is lax: you are -not limited to existing tags. - -TAGS is a list of strings. PREFIX is as for `diredp-do-bookmark'. - -A prefix argument ARG specifies files to use instead of those marked. - An integer means use the next ARG files (previous -ARG, if < 0). - `C-u': Use the current file (whether or not any are marked). - `C-u C-u': Use all files in Dired, except directories. - `C-u C-u C-u': Use all files and directories, except `.' and `..'. - `C-u C-u C-u C-u': Use all files and all directories." - (interactive (progn (diredp-ensure-bookmark+) - (diredp-ensure-mode) - (list (bmkp-read-tags-completing) - (and diredp-prompt-for-bookmark-prefix-flag - (read-string "Prefix for autofile bookmark name: ")) - current-prefix-arg))) - (dired-map-over-marks-check (lexical-let ((pref prefix)) #'(lambda () (diredp-tag tags pref))) - arg 'tag (diredp-fewer-than-2-files-p arg))) - -(defun diredp-tag (tags &optional prefix) - "Add tags to the file or directory named on the current line. -You need library `bookmark+.el' to use this function. -The bookmark name is the non-directory portion of the file name, - prefixed by PREFIX if it is non-nil. -Return nil for success, file name otherwise." - (bookmark-maybe-load-default-file) - (let ((file (dired-get-file-for-visit)) - failure) - (condition-case err - (bmkp-autofile-add-tags file tags nil prefix) - (error (setq failure (error-message-string err)))) - (if (not failure) - nil ; Return nil for success. - (dired-log failure) - (dired-make-relative file)))) ; Return file name for failure. - -;;;###autoload -(defun diredp-mouse-do-tag (event) ; Not bound - "In Dired, add some tags to this file. -You need library `bookmark+.el' to use this command." - (interactive "e") - (diredp-ensure-bookmark+) - (diredp-ensure-mode) - (lexical-let ((mouse-pos (event-start event)) - (dired-no-confirm t) - (prefix (and diredp-prompt-for-bookmark-prefix-flag - (read-string "Prefix for bookmark name: ")))) - (select-window (posn-window mouse-pos)) - (goto-char (posn-point mouse-pos)) - (dired-map-over-marks-check #'(lambda () (diredp-tag (bmkp-read-tags-completing) prefix)) - 1 'tag t)) - (diredp-previous-line 1)) - -;;;###autoload -(defun diredp-do-untag (tags &optional prefix arg) ; `T > -' - "Remove some tags from the marked (or the next prefix arg) files. -You need library `bookmark+.el' to use this command. - -Hit `RET' to enter each tag, then hit `RET' again after the last tag. -You can use completion to enter each tag. Completion is lax: you are -not limited to existing tags. - -TAGS is a list of strings. PREFIX is as for `diredp-do-bookmark'. - -A prefix argument ARG specifies files to use instead of those marked. - An integer means use the next ARG files (previous -ARG, if < 0). - `C-u': Use the current file (whether or not any are marked). - `C-u C-u': Use all files in Dired, except directories. - `C-u C-u C-u': Use all files and directories, except `.' and `..'. - `C-u C-u C-u C-u': Use all files and all directories." - (interactive (progn (diredp-ensure-bookmark+) - (diredp-ensure-mode) - (list (bmkp-read-tags-completing) - (and diredp-prompt-for-bookmark-prefix-flag - (read-string "Prefix for bookmark name: ")) - current-prefix-arg))) - (dired-map-over-marks-check (lexical-let ((pref prefix)) - #'(lambda () (diredp-untag tags pref))) - arg 'untag (diredp-fewer-than-2-files-p arg))) - -(defun diredp-untag (tags &optional prefix) - "Remove some tags from the file or directory named on the current line. -You need library `bookmark+.el' to use this function. -The bookmark name is the non-directory portion of the file name, - prefixed by PREFIX if it is non-nil. -Return nil for success, file name otherwise." - (bookmark-maybe-load-default-file) - (let ((file (dired-get-file-for-visit)) - failure) - (condition-case err - (bmkp-autofile-remove-tags file tags nil prefix) - (error (setq failure (error-message-string err)))) - (if (not failure) - nil ; Return nil for success. - (dired-log failure) - (dired-make-relative file)))) ; Return file name for failure. - -;;;###autoload -(defun diredp-mouse-do-untag (event) ; Not bound - "In Dired, remove some tags from this file. -You need library `bookmark+.el' to use this command." - (interactive "e") - (diredp-ensure-bookmark+) - (diredp-ensure-mode) - (lexical-let ((mouse-pos (event-start event)) - (dired-no-confirm t) - (prefix (and diredp-prompt-for-bookmark-prefix-flag - (read-string "Prefix for bookmark name: ")))) - (select-window (posn-window mouse-pos)) - (goto-char (posn-point mouse-pos)) - (lexical-let* ((bmk (bmkp-get-autofile-bookmark (dired-get-filename) nil prefix)) - (btgs (and bmk (bmkp-get-tags bmk)))) - (unless btgs (error "File has no tags to remove")) - (dired-map-over-marks-check - #'(lambda () (diredp-untag (bmkp-read-tags-completing btgs) prefix)) 1 'untag t))) - (diredp-previous-line 1)) - -;;;###autoload -(defun diredp-do-remove-all-tags (&optional prefix arg) ; `T > 0' - "Remove all tags from the marked (or the next prefix arg) files. -You need library `bookmark+.el' to use this command. - -PREFIX is as for `diredp-do-bookmark'. - -A prefix argument ARG specifies files to use instead of those marked. - An integer means use the next ARG files (previous -ARG, if < 0). - `C-u': Use the current file (whether or not any are marked). - `C-u C-u': Use all files in Dired, except directories. - `C-u C-u C-u': Use all files and directories, except `.' and `..'. - `C-u C-u C-u C-u': Use all files and all directories." - (interactive (progn (diredp-ensure-bookmark+) - (diredp-ensure-mode) - (list (and diredp-prompt-for-bookmark-prefix-flag - (read-string "Prefix for bookmark name: ")) - current-prefix-arg))) - (lexical-let ((pref prefix)) - (dired-map-over-marks-check #'(lambda () (diredp-remove-all-tags pref)) arg 'remove-all-tags - (diredp-fewer-than-2-files-p arg)))) - -(defun diredp-remove-all-tags (&optional prefix) - "Remove all tags from the file or directory named on the current line. -You need library `bookmark+.el' to use this function. -The bookmark name is the non-directory portion of the file name, - prefixed by PREFIX if it is non-nil. -Return nil for success, file name otherwise." - (bookmark-maybe-load-default-file) - (let ((file (dired-get-file-for-visit)) - failure) - (condition-case err - (bmkp-remove-all-tags (bmkp-autofile-set file nil prefix)) - (error (setq failure (error-message-string err)))) - (if (not failure) - nil ; Return nil for success. - (dired-log failure) - (dired-make-relative file)))) ; Return file name for failure. - -;;;###autoload -(defun diredp-mouse-do-remove-all-tags (event) ; Not bound - "In Dired, remove all tags from the marked (or next prefix arg) files. -You need library `bookmark+.el' to use this command." - (interactive "e") - (diredp-ensure-bookmark+) - (diredp-ensure-mode) - (lexical-let ((mouse-pos (event-start event)) - (dired-no-confirm t) - (prefix (and diredp-prompt-for-bookmark-prefix-flag - (read-string "Prefix for bookmark name: ")))) - (select-window (posn-window mouse-pos)) - (goto-char (posn-point mouse-pos)) - (dired-map-over-marks-check #'(lambda () (diredp-remove-all-tags prefix)) - 1 'remove-all-tags t)) - (diredp-previous-line 1)) - -;;;###autoload -(defun diredp-do-paste-add-tags (&optional prefix arg) ; `T > p', `T > C-y' - "Add previously copied tags to the marked (or next prefix arg) files. -The tags were previously copied from a file to `bmkp-copied-tags'. -You need library `bookmark+.el' to use this command. - -A prefix argument ARG specifies files to use instead of those marked. - An integer means use the next ARG files (previous -ARG, if < 0). - `C-u': Use the current file (whether or not any are marked). - `C-u C-u': Use all files in Dired, except directories. - `C-u C-u C-u': Use all files and directories, except `.' and `..'. - `C-u C-u C-u C-u': Use all files and all directories." - (interactive (progn (diredp-ensure-bookmark+) - (diredp-ensure-mode) - (list (and diredp-prompt-for-bookmark-prefix-flag - (read-string "Prefix for autofile bookmark name: ")) - current-prefix-arg))) - (dired-map-over-marks-check (lexical-let ((pref prefix)) - #'(lambda () (diredp-paste-add-tags pref))) - arg 'paste-add-tags - (diredp-fewer-than-2-files-p arg))) - -(defun diredp-paste-add-tags (&optional prefix) - "Add previously copied tags to the file or directory on the current line. -The tags were previously copied from a file to `bmkp-copied-tags'. -You need library `bookmark+.el' to use this function. -The bookmark name is the non-directory portion of the file name, - prefixed by PREFIX if it is non-nil. -Return nil for success, file name otherwise." - (bookmark-maybe-load-default-file) - (let ((file (dired-get-file-for-visit)) - failure) - (condition-case err - (bmkp-autofile-add-tags file bmkp-copied-tags nil prefix) - (error (setq failure (error-message-string err)))) - (if (not failure) - nil ; Return nil for success. - (dired-log failure) - (dired-make-relative file)))) ; Return file name for failure. - -;;;###autoload -(defun diredp-mouse-do-paste-add-tags (event) ; Not bound - "In Dired, add previously copied tags to this file. -The tags were previously copied from a file to `bmkp-copied-tags'. -You need library `bookmark+.el' to use this command." - (interactive "e") - (diredp-ensure-bookmark+) - (diredp-ensure-mode) - (lexical-let ((mouse-pos (event-start event)) - (dired-no-confirm t) - (prefix (and diredp-prompt-for-bookmark-prefix-flag - (read-string "Prefix for bookmark name: ")))) - (select-window (posn-window mouse-pos)) - (goto-char (posn-point mouse-pos)) - (dired-map-over-marks-check #'(lambda () (diredp-paste-add-tags prefix)) - 1 'paste-add-tags t)) - (diredp-previous-line 1)) - -;;;###autoload -(defun diredp-do-paste-replace-tags (&optional prefix arg) ; `T > q' - "Replace tags for marked (or next prefix arg) files with copied tags. -The tags were previously copied from a file to `bmkp-copied-tags'. -You need library `bookmark+.el' to use this command. - -A prefix argument ARG specifies files to use instead of those marked. - An integer means use the next ARG files (previous -ARG, if < 0). - `C-u': Use the current file (whether or not any are marked). - `C-u C-u': Use all files in Dired, except directories. - `C-u C-u C-u': Use all files and directories, except `.' and `..'. - `C-u C-u C-u C-u': Use all files and all directories." - (interactive (progn (diredp-ensure-bookmark+) - (diredp-ensure-mode) - (list (and diredp-prompt-for-bookmark-prefix-flag - (read-string "Prefix for autofile bookmark name: ")) - current-prefix-arg))) - (dired-map-over-marks-check (lexical-let ((pref prefix)) - #'(lambda () (diredp-paste-replace-tags pref))) - arg 'paste-replace-tags (diredp-fewer-than-2-files-p arg))) - -(defun diredp-paste-replace-tags (&optional prefix) - "Replace tags for this file or dir with tags copied previously. -The tags were previously copied from a file to `bmkp-copied-tags'. -You need library `bookmark+.el' to use this function. -The bookmark name is the non-directory portion of the file name, - prefixed by PREFIX if it is non-nil. -Return nil for success, file name otherwise." - (bookmark-maybe-load-default-file) - (let ((file (dired-get-file-for-visit)) - failure) - (condition-case err - (progn (bmkp-remove-all-tags (bmkp-autofile-set file nil prefix)) - (bmkp-autofile-add-tags file bmkp-copied-tags nil prefix)) - (error (setq failure (error-message-string err)))) - (if (not failure) - nil ; Return nil for success. - (dired-log failure) - (dired-make-relative file)))) - -;;;###autoload -(defun diredp-mouse-do-paste-replace-tags (event) ; Not bound - "In Dired, replace tags for this file with tags copied previously. -The tags were previously copied from a file to `bmkp-copied-tags'. -You need library `bookmark+.el' to use this command." - (interactive "e") - (diredp-ensure-bookmark+) - (diredp-ensure-mode) - (lexical-let ((mouse-pos (event-start event)) - (dired-no-confirm t) - (prefix (and diredp-prompt-for-bookmark-prefix-flag - (read-string "Prefix for bookmark name: ")))) - (select-window (posn-window mouse-pos)) - (goto-char (posn-point mouse-pos)) - (dired-map-over-marks-check #'(lambda () (diredp-paste-replace-tags prefix)) - 1 'paste-replace-tags t)) - (diredp-previous-line 1)) - -;;;###autoload -(defun diredp-do-set-tag-value (tag value &optional prefix arg) ; `T > v' - "Set TAG value to VALUE, for the marked (or next prefix arg) files. -This does not change the TAG name. -You need library `bookmark+.el' to use this command. - -PREFIX is as for `diredp-do-bookmark'. - -A prefix argument ARG specifies files to use instead of those marked. - An integer means use the next ARG files (previous -ARG, if < 0). - `C-u': Use the current file (whether or not any are marked). - `C-u C-u': Use all files in Dired, except directories. - `C-u C-u C-u': Use all files and directories, except `.' and `..'. - `C-u C-u C-u C-u': Use all files and all directories." - (interactive (progn (diredp-ensure-bookmark+) - (diredp-ensure-mode) - (list (bmkp-read-tag-completing) - (read (read-string "Value: ")) - (and diredp-prompt-for-bookmark-prefix-flag - (read-string "Prefix for bookmark name: ")) - current-prefix-arg))) - (dired-map-over-marks-check (lexical-let ((tg tag) - (val value) - (pref prefix)) - #'(lambda () (diredp-set-tag-value tg val pref))) - arg 'set-tag-value (diredp-fewer-than-2-files-p arg))) - -(defun diredp-set-tag-value (tag value &optional prefix) - "Set TAG value to VALUE for this file or directory. -This does not change the TAG name. -You need library `bookmark+.el' to use this function. -The bookmark name is the non-directory portion of the file name, - prefixed by PREFIX if it is non-nil. -Return nil for success, file name otherwise." - (bookmark-maybe-load-default-file) - (let ((file (dired-get-file-for-visit)) - failure) - (condition-case err - (bmkp-set-tag-value (bmkp-autofile-set file nil prefix) tag value) - (error (setq failure (error-message-string err)))) - (if (not failure) - nil ; Return nil for success. - (dired-log failure) - (dired-make-relative file)))) ; Return file name for failure. - -;;;###autoload -(defun diredp-mouse-do-set-tag-value (event) ; Not bound - "In Dired, set the value of a tag for this file. -This does not change the tag name. -You need library `bookmark+.el' to use this command." - (interactive "e") - (diredp-ensure-bookmark+) - (diredp-ensure-mode) - (lexical-let ((mouse-pos (event-start event)) - (dired-no-confirm t) - (prefix (and diredp-prompt-for-bookmark-prefix-flag - (read-string "Prefix for bookmark name: ")))) - (select-window (posn-window mouse-pos)) - (goto-char (posn-point mouse-pos)) - (dired-map-over-marks-check #'(lambda () (diredp-set-tag-value (bmkp-read-tag-completing) - (read (read-string "Value: ")) - prefix)) - 1 'set-tag-value t)) - (diredp-previous-line 1)) - - -;; Define these even if `Bookmark+' is not loaded. -;;;###autoload -(defun diredp-mark-autofiles () ; Bound to `* B' - "Mark all autofiles, that is, files that have an autofile bookmark." - (interactive) - (diredp-ensure-bookmark+) - (diredp-ensure-mode) - (diredp-mark/unmark-autofiles)) - -;;;###autoload -(defun diredp-unmark-autofiles () - "Unmark all autofiles, that is, files that have an autofile bookmark." - (interactive) - (diredp-ensure-bookmark+) - (diredp-ensure-mode) - (diredp-mark/unmark-autofiles t)) - -;;;###autoload -(defun diredp-mark/unmark-autofiles (&optional unmarkp) - "Mark all autofiles, or unmark if UNMARKP is non-nil." - (let ((dired-marker-char (if unmarkp ?\040 dired-marker-char))) - (diredp-mark-if (and (not (diredp-looking-at-p dired-re-dot)) (not (eolp)) - (let ((fname (dired-get-filename nil t))) - (and fname (bmkp-get-autofile-bookmark fname)))) - "autofile"))) - -(when (and (fboundp 'bmkp-get-autofile-bookmark) ; Defined in `bookmark+-1.el'. - (fboundp 'hlt-highlight-region)) ; Defined in `highlight.el'. - - (defun diredp-highlight-autofiles () - "Highlight files that are autofile bookmarks. -Highlighting uses face `diredp-autofile-name'." - (save-excursion - (goto-char (point-min)) - (while (re-search-forward dired-move-to-filename-regexp nil t) - ;; If Dired details are hidden the match data gets changed. - (let* ((bmk (save-match-data - (bmkp-get-autofile-bookmark (buffer-substring (match-end 0) (line-end-position))))) - (tags (and bmk (bmkp-get-tags bmk)))) - (when bmk - (hlt-highlight-region (match-end 0) (line-end-position) - (if tags - 'diredp-tagged-autofile-name - 'diredp-autofile-name))))))) - - (cond ((fboundp 'define-minor-mode) - ;; Emacs 21+. Use `eval' so that even if the library is byte-compiled with Emacs 20, - ;; loading it into Emacs 21+ will define variable `diredp-highlight-autofiles-mode'. - (eval '(define-minor-mode diredp-highlight-autofiles-mode - "Toggle automatic highlighting of autofile bookmarks. -When you turn this on, it ensures that your bookmark file is loaded. - -NOTE: This mode is ON BY DEFAULT. More precisely, when `dired+.el' is -loaded (for the first time per Emacs session), the mode is turned ON. -To prevent this and have the mode OFF by default, you must do one of -the following: - - * Put (diredp-highlight-autofiles-mode -1) in your init file, AFTER - it loads `dired+.el'. - - * Customize option `diredp-highlight-autofiles-mode' to `nil', AND - ensure that your `custom-file' (or the `custom-saved-variables' - part of your init file) is evaluated before `dired+.el' is loaded. - -You need libraries `Bookmark and `highlight.el' for this command." - :init-value t :global t :group 'Dired-Plus :require 'dired+ - (if (not diredp-highlight-autofiles-mode) - (remove-hook 'dired-after-readin-hook #'diredp-highlight-autofiles) - (add-hook 'dired-after-readin-hook #'diredp-highlight-autofiles) - (bookmark-maybe-load-default-file)) - (when (derived-mode-p 'dired-mode) (dired-revert nil nil)) - (when (interactive-p) - (message "Dired highlighting of autofile bookmarks is now %s" - (if diredp-highlight-autofiles-mode "ON" "OFF")))))) - (t;; Emacs 20. - (defun diredp-highlight-autofiles-mode (&optional arg) - "Toggle automatic highlighting of autofile bookmarks. -When you turn this on, it ensures that your bookmark file is loaded. - -NOTE: This mode is ON BY DEFAULT. More precisely, when `dired+.el' is -loaded (for the first time per Emacs session), the mode is turned ON. -To prevent this and have the mode OFF by default, you must do one of -the following: - - * Put (diredp-highlight-autofiles-mode -1) in your init file, AFTER - it loads `dired+.el'. - - * Customize option `diredp-highlight-autofiles-mode' to `nil', AND - ensure that your `custom-file' (or the `custom-saved-variables' - part of your init file) is evaluated before `dired+.el' is loaded. - -You need libraries `Bookmark and `highlight.el' for this command." - (interactive (list (or current-prefix-arg 'toggle))) - (setq diredp-highlight-autofiles-mode (if (eq arg 'toggle) - (not diredp-highlight-autofiles-mode) - (> (prefix-numeric-value arg) 0))) - (if (not diredp-highlight-autofiles-mode) - (remove-hook 'dired-after-readin-hook #'diredp-highlight-autofiles) - (add-hook 'dired-after-readin-hook #'diredp-highlight-autofiles) - (bookmark-maybe-load-default-file)) - (when (derived-mode-p 'dired-mode) (dired-revert nil nil)) - (when (interactive-p) (message "Dired highlighting of autofile bookmarks is now %s" - (if diredp-highlight-autofiles-mode "ON" "OFF")))))) - - ;; Turn it ON BY DEFAULT. - (unless (or (boundp 'diredp-loaded-p) (get 'diredp-highlight-autofiles-mode 'saved-value)) - (diredp-highlight-autofiles-mode 1)) - ) - -;;;###autoload -(defun diredp-do-bookmark (&optional prefix arg) ; Bound to `M-b' - "Bookmark the marked (or the next prefix argument) files. -Each bookmark name is the non-directory portion of the file name, - prefixed by PREFIX if it is non-nil. -Interactively, you are prompted for the PREFIX if - `diredp-prompt-for-bookmark-prefix-flag' is non-nil. -The bookmarked position is the beginning of the file. -If you use library `bookmark+.el' then the bookmark is an autofile. - -A prefix argument ARG specifies files to use instead of those marked. - An integer means use the next ARG files (previous -ARG, if < 0). - `C-u': Use the current file (whether or not any are marked). - `C-u C-u': Use all files in Dired, except directories. - `C-u C-u C-u': Use all files and directories, except `.' and `..'. - `C-u C-u C-u C-u': Use all files and all directories." - (interactive (progn (diredp-ensure-mode) - (list (and diredp-prompt-for-bookmark-prefix-flag - (read-string "Prefix for bookmark name: ")) - current-prefix-arg))) - (dired-map-over-marks-check (lexical-let ((pref prefix)) - #'(lambda () (diredp-bookmark pref nil 'NO-MSG-P))) - arg 'bookmark (diredp-fewer-than-2-files-p arg))) - -;;;###autoload -(defun diredp-mouse-do-bookmark (event) ; Not bound - "In Dired, bookmark this file. See `diredp-do-bookmark'." - (interactive "e") - (lexical-let ((mouse-pos (event-start event)) - (dired-no-confirm t) - (prefix (and diredp-prompt-for-bookmark-prefix-flag - (read-string "Prefix for bookmark name: ")))) - (select-window (posn-window mouse-pos)) - (goto-char (posn-point mouse-pos)) - (dired-map-over-marks-check #'(lambda () (diredp-bookmark prefix nil)) nil 'bookmark t)) - (diredp-previous-line 1)) - -(defun diredp-bookmark (&optional prefix file no-msg-p) - "Bookmark the file or directory FILE. -If you use library `bookmark+.el' then the bookmark is an autofile. -Return nil for success or the file name otherwise. - -The bookmark name is the (non-directory) file name, prefixed by - optional arg PREFIX (a string) if non-nil. - -FILE defaults to the file name on the current Dired line. - -Non-nil optional arg NO-MSG-P means do not show progress messages." - (bookmark-maybe-load-default-file) - (let ((fil (or file (dired-get-file-for-visit))) - (failure nil)) - (condition-case err - (if (fboundp 'bmkp-autofile-set) ; Bookmark+ - just set an autofile bookmark. - (bmkp-autofile-set fil nil prefix nil (not no-msg-p)) - ;; Vanilla `bookmark.el' (or very old Bookmark+ version). - (let ((bookmark-make-record-function - (cond ((and (require 'image nil t) (require 'image-mode nil t) - (condition-case nil (image-type fil) (error nil))) - ;; Last two lines of function are from `image-bookmark-make-record'. - ;; But don't use that directly, because it uses - ;; `bookmark-make-record-default', which gets nil for `filename'. - (lambda () - `((filename . ,fil) - (position . 0) - ;; NEED to keep this part of code sync'd with `bmkp-make-record-for-target-file'. - (image-type . ,(image-type fil)) - (handler . image-bookmark-jump)))) ; In `image-mode.el'. - (t - (lambda () - `((filename . ,fil) - (position . 0))))))) - (bookmark-store (concat prefix (file-name-nondirectory fil)) (cdr (bookmark-make-record)) nil))) - (error (setq failure (error-message-string err)))) - (if (not failure) - nil ; Return nil for success. - (if (fboundp 'bmkp-autofile-set) - (dired-log failure) - (dired-log "Failed to create bookmark for `%s':\n%s\n" fil failure)) - (dired-make-relative fil)))) ; Return file name for failure. - -;;;###autoload -(defun diredp-set-bookmark-file-bookmark-for-marked (bookmark-file ; Bound to `C-M-b' - &optional prefix arg) - "Bookmark the marked files and create a bookmark-file bookmark for them. -The bookmarked position is the beginning of the file. -Jumping to the bookmark-file bookmark loads the set of file bookmarks. -You need library `bookmark+.el' to use this command. - -Each bookmark name is the non-directory portion of the file name, - prefixed by PREFIX if it is non-nil. -Interactively, you are prompted for PREFIX if - `diredp-prompt-for-bookmark-prefix-flag' is non-nil. - -A prefix argument ARG specifies files to use instead of those marked. - An integer means use the next ARG files (previous -ARG, if < 0). - `C-u': Use the current file (whether or not any are marked). - `C-u C-u': Use all files in Dired, except directories. - `C-u C-u C-u': Use all files and directories, except `.' and `..'. - `C-u C-u C-u C-u': Use all files and all directories. - -You are also prompted for the bookmark file, BOOKMARK-FILE. The -default is `.emacs.bmk' in the current directory, but you can enter -any file name, anywhere. - -The marked-file bookmarks are added to file BOOKMARK-FILE, but this -command does not make BOOKMARK-FILE the current bookmark file. To -make it current, just jump to the bookmark-file bookmark created by -this command. That bookmark (which bookmarks BOOKMARK-FILE) is -defined in that current bookmark file. - -Example: - - Bookmark file `~/.emacs.bmk' is current before invoking this command. - The current (Dired) directory is `/foo/bar'. - The marked files are bookmarked in the (possibly new) bookmark file - `/foo/bar/.emacs.bmk'. - The bookmarks for the marked files have names prefixed by `FOOBAR '. - The name of the bookmark-file bookmark is `Foobar Files'. - Bookmark `Foobar Files' is itself in bookmark file `~/.emacs.bmk'. - Bookmark file `~/.emacs.bmk' is current after invoking this command. - -You are prompted for the name of the bookmark-file bookmark, the -BOOKMARK-FILE for the marked-file bookmarks, and a PREFIX string for -each of the marked-file bookmarks. - -See also command `diredp-do-bookmark-in-bookmark-file'." - (interactive (diredp-read-bookmark-file-args)) - (diredp-ensure-bookmark+) - (diredp-do-bookmark-in-bookmark-file bookmark-file prefix arg 'CREATE-BOOKMARK-FILE-BOOKMARK)) - -;;;###autoload -(defun diredp-do-bookmark-in-bookmark-file (bookmark-file ; Bound to `C-M-B' (aka `C-M-S-b') - &optional prefix arg bfile-bookmarkp files) - "Bookmark marked files in BOOKMARK-FILE and save BOOKMARK-FILE. -The files bookmarked are the marked files, by default. -The bookmarked position is the beginning of the file. -You are prompted for BOOKMARK-FILE. The default is `.emacs.bmk' in -the current directory, but you can enter any file name, anywhere. -You need library `bookmark+.el' to use this command. - -The marked files are bookmarked in file BOOKMARK-FILE, but this -command does not make BOOKMARK-FILE the current bookmark file. To -make it current, use `\\[bmkp-switch-bookmark-file]' (`bmkp-switch-bookmark-file'). - -Each bookmark name is the non-directory portion of the file name, - prefixed by PREFIX if it is non-nil. -Interactively, you are prompted for PREFIX if - `diredp-prompt-for-bookmark-prefix-flag' is non-nil. - -Interactively, a prefix argument ARG specifies the files to use -instead of those marked. - - An integer means use the next ARG files (previous -ARG, if < 0). - `C-u': Use the current file (whether or not any are marked). - `C-u C-u': Use all files in Dired, except directories. - `C-u C-u C-u': Use all files and directories, except `.' and `..'. - `C-u C-u C-u C-u': Use all files and all directories. - -See also command `diredp-set-bookmark-file-bookmark-for-marked'. - -Non-interactively: - - * Non-nil BFILE-BOOKMARKP means create a bookmark-file bookmark for - BOOKMARK-FILE. - * Non-nil FILES is the list of files to bookmark." - (interactive (diredp-read-bookmark-file-args)) - (diredp-ensure-bookmark+) - (let ((bfile-exists-p (file-readable-p bookmark-file))) - (unless bfile-exists-p (bmkp-empty-file bookmark-file)) - (unless bmkp-current-bookmark-file (setq bmkp-current-bookmark-file bookmark-default-file)) - (let ((old-bmkp-current-bookmark-file bmkp-current-bookmark-file)) - (unwind-protect - (progn (bmkp-switch-bookmark-file bookmark-file) ; Changes `*-current-bookmark-file'. - (if files - (dolist (file files) (diredp-bookmark prefix file 'NO-MSG-P)) - (dired-map-over-marks-check - (lexical-let ((pref prefix)) #'(lambda () (diredp-bookmark pref nil 'NO-MSG-P))) - arg 'bookmark (diredp-fewer-than-2-files-p arg))) - (bookmark-save) - (unless bfile-exists-p (revert-buffer))) - (unless (bmkp-same-file-p old-bmkp-current-bookmark-file bmkp-current-bookmark-file) - (bmkp-switch-bookmark-file old-bmkp-current-bookmark-file 'NO-MSG)))) - (when bfile-bookmarkp (bmkp-set-bookmark-file-bookmark bookmark-file)))) - -(defun diredp-read-bookmark-file-args () - "Read args for `diredp-do-bookmark-in-bookmark-file' and similar." - (diredp-ensure-bookmark+) - (diredp-ensure-mode) - (list (let* ((insert-default-directory t) - (bmk-file (expand-file-name - (read-file-name - "Use bookmark file (default is in CURRENT dir): " nil - (if (or (> emacs-major-version 23) - (and (= emacs-major-version 23) (> emacs-minor-version 1))) - (list ".emacs.bmk" bookmark-default-file) - ".emacs.bmk"))))) - bmk-file) - (and diredp-prompt-for-bookmark-prefix-flag (read-string "Prefix for autofile bookmark names: ")) - current-prefix-arg)) - - -;; REPLACE ORIGINAL in `dired.el'. -;; -;; Allows for consp `dired-directory' too. -;; -(defun dired-buffers-for-dir (dir &optional file) - "Return a list of buffers that Dired DIR (top level or in-situ subdir). -If FILE is non-nil, include only those whose wildcard pattern (if any) -matches FILE. -The list is in reverse order of buffer creation, most recent last. -As a side effect, killed Dired buffers for DIR are removed from -`dired-buffers'." - (setq dir (file-name-as-directory dir)) - (let (result buf) - (dolist (elt dired-buffers) - (setq buf (cdr elt)) - (cond ((null (buffer-name buf)) ; Buffer is killed - clean up. - (setq dired-buffers (delq elt dired-buffers))) - ((dired-in-this-tree dir (car elt)) - (with-current-buffer buf - (and (assoc dir dired-subdir-alist) - (or (null file) - (if (stringp dired-directory) - ;; Allow for consp `dired-directory' too. - (let ((wildcards (file-name-nondirectory (if (consp dired-directory) - (car dired-directory) - dired-directory)))) - (or (zerop (length wildcards)) - (diredp-string-match-p (dired-glob-regexp wildcards) file))) - (member (expand-file-name file dir) (cdr dired-directory)))) - (setq result (cons buf result))))))) - result)) - - -;; If you use library `files+.el', you need not use these commands -;; explicitly, because that library redefines `find-file-read-args' to -;; do the same thing, in Dired mode. These are provided here in case -;; you want to bind them directly - for example, in case your code -;; does not use `find-file-read-args'. -;; -;;;###autoload -(defun diredp-find-a-file (filename &optional wildcards) ; Not bound - "`find-file', but use file on current line as default (`M-n')." - (interactive (diredp-find-a-file-read-args "Find file: " nil)) - (find-file filename wildcards)) - -;;;###autoload -(defun diredp-find-a-file-other-frame (filename &optional wildcards) ; Not bound - "`find-file-other-frame', but use file under cursor as default (`M-n')." - (interactive (diredp-find-a-file-read-args "Find file: " nil)) - (find-file-other-frame filename wildcards)) - -;;;###autoload -(defun diredp-find-a-file-other-window (filename &optional wildcards) ; Not bound - "`find-file-other-window', but use file under cursor as default (`M-n')." - (interactive (diredp-find-a-file-read-args "Find file: " nil)) - (find-file-other-window filename wildcards)) - -;;;###autoload -(defun diredp-find-a-file-read-args (prompt mustmatch) ; Not bound - (list (lexical-let ((find-file-default (abbreviate-file-name (dired-get-file-for-visit)))) - (minibuffer-with-setup-hook (lambda () - (setq minibuffer-default find-file-default)) - (read-file-name prompt nil default-directory mustmatch))) - t)) - -;;;###autoload -(defun diredp-find-file-reuse-dir-buffer () ; Not bound - "Like `dired-find-file', but reuse Dired buffers. -Unlike `dired-find-alternate-file' this does not use -`find-alternate-file' unless (1) the target is a directory that is not -yet visited as a Dired buffer, and (2) the current (Dired) buffer is -not visited also in some other window (possibly in an iconified -frame)." - (interactive) - (set-buffer-modified-p nil) - (let ((file (dired-get-file-for-visit))) - (diredp--reuse-dir-buffer-helper file))) - -;;;###autoload -(defun diredp-mouse-find-file-reuse-dir-buffer (event &optional find-file-func find-dir-func) ; Not bound - "Like `dired-mouse-find-file', but reuse Dired buffers. -Unlike `dired-find-alternate-file' this does not use -`find-alternate-file' unless (1) the target is a directory that is not -yet visited as a Dired buffer, and (2) the current (Dired) buffer is -not visited also in some other window (possibly in an iconified -frame). - -Non-nil optional args FIND-FILE-FUNC and FIND-DIR-FUNC specify -functions to visit the file and directory, respectively. -Defaults: `find-file' and `dired', respectively." - (interactive "e") - (let (window pos file) - (save-excursion - (setq window (posn-window (event-end event)) - pos (posn-point (event-end event))) - (unless (windowp window) (error "No file chosen")) - (set-buffer (window-buffer window)) - (goto-char pos) - (setq file (dired-get-file-for-visit))) - (select-window window) - (diredp--reuse-dir-buffer-helper file find-file-func find-dir-func))) - -(defun diredp--reuse-dir-buffer-helper (file &optional find-file-func find-dir-func other-window) - "Helper for commands `diredp-*-reuse-dir-buffer' commands. -Non-nil optional args FIND-FILE-FUNC and FIND-DIR-FUNC specify -functions to visit the file and directory, respectively. -Defaults: `find-file' and `dired', respectively. - -Unlike `dired-find-alternate-file' this does not use -`find-alternate-file' unless (1) the target is a directory that is not -yet visited as a Dired buffer, and (2) the current (Dired) buffer is -not visited also in some other window (possibly in an iconified -frame)." - (setq find-file-func (or find-file-func (if other-window #'find-file-other-window #'find-file)) - find-dir-func (or find-dir-func (if other-window #'dired-other-window #'dired))) - (let (;; This binding prevents problems with preserving point in windows displaying Dired buffers, because - ;; reverting a Dired buffer empties it, which changes the places where the markers used by - ;; `switch-to-buffer-preserve-window-point' point. - (switch-to-buffer-preserve-window-point (and (boundp 'switch-to-buffer-preserve-window-point) ; Emacs 24+ - (or (not (boundp 'dired-auto-revert-buffer)) - (not dired-auto-revert-buffer)) - switch-to-buffer-preserve-window-point)) - (find-file-run-dired t) - (wins ()) - (alt-find-file-func (if other-window - #'find-alternate-file-other-window - #'find-alternate-file)) - dir-bufs) - (if (or (not (file-directory-p file)) ; New is a not a directory - (dired-buffers-for-dir file) ; or there is a Dired buffer for it, even as a subdir. - (and (setq dir-bufs (dired-buffers-for-dir default-directory)) ; Dired bufs for current (old). - (progn - (dolist (buf dir-bufs) - (setq wins (append wins (get-buffer-window-list buf 'NOMINI 0)))) - (setq wins (delq nil wins)) - (cdr wins)))) ; More than one window showing current Dired buffer. - (if (file-directory-p file) - (or (and (cdr dired-subdir-alist) (dired-goto-subdir file)) ; New is a subdir inserted in current - (funcall find-dir-func file)) - (funcall find-file-func (file-name-sans-versions file t))) - (funcall alt-find-file-func (file-name-sans-versions file t))))) - -;;;###autoload -(defalias 'toggle-diredp-find-file-reuse-dir 'diredp-toggle-find-file-reuse-dir) -;;;###autoload -(defun diredp-toggle-find-file-reuse-dir (force-p) ; Bound to `C-M-R' (aka `C-M-S-r') - "Toggle whether Dired `find-file' commands reuse directories. -This applies also to `dired-w32-browser' commands and -`diredp-up-directory'. - -A prefix arg specifies directly whether or not to reuse. - If its numeric value is non-negative then reuse; else do not reuse. - -To set the behavior as a preference (default behavior), put this in -your ~/.emacs, where VALUE is 1 to reuse or -1 to not reuse: - - (diredp-toggle-find-file-reuse-dir VALUE) - -Note: This affects only these commands: - - `dired-find-file' - `dired-mouse-find-file' - -It does not affect the corresponding `-other-window' commands. Note -too that, by default, mouse clicks to open files or directories open -in another window: command `diredp-mouse-find-file-other-window', not -`dired-mouse-find-file'. If you want a mouse click to reuse a -directory then bind `mouse-2' to `dired-mouse-find-file' instead." - (interactive "P") - (if force-p ; Force. - (if (natnump (prefix-numeric-value force-p)) - (diredp-make-find-file-keys-reuse-dirs) - (diredp-make-find-file-keys-not-reuse-dirs)) - (if (where-is-internal 'dired-find-file dired-mode-map 'ascii) - (diredp-make-find-file-keys-reuse-dirs) - (diredp-make-find-file-keys-not-reuse-dirs)))) - -(defun diredp-make-find-file-keys-reuse-dirs () - "Make find-file keys reuse Dired buffers." - (substitute-key-definition 'diredp-up-directory 'diredp-up-directory-reuse-dir-buffer dired-mode-map) - (substitute-key-definition 'dired-find-file 'diredp-find-file-reuse-dir-buffer dired-mode-map) - (substitute-key-definition 'dired-mouse-find-file 'diredp-mouse-find-file-reuse-dir-buffer dired-mode-map) - ;; These commands are defined in `w32-browser.el' (for use with MS Windows). - (substitute-key-definition 'dired-w32-browser 'dired-w32-browser-reuse-dir-buffer dired-mode-map) - (substitute-key-definition 'dired-mouse-w32-browser 'dired-mouse-w32-browser-reuse-dir-buffer dired-mode-map) - (message "Reusing Dired buffers is now ON")) - -(defun diredp-make-find-file-keys-not-reuse-dirs () - "Make find-file keys not reuse Dired buffers (i.e. act normally)." - (substitute-key-definition 'diredp-up-directory-reuse-dir-buffer 'diredp-up-directory dired-mode-map) - (substitute-key-definition 'diredp-find-file-reuse-dir-buffer 'dired-find-file dired-mode-map) - (substitute-key-definition 'diredp-mouse-find-file-reuse-dir-buffer 'dired-mouse-find-file dired-mode-map) - ;; These commands are defined in `w32-browser.el' (for use with MS Windows). - (substitute-key-definition 'dired-w32-browser-reuse-dir-buffer 'dired-w32-browser dired-mode-map) - (substitute-key-definition 'dired-mouse-w32-browser-reuse-dir-buffer 'dired-mouse-w32-browser dired-mode-map) - (message "Reusing Dired buffers is now OFF")) - -;;;###autoload -(defun diredp-omit-marked () ; Not bound - "Omit lines of marked files. Return the number of lines omitted." - (interactive) - (let ((old-modified-p (buffer-modified-p)) - count) - (when (interactive-p) (message "Omitting marked lines...")) - (setq count (dired-do-kill-lines nil "Omitted %d line%s.")) - (set-buffer-modified-p old-modified-p) ; So no `%*' appear in mode-line. - count)) - -;;;###autoload -(defun diredp-omit-unmarked () ; Not bound - "Omit lines of unmarked files. Return the number of lines omitted." - (interactive) - (let ((old-modified-p (buffer-modified-p)) - count) - (dired-toggle-marks) - (message "Omitting unmarked lines...") - (setq count (diredp-omit-marked)) - (dired-toggle-marks) ; Marks all except `.', `..' - (set-buffer-modified-p old-modified-p) ; So no `%*' appear in mode-line. - count)) - -;;;###autoload -(defun diredp-ediff (file2) ; Bound to `=' - "Compare file at cursor with file FILE2 using `ediff'. -FILE2 defaults to the file at the cursor as well. If you enter just a -directory name for FILE2, then the file at the cursor is compared with -a file of the same name in that directory. FILE2 is the second file -given to `ediff'; the file at the cursor is the first. - -Try to guess a useful default value for FILE2, as follows: - -* If the mark is active, use the file at mark. -* Else if the file at cursor is a autosave file or a backup file, use - the corresponding base file. -* Else if there is any backup file for the file at point, use the - newest backup file for it. -* Else use the file at point." - (interactive (progn (require 'ediff) - (list (ediff-read-file-name ; In `ediff-util.el'. - (format "Compare %s with" (dired-get-filename t)) - (dired-current-directory) - (let* ((file (dired-get-filename)) - (file-sans-dir (file-name-nondirectory file)) - (file-dir (file-name-directory file)) - (file-at-mark (and transient-mark-mode - mark-active - (save-excursion (goto-char (mark t)) - (dired-get-filename t t)))) - (last-backup (file-newest-backup file))) - (cond - (file-at-mark) - ((auto-save-file-name-p file-sans-dir) - (expand-file-name (substring file-sans-dir 1 -1) file-dir)) - ((backup-file-name-p file-sans-dir) - (expand-file-name (file-name-sans-versions file-sans-dir) file-dir)) - (last-backup) - (t file))))))) - (ediff-files (dired-get-filename) file2)) ; In `ediff.el'. - -(defun diredp-fewer-than-N-files-p (arg n) - "Return non-nil iff fewer than N files are to be treated by dired. -More precisely, return non-nil iff ARG is nil and fewer than N -files are marked, or the absolute value of ARG is less than N." - (if arg - (and (integerp arg) (< (abs arg) n)) ; Next or previous file (or none). - (not (save-excursion ; Fewer than two marked files. - (goto-char (point-min)) - (re-search-forward (dired-marker-regexp) nil t n))))) - -(defun diredp-fewer-than-2-files-p (arg) - "Return non-nil iff fewer than two files are to be treated by dired. -More precisely, return non-nil iff ARG is nil and fewer than two -files are marked, or ARG is -1, 0 or 1." - (diredp-fewer-than-N-files-p arg 2)) - -(defun diredp-fewer-than-echo-limit-files-p (arg) - "Return non-nil iff < `diredp-do-report-echo-limit' files marked. -More precisely, return non-nil iff ARG is nil and fewer than two -files are marked, or ARG is -1, 0 or 1." - (diredp-fewer-than-N-files-p arg diredp-do-report-echo-limit)) - -;;;###autoload -(defun diredp-do-apply-function (function &optional arg) ; Bound to `@' - "Apply FUNCTION to the marked files. -You are prompted for the FUNCTION. - -With a plain prefix ARG (`C-u'), visit each file and invoke FUNCTION - with no arguments. -Otherwise, apply FUNCTION to each file name. - -Any prefix arg other than single `C-u' behaves according to the ARG -argument of `dired-get-marked-files'. In particular, `C-u C-u' -operates on all files in the Dired buffer. - -The result returned for each file is logged by `dired-log'. Use `?' -to see all such results and any error messages. If there are fewer -marked files than `diredp-do-report-echo-limit' then each result is -also echoed momentarily." - (interactive (progn (diredp-ensure-mode) - (list (read (completing-read "Function: " obarray 'functionp nil nil - (and (boundp 'function-name-history) - 'function-name-history))) - current-prefix-arg))) - (let ((use-no-args-p (and (consp arg) (< (car arg) 16)))) - (when use-no-args-p (setq arg ())) - (save-selected-window - (diredp-map-over-marks-and-report - (if use-no-args-p #'diredp-invoke-function-no-args #'diredp-apply-function-to-file-name) - arg - 'apply\ function (diredp-fewer-than-2-files-p arg) - function - (diredp-fewer-than-echo-limit-files-p arg))))) - -(defun diredp-invoke-function-no-args (fun &optional echop) - "Visit file of this line at its beginning, then invoke function FUN. -No arguments are passed to FUN. -Log the result returned or any error. -Non-nil optional arg ECHOP means also echo the result." - (let* ((file (dired-get-filename)) - (failure (not (file-exists-p file))) - result) - (unless failure - (condition-case err - (with-current-buffer (find-file-noselect file) - (save-excursion - (goto-char (point-min)) - (setq result (funcall fun)))) - (error (setq failure err)))) - (diredp-report-file-result file result failure echop))) - -(defun diredp-apply-function-to-file-name (fun &optional echop) - "Apply function FUN to (absolute) file name on this line. -Log the result returned or any error. -Non-nil optional arg ECHOP means also echo the result." - (let ((file (dired-get-filename)) - (failure nil) - result) - (condition-case err - (setq result (funcall fun file)) - (error (setq failure err))) - (diredp-report-file-result file result failure echop))) - - -;; REPLACE ORIGINAL in `dired-aux.el'. -;; -;; 1. Redisplay only if at most one file is being treated. -;; 2. Doc string reflects `Dired+'s version of `dired-map-over-marks-check'. -;; -;;;###autoload -(defun dired-do-compress (&optional arg) ; Bound to `Z' - "Compress or uncompress marked (or next prefix argument) files. -A prefix argument ARG specifies files to use instead of marked. - An integer means use the next ARG files (previous -ARG, if < 0). - `C-u': Use the current file (whether or not any are marked). - `C-u C-u': Use all files in Dired, except directories. - `C-u C-u C-u': Use all files and directories, except `.' and `..'. - `C-u C-u C-u C-u': Use all files and all directories." - (interactive "P") - (dired-map-over-marks-check #'dired-compress arg 'compress (diredp-fewer-than-2-files-p arg))) - - -;; REPLACE ORIGINAL in `dired-aux.el'. -;; -;; 1. Redisplay only if at most one file is being treated. -;; 2. Doc string reflects `Dired+'s version of `dired-map-over-marks-check'. -;; -;;;###autoload -(defun dired-do-byte-compile (&optional arg) ; Bound to `B' - "Byte compile marked Emacs Lisp files. -A prefix argument ARG specifies files to use instead of those marked. - * An integer means use the next ARG files (previous -ARG, if < 0). - * Two or more `C-u' (e.g. `C-u C-u') means ignore any marks and use - all files in the Dired buffer. - * Any other prefix arg means use the current file." - (interactive (let* ((arg current-prefix-arg) - (C-u (and (consp arg) arg))) - (when (and C-u (> (prefix-numeric-value arg) 16)) (setq arg '(16))) - (list arg))) - (dired-map-over-marks-check #'dired-byte-compile arg 'byte-compile - (diredp-fewer-than-2-files-p arg))) - - -;; REPLACE ORIGINAL in `dired-aux.el'. -;; -;; 1. Redisplay only if at most one file is being treated. -;; 2. Doc string reflects `Dired+' version of `dired-map-over-marks-check'. -;; -;;;###autoload -(defun dired-do-load (&optional arg) ; Bound to `L' - "Load the marked Emacs Lisp files. -A prefix argument ARG specifies files to use instead of those marked. - * An integer means use the next ARG files (previous -ARG, if < 0). - * Two or more `C-u' (e.g. `C-u C-u') means ignore any marks and use - all files in the Dired buffer. - * Any other prefix arg means use the current file." - (interactive (let* ((arg current-prefix-arg) - (C-u (and (consp arg) arg))) - (when (and C-u (> (prefix-numeric-value arg) 16)) (setq arg '(16))) - (list arg))) - (dired-map-over-marks-check #'dired-load arg 'load (diredp-fewer-than-2-files-p arg))) - - -(when (fboundp 'multi-isearch-files) - - ;; REPLACE ORIGINAL in `dired.el': - ;; - ;; 1. Added optional arg ARG, so you can act on next ARG files or on all files. - ;; 2. Added optional arg INTERACTIVEP. - ;; 3. Do not raise error if no files when not INTERACTIVEP. - ;; - (defun dired-do-isearch (&optional arg interactivep) - "Search for a string through all marked files using Isearch. -A prefix argument ARG specifies files to use instead of those marked. - * An integer means use the next ARG files (previous -ARG, if < 0). - * Two or more `C-u' (e.g. `C-u C-u') means ignore any marks and use - all files in the Dired buffer. - * Any other prefix arg means use the current file. -When invoked interactively, raise an error if no files are marked." - (interactive (let* ((arg current-prefix-arg) - (C-u (and (consp arg) arg))) - (when (and C-u (> (prefix-numeric-value arg) 16)) (setq arg '(16))) - (list arg t))) - (multi-isearch-files (dired-get-marked-files nil arg 'dired-nondirectory-p nil interactivep))) - - - ;; REPLACE ORIGINAL in `dired.el': - ;; - ;; 1. Added optional arg ARG, so you can act on next ARG files or on all files. - ;; 2. Added optional arg INTERACTIVEP. - ;; 3. Do not raise error if no files when not INTERACTIVEP. - ;; - (defun dired-do-isearch-regexp (&optional arg interactivep) - "Search for a regexp through all marked files using Isearch. -A prefix arg behaves as follows: - * An integer means use the next ARG files (previous -ARG, if < 0). - * Two or more `C-u' (e.g. `C-u C-u') means ignore any marks and use - all files in the Dired buffer. - * Any other prefix arg means use the current file. -When invoked interactively, raise an error if no files are marked." - (interactive (let* ((arg current-prefix-arg) - (C-u (and (consp arg) arg))) - (when (and C-u (> (prefix-numeric-value arg) 16)) (setq arg '(16))) - (list arg t))) - (multi-isearch-files-regexp (dired-get-marked-files nil arg 'dired-nondirectory-p nil interactivep))) - - ) - - -;; REPLACE ORIGINAL in `dired-aux.el': -;; -;; 1. Added optional arg ARG, so you can act on next ARG files or on all files. -;; 2. Added optional arg INTERACTIVEP. -;; 3. Do not raise error if no files when not INTERACTIVEP. -;; -;;;###autoload -(defun dired-do-search (regexp &optional arg interactivep) - "Search through all marked files for a match for REGEXP. -Stops when a match is found. -To continue searching for next match, use command \\[tags-loop-continue]. - -A prefix arg behaves as follows: - * An integer means use the next ARG files (previous -ARG, if < 0). - * Two or more `C-u' (e.g. `C-u C-u') means ignore any marks and use - all files in the Dired buffer. - * Any other prefix arg means use the current file. - -When invoked interactively, raise an error if no files are marked." - (interactive (let* ((arg current-prefix-arg) - (C-u (and (consp arg) arg))) - (when (and C-u (> (prefix-numeric-value arg) 16)) (setq arg '(16))) - (list (diredp-read-regexp "Search marked files (regexp): ") - arg - t))) - (tags-search regexp `(dired-get-marked-files nil ',arg 'dired-nondirectory-p nil ,interactivep))) - - -;; REPLACE ORIGINAL in `dired-aux.el': -;; -;; 1. Added optional arg ARG, so you can act on next ARG files or on all files. -;; 2. Added optional arg INTERACTIVEP. -;; 3. Do not raise error if no files when not INTERACTIVEP. -;; -;;;###autoload -(defun dired-do-query-replace-regexp (from to &optional arg interactivep) - "Do `query-replace-regexp' of FROM with TO, on all marked files. -NOTE: A prefix arg for this command acts differently than for other -commands, so that you can use it to request word-delimited matches. - -With a prefix argument: - * An odd number of plain `C-u': act on the marked files, but replace - only word-delimited matches. - * More than one plain `C-u': act on all files, ignoring whether any - are marked. - * Any other prefix arg: Act on the next numeric-prefix files. - -So for example: - * `C-u C-u C-u': act on all files, replacing word-delimited matches. - * `C-u 4': act on the next 4 files. `C-4' means the same thing. - * `C-u': act on the marked files, replacing word-delimited matches. - -When invoked interactively, raise an error if no files are marked. - -If you exit (\\[keyboard-quit], RET or q), you can resume the query replace -with the command \\[tags-loop-continue]." - (interactive (let ((common (query-replace-read-args "Query replace regexp in marked files" t t))) - (list (nth 0 common) - (nth 1 common) - current-prefix-arg - t))) - (let* ((argnum (and (consp arg) (prefix-numeric-value arg))) - (delimited (and argnum (eq (logand (truncate (log argnum 4)) 1) 1))) ; Odd number of plain `C-u'. - (all (and argnum (> argnum 4))) ; At least 3 plain `C-u'. - (dgmf-arg (dired-get-marked-files nil - (if (and arg (atom arg)) (abs arg) (and all '(16))) - 'dired-nondirectory-p - nil - interactivep))) - (dolist (file dgmf-arg) - (let ((buffer (get-file-buffer file))) - (when (and buffer (with-current-buffer buffer buffer-read-only)) - (error "File `%s' is visited read-only" file)))) - (tags-query-replace from to delimited `',dgmf-arg))) - - -(when (fboundp 'xref-collect-matches) ; Emacs 25+ - - - ;; REPLACE ORIGINAL in `dired-aux.el': - ;; - ;; 1. Added optional arg ARG, so you can act on next ARG files or on all files. - ;; 2. Added optional arg INTERACTIVEP. - ;; 3. Do not raise error if no files when not INTERACTIVEP. - ;; - (defun dired-do-find-regexp (regexp &optional arg interactivep) - "Find all matches for REGEXP in all marked files. -For any marked directory, all of its files are searched recursively. -However, files matching `grep-find-ignored-files' and subdirectories -matching `grep-find-ignored-directories' are skipped in the marked -directories. - -A prefix arg behaves as follows: - * An integer means use the next ARG files (previous -ARG, if < 0). - * Two or more `C-u' (e.g. `C-u C-u') means ignore any marks and use - all files in the Dired buffer. - * Any other prefix arg means use the current file. - -When invoked interactively, raise an error if no files are marked. - -REGEXP should use constructs supported by your local `grep' command." - (interactive (let* ((arg current-prefix-arg) - (C-u (and (consp arg) arg))) - (when (and C-u (> (prefix-numeric-value arg) 16)) (setq arg '(16))) - (list (diredp-read-regexp "Search marked files (regexp): ") - arg - t))) - (require 'grep) - (defvar grep-find-ignored-files) - (defvar grep-find-ignored-directories) - (let* ((files (dired-get-marked-files nil arg nil nil interactivep)) - (ignores (nconc (mapcar (lambda (s) (concat s "/")) grep-find-ignored-directories) - grep-find-ignored-files)) - (xrefs (mapcan (lambda (file) - (xref-collect-matches - regexp "*" file (and (file-directory-p file) ignores))) - files))) - (if xrefs - (xref--show-xrefs xrefs nil t) - (when interactivep (diredp-user-error "No matches for: %s" regexp))))) - - - ;; REPLACE ORIGINAL in `dired-aux.el': - ;; - ;; 1. Added optional arg ARG, so you can act on next ARG files or on all files. - ;; 2. Added optional arg INTERACTIVEP. - ;; 3. Do not raise error if no files when not INTERACTIVEP. - ;; -;;;###autoload - (defun dired-do-find-regexp-and-replace (from to &optional arg interactivep) - "Replace matches of FROM with TO, in all marked files. -For any marked directory, matches in all of its files are replaced, -recursively. However, files matching `grep-find-ignored-files' -and subdirectories matching `grep-find-ignored-directories' are skipped -in the marked directories. - -A prefix arg behaves as follows: - * An integer means use the next ARG files (previous -ARG, if < 0). - * Two or more `C-u' (e.g. `C-u C-u') means ignore any marks and use - all files in the Dired buffer. - * Any other prefix arg means use the current file. - -When invoked interactively, raise an error if no files are marked. - -REGEXP should use constructs supported by your local `grep' command." - (interactive (let ((common (query-replace-read-args "Query replace regexp in marked files" t t)) - (arg current-prefix-arg) - (C-u (and (consp arg) arg))) - (when (and C-u (> (prefix-numeric-value arg) 16)) (setq arg '(16))) - (list (nth 0 common) - (nth 1 common) - arg - t))) - (with-current-buffer (dired-do-find-regexp from arg interactivep) - (xref-query-replace-in-results from to))) - - ) - -;;;###autoload -(defun diredp-do-grep (command-args) ; Bound to `C-M-G' - "Run `grep' on marked (or next prefix arg) files. -A prefix argument behaves according to the ARG argument of -`dired-get-marked-files'. In particular, `C-u C-u' operates on all -files in the Dired buffer." - (interactive (progn (unless (if (< emacs-major-version 22) - grep-command - (and grep-command (or (not grep-use-null-device) (eq grep-use-null-device t)))) - (grep-compute-defaults)) - (list (diredp-do-grep-1)))) - (grep command-args)) - -;; Optional arg FILES is no longer used. It was used in `diredp-do-grep' before the -;; new `dired-get-marked-files'. -(defun diredp-do-grep-1 (&optional files) - "Helper function for `diredp-do-grep'. -Non-nil optional arg FILES are the files to grep, overriding the files -choice described for `diredp-do-grep'." - (let ((default (and (fboundp 'grep-default-command) - (if (fboundp 'grepp-default-regexp-fn) ; In `grep+.el'. - (grep-default-command (funcall (grepp-default-regexp-fn))) - (grep-default-command))))) - (read-from-minibuffer - "grep : " - (let ((up-to-files (concat grep-command " "))) - (cons (concat up-to-files - (mapconcat #'identity - (or files (mapcar 'shell-quote-argument - (dired-get-marked-files nil current-prefix-arg))) - " ")) - (- (length up-to-files) 2))) - nil nil 'grep-history default))) - -(when (memq system-type '(windows-nt ms-dos)) - (define-derived-mode diredp-w32-drives-mode fundamental-mode "Drives" - "Mode for Dired buffer listing MS Windows drives (local or remote)." - (setq buffer-read-only t))) - -;; The next two commands were originally taken from Emacs Wiki, page WThirtyTwoBrowseNetDrives: -;; https://www.emacswiki.org/emacs/WThirtyTwoBrowseNetDrives. They are referred to there as -;; commands `show-net-connections' and `netdir'. I am hoping that the contributor (anonymous) -;; does not mind my adapting them and including them in `Dired+'. - -(when (memq system-type '(windows-nt ms-dos)) - (defun diredp-w32-list-mapped-drives () ; Not bound - "List network connection information for shared MS Windows resources. -This just invokes the Windows `NET USE' command." - (interactive) - (shell-command "net use") - (display-buffer "*Shell Command Output*"))) - -(when (memq system-type '(windows-nt ms-dos)) - (defun diredp-w32-drives (&optional other-window-p) ; Bound to `:/' - "Visit a list of MS Windows drives for use by Dired. -With a prefix argument use another window for the list. -In the list, use `mouse-2' or `RET' to open Dired for a given drive. - -The drives listed are the remote drives currently available, as -determined by the Windows command `NET USE', plus the local drives -specified by option `diredp-w32-local-drives', which you can -customize. - -Note: When you are in Dired at the root of a drive (e.g. directory - `C:/'), command `diredp-up-directory' invokes this command. - So you can use `\\[diredp-up-directory]' to go up to the list of drives." - (interactive "P") - (require 'widget) - (let ((drive (copy-sequence diredp-w32-local-drives)) - (inhibit-read-only t)) - (with-temp-buffer - (insert (shell-command-to-string "net use")) - (goto-char (point-min)) - (while (re-search-forward "[A-Z]: +\\\\\\\\[^ ]+" nil t nil) - (setq drive (cons (split-string (match-string 0)) drive)))) - (if other-window-p - (pop-to-buffer "*Windows Drives*") - (if (fboundp 'pop-to-buffer-same-window) - (pop-to-buffer-same-window "*Windows Drives*") - (switch-to-buffer "*Windows Drives*"))) - (erase-buffer) - (widget-minor-mode 1) - (dolist (drv (sort drive (lambda (a b) (string-lessp (car a) (car b))))) - (lexical-let ((drv drv)) - (widget-create 'push-button - :notify (lambda (widget &rest ignore) (dired (car drv))) - (concat (car drv) " " (cadr drv)))) - (widget-insert "\n")) - (goto-char (point-min)) - (diredp-w32-drives-mode)))) - -;; $$$$$$ NO LONGER USED. Was used in `diredp-do-grep(-1)' before new `dired-get-marked-files'. -(defun diredp-all-files () - "List of all files shown in current Dired buffer. -Directories are not included." - (let ((pos (make-marker)) - (files ()) - file) - (save-excursion - (goto-char (point-min)) (beginning-of-line) - (while (not (eobp)) - (beginning-of-line) - (while (and (not (eobp)) (dired-between-files)) (forward-line 1)) - (save-excursion (forward-line 1) (move-marker pos (1+ (point)))) - (setq file (dired-get-filename nil t)) ; Non-nil second arg means "also . and ..". - (when file ; Remove directory portion if in same directory. - (setq file (dired-get-filename (dired-in-this-tree file default-directory) t))) - (unless (or (not file) (file-directory-p file)) (push file files)) - (goto-char pos)) - (move-marker pos nil)) - (setq files (sort files (if (and (featurep 'ls-lisp) - (not (symbol-value 'ls-lisp-use-insert-directory-program))) - 'ls-lisp-string-lessp - (if case-fold-search - (lambda (s1 s2) (string-lessp (upcase s1) (upcase s2))) - 'string-lessp)))))) - -(when (fboundp 'read-char-choice) ; Emacs 24+ - - - ;; REPLACE ORIGINAL in `dired-aux.el' - ;; - ;; `l' lists the files involved and prompts again. - ;; - (defun dired-query (sym prompt &rest args) - "Format PROMPT with ARGS, query user, and store the result in SYM. -The return value is either nil or t. - -The user can type: - `y' or `SPC' to accept once - `n' or `DEL' to skip once - `!' to accept this and subsequent queries - `l' list the files, showing details per `diredp-list-file-attributes' - `q' or `ESC' to decline this and subsequent queries - -If SYM is already bound to a non-nil value, this function may return -automatically without querying the user. If SYM is `!', return t; if -SYM is `q' or ESC, return nil." - (let* ((char (symbol-value sym)) - (char-choices '(?y ?\ ?n ?\177 ?! ?l ?q ?\e)) ; Use ?\ , not ?\s, for Emacs 20 byte-compiler. - (list-buf (generate-new-buffer-name "*Files*")) - (list-was-shown nil)) - (unwind-protect - (cond ((eq char ?!) t) ; Accept, and don't ask again. - ((memq char '(?q ?\e)) nil) ; Skip, and don't ask again. - (t ; No previous answer - ask now - (setq prompt (concat (apply (if (fboundp 'format-message) #'format-message #'format) - prompt - args) - (if help-form - (format " [Type ynlq! or %s] " (key-description (vector help-char))) - " [Type y, n, l, q or !] "))) - (set sym (setq char (read-char-choice prompt char-choices))) - (when (eq char ?l) ; List files and prompt again. - (diredp-list-files args nil nil nil diredp-list-file-attributes) - (set sym (setq char (read-char-choice prompt char-choices)))) - (and (memq char '(?y ?\ ?!)) t))) ; Use ?\ , not ?\s, for Emacs 20. - (when (get-buffer list-buf) - (save-window-excursion - (pop-to-buffer list-buf) - (condition-case nil ; Ignore error if user already deleted. - (if (one-window-p) (delete-frame) (delete-window)) - (error nil)) - (if list-was-shown (bury-buffer list-buf) (kill-buffer list-buf))))))) - - ) - -(unless (fboundp 'read-char-choice) ; Emacs 20-23 (modified the Emacs 23 version). Needs `dired-query-alist'. - - - ;; REPLACE ORIGINAL in `dired-aux.el' - ;; - ;; 1. `l' lists the files involved and prompts again. - ;; 2. Compatible with older Emacs versions (before Emacs 24): can use `dired-query-alist'. - ;; - (defun dired-query (qs-var qs-prompt &rest qs-args) - "Query user and return nil or t. -The user can type: - `y' or `SPC' to accept once - `n' or `DEL' to skip once - `!' to accept this and subsequent queries - `l' list the files, showing details per `diredp-list-file-attributes' - `q' or `ESC' to decline this and subsequent queries - -Store answer in symbol VAR (which must initially be bound to nil). -Format PROMPT with ARGS. -Binding variable `help-form' will help the user who types the help key." - (let* ((char (symbol-value qs-var)) - (dired-query-alist (cons '(?l . l) dired-query-alist)) - (action (cdr (assoc char dired-query-alist)))) - (cond ((eq 'yes action) t) ; Accept, and don't ask again. - ((eq 'no action) nil) ; Skip, and don't ask again. - (t ; No lasting effects from last time we asked - ask now. - (let ((cursor-in-echo-area t) - (executing-kbd-macro executing-kbd-macro) - (qprompt (concat qs-prompt - (if help-form - (format " [Type ynl!q or %s] " - (key-description (char-to-string help-char))) - " [Type y, n, l, q or !] "))) - done result elt) - (while (not done) - (apply #'message qprompt qs-args) - (setq char (set qs-var (read-event))) - (when (eq char ?l) ; List files and prompt again. - (diredp-list-files qs-args nil nil nil diredp-list-file-attributes) - (apply #'message qprompt qs-args) - (setq char (set qs-var (read-event)))) - (if (numberp char) - (cond ((and executing-kbd-macro (= char -1)) - ;; `read-event' returns -1 if we are in a keyboard macro and there are no more - ;; events in the macro. Try to get an event interactively. - (setq executing-kbd-macro nil)) - ((eq (key-binding (vector char)) 'keyboard-quit) (keyboard-quit)) - (t (setq done (setq elt (assoc char dired-query-alist))))))) - ;; Display the question with the answer. - (message "%s" (concat (apply #'format qprompt qs-args) (char-to-string char))) - (memq (cdr elt) '(t y yes))))))) - - ) - - -;; REPLACE ORIGINAL in `dired-aux.el'. -;; -;; 1. Use `diredp-this-subdir' instead of `dired-get-filename'. -;; 2. If on a subdir listing header line or a non-dir file in a subdir listing, go to -;; the line for the subdirectory in the parent directory listing. -;; 3. Fit one-window frame after inserting subdir. -;; -;;;###autoload -(defun dired-maybe-insert-subdir (dirname &optional switches no-error-if-not-dir-p) - ; Bound to `i' - "Move to Dired subdirectory line or subdirectory listing. -This bounces you back and forth between a subdirectory line and its -inserted listing header line. Using it on a non-directory line in a -subdirectory listing acts the same as using it on the subdirectory -header line. - -* If on a subdirectory line, then go to the subdirectory's listing, - creating it if not yet present. - -* If on a subdirectory listing header line or a non-directory file in - a subdirectory listing, then go to the line for the subdirectory in - the parent directory listing. - -* If on a non-directory file in the top Dired directory listing, do - nothing. - -Subdirectories are listed in the same position as for `ls -lR' output. - -With a prefix arg, you can edit the `ls' switches used for this -listing. Add `R' to the switches to expand the directory tree under a -subdirectory. - -Dired remembers the switches you specify with a prefix arg, so -reverting the buffer does not reset them. However, you might -sometimes need to reset some subdirectory switches after a -`dired-undo'. You can reset all subdirectory switches to the -default value using \\\\[dired-reset-subdir-switches]. See \ -Info node -`(emacs)Subdir switches' for more details." - (interactive (list (diredp-this-subdir) - (and current-prefix-arg - (read-string "Switches for listing: " - (or (and (boundp 'dired-subdir-switches) dired-subdir-switches) - dired-actual-switches))))) - (let ((opoint (point)) - (filename dirname)) - (cond ((consp filename) ; Subdir header line or non-directory file. - (setq filename (car filename)) - (if (assoc filename dired-subdir-alist) - (dired-goto-file filename) ; Subdir header line. - (dired-insert-subdir (substring (file-name-directory filename) 0 -1)))) - (t - ;; We don't need a marker for opoint as the subdir is always - ;; inserted *after* opoint. - (setq dirname (file-name-as-directory dirname)) - (or (and (not switches) (dired-goto-subdir dirname)) - (dired-insert-subdir dirname switches no-error-if-not-dir-p)) - ;; Push mark so that it's easy to go back. Do this after the - ;; insertion message so that the user sees the `Mark set' message. - (push-mark opoint) - (when (and (get-buffer-window (current-buffer)) ; Fit one-window frame. - (fboundp 'fit-frame-if-one-window)) ; In `autofit-frame.el'. - (fit-frame-if-one-window)))))) - -(defun diredp-this-subdir () - "This line's filename, if directory, or `dired-current-directory' list. -If on a directory line, then return the directory name. -Else return a singleton list of a directory name, which is as follows: - If on a subdirectory header line (either of the two lines), then use - that subdirectory name. Else use the parent directory name." - (or (let ((file (dired-get-filename nil t))) - (and file - (file-directory-p file) - (not (member (file-relative-name file (file-name-directory (directory-file-name file))) - '("." ".." "./" "../"))) - file)) - (list (dired-current-directory)))) - - -;; REPLACE ORIGINAL in `dired-aux.el' -;; -;; 1. Added optional arg FROM, which is also listed by `l' when prompted. -;; 2. Added missing doc string. -;; -(defun dired-handle-overwrite (to &optional from) - "Save old version of file TO that is to be overwritten. -`dired-overwrite-confirmed' and `overwrite-backup-query' are fluid vars -from `dired-create-files'. - -Optional arg FROM is a file being copied or renamed to TO. It is used -only when a user hits `l' to list files when asked whether to -overwrite." - (let (backup) - (when (and dired-backup-overwrite - dired-overwrite-confirmed - (setq backup (car (find-backup-file-name to))) - (or (eq 'always dired-backup-overwrite) - (dired-query 'overwrite-backup-query "Make backup for existing file `%s'? " to from))) - (rename-file to backup 0) ; Confirm overwrite of old backup. - (dired-relist-entry backup)))) - - -(when (fboundp 'dired-copy-file-recursive) ; Emacs 22+ - - - ;; REPLACE ORIGINAL in `dired-aux.el' - ;; - ;; 1. Pass also FROM to `dired-handle-overwrite', so `l' lists it too. - ;; 2. Added missing doc string. - ;; - (defun dired-copy-file (from to ok-if-already-exists) - "Copy file FROM to location TO. -Non-nil arg OK-IF-ALREADY-EXISTS is passed to `copy-file' or - `make-symbolic-link'. -Preserves the last-modified date when copying, unless -`dired-copy-preserve-time' is nil." - (dired-handle-overwrite to from) - (dired-copy-file-recursive from to ok-if-already-exists dired-copy-preserve-time t dired-recursive-copies)) - - - ;; REPLACE ORIGINAL in `dired-aux.el' - ;; - ;; 1. Pass also FROM to `dired-handle-overwrite', so `l' lists it too. - ;; 2. Added missing doc string. - ;; - (defun dired-copy-file-recursive (from to ok-if-already-exists &optional keep-time top recursive) - "Copy file FROM to location TO, handling directories in FROM recursively. -Non-nil arg OK-IF-ALREADY-EXISTS is passed to `copy-file' or - `make-symbolic-link'. -Non-nil optional arg KEEP-TIME is passed to `copy-file' or - `copy-directory'. -Non-nil optional arg TOP means do not bother with `dired-handle-overwrite'. -Non-nil optional arg RECURSIVE means recurse on any directories in - FROM, after confirmation if RECURSIVE is not `always'." - (when (and (eq t (car (file-attributes from))) (file-in-directory-p to from)) - (error "Cannot copy `%s' into its subdirectory `%s'" from to)) - (let ((attrs (file-attributes from))) - (if (and recursive - (eq t (car attrs)) - (or (eq recursive 'always) (yes-or-no-p (format "Recursive copies of %s? " from)))) - (copy-directory from to keep-time) - (or top (dired-handle-overwrite to from)) - (condition-case err - (if (stringp (car attrs)) ; It is a symlink - (make-symbolic-link (car attrs) to ok-if-already-exists) - (copy-file from to ok-if-already-exists keep-time)) - (file-date-error - (push (dired-make-relative from) dired-create-files-failures) - (dired-log "Can't set date on %s:\n%s\n" from err)))))) - - ) - - -;; REPLACE ORIGINAL in `dired-aux.el' -;; -;; 1. Pass also FILE to `dired-handle-overwrite', so `l' lists it too. -;; 2. Added missing doc string. -;; -(defun dired-rename-file (file newname ok-if-already-exists) - "Rename FILE to NEWNAME. -Non-nil arg OK-IF-ALREADY-EXISTS is passed to `rename-file'." - (dired-handle-overwrite newname file) - (rename-file file newname ok-if-already-exists) ; Error is caught in `-create-files'. - ;; Silently rename the visited file of any buffer visiting this file. - (and (get-file-buffer file) (with-current-buffer (get-file-buffer file) (set-visited-file-name newname nil t))) - (dired-remove-file file) - ;; See if it's an inserted subdir, and rename that, too. - (dired-rename-subdir file newname)) - - -;; REPLACE ORIGINAL in `dired-aux.el' -;; -;; Pass also FILE to `dired-handle-overwrite', so `l' lists it too. -;; -(defun dired-hardlink (file newname &optional ok-if-already-exists) - "Give FILE additional name NEWNAME. -Non-nil arg OK-IF-ALREADY-EXISTS is passed to `add-name-to-file'." - (dired-handle-overwrite newname file) - (add-name-to-file file newname ok-if-already-exists) ; Error is caught in -create-files'. - (dired-relist-file file)) ; Update the link count. - - -;; REPLACE ORIGINAL in `dired.el'. -;; -;; No-op: does nothing now. -;; -(defun dired-insert-subdir-validate (dirname &optional switches)) - - -;;; $$$$$$$$ -;;; ;; REPLACE ORIGINAL in `dired-aux.el'. -;;; ;; -;;; ;; 1. Do not require that DIRNAME be in the current directory tree (no error if not). -;;; ;; 2. Use `dolist' instead of `mapcar'. -;;; ;; -;;; (defun dired-insert-subdir-validate (dirname &optional switches) -;;; "Raise an error if it is invalid to insert DIRNAME with SWITCHES." -;;; ;;; (or (dired-in-this-tree dirname (expand-file-name default-directory)) ; REMOVED -;;; ;;; (error "%s: not in this directory tree" dirname)) -;;; (let ((real-switches (or switches (and (boundp 'dired-subdir-switches) ; Emacs 22+ -;;; dired-subdir-switches)))) -;;; (when real-switches -;;; (let (case-fold-search) -;;; (dolist (switchs '("F" "b")) ; Switches that matter for `dired-get-filename'. -;;; (unless (eq (null (diredp-string-match-p switchs real-switches)) -;;; (null (diredp-string-match-p switchs dired-actual-switches))) -;;; (error "Can't have dirs with and without `-%s' switches together" switchs))))))) - - -;; REPLACE ORIGINAL in `dired-aux.el'. -;; -;; If NEW-DIR is not a descendant of a directory in the buffer, put it at eob. -;; -(defun dired-insert-subdir-newpos (new-dir) - "Move to the proper position for inserting NEW-DIR, and return it. -Respect the order within each directory tree. But if NEW-DIR is not a -descendant of any directory in the buffer, then put it at the end." - (let ((alist dired-subdir-alist) - elt dir new-pos) - (while alist - (setq elt (car alist) - alist (cdr alist) - dir (car elt)) - (if (dired-tree-lessp dir new-dir) - (setq new-pos (dired-get-subdir-max elt) ; Position NEW-DIR after DIR. - alist ()) - (setq new-pos (point-max)))) - (goto-char new-pos)) - (unless (eobp) (forward-line -1)) - (insert "\n") - (point)) - - -;; This is like original `dired-hide-subdir' in `dired-aux.el', except: -;; -;; 1. Plain prefix arg means invoke `dired-hide-all'. Added optional arg NEXT. -;; 2. Do not move to the next subdir. -;; 3. Modified to work with also with older Emacs versions. -;; -(defun diredp-hide-subdir-nomove (arg &optional next) - "Hide or unhide the current directory. -Unlike `dired-hide-subdir', this does not advance the cursor to the -next directory header line. - -With a plain prefix arg (`C-u'), invoke `dired-hide-all' to hide or - show everything. -With a numeric prefix arg N, hide this subdirectory and the next N-1 - subdirectories." - (interactive "P") - (dired-hide-check) - (if (consp arg) - (dired-hide-all 'IGNORED) ; Arg needed for older Emacs versions. - (setq arg (prefix-numeric-value arg)) - (let ((modflag (buffer-modified-p))) - (while (>= (setq arg (1- arg)) 0) - (let* ((cur-dir (dired-current-directory)) - (hidden-p (dired-subdir-hidden-p cur-dir)) - (elt (assoc cur-dir dired-subdir-alist)) - (end-pos (1- (dired-get-subdir-max elt))) - buffer-read-only) - (goto-char (dired-get-subdir-min elt)) ; Keep header line visible, hide rest - (skip-chars-forward "^\n\r") - (if hidden-p - (subst-char-in-region (point) end-pos ?\r ?\n) - (subst-char-in-region (point) end-pos ?\n ?\r))) - (when next (dired-next-subdir 1 t))) - (if (fboundp 'restore-buffer-modified-p) - (restore-buffer-modified-p modflag) - (set-buffer-modified-p modflag))))) - -;;; ---------------------- -;;; If we instead renamed `diredp-hide-subdir-nomove' to `dired-hide-subdir' as a replacement, -;;; then we would define things this way: -;;; -;;; -;;; ;; REPLACE ORIGINAL in `dired-aux.el'. -;;; ;; -;;; ;; 1. Plain prefix arg means invoke `dired-hide-all'. Added optional arg NEXT. -;;; ;; -;;; ;; 2. Do not move to the next subdir. -;;; ;; -;;; ;; 3. Modified to work with also with older Emacs versions. -;;; ;; -;;; (defun dired-hide-subdir (arg &optional next) -;;; "Hide or unhide the current directory. -;;; Unlike `diredp-hide-subdir-goto-next', this does not advance the -;;; cursor to the next directory header line. -;;; -;;; With a plain prefix arg (`C-u'), invoke `dired-hide-all' to hide or -;;; show everything. -;;; With a numeric prefix arg N, hide this subdirectory and the next N-1 -;;; subdirectories." -;;; (interactive "P") -;;; (dired-hide-check) -;;; (if (consp arg) -;;; (dired-hide-all 'IGNORED) ; Arg needed for older Emacs versions. -;;; (setq arg (prefix-numeric-value arg)) -;;; (let ((modflag (buffer-modified-p))) -;;; (while (>= (setq arg (1- arg)) 0) -;;; (let* ((cur-dir (dired-current-directory)) -;;; (hidden-p (dired-subdir-hidden-p cur-dir)) -;;; (elt (assoc cur-dir dired-subdir-alist)) -;;; (end-pos (1- (dired-get-subdir-max elt))) -;;; buffer-read-only) -;;; (goto-char (dired-get-subdir-min elt)) ; Keep header line visible, hide rest -;;; (skip-chars-forward "^\n\r") -;;; (if hidden-p -;;; (subst-char-in-region (point) end-pos ?\r ?\n) -;;; (subst-char-in-region (point) end-pos ?\n ?\r))) -;;; (when next (dired-next-subdir 1 t))) -;;; (if (fboundp 'restore-buffer-modified-p) -;;; (restore-buffer-modified-p modflag) -;;; (set-buffer-modified-p modflag))))) -;;; -;;; (defun diredp-hide-subdir-goto-next (arg) -;;; "Hide or unhide current directory and move to next directory header line." -;;; (interactive "P") -;;; (dired-hide-subdir arg 'NEXT)) -;;; ---------------------- - - -;; REPLACE ORIGINAL in `dired-x.el'. -;; -;; Fix the `interactive' spec. This is the Emacs 24+ version, provided for earlier versions. -;; -(unless (> emacs-major-version 23) - (defun dired-mark-unmarked-files (regexp msg &optional unflag-p localp) - "Mark unmarked files matching REGEXP, displaying MSG. -REGEXP is matched against the entire file name. When called -interactively, prompt for REGEXP. -With prefix argument, unflag all those files. - -Non-interactively: - Returns t if any work was done, nil otherwise. - Optional fourth argument LOCALP is as in `dired-get-filename'." - (interactive (list (diredp-read-regexp "Mark unmarked files matching regexp (default all): ") - nil - current-prefix-arg - nil)) - (let ((dired-marker-char (if unflag-p ?\ dired-marker-char)) - (unmarkedp (eq (char-after) ?\ ))) - (diredp-mark-if (and (if unflag-p (not unmarkedp) unmarkedp) ; Fixes Emacs bug #27465. - (let ((fn (dired-get-filename localp 'NO-ERROR))) ; Uninteresting - (and fn (diredp-string-match-p regexp fn)))) - msg)))) - - -;; REPLACE ORIGINAL in `dired-x.el'. -;; -;; 1. Call `dired-get-marked-files' with original ARG, to get its multi-`C-u' behavior. -;; 2. Doc string updated to reflect change to `dired-simultaneous-find-file'. -;; 3. Added optional arg INTERACTIVEP. -;; 4. Do not raise error if no files when not INTERACTIVEP. -;; -;;;###autoload -(defun dired-do-find-marked-files (&optional arg interactivep) ; Bound to `F' - "Find marked files, displaying all of them simultaneously. -With no prefix argument: - -* If `pop-up-frames' is nil then split the current window across all - marked files, as evenly as possible. Remaining lines go to the - bottom-most window. The number of files that can be displayed this - way is restricted by the height of the current window and - `window-min-height'. - -* If `pop-up-frames' is non-nil then show each marked file in a - separate frame (not window). - -With a prefix argument: - -* One or more plain `C-u' behaves as for `dired-get-marked-files'. - In particular, `C-u C-u' means ignore any markings and operate on - ALL files and directories (except `.' and `..') in the Dired buffer. - -* A numeric prefix arg >= 0 means just find (visit) the marked files - - do not show them. - -* A numeric prefix arg < 0 means show each marked file in a separate - frame (not window). (This is the same behavior as no prefix arg - with non-nil `pop-up-frames'.) - -Note that a numeric prefix argument acts differently with this command -than it does with other `dired-do-*' commands: it does NOT act on the -next or previous (abs ARG) files, ignoring markings. - -To keep the Dired buffer displayed, split the window (e.g., `C-x 2') -first. To show only the marked files, type `\\[delete-other-windows]' first. - -When invoked interactively, raise an error if no files are marked." - (interactive "P\np") - (dired-simultaneous-find-file - (dired-get-marked-files nil (and (consp arg) arg) nil nil interactivep) - (and arg (prefix-numeric-value arg)))) - - -;; REPLACE ORIGINAL in `dired-x.el'. -;; -;; Use separate frames instead of windows if `pop-up-frames' is non-nil, -;; or if prefix arg is negative. -;; -(defun dired-simultaneous-find-file (file-list option) - "Visit all files in list FILE-LIST and display them simultaneously. -With non-nil OPTION >= 0, the files are found (visited) but not shown. - -If `pop-up-frames' is non-nil or if OPTION < 0, use a separate frame -for each file. (See also option `diredp-max-frames'.) - -Otherwise, the current window is split across all files in FILE-LIST, -as evenly as possible. Remaining lines go to the bottom-most window. -The number of files that can be displayed this way is restricted by -the height of the current window and the value of variable -`window-min-height'." - ;; This is not interactive because it is usually too clumsy to specify FILE-LIST interactively unless via dired. - (let (size) - (cond ((and option (natnump option)) - (while file-list (find-file-noselect (car file-list)) (pop file-list))) - ((or pop-up-frames option) - (let ((nb-files (length file-list))) - (when (and (> nb-files diredp-max-frames) - (not (y-or-n-p (format "Really show %d files in separate frames? " nb-files)))) - (error "OK, canceled")) - (while file-list (find-file-other-frame (car file-list)) (pop file-list)))) - (t - (setq size (/ (window-height) (length file-list))) - (when (> window-min-height size) (error "Too many files to show simultaneously")) - (find-file (car file-list)) - (pop file-list) - (while file-list - ;; Vertically split off a window of desired size. Upper window will have SIZE lines. - ;; Select lower (larger) window. We split it again. - (select-window (split-window nil size)) - (find-file (car file-list)) - (pop file-list)))))) - - -;;;;;; REPLACE ORIGINAL in both `dired.el' and `dired-x.el': -;;;;;; -;;;;;; 1. This incorporates the `dired-x.el' change to the `dired.el' -;;;;;; definition. This version works with or without using dired-x. -;;;;;; The `dired-x.el' version respects the var `dired-find-subdir'. -;;;;;; When `dired-find-subdir' is non-nil, this version is the same -;;;;;; as the `dired-x.el' version, except that a bug is corrected: -;;;;;; Whenever the argument to `dired-find-buffer-nocreate' is a cons, -;;;;;; the call to `dired-buffers-for-dir' gave a wrong type error. -;;;;;; This has been avoided by not respecting `dired-find-subdir' -;;;;;; whenever `dired-find-buffer-nocreate' is a cons. -;;;;;; For the case when `dired-find-subdir' is nil, see #2, below. -;;;;;; -;;;;;; 2. Unless `dired-find-subdir' is bound and non-nil: -;;;;;; If both DIRNAME and `dired-directory' are conses, then only -;;;;;; compare their cars (directories), not their explicit file lists -;;;;;; too. If equal, then update `dired-directory's file list to that -;;;;;; of DIRNAME. -;;;;;; -;;;;;; This prevents `dired-internal-noselect' (which is currently -;;;;;; `dired-find-buffer-nocreate's only caller) from creating a new -;;;;;; buffer in this case whenever a different set of files is present -;;;;;; in the cdr of DIRNAME and DIRNAME represents the same buffer as -;;;;;; `dired-directory'. -;;;;;; -;;;;;; If only one of DIRNAME and `dired-directory' is a cons, then -;;;;;; this returns nil. -;;;;;;;###autoload -;;;;(defun dired-find-buffer-nocreate (dirname &optional mode) -;;;; (let ((atomic-dirname-p (atom dirname))) -;;;; (if (and (boundp 'dired-find-subdir) dired-find-subdir atomic-dirname-p) -;;;; ;; This is the `dired-x.el' change: -;;;; (let* ((cur-buf (current-buffer)) -;;;; (buffers (nreverse (dired-buffers-for-dir dirname))) -;;;; (cur-buf-matches (and (memq cur-buf buffers) -;;;; ;; Files list (wildcards) must match, too: -;;;; (equal dired-directory dirname)))) -;;;; (setq buffers (delq cur-buf buffers)) ; Avoid using same buffer--- -;;;; (or (car (sort buffers (function dired-buffer-more-recently-used-p))) -;;;; (and cur-buf-matches cur-buf))) ; ---unless no other possibility. -;;;; ;; Comment from `dired.el': -;;;; ;; This differs from `dired-buffers-for-dir' in that it doesn't consider -;;;; ;; subdirs of `default-directory' and searches for the first match only. -;;;; (let ((blist dired-buffers) ; was (buffer-list) -;;;; found) -;;;; (or mode (setq mode 'dired-mode)) -;;;; (while blist -;;;; (if (null (buffer-name (cdr (car blist)))) -;;;; (setq blist (cdr blist)) -;;;; (save-excursion -;;;; (set-buffer (cdr (car blist))) -;;;; (if (not (and (eq major-mode mode) -;;;; ;; DIRNAME and `dired-directory' have the same dir, -;;;; ;; and if either of them has an explicit file list, -;;;; ;; then both of them do. In that case, update -;;;; ;; `dired-directory's file list from DIRNAME. -;;;; (if atomic-dirname-p -;;;; (and (atom dired-directory) ; Both are atoms. -;;;; (string= (file-truename dirname) -;;;; (file-truename dired-directory))) -;;;; (and (consp dired-directory) ; Both are conses. -;;;; (string= -;;;; (file-truename (car dirname)) -;;;; (file-truename (car dired-directory))) -;;;; ;; Update `dired-directory's file list. -;;;; (setq dired-directory dirname))))) -;;;; (setq blist (cdr blist)) -;;;; (setq found (cdr (car blist))) -;;;; (setq blist nil))))) -;;;; found)))) - - -;; REPLACE ORIGINAL in `dired-x.el'. -;; -;; Require confirmation. Fixes Emacs bug #13561. -;; -(defun dired-do-run-mail () - "If `dired-bind-vm' is non-nil, call `dired-vm', else call `dired-rmail'." - (interactive) - (unless (y-or-n-p "Read all marked mail folders? ") (error "OK, canceled")) - (if dired-bind-vm - ;; Read mail folder using vm. - (dired-vm) - ;; Read mail folder using rmail. - (dired-rmail))) - - -;; REPLACE ORIGINAL in `dired.el'. -;; -;; 1. Put `mouse-face' on whole line, not just file name. -;; 2. Add text property `dired-filename' to only the file name. -;; 3. Show image-file preview on mouseover, if `tooltip-mode' -;; and if `diredp-image-preview-in-tooltip'. -;; -(defun dired-insert-set-properties (beg end) - "Add various text properties to the lines in the region. -Highlight entire line upon mouseover. -Add text property `dired-filename' to the file name. -Handle `dired-hide-details-mode' invisibility spec (Emacs 24.4+)." - (let ((inhibit-field-text-motion t)) ; Just in case. - (save-excursion - (goto-char beg) - (while (< (point) end) - (condition-case nil - (cond ((dired-move-to-filename) - (add-text-properties (line-beginning-position) (line-end-position) - '(mouse-face highlight help-echo diredp-mouseover-help)) - (put-text-property - (point) (save-excursion (dired-move-to-end-of-filename) (point)) - 'dired-filename t) - (when (fboundp 'dired-hide-details-mode) ; Emacs 24.4+ - (put-text-property (+ (line-beginning-position) 1) (1- (point)) - 'invisible 'dired-hide-details-detail) - (dired-move-to-end-of-filename) - (when (< (+ (point) 4) (line-end-position)) - (put-text-property (+ (point) 4) (line-end-position) - 'invisible 'dired-hide-details-link)))) - ((fboundp 'dired-hide-details-mode) ; Emacs 24.4+ - (unless (or (diredp-looking-at-p "^$") (diredp-looking-at-p dired-subdir-regexp)) - (put-text-property (line-beginning-position) (1+ (line-end-position)) - 'invisible 'dired-hide-details-information)))) - (error nil)) - (forward-line 1))))) - -(defun diredp-mouseover-help (window buffer pos) - "Show `help-echo' help for a file name, in Dired. -If `tooltip-mode' is on and `diredp-image-preview-in-tooltip' says to -show an image preview, then do so. Otherwise, show text help." - (let ((image-dired-thumb-width (or (and (wholenump diredp-image-preview-in-tooltip) - diredp-image-preview-in-tooltip) - image-dired-thumb-width)) - (image-dired-thumb-height (or (and (wholenump diredp-image-preview-in-tooltip) - diredp-image-preview-in-tooltip) - image-dired-thumb-height)) - file) - (or (and (boundp 'tooltip-mode) tooltip-mode - (fboundp 'image-file-name-regexp) ; Emacs 22+, `image-file.el'. - diredp-image-preview-in-tooltip - (condition-case nil - (and (with-current-buffer buffer - (save-excursion (goto-char pos) - (diredp-string-match-p - (image-file-name-regexp) - (setq file (if (derived-mode-p 'dired-mode) - (dired-get-filename nil 'NO-ERROR) - ;; Make it work also for `diredp-list-files' listings. - (buffer-substring-no-properties (line-beginning-position) - (line-end-position))))))) - (or (not diredp-auto-focus-frame-for-thumbnail-tooltip-flag) - (progn (select-frame-set-input-focus (window-frame window)) t)) - (let ((img-file (if (eq 'full diredp-image-preview-in-tooltip) - file - (diredp-image-dired-create-thumb file)))) - (propertize " " 'display (create-image img-file)))) - (error nil))) - (if (fboundp 'describe-file) ; Library `help-fns+.el' - "mouse-2: visit in another window, C-h RET: describe" - "mouse-2: visit this file/dir in another window")))) - -;; `dired-hide-details-mode' enhancements. -(when (fboundp 'dired-hide-details-mode) ; Emacs 24.4+ - - (defun diredp-hide-details-if-dired () - "In Dired mode hide details. Outside Dired, do nothing." - (when (derived-mode-p 'dired-mode) (dired-hide-details-mode 1))) - - ;; Use `eval' of list so file byte-compiled in Emacs 20 will be OK in later versions. - (eval '(define-globalized-minor-mode global-dired-hide-details-mode - dired-hide-details-mode diredp-hide-details-if-dired)) - - (eval '(define-minor-mode dired-hide-details-mode - "Hide details in Dired mode." - (and diredp-hide-details-propagate-flag diredp-hide-details-last-state) - :group 'dired - (unless (derived-mode-p 'dired-mode) (error "Not a Dired buffer")) - (dired-hide-details-update-invisibility-spec) - (setq diredp-hide-details-toggled t) - (when diredp-hide-details-propagate-flag - (setq diredp-hide-details-last-state dired-hide-details-mode)) - (if dired-hide-details-mode - (add-hook 'wdired-mode-hook 'dired-hide-details-update-invisibility-spec nil t) - (remove-hook 'wdired-mode-hook 'dired-hide-details-update-invisibility-spec t)))) - - (defun diredp-hide/show-details () - "Hide/show details according to user options. -If `diredp-hide-details-propagate-flag' is non-nil and details have -never been hidden in the buffer, then hide/show according to your last -hide/show choice in any other Dired buffer or, if no last choice, -according to option `diredp-hide-details-initially-flag'." - (unless (or diredp-hide-details-toggled ; No op if hide/show already set. - (buffer-narrowed-p)) ; No-op when showing just newly copied file etc. - (cond (diredp-hide-details-propagate-flag - (dired-hide-details-mode (if diredp-hide-details-last-state 1 -1))) - (diredp-hide-details-initially-flag - (dired-hide-details-mode 1))))) - - (add-hook 'dired-after-readin-hook #'diredp-hide/show-details) - - (defun diredp-fit-frame-unless-buffer-narrowed () - "Fit frame unless Dired buffer is narrowed. -Requires library `autofit-frame.el'." - (when (and (get-buffer-window (current-buffer)) (not (buffer-narrowed-p))) - (fit-frame-if-one-window))) - - ;; Fit frame only if not narrowed. Put it on this hook because `dired-hide-details-mode' is - ;; invoked from `dired-after-readin-hook' via `diredp-hide/show-details', even for an update - ;; such as copying a file, where buffer is narrowed when invoked. - (when (fboundp 'fit-frame-if-one-window) ; In `autofit-frame.el'. - (add-hook 'dired-hide-details-mode-hook #'diredp-fit-frame-unless-buffer-narrowed))) - - -;; REPLACE ORIGINAL in `dired.el'. -;; -;; Reset `mode-line-process' to nil. -;; -(when (< emacs-major-version 21) - (or (fboundp 'old-dired-revert) (fset 'old-dired-revert (symbol-function 'dired-revert))) - (defun dired-revert (&optional arg noconfirm) - (setq mode-line-process nil) ; Set by, e.g., `find-dired'. - (old-dired-revert arg noconfirm))) - -;; Like `dired-up-directory', but go up to MS Windows drive if in top-level directory. -;; -;;;###autoload -(defun diredp-up-directory (&optional other-window) ; Bound to `^' - "Run Dired on parent directory of current directory. -Find the parent directory either in this buffer or another buffer. -Creates a buffer if necessary. - -With a prefix arg, Dired the parent directory in another window. - -On MS Windows, if you are already at the root directory, invoke -`diredp-w32-drives' to visit a navigable list of Windows drives." - (interactive "P") - (let* ((dir (dired-current-directory)) - (up (file-name-directory (directory-file-name dir)))) - (or (dired-goto-file (directory-file-name dir)) - ;; Only try `dired-goto-subdir' if buffer has more than one dir. - (and (cdr dired-subdir-alist) (dired-goto-subdir up)) - (progn (if other-window (dired-other-window up) (dired up)) - (dired-goto-file dir)) - (and (memq system-type '(windows-nt ms-dos)) (diredp-w32-drives other-window))))) - -;;;###autoload -(defun diredp-up-directory-reuse-dir-buffer (&optional other-window) ; Not bound - "Like `diredp-up-directory', but reuse Dired buffers. -With a prefix arg, Dired the parent directory in another window. - -On MS Windows, moving up from a root Dired buffer does not kill that -buffer (the Windows drives buffer is not really a Dired buffer)." - (interactive "P") - (let* ((dir (dired-current-directory)) - (dirfile (directory-file-name dir)) - (up (file-name-directory dirfile))) - (or (dired-goto-file dirfile) - ;; Only try `dired-goto-subdir' if buffer has more than one dir. - (and (cdr dired-subdir-alist) (dired-goto-subdir up)) ; It is a subdir inserted in current Dired. - (progn (diredp--reuse-dir-buffer-helper up nil nil other-window) - (dired-goto-file dir)) - (and (memq system-type '(windows-nt ms-dos)) (diredp-w32-drives other-window))))) - -;; Differs from `dired-next-line' in both wraparound and respect of `goal-column'. -;; -;;;###autoload -(defun diredp-next-line (arg) ; Bound to `SPC', `n', `C-n', `down' - "Move down lines then position cursor at filename. -If `goal-column' is non-nil then put the cursor at that column. -Optional prefix ARG says how many lines to move; default is one line. - -If `diredp-wrap-around-flag' is non-nil then wrap around if none is -found before the buffer end (buffer beginning, if ARG is negative). -Otherwise, just move to the buffer limit." - (interactive (let ((narg (prefix-numeric-value current-prefix-arg))) - (when (and (boundp 'shift-select-mode) shift-select-mode) (handle-shift-selection)) ; Emacs 23+ - (list narg))) ; Equivalent to "^p" - (let* ((line-move-visual nil) - ;; (goal-column nil) - - ;; Use `condition-case' and `(progn... t)' because Emacs < 22 `line-move' has no - ;; NO-ERROR arg and it always returns nil. - (no-more (or (not (condition-case nil (progn (line-move arg) t) (error nil))) - (if (< arg 0) (bobp) (eobp))))) - (when (and diredp-wrap-around-flag no-more) - (let ((diredp-wrap-around-flag nil)) - (goto-char (if (< arg 0) (point-max) (point-min))) - (diredp-next-line arg))) - ;; We never want to move point into an invisible line. - (while (and (fboundp 'invisible-p) ; Emacs 22+ - (invisible-p (point)) - (not (if (and arg (< arg 0)) (bobp) (eobp)))) - (forward-char (if (and arg (< arg 0)) -1 1))) - (unless goal-column (dired-move-to-filename)))) - -;; In Emacs < 22, `C-p' does not wrap around, because it never moves to the first header line. -;;;###autoload -(defun diredp-previous-line (arg) ; Bound to `p', `C-p', `up' - "Move up lines then position cursor at filename. -If `goal-column' is non-nil then put the cursor at that column. -Optional prefix ARG says how many lines to move; default is one line. - -If `diredp-wrap-around-flag' is non-nil then wrap around if none is -found before the buffer beginning (buffer end, if ARG is negative). -Otherwise, just move to the buffer limit." - (interactive (let ((narg (prefix-numeric-value current-prefix-arg))) - (when (and (boundp 'shift-select-mode) shift-select-mode) (handle-shift-selection)) ; Emacs 23+ - (list narg))) ; Equivalent to "^p" - (diredp-next-line (- (or arg 1)))) - -;;;###autoload -(defun diredp-next-dirline (arg &optional opoint) ; Bound to `>' - "Goto ARGth next directory file line. -If `diredp-wrap-around-flag' is non-nil then wrap around if none is -found before the buffer beginning (buffer end, if ARG is negative). -Otherwise, raise an error or, if NO-ERROR-IF-NOT-FOUND is nil, return -nil." - (interactive (let ((narg (prefix-numeric-value current-prefix-arg))) - (when (and (boundp 'shift-select-mode) shift-select-mode) (handle-shift-selection)) ; Emacs 23+ - (list narg))) ; Equivalent to "^p" - (or opoint (setq opoint (point))) - (if (if (> arg 0) - (re-search-forward dired-re-dir nil t arg) - (beginning-of-line) - (re-search-backward dired-re-dir nil t (- arg))) - (dired-move-to-filename) ; user may type `i' or `f' - (if diredp-wrap-around-flag - (let ((diredp-wrap-around-flag nil)) - (goto-char (if (< arg 0) (point-max) (point-min))) - (diredp-next-dirline arg opoint)) - (goto-char opoint) - (error "No more subdirectories")))) - -;;;###autoload -(defun diredp-prev-dirline (arg) ; Bound to `<' - "Goto ARGth previous directory file line." - (interactive (let ((narg (prefix-numeric-value current-prefix-arg))) - (when (and (boundp 'shift-select-mode) shift-select-mode) (handle-shift-selection)) ; Emacs 23+ - (list narg))) ; Equivalent to "^p" - (diredp-next-dirline (- arg))) - -;;;###autoload -(defun diredp-next-subdir (arg &optional no-error-if-not-found no-skip) ; Bound to `C-M-n' - "Go to the next subdirectory, regardless of level. -If ARG = 0 then go to this directory's header line. - -If `diredp-wrap-around-flag' is non-nil then wrap around if none is -found before the buffer end (buffer beginning, if ARG is negative). -Otherwise, raise an error or, if NO-ERROR-IF-NOT-FOUND is nil, return -nil. - -Non-nil NO-SKIP means do not move to end of header line, and return -the position moved to so far." - (interactive (let ((narg (prefix-numeric-value current-prefix-arg))) - (when (and (boundp 'shift-select-mode) shift-select-mode) (handle-shift-selection)) ; Emacs 23+ - (list narg))) ; Equivalent to "^p" - (let ((this-dir (dired-current-directory)) - pos index) - ;; `nth' with negative arg does not return nil but the first element - (setq index (if diredp-wrap-around-flag - (mod (- (dired-subdir-index this-dir) arg) (length dired-subdir-alist)) - (- (dired-subdir-index this-dir) arg)) - pos (and (>= index 0) (dired-get-subdir-min (nth index dired-subdir-alist)))) - (if pos - (progn (goto-char pos) - (or no-skip (skip-chars-forward "^\n\r")) - (point)) - (if no-error-if-not-found - nil ; Return nil if not found - (error "%s directory" (if (> arg 0) "Last" "First")))))) - -;;;###autoload -(defun diredp-prev-subdir (arg &optional no-error-if-not-found no-skip) ; Bound to `C-M-p' - "Go to the previous subdirectory, regardless of level. -When called interactively and not on a subdir line, go to this subdir's line. -Otherwise, this is a mirror image of `diredp-next-subdir'." - ;;(interactive "^p") - (interactive - (list (if current-prefix-arg - (let ((narg (prefix-numeric-value current-prefix-arg))) - (when (and (boundp 'shift-select-mode) shift-select-mode) (handle-shift-selection)) ; Emacs 23+ - narg) ; Equivalent to "^p" - ;; If on subdir start already then do not stay there. - (if (dired-get-subdir) 1 0)))) - (diredp-next-subdir (- arg) no-error-if-not-found no-skip)) - - -;; REPLACE ORIGINAL in `dired.el'. -;; -;; 1. Test also ./ and ../, in addition to . and .., for error "Cannot operate on `.' or `..'". -;; 2. Hack for Emacs 20-22, to expand `~/...'. -;; -(defun dired-get-filename (&optional localp no-error-if-not-filep) - "In Dired, return name of file mentioned on this line. -Value returned normally includes the directory name. - -Optional arg LOCALP: - `no-dir' means do not include directory name in result. - `verbatim' means return the name exactly as it occurs in the buffer. - Any other non-nil value means construct the name relative to - `default-directory', which still might contain slashes if point is - in a subdirectory. - -Non-nil optional arg NO-ERROR-IF-NOT-FILEP means treat `.' and `..' as -regular filenames and return nil if there is no filename on this line. -Otherwise, an error occurs in these cases." - (let ((case-fold-search nil) - (already-absolute nil) - file p1 p2) - (save-excursion (when (setq p1 (dired-move-to-filename (not no-error-if-not-filep))) - (setq p2 (dired-move-to-end-of-filename no-error-if-not-filep)))) - ;; nil if no file on this line but `no-error-if-not-filep' is t: - (when (setq file (and p1 p2 (buffer-substring p1 p2))) - ;; Get rid of the mouse-face property that file names have. - (set-text-properties 0 (length file) nil file) - - ;; Unquote names quoted by `ls' or by `dired-insert-directory'. - ;; Prior to Emacs 23.3, this code was written using `read' (see commented code below), - ;; because that is faster than substituting \007 (4 chars) -> ^G (1 char) etc. in a loop. - ;; Unfortunately, that implementation required hacks such as dealing with filenames - ;; with quotation marks in their names. - (while (string-match (if (> emacs-major-version 21) - "\\(?:[^\\]\\|\\`\\)\\(\"\\)" ; Shy group: Emacs 22+. - "\\([^\\]\\|\\`\\)\\(\"\\)") - file) - (setq file (replace-match "\\\"" nil t file 1))) - - ;; $$$ This was the code for that unquoting prior to Emacs 23.3: - ;; (setq file (read (concat "\"" ; Some `ls -b' do not escape quotes. But GNU `ls' is OK. - ;; (or (dired-string-replace-match - ;; "\\([^\\]\\|\\`\\)\"" file "\\1\\\\\"" nil t) - ;; file) - ;; "\""))) - - ;; This sexp was added by Emacs 24, to fix bug #10469: - ;; Unescape any spaces escaped by `ls -b'. - ;; Other `-b' quotes, such as \t and \n, work transparently. - (when (dired-switches-escape-p dired-actual-switches) - (let ((start 0) - (rep "") - (shift -1)) - (when (eq localp 'verbatim) (setq rep "\\\\" - shift +1)) - (while (string-match "\\(\\\\\\) " file start) - (setq file (replace-match rep nil t file 1) - start (+ shift (match-end 0)))))) - - ;; $$$ This sexp was added by Emacs 23.3. - (when (memq system-type '(windows-nt ms-dos)) - (save-match-data - (let ((start 0)) - (while (string-match "\\\\" file start) - (aset file (match-beginning 0) ?/) - (setq start (match-end 0)))))) - - ;; $$$ This sexp was added by Emacs 23.3. - ;; Hence we don't need to worry about converting `\\' back to `\'. - (setq file (read (concat "\"" file "\""))) - - ;; Above `read' returns a unibyte string if FILE contains eight-bit-control/graphic chars. - (when (and (fboundp 'string-to-multibyte) ; Emacs 22 - enable-multibyte-characters - (not (multibyte-string-p file))) - (setq file (string-to-multibyte file)))) - (and file - (file-name-absolute-p file) - ;; A relative file name can start with ~. Do not treat it as absolute in this context. - (not (eq (aref file 0) ?~)) - (setq already-absolute t)) - (cond ((null file) nil) - ((eq localp 'verbatim) file) - ;; This is the essential `Dired+' change: Added ./ and ../, not just . and .. - ((and (not no-error-if-not-filep) (member file '("." ".." "./" "../"))) - (error "Cannot operate on `.' or `..'")) - ((and (eq localp 'no-dir) already-absolute) - (file-name-nondirectory file)) - (already-absolute - (let ((handler (find-file-name-handler file nil))) - ;; check for safe-magic property so that we won't - ;; put /: for names that don't really need them. - ;; For instance, .gz files when auto-compression-mode is on. - (if (and handler (not (get handler 'safe-magic))) - (concat "/:" file) - file))) - ((eq localp 'no-dir) file) - ((equal (dired-current-directory) "/") - (setq file (concat (dired-current-directory localp) file)) - (let ((handler (find-file-name-handler file nil))) - ;; check for safe-magic property so that we won't - ;; put /: for names that don't really need them. - ;; For instance, .gz files when auto-compression-mode is on. - (if (and handler (not (get handler 'safe-magic))) - (concat "/:" file) - file))) - ;; Ugly hack for Emacs < 23, for which `ls-lisp-insert-directory' can insert a subdir - ;; using `~/...'. Expand `~/' for return value. - ((and (< emacs-major-version 23) file (file-name-absolute-p file) - (eq (aref file 0) ?~)) - (expand-file-name file)) - (t - (concat (dired-current-directory localp) file))))) - - -;; REPLACE ORIGINAL in `dired.el'. -;; -;; 1. Fixes Emacs bug #7126: Did not work with arbitrary file list (cons arg to `dired'). -;; 2. Remove `/' from directory name before comparing with BASE. -;; -(when (< emacs-major-version 24) - (defun dired-goto-file (file) ; Bound to `j' - "Go to line describing file FILE in this Dired buffer. -FILE must be an absolute file name. -Return buffer position on success, else nil." - ;; Loses if FILE contains control chars like "\007" for which `ls' inserts "?" or "\\007" - ;; into the buffer, so we won't find it in the buffer. - (interactive (prog1 ; Let push-mark display its message - (list (expand-file-name (read-file-name "Goto file: " (dired-current-directory)))) - (push-mark))) - (unless (file-name-absolute-p file) (error "File name `%s' is not absolute" file)) - (setq file (directory-file-name file)) ; does no harm if no directory - (let* ((case-fold-search nil) - (dir (file-name-directory file)) - (found nil)) - ;; `Dired+': Added this sexp. - (save-excursion - (goto-char (point-min)) - (let ((search-string (replace-regexp-in-string "\^m" "\\^m" file nil t)) - (here nil)) - (setq search-string (replace-regexp-in-string "\\\\" "\\\\" search-string nil t)) - - ;; Escape whitespace. Added per Emacs 24 addition in `unless' code below: - (when (and (dired-switches-escape-p dired-actual-switches) - (diredp-string-match-p "[ \t\n]" search-string)) - ;; FIXME: fix this for all possible file names (embedded control chars etc). - ;; Need to escape everything that `ls -b' escapes. - (setq search-string (replace-regexp-in-string " " "\\ " search-string nil t) - search-string (replace-regexp-in-string "\t" "\\t" search-string nil t) - search-string (replace-regexp-in-string "\n" "\\n" search-string nil t))) - - ;; Use HERE to ensure we do not keep searching for a directory entry. - (while (and (not (eobp)) (not found) (not (equal here (point)))) - (setq here (point)) - (if (search-forward (concat " " search-string) nil 'NO-ERROR) - ;; Must move to filename since an (actually correct) match could have been - ;; elsewhere on the line (e.g. "-" would match somewhere in permission bits). - (setq found (dired-move-to-filename)) - ;; If this isn't the right line, move forward to avoid trying this line again. - (forward-line 1))))) - - (unless found - (save-excursion - ;; The difficulty here is to get the result of `dired-goto-subdir' without really - ;; calling it, if we don't have any subdirs. - (when (if (string= dir (expand-file-name default-directory)) - (goto-char (point-min)) - (and (cdr dired-subdir-alist) (dired-goto-subdir dir))) - (let ((base (file-name-nondirectory file)) - (boundary (dired-subdir-max)) - search-string) - (setq search-string (replace-regexp-in-string "\^m" "\\^m" base nil t) - search-string (replace-regexp-in-string "\\\\" "\\\\" search-string nil t)) - - ;; Escape whitespace. Sexp added by Emacs 24: - (when (and (dired-switches-escape-p dired-actual-switches) - (diredp-string-match-p "[ \t\n]" search-string)) - ;; FIXME: fix this for all possible file names (embedded control chars etc). - ;; Need to escape everything that `ls -b' escapes. - (setq search-string (replace-regexp-in-string " " "\\ " search-string nil t) - search-string (replace-regexp-in-string "\t" "\\t" search-string nil t) - search-string (replace-regexp-in-string "\n" "\\n" search-string nil t))) - (while (and (not found) - ;; Filenames are preceded by SPC. This makes the search faster - ;; (e.g. for the filename "-"!). - (search-forward (concat " " search-string) boundary 'move)) - ;; `Dired+': Remove `/' from filename, then compare with BASE. - ;; Match could have BASE just as initial substring or - ;; or in permission bits or date or not be a proper filename at all. - (if (and (dired-get-filename 'no-dir t) - (equal base (directory-file-name (dired-get-filename 'no-dir t)))) - ;; Must move to filename since an (actually correct) match could have been - ;; elsewhere on the line (e.g. "-" would match somewhere in permission bits). - (setq found (dired-move-to-filename)) - ;; If this is not the right line, move forward to avoid trying this line again. - (forward-line 1))))))) - (and found (goto-char found))))) ; Return buffer position, or nil if not found. - - -;; REPLACE ORIGINAL in `dired.el'. -;; -;; If destination is in a hidden dir listing, open that listing and move to destination in it. -;; -(unless (< emacs-major-version 24) - (defun dired-goto-file (file) - "Go to line describing file FILE in this Dired buffer. -FILE must be an absolute file name. -Return buffer position on success, else nil." - ;; Loses if FILE contains control chars like "\007" for which `ls' inserts "?" or "\\007" - ;; into the buffer, so we won't find it in the buffer. - (interactive (prog1 (list (expand-file-name (read-file-name "Goto file: " (dired-current-directory)))) - (push-mark))) ; Let push-mark display its message. - (unless (file-name-absolute-p file) (error "File name `%s' is not absolute" file)) - (setq file (directory-file-name file)) ; Does no harm if not a directory - (let* ((case-fold-search nil) - (dir (file-name-directory file)) - (found - (or - ;; First, look for a listing under the absolute name. - (save-excursion (goto-char (point-min)) (dired-goto-file-1 file file (point-max))) - ;; Else look for it as a relative name. The difficulty is to get the result - ;; of `dired-goto-subdir' without calling it, if we don't have any subdirs. - (save-excursion - (when (if (string= dir (expand-file-name default-directory)) - (goto-char (point-min)) - (and (cdr dired-subdir-alist) (dired-goto-subdir dir))) - (when (dired-subdir-hidden-p (dired-current-directory)) - (diredp-hide-subdir-nomove 1)) ; Open hidden parent directory. - (dired-goto-file-1 (file-name-nondirectory file) file (dired-subdir-max))))))) - (and found (goto-char found))))) ; Return buffer position, or nil if not found. - - -;; REPLACE ORIGINAL in `dired.el': -;; -;; 1. Display a message to warn that flagged, not marked, files will be deleted. -;; 2. Use `diredp-internal-do-deletions', so it works with all Emacs versions. -;; -;;;###autoload -(defun dired-do-flagged-delete (&optional no-msg) ; Bound to `x' - "In Dired, delete the files flagged for deletion. -NOTE: This deletes flagged, not marked, files. -If arg NO-MSG is non-nil, no message is displayed. - -User option `dired-recursive-deletes' controls whether deletion of -non-empty directories is allowed." - (interactive) - (unless no-msg - (ding) - (message "NOTE: Deletion of files flagged `%c' (not those marked `%c')" - dired-del-marker dired-marker-char) - ;; Too slow/annoying, but without it the message is never seen: (sit-for 2) - ) - (let* ((dired-marker-char dired-del-marker) - (regexp (dired-marker-regexp)) - (case-fold-search nil)) - (if (save-excursion (goto-char (point-min)) (re-search-forward regexp nil t)) - (diredp-internal-do-deletions - ;; This cannot move point since last arg is nil. - (dired-map-over-marks (cons (dired-get-filename) (point)) nil) - nil - 'USE-TRASH-CAN) ; This arg is for Emacs 24+ only. - (unless no-msg (message "(No deletions requested.)"))))) - - -;; REPLACE ORIGINAL in `dired.el': -;; -;; 1. Display a message to warn that marked, not flagged, files will be deleted. -;; 2. Use `diredp-internal-do-deletions', so it works with all Emacs versions. -;; -;;;###autoload -(defun dired-do-delete (&optional arg) ; Bound to `D' - "Delete all marked (or next ARG) files. -NOTE: This deletes marked, not flagged, files. -`dired-recursive-deletes' controls whether deletion of -non-empty directories is allowed." - (interactive "P") - ;; This is more consistent with the file-marking feature than - ;; `dired-do-flagged-delete'. But it can be confusing to the user, - ;; especially since this is usually bound to `D', which is also the - ;; `dired-del-marker'. So offer this warning message: - (unless arg - (ding) - (message "NOTE: Deletion of files marked `%c' (not those flagged `%c')." - dired-marker-char dired-del-marker)) - (diredp-internal-do-deletions - ;; This can move point if ARG is an integer. - (dired-map-over-marks (cons (dired-get-filename) (point)) arg) - arg - 'USE-TRASH-CAN)) ; This arg is for Emacs 24+ only. - -(defun diredp-internal-do-deletions (file-alist arg &optional trash) - "`dired-internal-do-deletions', but for any Emacs version. -FILE-ALIST is an alist of files to delete, with their buffer positions. -ARG is the prefix arg. Filenames are absolute. -Non-nil TRASH means use the trash can." - ;; \(car FILE-ALIST) *must* be the *last* (bottommost) file in the dired - ;; buffer. That way as changes are made in the buffer they do not shift - ;; the lines still to be changed, so the (point) values in FILE-ALIST - ;; stay valid. Also, for subdirs in natural order, a subdir's files are - ;; deleted before the subdir itself - the other way around would not work." - (setq file-alist (delq nil file-alist)) ; nils could come from `dired-map-over-marks'. - (if (> emacs-major-version 23) - (dired-internal-do-deletions file-alist arg trash) - (dired-internal-do-deletions file-alist arg))) - - -;; REPLACE ORIGINAL in `dired.el': -;; -;; Put window point at bob. Fixes bug #12281. -;; -(when (and (> emacs-major-version 22) (or (< emacs-major-version 24) - (and (= emacs-major-version 24) (= emacs-minor-version 1)))) - (defun dired-pop-to-buffer (buf) - "Pop up buffer BUF in a way suitable for Dired." - (let ((split-window-preferred-function - (lambda (window) - (or (and (let ((split-height-threshold 0)) (window-splittable-p (selected-window))) - ;; Try to split the selected window vertically if that's possible. (Bug#1806) - (if (fboundp 'split-window-below) (split-window-below) (split-window-vertically))) - (split-window-sensibly window)))) - pop-up-frames) - (pop-to-buffer (get-buffer-create buf))) - (set-window-start (selected-window) (point-min)) - (when dired-shrink-to-fit - ;; Try to not delete window when we want to display less than `window-min-height' lines. - (fit-window-to-buffer (get-buffer-window buf) nil 1)))) - - -;; REPLACE ORIGINAL in `dired.el': -;; -;; 1. Delete the window or frame popped up, afterward, and bury its buffer. -;; Fixes Emacs bug #7533. -;; -;; 2, If buffer is shown in a separate frame, do not show a menu bar for that frame. -;; -(defun dired-mark-pop-up (buffer-or-name op-symbol files function &rest args) - "Return FUNCTION's result on ARGS after showing which files are marked. -Displays the file names in a buffer named BUFFER-OR-NAME, the default -name being \" *Marked Files*\". The buffer is not shown if there is -just one file, `dired-no-confirm' is t, or OP-SYMBOL is a member of -the list in `dired-no-confirm'. Uses function `dired-pop-to-buffer' -to show the buffer. - -The window is not shown if there is just one file, `dired-no-confirm' -is `t', or OP-SYMBOL is a member of `dired-no-confirm'. - -FILES is the list of marked files. It can also be (t FILENAME) -in the case of one marked file, to distinguish that from using -just the current file. - -FUNCTION should not manipulate the files. It should just read input -\(an argument or confirmation)." - (unless buffer-or-name (setq buffer-or-name " *Marked Files*")) - (let (result) - (if (or (eq dired-no-confirm t) - (memq op-symbol dired-no-confirm) - ;; If FILES defaulted to the current line's file. - (= (length files) 1)) - (setq result (apply function args)) - (with-current-buffer (get-buffer-create buffer-or-name) - (erase-buffer) - ;; Handle (t FILE) just like (FILE), here. That value is used (only in some cases), - ;; to mean just one file that was marked, rather than the current-line file. - (dired-format-columns-of-files (if (eq (car files) t) (cdr files) files)) - (remove-text-properties (point-min) (point-max) - '(mouse-face nil help-echo nil))) - (unwind-protect - (save-window-excursion - ;; Do not show menu bar, if buffer is popped up in a separate frame. - (let ((special-display-frame-alist (cons '(menu-bar-lines . 0) - special-display-frame-alist)) - (default-frame-alist (cons '(menu-bar-lines . 0) - default-frame-alist))) - (dired-pop-to-buffer buffer-or-name) - ;; Work around Emacs 22 bug in `dired-pop-to-buffer', which can exit with Dired buffer current. - (set-buffer buffer-or-name) - (goto-char (point-min))) - (setq result (apply function args))) - (save-excursion - (condition-case nil ; Ignore error if user already deleted window. - (progn (select-window (get-buffer-window buffer-or-name 0)) - (if (one-window-p) (delete-frame) (delete-window))) - (error nil))) - (bury-buffer buffer-or-name))) - result)) - - -;; REPLACE ORIGINAL in `dired.el': -;; -;; 1. Prefix arg has more possibilities. -;; 2, Added optional arg LOCALP, so you can mark/unmark matching different file-name forms. -;; 3. Push REGEXP onto `regexp-search-ring'. -;; -;;;###autoload -(defun dired-mark-files-regexp (regexp &optional marker-char localp) - "Mark all file names matching REGEXP for use in later commands. -`.' and `..' are never marked or unmarked by this command. - -Whether to mark or unmark, and what form of file name to match, are -governed by the prefix argument. For this, a plain (`C-u') or a -double-plain (`C-u C-u') prefix arg is considered only as such - it is -not considered numerically. - -Whether to mark or unmark: - - - No prefix arg, a positive arg, or a negative arg means mark. - - - Plain (`C-u'), double-plain (`C-u C-u'), or zero (e.g. `M-0' means - unmark. - -The form of a file name used for matching: - - - No prefix arg (to mark) or a plain prefix arg (`C-u', to unmark) - means use the relative file name (no directory part). - - - A negative arg (e.g. `M--', to mark) or a zero arg (e.g. `M-0', to - unmark) means use the absolute file name, that is, including all - directory components. - - - A positive arg (e.g. `M-+', to mark) or a double plain arg (`C-u - C-u', to unmark) means construct the name relative to - `default-directory'. For an entry in an inserted subdir listing, - this means prefix the relative file name (no directory part) with - the subdir name relative to `default-directory'. - -Note that the default matching behavior of this command is different -for Dired+ than it is for vanilla Emacs. Using a positive prefix arg -or a double plain prefix arg (`C-u C-u') gives you the same behavior -as vanilla Emacs (marking or unmarking, respectively): matching -against names that are relative to the `default-directory'. - -What Dired+ offers in addition is the possibility to match against -names that are relative (have no directory part - no prefix arg or -`C-u' to mark and unmark, respectively) or absolute (`M--' or `M-0', -respectively). The default behavior uses relative names because this -is likely to be the more common use case. But matching against -absolute names gives you more flexibility. - -REGEXP is an Emacs regexp, not a shell wildcard. Thus, use `\\.o$' -for object files--just `.o' might mark more than you might expect. - -REGEXP is added to `regexp-search-ring', for regexp search. - -Non-interactively: - MARKER-CHAR is the marker character - used for `dired-marker-char'. - LOCALP is passed to `dired-get-filename'. It determines the form of - filename that is matched against REGEXP." - (interactive (let* ((raw current-prefix-arg) - (C-u (and (consp raw) (= 4 (car raw)))) - (C-u-C-u (and (consp raw) (= 16 (car raw)))) - (num (and raw (prefix-numeric-value raw)))) - (list (diredp-read-regexp (concat (if (or (consp raw) (and num (zerop num))) - "UNmark" - "Mark") - " files (regexp): ")) - (and raw (or C-u C-u-C-u (zerop num)) ?\040) - (cond ((or (not raw) C-u) t) ; none, `C-u' - ((> num 0) nil) ; `M-+', `C-u C-u' - (t 'no-dir))))) ; `M--', `M-0' - (add-to-list 'regexp-search-ring regexp) ; Add REGEXP to `regexp-search-ring'. - (let ((dired-marker-char (or marker-char dired-marker-char))) - (diredp-mark-if (and (not (diredp-looking-at-p dired-re-dot)) - (not (eolp)) ; Empty line - (let ((fn (dired-get-filename localp t))) - (and fn (diredp-string-match-p regexp fn)))) - "file"))) - - -;; REPLACE ORIGINAL in `dired.el': -;; -;; Use `diredp-mark-if', not `dired-mark-if'. -;; -;;;###autoload -(defun dired-mark-files-containing-regexp (regexp &optional marker-char) - "Mark files with contents containing a REGEXP match. -A prefix argument means unmark them instead. -`.' and `..' are never marked. - -If a file is visited in a buffer and `dired-always-read-filesystem' is -nil, this looks in the buffer without revisiting the file, so the -results might be inconsistent with the file on disk if its contents -have changed since it was last visited." - (interactive - (list (diredp-read-regexp (concat (if current-prefix-arg "Unmark" "Mark") " files containing (regexp): ") - nil 'dired-regexp-history) - (and current-prefix-arg ?\040))) - (let ((dired-marker-char (or marker-char dired-marker-char))) - (diredp-mark-if (and (not (diredp-looking-at-p dired-re-dot)) - (not (eolp)) - (let ((fname (dired-get-filename nil t))) - (when (and fname (file-readable-p fname) (not (file-directory-p fname))) - (let ((prebuf (get-file-buffer fname))) - (message "Checking %s" fname) - ;; For now, do it inside Emacs. Grep might be better if there are lots of files. - (if (and prebuf (or (not (boundp 'dired-always-read-filesystem)) - (not dired-always-read-filesystem))) ; Emacs 26+ - (with-current-buffer prebuf - (save-excursion (goto-char (point-min)) (re-search-forward regexp nil t))) - (with-temp-buffer - (insert-file-contents fname) - (goto-char (point-min)) - (re-search-forward regexp nil t))))))) - "file"))) - - -;; REPLACE ORIGINAL in `dired.el': -;; -;; Use `diredp-mark-if', not `dired-mark-if'. -;; -;;;###autoload -(defun dired-mark-symlinks (unflag-p) - "Mark all symbolic links. -With prefix argument, unmark or unflag all those files." - (interactive "P") - (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char))) - (diredp-mark-if (diredp-looking-at-p dired-re-sym) "symbolic link"))) - - -;; REPLACE ORIGINAL in `dired.el': -;; -;; Use `diredp-mark-if', not `dired-mark-if'. -;; -;;;###autoload -(defun dired-mark-directories (unflag-p) - "Mark all directory file lines except `.' and `..'. -With prefix argument, unmark or unflag the files instead." - (interactive "P") - (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char))) - (diredp-mark-if (and (diredp-looking-at-p dired-re-dir) (not (diredp-looking-at-p dired-re-dot))) - "directory" "directories"))) - - -;; REPLACE ORIGINAL in `dired.el': -;; -;; Use `diredp-mark-if', not `dired-mark-if'. -;; -;;;###autoload -(defun dired-mark-executables (unflag-p) - "Mark all executable files. -With prefix argument, unmark or unflag the files instead." - (interactive "P") - (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char))) - (diredp-mark-if (diredp-looking-at-p dired-re-exe) "executable file"))) - - -;; REPLACE ORIGINAL in `dired.el': -;; -;; Use `diredp-mark-if', not `dired-mark-if'. -;; -;;;###autoload -(defun dired-flag-auto-save-files (&optional unflag-p) - "Flag for deletion files whose names suggest they are auto save files. -A prefix argument says to unmark or unflag the files instead." - (interactive "P") - (let ((dired-marker-char (if unflag-p ?\040 dired-del-marker))) - (diredp-mark-if - ;; It is less than general to check for # here, but it's the only way this runs fast enough. - (and (save-excursion (end-of-line) - (or (eq (preceding-char) ?#) - ;; Handle executables in case of -F option. Need not worry about the other kinds - ;; of markings that -F makes, since they won't appear on real auto-save files. - (and (eq (preceding-char) ?*) - (progn (forward-char -1) (eq (preceding-char) ?#))))) - (not (diredp-looking-at-p dired-re-dir)) - (let ((fname (dired-get-filename t t))) - (and fname (auto-save-file-name-p (file-name-nondirectory fname))))) - "auto-save file"))) - -;;;###autoload -(defun diredp-capitalize (&optional arg) ; Bound to `% c' - "Rename all marked (or next ARG) files by capitalizing them. -Makes the first char of the name uppercase and the others lowercase." - (interactive "P") - (dired-rename-non-directory #'capitalize "Rename by capitalizing:" arg)) - -;; This is more useful than a single-file version of `dired-do-delete'. -;;;###autoload -(defun diredp-delete-this-file (&optional use-trash-can) ; Bound to `C-k', `delete' - "In Dired, delete the file on the cursor line, upon confirmation. -This uses `delete-file'. -If the file is a symlink, remove the symlink. If the file has -multiple names, it continues to exist with the other names. - -For Emacs 24 and later, a prefix arg means that if -`delete-by-moving-to-trash' is non-nil then trash the file instead of -deleting it." - (interactive "P") - (let ((file (dired-get-filename))) - (if (not (yes-or-no-p (format "%s file `%s'? " (if (and use-trash-can delete-by-moving-to-trash) - "Trash" - "Permanently delete") - file))) - (message "OK - canceled") - (if (> emacs-major-version 23) (delete-file file use-trash-can) (delete-file file)) - (revert-buffer)))) - -;;; Versions of `dired-do-*' commands for just this line's file. -;;;###autoload -(defun diredp-capitalize-this-file () ; Bound to `M-c' - "In Dired, rename the file on the cursor line by capitalizing it. -Makes the first char of the name uppercase and the others lowercase." - (interactive) (diredp-capitalize 1)) - -;;;###autoload -(defun diredp-downcase-this-file () ; Bound to `M-l' - "In Dired, rename the file on the cursor line to lower case." - (interactive) (dired-downcase 1)) - -;;;###autoload -(defun diredp-upcase-this-file () ; Bound to `M-u' - "In Dired, rename the file on the cursor line to upper case." - (interactive) (dired-upcase 1)) - -;;;###autoload -(defun diredp-rename-this-file () ; Bound to `r' - "In Dired, rename the file on the cursor line." - (interactive) - (let ((use-file-dialog nil)) (dired-do-rename 1))) - -(when (fboundp 'epa-dired-do-encrypt) ; Emacs 23+ - (defun diredp-decrypt-this-file () - "In Dired, decrypt the file on the cursor line." - (interactive) - (let ((use-file-dialog nil)) (epa-dired-do-decrypt 1))) - - (defun diredp-encrypt-this-file () - "In Dired, encrypt the file on the cursor line." - (interactive) - (let ((use-file-dialog nil)) (epa-dired-do-encrypt 1))) - - (defun diredp-verify-this-file () - "In Dired, verify the file on the cursor line." - (interactive) - (let ((use-file-dialog nil)) (epa-dired-do-verify 1))) - - (defun diredp-sign-this-file () - "In Dired, sign the file on the cursor line." - (interactive) - (let ((use-file-dialog nil)) (epa-dired-do-sign 1)))) - -;;;###autoload -(defun diredp-copy-this-file () ; Not bound - "In Dired, copy the file on the cursor line." - (interactive) - (let ((use-file-dialog nil)) (dired-do-copy 1))) - -;;;###autoload -(defun diredp-relsymlink-this-file () ; Bound to `y' - "In Dired, make a relative symbolic link to file on cursor line." - (interactive) - (let ((use-file-dialog nil)) (dired-do-relsymlink 1))) - -;;;###autoload -(defun diredp-symlink-this-file () ; Not bound - "In Dired, make a symbolic link to the file on the cursor line." - (interactive) - (let ((use-file-dialog nil)) (dired-do-symlink 1))) - -;;;###autoload -(defun diredp-hardlink-this-file () ; Not bound - "In Dired, add a name (hard link) to the file on the cursor line." - (interactive) - (let ((use-file-dialog nil)) (dired-do-hardlink 1))) - -;;;###autoload -(defun diredp-print-this-file () ; Bound to `M-p' - "In Dired, print the file on the cursor line." - (interactive) (dired-do-print 1)) - -;;;###autoload -(defun diredp-grep-this-file () ; Not bound - "In Dired, grep the file on the cursor line." - (interactive) - (unless (and grep-command (or (< emacs-major-version 22) - (not grep-use-null-device) - (eq grep-use-null-device t))) - (grep-compute-defaults)) - (grep (diredp-do-grep-1 (list (dired-get-filename t))))) - -;;;###autoload -(defun diredp-compress-this-file () ; Bound to `z' - "In Dired, compress or uncompress the file on the cursor line." - (interactive) (dired-do-compress 1)) - -;;;###autoload -(defun diredp-async-shell-command-this-file (command filelist) ; Not bound - "Run a shell COMMAND asynchronously on the file on the Dired cursor line. -Like `diredp-shell-command-this-file', but adds `&' at the end of -COMMAND to execute it asynchronously. The command output appears in -buffer `*Async Shell Command*'." - (interactive (list (dired-read-shell-command (concat "& on " "%s: ") 1 (list (dired-get-filename t))) - (list (dired-get-filename t)))) - (unless (diredp-string-match-p "&[ \t]*\\'" command) (setq command (concat command " &"))) - (dired-do-shell-command command 1 filelist)) - -;;;###autoload -(defun diredp-shell-command-this-file (command filelist) ; Not bound - "In Dired, run a shell COMMAND on the file on the cursor line." - (interactive (list (dired-read-shell-command (concat "! on " "%s: ") 1 (list (dired-get-filename t))) - (list (dired-get-filename t)))) - (dired-do-shell-command command 1 filelist)) - -;;;###autoload -(defun diredp-bookmark-this-file (&optional prefix) ; Bound to `C-B' (`C-S-b') - "In Dired, bookmark the file on the cursor line. -See `diredp-do-bookmark'." - (interactive (progn (diredp-ensure-mode) - (list (and diredp-prompt-for-bookmark-prefix-flag - (read-string "Prefix for bookmark name: "))))) - (diredp-do-bookmark prefix 1)) - -;;;###autoload -(defun diredp-tag-this-file (tags &optional prefix) ; Bound to `T +' - "In Dired, add some tags to the file on the cursor line. -You need library `bookmark+.el' to use this command." - (interactive (progn (diredp-ensure-bookmark+) - (diredp-ensure-mode) - (list (bmkp-read-tags-completing) - (and diredp-prompt-for-bookmark-prefix-flag - (read-string "Prefix for bookmark name: "))))) - (diredp-do-tag tags prefix 1)) - -;;;###autoload -(defun diredp-untag-this-file (tags &optional prefix arg) ; Bound to `T -' - "In Dired, remove some tags from the file on the cursor line. -With a prefix arg, remove all tags from the file. -You need library `bookmark+.el' to use this command." - (interactive (progn (diredp-ensure-bookmark+) - (diredp-ensure-mode) - (let* ((pref (and diredp-prompt-for-bookmark-prefix-flag - (read-string "Prefix for bookmark name: "))) - (bmk (bmkp-get-autofile-bookmark (dired-get-filename) nil pref)) - (btgs (and bmk (bmkp-get-tags bmk)))) - (unless btgs (error "File has no tags to remove")) - (list (if current-prefix-arg btgs (bmkp-read-tags-completing btgs)) - pref - current-prefix-arg)))) - (diredp-do-untag tags prefix 1)) - -;;;###autoload -(defun diredp-remove-all-tags-this-file (&optional prefix msgp) ; Bound to `T 0' - "In Dired, remove all tags from this file. -You need library `bookmark+.el' to use this command." - (interactive (progn (diredp-ensure-bookmark+) - (diredp-ensure-mode) - (list (and diredp-prompt-for-bookmark-prefix-flag - (read-string "Prefix for bookmark name: ")) - 'MSG))) - (bookmark-maybe-load-default-file) - (diredp-do-remove-all-tags prefix 1)) - -;;;###autoload -(defun diredp-paste-add-tags-this-file (&optional prefix msgp) ; Bound to `T p', `T C-y' - "In Dired, add previously copied tags to this file. -See `diredp-paste-add-tags'. -You need library `bookmark+.el' to use this command." - (interactive (progn (diredp-ensure-bookmark+) - (diredp-ensure-mode) - (list (and diredp-prompt-for-bookmark-prefix-flag - (read-string "Prefix for bookmark name: ")) - 'MSG))) - (bookmark-maybe-load-default-file) - (diredp-do-paste-add-tags prefix 1)) - -;;;###autoload -(defun diredp-paste-replace-tags-this-file (&optional prefix msgp) ; Bound to `T q' - "In Dired, replace tags for this file with previously copied tags. -See `diredp-paste-replace-tags'. -You need library `bookmark+.el' to use this command." - (interactive (progn (diredp-ensure-bookmark+) - (diredp-ensure-mode) - (list (and diredp-prompt-for-bookmark-prefix-flag - (read-string "Prefix for bookmark name: ")) - 'MSG))) - (bookmark-maybe-load-default-file) - (diredp-do-paste-add-tags prefix 1)) - -;;;###autoload -(defun diredp-set-tag-value-this-file (tag value &optional prefix msgp) ; Bound to `T v' - "In Dired, Set value of TAG to VALUE for this file. -See `diredp-set-tag-value'. -You need library `bookmark+.el' to use this command." - (interactive (progn (diredp-ensure-bookmark+) - (diredp-ensure-mode) - (list (bmkp-read-tag-completing) - (read (read-string "Value: ")) - (and diredp-prompt-for-bookmark-prefix-flag - (read-string "Prefix for bookmark name: ")) - 'MSG))) - (bookmark-maybe-load-default-file) - (diredp-do-set-tag-value tag value prefix 1)) - -;;;###autoload -(defun diredp-copy-tags-this-file (&optional prefix msgp) ; Bound to `T c', `T M-w' - "In Dired, copy the tags from this file, so you can paste them to another. -See `diredp-copy-tags'. -You need library `bookmark+.el' to use this command." - (interactive (progn (diredp-ensure-bookmark+) - (diredp-ensure-mode) - (list (and diredp-prompt-for-bookmark-prefix-flag - (read-string "Prefix for bookmark name: ")) - 'MSG))) - (bookmark-maybe-load-default-file) - (let ((bmk (bmkp-get-autofile-bookmark (dired-get-filename) nil prefix))) - (and bmk (bmkp-copy-tags bmk msgp)))) - -;;;###autoload -(defun diredp-mouse-copy-tags (event) ; Not bound - "In Dired, copy the tags from this file, so you can paste them to another. -You need library `bookmark+.el' to use this command." - (interactive "e") - (let ((mouse-pos (event-start event)) - (dired-no-confirm t) - (prefix (and diredp-prompt-for-bookmark-prefix-flag - (read-string "Prefix for bookmark name: ")))) - (select-window (posn-window mouse-pos)) - (goto-char (posn-point mouse-pos)) - (diredp-copy-tags-this-file prefix 'MSG)) - (diredp-previous-line 1)) - -(when (fboundp 'describe-file) ; In `help-fns+.el' or `help+20.el'. - (defun diredp-describe-file (&optional internal-form-p) ; Bound to `C-h RET', `C-h C-RET' - "In Dired, describe this file or directory. -You need library `help-fns+.el' to use this command. -If the file has an autofile bookmark and you use library `Bookmark+', -then show also the bookmark information (tags etc.). In this case, a -prefix arg shows the internal form of the bookmark." - (interactive "P") - (describe-file (dired-get-filename nil t) internal-form-p)) - - (defun diredp-mouse-describe-file (event &optional internal-form-p) ; Not bound - "Describe the clicked file. -You need library `help-fns+.el' to use this command. -If the file has an autofile bookmark and you use library `Bookmark+', -then show also the bookmark information (tags etc.). In this case, a -prefix arg shows the internal form of the bookmark." - (interactive "e\nP") - (let (file) - (with-current-buffer (window-buffer (posn-window (event-end event))) - (save-excursion (goto-char (posn-point (event-end event))) - (setq file (dired-get-filename nil t)))) - (describe-file file internal-form-p)))) - -;; Define these even if `Bookmark+' is not loaded. -;;;###autoload -(defalias 'diredp-show-metadata 'diredp-describe-autofile) -;;;###autoload -(defun diredp-describe-autofile (&optional internal-form-p) - "Show the metadata for the file of the current line. -The file must name an autofile bookmark. The metadata is the bookmark -information. - -With a prefix argument, show the internal definition of the bookmark. - -You need library `bookmark+.el' for this command." - (interactive "P") - (diredp-ensure-bookmark+) - (diredp-ensure-mode) - (let ((bmk (save-match-data - (bmkp-get-autofile-bookmark (dired-get-filename nil t))))) - (unless bmk (error "Not on an autofile bookmark")) - (save-selected-window (if internal-form-p - (bmkp-describe-bookmark-internals bmk) - (bmkp-describe-bookmark bmk))))) - -(defun diredp-mouse-describe-autofile (event &optional internal-form-p) ; Not bound - "Show the metadata for the file whose name you click. -The file must name an autofile bookmark. The metadata is the bookmark -information. - -With a prefix argument, show the internal definition of the bookmark. - -You need library `bookmark+.el' for this command." - (interactive "e\nP") - (diredp-ensure-bookmark+) - (let (file) - (with-current-buffer (window-buffer (posn-window (event-end event))) - (diredp-ensure-mode) - (save-excursion (goto-char (posn-point (event-end event))) - (setq file (dired-get-filename nil t)))) - (let ((bmk (save-match-data (bmkp-get-autofile-bookmark file)))) - (unless bmk (error "Not an autofile bookmark")) - (save-selected-window (if internal-form-p - (bmkp-describe-bookmark-internals bmk) - (bmkp-describe-bookmark bmk)))))) - -;;;###autoload -(defalias 'diredp-show-metadata-for-marked 'diredp-describe-marked-autofiles) -;;;###autoload -(defun diredp-describe-marked-autofiles (&optional internal-form-p interactivep details) - "Show metadata for the marked files. -If no file is marked, describe ALL autofiles in this directory. -With a prefix argument, show the internal (Lisp) form of the metadata. -When invoked interactively, raise an error if no files are marked. -You need library `bookmark+.el' for this command. - -When called from Lisp, optional arg DETAILS is passed to -`diredp-get-files'." - (interactive (list current-prefix-arg t diredp-list-file-attributes)) - (diredp-ensure-bookmark+) - (let ((help-xref-following nil)) - (help-setup-xref (list `(lambda (_buf) - (with-current-buffer ,(current-buffer) (diredp-describe-marked-autofiles))) - internal-form-p) - (if (or (> emacs-major-version 23) - (and (= emacs-major-version 23) (> emacs-minor-version 1))) - (called-interactively-p 'interactive) - (interactive-p)))) - (diredp-with-help-window "*Help*" - (let ((marked (dired-get-marked-files nil nil nil 'DISTINGUISH-ONE-MARKED interactivep))) - (unless (cdr marked) - (message "Describing ALL autofiles here (none are marked)...") - (setq marked (diredp-get-files 'IGNORE-MARKS-P nil nil nil nil details))) - (if (eq t (car marked)) - (diredp-describe-autofile internal-form-p) - (dolist (bmk (delq nil (mapcar #'bmkp-get-autofile-bookmark marked))) - (if internal-form-p - (let* ((bname (bmkp-bookmark-name-from-record bmk)) - (help-text (format "%s\n%s\n\n%s" - bname (make-string (length bname) ?-) (pp-to-string bmk)))) - (princ help-text) (terpri)) - (princ (bmkp-bookmark-description bmk)) (terpri))))))) - -;;;###autoload -(defun diredp-byte-compile-this-file () ; Bound to `b' - "In Dired, byte compile the (Lisp source) file on the cursor line." - (interactive) (dired-do-byte-compile 1)) - -;;;###autoload -(defun diredp-load-this-file () ; Not bound - "In Dired, load the file on the cursor line." - (interactive) (dired-do-load 1)) - -;;;###autoload -(defun diredp-chmod-this-file () ; Bound to `M-m' - "In Dired, change the mode of the file on the cursor line." - (interactive) (dired-do-chmod 1)) - -(unless (memq system-type '(windows-nt ms-dos)) - (defun diredp-chgrp-this-file () ; Not bound - "In Dired, change the group of the file on the cursor line." - (interactive) (dired-do-chgrp 1))) - -(unless (memq system-type '(windows-nt ms-dos)) - (defun diredp-chown-this-file () ; Not bound - "In Dired, change the owner of the file on the cursor line." - (interactive) (dired-do-chown 1))) - -(when (fboundp 'dired-do-touch) - (defun diredp-touch-this-file () ; Not bound - "In Dired, `touch' (change the timestamp of) the file on the cursor line." - (interactive) (dired-do-touch 1))) - - -;; REPLACE ORIGINAL in `dired-x.el'. -;; -;; 1. Variable (symbol) `s' -> `blks'. -;; 2. Fixes to remove leading space from `uid' and allow `.' in `gid'. -;; 3. Cleaned up doc string and code a bit. -;; -;;;###autoload -(defun dired-mark-sexp (predicate &optional unmark-p) ; Bound to `M-(', `* (' - "Mark files for which PREDICATE returns non-nil. -With a prefix arg, unmark or unflag those files instead. - -PREDICATE is a lisp sexp that can refer to the following symbols as -variables: - - `mode' [string] file permission bits, e.g. \"-rw-r--r--\" - `nlink' [integer] number of links to file - `size' [integer] file size in bytes - `uid' [string] owner - `gid' [string] group (If the gid is not displayed by `ls', - this will still be set (to the same as uid)) - `time' [string] the time that `ls' displays, e.g. \"Feb 12 14:17\" - `name' [string] the name of the file - `sym' [string] if file is a symbolic link, the linked-to name, - else \"\" - `inode' [integer] the inode of the file (only for `ls -i' output) - `blks' [integer] the size of the file for `ls -s' output - (ususally in blocks or, with `-k', in Kbytes) -Examples: - Mark zero-length files: `(equal 0 size)' - Mark files last modified on Feb 2: `(string-match \"Feb 2\" time)' - Mark uncompiled Emacs Lisp files (`.el' file without a `.elc' file): - First, Dired just the source files: `dired *.el'. - Then, use \\[dired-mark-sexp] with this sexp: - (not (file-exists-p (concat name \"c\"))) - -There's an ambiguity when a single integer not followed by a unit -prefix precedes the file mode: It is then parsed as inode number -and not as block size (this always works for GNU coreutils ls). - -Another limitation is that the uid field is needed for the -function to work correctly. In particular, the field is not -present for some values of `ls-lisp-emulation'. - -This function operates only on the Dired buffer content. It does not -refer at all to the underlying file system. Contrast this with -`find-dired', which might be preferable for the task at hand." - ;; Using `sym' = "", instead of nil, for non-linked files avoids the trap of - ;; (string-match "foo" sym) into which a user would soon fall. - ;; Use `equal' instead of `=' in the example, as it works on integers and strings. - (interactive "xMark if (vars: inode,blks,mode,nlink,uid,gid,size,time,name,sym): \nP") - (message "%s" predicate) - (let ((dired-marker-char (if unmark-p ?\040 dired-marker-char)) - (inode nil) - (blks ()) - mode nlink uid gid size time name sym) - (diredp-mark-if - (save-excursion - (and - ;; Sets vars INODE BLKS MODE NLINK UID GID SIZE TIME NAME and SYM - ;; according to current file line. Returns `t' for success, nil if - ;; there is no file line. Upon success, these vars are set, to either - ;; nil or the appropriate value, so they need not be initialized. - ;; Moves point within the current line. - (dired-move-to-filename) - (let ((mode-len 10) ; Length of mode string. - ;; As in `dired.el', but with subexpressions \1=inode, \2=blks: - ;; GNU `ls -hs' suffixes the block count with a unit and prints it as a float; FreeBSD does neither. - ;; $$$$$$ (dired-re-inode-size "\\s *\\([0-9]*\\)\\s *\\([0-9]*\\) ?") - (dired-re-inode-size (if (> emacs-major-version 24) - "\\=\\s *\\([0-9]+\\s +\\)?\ -\\(?:\\([0-9]+\\(?:\\.[0-9]*\\)?[BkKMGTPEZY]?\\)? ?\\)" - "\\s *\\([0-9]*\\)\\s *\\([0-9]*\\) ?")) - pos) - (beginning-of-line) - (forward-char 2) - (search-forward-regexp dired-re-inode-size nil t) - ;; XXX Might be a size not followed by a unit prefix. Could set `blks' to `inode' if it were otherwise - ;; nil, with similar reasoning as for setting `gid' to `uid', but it would be even more whimsical. - (setq inode (and (match-string 1) (string-to-number (match-string 1))) - blks (and (match-string 2) (if (fboundp 'dired-x--string-to-number) - (dired-x--string-to-number (match-string 2)) ; Emacs 25+ - (string-to-number (match-string 2)))) - mode (buffer-substring (point) (+ mode-len (point)))) - (forward-char mode-len) - (unless (eq (char-after) ?\ ) (forward-char 1)) ; Skip any extended attributes marker ("." or "+"). - (setq nlink (read (current-buffer))) - ;; Karsten Wenger fixed uid. - - ;; Another issue is that GNU `ls -n' right-justifies numerical UIDs and GIDs, while FreeBSD - ;; left-justifies them, so do not rely on a specific whitespace layout. Both of them right-justify all - ;; other numbers, though. - ;; XXX Return a number if the `uid' or `gid' seems to be numerical? - ;; $$$$$$ (setq uid (buffer-substring (+ (point) 1) (progn (forward-word 1) (point)))) - (setq uid (buffer-substring (progn (skip-chars-forward " \t") (point)) - (progn (skip-chars-forward "^ \t") (point)))) - (cond ((> emacs-major-version 24) - (dired-move-to-filename) - (save-excursion - (setq time - ;; The regexp below tries to match from the last digit of the size field through a - ;; space after the date. Also, dates may have different formats depending on file age, - ;; so the date column need not be aligned to the right. - (buffer-substring (save-excursion (skip-chars-backward " \t") (point)) - (progn (re-search-backward directory-listing-before-filename-regexp) - (skip-chars-forward "^ \t") - (1+ (point)))) - size - (dired-x--string-to-number - ;; We know that there's some kind of number before point because the regexp search - ;; above succeeded. Not worth doing an extra check for leading garbage. - (buffer-substring (point) (progn (skip-chars-backward "^ \t") (point)))) - ;; If no `gid' is displayed, `gid' will be set to `uid' but user will then not reference - ;; it anyway in PREDICATE. - gid - (buffer-substring (progn (skip-chars-backward " \t") (point)) - (progn (skip-chars-backward "^ \t") (point))))) - (setq name (buffer-substring (point) (or (dired-move-to-end-of-filename t) (point))) - sym (if (diredp-looking-at-p " -> ") - (buffer-substring (progn (forward-char 4) (point)) (line-end-position)) - ""))) - (t - (re-search-forward - (if (< emacs-major-version 20) - "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)" - dired-move-to-filename-regexp)) - (goto-char (match-beginning 1)) - (forward-char -1) - (setq size (string-to-number (buffer-substring (save-excursion (backward-word 1) - (setq pos (point))) - (point)))) - (goto-char pos) - (backward-word 1) - ;; if no `gid' is displayed, `gid' will be set to `uid' but user will then not reference - ;; it anyway in PREDICATE. - (setq gid (buffer-substring (save-excursion (forward-word 1) (point)) (point)) - time (buffer-substring (match-beginning 1) (1- (dired-move-to-filename))) - name (buffer-substring (point) (or (dired-move-to-end-of-filename t) (point))) - sym (if (diredp-looking-at-p " -> ") - (buffer-substring (progn (forward-char 4) (point)) (line-end-position)) - ""))))) - ;; Vanilla Emacs uses `lexical-binding' = t, and it passes bindings to `eval' as a second arg. - ;; We use `lexical-binding' = nil, and anyway there should be no need to pass the bindings. - (eval predicate))) - (format "'%s file" predicate)))) - -(defun diredp-this-file-marked-p (&optional mark-char) - "Return non-nil if the file on this line is marked. -Optional arg MARK-CHAR is the type of mark to check. - If nil, then if the file has any mark, including `D', it is marked." - (and (dired-get-filename t t) (save-excursion - (beginning-of-line) - (if mark-char - (diredp-looking-at-p - (concat "^" (regexp-quote (char-to-string mark-char)))) - (not (diredp-looking-at-p "^ ")))))) - -(defun diredp-this-file-unmarked-p (&optional mark-char) - "Return non-nil if the file on this line is unmarked. -Optional arg MARK-CHAR is the type of mark to check. - If nil, then if the file has no mark, including `D', it is unmarked. - If non-nil, then it is unmarked for MARK-CHAR if it has no mark or - it has any mark except MARK-CHAR." - (and (dired-get-filename t t) (save-excursion - (beginning-of-line) - (if mark-char - (not (diredp-looking-at-p - (concat "^" (regexp-quote (char-to-string mark-char))))) - (diredp-looking-at-p "^ "))))) - -;;;###autoload -(defun diredp-mark-region-files (&optional unmark-p) ; Not bound - "Mark all of the files in the current region (if it is active). -With non-nil prefix arg, unmark them instead." - (interactive "P") - (let ((beg (min (point) (mark))) - (end (max (point) (mark))) - (inhibit-field-text-motion t)) ; Just in case. - (setq beg (save-excursion (goto-char beg) (line-beginning-position)) - end (save-excursion (goto-char end) (line-end-position))) - (let ((dired-marker-char (if unmark-p ?\040 dired-marker-char))) - (diredp-mark-if (and (<= (point) end) (>= (point) beg) (diredp-this-file-unmarked-p)) "region file")))) - -;;;###autoload -(defun diredp-unmark-region-files (&optional mark-p) ; Not bound - "Unmark all of the files in the current region (if it is active). -With non-nil prefix arg, mark them instead." - (interactive "P") - (let ((beg (min (point) (mark))) - (end (max (point) (mark))) - (inhibit-field-text-motion t)) ; Just in case. - (setq beg (save-excursion (goto-char beg) (line-beginning-position)) - end (save-excursion (goto-char end) (line-end-position))) - (let ((dired-marker-char (if mark-p dired-marker-char ?\040))) - (diredp-mark-if (and (<= (point) end) (>= (point) beg) (diredp-this-file-marked-p)) "region file")))) - -;;;###autoload -(defun diredp-flag-region-files-for-deletion () ; Not bound - "Flag all of the files in the current region (if it is active) for deletion." - (interactive) - (let ((beg (min (point) (mark))) - (end (max (point) (mark))) - (inhibit-field-text-motion t)) ; Just in case. - (setq beg (save-excursion (goto-char beg) (line-beginning-position)) - end (save-excursion (goto-char end) (line-end-position))) - (let ((dired-marker-char dired-del-marker)) - (diredp-mark-if (and (<= (point) end) (>= (point) beg) (diredp-this-file-unmarked-p ?\D)) - "region file")))) - -;;;###autoload -(defun diredp-toggle-marks-in-region (start end) ; Not bound - "Toggle marks in the region." - (interactive "r") - (save-excursion - (save-restriction - (if (not (fboundp 'dired-toggle-marks)) - ;; Pre-Emacs 22. Use bol, eol. If details hidden, show first. - (let ((details-hidden-p (and (boundp 'dired-details-state) (eq 'hidden dired-details-state)))) - (widen) - (when details-hidden-p (dired-details-show)) - (goto-char start) - (setq start (line-beginning-position)) - (goto-char end) - (setq end (line-end-position)) - (narrow-to-region start end) - (dired-toggle-marks) - (when details-hidden-p (dired-details-hide))) - (narrow-to-region start end) - (dired-toggle-marks)))) - (when (and (get-buffer-window (current-buffer)) (fboundp 'fit-frame-if-one-window)) - (fit-frame-if-one-window))) - - -;;; Mouse 3 menu. -;;;;;;;;;;;;;;;;; - -(defvar diredp-file-line-overlay nil) - -;;;###autoload -(defun diredp-mouse-3-menu (event) ; Bound to `mouse-3' - "Dired pop-up `mouse-3' menu, for files in selection or current line." - (interactive "e") - (if (not (and (fboundp 'mouse3-dired-use-menu) (diredp-nonempty-region-p))) - ;; No `mouse3.el' or no region. - (if (diredp-nonempty-region-p) - ;; Region - (let ((reg-choice (x-popup-menu - event - (list "Files in Region" - (list "" - '("Mark" . diredp-mark-region-files) - '("Unmark" . diredp-unmark-region-files) - '("Toggle Marked/Unmarked" . - diredp-toggle-marks-in-region) - '("Flag for Deletion" . - diredp-flag-region-files-for-deletion)))))) - (when reg-choice (call-interactively reg-choice))) - ;; Single file/dir (no region). - (let ((mouse-pos (event-start event)) - ;; Do not use `save-excursion', because some commands will move point on purpose. - ;; Just save original point and return to it unless MOVEP is set to non-nil. - (opoint (point)) - (movep nil) - (inhibit-field-text-motion t) ; Just in case. - choice bol eol file/dir-name) - (with-current-buffer (window-buffer (posn-window mouse-pos)) - (goto-char (posn-point mouse-pos)) - (setq bol (line-beginning-position) - eol (line-end-position)) - (unwind-protect - (when (setq file/dir-name (and (not (eobp)) (dired-get-filename nil t))) - (if diredp-file-line-overlay ; Don't re-create if exists. - (move-overlay diredp-file-line-overlay bol eol (current-buffer)) - (setq diredp-file-line-overlay (make-overlay bol eol)) - (overlay-put diredp-file-line-overlay 'face 'region)) - (sit-for 0) - (let ((map - (easy-menu-create-menu - "This File" - `( - ("Bookmark" :visible (featurep 'bookmark+) - ["Bookmark..." diredp-bookmark-this-file] - ["Add Tags..." diredp-tag-this-file - :visible (featurep 'bookmark+)] - ["Remove Tags..." diredp-untag-this-file - :visible (featurep 'bookmark+)] - ["Remove All Tags" diredp-remove-all-tags-this-file - :visible (featurep 'bookmark+)] - ["Copy Tags" diredp-copy-tags-this-file - :visible (featurep 'bookmark+)] - ["Paste Tags (Add)" diredp-paste-add-tags-this-file - :visible (featurep 'bookmark+)] - ["Paste Tags (Replace)" diredp-paste-replace-tags-this-file - :visible (featurep 'bookmark+)] - ["Set Tag Value..." diredp-set-tag-value-this-file - :visible (featurep 'bookmark+)] - ) - ["Describe" ',(if (if (> emacs-major-version 21) - (require 'help-fns+ nil t) - (require 'help+20 nil t)) - 'diredp-describe-file - 'diredp-describe-autofile)] ; Requires `bookmark+.el' - ;; Stuff from `Marks' menu. - ["Mark" dired-mark - :visible (not (eql (dired-file-marker file/dir-name) - dired-marker-char))] - ["Unmark" dired-unmark - :visible (dired-file-marker file/dir-name)] - ["Flag for Deletion" dired-flag-file-deletion - :visible (not (eql (dired-file-marker file/dir-name) - dired-del-marker))] - ["Delete..." diredp-delete-this-file] - "--" ; ------------------------------------------------------ - ;; Stuff from `Single' / `Multiple' menus. - ["Open" dired-find-file] - ["Open in Other Window" dired-find-file-other-window] - ["Open in Other Frame" diredp-find-file-other-frame] - ["Open Associated Windows App" dired-w32-browser - :visible (featurep 'w32-browser)] - ["Open in Windows Explorer" dired-w32explore - :visible (featurep 'w32-browser)] - ["View (Read Only)" dired-view-file] - ["--" 'ignore ; ------------------------------------------------- - :visible (or (atom (diredp-this-subdir)) ; Subdir line. - (not (equal (expand-file-name (dired-current-directory)) - (expand-file-name default-directory))))] ; Not top. - ["Insert This Subdir" - (lambda () (interactive) - (call-interactively #'dired-maybe-insert-subdir) - (setq movep t)) - :visible (and (atom (diredp-this-subdir)) - (not (assoc (file-name-as-directory (diredp-this-subdir)) - dired-subdir-alist))) - :enable (atom (diredp-this-subdir))] - ["Go To Inserted Subdir" - (lambda () (interactive) - (call-interactively #'dired-maybe-insert-subdir) - (setq movep t)) - :visible (and (atom (diredp-this-subdir)) - (assoc (file-name-as-directory (diredp-this-subdir)) - dired-subdir-alist)) - :enable (atom (diredp-this-subdir)) - :keys "i"] - ["Remove This Inserted Subdir" dired-kill-subdir - :visible (not (equal - (expand-file-name (dired-current-directory)) - (expand-file-name default-directory)))] ; In subdir, not top. - ["Remove This Inserted Subdir and Lower" diredp-kill-this-tree - :visible (and (fboundp 'diredp-kill-this-tree) - (not (equal - (expand-file-name (dired-current-directory)) - (expand-file-name default-directory))))] ; In subdir, not top. - ["Dired This Inserted Subdir (Tear Off)" - (lambda () (interactive) (diredp-dired-this-subdir t)) - :visible (not (equal (expand-file-name (dired-current-directory)) - (expand-file-name default-directory)))] ; In subdir, not top. - "--" ; ------------------------------------------------------ - ["Compare..." diredp-ediff] - ["Diff..." dired-diff] - ["Diff with Backup" dired-backup-diff] - - ["Bookmark..." diredp-bookmark-this-file - :visible (not (featurep 'bookmark+))] - "--" ; ------------------------------------------------------ - ["Rename to..." diredp-rename-this-file] - ["Capitalize" diredp-capitalize-this-file] - ["Upcase" diredp-upcase-this-file] - ["Downcase" diredp-downcase-this-file] - "--" ; ------------------------------------------------------ - ["Copy to..." diredp-copy-this-file] - ["Symlink to (Relative)..." diredp-relsymlink-this-file] - ["Symlink to..." diredp-symlink-this-file] - ["Hardlink to..." diredp-hardlink-this-file] - "--" ; ------------------------------------------------------ - ["Shell Command..." diredp-shell-command-this-file] - ["Asynchronous Shell Command..." - diredp-async-shell-command-this-file] - ["Print..." diredp-print-this-file] - ["Grep" diredp-grep-this-file] - ["Compress/Uncompress" diredp-compress-this-file] - ["Byte-Compile" diredp-byte-compile-this-file] - ["Load" diredp-load-this-file] - "--" ; ------------------------------------------------------ - ["Change Timestamp..." diredp-touch-this-file] - ["Change Mode..." diredp-chmod-this-file] - ["Change Group..." diredp-chgrp-this-file - :visible (fboundp 'diredp-chgrp-this-file)] - ["Change Owner..." diredp-chown-this-file - :visible (fboundp 'diredp-chown-this-file)])))) - (when diredp-file-line-overlay - (delete-overlay diredp-file-line-overlay)) - (setq choice (x-popup-menu event map)) - (when choice (call-interactively (lookup-key map (apply 'vector choice)))))) - (unless movep (goto-char opoint)))))) - ;; `mouse3.el' and active region. - (unless (eq mouse3-dired-function 'mouse3-dired-use-menu) - (funcall #'mouse3-dired-use-menu) - (revert-buffer)) - (let ((last-command 'mouse-save-then-kill)) (mouse-save-then-kill event)))) - - -;; REPLACE ORIGINAL in `dired.el' for Emacs 20. -;; -;; Allow `.' and `..', by using non-nil second arg to `dired-get-filename'. -;; -(when (< emacs-major-version 21) - (defun dired-find-file () ; Bound to `RET' - "In Dired, visit the file or directory named on this line." - (interactive) - (let* ((dgf-result (or (dired-get-filename nil t) (error "No file on this line"))) - (file-name (file-name-sans-versions dgf-result t))) - (if (file-exists-p file-name) - (find-file file-name) - (if (file-symlink-p file-name) - (error "File is a symlink to a nonexistent target") - (error "File no longer exists; type `g' to update Dired buffer")))))) - -;;;###autoload -(defun diredp-find-file-other-frame () ; Bound to `C-o' - "In Dired, visit this file or directory in another frame." - (interactive) - (find-file-other-frame (file-name-sans-versions (dired-get-filename nil t) t))) - -;;;###autoload -(defun diredp-mouse-find-file-other-frame (event) ; Bound to `M-mouse-2' - "In Dired, visit file or directory clicked on in another frame." - (interactive "e") - (let ((pop-up-frames t)) (dired-mouse-find-file-other-window event))) - - -;; REPLACE ORIGINAL in `dired.el'. -;; -;; Allow `.' and `..', by using non-nil second arg to `dired-get-filename'. -;; -;;;###autoload -(defun dired-mouse-find-file-other-window (event) ; Bound to `mouse-2' - "In Dired, visit the file or directory name you click on." - (interactive "e") - (let (file) - (with-current-buffer (window-buffer (posn-window (event-end event))) - (save-excursion (goto-char (posn-point (event-end event))) - (setq file (dired-get-filename nil t)))) - (unless (stringp file) (error "No file here")) - (select-window (posn-window (event-end event))) - (find-file-other-window (file-name-sans-versions file t)))) - -;;;###autoload -(defun diredp-mouse-view-file (event) ; Not bound - "Examine this file in view mode, returning to Dired when done. -When file is a directory, show it in this buffer if it is inserted; -otherwise, display it in another buffer." - (interactive "e") - (let (file) - (with-current-buffer (window-buffer (posn-window (event-end event))) - (save-excursion (goto-char (posn-point (event-end event))) - (setq file (dired-get-filename nil t)))) - (select-window (posn-window (event-end event))) - (if (file-directory-p file) - (or (and (cdr dired-subdir-alist) (dired-goto-subdir file)) (dired file)) - (view-file file)))) ; In `view.el'. - -;;;###autoload -(defun diredp-mouse-ediff (event) ; Not bound - "Compare this file (pointed by mouse) with file FILE2 using `ediff'. -FILE2 defaults to this file as well. If you enter just a directory -name for FILE2, then this file is compared with a file of the same -name in that directory. FILE2 is the second file given to `ediff'; -this file is the first given to it." - (interactive "e") - (require 'ediff) - (let ((mouse-pos (event-start event))) - (select-window (posn-window mouse-pos)) - (goto-char (posn-point mouse-pos)) - (call-interactively 'diredp-ediff))) - -;;;###autoload -(defun diredp-mouse-diff (event &optional switches) ; Not bound - "Compare this file (pointed by mouse) with file FILE2 using `diff'. -FILE2 defaults to the file at the mark. This file is the first file -given to `diff'. With prefix arg, prompt for second arg SWITCHES, -which are options for `diff'." - (interactive "e") - (let ((default (and (mark t) (save-excursion (goto-char (mark t)) - (dired-get-filename t t)))) - (mouse-pos (event-start event))) - (require 'diff) - (select-window (posn-window mouse-pos)) - (goto-char (posn-point mouse-pos)) - (let ((file2 (read-file-name (format "Diff %s with: %s" - (dired-get-filename t) - (if default (concat "(default " default ") ") "")) - (dired-current-directory) default t))) - (setq switches (and current-prefix-arg - (if (fboundp 'icicle-read-string-completing) ; In `icicles-fn.el' - (icicle-read-string-completing "Options for diff: " - (if (stringp diff-switches) - diff-switches - (mapconcat #'identity diff-switches " ")) - (lambda (c) - (diredp-string-match-p "switches" - (symbol-name c)))) - (read-string "Options for diff: " (if (stringp diff-switches) - diff-switches - (mapconcat #'identity diff-switches " ")))))) - (diff file2 (dired-get-filename t) switches)))) - -;;;###autoload -(defun diredp-mouse-backup-diff (event) ; Not bound - "Diff this file with its backup file or vice versa. -Use the latest backup, if there are several numerical backups. -If this file is a backup, diff it with its original. -The backup file is the first file given to `diff'. -With prefix arg, prompt for SWITCHES which are the options for `diff'." - (interactive "e") - (let ((switches (and current-prefix-arg - (if (fboundp 'icicle-read-string-completing) ; In `icicles-fn.el' - (icicle-read-string-completing "Options for diff: " - (if (stringp diff-switches) - diff-switches - (mapconcat #'identity diff-switches " ")) - (lambda (c) - (diredp-string-match-p "switches" - (symbol-name c)))) - (read-string "Options for diff: " (if (stringp diff-switches) - diff-switches - (mapconcat #'identity diff-switches " ")))))) - (mouse-pos (event-start event))) - (select-window (posn-window mouse-pos)) - (goto-char (posn-point mouse-pos)) - (diff-backup (dired-get-filename) switches))) - -;;;###autoload -(defun diredp-mouse-mark (event) ; Not bound - "In Dired, mark this file. -If on a subdir headerline, mark all its files except `.' and `..'. - -Use \\[dired-unmark-all-files] to remove all marks, -and \\[dired-unmark] on a subdir to remove the marks in this subdir." - (interactive "e") - (let ((mouse-pos (event-start event))) - (select-window (posn-window mouse-pos)) - (goto-char (posn-point mouse-pos))) - (if (and (cdr dired-subdir-alist) (dired-get-subdir)) - (save-excursion (dired-mark-subdir-files)) - (let ((buffer-read-only nil)) - (dired-repeat-over-lines 1 #'(lambda () (delete-char 1) (insert dired-marker-char))) - (diredp-previous-line 1)))) - -;;;###autoload -(defun diredp-mouse-unmark (event) ; Not bound - "In Dired, unmark this file. -If looking at a subdir, unmark all its files except `.' and `..'." - (interactive "e") - (let ((mouse-pos (event-start event))) - (select-window (posn-window mouse-pos)) - (goto-char (posn-point mouse-pos))) - (let ((dired-marker-char ?\040)) (dired-mark nil)) - (diredp-previous-line 1)) - -;;; This can be bound to [C-down-mouse-1] to give behavior similar to Windows Explorer. -;;; However, Emacs generally uses [C-down-mouse-1] for `mouse-buffer-menu'. -;;;###autoload -(defun diredp-mouse-mark/unmark (event) ; Not bound - "Mark/unmark file or directory at mouse EVENT." - (interactive "e") - (let* ((mouse-pos (event-start event)) - (inhibit-field-text-motion t) ; Just in case. - (file/dir-name (with-current-buffer (window-buffer (posn-window mouse-pos)) - (save-excursion - (goto-char (posn-point mouse-pos)) - (and (not (eobp)) (dired-get-filename nil t)))))) - ;; Return nil iff not on a file or directory name. - (and file/dir-name (cond ((dired-file-marker file/dir-name) - (diredp-mouse-unmark event) - (message "Unmarked: %s" file/dir-name)) - (t - (diredp-mouse-mark event) - (message "Marked: %s" file/dir-name)))))) - -;; This can be bound to [S-mouse-1] to give behavior similar to Windows Explorer. -;; If you do that, consider binding `diredp-mouse-mark/unmark' to `C-mouse-1'. -;; Alternatively, just bind `diredp-mouse-mark/unmark-mark-region-files' to [S-mouse-1]. -;;;###autoload -(defun diredp-mouse-mark-region-files (event) ; Bound to `S-mouse-1' - "Mark files between point and the mouse." - (interactive "e") - (call-interactively 'mouse-save-then-kill) - (diredp-mark-region-files)) - -;; This can be bound to [S-mouse-1] to give behavior similar to Windows Explorer. -;; If you don't bind `diredp-mouse-mark/unmark' to, for instance, `C-mouse-1', then -;; Consider binding this to [S-mouse-1]. -;;;###autoload -(defun diredp-mouse-mark/unmark-mark-region-files (event) ; Not bound - "Mark/unmark file or mark files in region. -If the file the cursor is on is marked, then mark all files between it - and the line clicked (included). -Otherwise (cursor's file is unmarked): - If the file clicked is marked, then unmark it. - If it is unmarked, then mark it." - (interactive "e") - (let ((mouse-pos (event-start event))) - ;; If same click same line as cursor, or cursor's line is marked, - ;; Then toggle the clicked line's mark. - ;; Else mark all files in region between point and clicked line (included). - (if (or (eq (count-lines (point-min) (posn-point mouse-pos)) - (count-lines (point-min) (point))) - (equal dired-marker-char (dired-file-marker (dired-get-filename nil t)))) - (diredp-mouse-mark/unmark event) - (call-interactively 'mouse-save-then-kill) - (diredp-mark-region-files)))) - -;;;###autoload -(defun diredp-mouse-flag-file-deletion (event) ; Not bound - "In Dired, flag this file for deletion. -If on a subdir headerline, mark all its files except `.' and `..'." - (interactive "e") - (let ((mouse-pos (event-start event))) - (select-window (posn-window mouse-pos)) - (goto-char (posn-point mouse-pos))) - (let ((dired-marker-char dired-del-marker)) (dired-mark 1)) - (diredp-previous-line 1)) - -;;;###autoload -(defun diredp-mouse-do-copy (event) ; Not bound - "In Dired, copy this file. -This normally preserves the last-modified date when copying." - (interactive "e") - (let ((mouse-pos (event-start event))) - (select-window (posn-window mouse-pos)) - (goto-char (posn-point mouse-pos))) - (dired-do-create-files 'copy #'dired-copy-file (if dired-copy-preserve-time "Copy [-p]" "Copy") - 1 dired-keep-marker-copy)) - -;;;###autoload -(defun diredp-mouse-do-rename (event) ; Not bound - "In Dired, rename this file." - (interactive "e") - (let ((mouse-pos (event-start event))) - (select-window (posn-window mouse-pos)) - (goto-char (posn-point mouse-pos))) - (dired-do-create-files 'move #'dired-rename-file "Move" 1 dired-keep-marker-rename "Rename")) - -;;;###autoload -(defun diredp-mouse-upcase (event) ; Not bound - "In Dired, rename this file to upper case." - (interactive "e") - (let ((mouse-pos (event-start event))) - (select-window (posn-window mouse-pos)) - (goto-char (posn-point mouse-pos))) - (dired-rename-non-directory #'upcase "Rename to uppercase:" nil)) - -;;;###autoload -(defun diredp-mouse-downcase (event) ; Not bound - "In Dired, rename this file to lower case." - (interactive "e") - (let ((mouse-pos (event-start event))) - (select-window (posn-window mouse-pos)) - (goto-char (posn-point mouse-pos))) - (dired-rename-non-directory #'downcase "Rename to lowercase:" nil)) - -;;;###autoload -(defun diredp-mouse-do-delete (event) ; Not bound - "In Dired, delete this file, upon confirmation." - (interactive "e") - (let ((mouse-pos (event-start event))) - (select-window (posn-window mouse-pos)) - (goto-char (posn-point mouse-pos))) - (diredp-internal-do-deletions (dired-map-over-marks (cons (dired-get-filename) (point)) 1) - 1 - 'USE-TRASH-CAN) ; This arg is for Emacs 24+ only. - (diredp-previous-line 1)) - -;;;###autoload -(defun diredp-mouse-do-shell-command (event) ; Not bound - "Run a shell COMMAND on this file. -If there is output, it goes to a separate buffer. - -No automatic redisplay of Dired buffers is attempted, as there's no -telling what files the command may have changed. Type -\\[dired-do-redisplay] to redisplay. - -The shell command has the top level directory as working directory, so -output files usually are created there instead of in a subdir." - ;;Functions dired-run-shell-command and dired-shell-stuff-it do the - ;;actual work and can be redefined for customization. - (interactive "e") - (lexical-let ((mouse-pos (event-start event)) - (command (dired-read-shell-command "! on %s: " nil (dired-get-marked-files t nil)))) - (select-window (posn-window mouse-pos)) - (goto-char (posn-point mouse-pos)) - (dired-bunch-files (- 10000 (length command)) - (lambda (&rest files) (dired-run-shell-command (dired-shell-stuff-it command files t 1))) - nil - (dired-get-marked-files t 1)))) - -;;;###autoload -(defun diredp-mouse-do-symlink (event) ; Not bound - "Make symbolic link to this file." - (interactive "e") - (let ((mouse-pos (event-start event))) - (select-window (posn-window mouse-pos)) - (goto-char (posn-point mouse-pos))) - (dired-do-create-files 'symlink #'make-symbolic-link "Symlink" 1 dired-keep-marker-symlink)) - -;;;###autoload -(defun diredp-mouse-do-hardlink (event) ; Not bound - "Make hard link (alias) to this file." - (interactive "e") - (let ((mouse-pos (event-start event))) - (select-window (posn-window mouse-pos)) - (goto-char (posn-point mouse-pos))) - (dired-do-create-files 'hardlink #'add-name-to-file "Hardlink" 1 dired-keep-marker-hardlink)) - -;;;###autoload -(defun diredp-mouse-do-print (event) ; Not bound - "Print this file. -Uses the shell command coming from variables `lpr-command' and -`lpr-switches' as default." - (interactive "e") - (let ((mouse-pos (event-start event))) - (select-window (posn-window mouse-pos)) - (goto-char (posn-point mouse-pos))) - (let* ((file (dired-get-filename)) - (command (dired-mark-read-string "Print %s with: " - (apply 'concat lpr-command " " lpr-switches) - 'print 1 (list file)))) - (dired-run-shell-command (dired-shell-stuff-it command (list file) nil)))) - -;;;###autoload -(defun diredp-mouse-do-grep (event) ; Not bound - "Run grep against this file." - (interactive "e") - (let ((mouse-pos (event-start event))) - (select-window (posn-window mouse-pos)) - (goto-char (posn-point mouse-pos))) - (unless grep-command (grep-compute-defaults)) - (grep (diredp-do-grep-1 (list (dired-get-filename t))))) - -;;;###autoload -(defun diredp-mouse-do-compress (event) ; Not bound - "Compress or uncompress this file." - (interactive "e") - (let ((mouse-pos (event-start event)) - (dired-no-confirm t)) - (select-window (posn-window mouse-pos)) - (goto-char (posn-point mouse-pos)) - (dired-map-over-marks-check #'dired-compress 1 'compress t)) - (diredp-previous-line 1)) - -;;;###autoload -(defun diredp-mouse-do-byte-compile (event) ; Not bound - "Byte compile this file." - (interactive "e") - (let ((mouse-pos (event-start event)) - (dired-no-confirm t)) - (select-window (posn-window mouse-pos)) - (goto-char (posn-point mouse-pos)) - (dired-map-over-marks-check #'dired-byte-compile 1 'byte-compile t)) - (diredp-previous-line 1)) - -;;;###autoload -(defun diredp-mouse-do-load (event) ; Not bound - "Load this Emacs Lisp file." - (interactive "e") - (let ((mouse-pos (event-start event)) - (dired-no-confirm t)) - (select-window (posn-window mouse-pos)) - (goto-char (posn-point mouse-pos)) - (dired-map-over-marks-check #'dired-load 1 'load t)) - (diredp-previous-line 1)) - -;;;###autoload -(defun diredp-mouse-do-chmod (event) ; Not bound - "Change the mode of this file. -This calls chmod, so symbolic modes like `g+w' are allowed." - (interactive "e") - (let ((mouse-pos (event-start event))) - (select-window (posn-window mouse-pos)) - (goto-char (posn-point mouse-pos))) - (dired-do-chxxx "Mode" "chmod" 'chmod 1) - (diredp-previous-line 1)) - -(unless (memq system-type '(windows-nt ms-dos)) - (defun diredp-mouse-do-chgrp (event) ; Not bound - "Change the group of this file." - (interactive "e") - (let ((mouse-pos (event-start event))) - (select-window (posn-window mouse-pos)) - (goto-char (posn-point mouse-pos))) - (dired-do-chxxx "Group" "chgrp" 'chgrp 1) - (diredp-previous-line 1))) - -(unless (memq system-type '(windows-nt ms-dos)) - (defun diredp-mouse-do-chown (event) ; Not bound - "Change the owner of this file." - (interactive "e") - (let ((mouse-pos (event-start event))) - (select-window (posn-window mouse-pos)) - (goto-char (posn-point mouse-pos))) - (dired-do-chxxx "Owner" dired-chown-program 'chown 1) - (diredp-previous-line 1))) - - -;;; Breadcrumbs - -(when (fboundp 'define-minor-mode) - - ;; Macro `define-minor-mode' is not defined in Emacs 20, so in order to be able to byte-compile - ;; this file in Emacs 20, prohibit byte-compiling of the `define-minor-mode' call. - ;; - (eval '(define-minor-mode diredp-breadcrumbs-in-header-line-mode - "Toggle the use of breadcrumbs in Dired header line. -With arg, show breadcrumbs iff arg is positive." - :init-value nil :group 'header-line :group 'Dired-Plus - (unless (derived-mode-p 'dired-mode) - (error "You must be in Dired or a mode derived from it to use this command")) - (if diredp-breadcrumbs-in-header-line-mode - (diredp-set-header-line-breadcrumbs) - (setq header-line-format (default-value 'header-line-format))))) - - (defun diredp-set-header-line-breadcrumbs () - "Show a header line with breadcrumbs to parent directories." - (let ((parent (diredp-parent-dir default-directory)) - (dirs ()) - (text "")) - (while parent - (push parent dirs) - (setq parent (diredp-parent-dir parent))) - (dolist (dir dirs) - (let* ((crumbs-map (make-sparse-keymap)) - (menu-map (make-sparse-keymap "Breadcrumbs in Header Line")) - ;; The next three are for showing the root as absolute and the rest as relative. - (rootp (diredp-root-directory-p dir)) - (parent-rootp (and (not rootp) (diredp-root-directory-p (diredp-parent-dir dir)))) - (rdir dir)) - ;; (define-key crumbs-map [header-line mouse-3] menu-map) - (unless rootp (setq rdir (file-name-nondirectory (directory-file-name dir)))) - (when dir - (setq rdir (propertize rdir - 'local-map (progn (define-key crumbs-map [header-line mouse-1] - `(lambda () (interactive) - (dired ,dir dired-actual-switches))) - (define-key crumbs-map [header-line mouse-2] - `(lambda () (interactive) - (dired-other-window ,dir dired-actual-switches))) - crumbs-map) - 'mouse-face 'mode-line-highlight - ;;'help-echo "mouse-1: Dired; mouse-2: Dired in other window; mouse-3: Menu")) - 'help-echo "mouse-1: Dired; mouse-2: Dired in other window")) - (setq text (concat text (if (or rootp parent-rootp) " " " / ") rdir))))) - (make-local-variable 'header-line-format) - (setq header-line-format text))) - - ;; Users can do this. - ;; - ;; (add-hook 'dired-before-readin-hook 'diredp-breadcrumbs-in-header-line-mode) - - ) - - -;;; `Dired+' Help - -;;;###autoload -(defun diredp-describe-mode (&optional buffer) - "Describe Dired mode, including Dired+ features. -This is `describe-mode' plus a description of Dired+ features. -For just the latter, use \\`\\[diredp-dired-plus-help]'." - (interactive "@") - (unless (derived-mode-p 'dired-mode) - (error "Use `diredp-dired-plus-help' if you want information about Dired+")) - (with-current-buffer (or buffer (current-buffer)) (describe-mode)) - (with-current-buffer (get-buffer-create "*Help*") - (save-excursion - (goto-char (point-min)) - (diredp-dired-plus-help-link) - (let ((buffer-read-only nil)) (insert "\n")) - (when (re-search-forward "Keybindings:\nkey\\s-+binding\n---\\s-+-------" nil t) - (goto-char (match-beginning 0)) - (let ((buffer-read-only nil)) - (insert "\f\n") - (diredp-dired-plus-description+links) - (insert "\f\n")))))) - -;;;###autoload -(defun diredp-dired-plus-help () - "Describe Dired+." - (interactive "@") - (diredp-with-help-window "*Help*" (diredp-dired-plus-description+links))) - -(defun diredp-dired-plus-description+links () - "Insert Dired+ help text in `*Help*'." - (with-current-buffer (get-buffer-create "*Help*") - (let ((buffer-read-only nil)) - (save-restriction - (narrow-to-region (point) (point)) - (diredp-dired-plus-help-link) - (insert (diredp-dired-plus-description)) - (goto-char (point-max)) - (insert "\n") - (diredp-dired-plus-help-link))))) - -(when (and (> emacs-major-version 21) - (require 'help-mode nil t) - (get 'help-xref 'button-category-symbol)) ; `button.el' - (define-button-type 'diredp-help-button - :supertype 'help-xref - 'help-function #'(lambda () (browse-url "https://www.emacswiki.org/emacs/DiredPlus")) - 'help-echo - (purecopy "mouse-2, RET: Dired+ documentation on the Emacs Wiki (requires \ -Internet access)"))) - -(defun diredp-dired-plus-help-link () - "Add Web link for Dired+ help, and reminder about sending bug report." - ;; Don't bother to do this for Emacs 21.3. Its `help-insert-xref-button' is different. - (when (and (> emacs-major-version 21) - (require 'help-mode nil t) - (fboundp 'help-insert-xref-button)) ; `help-mode.el'. - (let ((buffer-read-only nil)) - (help-insert-xref-button "[Dired+ Help on the Web]" 'diredp-help-button) - (insert (substitute-command-keys - "\t\tSend a Dired+ bug report:\n\t\t\t\t\t`\\[diredp-send-bug-report]'\n"))))) - -(defun diredp-dired-plus-description () - "Dired+ description." - (substitute-command-keys - (concat - "\\\ - Dired+ Features - --------------- - -To see or customize the Dired+ options or faces, use -`M-x customize-option diredp TAB' or `M-x customize-face diredp TAB'. - -Most keys listed here are in addition to those for vanilla Dired. - -Menus ------ - -Many Dired+ actions are available from the menu-bar menus and the -`mouse-3' context menu. This may include commands shown here as not -being bound to keys (i.e., listed as `M-x ...'). - -General Here ------------- - -" - (and (fboundp 'diredp-w32-drives) - " \\[diredp-w32-drives]\t\t- Go up to a list of MS Windows drives -") - (and (fboundp 'dired-hide-details-mode) - " \\[dired-hide-details-mode]\t\t- Hide/show details -") - - " \\[revert-buffer]\t\t- Refresh (sync and show all) - \\[diredp-toggle-find-file-reuse-dir]\t- Toggle reusing directories -" - " \\[diredp-marked-other-window]\t\t- Open Dired on marked files here - \\[diredp-dired-inserted-subdirs]\t\t- Dired separately each subdir inserted here -" - (and (featurep 'bookmark+) - " \\[diredp-highlight-autofiles-mode]\t- Toggle autofile highlighting - -") - - "General Globally ----------------- - -\\\ - \\[diredp-add-to-dired-buffer]\t- Add files to a Dired buffer - \\[diredp-fileset]\t- Open Dired on files in a fileset - \\[diredp-dired-recent-dirs]\t- Open Dired on recently used dirs - \\[diredp-dired-union]\t- Create union of some Dired buffers - \\[diredp-dired-for-files]\t- Open Dired on files located anywhere -\\\ - -Mouse ------ - - \\[diredp-mouse-3-menu]\t- Context-sensitive menu -" - - (and (where-is-internal 'diredp-mouse-describe-file dired-mode-map) - " \\[diredp-mouse-describe-file]\t- Describe file -") - - (and (where-is-internal 'diredp-mouse-describe-autofile dired-mode-map) - " \\[diredp-mouse-describe-autofile]\t- Describe autofile -") - - " \\[diredp-mouse-mark-region-files]\t\t- Mark all in region -" - - (and (fboundp 'dired-mouse-w32-browser) ; In `w32-browser.el'. - (where-is-internal 'dired-mouse-w32-browser dired-mode-map) - " \\[dired-mouse-w32-browser]\t\t- MS Windows `Open' action -") - (and (fboundp 'dired-mouse-w32-browser-reuse-dir-buffer) ; In `w32-browser.el'. - (where-is-internal 'dired-mouse-w32-browser-reuse-dir-buffer dired-mode-map) - " \\[dired-mouse-w32-browser-reuse-dir-buffer]\t- MS Windows `Open' action -") - - (and (where-is-internal 'dired-mouse-find-file dired-mode-map) - " \\[dired-mouse-find-file]\t- Open in this window -") - (and (where-is-internal 'diredp-mouse-find-file-reuse-dir-buffer dired-mode-map) - " \\[diredp-mouse-find-file-reuse-dir-buffer]\t- Open in this window -") - - (and (where-is-internal 'dired-mouse-find-file-other-window dired-mode-map) - " \\[dired-mouse-find-file-other-window]\t\t- Open in another window -") - - " \\[diredp-mouse-find-file-other-frame]\t\t- Open in another frame -" - - " -Marking -------- - - \\[dired-mark]\t\t- Mark this file/dir - \\[dired-unmark]\t\t- Unmark this file/dir - \\[dired-toggle-marks]\t\t- Toggle marked/unmarked - \\[dired-mark-sexp]\t\t- Mark all satisfying a predicate - \\[dired-unmark-all-marks]\t\t- Unmark all - \\[diredp-mark/unmark-extension]\t\t- Mark/unmark all that have a given extension -" - - (and (fboundp 'dired-mark-omitted) ; In `dired-x.el' Emacs 22+. - " \\[dired-mark-omitted]\t\t- Mark omitted -") - - " \\[diredp-mark-files-tagged-regexp]\t\t- Mark those with a tag that matches a regexp - \\[diredp-unmark-files-tagged-regexp]\t\t- Unmark those with a tag that matches a regexp - \\[diredp-mark-files-tagged-all]\t\t- Mark those with all of the given tags - \\[diredp-unmark-files-tagged-all]\t\t- Unmark those with all of the given tags - \\[diredp-mark-files-tagged-some]\t\t- Mark those with some of the given tags - \\[diredp-unmark-files-tagged-some]\t\t- Unmark those with some of the given tags - \\[diredp-mark-files-tagged-not-all]\t- Mark those without some of the given tags - \\[diredp-unmark-files-tagged-not-all]\t- Unmark those without some of the given tags - \\[diredp-mark-files-tagged-none]\t- Mark those with none of the given tags - \\[diredp-unmark-files-tagged-none]\t- Unmark those with none of the given tags -" - - " -Current file/subdir (current line) ----------------------------------- - - \\[diredp-describe-file]\t- Describe - \\[dired-find-file]\t\t- Open -" - (and (fboundp 'dired-mouse-w32-browser) ; In `w32-browser.el'. - (where-is-internal 'dired-mouse-w32-browser dired-mode-map) - " \\[dired-mouse-w32-browser]\t- MS Windows `Open' action - \\[dired-w32explore]\t- MS Windows Explorer -") - - " \\[diredp-byte-compile-this-file]\t\t- Byte-compile - \\[diredp-compress-this-file]\t\t- Compress/uncompress - \\[diredp-print-this-file]\t\t- Print - \\[diredp-relsymlink-this-file]\t\t- Create relative symlink - \\[diredp-delete-this-file]\t\t- Delete (with confirmation) - \\[diredp-rename-this-file]\t\t- Rename - \\[diredp-capitalize-this-file]\t\t- Capitalize (rename) - \\[diredp-upcase-this-file]\t\t- Rename to uppercase - \\[diredp-downcase-this-file]\t\t- Rename to lowercase - \\[diredp-ediff]\t\t- Ediff - \\[diredp-bookmark-this-file]\t\t- Bookmark -" - (and (featurep 'bookmark+) - " \\[diredp-tag-this-file]\t\t- Add some tags to this file/dir - \\[diredp-untag-this-file]\t\t- Remove some tags from this file/dir - \\[diredp-remove-all-tags-this-file]\t\t- Remove all tags from this file/dir - \\[diredp-copy-tags-this-file]\t\t- Copy the tags from this file/dir - \\[diredp-paste-add-tags-this-file]\t\t- Paste (add) copied tags to this file/dir - \\[diredp-paste-replace-tags-this-file]\t\t- Paste (replace) tags for this file/dir - \\[diredp-set-tag-value-this-file]\t\t- Set a tag value for this file/dir -") - - (and (fboundp 'dired-mouse-w32-browser-reuse-dir-buffer) ; In `w32-browser.el'. - (where-is-internal 'dired-mouse-w32-browser-reuse-dir-buffer dired-mode-map) - " \\[dired-mouse-w32-browser-reuse-dir-buffer]\t- MS Windows `Open' action - \\[dired-w32explore]\t- MS Windows Explorer -") - - " -Marked (or next prefix arg) files & subdirs here ------------------------------------------------- -" - (and (fboundp 'dired-multiple-w32-browser) ; In `w32-browser.el'. - " - \\[dired-multiple-w32-browser]\t- MS Windows `Open' action -") - - - " \\[diredp-list-marked]\t\t- List marked files and directories - \\[diredp-insert-subdirs]\t\t- Insert marked subdirectories - \\[dired-copy-filename-as-kill]\t\t- Copy names for pasting - M-o \\[dired-copy-filename-as-kill]\t\t- Copy absolute names for pasting - \\[diredp-yank-files]\t\t- Paste files whose absolute names you copied - \\[dired-do-find-marked-files]\t\t- Visit - \\[dired-do-copy]\t\t- Copy - \\[dired-do-rename]\t\t- Rename/move - \\[diredp-do-grep]\t\t- Run `grep' - \\[dired-do-search]\t\t- Search -" - (and (fboundp 'dired-do-find-regexp) ; Emacs 25+ - " \\[dired-do-find-regexp]\t\t- Search using `find' -") - - (if (fboundp 'dired-do-query-replace-regexp) ; Emacs 22+ - " \\[dired-do-query-replace-regexp]\t\t- Query-replace -" - " \\[dired-do-query-replace]\t\t- Query-replace -") - - (and (fboundp 'dired-do-find-regexp-and-replace) - " \\[dired-do-find-regexp-and-replace]\t\t- Query-replace using `find' -") - - (and (fboundp 'dired-do-isearch) - " \\[dired-do-isearch]\t- Isearch - \\[dired-do-isearch-regexp]\t- Regexp isearch -") - - (and (fboundp 'dired-do-async-shell-command) - " \\[dired-do-async-shell-command]\t\t- Run shell command asynchronously -") - - " \\[dired-do-shell-command]\t\t- Run shell command - \\[diredp-marked-other-window]\t\t- Dired - \\[dired-do-compress]\t\t- Compress - \\[dired-do-byte-compile]\t\t- Byte-compile - \\[dired-do-load]\t\t- Load (Emacs Lisp) - \\[diredp-do-apply-function]\t\t- Apply Lisp function - \\[diredp-do-emacs-command]\t\t- Invoke Emacs command -" - (and (fboundp 'diredp-read-expression) ; Emacs 22+ - " \\[diredp-do-lisp-sexp]\t\t- Evaluate Lisp sexp -") - - " \\[diredp-omit-marked]\t- Omit - \\[diredp-omit-unmarked]\t- Omit unmarked -" - - (and (featurep 'bookmark+) - " - \\[diredp-do-tag]\t\t- Add some tags to marked - \\[diredp-do-untag]\t\t- Remove some tags from marked - \\[diredp-do-remove-all-tags]\t\t- Remove all tags from marked - \\[diredp-do-paste-add-tags]\t- Paste (add) copied tags to marked - \\[diredp-do-paste-replace-tags]\t\t- Paste (replace) tags for marked - \\[diredp-do-set-tag-value]\t\t- Set a tag value for marked - \\[diredp-mark-files-tagged-regexp]\t\t- Mark those with a tag that matches a regexp - \\[diredp-mark-files-tagged-all]\t\t- Mark those with all of the given tags - \\[diredp-mark-files-tagged-some]\t\t- Mark those with some of the given tags - \\[diredp-mark-files-tagged-not-all]\t- Mark those without some of the given tags - \\[diredp-mark-files-tagged-none]\t- Mark those with none of the given tags - \\[diredp-unmark-files-tagged-regexp]\t\t- Unmark those with a tag that matches a regexp - \\[diredp-unmark-files-tagged-all]\t\t- Unmark those with all of the given tags - \\[diredp-unmark-files-tagged-some]\t\t- Unmark those with some of the given tags - \\[diredp-unmark-files-tagged-not-all]\t- Unmark those without some of the given tags - \\[diredp-unmark-files-tagged-none]\t- Unmark those with none of the given tags") - - " - - \\[diredp-do-bookmark]\t\t- Bookmark -" - - (and (featurep 'bookmark+) - " \\[diredp-set-bookmark-file-bookmark-for-marked]\t\t- \ -Bookmark and create bookmark-file bookmark - \\[diredp-do-bookmark-in-bookmark-file]\t- Bookmark in specific bookmark file -") - - " -Here and below (in marked subdirs) ----------------------------------- -" - (and (fboundp 'dired-multiple-w32-browser) ; In `w32-browser.el'. - " - \\[diredp-multiple-w32-browser-recursive]\t- MS Windows `Open' action -") - - " \\[diredp-list-marked-recursive]\t\t- List marked files and directories - \\[diredp-insert-subdirs-recursive]\t\t- Insert marked subdirectories - \\[diredp-copy-filename-as-kill-recursive]\t\t- Copy names for pasting - \\[diredp-do-find-marked-files-recursive]\t\t\t- Visit - \\[diredp-do-print-recursive]\t\t\t- Print - \\[diredp-do-copy-recursive]\t\t\t- Copy - \\[diredp-do-move-recursive]\t\t\t- Move - \\[diredp-do-touch-recursive]\t\t- Touch (update timestamp) - \\[diredp-do-chmod-recursive]\t\t\t- Change mode - - \\[diredp-do-symlink-recursive]\t\t\t- Add symbolic links - \\[diredp-do-relsymlink-recursive]\t\t\t- Add relative symbolic links - \\[diredp-do-hardlink-recursive]\t\t\t- Add hard links - - \\[diredp-capitalize-recursive]\t\t- Capitalize - \\[diredp-downcase-recursive]\t\t- Downcase - \\[diredp-upcase-recursive]\t\t- Upcase -" - (and (fboundp 'epa-dired-do-encrypt) ; Emacs 23+ - " - \\[diredp-do-encrypt-recursive]\t\t- Encrypt - \\[diredp-do-decrypt-recursive]\t\t- Decrypt - \\[diredp-do-sign-recursive]\t\t- Sign - \\[diredp-do-verify-recursive]\t\t- Verify -") - - " - \\[diredp-do-grep-recursive]\t\t- `grep' - \\[diredp-do-search-recursive]\t\t\t- Search - \\[diredp-do-query-replace-regexp-recursive]\t\t\t- Query-replace - \\[diredp-do-isearch-recursive]\t\t- Isearch - \\[diredp-do-isearch-regexp-recursive]\t- Regexp isearch -" - (and (fboundp 'diredp-do-async-shell-command-recursive) ; Emacs 23+ - " - \\[diredp-do-async-shell-command-recursive]\t\t\t- Run shell command asynchronously -") - - " \\[diredp-do-shell-command-recursive]\t\t\t- Run shell command - \\[diredp-do-apply-function-recursive]\t\t\t- Apply Lisp function - - \\[diredp-marked-recursive-other-window]\t\t- Dired - \\[diredp-list-marked-recursive]\t\t- List - - \\[diredp-image-dired-comment-files-recursive]\t\t- Add image comment - \\[diredp-image-dired-display-thumbs-recursive]\t\t- Show thumbnail images - \\[diredp-image-dired-tag-files-recursive]\t\t- Tag images - \\[diredp-image-dired-delete-tag-recursive]\t\t- Delete image tags - - \\[diredp-do-bookmark-recursive]\t\t- Bookmark -" - (and (featurep 'bookmark+) - " \\[diredp-do-bookmark-in-bookmark-file-recursive]\t\t- Bookmark in bookmark file - \\[diredp-set-bookmark-file-bookmark-for-marked-recursive]\t\t- Create bookmark-file bookmark -") - - " - \\[diredp-mark-directories-recursive]\t\t- Mark directories - \\[diredp-mark-executables-recursive]\t\t- Mark executables - \\[diredp-mark-symlinks-recursive]\t\t- Mark symbolic links - \\[diredp-mark-files-containing-regexp-recursive]\t\t- Mark content regexp matches - \\[diredp-mark-files-regexp-recursive]\t\t- Mark filename regexp matches -" - (and (featurep 'bookmark+) - " \\[diredp-mark-autofiles-recursive]\t\t- Mark autofiles -") - " \\[diredp-flag-auto-save-files-recursive]\t\t\t- Flag auto-save - \\[diredp-do-delete-recursive]\t\t\t- Delete marked (not flagged) - \\[diredp-change-marks-recursive]\t\t- Change marks - \\[diredp-unmark-all-files-recursive]\t\t- Remove a given mark - \\[diredp-unmark-all-marks-recursive]\t\t\t- Remove all marks -" - (and (featurep 'bookmark+) -" - -Tagging -------- - - \\[diredp-tag-this-file]\t\t- Add some tags to this file/dir - \\[diredp-untag-this-file]\t\t- Remove some tags from this file/dir - \\[diredp-remove-all-tags-this-file]\t\t- Remove all tags from this file/dir - \\[diredp-copy-tags-this-file]\t\t- Copy the tags from this file/dir - \\[diredp-paste-add-tags-this-file]\t\t- Paste (add) copied tags to this file/dir - \\[diredp-paste-replace-tags-this-file]\t\t- Paste (replace) tags for this file/dir - \\[diredp-set-tag-value-this-file]\t\t- Set a tag value for this file/dir - \\[diredp-do-tag]\t\t- Add some tags to marked - \\[diredp-do-untag]\t\t- Remove some tags from marked - \\[diredp-do-remove-all-tags]\t\t- Remove all tags from marked - \\[diredp-do-paste-add-tags]\t- Paste (add) copied tags to marked - \\[diredp-do-paste-replace-tags]\t\t- Paste (replace) tags for marked - \\[diredp-do-set-tag-value]\t\t- Set a tag value for marked - \\[diredp-mark-files-tagged-regexp]\t\t- Mark those with a tag that matches a regexp - \\[diredp-mark-files-tagged-all]\t\t- Mark those with all of the given tags - \\[diredp-mark-files-tagged-some]\t\t- Mark those with some of the given tags - \\[diredp-mark-files-tagged-not-all]\t- Mark those without some of the given tags - \\[diredp-mark-files-tagged-none]\t- Mark those with none of the given tags - \\[diredp-unmark-files-tagged-regexp]\t\t- Unmark those with a tag that matches a regexp - \\[diredp-unmark-files-tagged-all]\t\t- Unmark those with all of the given tags - \\[diredp-unmark-files-tagged-some]\t\t- Unmark those with some of the given tags - \\[diredp-unmark-files-tagged-not-all]\t- Unmark those without some of the given tags - \\[diredp-unmark-files-tagged-none]\t- Unmark those with none of the given tags -") - - " -Bookmarking ------------ - - \\[diredp-bookmark-this-file]\t\t- Bookmark this file/dir - \\[diredp-do-bookmark]\t\t- Bookmark marked" - - (and (featurep 'bookmark+) - " - \\[diredp-set-bookmark-file-bookmark-for-marked]\t\t- \ -Bookmark marked and create bookmark-file bookmark - \\[diredp-do-bookmark-in-bookmark-file]\t- Bookmark marked, in specific bookmark file -") - - " \\[diredp-do-bookmark-recursive]\t- Bookmark marked, here and below -" - (and (featurep 'bookmark+) - " \\[diredp-do-bookmark-in-bookmark-file-recursive]\t- \ -Bookmark marked, here and below, in specific file - \\[diredp-set-bookmark-file-bookmark-for-marked-recursive]\t- \ -Set bookmark-file bookmark for marked here and below -") - - ))) - -(when (> emacs-major-version 21) - (defun diredp-nb-marked-in-mode-name () - "Show number of marked, flagged, and current-list lines in mode-line. -\(Flagged means flagged for deletion.) -If the current line is marked/flagged and there are others -marked/flagged after it then show `N/M', where `N' is the number -marked/flagged through the current line and `M' is the total number -marked/flagged. - -If the current line is for a file then show `L/T', where `L' is the -line number in the current listing and `T' is the number of files in -that listing. If option `diredp-count-.-and-..-flag' is non-nil then -count also `.' and `..'. - -Also abbreviate `mode-name', using \"Dired/\" instead of \"Dired by\"." - (let ((mname (format-mode-line mode-name))) - ;; Property `dired+-mode-name' indicates whether `mode-name' has been changed. - (unless (get-text-property 0 'dired+-mode-name mname) - (save-match-data - (setq mode-name - `(,(propertize (if (string-match "^[dD]ired \\(by \\)?\\(.*\\)" mname) - (format "Dired/%s" (match-string 2 mname)) - mname) - 'dired+-mode-name t) - (:eval (let* ((dired-marker-char (if (eq ?D dired-marker-char) - ?* ; `dired-do-flagged-delete' binds it. - dired-marker-char)) - (marked-regexp (dired-marker-regexp)) - (nb-marked (count-matches marked-regexp - (point-min) (point-max)))) - (if (not (> nb-marked 0)) - "" - (propertize - (format " %s%d%c" - (save-excursion - (forward-line 0) - (if (diredp-looking-at-p (concat marked-regexp ".*")) - (format "%d/" (1+ (count-matches - marked-regexp - (point-min) (point)))) - "")) - nb-marked dired-marker-char) - 'face 'diredp-mode-line-marked 'dired+-mode-name t)))) - (:eval (let* ((flagged-regexp (let ((dired-marker-char dired-del-marker)) - (dired-marker-regexp))) - (nb-flagged (count-matches flagged-regexp - (point-min) (point-max)))) - (if (not (> nb-flagged 0)) - "" - (propertize - (format " %s%dD" - (save-excursion - (forward-line 0) - (if (diredp-looking-at-p (concat flagged-regexp ".*")) - (format "%d/" (1+ (count-matches - flagged-regexp - (point-min) (point)))) - "")) - nb-flagged) - 'face 'diredp-mode-line-flagged)))) - (:eval (save-excursion - (let ((this 0) - (total 0) - (o-pt (line-beginning-position)) - (e-pt (or (condition-case nil - (let ((diredp-wrap-around-flag nil)) - (save-excursion - (diredp-next-subdir 1) - (line-beginning-position))) - (error nil)) - (save-excursion (goto-char (point-max)) (line-beginning-position))))) - (when dired-subdir-alist (dired-goto-subdir (dired-current-directory))) - (while (and (<= (point) e-pt) - (< (point) (point-max))) ; Hack to work around Emacs display-engine bug. - (when (condition-case nil - (dired-get-filename nil diredp-count-.-and-..-flag) - (error nil)) - (when (<= (line-beginning-position) o-pt) (setq this (1+ this))) - (setq total (1+ total))) - (forward-line 1)) - (if (not (> this 0)) (format " %d" total) (format " %d/%d" this total))))))))))) - - (add-hook 'dired-after-readin-hook 'diredp-nb-marked-in-mode-name) - ;; This one is needed for `find-dired', because it does not call `dired-readin'. - (add-hook 'dired-mode-hook 'diredp-nb-marked-in-mode-name)) - -;;;###autoload -(defun diredp-send-bug-report () - "Send a bug report about a Dired+ problem." - (interactive) - (browse-url (format (concat "mailto:" "drew.adams" "@" "oracle" ".com?subject=\ -Dired+ bug: \ -&body=Describe bug below, using a precise recipe that starts with `emacs -Q' or `emacs -q'. \ -File `dired+.el' has a header `Update #' that you can use to identify it.\ -%%0A%%0AEmacs version: %s.") - (emacs-version)))) - -(defun diredp-visit-ignore-regexp () ; Taken from `image-file-name-regexp'. - "Return a regular expression matching file names to skip. -This is used by `dired-visit-(next|previous)'." - (let ((exts-regexp (and diredp-visit-ignore-extensions - (concat "\\." (regexp-opt (nconc (mapcar #'upcase diredp-visit-ignore-extensions) - diredp-visit-ignore-extensions) - t) - "\\'")))) - (if diredp-visit-ignore-regexps - (mapconcat #'identity (if exts-regexp - (cons exts-regexp diredp-visit-ignore-regexps) - diredp-visit-ignore-regexps) - "\\|") - exts-regexp))) - -;;;###autoload -(defun diredp-visit-next-file (&optional arg) ; Bound to `C-down' - "Move down a line and visit its file in another window. -With numeric prefix arg N, move down N-1 lines first. - -After moving N lines, skip any lines with file names that match either -`diredp-visit-ignore-extensions' or `diredp-visit-ignore-regexps'. - -Kill the last buffer visited by a `dired-visit-*' command." - (interactive "p") - (dired-next-line arg) - (while (diredp-string-match-p (diredp-visit-ignore-regexp) (dired-get-file-for-visit)) - (dired-next-line 1)) - (diredp-visit-this-file)) - -;;;###autoload -(defun diredp-visit-previous-file (&optional arg) ; Bound to `C-up' - "Move up a line and visit its file in another window. -With numeric prefix arg N, move up N-1 lines first. - -After moving N lines, skip any lines with file names that match either -`diredp-visit-ignore-extensions' or `diredp-visit-ignore-regexps'. - -Kill the last buffer visited by a `dired-visit-*' command." - (interactive "p") - (dired-previous-line arg) - (while (diredp-string-match-p (diredp-visit-ignore-regexp) (dired-get-file-for-visit)) - (dired-previous-line 1)) - (diredp-visit-this-file)) - -;;;###autoload -(defun diredp-visit-this-file () ; Bound to `e' (replaces `dired-find-file' binding) - "View the file on this line in another window in the same frame. -If it was not already shown there then kill the previous buffer -visited by a `dired-visit-*' command. - -If it was already shown there, and if it and Dired are the only -windows there, then delete its window (toggle : show/hide the file)." - (interactive) - (let ((file (dired-get-file-for-visit)) - (obuf (current-buffer)) - (shown nil) - fwin) - (unless (or (and (fboundp 'window-parent) (window-parent)) - (not (one-window-p 'NOMINI))) - (split-window)) - (save-selected-window - (other-window 1) - (setq fwin (selected-window)) - (unless (or (setq shown (or (equal (current-buffer) (get-file-buffer file)) - (memq (current-buffer) (dired-buffers-for-dir file)))) - (equal obuf (current-buffer))) - (kill-buffer (current-buffer)))) - (if shown - (when (= 2 (count-windows 'NOMINI)) (delete-window fwin)) - (set-window-buffer fwin (find-file-noselect file))))) - -;;; Key Bindings. - - -;; Menu Bar. -;; New order is (left -> right): -;; -;; Dir Regexp Mark Multiple Single - -;; Get rid of menu bar predefined in `dired.el'. -(define-key dired-mode-map [menu-bar] nil) -;; Get rid of Edit menu bar menu to save space. -(define-key dired-mode-map [menu-bar edit] 'undefined) - - -;; `Single' menu. -;; -;; REPLACE ORIGINAL `Immediate' menu in `dired.el'. -;; -(defvar diredp-menu-bar-single-menu (make-sparse-keymap "Single")) -(define-key dired-mode-map [menu-bar immediate] (cons "Single" diredp-menu-bar-single-menu)) - -;; We don't use `define-obsolete-variable-alias' so that byte-compilation in older Emacs -;; works for newer Emacs too. -(when (fboundp 'defvaralias) ; Emacs 22+ - (defvaralias 'diredp-menu-bar-immediate-menu 'diredp-menu-bar-single-menu)) -(make-obsolete-variable 'diredp-menu-bar-immediate-menu 'diredp-menu-bar-single-menu) ; 2017-04-09 - -(if (fboundp 'diredp-describe-file) - (define-key diredp-menu-bar-single-menu [diredp-describe-file] - '(menu-item "Describe" diredp-describe-file - :help "Describe the file or directory at cursor")) - (define-key diredp-menu-bar-single-menu [diredp-describe-autofile] - '(menu-item "Describe" diredp-describe-autofile - :help "Describe the autofile at cursor" - :enable (featurep 'bookmark+)))) -(define-key diredp-menu-bar-single-menu [separator-describe] '("--")) ; --------------------- - -(when (fboundp 'diredp-chown-this-file) - (define-key diredp-menu-bar-single-menu [chown] - '(menu-item "Change Owner..." diredp-chown-this-file - :help "Change the owner of file at cursor"))) -(when (fboundp 'diredp-chgrp-this-file) - (define-key diredp-menu-bar-single-menu [chgrp] - '(menu-item "Change Group..." diredp-chgrp-this-file - :help "Change the group of file at cursor"))) -(define-key diredp-menu-bar-single-menu [chmod] - '(menu-item "Change Mode..." diredp-chmod-this-file - :help "Change mode (attributes) of file at cursor")) -(when (fboundp 'dired-do-touch) ; Emacs 22+ - (define-key diredp-menu-bar-single-menu [touch] - '(menu-item "Change Timestamp (`touch')..." diredp-touch-this-file - :help "Change the timestamp of file at cursor, using `touch'"))) -(define-key diredp-menu-bar-single-menu [separator-change] '("--")) ; ----------------------- - -(define-key diredp-menu-bar-single-menu [print] - '(menu-item "Print..." diredp-print-this-file - :help "Print file at cursor, supplying print command")) -(define-key diredp-menu-bar-single-menu [grep] - '(menu-item "Grep..." diredp-grep-this-file :help "Grep file at cursor")) -(define-key diredp-menu-bar-single-menu [compress] - '(menu-item "Compress/Uncompress" diredp-compress-this-file - :help "Compress/uncompress file at cursor")) -(define-key diredp-menu-bar-single-menu [command] - '(menu-item "Shell Command..." diredp-shell-command-this-file - :help "Run a shell command on file at cursor")) -(define-key diredp-menu-bar-single-menu [diredp-async-shell-command-this-file] - '(menu-item "Asynchronous Shell Command..." diredp-async-shell-command-this-file - :help "Run a shell command asynchronously on file at cursor")) -(define-key diredp-menu-bar-single-menu [compile] - '(menu-item "Byte Compile" diredp-byte-compile-this-file - :help "Byte-compile this Emacs Lisp file")) -(define-key diredp-menu-bar-single-menu [load] - '(menu-item "Load" diredp-load-this-file - :help "Load this Emacs Lisp file")) - -(when (fboundp 'mkhtml-dired-files) ; In `mkhtml.el'. - (define-key diredp-menu-bar-single-menu [mkhtml-dired-files] - '(menu-item "Create HTML" mkhtml-dired-files - :help "Create an HTML file corresponding to file at cursor"))) -(define-key diredp-menu-bar-single-menu [separator-misc] '("--")) ; ------------------------- - -(define-key diredp-menu-bar-single-menu [delete] - '(menu-item "Delete" diredp-delete-this-file :help "Delete file at cursor")) -(define-key diredp-menu-bar-single-menu [separator-delete] '("--")) ; ----------------------- - -(define-key diredp-menu-bar-single-menu [backup-diff] - '(menu-item "Diff with Backup" dired-backup-diff - :help "Diff file at cursor with its latest backup")) -(define-key diredp-menu-bar-single-menu [diff] - '(menu-item "Diff..." dired-diff - :help "Compare file at cursor with another file using `diff'")) -(define-key diredp-menu-bar-single-menu [ediff] - '(menu-item "Compare..." diredp-ediff :help "Compare file at cursor with another file")) -(define-key diredp-menu-bar-single-menu [separator-diff] '("--")) ; ------------------------- - -(define-key diredp-menu-bar-single-menu [diredp-kill-this-tree] - '(menu-item "Remove This Inserted Subdir and Lower" diredp-kill-this-tree - :visible (and (fboundp 'diredp-kill-this-tree) - (not (equal - (expand-file-name (dired-current-directory)) - (expand-file-name default-directory)))))) ; In subdir, not top. -(define-key diredp-menu-bar-single-menu [dired-kill-subdir] - '(menu-item "Remove This Inserted Subdir" dired-kill-subdir - :visible (not (equal (expand-file-name (dired-current-directory)) - (expand-file-name default-directory))))) ; In subdir, not top. -(define-key diredp-menu-bar-single-menu [diredp-dired-this-subdir] - '(menu-item "Dired This Inserted Subdir (Tear Off)" - (lambda () (interactive) (diredp-dired-this-subdir t)) - :visible (and (cdr dired-subdir-alist) ; First is current dir. Must have at least one more. - (not (equal (expand-file-name (dired-current-directory)) - (expand-file-name default-directory)))) ; Must be sub, not top. - :help "Open Dired for subdir at or above point, tearing it off if inserted")) -(define-key diredp-menu-bar-single-menu [insert-subdir] - '(menu-item "Insert This Subdir" dired-maybe-insert-subdir - :visible (and (atom (diredp-this-subdir)) - (not (assoc (file-name-as-directory (diredp-this-subdir)) dired-subdir-alist))) - :enable (atom (diredp-this-subdir)) - :help "Insert a listing of this subdirectory")) -(define-key diredp-menu-bar-single-menu [goto-subdir] - '(menu-item "Go To Inserted Subdir" dired-maybe-insert-subdir - :visible (and (atom (diredp-this-subdir)) - (assoc (file-name-as-directory (diredp-this-subdir)) dired-subdir-alist)) - :enable (atom (diredp-this-subdir)) - :help "Go to the inserted listing of this subdirectory")) -(define-key diredp-menu-bar-single-menu [separator-subdir] '("--" ; ------------------------ - :visible (or (atom (diredp-this-subdir)) ; Subdir line. - (not (equal (expand-file-name (dired-current-directory)) - (expand-file-name default-directory)))))) ; Not top. - -(define-key diredp-menu-bar-single-menu [view] - '(menu-item "View (Read Only)" dired-view-file - :help "Examine file at cursor in read-only mode")) -(define-key diredp-menu-bar-single-menu [display] - '(menu-item "Display in Other Window" dired-display-file - :help "Display file at cursor in a different window")) - - -;; `Single' > `Open' menu. -;; -(defvar diredp-single-open-menu (make-sparse-keymap "Rename") - "`Open' submenu for Dired menu-bar `Single' menu.") -(define-key diredp-menu-bar-single-menu [multiple-open] (cons "Open" diredp-single-open-menu)) - -;; On Windows, bind more. -(eval-after-load "w32-browser" - '(progn - (define-key diredp-single-open-menu [dired-w32-browser] - '(menu-item "Open Associated Windows App" dired-w32-browser - :help "Open file using the Windows app associated with its file type")) - (define-key diredp-single-open-menu [dired-w32explore] - '(menu-item "Open in Windows Explorer" dired-w32explore - :help "Open file in Windows Explorer")))) -(define-key diredp-single-open-menu [find-file-other-frame] - '(menu-item "Open in Other Frame" diredp-find-file-other-frame - :help "Edit file at cursor in a different frame")) -(define-key diredp-single-open-menu [find-file-other-window] - '(menu-item "Open in Other Window" dired-find-file-other-window - :help "Edit file at cursor in a different window")) -(define-key diredp-single-open-menu [find-file] - '(menu-item "Open" dired-find-file :help "Edit file at cursor")) - - -;; `Single' > `Rename' menu. -;; -(defvar diredp-single-rename-menu (make-sparse-keymap "Rename") - "`Rename' submenu for Dired menu-bar `Single' menu.") -(define-key diredp-menu-bar-single-menu [multiple-case] (cons "Rename" diredp-single-rename-menu)) - -(define-key diredp-single-rename-menu [single-rename-capitalize] - '(menu-item "Capitalize" diredp-capitalize-this-file - :help "Capitalize (initial caps) name of file at cursor")) -(define-key diredp-single-rename-menu [single-rename-downcase] - '(menu-item "Downcase" diredp-downcase-this-file - ;; When running on plain MS-DOS, there is only one letter-case for file names. - :enable (or (not (fboundp 'msdos-long-file-names)) (msdos-long-file-names)) - :help "Rename file at cursor to a lower-case name")) -(define-key diredp-single-rename-menu [single-rename-upcase] - '(menu-item "Upcase" diredp-upcase-this-file - :enable (or (not (fboundp 'msdos-long-file-names)) (msdos-long-file-names)) - :help "Rename file at cursor to an upper-case name")) - - -;; `Single' > `Move / Copy / Link' menu. -;; -(defvar diredp-single-move-copy-link-menu (make-sparse-keymap "Move / Copy / Link") - "`Move / Copy / Link' submenu for Dired menu-bar `Single' menu.") -(define-key diredp-menu-bar-single-menu [multiple-move-copy-link] - (cons "Move / Copy / Link" diredp-single-move-copy-link-menu)) - -(define-key diredp-single-move-copy-link-menu [single-hardlink] - '(menu-item "Hardlink to..." diredp-hardlink-this-file - :help "Make hard links for current or marked files")) -(define-key diredp-single-move-copy-link-menu [single-symlink] - '(menu-item "Symlink to (Absolute)..." diredp-symlink-this-file - :help "Make absolute symbolic link for file at cursor")) -(define-key diredp-single-move-copy-link-menu [single-relsymlink] - '(menu-item "Symlink to (Relative)..." diredp-relsymlink-this-file - :help "Make relative symbolic link for file at cursor")) -(define-key diredp-single-move-copy-link-menu [single-copy] - '(menu-item "Copy to..." diredp-copy-this-file :help "Copy file at cursor")) -(define-key diredp-single-move-copy-link-menu [single-rename] - '(menu-item "Move to..." diredp-rename-this-file - :help "Rename file at cursor, or move it to a different directory")) - - -;; `Single' > `Image' menu. -;; -(defvar diredp-single-image-menu (make-sparse-keymap "Image")) -(defalias 'diredp-single-image-menu diredp-single-image-menu) -(define-key diredp-menu-bar-single-menu [image] - '(menu-item "Image" diredp-single-image-menu - :enable (let ((img-file (diredp-get-image-filename 'LOCALP 'NO-ERROR))) - (and (fboundp 'image-dired-dired-display-image) img-file)))) - -(define-key diredp-single-image-menu [diredp-image-dired-display-thumb] - '(menu-item "Go To Thumbnail" diredp-image-dired-display-thumb - :help "Pop to buffer showing the thumbnail of this image file")) -(define-key diredp-single-image-menu [diredp-image-dired-create-thumb] - '(menu-item "Create Thumbnail" diredp-image-dired-create-thumb - :help "Create a thumbnail image for this image file")) -(define-key diredp-single-image-menu [diredp-image-dired-edit-comment-and-tags] - '(menu-item "Edit Comment and Tags..." diredp-image-dired-edit-comment-and-tags - :help "Edit comment and tags for this image file")) -(define-key diredp-single-image-menu [diredp-image-dired-delete-tag] - '(menu-item "Delete Image Tag..." diredp-image-dired-delete-tag - :help "Remove an `image-dired' tag from this image file")) -(define-key diredp-single-image-menu [diredp-image-dired-tag-file] - '(menu-item "Add Tags..." diredp-image-dired-tag-file - :help "Add tags to this image file")) -(define-key diredp-single-image-menu [diredp-image-dired-comment-file] - '(menu-item "Add Comment..." diredp-image-dired-comment-file - :help "Add a comment to this image file")) -(define-key diredp-single-image-menu [diredp-image-dired-copy-with-exif-name] - '(menu-item "Copy with EXIF Name" diredp-image-dired-copy-with-exif-name - :help "Copy this image file to main image dir using EXIF name")) -(define-key diredp-single-image-menu [image-dired-dired-display-external] - '(menu-item "Display Externally" image-dired-dired-display-external - :help "Display image using external viewer")) -(define-key diredp-single-image-menu [image-dired-dired-display-image] - '(menu-item "Display to Fit Other Window" image-dired-dired-display-image - :help "Display scaled image to fit a separate window")) -(define-key diredp-single-image-menu [diredp-image-show-this-file] - '(menu-item "Display Full Size Or Smaller" diredp-image-show-this-file - :help "Display image full size or at least prefix-arg lines high")) -(define-key diredp-single-image-menu [dired-find-file] - '(menu-item "Display Full Size" dired-find-file - :help "Display image full size")) - - -;; `Single' > `Encryption' menu. -;; -(when (fboundp 'epa-dired-do-encrypt) ; Emacs 23+ - (defvar diredp-single-encryption-menu (make-sparse-keymap "Encryption")) - (define-key diredp-menu-bar-single-menu [encryption] - (cons "Encryption" diredp-single-encryption-menu)) - - (define-key diredp-single-encryption-menu [diredp-decrypt-this-file] - '(menu-item "Decrypt..." (lambda () - (interactive) - (epa-decrypt-file (expand-file-name (dired-get-filename - nil 'NO-ERROR-P)))) - :help "Decrypt this file")) - (define-key diredp-single-encryption-menu [diredp-verify-this-file] - '(menu-item "Verify..." (lambda () - (interactive) - (epa-verify-file (expand-file-name (dired-get-filename - nil 'NO-ERROR-P)))) - :help "Verify this file")) - (define-key diredp-single-encryption-menu [diredp-sign-this-file] - '(menu-item "Sign..." (lambda () - (interactive) - (epa-sign-file (expand-file-name (dired-get-filename - nil 'NO-ERROR-P)) - (epa-select-keys (epg-make-context) - "Select keys for signing. -If no one is selected, default secret key is used. " - nil t))) - :help "Encrypt this file")) - (define-key diredp-single-encryption-menu [diredp-encrypt-this-file] - '(menu-item "Encrypt..." (lambda () - (interactive) - (epa-encrypt-file (expand-file-name (dired-get-filename - nil 'NO-ERROR-P)) - (epa-select-keys - (epg-make-context) - "Select recipients for encryption. -If no one is selected, symmetric encryption will be performed. " - nil t))) - :help "Sign this file"))) - - -;; `Single' > `Bookmark' menu. -;; -(when (require 'bookmark+ nil t) - (defvar diredp-single-bookmarks-menu (make-sparse-keymap "Bookmark")) - (define-key diredp-menu-bar-single-menu [bookmark] - (cons "Bookmark" diredp-single-bookmarks-menu)) - - (define-key diredp-single-bookmarks-menu [diredp-set-tag-value-this-file] - '(menu-item "Set Tag Value..." diredp-set-tag-value-this-file - :help "Set the value (not the name) of a given tag for this file")) - (define-key diredp-single-bookmarks-menu [diredp-paste-replace-tags-this-file] - '(menu-item "Paste Tags (Replace)" diredp-paste-replace-tags-this-file - :help "Replace tags for this file with previously copied tags")) - (define-key diredp-single-bookmarks-menu [diredp-paste-add-tags-this-file] - '(menu-item "Paste Tags (Add)" diredp-paste-add-tags-this-file - :help "Add previously copied tags to this file")) - (define-key diredp-single-bookmarks-menu [diredp-copy-tags-this-file] - '(menu-item "Copy Tags" diredp-copy-tags-this-file - :help "Copy the tags from this file, so you can paste them to another")) - (define-key diredp-single-bookmarks-menu [diredp-remove-all-tags-this-file] - '(menu-item "Remove All Tags" diredp-remove-all-tags-this-file - :help "Remove all tags from the file at cursor")) - (define-key diredp-single-bookmarks-menu [diredp-untag-this-file] - '(menu-item "Remove Tags..." diredp-untag-this-file - :help "Remove some tags from the file at cursor (`C-u': remove all tags)")) - (define-key diredp-single-bookmarks-menu [diredp-tag-this-file] - '(menu-item "Add Tags..." diredp-tag-this-file :help "Add some tags to the file at cursor")) - (define-key diredp-single-bookmarks-menu [diredp-bookmark-this-file] - '(menu-item "Bookmark..." diredp-bookmark-this-file - :help "Bookmark the file at cursor (create/set autofile)"))) - - -;; `Multiple' menu. -;; -;; REPLACE ORIGINAL "Operate" menu in `dired.el'. -;; -(defvar diredp-menu-bar-multiple-menu (make-sparse-keymap "Multiple")) -(define-key dired-mode-map [menu-bar operate] (cons "Multiple" diredp-menu-bar-multiple-menu)) - -;; We don't use `define-obsolete-variable-alias' so that byte-compilation in older Emacs -;; works for newer Emacs too. -(when (fboundp 'defvaralias) ; Emacs 22+ - (defvaralias 'diredp-menu-bar-operate-menu 'diredp-menu-bar-multiple-menu)) -(make-obsolete-variable 'diredp-menu-bar-operate-menu 'diredp-menu-bar-multiple-menu) ; 2017-04-09 - -(define-key diredp-menu-bar-multiple-menu [diredp-describe-marked-autofiles] - '(menu-item "Describe Marked Autofiles" diredp-describe-marked-autofiles - :help "Show the metadata for the marked files that are autofiles" - :enable (featurep 'bookmark+))) -(define-key diredp-menu-bar-multiple-menu [separator-describe] '("--")) ; ----------------------- - -(unless (memq system-type '(windows-nt ms-dos)) - (define-key diredp-menu-bar-multiple-menu [chown] - '(menu-item "Change Owner..." dired-do-chown - :help "Change the owner of marked files"))) -(unless (memq system-type '(windows-nt ms-dos)) - (define-key diredp-menu-bar-multiple-menu [chgrp] - '(menu-item "Change Group..." dired-do-chgrp - :help "Change the owner of marked files"))) -(define-key diredp-menu-bar-multiple-menu [chmod] - '(menu-item "Change Mode..." dired-do-chmod - :help "Change mode (attributes) of marked files")) -(when (fboundp 'dired-do-touch) ; Emacs 22+ - (define-key diredp-menu-bar-multiple-menu [touch] - '(menu-item "Change Timestamp (`touch')..." dired-do-touch - :help "Change the timestamp of the marked files, using `touch'"))) -(define-key diredp-menu-bar-multiple-menu [separator-change] '("--")) ; ------------------------- - -(when (fboundp 'diredp-read-expression) ; Emacs 22+ - (define-key diredp-menu-bar-multiple-menu [diredp-do-lisp-sexp] - '(menu-item "Eval Sexp..." diredp-do-lisp-sexp - :help "Evaluate an Emacs-Lisp sexp in each marked file"))) -(define-key diredp-menu-bar-multiple-menu [diredp-do-emacs-command] - '(menu-item "Invoke Emacs Command..." diredp-do-emacs-command - :help "Invoke an Emacs command in each marked file")) -(define-key diredp-menu-bar-multiple-menu [diredp-do-apply-function] - '(menu-item "Apply Function..." diredp-do-apply-function - :help "Apply a Lisp function to each marked file name (`C-u': file contents, not name)")) -(define-key diredp-menu-bar-multiple-menu [print] - '(menu-item "Print..." dired-do-print :help "Print marked files, supplying print command")) -(define-key diredp-menu-bar-multiple-menu [compress] - '(menu-item "Compress/Uncompress" dired-do-compress :help "Compress/uncompress marked files")) -(when (fboundp 'dired-do-compress-to) - (define-key diredp-menu-bar-multiple-menu [compress-to] - '(menu-item "Compress to..." dired-do-compress-to - :help "Compress marked files and dirs together, in the same archive"))) -(define-key diredp-menu-bar-multiple-menu [command] - '(menu-item "Shell Command..." dired-do-shell-command - :help "Run a shell command on each marked file")) -(when (fboundp 'dired-do-async-shell-command) ; Emacs 23+ - (define-key diredp-menu-bar-multiple-menu [async-command] - '(menu-item "Asynchronous Shell Command..." dired-do-async-shell-command - :help "Run a shell command asynchronously on each marked file"))) -(define-key diredp-menu-bar-multiple-menu [compile] - '(menu-item "Byte Compile" dired-do-byte-compile :help "Byte-compile marked Emacs Lisp files")) -(define-key diredp-menu-bar-multiple-menu [load] - '(menu-item "Load" dired-do-load :help "Load marked Emacs Lisp files")) - -(unless (require 'bookmark+ nil t) - (define-key diredp-menu-bar-multiple-menu [diredp-bookmark-this-file] - '(menu-item "Bookmark..." diredp-bookmark-this-file :help "Bookmark the file at cursor"))) -(when (fboundp 'mkhtml-dired-files) ; In `mkhtml.el'. - (define-key diredp-menu-bar-multiple-menu [mkhtml-dired-files] - '(menu-item "Create HTML" mkhtml-dired-files - :help "Create HTML files corresponding to marked files"))) -(define-key diredp-menu-bar-multiple-menu [separator-misc] '("--")) ; --------------------------- - -(define-key diredp-menu-bar-multiple-menu [diredp-copy-abs-filenames-as-kill] - '(menu-item "Copy Marked Names as Absolute" diredp-copy-abs-filenames-as-kill - :help "Copy absolute names of marked files to the kill ring" - :keys "M-0 w")) -(define-key diredp-menu-bar-multiple-menu [kill-ring] - '(menu-item "Copy Marked Names" dired-copy-filename-as-kill - :help "Copy names of marked files to the kill ring, for pasting")) -(define-key diredp-menu-bar-multiple-menu [diredp-list-marked] - '(menu-item "List Marked Files" diredp-list-marked - :help "List the files marked here (C-u C-u: all, C-u C-u C-u: all + dirs)")) -(define-key diredp-menu-bar-multiple-menu [diredp-insert-subdirs] - '(menu-item "Insert Subdirs" diredp-insert-subdirs - :help "Insert the marked subdirectories - like using `i' at each marked dir")) -;; On Windows, bind more. -(eval-after-load "w32-browser" - '(define-key diredp-menu-bar-multiple-menu [dired-multiple-w32-browser] - '(menu-item "Open Associated Windows Apps" dired-multiple-w32-browser - :help "Open files using the Windows apps associated with their file types"))) -(when (fboundp 'dired-do-find-marked-files) - (define-key diredp-menu-bar-multiple-menu [find-files] - '(menu-item "Open" dired-do-find-marked-files ; In `dired-x.el'. - :help "Open each marked file for editing"))) - - -;; `Multiple' > `Dired' menu. -;; -(defvar diredp-multiple-dired-menu (make-sparse-keymap "Dired") - "`Dired' submenu for Dired menu-bar `Multiple' menu.") -(define-key diredp-menu-bar-multiple-menu [multiple-dired] - `(menu-item "Dired" ,diredp-multiple-dired-menu - :enable (save-excursion (goto-char (point-min)) - (and (re-search-forward (dired-marker-regexp) nil t) - (re-search-forward (dired-marker-regexp) nil t))) - :help "Open Dired on marked files and dirs only")) - -(define-key diredp-multiple-dired-menu [diredp-marked-other-window] - '(menu-item "Dired Marked in Other Window" diredp-marked-other-window - :enable (save-excursion (goto-char (point-min)) - (and (re-search-forward (dired-marker-regexp) nil t) - (re-search-forward (dired-marker-regexp) nil t))) - :help "Open Dired on marked files and dirs only, in other window")) -(define-key diredp-multiple-dired-menu [diredp-marked] - '(menu-item "Dired Marked" diredp-marked - :enable (save-excursion (goto-char (point-min)) - (and (re-search-forward (dired-marker-regexp) nil t) - (re-search-forward (dired-marker-regexp) nil t))) - :help "Open Dired on marked files and dirs only")) - - -;; `Multiple' > `Omit' menu. -;; -(defvar diredp-multiple-omit-menu (make-sparse-keymap "Omit") - "`Omit' submenu for Dired menu-bar `Multiple' menu.") -(define-key diredp-menu-bar-multiple-menu [multiple-omit] (cons "Omit" diredp-multiple-omit-menu)) - -(define-key diredp-multiple-omit-menu [omit-unmarked] - '(menu-item "Omit Unmarked" diredp-omit-unmarked :help "Hide lines of unmarked files")) -(define-key diredp-multiple-omit-menu [omit-marked] - '(menu-item "Omit Marked" diredp-omit-marked :help "Hide lines of marked files")) - - -;; `Multiple' > `Delete' menu. -;; -(defvar diredp-multiple-delete-menu (make-sparse-keymap "Delete") - "`Delete' submenu for Dired menu-bar `Multiple' menu.") -(define-key diredp-menu-bar-multiple-menu [multiple-delete] (cons "Delete" diredp-multiple-delete-menu)) - -(define-key diredp-multiple-delete-menu [delete-flagged] - '(menu-item "Delete Flagged" dired-do-flagged-delete - :help "Delete all files flagged for deletion (D)")) -(define-key diredp-multiple-delete-menu [delete] - '(menu-item "Delete Marked (not Flagged)" dired-do-delete - :help "Delete current file or all marked files (not flagged files)")) - - -;; `Multiple' > `Rename' menu. -;; -(defvar diredp-multiple-rename-menu (make-sparse-keymap "Rename") - "`Rename' submenu for Dired menu-bar `Multiple' menu.") -(define-key diredp-menu-bar-multiple-menu [multiple-case] (cons "Rename" diredp-multiple-rename-menu)) - -(define-key diredp-multiple-rename-menu [multiple-rename-rename] - '(menu-item "Move to Dir... / Rename This..." dired-do-rename - :help "Move marked (or next N) files, or rename current file")) - -(define-key diredp-multiple-rename-menu [multiple-rename-capitalize] - '(menu-item "Capitalize" diredp-capitalize - :help "Capitalize (initial caps) the names of all marked files")) -(define-key diredp-multiple-rename-menu [multiple-rename-downcase] - '(menu-item "Downcase" dired-downcase - :enable (or (not (fboundp 'msdos-long-file-names)) (msdos-long-file-names)) - :help "Rename marked files to lowercase names")) -(define-key diredp-multiple-rename-menu [multiple-rename-upcase] - '(menu-item "Upcase" dired-upcase - :enable (or (not (fboundp 'msdos-long-file-names)) (msdos-long-file-names)) - :help "Rename marked files to uppercase names")) - - -;; `Multiple' > `Move / Copy / Link' menu. -;; -(defvar diredp-multiple-move-copy-link-menu (make-sparse-keymap "Move / Copy / Link") - "`Move / Copy / Link' submenu for Dired menu-bar `Multiple' menu.") -(define-key diredp-menu-bar-multiple-menu [multiple-move-copy-link] - (cons "Move / Copy / Link" diredp-multiple-move-copy-link-menu)) - -(define-key diredp-multiple-move-copy-link-menu [multiple-move-copy-link-hardlink] - '(menu-item "Hardlink to..." dired-do-hardlink - :help "Make hard links for current or marked files")) -(define-key diredp-multiple-move-copy-link-menu [multiple-move-copy-link-symlink] - '(menu-item "Symlink to (Absolute)..." dired-do-symlink ; In `dired-aux.el'. - :help "Make absolute symbolic links for current or marked files")) -(define-key diredp-multiple-move-copy-link-menu [multiple-move-copy-link-relsymlink] - '(menu-item "Symlink to (Relative)..." dired-do-relsymlink ; In `dired-x.el'. - :help "Make relative symbolic links for current or marked files")) -(define-key diredp-multiple-move-copy-link-menu [multiple-move-copy-link-copy] - '(menu-item "Copy to..." dired-do-copy :help "Copy current file or all marked files")) -(define-key diredp-multiple-move-copy-link-menu [multiple-move-copy-link-rename] - '(menu-item "Move to..." dired-do-rename :help "Rename current file or move marked files")) - - -;; `Multiple' > `Images' menu. -;; -(defvar diredp-multiple-images-menu (make-sparse-keymap "Images")) -(defalias 'diredp-multiple-images-menu diredp-multiple-images-menu) -(define-key diredp-menu-bar-multiple-menu [images] - '(menu-item "Images" diredp-multiple-images-menu - :enable (fboundp 'image-dired-display-thumbs))) - -;; We don't use `define-obsolete-variable-alias' so that byte-compilation in older Emacs -;; works for newer Emacs too. -(when (fboundp 'defvaralias) ; Emacs 22+ - (defvaralias 'diredp-menu-bar-images-menu 'diredp-multiple-images-menu)) -(make-obsolete-variable 'diredp-menu-bar-images-menu 'diredp-multiple-images-menu) ; 2017-04-09 - -;; Remove the items from `Multiple' menu. -(define-key diredp-menu-bar-multiple-menu [image-dired-delete-tag] nil) -(define-key diredp-menu-bar-multiple-menu [image-dired-tag-files] nil) -(define-key diredp-menu-bar-multiple-menu [image-dired-dired-comment-files] nil) -(define-key diredp-menu-bar-multiple-menu [image-dired-display-thumbs] nil) - -;; Add them to `Multiple' > `Images' menu. -(define-key diredp-multiple-images-menu [image-dired-delete-tag] - '(menu-item "Delete Tag..." image-dired-delete-tag - :help "Delete tag from marked image files")) -(define-key diredp-multiple-images-menu [image-dired-tag-files] - '(menu-item "Add Tags..." image-dired-tag-files - :help "Add tags to marked image files")) -(define-key diredp-multiple-images-menu [image-dired-dired-comment-files] - '(menu-item "Add Comment..." image-dired-dired-comment-files - :help "Add comment to marked image files")) -(define-key diredp-multiple-images-menu [image-dired-display-thumbs] - '(menu-item "Display Thumbnails" image-dired-display-thumbs - :help "Display thumbnails for marked image files")) -(define-key diredp-multiple-images-menu [diredp-do-display-images] - '(menu-item "Display" diredp-do-display-images - :help "Display the marked image files")) - - -;; `Multiple' > `Encryption' menu. -;; -(when (fboundp 'epa-dired-do-encrypt) ; Emacs 23+ - (defvar diredp-multiple-encryption-menu (make-sparse-keymap "Encryption")) - (define-key diredp-menu-bar-multiple-menu [encryption] - (cons "Encryption" diredp-multiple-encryption-menu)) - - ;; We don't use `define-obsolete-variable-alias' so that byte-compilation in older Emacs - ;; works for newer Emacs too. - (when (fboundp 'defvaralias) ; Emacs 22+ - (defvaralias 'diredp-menu-bar-encryption-menu 'diredp-multiple-encryption-menu)) - (make-obsolete-variable 'diredp-menu-bar-encryption-menu 'diredp-multiple-encryption-menu) ; 2017-04-09 - - (when (boundp 'diredp-menu-bar-encryption-menu) - (defalias 'diredp-menu-bar-encryption-menu diredp-menu-bar-encryption-menu)) - (make-obsolete 'diredp-menu-bar-encryption-menu 'diredp-multiple-encryption-menu) ; 2017-04-09 - - ;; Remove the items from `Multiple' menu. - (define-key diredp-menu-bar-multiple-menu [epa-dired-do-decrypt] nil) - (define-key diredp-menu-bar-multiple-menu [epa-dired-do-verify] nil) - (define-key diredp-menu-bar-multiple-menu [epa-dired-do-sign] nil) - (define-key diredp-menu-bar-multiple-menu [epa-dired-do-encrypt] nil) - - ;; Add them to `Multiple' > `Encryption' menu. - (define-key diredp-multiple-encryption-menu [epa-dired-do-decrypt] - '(menu-item "Decrypt..." epa-dired-do-decrypt :help "Decrypt the marked files")) - (define-key diredp-multiple-encryption-menu [epa-dired-do-verify] - '(menu-item "Verify..." epa-dired-do-verify :help "Verify the marked files")) - (define-key diredp-multiple-encryption-menu [epa-dired-do-sign] - '(menu-item "Sign..." epa-dired-do-sign :help "Sign the marked files")) - (define-key diredp-multiple-encryption-menu [epa-dired-do-encrypt] - '(menu-item "Encrypt..." epa-dired-do-encrypt :help "Encrypt the marked files"))) - - -;; `Multiple' > `Search' menu. -;; -(defvar diredp-multiple-search-menu (make-sparse-keymap "Search")) -(define-key diredp-menu-bar-multiple-menu [search] - (cons "Search" diredp-multiple-search-menu)) - -;; We don't use `define-obsolete-variable-alias' so that byte-compilation in older Emacs -;; works for newer Emacs too. -(when (fboundp 'defvaralias) ; Emacs 22+ - (defvaralias 'diredp-menu-bar-operate-search-menu 'diredp-multiple-search-menu)) -(make-obsolete-variable 'diredp-menu-bar-operate-search-menu 'diredp-multiple-search-menu) ; 2017-04-09 - -(when (fboundp 'dired-do-isearch-regexp) ; Emacs 23+ - (define-key diredp-multiple-search-menu [isearch-regexp] - '(menu-item "Isearch Regexp Files..." dired-do-isearch-regexp - :help "Incrementally search marked files for regexp")) - (define-key diredp-multiple-search-menu [isearch] - '(menu-item "Isearch Files..." dired-do-isearch - :help "Incrementally search marked files for string"))) -(when (fboundp 'dired-do-find-regexp-and-replace) - (define-key diredp-multiple-search-menu [find-query-replace] - '(menu-item "Query Replace Using `find'..." dired-do-find-regexp-and-replace - :help "Replace regexp in marked files using `find'"))) -(define-key diredp-multiple-search-menu [query-replace] - (if (< emacs-major-version 21) - '(menu-item "Query Replace Using TAGS Table..." dired-do-query-replace) - '(menu-item "Query Replace Using TAGS Table..." dired-do-query-replace-regexp - :help "Replace regexp in marked files using tags in a TAGS table"))) -(when (fboundp 'dired-do-find-regexp) - (define-key diredp-multiple-search-menu [find-regexp] - '(menu-item "Search Files Using `find'..." dired-do-find-regexp - :help "Search marked files for regexp using `find'"))) -(define-key diredp-multiple-search-menu [search] - '(menu-item "Search Files Using TAGS Table..." dired-do-search - :help "Search marked files for regexp using tags in a TAGS table")) -(define-key diredp-multiple-search-menu [grep] - '(menu-item "Grep..." diredp-do-grep :help "Grep marked, next N, or all files shown")) - - -;; `Multiple' > `Bookmark' menu. -;; -(defvar diredp-multiple-bookmarks-menu (make-sparse-keymap "Bookmark")) -(define-key diredp-menu-bar-multiple-menu [bookmark] - (cons "Bookmark" diredp-multiple-bookmarks-menu)) - -;; We don't use `define-obsolete-variable-alias' so that byte-compilation in older Emacs -;; works for newer Emacs too. -(when (fboundp 'defvaralias) ; Emacs 22+ - (defvaralias 'diredp-menu-bar-operate-bookmarks-menu 'diredp-multiple-bookmarks-menu)) -(make-obsolete-variable 'diredp-menu-bar-operate-bookmarks-menu 'diredp-multiple-bookmarks-menu) ; 2017-04-09 - -(when (require 'bookmark+ nil t) - (define-key diredp-multiple-bookmarks-menu [diredp-do-set-tag-value] - '(menu-item "Set Tag Value..." diredp-do-set-tag-value - :help "Set the value of a given tag for the marked or next N files")) - (define-key diredp-multiple-bookmarks-menu [diredp-do-paste-replace-tags] - '(menu-item "Paste Tags (Replace)" diredp-do-paste-replace-tags - :help "Replace tags for the marked or next N files with copied tags")) - (define-key diredp-multiple-bookmarks-menu [diredp-do-paste-add-tags] - '(menu-item "Paste Tags (Add)" diredp-do-paste-add-tags - :help "Add previously copied tags to the marked or next N files")) - (define-key diredp-multiple-bookmarks-menu [diredp-do-remove-all-tags] - '(menu-item "Remove All Tags" diredp-do-remove-all-tags - :help "Remove all tags from the marked or next N files")) - (define-key diredp-multiple-bookmarks-menu [diredp-do-untag] - '(menu-item "Remove Tags..." diredp-do-untag - :help "Remove some tags from the marked or next N files")) - (define-key diredp-multiple-bookmarks-menu [diredp-do-tag] - '(menu-item "Add Tags..." diredp-do-tag - :help "Add some tags to the marked or next N files")) - (define-key diredp-multiple-bookmarks-menu [separator-book-2] '("--"))) ; ------------ - -(define-key diredp-multiple-bookmarks-menu - [diredp-do-bookmark-in-bookmark-file-recursive] - '(menu-item "Bookmark in Bookmark File (Here and Below)..." - diredp-do-bookmark-in-bookmark-file-recursive - :help "Bookmark marked files (including in marked subdirs) in bookmark file and save it")) -(define-key diredp-multiple-bookmarks-menu - [diredp-set-bookmark-file-bookmark-for-marked-recursive] - '(menu-item "Create Bookmark-File Bookmark (Here and Below)..." - diredp-set-bookmark-file-bookmark-for-marked-recursive - :help "Create a bookmark-file bookmark for marked files, including in marked subdirs")) -(define-key diredp-multiple-bookmarks-menu [diredp-do-bookmark-dirs-recursive] - '(menu-item "Bookmark Dirs (Here and Below)..." diredp-do-bookmark-dirs-recursive - :help "Bookmark this Dired buffer and marked subdirectory Dired buffers, recursively.")) -(define-key diredp-multiple-bookmarks-menu [diredp-do-bookmark-recursive] - '(menu-item "Bookmark (Here and Below)..." diredp-do-bookmark-recursive - :help "Bookmark the marked files, including those in marked subdirs")) -(define-key diredp-multiple-bookmarks-menu [separator-book-1] '("--")) ; --------------- - -(define-key diredp-multiple-bookmarks-menu [diredp-do-bookmark-in-bookmark-file] - '(menu-item "Bookmark in Bookmark File..." diredp-do-bookmark-in-bookmark-file - :help "Bookmark the marked files in BOOKMARK-FILE and save BOOKMARK-FILE")) -(define-key diredp-multiple-bookmarks-menu [diredp-set-bookmark-file-bookmark-for-marked] - '(menu-item "Create Bookmark-File Bookmark..." diredp-set-bookmark-file-bookmark-for-marked - :help "Create a bookmark-file bookmark, and bookmark the marked files in it")) -(define-key diredp-multiple-bookmarks-menu [diredp-do-bookmark] - '(menu-item "Bookmark..." diredp-do-bookmark :help "Bookmark the marked or next N files")) - - -;; `Multiple' > `Marked Here and Below' menu. -;; -(defvar diredp-multiple-recursive-menu (make-sparse-keymap "Marked Here and Below")) -(define-key diredp-menu-bar-multiple-menu [operate-recursive] - (cons "Marked Here and Below" diredp-multiple-recursive-menu)) - -;; We don't use `define-obsolete-variable-alias' so that byte-compilation in older Emacs -;; works for newer Emacs too. -(when (fboundp 'defvaralias) ; Emacs 22+ - (defvaralias 'diredp-menu-bar-operate-recursive-menu 'diredp-multiple-recursive-menu)) -(make-obsolete-variable 'diredp-menu-bar-operate-recursive-menu 'diredp-multiple-recursive-menu) ; 2017-04-09 - -(when (fboundp 'diredp-do-chown-recursive) - (define-key diredp-multiple-recursive-menu [chown] - '(menu-item "Change Owner..." diredp-do-chown-recursive - :help "Change the owner of marked files, including those in marked subdirs"))) -(when (fboundp 'diredp-do-chgrp-recursive) - (define-key diredp-multiple-recursive-menu [chgrp] - '(menu-item "Change Group..." diredp-do-chgrp-recursive - :help "Change the owner of marked files, including those in marked subdirs"))) -(define-key diredp-multiple-recursive-menu [chmod] - '(menu-item "Change Mode..." diredp-do-chmod-recursive - :help "Change mode (attributes) of marked files, including those in marked subdirs")) -(when (fboundp 'dired-do-touch) ; Emacs 22+ - (define-key diredp-multiple-recursive-menu [touch] - '(menu-item "Change Timestamp (`touch')..." diredp-do-touch-recursive - :help "Change timestamp of marked files, including those in marked subdirs"))) -(define-key diredp-multiple-recursive-menu [separator-change] '("--")) ; ---------------- - -(define-key diredp-multiple-recursive-menu [diredp-do-apply-function-recursive] - '(menu-item "Apply Lisp Function..." diredp-do-apply-function-recursive - :help "Apply a Lisp function to the marked files, including those in marked subdirs")) -(define-key diredp-multiple-recursive-menu [diredp-do-print-recursive] - '(menu-item "Print..." diredp-do-print-recursive - :help "Print the marked files, including those in marked subdirs")) -(define-key diredp-multiple-recursive-menu [diredp-do-shell-command-recursive] - '(menu-item "Shell Command..." diredp-do-shell-command-recursive - :help "Run shell command on the marked files, including those in marked subdirs")) -(when (fboundp 'dired-do-async-shell-command) ; Emacs 23+ - (define-key diredp-multiple-recursive-menu [diredp-do-async-shell-command-recursive] - '(menu-item "Asynchronous Shell Command..." diredp-do-async-shell-command-recursive - :help "Run shell command asynchronously on marked files, including in marked subdirs"))) - -(when (fboundp 'diredp-unmark-all-marks-recursive) ; Emacs 22+ - (define-key diredp-multiple-recursive-menu [separator-1] '("--")) ; ------------ - (define-key diredp-multiple-recursive-menu [diredp-change-marks-recursive] - '(menu-item "Change Mark..." diredp-change-marks-recursive - :help "Change all OLD marks to NEW marks, including those in marked subdirs")) - (define-key diredp-multiple-recursive-menu [diredp-unmark-all-files-recursive] - '(menu-item "Unmark Marked-With..." diredp-unmark-all-files-recursive - :help "Remove a given mark everywhere, including in marked subdirs")) - (define-key diredp-multiple-recursive-menu [diredp-unmark-all-marks-recursive] - '(menu-item "Unmark All..." diredp-unmark-all-marks-recursive - :help "Remove ALL marks everywhere, including in marked subdirs"))) - -(define-key diredp-multiple-recursive-menu [separator-misc] '("--")) ; ------------------ - -(define-key diredp-multiple-recursive-menu [diredp-do-delete-recursive] - '(menu-item "Delete Marked (not Flagged)" diredp-do-delete-recursive - :help "Delete marked (not flagged) files, including in marked subdirs")) -(define-key diredp-multiple-recursive-menu [separator-delete] '("--")) ; ---------------- - -(define-key diredp-multiple-recursive-menu [diredp-do-hardlink-recursive] - '(menu-item "Hardlink to..." diredp-do-hardlink-recursive - :help "Make hard links for marked files, including those in marked subdirs")) -(define-key diredp-multiple-recursive-menu [diredp-do-symlink-recursive] - '(menu-item "Symlink to (Absolute)..." diredp-do-symlink-recursive - :help "Make absolute symbolic links for marked files, including those in marked subdirs")) -(define-key diredp-multiple-recursive-menu [diredp-do-relsymlink-recursive] - '(menu-item "Symlink to (Relative)..." diredp-do-relsymlink-recursive - :help "Make relative symbolic links for marked files, including those in marked subdirs")) -(define-key diredp-multiple-recursive-menu [diredp-do-copy-recursive] - '(menu-item "Copy to..." diredp-do-copy-recursive - :help "Copy marked files, including in marked subdirs, to a given directory")) -(define-key diredp-multiple-recursive-menu [diredp-do-move-recursive] - '(menu-item "Move to..." diredp-do-move-recursive - :help "Move marked files, including in marked subdirs, to a given directory")) -(define-key diredp-multiple-recursive-menu [separator-copy-move] '("--")) ; ------------- - -(define-key diredp-multiple-recursive-menu [diredp-capitalize-recursive] - '(menu-item "Capitalize" diredp-capitalize-recursive - :enable (or (not (fboundp 'msdos-long-file-names)) (msdos-long-file-names)) - :help "Capitalize the names of all marked files, including in marked subdirs")) -(define-key diredp-multiple-recursive-menu [diredp-downcase-recursive] - '(menu-item "Downcase" diredp-downcase-recursive - :enable (or (not (fboundp 'msdos-long-file-names)) (msdos-long-file-names)) - :help "Rename marked files, including in marked subdirs, to lowercase names")) -(define-key diredp-multiple-recursive-menu [diredp-upcase-recursive] - '(menu-item "Upcase" diredp-upcase-recursive - :enable (or (not (fboundp 'msdos-long-file-names)) (msdos-long-file-names)) - :help "Rename marked files, including in marked subdirs, to uppercase names")) -(define-key diredp-multiple-recursive-menu [separator-lettercase] '("--")) ; ------------ - -(define-key diredp-multiple-recursive-menu [diredp-list-marked-recursive] - '(menu-item "List Marked Files" diredp-list-marked-recursive - :help "List the files marked here and in marked subdirs, recursively")) -(define-key diredp-multiple-recursive-menu [diredp-copy-filename-as-kill-recursive] - '(menu-item "Copy File Names (to Paste)" diredp-copy-filename-as-kill-recursive - :help "Copy names of files marked here and in marked subdirs, to `kill-ring'")) -(define-key diredp-multiple-recursive-menu [diredp-insert-subdirs-recursive] - '(menu-item "Insert Subdirs" diredp-insert-subdirs-recursive - :help "Insert the marked subdirectories, gathered recursively")) -(define-key diredp-multiple-recursive-menu [separator-dirs] '("--")) ; ------------------ - -(define-key diredp-multiple-recursive-menu [diredp-marked-recursive-other-window] - '(menu-item "Dired (Marked) in Other Window" diredp-marked-recursive-other-window - :help "Open Dired (in other window) on marked files, including those in marked subdirs")) -(define-key diredp-multiple-recursive-menu [diredp-marked-recursive] - '(menu-item "Dired (Marked)" diredp-marked-recursive - :help "Open Dired on marked files, including those in marked subdirs")) -;; On Windows, bind more. -(eval-after-load "w32-browser" - '(define-key diredp-multiple-recursive-menu [diredp-multiple-w32-browser-recursive] - '(menu-item "Open Associated Windows Apps" diredp-multiple-w32-browser-recursive - :help "Run Windows apps for with marked files, including those in marked subdirs"))) -(define-key diredp-multiple-recursive-menu [diredp-do-find-marked-files-recursive] - '(menu-item "Open" diredp-do-find-marked-files-recursive - :help "Find marked files simultaneously, including those in marked subdirs")) - - -;; `Multiple' > `Marked Here and Below' > `Images' menu. -;; -(defvar diredp-images-recursive-menu (make-sparse-keymap "Images")) -(defalias 'diredp-images-recursive-menu diredp-images-recursive-menu) - -;; We don't use `define-obsolete-variable-alias' so that byte-compilation in older Emacs -;; works for newer Emacs too. -(when (fboundp 'defvaralias) ; Emacs 22+ - (defvaralias 'diredp-menu-bar-images-recursive-menu 'diredp-images-recursive-menu)) -(make-obsolete-variable 'diredp-menu-bar-images-recursive-menu 'diredp-images-recursive-menu) ; 2017-04-09 - -(when (boundp 'diredp-menu-bar-images-recursive-menu) - (defalias 'diredp-menu-bar-images-recursive-menu diredp-menu-bar-images-recursive-menu)) -(make-obsolete 'diredp-menu-bar-images-recursive-menu 'diredp-images-recursive-menu) ; 2017-04-09 - -(define-key diredp-multiple-recursive-menu [images] - '(menu-item "Images" diredp-images-recursive-menu - :enable (fboundp 'image-dired-delete-tag))) -(define-key diredp-images-recursive-menu [diredp-image-dired-delete-tag-recursive] - '(menu-item "Delete Image Tag..." diredp-image-dired-delete-tag-recursive - :help "Remove an `image-dired' tag from marked files, including those in marked subdirs")) -(define-key diredp-images-recursive-menu [diredp-image-dired-tag-files-recursive] - '(menu-item "Add Image Tags..." diredp-image-dired-tag-files-recursive - :help "Add `image-dired' tags to marked files, including those in marked subdirs")) -(define-key diredp-images-recursive-menu [diredp-image-dired-comment-files-recursive] - '(menu-item "Add Image Comment..." diredp-image-dired-comment-files-recursive - :help "Add image comment to marked files, including those in marked subdirs")) -(define-key diredp-images-recursive-menu [diredp-image-dired-display-thumbs-recursive] - '(menu-item "Display Image Thumbnails" diredp-image-dired-display-thumbs-recursive - :help "Show thumbnails for marked image files, including those in marked subdirs")) - - -;; `Multiple' > `Marked Here and Below' > `Encryption' menu. -;; -(when (fboundp 'epa-dired-do-encrypt) ; Emacs 23+ - (defvar diredp-menu-bar-encryption-recursive-menu (make-sparse-keymap "Encryption")) - (define-key diredp-multiple-recursive-menu [encryption] - (cons "Encryption" diredp-menu-bar-encryption-recursive-menu)) - (define-key diredp-menu-bar-encryption-recursive-menu [diredp-do-decrypt-recursive] - '(menu-item "Decrypt..." diredp-do-decrypt-recursive - :help "Decrypt marked files, including those in marked subdirs")) - (define-key diredp-menu-bar-encryption-recursive-menu [diredp-do-verify-recursive] - '(menu-item "Verify..." diredp-do-verify-recursive - :help "Verify marked files, including those in marked subdirs")) - (define-key diredp-menu-bar-encryption-recursive-menu [diredp-do-sign-recursive] - '(menu-item "Sign..." diredp-do-sign-recursive - :help "Sign marked files, including those in marked subdirs")) - (define-key diredp-menu-bar-encryption-recursive-menu [diredp-do-encrypt-recursive] - '(menu-item "Encrypt..." diredp-do-encrypt-recursive - :help "Encrypt marked files, including those in marked subdirs"))) - - -;; `Multiple' > `Marked Here and Below' > `Search' menu. -;; -(defvar diredp-menu-bar-search-recursive-menu (make-sparse-keymap "Search")) -(define-key diredp-multiple-recursive-menu [search] - (cons "Search" diredp-menu-bar-search-recursive-menu)) -(when (fboundp 'dired-do-isearch-regexp) ; Emacs 23+ - (define-key diredp-menu-bar-search-recursive-menu [diredp-do-isearch-regexp-recursive] - '(menu-item "Isearch Regexp Files..." diredp-do-isearch-regexp-recursive - :help "Incrementally regexp search marked files, including those in marked subdirs")) - (define-key diredp-menu-bar-search-recursive-menu [diredp-do-isearch-recursive] - '(menu-item "Isearch Files..." diredp-do-isearch-recursive - :help "Incrementally search marked files, including those in marked subdirs"))) -(define-key diredp-menu-bar-search-recursive-menu [diredp-do-query-replace-regexp-recursive] - '(menu-item "Query Replace..." diredp-do-query-replace-regexp-recursive - :help "Replace regexp in marked files, including those in marked subdirs")) -(define-key diredp-menu-bar-search-recursive-menu [diredp-do-search-recursive] - '(menu-item "Search Files..." diredp-do-search-recursive - :help "Regexp search marked files, including those in marked subdirs")) -(define-key diredp-menu-bar-search-recursive-menu [diredp-do-grep-recursive] - '(menu-item "Grep..." diredp-do-grep-recursive - :help "Run `grep' on the marked files, including those in marked subdirs")) - - -;; `Multiple' > `Marked Here and Below' > `Bookmark' menu. -;; -(defvar diredp-menu-bar-bookmarks-recursive-menu (make-sparse-keymap "Bookmark")) -(define-key diredp-multiple-recursive-menu [bookmarks] - (cons "Bookmark" diredp-menu-bar-bookmarks-recursive-menu)) -(define-key diredp-menu-bar-bookmarks-recursive-menu - [diredp-do-bookmark-in-bookmark-file-recursive] - '(menu-item "Bookmark in Bookmark File..." diredp-do-bookmark-in-bookmark-file-recursive - :help "Bookmark marked files, including those in marked subdirs, in a bookmark file")) -(define-key diredp-menu-bar-bookmarks-recursive-menu - [diredp-set-bookmark-file-bookmark-for-marked-recursive] - '(menu-item "Create Bookmark-File Bookmark..." - diredp-set-bookmark-file-bookmark-for-marked-recursive - :help "Create a bookmark-file bookmark for marked files, including in marked subdirs")) -(define-key diredp-menu-bar-bookmarks-recursive-menu [diredp-do-bookmark-dirs-recursive] - '(menu-item "Bookmark Dirs..." diredp-do-bookmark-dirs-recursive - :help "Bookmark this Dired buffer and marked subdirectory Dired buffers, recursively.")) -(define-key diredp-menu-bar-bookmarks-recursive-menu [diredp-do-bookmark-recursive] - '(menu-item "Bookmark..." diredp-do-bookmark-recursive - :help "Bookmark the marked files, including those in marked subdirs")) - - - -;; `Regexp' menu. -;; -;; REPLACE ORIGINAL `Regexp' menu in `dired.el'. -;; -(defvar diredp-menu-bar-regexp-menu (make-sparse-keymap "Regexp")) -(define-key dired-mode-map [menu-bar regexp] (cons "Regexp" diredp-menu-bar-regexp-menu)) - -(define-key diredp-menu-bar-regexp-menu [hardlink] - '(menu-item "Hardlink to..." dired-do-hardlink-regexp ; In `dired-aux.el'. - :help "Make hard links for files matching regexp")) -(define-key diredp-menu-bar-regexp-menu [symlink] - '(menu-item "Symlink to (Absolute)..." dired-do-symlink-regexp ; In `dired-aux.el'. - :help "Make absolute symbolic links for files matching regexp")) -(define-key diredp-menu-bar-regexp-menu [relsymlink] - '(menu-item "Symlink to (Relative)..." dired-do-relsymlink-regexp ; In `dired-x.el'. - :help "Make relative symbolic links for files matching regexp")) -(define-key diredp-menu-bar-regexp-menu [copy] - '(menu-item "Copy to..." dired-do-copy-regexp ; In `dired-aux.el'. - :help "Copy marked files matching regexp")) -(define-key diredp-menu-bar-regexp-menu [rename] - '(menu-item "Move to..." dired-do-rename-regexp ; In `dired-aux.el'. - :help "Move marked files matching regexp")) -(define-key diredp-menu-bar-regexp-menu [flag] - '(menu-item "Flag..." dired-flag-files-regexp :help "Flag files matching regexp for deletion")) -(define-key diredp-menu-bar-regexp-menu [image-dired-mark-tagged-files] - '(menu-item "Mark Image Files Tagged..." image-dired-mark-tagged-files - :enable (fboundp 'image-dired-mark-tagged-files) - :help "Mark image files whose image tags match regexp")) -(define-key diredp-menu-bar-regexp-menu [mark-cont] - '(menu-item "Mark Containing..." dired-mark-files-containing-regexp - :help "Mark files whose contents matches regexp")) -(define-key diredp-menu-bar-regexp-menu [mark] - '(menu-item "Mark..." dired-mark-files-regexp - :help "Mark files matching regexp")) - - -;; `Regexp' > `Here and Below' menu. -;; -(defvar diredp-regexp-recursive-menu (make-sparse-keymap "Here and Below")) -(define-key diredp-menu-bar-regexp-menu [mark-recursive] - (cons "Here and Below" diredp-regexp-recursive-menu)) -(define-key diredp-regexp-recursive-menu [diredp-mark-files-regexp-recursive] - '(menu-item "Mark Named..." diredp-mark-files-regexp-recursive - :help "Mark all file names matching a regexp, including those in marked subdirs")) -(define-key diredp-regexp-recursive-menu [diredp-mark-files-containing-regexp-recursive] - '(menu-item "Mark Containing..." diredp-mark-files-containing-regexp-recursive - :help "Mark all files with content matching a regexp, including in marked subdirs")) - -;; We don't use `define-obsolete-variable-alias' so that byte-compilation in older Emacs -;; works for newer Emacs too. -(when (fboundp 'defvaralias) ; Emacs 22+ - (defvaralias 'diredp-menu-bar-regexp-recursive-menu 'diredp-regexp-recursive-menu)) -(make-obsolete-variable 'diredp-menu-bar-regexp-recursive-menu 'diredp-regexp-recursive-menu) ; 2017-04-09 - -(when (boundp 'diredp-menu-bar-regexp-recursive-menu) - (defalias 'diredp-menu-bar-regexp-recursive-menu diredp-menu-bar-regexp-recursive-menu)) -(make-obsolete 'diredp-menu-bar-regexp-recursive-menu 'diredp-regexp-recursive-menu) ; 2017-04-09 - - -;; "Marks" menu. -;; -;; REPLACE ORIGINAL `Marks' menu in `dired.el'. -;; -(defvar diredp-menu-bar-marks-menu (make-sparse-keymap "Marks")) -(define-key dired-mode-map [menu-bar mark] (cons "Marks" diredp-menu-bar-marks-menu)) - -;; We don't use `define-obsolete-variable-alias' so that byte-compilation in older Emacs -;; works for newer Emacs too. -(when (fboundp 'defvaralias) ; Emacs 22+ - (defvaralias 'diredp-menu-bar-mark-menu 'diredp-menu-bar-marks-menu)) -(make-obsolete-variable 'diredp-menu-bar-mark-menu 'diredp-menu-bar-marks-menu) ; 2017-04-09 - -(define-key diredp-menu-bar-marks-menu [prev] - '(menu-item "Previous Marked" dired-prev-marked-file :help "Move to previous marked file")) -(define-key diredp-menu-bar-marks-menu [next] - '(menu-item "Next Marked" dired-next-marked-file :help "Move to next marked file")) -(define-key diredp-menu-bar-marks-menu [marks] - '(menu-item "Change Mark..." dired-change-marks - :help "Replace a given mark character with another")) -(define-key diredp-menu-bar-marks-menu [toggle-marks] - (if (> emacs-major-version 21) - '(menu-item "Toggle Marked/Unmarked" dired-toggle-marks - :help "Mark unmarked files, unmark marked ones") - '(menu-item "Toggle Marked/Unmarked" dired-toggle-marks - :help "Mark unmarked files, unmark marked ones"))) - - -;; `Marks' > `Tagged' menu. -;; -(when (require 'bookmark+ nil t) - (defvar diredp-marks-tags-menu (make-sparse-keymap "Tagged (Autofiles)") - "`Tags' submenu for Dired menu-bar `Marks' menu.") - (define-key diredp-menu-bar-marks-menu [mark-tags] (cons "Tagged" diredp-marks-tags-menu)) - - (define-key diredp-marks-tags-menu [diredp-unmark-files-tagged-none] - '(menu-item "Unmark Not Tagged with Any..." diredp-unmark-files-tagged-none - :help "Unmark files that are not tagged with *any* of the tags you enter")) - (define-key diredp-marks-tags-menu [diredp-unmark-files-tagged-not-all] - '(menu-item "Unmark Not Tagged with All..." diredp-unmark-files-tagged-not-all - :help "Unmark files that are not tagged with *all* tags")) - (define-key diredp-marks-tags-menu [diredp-unmark-files-tagged-some] - '(menu-item "Unmark Tagged with Some..." diredp-unmark-files-tagged-some - :help "Unmark files that are tagged with at least one of the tags you enter")) - (define-key diredp-marks-tags-menu [diredp-unmark-files-tagged-all] - '(menu-item "Unmark Tagged with All..." diredp-unmark-files-tagged-all - :help "Unmark files that are tagged with *each* tag you enter")) - (define-key diredp-marks-tags-menu [diredp-unmark-files-tagged-regexp] - '(menu-item "Unmark Tagged Matching Regexp..." diredp-unmark-files-tagged-regexp - :help "Unmark files that have at least one tag that matches a regexp")) - (define-key diredp-marks-tags-menu [separator-marks-tags] '("--")) ; ------------------------- - - (define-key diredp-marks-tags-menu [diredp-mark-files-tagged-none] - '(menu-item "Mark Not Tagged with Any..." diredp-mark-files-tagged-none - :help "Mark files that are not tagged with *any* of the tags you enter")) - (define-key diredp-marks-tags-menu [diredp-mark-files-tagged-not-all] - '(menu-item "Mark Not Tagged with All..." diredp-mark-files-tagged-not-all - :help "Mark files that are not tagged with *all* tags")) - (define-key diredp-marks-tags-menu [diredp-mark-files-tagged-some] - '(menu-item "Mark Tagged with Some..." diredp-mark-files-tagged-some - :help "Mark files that are tagged with at least one of the tags you enter")) - (define-key diredp-marks-tags-menu [diredp-mark-files-tagged-all] - '(menu-item "Mark Tagged with All..." diredp-mark-files-tagged-all - :help "Mark files that are tagged with *each* tag you enter")) - (define-key diredp-marks-tags-menu [diredp-mark-files-tagged-regexp] - '(menu-item "Mark Tagged Matching Regexp..." diredp-mark-files-tagged-regexp - :help "Mark files that have at least one tag that matches a regexp"))) - - -;; `Marks' > `Omit' menu. -;; -(defvar diredp-marks-omit-menu (make-sparse-keymap "Omit") - "`Omit' submenu for Dired menu-bar `Marks' menu.") -(define-key diredp-menu-bar-marks-menu [marks-omit] (cons "Omit" diredp-marks-omit-menu)) - -(define-key diredp-marks-omit-menu [marks-omit-unmarked] - '(menu-item "Omit Unmarked" diredp-omit-unmarked :help "Hide lines of unmarked files")) -(define-key diredp-marks-omit-menu [marks-omit-marked] - '(menu-item "Omit Marked" diredp-omit-marked :help "Hide lines of marked files")) - - -;; `Marks' > `Flag' menu. -;; -(defvar diredp-marks-flag-menu (make-sparse-keymap "Flag") - "`Flag' submenu for Dired menu-bar `Marks' menu.") -(define-key diredp-menu-bar-marks-menu [mark-flag] (cons "Flag" diredp-marks-flag-menu)) - -(define-key diredp-marks-flag-menu [marks-flag-extension] - '(menu-item "Flag Extension..." dired-flag-extension ; In `dired-x.el' - :help "Flag all files that have a certain extension, for deletion")) -(define-key diredp-marks-flag-menu [marks-flag-garbage-files] - '(menu-item "Flag Garbage Files" dired-flag-garbage-files - :help "Flag unneeded files for deletion")) -(define-key diredp-marks-flag-menu [marks-flag-backup-files] - '(menu-item "Flag Backup Files" dired-flag-backup-files - :help "Flag all backup files for deletion")) -(define-key diredp-marks-flag-menu [marks-flag-auto-save-files] - '(menu-item "Flag Auto-save Files" dired-flag-auto-save-files - :help "Flag auto-save files for deletion")) -(define-key diredp-marks-flag-menu [marks-flag-region] - '(menu-item "Flag Region" diredp-flag-region-files-for-deletion - :visible (diredp-nonempty-region-p) - :help "Flag all files in the region (selection) for deletion")) -(when (< emacs-major-version 21) - (put 'diredp-flag-region-files-for-deletion 'menu-enable '(diredp-nonempty-region-p))) -(define-key diredp-marks-flag-menu [marks-flag-deletion] - '(menu-item "Flag This" dired-flag-file-deletion - :visible (not (diredp-nonempty-region-p)) - :help "Flag current line's file for deletion")) - - -;; `Marks' > `Unmark' menu. -;; -(defvar diredp-marks-unmark-menu (make-sparse-keymap "Unmark") - "`Unmark' submenu for Dired menu-bar `Marks' menu.") -(define-key diredp-menu-bar-marks-menu [mark-mark] (cons "Unmark" diredp-marks-unmark-menu)) - -(define-key diredp-marks-unmark-menu [unmark-autofiles] - '(menu-item "Unmark Autofiles" diredp-unmark-autofiles - :help "Unmark all autofiles (bookmarks with same name as file)" - :enable (featurep 'bookmark+))) -(define-key diredp-marks-unmark-menu [unmark-all] - '(menu-item "Unmark All" dired-unmark-all-marks :help "Remove all marks from all files")) -(define-key diredp-marks-unmark-menu [unmark-with] - '(menu-item "Unmark Marked-With..." dired-unmark-all-files - :help "Remove a specific mark (or all marks) from every file")) -(define-key diredp-marks-unmark-menu [unmark-region] - '(menu-item "Unmark Region" diredp-unmark-region-files - :visible (diredp-nonempty-region-p) - :help "Unmark all files in the region (selection)")) -(when (< emacs-major-version 21) - (put 'diredp-unmark-region-files 'menu-enable '(diredp-nonempty-region-p))) -(define-key diredp-marks-unmark-menu [unmark-this] - '(menu-item "Unmark This" dired-unmark - :visible (not (diredp-nonempty-region-p)) - :help "Unmark or unflag current line's file")) - - -;; `Marks' > `Mark' menu. -;; -(defvar diredp-marks-mark-menu (make-sparse-keymap "Mark") - "`Mark' submenu for Dired menu-bar `Marks' menu.") -(define-key diredp-menu-bar-marks-menu [marks-mark] (cons "Mark" diredp-marks-mark-menu)) - -(define-key diredp-marks-mark-menu [marks-mark-sexp] - '(menu-item "Mark If..." dired-mark-sexp ; In `dired-x.el'. - :help "Mark files that satisfy specified condition")) -(define-key diredp-marks-mark-menu [marks-image-dired-mark-tagged-files] - '(menu-item "Mark Image Files Tagged..." image-dired-mark-tagged-files - :enable (fboundp 'image-dired-mark-tagged-files) ; In `image-dired.el'. - :help "Mark image files whose image tags match regexp")) -(define-key diredp-marks-mark-menu [marks-mark-cont] - '(menu-item "Mark Content Matching Regexp..." dired-mark-files-containing-regexp - :help "Mark files whose contents matches regexp")) -(define-key diredp-marks-mark-menu [marks-mark...] - '(menu-item "Mark Name Matching Regexp..." dired-mark-files-regexp - :help "Mark file names matching regexp")) -(when (fboundp 'dired-mark-omitted) ; In `dired-x.el', Emacs 22+. - (define-key diredp-marks-mark-menu [marks-mark-omitted] - '(menu-item "Mark Omitted..." dired-mark-omitted - :help "Mark all omitted files and subdirectories"))) -(define-key diredp-marks-mark-menu [marks-mark-extension] - '(menu-item "Mark Extension..." diredp-mark/unmark-extension - :help "Mark all files with specified extension")) -(define-key diredp-marks-mark-menu [marks-mark-autofiles] - '(menu-item "Mark Autofiles" diredp-mark-autofiles - :help "Mark all autofiles (bookmarks with same name as file)" - :enable (featurep 'bookmark+))) -(define-key diredp-marks-mark-menu [marks-mark-symlinks] - '(menu-item "Mark Symlinks" dired-mark-symlinks - :visible (fboundp 'make-symbolic-link) :help "Mark all symbolic links")) -(define-key diredp-marks-mark-menu [marks-mark-directories] - '(menu-item "Mark Directories" dired-mark-directories - :help "Mark all directories except `.' and `..'")) -(define-key diredp-marks-mark-menu [marks-mark-directory] - '(menu-item "Mark Old Backups" dired-clean-directory - :help "Flag old numbered backups for deletion")) -(define-key diredp-marks-mark-menu [marks-mark-executables] - '(menu-item "Mark Executables" dired-mark-executables :help "Mark all executable files")) -(define-key diredp-marks-mark-menu [marks-mark-region] - '(menu-item "Mark Region" diredp-mark-region-files - :visible (diredp-nonempty-region-p) - :help "Mark all of the files in the region (selection)")) -(when (< emacs-major-version 21) - (put 'diredp-mark-region-files 'menu-enable '(diredp-nonempty-region-p))) -(define-key diredp-marks-mark-menu [marks-mark-this] - '(menu-item "Mark This" dired-mark - :visible (not (diredp-nonempty-region-p)) - :help "Mark current line's file for future operations")) - - -;; `Marks' > `Here and Below' menu. -;; -(defvar diredp-marks-recursive-menu (make-sparse-keymap "Here and Below")) -(define-key diredp-menu-bar-marks-menu [mark-recursive] - (cons "Here and Below" diredp-marks-recursive-menu)) - -(define-key diredp-marks-recursive-menu [diredp-flag-auto-save-files-recursive] - '(menu-item "Flag Auto-Save Files..." diredp-flag-auto-save-files-recursive - :help "Flag all auto-save files for deletion, including those in marked subdirs")) -(when (fboundp 'diredp-unmark-all-marks-recursive) ; Emacs 22+ - (define-key diredp-marks-recursive-menu [diredp-change-marks-recursive] - '(menu-item "Change Mark..." diredp-change-marks-recursive - :help "Change all OLD marks to NEW marks, including those in marked subdirs")) - (define-key diredp-marks-recursive-menu [diredp-unmark-all-files-recursive] - '(menu-item "Unmark Marked-With..." diredp-unmark-all-files-recursive - :help "Remove a given mark everywhere, including in marked subdirs")) - (define-key diredp-marks-recursive-menu [diredp-unmark-all-marks-recursive] - '(menu-item "Unmark All..." diredp-unmark-all-marks-recursive - :help "Remove ALL marks everywhere, including in marked subdirs")) - (define-key diredp-marks-recursive-menu [separator-1] '("--"))) ; ------------ -(define-key diredp-marks-recursive-menu [diredp-mark-sexp-recursive] - '(menu-item "If..." diredp-mark-sexp-recursive - :help "Mark files satisfying specified condition, including those in marked subdirs")) -(define-key diredp-marks-recursive-menu [diredp-mark-files-containing-regexp-recursive] - '(menu-item "Containing Regexp..." diredp-mark-files-containing-regexp-recursive - :help "Mark all files with content matching a regexp, including in marked subdirs")) -(define-key diredp-marks-recursive-menu [diredp-mark-files-regexp-recursive] - '(menu-item "Named Regexp..." diredp-mark-files-regexp-recursive - :help "Mark all file names matching a regexp, including those in marked subdirs")) -(define-key diredp-marks-recursive-menu [diredp-mark-extension-recursive] - '(menu-item "Extension..." diredp-mark-extension-recursive - :help "Mark all files with a given extension, including those in marked subdirs")) -(define-key diredp-marks-recursive-menu [diredp-mark-autofiles-recursive] - '(menu-item "Autofiles" diredp-mark-autofiles-recursive - :help "Mark all files with a given extension, including those in marked subdirs" - :enable (featurep 'bookmark+))) -(define-key diredp-marks-recursive-menu [diredp-mark-symlinks-recursive] - '(menu-item "Symbolic Links" diredp-mark-symlinks-recursive - :help "Mark all symbolic links, including those in marked subdirs")) -(define-key diredp-marks-recursive-menu [diredp-mark-directories-recursive] - '(menu-item "Directories" diredp-mark-directories-recursive - :help "Mark all directories, including those in marked subdirs")) -(define-key diredp-marks-recursive-menu [diredp-mark-executables-recursive] - '(menu-item "Executables" diredp-mark-executables-recursive - :help "Mark all executable files, including those in marked subdirs")) - - -;; "Dir" menu. -;; -;; REPLACE ORIGINAL `Subdir' menu in `dired.el'. -;; -(defvar diredp-menu-bar-dir-menu (make-sparse-keymap "Dir")) -(define-key dired-mode-map [menu-bar subdir] (cons "Dir" diredp-menu-bar-dir-menu)) - -;; We don't use `define-obsolete-variable-alias' so that byte-compilation in older Emacs -;; works for newer Emacs too. -(when (fboundp 'defvaralias) ; Emacs 22+ - (defvaralias 'diredp-menu-bar-subdir-menu 'diredp-dir-menu)) -(make-obsolete-variable 'diredp-menu-bar-subdir-menu 'diredp-dir-menu) ; 2017-04-09 - -(when (boundp 'diredp-menu-bar-subdir-menu) - (defalias 'diredp-menu-bar-subdir-menu diredp-menu-bar-subdir-menu)) -(make-obsolete 'diredp-menu-bar-subdir-menu 'diredp-dir-menu) ; 2017-04-09 - - -;; `Dir' > `Hide/Show' menu. -;; -(defvar diredp-hide/show-menu (make-sparse-keymap "Hide/Show") - "`Hide/Show' submenu for Dired menu-bar `Dir' menu.") -(define-key diredp-menu-bar-dir-menu [hide-show] (cons "Hide/Show" diredp-hide/show-menu)) - -(when (fboundp 'dired-omit-mode) - (define-key diredp-hide/show-menu [dired-omit-mode] - '(menu-item "Hide/Show Uninteresting (Omit Mode)" dired-omit-mode - :help "Toggle omission of uninteresting files (Omit mode)"))) -(when (fboundp 'dired-hide-details-mode) ; Emacs 24.4+ - (define-key diredp-hide/show-menu [hide-details] - '(menu-item "Hide/Show Details" dired-hide-details-mode - :help "Hide or show less important fields of directory listing"))) -(define-key diredp-hide/show-menu [hide-all] - '(menu-item "Hide/Show All Subdirs" dired-hide-all - :help "Hide all subdirectories, leave only header lines")) -(define-key diredp-hide/show-menu [hide-subdir] - '(menu-item "Hide/Show Subdir" diredp-hide-subdir-nomove - :help "Hide or unhide current directory listing")) - - -;; `Dir' > `Bookmark' menu. -;; -(defvar diredp-bookmark-menu (make-sparse-keymap "Bookmark") - "`Bookmark' submenu for Dired menu-bar `Dir' menu.") -(define-key diredp-menu-bar-dir-menu [bookmark] (cons "Bookmark" diredp-bookmark-menu)) - -(define-key diredp-bookmark-menu [diredp-highlight-autofiles-mode] - '(menu-item "Toggle Autofile Highlighting" diredp-highlight-autofiles-mode - :help "Toggle whether to highlight autofile bookmarks" - :visible (and (featurep 'bookmark+) (featurep 'highlight)))) -(define-key diredp-bookmark-menu [diredp-do-bookmark-dirs-recursive] - '(menu-item "Bookmark Dirs Here and Below..." diredp-do-bookmark-dirs-recursive - :help "Bookmark this Dired buffer and marked subdirectory Dired buffers, recursively.")) -(define-key diredp-bookmark-menu [bookmark-dired] - '(menu-item "Bookmark Dired Buffer..." bookmark-set :help "Bookmark this Dired buffer")) - - -;; `Dir' > `Navigate' menu. -;; -(defvar diredp-navigate-menu (make-sparse-keymap "Navigate") - "`Navigate' submenu for Dired menu-bar `Dir' menu.") -(define-key diredp-menu-bar-dir-menu [navigate] (cons "Navigate" diredp-navigate-menu)) - -(define-key diredp-navigate-menu [insert] - '(menu-item "Move To This Subdir" dired-maybe-insert-subdir - :help "Move to subdirectory line or listing")) -(define-key diredp-navigate-menu [tree-down] - '(menu-item "Tree Down" dired-tree-down :help "Go to first subdirectory header down the tree")) -(define-key diredp-navigate-menu [tree-up] - '(menu-item "Tree Up" dired-tree-up :help "Go to first subdirectory header up the tree")) -(define-key diredp-navigate-menu [up] - '(menu-item "Up Directory" diredp-up-directory :help "Dired the parent directory")) -(define-key diredp-navigate-menu [prev-subdir] - '(menu-item "Prev Subdir" diredp-prev-subdir :help "Go to previous subdirectory header line")) -(define-key diredp-navigate-menu [next-subdir] - '(menu-item "Next Subdir" diredp-next-subdir :help "Go to next subdirectory header line")) -(define-key diredp-navigate-menu [prev-dirline] - '(menu-item "Prev Dirline" diredp-prev-dirline :help "Move to previous directory-file line")) -(define-key diredp-navigate-menu [next-dirline] - '(menu-item "Next Dirline" diredp-next-dirline :help "Move to next directory-file line")) - -(define-key diredp-menu-bar-dir-menu [separator-subdir] '("--")) ; -------------------------- - -(define-key diredp-menu-bar-dir-menu [image-dired-dired-toggle-marked-thumbs] - '(menu-item "Toggle Image Thumbnails" image-dired-dired-toggle-marked-thumbs - :enable (fboundp 'image-dired-dired-toggle-marked-thumbs) - :help "Add or remove image thumbnails in front of marked file names")) -(when (fboundp 'dired-isearch-filenames) ; Emacs 23+ - (define-key diredp-menu-bar-dir-menu [isearch-filenames-regexp] - '(menu-item "Isearch Regexp in File Names..." dired-isearch-filenames-regexp - :help "Incrementally search for regexp in file names only")) - (define-key diredp-menu-bar-dir-menu [isearch-filenames] - '(menu-item "Isearch in File Names..." dired-isearch-filenames - :help "Incrementally search for literal text in file names only."))) -(when (or (> emacs-major-version 21) (fboundp 'wdired-change-to-wdired-mode)) - (define-key diredp-menu-bar-dir-menu [wdired-mode] - '(menu-item "Edit File Names (WDired)" wdired-change-to-wdired-mode - :help "Put a Dired buffer in a mode in which filenames are editable" - :keys "C-x C-q" :filter (lambda (x) (and (derived-mode-p 'dired-mode) x))))) -(define-key diredp-menu-bar-dir-menu [diredp-yank-files] - '(menu-item "Paste Files from Copied Absolute Names" diredp-yank-files - :help "Paste files here whose absolute names you copied" - :enable (catch 'dir-menu--yank-files - (let ((files (car kill-ring-yank-pointer))) - (and (stringp files) - (dolist (file (split-string files)) - (unless (file-name-absolute-p file) (throw 'dir-menu--yank-files nil))))) - t))) -(when (fboundp 'dired-compare-directories) ; Emacs 22+ - (define-key diredp-menu-bar-dir-menu [compare-directories] - '(menu-item "Compare Directories..." dired-compare-directories - :help "Mark files with different attributes in two Dired buffers"))) - -(define-key diredp-menu-bar-dir-menu [separator-dired-on-set] '("--")) ; -------------------- - -(define-key diredp-menu-bar-dir-menu [diredp-dired-recent-dirs] - '(menu-item "Dired Recent Directories..." diredp-dired-recent-dirs - :visible (boundp 'recentf-list) :enable (and (boundp 'recentf-list) (consp recentf-list)) - :help "Open a Dired buffer for recently used directories")) -(define-key diredp-menu-bar-dir-menu [diredp-dired-inserted-subdirs] - '(menu-item "Dired Each Inserted Subdir..." diredp-dired-inserted-subdirs - :enable (cdr dired-subdir-alist) ; First elt is current dir. Must have at least one more. - :help "Open Dired separately for each of the inserted subdirectories")) -(define-key diredp-menu-bar-dir-menu [diredp-add-to-this-dired-buffer] - '(menu-item "Add Entries Here..." diredp-add-to-this-dired-buffer - :help "Add individual file and directory names to the listing" - :keys "C-x E")) -(define-key diredp-menu-bar-dir-menu [diredp-dired-union] - '(menu-item "Dired Union..." diredp-dired-union - :help "Open Dired for the union of some existing Dired buffers")) -(define-key diredp-menu-bar-dir-menu [diredp-fileset-other-window] - '(menu-item "Dired Fileset..." diredp-fileset-other-window - :enable (> emacs-major-version 21) :help "Open Dired on an Emacs fileset")) -(define-key diredp-menu-bar-dir-menu [diredp-dired-for-files] - '(menu-item "Dired Files Located Anywhere" diredp-dired-for-files - :help "Open Dired on specific files whose names you provide")) -(define-key diredp-menu-bar-dir-menu [diredp-marked-other-window] - '(menu-item "Dired Marked Files in Other Window" diredp-marked-other-window - :enable (save-excursion (goto-char (point-min)) - (and (re-search-forward (dired-marker-regexp) nil t) - (re-search-forward (dired-marker-regexp) nil t))) - :help "Open Dired on marked files only, in other window")) -(define-key diredp-menu-bar-dir-menu [diredp-marked] - '(menu-item "Dired Marked Files" diredp-marked - :enable (save-excursion (goto-char (point-min)) - (and (re-search-forward (dired-marker-regexp) nil t) - (re-search-forward (dired-marker-regexp) nil t))) - :help "Open Dired on marked files only")) -(define-key diredp-menu-bar-dir-menu [dired] - '(menu-item "Dired (Filter via Wildcards)..." dired - :help "Explore a directory (you can provide wildcards)")) - -(define-key diredp-menu-bar-dir-menu [separator-dired] '("--")) ; --------------------- - -(define-key diredp-menu-bar-dir-menu [insert] - '(menu-item "Insert/Move-To This Subdir" dired-maybe-insert-subdir - :help "Move to subdirectory line or listing")) -(define-key diredp-menu-bar-dir-menu [revert] - '(menu-item "Refresh (Sync \& Show All)" revert-buffer :help "Update directory contents")) -(define-key diredp-menu-bar-dir-menu [create-directory] ; Moved from "Immediate". - '(menu-item "New Directory..." dired-create-directory :help "Create a directory")) - - -;;; Mouse-3 menu binding. -(define-key dired-mode-map [down-mouse-3] 'diredp-mouse-3-menu) -(define-key dired-mode-map [mouse-3] 'ignore) - - -;;; Non-menu Dired bindings. - -;; Move `dired-omit-mode' to `C-x M-o', so prefix key `M-o' is free for face/font-lock stuff. -(define-key dired-mode-map "\C-x\M-o" (if (fboundp 'dired-omit-mode) 'dired-omit-mode 'dired-omit-toggle)) -(when (memq (lookup-key dired-mode-map "\M-o") '(dired-omit-mode dired-omit-toggle)) - (define-key dired-mode-map "\M-o" nil)) - -;; These are global, not just Dired mode. They are on prefix key `C-x D'. -(unless (lookup-key ctl-x-map "D") - (define-key ctl-x-map "D" nil) ; For Emacs 20 - (define-key ctl-x-map "DA" 'diredp-add-to-dired-buffer) ; `C-x D A' - (define-key ctl-x-map "DF" 'diredp-dired-for-files) ; `C-x D F' - (define-key ctl-x-map "DR" 'diredp-dired-recent-dirs) ; `C-x D R' - (define-key ctl-x-map "DS" 'diredp-fileset) ; `C-x D S' - (define-key ctl-x-map "DU" 'diredp-dired-union)) ; `C-x D U' - -(unless (lookup-key ctl-x-4-map "D") - (define-key ctl-x-4-map "D" nil) ; For Emacs 20 - (define-key ctl-x-4-map "DA" 'diredp-add-to-dired-buffer-other-window) ; `C-x 4 D A' - (define-key ctl-x-4-map "DF" 'diredp-dired-for-files-other-window) ; `C-x 4 D F' - (define-key ctl-x-4-map "DR" 'diredp-dired-recent-dirs-other-window) ; `C-x 4 D R' - (define-key ctl-x-4-map "DS" 'diredp-fileset-other-window) ; `C-x 4 D S' - (define-key ctl-x-4-map "DU" 'diredp-dired-union-other-window)) ; `C-x 4 D U' - -;; Navigation -(substitute-key-definition 'dired-up-directory 'diredp-up-directory dired-mode-map) -(substitute-key-definition 'dired-next-line 'diredp-next-line dired-mode-map) -(substitute-key-definition 'dired-previous-line 'diredp-previous-line dired-mode-map) -(substitute-key-definition 'dired-next-dirline 'diredp-next-dirline dired-mode-map) -(substitute-key-definition 'dired-prev-dirline 'diredp-prev-dirline dired-mode-map) -(substitute-key-definition 'dired-next-subdir 'diredp-next-subdir dired-mode-map) -(substitute-key-definition 'dired-prev-subdir 'diredp-prev-subdir dired-mode-map) - - -(define-key dired-mode-map [S-down-mouse-1] 'ignore) ; (normally `mouse-set-font') -;; `diredp-mouse-mark-region-files' provides Windows-Explorer behavior -;; for selecting (marking) files. -(define-key dired-mode-map [S-mouse-1] 'diredp-mouse-mark-region-files) ; `S-mouse-1' -(define-key dired-mode-map [mouse-2] 'dired-mouse-find-file-other-window) ; `mouse-2' -;; But be aware that `dired-sort-menu.el' binds `S-mouse-2' to `dired-sort-menu-popup'. -(define-key dired-mode-map [S-down-mouse-2] 'dired-mouse-find-file) ; `S-mouse-2' -(define-key dired-mode-map [S-mouse-2] 'ignore) -(define-key dired-mode-map [M-mouse-2] 'diredp-mouse-find-file-other-frame) ; `M-mouse-2' - -;; On Windows, bind more. -(eval-after-load "w32-browser" - '(progn - (define-key dired-mode-map [(control return)] 'dired-w32explore) ; `C-RET' - (define-key dired-mode-map [(meta return)] 'dired-w32-browser) ; `M-RET' - (define-key dired-mode-map [mouse-2] 'dired-mouse-w32-browser) ; `mouse-2' - (define-key dired-mode-map (kbd "") 'dired-multiple-w32-browser))) ; `C-M-RET' - -(when (fboundp 'diredp-w32-drives) - (when (< emacs-major-version 21) (define-key dired-mode-map ":" nil)) ; For Emacs 20 - (define-key dired-mode-map ":/" 'diredp-w32-drives)) ; `:/' - -;; Other keyboard keys -(define-key dired-mode-map "@" 'diredp-do-apply-function) ; `@' -(define-key dired-mode-map "\$" 'diredp-hide-subdir-nomove) ; `$' -(define-key dired-mode-map "\M-$" 'dired-hide-subdir) ; `M-$' -(define-key dired-mode-map "=" 'diredp-ediff) ; `=' -;; This replaces the `dired-x.el' binding of `dired-mark-extension'. -(define-key dired-mode-map "*." 'diredp-mark/unmark-extension) ; `* .' -(define-key dired-mode-map "*B" 'diredp-mark-autofiles) ; `* B' -(define-key dired-mode-map [(control meta ?*)] 'diredp-marked-other-window) ; `C-M-*' -(define-key dired-mode-map "\M-a" 'dired-do-search) ; `M-a' -(define-key dired-mode-map "\M-b" 'diredp-do-bookmark) ; `M-b' -(define-key dired-mode-map "\C-\M-b" 'diredp-set-bookmark-file-bookmark-for-marked) ; `C-M-b' -(when diredp-bind-problematic-terminal-keys - (define-key dired-mode-map [(control meta shift ?b)] ; `C-M-B' (aka `C-M-S-b') - 'diredp-do-bookmark-in-bookmark-file)) -(define-key dired-mode-map "e" 'diredp-visit-this-file) ; `e' (was `dired-find-file') -(define-key dired-mode-map [C-down] 'diredp-visit-next-file) ; `C-down' (was `forward-paragraph') -(define-key dired-mode-map [C-up] 'diredp-visit-previous-file) ; `C-up' (was `backward-paragraph') -(define-key dired-mode-map "\C-\M-G" 'diredp-do-grep) ; `C-M-G' -(when (fboundp 'mkhtml-dired-files) ; In `mkhtml.el'. - (define-key dired-mode-map "\M-h" 'mkhtml-dired-files)) ; `M-h' -(define-key dired-mode-map "\C-\M-i" 'diredp-dired-inserted-subdirs) ; `C-M-i' -(define-key dired-mode-map "\M-q" (if (< emacs-major-version 21) - 'dired-do-query-replace - 'dired-do-query-replace-regexp)) ; `M-q' -(when diredp-bind-problematic-terminal-keys - (define-key dired-mode-map [(control meta shift ?r)] ; `C-M-R' (aka `C-M-S-r') - 'diredp-toggle-find-file-reuse-dir)) -(define-key dired-mode-map "U" 'dired-unmark-all-marks) ; `U' -(substitute-key-definition 'describe-mode 'diredp-describe-mode ; `h', `C-h m' - dired-mode-map (current-global-map)) - -;; Tags - same keys as in `*Bookmark List*'. -;; -;; NOTE: If this changes then need to update `dired-sort-menu+.el' to reflect the changes. -;; -(define-key dired-mode-map "T" nil) ; For Emacs 20 -(define-key dired-mode-map "T+" 'diredp-tag-this-file) ; `T +' -(define-key dired-mode-map "T-" 'diredp-untag-this-file) ; `T -' -(define-key dired-mode-map "T0" 'diredp-remove-all-tags-this-file) ; `T 0' -(define-key dired-mode-map "Tc" 'diredp-copy-tags-this-file) ; `T c' -(define-key dired-mode-map "Tp" 'diredp-paste-add-tags-this-file) ; `T p' -(define-key dired-mode-map "Tq" 'diredp-paste-replace-tags-this-file) ; `T q' -(define-key dired-mode-map "Tv" 'diredp-set-tag-value-this-file) ; `T v' -(define-key dired-mode-map "T\M-w" 'diredp-copy-tags-this-file) ; `T M-w' -(define-key dired-mode-map "T\C-y" 'diredp-paste-add-tags-this-file) ; `T C-y' -(define-key dired-mode-map "T>+" 'diredp-do-tag) ; `T > +' -(define-key dired-mode-map "T>-" 'diredp-do-untag) ; `T > -' -(define-key dired-mode-map "T>0" 'diredp-do-remove-all-tags) ; `T > 0' -(define-key dired-mode-map "T>p" 'diredp-do-paste-add-tags) ; `T > p' -(define-key dired-mode-map "T>q" 'diredp-do-paste-replace-tags) ; `T > q' -(define-key dired-mode-map "T>v" 'diredp-do-set-tag-value) ; `T > v' -(define-key dired-mode-map "T>\C-y" 'diredp-do-paste-add-tags) ; `T > C-y' -(define-key dired-mode-map "Tm%" 'diredp-mark-files-tagged-regexp) ; `T m %' -(define-key dired-mode-map "Tm*" 'diredp-mark-files-tagged-all) ; `T m *' -(define-key dired-mode-map "Tm+" 'diredp-mark-files-tagged-some) ; `T m +' -(define-key dired-mode-map "Tm~*" 'diredp-mark-files-tagged-not-all) ; `T m ~ *' -(define-key dired-mode-map "Tm~+" 'diredp-mark-files-tagged-none) ; `T m ~ +' -(define-key dired-mode-map "Tu%" 'diredp-unmark-files-tagged-regexp) ; `T u %' -(define-key dired-mode-map "Tu*" 'diredp-unmark-files-tagged-all) ; `T u *' -(define-key dired-mode-map "Tu+" 'diredp-unmark-files-tagged-some) ; `T u +' -(define-key dired-mode-map "Tu~*" 'diredp-unmark-files-tagged-not-all) ; `T u ~ *' -(define-key dired-mode-map "Tu~+" 'diredp-unmark-files-tagged-none) ; `T u ~ +' -;; $$$$$$ (define-key dired-mode-map [(control ?+)] 'diredp-do-tag) -;; $$$$$$ (define-key dired-mode-map [(control ?-)] 'diredp-do-untag) - - -;; Vanilla Emacs binds `c' to `dired-do-compress-to'. Use `M-z' instead'. -;; (`dired-sort-menu.el' binds `c' to `dired-sort-menu-toggle-ignore-case'.) -;; -(when (fboundp 'dired-do-compress-to) ; Emacs 25+ - (define-key dired-mode-map (kbd "M-z") 'dired-do-compress-to)) - - -;; Commands for operating on the current line's file. When possible, -;; these are lower-case versions of the upper-case commands for operating on -;; the marked files. (Most of the other corresponding lower-case letters are already -;; defined and cannot be used here.) - -;; $$$$$$ (define-key dired-mode-map [(control meta ?+)] 'diredp-tag-this-file) -;; $$$$$$ (define-key dired-mode-map [(control meta ?-)] 'diredp-untag-this-file) -(define-key dired-mode-map "\r" 'dired-find-file) ; `RET' -(when (fboundp 'diredp-describe-file) - (define-key dired-mode-map (kbd "C-h RET") 'diredp-describe-file) ; `C-h RET' - (define-key dired-mode-map (kbd "C-h C-") 'diredp-describe-file)) ; `C-h C-RET' -(define-key dired-mode-map "%c" 'diredp-capitalize) ; `% c' -(define-key dired-mode-map "b" 'diredp-byte-compile-this-file) ; `b' -(define-key dired-mode-map [(control shift ?b)] 'diredp-bookmark-this-file) ; `C-B' -(define-key dired-mode-map "\M-c" 'diredp-capitalize-this-file) ; `M-c' -(when (and (fboundp 'diredp-chgrp-this-file) diredp-bind-problematic-terminal-keys) - (define-key dired-mode-map [(control meta shift ?g)] 'diredp-chgrp-this-file)) ; `C-M-G' (aka `C-M-S-g') -(define-key dired-mode-map "\M-i" 'diredp-insert-subdirs) ; `M-i' -(define-key dired-mode-map "\M-l" 'diredp-downcase-this-file) ; `M-l' -(define-key dired-mode-map "\C-\M-l" 'diredp-list-marked) ; `C-M-l' -(when diredp-bind-problematic-terminal-keys - (define-key dired-mode-map [(meta shift ?m)] 'diredp-chmod-this-file)) ; `M-M' (aka `M-S-m') -(define-key dired-mode-map "\C-o" 'diredp-find-file-other-frame) ; `C-o' -(when (and (fboundp 'diredp-chown-this-file) diredp-bind-problematic-terminal-keys) - (define-key dired-mode-map [(meta shift ?o)] 'diredp-chown-this-file)) ; `M-O' (aka `M-S-o') -(define-key dired-mode-map "\C-\M-o" 'dired-display-file) ; `C-M-o' (not `C-o') -(define-key dired-mode-map "\M-p" 'diredp-print-this-file) ; `M-p' -(define-key dired-mode-map "r" 'diredp-rename-this-file) ; `r' -(when (fboundp 'image-dired-dired-display-image) - (define-key dired-mode-map "\C-tI" 'diredp-image-show-this-file)) ; `C-t I' -(when diredp-bind-problematic-terminal-keys - (define-key dired-mode-map [(meta shift ?t)] 'diredp-touch-this-file) ; `M-T' (aka `M-S-t') - (define-key dired-mode-map [(control meta shift ?t)] 'dired-do-touch)) ; `C-M-T' (aka `C-M-S-t') -(define-key dired-mode-map "\M-u" 'diredp-upcase-this-file) ; `M-u' -(define-key dired-mode-map "y" 'diredp-relsymlink-this-file) ; `y' -(define-key dired-mode-map "\C-w" 'diredp-move-files-named-in-kill-ring) ; `C-w' -(define-key dired-mode-map "\C-y" 'diredp-yank-files) ; `C-y' -(define-key dired-mode-map "z" 'diredp-compress-this-file) ; `z' -(when (fboundp 'dired-show-file-type) - (define-key dired-mode-map "_" 'dired-show-file-type)) ; `_' (underscore) -(substitute-key-definition 'kill-line 'diredp-delete-this-file ; `C-k', `delete', `deleteline' - dired-mode-map (current-global-map)) - - -;; Commands that handle marked below, recursively. -;; Use `M-+' as a prefix key for all such commands. - -(define-prefix-command 'diredp-recursive-map) -(define-key dired-mode-map "\M-+" diredp-recursive-map) ; `M-+' - -(when (fboundp 'char-displayable-p) ; Emacs 22+ - (define-key diredp-recursive-map "\M-\C-?" 'diredp-unmark-all-files-recursive)) ; `M-DEL' -(define-key diredp-recursive-map "@" 'diredp-do-apply-function-recursive) ; `@' -(define-key diredp-recursive-map "#" 'diredp-flag-auto-save-files-recursive) ; `#' -(define-key diredp-recursive-map "*@" 'diredp-mark-symlinks-recursive) ; `* @' -(define-key diredp-recursive-map "**" 'diredp-mark-executables-recursive) ; `* *' -(define-key diredp-recursive-map "*/" 'diredp-mark-directories-recursive) ; `* /' -(define-key diredp-recursive-map "*." 'diredp-mark-extension-recursive) ; `* .' -(define-key diredp-recursive-map "*(" 'diredp-mark-sexp-recursive) ; `* (' -(define-key diredp-recursive-map "*B" 'diredp-mark-autofiles-recursive) ; `* B' -(when (fboundp 'char-displayable-p) ; Emacs 22+ - (define-key diredp-recursive-map "*c" 'diredp-change-marks-recursive)) ; `* c' -(define-key diredp-recursive-map "*%" 'diredp-mark-files-regexp-recursive) ; `* %' -(when (> emacs-major-version 22) - (define-key diredp-recursive-map ":d" 'diredp-do-decrypt-recursive) ; `: d' - (define-key diredp-recursive-map ":e" 'diredp-do-encrypt-recursive) ; `: e' - (define-key diredp-recursive-map ":s" 'diredp-do-sign-recursive) ; `: s' - (define-key diredp-recursive-map ":v" 'diredp-do-verify-recursive)) ; `: v' -(define-key diredp-recursive-map "%c" 'diredp-capitalize-recursive) ; `% c' -(define-key diredp-recursive-map "%g" 'diredp-mark-files-containing-regexp-recursive) ; `% g' -(define-key diredp-recursive-map "%l" 'diredp-downcase-recursive) ; `% l' -(define-key diredp-recursive-map "%m" 'diredp-mark-files-regexp-recursive) ; `% m' -(define-key diredp-recursive-map "%u" 'diredp-upcase-recursive) ; `% u' -(when (fboundp 'dired-do-async-shell-command) ; Emacs 23+ - (define-key diredp-recursive-map "&" 'diredp-do-async-shell-command-recursive)) ; `&' -(define-key diredp-recursive-map "!" 'diredp-do-shell-command-recursive) ; `!' -(define-key diredp-recursive-map (kbd "C-M-*") 'diredp-marked-recursive-other-window) ; `C-M-*' -(define-key diredp-recursive-map "A" 'diredp-do-search-recursive) ; `A' -(define-key diredp-recursive-map "\M-b" 'diredp-do-bookmark-recursive) ; `M-b' -(when diredp-bind-problematic-terminal-keys - (define-key diredp-recursive-map [(meta shift ?b)] ; `M-B' (aka `M-S-b') - 'diredp-do-bookmark-dirs-recursive)) -(define-key diredp-recursive-map (kbd "C-M-b") ; `C-M-b' - 'diredp-set-bookmark-file-bookmark-for-marked-recursive) -(when diredp-bind-problematic-terminal-keys - (define-key diredp-recursive-map [(control meta shift ?b)] ; `C-M-B' (aka `C-M-S-b') - 'diredp-do-bookmark-in-bookmark-file-recursive)) -(define-key diredp-recursive-map "C" 'diredp-do-copy-recursive) ; `C' -(define-key diredp-recursive-map "D" 'diredp-do-delete-recursive) ; `D' -(define-key diredp-recursive-map "F" 'diredp-do-find-marked-files-recursive) ; `F' -(when (fboundp 'diredp-do-chgrp-recursive) - (define-key diredp-recursive-map "G" 'diredp-do-chgrp-recursive)) ; `G' -(define-key diredp-recursive-map "\C-\M-G" 'diredp-do-grep-recursive) ; `C-M-G' -(define-key diredp-recursive-map "H" 'diredp-do-hardlink-recursive) ; `H' -(define-key diredp-recursive-map "\M-i" 'diredp-insert-subdirs-recursive) ; `M-i' -(define-key diredp-recursive-map "\C-\M-l" 'diredp-list-marked-recursive) ; `C-M-l' -(define-key diredp-recursive-map "M" 'diredp-do-chmod-recursive) ; `M' -(when (fboundp 'diredp-do-chown-recursive) - (define-key diredp-recursive-map "O" 'diredp-do-chown-recursive)) ; `O' -(define-key diredp-recursive-map "P" 'diredp-do-print-recursive) ; `P' -(define-key diredp-recursive-map "Q" 'diredp-do-query-replace-regexp-recursive) ; `Q' -(define-key diredp-recursive-map "R" 'diredp-do-move-recursive) ; `R' -(define-key diredp-recursive-map "S" 'diredp-do-symlink-recursive) ; `S' -(define-key diredp-recursive-map (kbd "M-s a C-s") ; `M-s a C-s' - 'diredp-do-isearch-recursive) -(define-key diredp-recursive-map (kbd "M-s a C-M-s") ; `M-s a C-M-s' - 'diredp-do-isearch-regexp-recursive) -(when diredp-bind-problematic-terminal-keys - (define-key diredp-recursive-map [(control meta shift ?t)] - 'diredp-do-touch-recursive)) ; `C-M-T' (aka `C-M-S-t') -(define-key diredp-recursive-map "\C-tc" 'diredp-image-dired-comment-files-recursive) ; `C-t c' -(define-key diredp-recursive-map "\C-td" 'diredp-image-dired-display-thumbs-recursive) ; `C-t d' -(define-key diredp-recursive-map "\C-tr" 'diredp-image-dired-delete-tag-recursive) ; `C-t r' -(define-key diredp-recursive-map "\C-tt" 'diredp-image-dired-tag-files-recursive) ; `C-t t' -(when (fboundp 'char-displayable-p) ; Emacs 22+ - (define-key diredp-recursive-map "U" 'diredp-unmark-all-marks-recursive)) ; `U' -(define-key diredp-recursive-map "\M-(" 'diredp-mark-sexp-recursive) ; `M-(' -(define-key diredp-recursive-map "\M-w" 'diredp-copy-filename-as-kill-recursive) ; `M-w' -(define-key diredp-recursive-map "Y" 'diredp-do-relsymlink-recursive) ; `Y' - -(eval-after-load "w32-browser" - '(define-key diredp-recursive-map (kbd "") 'diredp-multiple-w32-browser-recursive)) ; `C-M-RET' - -;; Undefine some bindings that would try to modify a Dired buffer. Their key sequences will -;; then appear to the user as available for local (Dired) definition. -(when (fboundp 'undefine-killer-commands) (undefine-killer-commands dired-mode-map)) - -;;;;;;;;;;;; - -(setq diredp-loaded-p t) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; dired+.el ends here diff --git a/configs/shared/.emacs.d/vendor/org-clubhouse.el b/configs/shared/.emacs.d/vendor/org-clubhouse.el deleted file mode 100644 index ba1f004a24..0000000000 --- a/configs/shared/.emacs.d/vendor/org-clubhouse.el +++ /dev/null @@ -1,365 +0,0 @@ -;;; private/grfn/org-clubhouse.el - -(require 'dash) -(require 'dash-functional) -(require 's) -(require 'org) -(require 'org-element) -(require 'cl) - -;;; -;;; Configuration -;;; - -(defvar org-clubhouse-auth-token nil - "Authorization token for the Clubhouse API") - -(defvar org-clubhouse-team-name nil - "Team name to use in links to Clubhouse -ie https://app.clubhouse.io//stories") - -(defvar org-clubhouse-project-ids nil - "Specific list of project IDs to synchronize with clubhouse. -If unset all projects will be synchronized") - -(defvar org-clubhouse-workflow-name "Default") - -(defvar org-clubhouse-state-alist - '(("LATER" . "Unscheduled") - ("[ ]" . "Ready for Development") - ("TODO" . "Ready for Development") - ("OPEN" . "Ready for Development") - ("ACTIVE" . "In Development") - ("PR" . "Review") - ("DONE" . "Merged") - ("[X]" . "Merged") - ("CLOSED" . "Merged"))) - -;;; -;;; Utilities -;;; - -(defun ->list (vec) (append vec nil)) - -(defun reject-archived (item-list) - (-filter (lambda (item) (equal :json-false (alist-get 'archived item))) item-list)) - -(defun alist->plist (key-map alist) - (->> key-map - (-map (lambda (key-pair) - (let ((alist-key (car key-pair)) - (plist-key (cdr key-pair))) - (list plist-key (alist-get alist-key alist))))) - (-flatten-n 1))) - -(defun alist-get-equal (key alist) - "Like `alist-get', but uses `equal' instead of `eq' for comparing keys" - (->> alist - (-find (lambda (pair) (equal key (car pair)))) - (cdr))) - -;;; -;;; Org-element interaction -;;; - -;; (defun org-element-find-headline () -;; (let ((current-elt (org-element-at-point))) -;; (if (equal 'headline (car current-elt)) -;; current-elt -;; (let* ((elt-attrs (cadr current-elt)) -;; (parent (plist-get elt-attrs :post-affiliated))) -;; (goto-char parent) -;; (org-element-find-headline))))) - -(defun org-element-find-headline () - (let ((current-elt (org-element-at-point))) - (when (equal 'headline (car current-elt)) - (cadr current-elt)))) - -(defun org-element-extract-clubhouse-id (elt) - (when-let ((clubhouse-id-link (plist-get elt :CLUBHOUSE-ID))) - (string-match - (rx "[[" (one-or-more anything) "]" - "[" (group (one-or-more digit)) "]]") - clubhouse-id-link) - (string-to-int (match-string 1 clubhouse-id-link)))) - - - -(defun org-element-clubhouse-id () - (org-element-extract-clubhouse-id - (org-element-find-headline))) - -;;; -;;; API integration -;;; - -(defvar org-clubhouse-base-url* "https://api.clubhouse.io/api/v2") - -(defun org-clubhouse-auth-url (url) - (concat url - "?" - (url-build-query-string - `(("token" ,org-clubhouse-auth-token))))) - -(defun org-clubhouse-baseify-url (url) - (if (s-starts-with? org-clubhouse-base-url* url) url - (concat org-clubhouse-base-url* - (if (s-starts-with? "/" url) url - (concat "/" url))))) - -(defun org-clubhouse-request (method url &optional data) - (message "%s %s %s" method url (prin1-to-string data)) - (let* ((url-request-method method) - (url-request-extra-headers - '(("Content-Type" . "application/json"))) - (url-request-data data) - (buf)) - - (setq url (-> url - org-clubhouse-baseify-url - org-clubhouse-auth-url)) - - (setq buf (url-retrieve-synchronously url)) - - (with-current-buffer buf - (goto-char url-http-end-of-headers) - (prog1 (json-read) (kill-buffer))))) - -(cl-defun to-id-name-pairs - (seq &optional (id-attr 'id) (name-attr 'name)) - (->> seq - ->list - (-map (lambda (resource) - (cons (alist-get id-attr resource) - (alist-get name-attr resource)))))) - -(cl-defun org-clubhouse-fetch-as-id-name-pairs - (resource &optional - (id-attr 'id) - (name-attr 'name)) - "Returns the given resource from clubhouse as (id . name) pairs" - (let ((resp-json (org-clubhouse-request "GET" resource))) - (-> resp-json - ->list - reject-archived - (to-id-name-pairs id-attr name-attr)))) - -(defun org-clubhouse-link-to-story (story-id) - (format "https://app.clubhouse.io/%s/story/%d" - org-clubhouse-team-name - story-id)) - -(defun org-clubhouse-link-to-epic (epic-id) - (format "https://app.clubhouse.io/%s/epic/%d" - org-clubhouse-team-name - epic-id)) - -(defun org-clubhouse-link-to-project (project-id) - (format "https://app.clubhouse.io/%s/project/%d" - org-clubhouse-team-name - project-id)) - -;;; -;;; Caching -;;; - - - -(defvar org-clubhouse-cache-clear-functions ()) - -(defmacro defcache (name &optional docstring &rest body) - (let* ((doc (when docstring (list docstring))) - (cache-var-name (intern (concat (symbol-name name) - "-cache"))) - (clear-cache-function-name - (intern (concat "clear-" (symbol-name cache-var-name))))) - `(progn - (defvar ,cache-var-name :no-cache) - (defun ,name () - ,@doc - (when (equal :no-cache ,cache-var-name) - (setq ,cache-var-name (progn ,@body))) - ,cache-var-name) - (defun ,clear-cache-function-name () - (interactive) - (setq ,cache-var-name :no-cache)) - - (push (quote ,clear-cache-function-name) - org-clubhouse-cache-clear-functions)))) - -(defun org-clubhouse-clear-cache () - (interactive) - (-map #'funcall org-clubhouse-cache-clear-functions)) - -;;; -;;; API resource functions -;;; - -(defcache org-clubhouse-projects - "Returns projects as (project-id . name)" - (org-clubhouse-fetch-as-id-name-pairs "projects")) - -(defcache org-clubhouse-epics - "Returns projects as (project-id . name)" - (org-clubhouse-fetch-as-id-name-pairs "epics")) - -(defcache org-clubhouse-workflow-states - "Returns worflow states as (name . id) pairs" - (let* ((resp-json (org-clubhouse-request "GET" "workflows")) - (workflows (->list resp-json)) - ;; just assume it exists, for now - (workflow (-find (lambda (workflow) - (equal org-clubhouse-workflow-name - (alist-get 'name workflow))) - workflows)) - (states (->list (alist-get 'states workflow)))) - (to-id-name-pairs states - 'name - 'id))) - -(defun org-clubhouse-stories-in-project (project-id) - "Returns the stories in the given project as org bugs" - (let ((resp-json (org-clubhouse-request "GET" (format "/projects/%d/stories" project-id)))) - (->> resp-json ->list reject-archived - (-reject (lambda (story) (equal :json-true (alist-get 'completed story)))) - (-map (lambda (story) - (cons - (cons 'status - (cond - ((equal :json-true (alist-get 'started story)) - 'started) - ((equal :json-true (alist-get 'completed story)) - 'completed) - ('t - 'open))) - story))) - (-map (-partial #'alist->plist - '((name . :title) - (id . :id) - (status . :status))))))) - -;;; -;;; Story creation -;;; - -(cl-defun org-clubhouse-create-story-internal - (title &key project-id epic-id) - (assert (and (stringp title) - (integerp project-id) - (or (null epic-id) (integerp epic-id)))) - (org-clubhouse-request - "POST" - "stories" - (json-encode - `((name . ,title) - (project_id . ,project-id) - (epic_id . ,epic-id))))) - -(defun org-clubhouse-prompt-for-project (cb) - (ivy-read - "Select a project: " - (-map #'cdr (org-clubhouse-projects)) - :require-match t - :history 'org-clubhouse-project-history - :action (lambda (selected) - (let ((project-id - (->> (org-clubhouse-projects) - (-find (lambda (proj) - (string-equal (cdr proj) selected))) - car))) - (message "%d" project-id) - (funcall cb project-id))))) - -(defun org-clubhouse-prompt-for-epic (cb) - (ivy-read - "Select an epic: " - (-map #'cdr (org-clubhouse-epics)) - :history 'org-clubhouse-epic-history - :action (lambda (selected) - (let ((epic-id - (->> (org-clubhouse-epics) - (-find (lambda (proj) - (string-equal (cdr proj) selected))) - car))) - (message "%d" epic-id) - (funcall cb epic-id))))) - -(defun org-clubhouse-populate-created-story (story) - (let ((elt (org-element-find-headline)) - (story-id (alist-get 'id story)) - (epic-id (alist-get 'epic_id story)) - (project-id (alist-get 'project_id story))) - - (org-set-property "clubhouse-id" - (org-make-link-string - (org-clubhouse-link-to-story story-id) - (number-to-string story-id))) - - (org-set-property "clubhouse-epic" - (org-make-link-string - (org-clubhouse-link-to-epic epic-id) - (alist-get epic-id (org-clubhouse-epics)))) - - (org-set-property "clubhouse-project" - (org-make-link-string - (org-clubhouse-link-to-project project-id) - (alist-get project-id (org-clubhouse-projects)))) - - (org-todo "TODO"))) - -(defun org-clubhouse-create-story () - (interactive) - ;; (message (org-element-find-headline)) - (when-let ((elt (org-element-find-headline)) - (title (plist-get elt :title))) - (if (plist-get elt :CLUBHOUSE-ID) - (message "This headline is already a clubhouse story!") - (org-clubhouse-prompt-for-project - (lambda (project-id) - (when project-id - (org-clubhouse-prompt-for-epic - (lambda (epic-id) - (let* ((story (org-clubhouse-create-story-internal - title - :project-id project-id - :epic-id epic-id))) - (org-clubhouse-populate-created-story story)))))))))) - -;;; -;;; Story updates -;;; - -(cl-defun org-clubhouse-update-story-internal - (story-id &rest attrs) - (assert (and (integerp story-id) - (listp attrs))) - (org-clubhouse-request - "PUT" - (format "stories/%d" story-id) - (json-encode attrs))) - -(defun org-clubhouse-update-status () - (when-let (clubhouse-id (org-element-clubhouse-id)) - (let* ((elt (org-element-find-headline)) - (todo-keyword (-> elt (plist-get :todo-keyword) (substring-no-properties)))) - (message todo-keyword) - (when-let ((clubhouse-workflow-state - (alist-get-equal todo-keyword org-clubhouse-state-alist)) - (workflow-state-id - (alist-get-equal clubhouse-workflow-state (org-clubhouse-workflow-states)))) - (org-clubhouse-update-story-internal - clubhouse-id - :workflow_state_id workflow-state-id) - (message "Successfully updated clubhouse status to \"%s\"" - clubhouse-workflow-state))))) - -(define-minor-mode org-clubhouse-mode - :init-value nil - :group 'org - :lighter "Org-Clubhouse" - :keymap '() - (add-hook 'org-after-todo-state-change-hook - 'org-clubhouse-update-status - nil - t)) diff --git a/configs/shared/.emacs.d/vendor/reason-indent.el b/configs/shared/.emacs.d/vendor/reason-indent.el deleted file mode 100644 index 8fd3c94258..0000000000 --- a/configs/shared/.emacs.d/vendor/reason-indent.el +++ /dev/null @@ -1,304 +0,0 @@ -;;; reason-indent.el --- Indentation functions for ReasonML -*-lexical-binding: t-*- - -;; Portions Copyright (c) 2015-present, Facebook, Inc. All rights reserved. - -;;; Commentary: - -;; Indentation functions for Reason. - -;;; Code: - -(defconst reason-re-ident "[[:word:][:multibyte:]_][[:word:][:multibyte:]_[:digit:]]*") - -(defcustom reason-indent-offset 2 - "Indent Reason code by this number of spaces." - :type 'integer - :group 'reason-mode - :safe #'integerp) - -(defun reason-looking-back-str (str) - "Like `looking-back' but for fixed strings rather than regexps. -Works around some regexp slowness. -Argument STR string to search for." - (let ((len (length str))) - (and (> (point) len) - (equal str (buffer-substring-no-properties (- (point) len) (point)))))) - -(defun reason-paren-level () - "Get the level of nesting inside parentheses." - (nth 0 (syntax-ppss))) - -(defun reason-in-str-or-cmnt () - "Return whether point is currently inside a string or a comment." - (nth 8 (syntax-ppss))) - -(defun reason-rewind-past-str-cmnt () - "Rewind past string or comment." - (goto-char (nth 8 (syntax-ppss)))) - -(defun reason-rewind-irrelevant () - "Rewind past irrelevant characters (whitespace of inside comments)." - (interactive) - (let ((starting (point))) - (skip-chars-backward "[:space:]\n") - (if (reason-looking-back-str "*/") (backward-char)) - (if (reason-in-str-or-cmnt) - (reason-rewind-past-str-cmnt)) - (if (/= starting (point)) - (reason-rewind-irrelevant)))) - -(defun reason-align-to-expr-after-brace () - "Align the expression at point to the expression after the previous brace." - (save-excursion - (forward-char) - ;; We don't want to indent out to the open bracket if the - ;; open bracket ends the line - (when (not (looking-at "[[:blank:]]*\\(?://.*\\)?$")) - (when (looking-at "[[:space:]]") - (forward-word 1) - (backward-word 1)) - (current-column)))) - -(defun reason-align-to-prev-expr () - "Align the expression at point to the previous expression." - (let ((alignment (save-excursion - (forward-char) - ;; We don't want to indent out to the open bracket if the - ;; open bracket ends the line - (when (not (looking-at "[[:blank:]]*\\(?://.*\\)?$")) - (if (looking-at "[[:space:]]") - (progn - (forward-word 1) - (backward-word 1)) - (backward-char)) - (current-column))))) - (if (not alignment) - (save-excursion - (forward-char) - (forward-line) - (back-to-indentation) - (current-column)) - alignment))) - -;;; Start of a reason binding -(defvar reason-binding - (regexp-opt '("let" "type" "module" "fun"))) - -(defun reason-beginning-of-defun (&optional arg) - "Move backward to the beginning of the current defun. - -With ARG, move backward multiple defuns. Negative ARG means -move forward. - -This is written mainly to be used as `beginning-of-defun-function'. -Don't move to the beginning of the line. `beginning-of-defun', -which calls this, does that afterwards." - (interactive "p") - (re-search-backward (concat "^\\(" reason-binding "\\)\\_>") - nil 'move (or arg 1))) - -(defun reason-end-of-defun () - "Move forward to the next end of defun. - -With argument, do it that many times. -Negative argument -N means move back to Nth preceding end of defun. - -Assume that this is called after ‘beginning-of-defun’. So point is -at the beginning of the defun body. - -This is written mainly to be used as `end-of-defun-function' for Reason." - (interactive) - ;; Find the opening brace - (if (re-search-forward "[{]" nil t) - (progn - (goto-char (match-beginning 0)) - ;; Go to the closing brace - (condition-case nil - (forward-sexp) - (scan-error - ;; The parentheses are unbalanced; instead of being unable to fontify, just jump to the end of the buffer - (goto-char (point-max))))) - ;; There is no opening brace, so consider the whole buffer to be one "defun" - (goto-char (point-max)))) - -(defun reason-rewind-to-beginning-of-current-level-expr () - "Rewind to the beginning of the expression on the current level of nesting." - (interactive) - (let ((current-level (reason-paren-level))) - (back-to-indentation) - (when (looking-at "=>") - (reason-rewind-irrelevant) - (back-to-indentation)) - (while (> (reason-paren-level) current-level) - (backward-up-list) - (back-to-indentation)))) - -(defun reason-mode-indent-line () - "Indent current line." - (interactive) - (let ((indent - (save-excursion - (back-to-indentation) - ;; Point is now at beginning of current line - (let* ((level (reason-paren-level)) - (baseline - ;; Our "baseline" is one level out from the indentation of the expression - ;; containing the innermost enclosing opening bracket. That - ;; way if we are within a block that has a different - ;; indentation than this mode would give it, we still indent - ;; the inside of it correctly relative to the outside. - (if (= 0 level) - 0 - (save-excursion - (reason-rewind-irrelevant) - (if (save-excursion - (reason-rewind-to-beginning-of-current-level-expr) - (looking-at "<")) - (progn - (reason-rewind-to-beginning-of-current-level-expr) - (current-column)) - (progn - (backward-up-list) - (reason-rewind-to-beginning-of-current-level-expr) - - (cond - ((looking-at "switch") - (current-column)) - - ((looking-at "|") - (+ (current-column) (* reason-indent-offset 2))) - - (t - (let ((current-level (reason-paren-level))) - (save-excursion - (while (and (= current-level (reason-paren-level)) - (not (looking-at reason-binding))) - (reason-rewind-irrelevant) - (reason-rewind-to-beginning-of-current-level-expr)) - (+ (current-column) reason-indent-offset))))))))))) - (cond - ;; A function return type is indented to the corresponding function arguments - ((looking-at "=>") - (+ baseline reason-indent-offset)) - - ((reason-in-str-or-cmnt) - (cond - ;; In the end of the block -- align with star - ((looking-at "*/") (+ baseline 1)) - ;; Indent to the following shape: - ;; /* abcd - ;; * asdf - ;; */ - ;; - ((looking-at "*") (+ baseline 1)) - ;; Indent to the following shape: - ;; /* abcd - ;; asdf - ;; */ - ;; - (t (+ baseline (+ reason-indent-offset 1))))) - - ((looking-at ""))) - (backward-up-list) - (reason-rewind-to-beginning-of-current-level-expr) - (cond - ((looking-at "switch") baseline) - - (jsx? (current-column)) - - (t (- baseline reason-indent-offset)))))) - - ;; Doc comments in /** style with leading * indent to line up the *s - ((and (nth 4 (syntax-ppss)) (looking-at "*")) - (+ 1 baseline)) - - ;; If we're in any other token-tree / sexp, then: - (t - (or - ;; If we are inside a pair of braces, with something after the - ;; open brace on the same line and ending with a comma, treat - ;; it as fields and align them. - (when (> level 0) - (save-excursion - (reason-rewind-irrelevant) - (backward-up-list) - ;; Point is now at the beginning of the containing set of braces - (reason-align-to-expr-after-brace))) - - (progn - (back-to-indentation) - (cond ((looking-at (regexp-opt '("and" "type"))) - baseline) - ((save-excursion - (reason-rewind-irrelevant) - (= (point) 1)) - baseline) - ((save-excursion - (while (looking-at "|") - (reason-rewind-irrelevant) - (back-to-indentation)) - (looking-at (regexp-opt '("type")))) - (+ baseline reason-indent-offset)) - ((looking-at "|\\|/[/*]") - baseline) - ((and (> level 0) - (save-excursion - (reason-rewind-irrelevant) - (backward-up-list) - (reason-rewind-to-beginning-of-current-level-expr) - (looking-at "switch"))) - (+ baseline reason-indent-offset)) - ((save-excursion - (reason-rewind-irrelevant) - (looking-back "[{;,\\[(]" (- (point) 2))) - baseline) - ((and - (save-excursion - (reason-rewind-irrelevant) - (reason-rewind-to-beginning-of-current-level-expr) - (and (looking-at reason-binding) - (not (progn - (forward-sexp) - (forward-sexp) - (skip-chars-forward "[:space:]\n") - (looking-at "="))))) - (not (save-excursion - (skip-chars-backward "[:space:]\n") - (reason-looking-back-str "=>")))) - (save-excursion - (reason-rewind-irrelevant) - (backward-sexp) - (reason-align-to-prev-expr))) - ((save-excursion - (reason-rewind-irrelevant) - (looking-back "<\/.*?>" (- (point) 30))) - baseline) - (t - (save-excursion - (reason-rewind-irrelevant) - (reason-rewind-to-beginning-of-current-level-expr) - - (if (looking-at "|") - baseline - (+ baseline reason-indent-offset))))) - ;; Point is now at the beginning of the current line - )))))))) - - (when indent - ;; If we're at the beginning of the line (before or at the current - ;; indentation), jump with the indentation change. Otherwise, save the - ;; excursion so that adding the indentations will leave us at the - ;; equivalent position within the line to where we were before. - (if (<= (current-column) (current-indentation)) - (indent-line-to indent) - (save-excursion (indent-line-to indent)))))) - -(provide 'reason-indent) - -;;; reason-indent.el ends here diff --git a/configs/shared/.emacs.d/vendor/reason-interaction.el b/configs/shared/.emacs.d/vendor/reason-interaction.el deleted file mode 100644 index 6ceaed1e93..0000000000 --- a/configs/shared/.emacs.d/vendor/reason-interaction.el +++ /dev/null @@ -1,216 +0,0 @@ -;;; reason-interaction.el --- Phrase navitagion for rtop -*-lexical-binding: t-*- - -;; Portions Copyright (c) 2015-present, Facebook, Inc. All rights reserved. - -;;; Commentary: - -;; Phrase navigation for utop and maybe other REPLs. - -;; The utop compatibility layer for Reason was mainly taken from: -;; https://github.com/ocaml/tuareg/blob/master/tuareg-light.el (big thanks!) - -;;; Code: - -(defun reason-backward-char (&optional step) - "Go back one char. -Similar to `backward-char` but it does not signal errors -`beginning-of-buffer` and `end-of-buffer`. It optionally takes a -STEP parameter for jumping back more than one character." - (when step (goto-char (- (point) step)) - (goto-char (1- (point))))) - -(defun reason-forward-char (&optional step) - "Go forward one char. -Similar to `forward-char` but it does not signal errors -`beginning-of-buffer` and `end-of-buffer`. It optionally takes a -STEP parameter for jumping back more than one character." - (when step (goto-char (+ (point) step)) - (goto-char (1+ (point))))) - -(defun reason-in-literal-p () - "Return non-nil if point is inside an Reason literal." - (nth 3 (syntax-ppss))) - -(defconst reason-comment-delimiter-regexp "\\*/\\|/\\*" - "Regex for identify either open or close comment delimiters.") - -(defun reason-in-between-comment-chars-p () - "Return non-nil iff point is in between the comment delimiter chars. -It returns non-nil if point is between the chars only (*|/ or /|* -where | is point)." - (and (not (bobp)) (not (eobp)) - (or (and (char-equal ?/ (char-before)) (char-equal ?* (char-after))) - (and (char-equal ?* (char-before)) (char-equal ?/ (char-after)))))) - -(defun reason-looking-at-comment-delimiters-p () - "Return non-nil iff point in between comment delimiters." - (looking-at-p reason-comment-delimiter-regexp)) - -(defun reason-in-between-comment-delimiters-p () - "Return non-nil if inside /* and */." - (nth 4 (syntax-ppss))) - -(defun reason-in-comment-p () - "Return non-nil iff point is inside or right before a comment." - (or (reason-in-between-comment-delimiters-p) - (reason-in-between-comment-chars-p) - (reason-looking-at-comment-delimiters-p))) - -(defun reason-beginning-of-literal-or-comment () - "Skip to the beginning of the current literal or comment (or buffer)." - (interactive) - (goto-char (or (nth 8 (syntax-ppss)) (point)))) - -(defun reason-inside-block-scope-p () - "Skip to the beginning of the current literal or comment (or buffer)." - (and (> (nth 0 (syntax-ppss)) 0) - (let ((delim-start (nth 1 (syntax-ppss)))) - (save-excursion - (goto-char delim-start) - (char-equal ?{ (following-char)))))) - -(defun reason-at-phrase-break-p () - "Is the underlying `;' a phrase break?" - ;; Difference from OCaml, the phrase separator is a single semi-colon - (and (not (eobp)) - (char-equal ?\; (following-char)))) - -(defun reason-skip-to-close-delimiter (&optional limit) - "Skip to the end of a Reason block. -It basically calls `re-search-forward` in order to go to any -closing delimiter, not concerning itself with balancing of any -sort. Client code needs to check that. -LIMIT is passed to `re-search-forward` directly." - (re-search-forward "\\s)" limit 'move)) - -(defun reason-skip-back-to-open-delimiter (&optional limit) - "Skip to the beginning of a Reason block backwards. -It basically calls `re-search-backward` in order to go to any -opening delimiter, not concerning itself with balancing of any -sort. Client code needs to check that. -LIMIT is passed to `re-search-backward` directly." - (re-search-backward "\\s(" limit 'move)) - -(defun reason-find-phrase-end () - "Skip to the end of a phrase." - (while (and (not (eobp)) - (not (reason-at-phrase-break-p))) - (if (re-search-forward ";" nil 'move) - (progn (when (reason-inside-block-scope-p) - (reason-skip-to-close-delimiter)) - (goto-char (1- (point)))) - ;; avoid infinite loop at the end of the buffer - (re-search-forward "[[:space:]\\|\n]+" nil 'move))) - (min (goto-char (1+ (point))) (point-max))) - -(defun reason-skip-blank-and-comments () - "Skip blank spaces and comments." - (cond - ((eobp) (point)) - ((or (reason-in-between-comment-chars-p) - (reason-looking-at-comment-delimiters-p)) (progn - (reason-forward-char 1) - (reason-skip-blank-and-comments))) - ((reason-in-between-comment-delimiters-p) (progn - (search-forward "*/" nil t) - (reason-skip-blank-and-comments))) - ((eolp) (progn - (reason-forward-char 1) - (reason-skip-blank-and-comments))) - (t (progn (skip-syntax-forward " ") - (point))))) - -(defun reason-skip-back-blank-and-comments () - "Skip blank spaces and comments backwards." - (cond - ((bobp) (point)) - ((looking-back reason-comment-delimiter-regexp) (progn - (reason-backward-char 1) - (reason-skip-back-blank-and-comments))) - ((reason-in-between-comment-delimiters-p) (progn - (search-backward "/*" nil t) - (reason-backward-char 1) - (reason-skip-back-blank-and-comments))) - ((or (reason-in-between-comment-chars-p) - (reason-looking-at-comment-delimiters-p)) (progn - (reason-backward-char 1) - (reason-skip-back-blank-and-comments))) - ((bolp) (progn - (reason-backward-char 1) - (reason-skip-back-blank-and-comments))) - (t (progn (skip-syntax-backward " ") - (point))))) - -(defun reason-ro (&rest words) - "Build a regex matching iff at least a word in WORDS is present." - (concat "\\<" (regexp-opt words t) "\\>")) - -(defconst reason-find-phrase-beginning-regexp - (concat (reason-ro "end" "type" "module" "sig" "struct" "class" - "exception" "open" "let") - "\\|^#[ \t]*[a-z][_a-z]*\\>\\|;")) - -(defun reason-at-phrase-start-p () - "Return t if is looking at the beginning of a phrase. -A phrase starts when a toplevel keyword is at the beginning of a line." - (or (looking-at "#") - (looking-at reason-find-phrase-beginning-regexp))) - -(defun reason-find-phrase-beginning-backward () - "Find the beginning of a phrase and return point. -It scans code backwards, therefore the caller can assume that the -beginning of the phrase (if found) is always before the starting -point. No error is signalled and (point-min) is returned when a -phrease cannot be found." - (beginning-of-line) - (while (and (not (bobp)) (not (reason-at-phrase-start-p))) - (if (reason-inside-block-scope-p) - (reason-skip-back-to-open-delimiter) - (re-search-backward reason-find-phrase-beginning-regexp nil 'move))) - (point)) - -(defun reason-discover-phrase () - "Discover a Reason phrase in the buffer." - ;; TODO reason-with-internal-syntax ;; tuareg2 modifies the syntax table (removed for now) - ;; TODO stop-at-and feature for phrase detection (do we need it?) - ;; TODO tuareg2 has some custom logic for module and class (do we need it?) - (save-excursion - (let ((case-fold-search nil)) - (reason-skip-blank-and-comments) - (list (reason-find-phrase-beginning-backward) ;; beginning - (reason-find-phrase-end) ;; end - (save-excursion ;; end-with-comment - (reason-skip-blank-and-comments) - (point)))))) - -(defun reason-discover-phrase-debug () - "Discover a Reason phrase in the buffer (debug mode)." - (let ((triple (reason-discover-phrase))) - (message (concat "Evaluating: \"" (reason-fetch-phrase triple) "\"")) - triple)) - -(defun reason-fetch-phrase (triple) - "Fetch the phrase text given a TRIPLE." - (let* ((start (nth 0 triple)) - (end (nth 1 triple))) ;; we don't need end-with-comment - (buffer-substring-no-properties start end))) - -(defun reason-next-phrase () - "Skip to the beginning of the next phrase." - (cond - ((reason-at-phrase-start-p) (point)) - ((eolp) (progn - (forward-char 1) - (reason-skip-blank-and-comments) - (reason-next-phrase))) - ((reason-inside-block-scope-p) (progn (reason-skip-to-close-delimiter) - (reason-next-phrase))) - ((looking-at ";") (progn - (forward-char 1) - (reason-next-phrase))) - (t (progn (end-of-line) - (reason-next-phrase))))) - -(provide 'reason-interaction) - -;;; reason-interaction.el ends here diff --git a/configs/shared/.emacs.d/vendor/reason-mode.el b/configs/shared/.emacs.d/vendor/reason-mode.el deleted file mode 100644 index 789735955d..0000000000 --- a/configs/shared/.emacs.d/vendor/reason-mode.el +++ /dev/null @@ -1,242 +0,0 @@ -;;; reason-mode.el --- A major mode for editing ReasonML -*-lexical-binding: t-*- -;; Portions Copyright (c) 2015-present, Facebook, Inc. All rights reserved. - -;; Version: 0.4.0 -;; Author: Mozilla -;; Url: https://github.com/reasonml-editor/reason-mode -;; Keywords: languages, ocaml -;; Package-Requires: ((emacs "24.3")) - -;; This file is NOT part of GNU Emacs. - -;; This file is distributed under the terms of both the MIT license and the -;; Apache License (version 2.0). - -;;; Commentary: -;; This project provides useful functions and helpers for developing code -;; using the Reason programming language (https://facebook.github.io/reason). -;; -;; Reason is an umbrella project that provides a curated layer for OCaml. -;; -;; It offers: -;; - A new, familiar syntax for the battle-tested language that is OCaml. -;; - A workflow for compiling to JavaScript and native code. -;; - A set of friendly documentations, libraries and utilities. -;; -;; See the README.md for more details. - -;;; Code: - -(require 'reason-indent) -(require 'refmt) -(require 'reason-interaction) - -(eval-when-compile (require 'rx) - (require 'compile) - (require 'url-vars)) - -;; Syntax definitions and helpers -(defvar reason-mode-syntax-table - (let ((table (make-syntax-table))) - - ;; Operators - (dolist (i '(?+ ?- ?* ?/ ?& ?| ?^ ?! ?< ?> ?~ ?@)) - (modify-syntax-entry i "." table)) - - ;; Strings - (modify-syntax-entry ?\" "\"" table) - (modify-syntax-entry ?\\ "\\" table) - (modify-syntax-entry ?\' "_" table) - - ;; Comments - (modify-syntax-entry ?/ ". 124b" table) - (modify-syntax-entry ?* ". 23n" table) - (modify-syntax-entry ?\n "> b" table) - (modify-syntax-entry ?\^m "> b" table) - - table)) - -(defgroup reason nil - "Support for Reason code." - :link '(url-link "http://facebook.github.io/reason/") - :group 'languages) - -(defcustom reason-mode-hook nil - "Hook called by `reason-mode'." - :type 'hook - :group 'reason) - -;; Font-locking definitions and helpers -(defconst reason-mode-keywords - '("and" "as" - "else" "external" - "fun" "for" - "if" "impl" "in" "include" - "let" - "module" "match" "mod" "move" "mutable" - "open" - "priv" "pub" - "rec" "ref" "return" - "self" "static" "switch" "struct" "super" - "trait" "type" - "use" - "virtual" - "where" "when" "while")) - -(defconst reason-mode-consts - '("true" "false")) - -(defconst reason-special-types - '("int" "float" "string" "char" - "bool" "unit" "list" "array" "exn" - "option" "ref")) - -(defconst reason-camel-case - (rx symbol-start - (group upper (0+ (any word nonascii digit "_"))) - symbol-end)) - -(eval-and-compile - (defconst reason--char-literal-rx - (rx (seq (group "'") - (or (seq "\\" anything) - (not (any "'\\"))) - (group "'"))))) - -(defun reason-re-word (inner) - "Build a word regexp given INNER." - (concat "\\<" inner "\\>")) - -(defun reason-re-grab (inner) - "Build a grab regexp given INNER." - (concat "\\(" inner "\\)")) - -(defun reason-regexp-opt-symbols (words) - "Like `(regexp-opt words 'symbols)`, but will work on Emacs 23. -See rust-mode PR #42. -Argument WORDS argument to pass to `regexp-opt`." - (concat "\\_<" (regexp-opt words t) "\\_>")) - -;;; Syntax highlighting for Reason -(defvar reason-font-lock-keywords - `((,(reason-regexp-opt-symbols reason-mode-keywords) . font-lock-keyword-face) - (,(reason-regexp-opt-symbols reason-special-types) . font-lock-builtin-face) - (,(reason-regexp-opt-symbols reason-mode-consts) . font-lock-constant-face) - - (,reason-camel-case 1 font-lock-type-face) - - ;; Field names like `foo:`, highlight excluding the : - (,(concat (reason-re-grab reason-re-ident) ":[^:]") 1 font-lock-variable-name-face) - ;; Module names like `foo::`, highlight including the :: - (,(reason-re-grab (concat reason-re-ident "::")) 1 font-lock-type-face) - ;; Name punned labeled args like ::foo - (,(concat "[[:space:]]+" (reason-re-grab (concat "::" reason-re-ident))) 1 font-lock-type-face) - - ;; TODO jsx attribs? - (, - (concat "<[/]?" (reason-re-grab reason-re-ident) "[^>]*" ">") - 1 font-lock-type-face))) - -(defun reason-mode-try-find-alternate-file (mod-name extension) - "Switch to the file given by MOD-NAME and EXTENSION." - (let* ((filename (concat mod-name extension)) - (buffer (get-file-buffer filename))) - (if buffer (switch-to-buffer buffer) - (find-file filename)))) - -(defun reason-mode-find-alternate-file () - "Switch to implementation/interface file." - (interactive) - (let ((name buffer-file-name)) - (when (string-match "\\`\\(.*\\)\\.re\\([il]\\)?\\'" name) - (let ((mod-name (match-string 1 name)) - (e (match-string 2 name))) - (cond - ((string= e "i") - (reason-mode-try-find-alternate-file mod-name ".re")) - (t - (reason-mode-try-find-alternate-file mod-name ".rei"))))))) - -(defun reason--syntax-propertize-multiline-string (end) - "Propertize Reason multiline string. -Argument END marks the end of the string." - (let ((ppss (syntax-ppss))) - (when (eq t (nth 3 ppss)) - (let ((key (save-excursion - (goto-char (nth 8 ppss)) - (and (looking-at "{\\([a-z]*\\)|") - (match-string 1))))) - (when (search-forward (format "|%s}" key) end 'move) - (put-text-property (1- (match-end 0)) (match-end 0) - 'syntax-table (string-to-syntax "|"))))))) - -(defun reason-syntax-propertize-function (start end) - "Propertize Reason function. -Argument START marks the beginning of the function. -Argument END marks the end of the function." - (goto-char start) - (reason--syntax-propertize-multiline-string end) - (funcall - (syntax-propertize-rules - (reason--char-literal-rx (1 "\"") (2 "\"")) - ;; multi line strings - ("\\({\\)[a-z]*|" - (1 (prog1 "|" - (goto-char (match-end 0)) - (reason--syntax-propertize-multiline-string end))))) - (point) end)) - -(defvar reason-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "\C-c\C-a" #'reason-mode-find-alternate-file) - (define-key map "\C-c\C-r" #'refmt-region-ocaml-to-reason) - (define-key map "\C-c\C-o" #'refmt-region-reason-to-ocaml) - map)) - -;;;###autoload -(define-derived-mode reason-mode prog-mode "Reason" - "Major mode for Reason code. - -\\{reason-mode-map}" - :group 'reason - :syntax-table reason-mode-syntax-table - :keymap reason-mode-map - - ;; Syntax - (setq-local syntax-propertize-function #'reason-syntax-propertize-function) - ;; Indentation - (setq-local indent-line-function 'reason-mode-indent-line) - ;; Fonts - (setq-local font-lock-defaults '(reason-font-lock-keywords)) - ;; Misc - (setq-local comment-start "/*") - (setq-local comment-end "*/") - (setq-local indent-tabs-mode nil) - ;; Allow paragraph fills for comments - (setq-local comment-start-skip "/\\*+[ \t]*") - (setq-local paragraph-start - (concat "^[ \t]*$\\|\\*)$\\|" page-delimiter)) - (setq-local paragraph-separate paragraph-start) - (setq-local require-final-newline t) - (setq-local normal-auto-fill-function nil) - (setq-local comment-multi-line t) - - (setq-local beginning-of-defun-function 'reason-beginning-of-defun) - (setq-local end-of-defun-function 'reason-end-of-defun) - (setq-local parse-sexp-lookup-properties t)) - -;;;###autoload -(add-to-list 'auto-mode-alist '("\\.rei?\\'" . reason-mode)) - -(defun reason-mode-reload () - "Reload Reason mode." - (interactive) - (unload-feature 'reason-mode) - (unload-feature 'reason-indent) - (unload-feature 'reason-interaction) - (require 'reason-mode) - (reason-mode)) - -(provide 'reason-mode) - -;;; reason-mode.el ends here diff --git a/configs/shared/.emacs.d/vendor/refmt.el b/configs/shared/.emacs.d/vendor/refmt.el deleted file mode 100644 index b9ea2b43f0..0000000000 --- a/configs/shared/.emacs.d/vendor/refmt.el +++ /dev/null @@ -1,231 +0,0 @@ -;;; refmt.el --- utility functions to format reason code - -;; Copyright (c) 2014 The go-mode Authors. All rights reserved. -;; Portions Copyright (c) 2015-present, Facebook, Inc. All rights reserved. - -;; Redistribution and use in source and binary forms, with or without -;; modification, are permitted provided that the following conditions are -;; met: - -;; * Redistributions of source code must retain the above copyright -;; notice, this list of conditions and the following disclaimer. -;; * Redistributions in binary form must reproduce the above -;; copyright notice, this list of conditions and the following disclaimer -;; in the documentation and/or other materials provided with the -;; distribution. -;; * Neither the name of the copyright holder nor the names of its -;; contributors may be used to endorse or promote products derived from -;; this software without specific prior written permission. - -;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.) - -;;; Commentary: -;; - -;;; Code: - -(require 'cl-lib) - -(defcustom refmt-command "refmt" - "The 'refmt' command." - :type 'string - :group 're-fmt) - -(defcustom refmt-show-errors 'buffer - "Where to display refmt error output. -It can either be displayed in its own buffer, in the echo area, or not at all. -Please note that Emacs outputs to the echo area when writing -files and will overwrite refmt's echo output if used from inside -a `before-save-hook'." - :type '(choice - (const :tag "Own buffer" buffer) - (const :tag "Echo area" echo) - (const :tag "None" nil)) - :group 're-fmt) - -(defcustom refmt-width-mode nil - "Specify width when formatting buffer contents." - :type '(choice - (const :tag "Window width" window) - (const :tag "Fill column" fill) - (const :tag "None" nil)) - :group 're-fmt) - -;;;###autoload -(defun refmt-before-save () - "Add this to .emacs to run refmt on the current buffer when saving: - (add-hook 'before-save-hook 'refmt-before-save)." - (interactive) - (when (eq major-mode 'reason-mode) (refmt))) - -(defun reason--goto-line (line) - (goto-char (point-min)) - (forward-line (1- line))) - -(defun reason--delete-whole-line (&optional arg) - "Delete the current line without putting it in the `kill-ring'. -Derived from function `kill-whole-line'. ARG is defined as for that -function." - (setq arg (or arg 1)) - (if (and (> arg 0) - (eobp) - (save-excursion (forward-visible-line 0) (eobp))) - (signal 'end-of-buffer nil)) - (if (and (< arg 0) - (bobp) - (save-excursion (end-of-visible-line) (bobp))) - (signal 'beginning-of-buffer nil)) - (cond ((zerop arg) - (delete-region (progn (forward-visible-line 0) (point)) - (progn (end-of-visible-line) (point)))) - ((< arg 0) - (delete-region (progn (end-of-visible-line) (point)) - (progn (forward-visible-line (1+ arg)) - (unless (bobp) - (backward-char)) - (point)))) - (t - (delete-region (progn (forward-visible-line 0) (point)) - (progn (forward-visible-line arg) (point)))))) - -(defun reason--apply-rcs-patch (patch-buffer &optional start-pos) - "Apply an RCS-formatted diff from PATCH-BUFFER to the current buffer." - (setq start-pos (or start-pos (point-min))) - (let ((first-line (line-number-at-pos start-pos)) - (target-buffer (current-buffer)) - ;; Relative offset between buffer line numbers and line numbers - ;; in patch. - ;; - ;; Line numbers in the patch are based on the source file, so - ;; we have to keep an offset when making changes to the - ;; buffer. - ;; - ;; Appending lines decrements the offset (possibly making it - ;; negative), deleting lines increments it. This order - ;; simplifies the forward-line invocations. - (line-offset 0)) - (save-excursion - (with-current-buffer patch-buffer - (goto-char (point-min)) - (while (not (eobp)) - (unless (looking-at "^\\([ad]\\)\\([0-9]+\\) \\([0-9]+\\)") - (error "invalid rcs patch or internal error in reason--apply-rcs-patch")) - (forward-line) - (let ((action (match-string 1)) - (from (string-to-number (match-string 2))) - (len (string-to-number (match-string 3)))) - (cond - ((equal action "a") - (let ((start (point))) - (forward-line len) - (let ((text (buffer-substring start (point)))) - (with-current-buffer target-buffer - (cl-decf line-offset len) - (goto-char start-pos) - (forward-line (- from len line-offset)) - (insert text))))) - ((equal action "d") - (with-current-buffer target-buffer - (reason--goto-line (- (1- (+ first-line from)) line-offset)) - (cl-incf line-offset len) - (reason--delete-whole-line len))) - (t - (error "invalid rcs patch or internal error in reason--apply-rcs-patch"))))))))) - -(defun refmt--process-errors (filename tmpfile errorfile errbuf) - (with-current-buffer errbuf - (if (eq refmt-show-errors 'echo) - (progn - (message "%s" (buffer-string)) - (refmt--kill-error-buffer errbuf)) - (insert-file-contents errorfile nil nil nil) - ;; Convert the refmt stderr to something understood by the compilation mode. - (goto-char (point-min)) - (insert "refmt errors:\n") - (while (search-forward-regexp (regexp-quote tmpfile) nil t) - (replace-match (file-name-nondirectory filename))) - (compilation-mode) - (display-buffer errbuf)))) - -(defun refmt--kill-error-buffer (errbuf) - (let ((win (get-buffer-window errbuf))) - (if win - (quit-window t win) - (with-current-buffer errbuf - (erase-buffer)) - (kill-buffer errbuf)))) - -(defun apply-refmt (&optional start end from to) - (setq start (or start (point-min)) - end (or end (point-max)) - from (or from "re") - to (or to "re")) - (let* ((ext (file-name-extension buffer-file-name t)) - (bufferfile (make-temp-file "refmt" nil ext)) - (outputfile (make-temp-file "refmt" nil ext)) - (errorfile (make-temp-file "refmt" nil ext)) - (errbuf (if refmt-show-errors (get-buffer-create "*Refmt Errors*"))) - (patchbuf (get-buffer-create "*Refmt patch*")) - (coding-system-for-read 'utf-8) - (coding-system-for-write 'utf-8) - (width-args - (cond - ((equal refmt-width-mode 'window) - (list "--print-width" (number-to-string (window-body-width)))) - ((equal refmt-width-mode 'fill) - (list "--print-width" (number-to-string fill-column))) - (t - '())))) - (unwind-protect - (save-restriction - (widen) - (write-region start end bufferfile) - (if errbuf - (with-current-buffer errbuf - (setq buffer-read-only nil) - (erase-buffer))) - (with-current-buffer patchbuf - (erase-buffer)) - (if (zerop (apply 'call-process - refmt-command nil (list (list :file outputfile) errorfile) - nil (append width-args (list "--parse" from "--print" to bufferfile)))) - (progn - (call-process-region start end "diff" nil patchbuf nil "-n" "-" - outputfile) - (reason--apply-rcs-patch patchbuf start) - (message "Applied refmt") - (if errbuf (refmt--kill-error-buffer errbuf))) - (message "Could not apply refmt") - (if errbuf - (refmt--process-errors (buffer-file-name) bufferfile errorfile errbuf))))) - (kill-buffer patchbuf) - (delete-file errorfile) - (delete-file bufferfile) - (delete-file outputfile))) - -(defun refmt () - "Format the current buffer according to the refmt tool." - (interactive) - (apply-refmt)) - -(defun refmt-region-ocaml-to-reason (start end) - (interactive "r") - (apply-refmt start end "ml")) - -(defun refmt-region-reason-to-ocaml (start end) - (interactive "r") - (apply-refmt start end "re" "ml")) - -(provide 'refmt) - -;;; refmt.el ends here diff --git a/configs/shared/.emacs.d/vendor/slack-snippets.el b/configs/shared/.emacs.d/vendor/slack-snippets.el deleted file mode 100644 index 6bf933cfb8..0000000000 --- a/configs/shared/.emacs.d/vendor/slack-snippets.el +++ /dev/null @@ -1,228 +0,0 @@ -;;; private/grfn/slack-snippets.el -*- lexical-binding: t; -*- - -(require 's) -(require 'json) -(require 'dash) -(require 'dash-functional) -(require 'request) -(require 'subr-x) - -;;; -;;; Configuration -;;; - -(defvar slack/token nil - "Legacy (https://api.slack.com/custom-integrations/legacy-tokens) access token") - -(defvar slack/include-public-channels 't - "Whether or not to inclue public channels in the list of conversations") - -(defvar slack/include-private-channels 't - "Whether or not to inclue public channels in the list of conversations") - -(defvar slack/include-im 't - "Whether or not to inclue IMs (private messages) in the list of conversations") - -(defvar slack/include-mpim nil - "Whether or not to inclue multi-person IMs (multi-person private messages) in - the list of conversations") - -;;; -;;; Utilities -;;; - -(defmacro comment (&rest _body) - "Comment out one or more s-expressions" - nil) - -(defun ->list (vec) (append vec nil)) - -(defun json-truthy? (x) (and x (not (equal :json-false x)))) - -;;; -;;; Generic API integration -;;; - -(defvar slack/base-url "https://slack.com/api") - -(defun slack/get (path params &optional callback) - "params is an alist of query parameters" - (let* ((params-callback (if (functionp params) `(() . ,params) (cons params callback))) - (params (car params-callback)) (callback (cdr params-callback)) - (params (append `(("token" . ,slack/token)) params)) - (url (concat (file-name-as-directory slack/base-url) path))) - (request url - :type "GET" - :params params - :parser 'json-read - :success (cl-function - (lambda (&key data &allow-other-keys) - (funcall callback data)))))) - -(defun slack/post (path params &optional callback) - (let* ((params-callback (if (functionp params) `(() . ,params) (cons params callback))) - (params (car params-callback)) (callback (cdr params-callback)) - (url (concat (file-name-as-directory slack/base-url) path))) - (request url - :type "POST" - :data (json-encode params) - :headers `(("Content-Type" . "application/json") - ("Authorization" . ,(format "Bearer %s" slack/token))) - :success (cl-function - (lambda (&key data &allow-other-keys) - (funcall callback data)))))) - - -;;; -;;; Specific API endpoints -;;; - -;; Users - -(defun slack/users (cb) - "Returns users as (id . name) pairs" - (slack/get - "users.list" - (lambda (data) - (->> data - (assoc-default 'members) - ->list - (-map (lambda (user) - (cons (assoc-default 'id user) - (assoc-default 'real_name user)))) - (-filter #'cdr) - (funcall cb))))) - -(comment - (slack/get - "users.list" - (lambda (data) (setq response-data data))) - - (slack/users (lambda (data) (setq --users data))) - - ) - -;; Conversations - -(defun slack/conversation-types () - (->> - (list (when slack/include-public-channels "public_channel") - (when slack/include-private-channels "private_channel") - (when slack/include-im "im") - (when slack/include-mpim "mpim")) - (-filter #'identity) - (s-join ","))) - -(defun channel-label (chan users-alist) - (cond - ((json-truthy? (assoc-default 'is_channel chan)) - (format "#%s" (assoc-default 'name chan))) - ((json-truthy? (assoc-default 'is_im chan)) - (let ((user-id (assoc-default 'user chan))) - (format "Private message with %s" (assoc-default user-id users-alist)))) - ((json-truthy? (assoc-default 'is_mpim chan)) - (->> chan - (assoc-default 'purpose) - (assoc-default 'value))))) - -(defun slack/conversations (cb) - "Calls `cb' with (id . '((label . \"label\") '(topic . \"topic\") '(purpose . \"purpose\"))) pairs" - (slack/get - "conversations.list" - `(("types" . ,(slack/conversation-types)) - ("exclude-archived" . "true")) - (lambda (data) - (setq --data data) - (slack/users - (lambda (users) - (->> data - (assoc-default 'channels) - ->list - (-filter - (lambda (chan) (channel-label chan users))) - (-map - (lambda (chan) - (cons (assoc-default 'id chan) - `((label . ,(channel-label chan users)) - (topic . ,(->> chan - (assoc-default 'topic) - (assoc-default 'value))) - (purpose . ,(->> chan - (assoc-default 'purpose) - (assoc-default 'value))))))) - (funcall cb))))))) - -(comment - (slack/get - "conversations.list" - '(("types" . "public_channel,private_channel,im,mpim")) - (lambda (data) (setq response-data data))) - - (slack/get - "conversations.list" - '(("types" . "im")) - (lambda (data) (setq response-data data))) - - (slack/conversations - (lambda (convos) (setq --conversations convos))) - - ) - -;; Messages - -(cl-defun slack/post-message - (&key text channel-id (on-success #'identity)) - (slack/post "chat.postMessage" - `((text . ,text) - (channel . ,channel-id) - (as_user . t)) - on-success)) - -(comment - - (slack/post-message - :text "hi slackbot" - :channel-id slackbot-channel-id - :on-success (lambda (data) (setq resp data))) - - (-map (lambda (chan) (let ((label (assoc-default 'label (cdr chan))) - (id (car chan))) - (propertize label 'channel-id id))) - --conversations) - - ) - -;;; -;;; Posting code snippets to slack -;;; - -(defun prompt-for-channel (cb) - (slack/conversations - (lambda (conversations) - (setq testing (-map (lambda (chan) (let ((label (assoc-default 'label (cdr chan))) - (id (car chan))) - (propertize label 'channel-id id))) - conversations)) - (ivy-read - "Select channel: " - ;; TODO want to potentially use purpose / topic stuff here - (-map (lambda (chan) (let ((label (assoc-default 'label (cdr chan))) - (id (car chan))) - (propertize label 'channel-id id))) - conversations) - :history 'slack/channel-history - :action (lambda (selected) - (let ((channel-id (get-text-property 0 'channel-id selected))) - (funcall cb channel-id) - (message "Sent message to %s" selected)))))) - nil) - -(defun slack-send-code-snippet (&optional snippet-text) - (interactive) - (when-let ((snippet-text (or snippet-text - (buffer-substring-no-properties (mark) (point))))) - (prompt-for-channel - (lambda (channel-id) - (slack/post-message - :text (format "```\n%s```" snippet-text) - :channel-id channel-id))))) diff --git a/configs/shared/.emacs.d/vendor/wpgtk-theme.el b/configs/shared/.emacs.d/vendor/wpgtk-theme.el deleted file mode 100644 index 702048baf8..0000000000 --- a/configs/shared/.emacs.d/vendor/wpgtk-theme.el +++ /dev/null @@ -1,536 +0,0 @@ -;;; wpgtk-theme.el --- Dynamic color theme, specially made for wpgtk - -;; based on: -;; -;; Version: 0.1 -;; Keywords: color, theme -;; Package-Requires: ((emacs "24")) - -;; Initially with the help of emacs-theme-generator, . -;; Modified directly from Nasser Alshammari's spacemacs theme - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of Emacs. - -;; TODO: Is it possible to generate a *complete* Emacs theme from only 16 bit -;; colors? If so, replace all of this nonsense with just that. - -;;; Code: - -(defgroup wpgtk-theme nil - "Xres-theme options." - :group 'faces) - -(defcustom wpgtk-theme-comment-bg nil - "Use a background for comment lines." - :type 'boolean - :group 'wpgtk-theme) - -(defcustom wpgtk-theme-org-height t - "Use varying text heights for org headings." - :type 'boolean - :group 'wpgtk-theme) - -(defconst wpgtk/font "Source Code Pro 10" - "Font read from the wpg.conf template.") - -(macros/comment - (fonts/set wpgtk/font)) - -(defun get-hex-or-term (n) - "Gets N hex or a term color depending on whether we're using an GUI or not." - ;; Since I start emacs with `emacs --daemon`, `(display-graphic-p)` is `nil` - ;; and therefore "black", "brightblue", etc. will be set, which is - ;; undesirable. - (list/get n '("#01022E" - "#434AA6" - "#0278C6" - "#9B6DB0" - "#018CD5" - "#07AAE9" - "#3FA4E0" - "#a7dff4" - "#749caa" - "#434AA6" - "#0278C6" - "#9B6DB0" - "#018CD5" - "#07AAE9" - "#3FA4E0" - "#a7dff4"))) - -(defun create-wpgtk-theme (variant theme-name) - (let ((class '((class color) (min-colors 16))) - (base (get-hex-or-term 15)) - (white (get-hex-or-term 7)) - (cursor (get-hex-or-term 7)) - (bg1 (get-hex-or-term 0)) - (bg2 (get-hex-or-term 8)) - (bg3 (get-hex-or-term 8)) - (bg4 (get-hex-or-term 8)) - (key1 (get-hex-or-term 14)) - (key2 (get-hex-or-term 14)) - (builtin (get-hex-or-term 13)) - (keyword (get-hex-or-term 12)) - (const (get-hex-or-term 11)) - (comment (get-hex-or-term 2)) - (comment-bg (get-hex-or-term 0)) - (func (get-hex-or-term 13)) - (str (get-hex-or-term 11)) - (type (get-hex-or-term 14)) - (comp (get-hex-or-term 13)) - (var (get-hex-or-term 10)) - (err (get-hex-or-term 9)) - (war (get-hex-or-term 11)) - (inf (get-hex-or-term 11)) - (suc (get-hex-or-term 10)) - (green (get-hex-or-term 10)) - (yellow (get-hex-or-term 11)) - (cyan (get-hex-or-term 14)) - (violet (get-hex-or-term 13)) - (red (get-hex-or-term 9)) - (active1 (get-hex-or-term 14)) - (active2 (get-hex-or-term 6)) - (inactive (get-hex-or-term 8)) - (m-line-brdr (get-hex-or-term 8)) - (org-block-bg (get-hex-or-term 8)) - (org-h1-bg (get-hex-or-term 8)) - (org-h2-bg (get-hex-or-term 0)) - (org-h3-bg (get-hex-or-term 0)) - (org-h4-bg (get-hex-or-term 0)) - (highlight (get-hex-or-term 14))) - - (custom-theme-set-faces - theme-name - -;;;;; basics - `(cursor ((,class (:background ,cursor)))) - `(default ((,class (:background ,bg1 :foreground ,base)))) - `(default-italic ((,class (:italic t)))) - `(error ((,class (:foreground ,err)))) - `(eval-sexp-fu-flash ((,class (:background ,suc :foreground ,bg1)))) - `(eval-sexp-fu-flash-error ((,class (:background ,err :foreground ,bg1)))) - `(font-lock-builtin-face ((,class (:foreground ,builtin)))) - `(font-lock-comment-face ((,class (:foreground ,comment :background ,(when wpgtk-theme-comment-bg comment-bg))))) - `(font-lock-constant-face ((,class (:foreground ,const)))) - `(font-lock-doc-face ((,class (:foreground ,comment)))) - `(font-lock-function-name-face ((,class (:foreground ,func :bold t)))) - `(font-lock-keyword-face ((,class (:bold ,class :foreground ,keyword)))) - `(font-lock-negation-char-face ((,class (:foreground ,const)))) - `(font-lock-preprocessor-face ((,class (:foreground ,func)))) - `(font-lock-reference-face ((,class (:foreground ,const)))) - `(font-lock-string-face ((,class (:foreground ,str)))) - `(font-lock-type-face ((,class (:foreground ,type :bold t)))) - `(font-lock-variable-name-face ((,class (:foreground ,var)))) - `(font-lock-warning-face ((,class (:foreground ,war :background ,bg1)))) - `(fringe ((,class (:background ,bg1 :foreground ,base)))) - `(highlight ((,class (:foreground ,base :background ,bg3)))) - `(hl-line ((,class (:background ,bg2)))) - `(isearch ((,class (:bold t :foreground ,bg1 :background ,inf)))) - `(lazy-highlight ((,class (:foreground ,bg1 :background ,inf :weight normal)))) - `(link ((,class (:foreground ,comment :underline t)))) - `(link-visited ((,class (:foreground ,comp :underline t)))) - `(match ((,class (:background ,bg1 :foreground ,inf :weight bold)))) - `(minibuffer-prompt ((,class (:bold t :foreground ,keyword)))) - `(page-break-lines ((,class (:foreground ,active2)))) - `(region ((,class (:background ,highlight :foreground ,bg1)))) - `(secondary-selection ((,class (:background ,bg3)))) - `(show-paren-match-face ((,class (:background ,suc)))) - `(success ((,class (:foreground ,suc)))) - `(vertical-border ((,class (:foreground ,white :background, bg2)))) - `(warning ((,class (:foreground ,war )))) - -;;;;; anzu-mode - `(anzu-mode-line ((,class (:foreground ,yellow :weight bold)))) - -;;;;; company - `(company-echo-common ((,class (:background ,base :foreground ,bg1)))) - `(company-preview ((,class (:background ,bg1 :foreground ,key1)))) - `(company-preview-common ((,class (:background ,bg2 :foreground ,keyword)))) - `(company-preview-search ((,class (:background ,bg2 :foreground ,green)))) - `(company-scrollbar-bg ((,class (:background ,bg2)))) - `(company-scrollbar-fg ((,class (:background ,comp)))) - `(company-template-field ((,class (:inherit region)))) - `(company-tooltip ((,class (:background ,bg2 :foreground ,base)))) - `(company-tooltip-annotation ((,class (:background ,bg2 :foreground ,active1)))) - `(company-tooltip-common ((,class (:background ,active2 :foreground ,bg1)))) - `(company-tooltip-common-selection ((,class (:foreground ,bg1)))) - `(company-tooltip-mouse ((,class (:inherit highlight)))) - `(company-tooltip-search ((,class (:inherit match)))) - `(company-tooltip-selection ((,class (:background ,active1 :foreground, bg1)))) - -;;;;; diff - `(diff-added ((,class :background nil :foreground ,green))) - `(diff-changed ((,class :background nil :foreground ,inf))) - `(diff-indicator-added ((,class :background nil :foreground ,green))) - `(diff-indicator-changed ((,class :background nil :foreground ,inf))) - `(diff-indicator-removed ((,class :background nil :foreground ,red))) - `(diff-refine-added ((,class :background ,green :foreground ,bg4))) - `(diff-refine-changed ((,class :background ,inf :foreground ,bg4))) - `(diff-refine-removed ((,class :background ,red :foreground ,bg4))) - `(diff-removed ((,class :background nil :foreground ,red))) - -;;;;; dired - `(dired-directory ((,class (:foreground ,key1 :background ,bg1 :weight bold)))) - `(dired-flagged ((,class (:foreground ,red)))) - `(dired-header ((,class (:foreground ,comp :weight bold)))) - `(dired-ignored ((,class (:inherit shadow)))) - `(dired-mark ((,class (:foreground ,comp :weight bold)))) - `(dired-marked ((,class (:foreground ,violet :weight bold)))) - `(dired-perm-write ((,class (:foreground ,base :underline t)))) - `(dired-symlink ((,class (:foreground ,cyan :background ,bg1 :weight bold)))) - `(dired-warning ((,class (:foreground ,war)))) - -;;;;; ediff - `(ediff-current-diff-A ((,class(:background ,org-h1-bg :foreground ,inf)))) - `(ediff-current-diff-Ancestor ((,class(:background ,org-h2-bg :foreground ,str)))) - `(ediff-current-diff-B ((,class(:background ,org-h4-bg :foreground ,yellow)))) - `(ediff-current-diff-C ((,class(:background ,org-h3-bg :foreground ,green)))) - `(ediff-even-diff-A ((,class(:background ,bg3)))) - `(ediff-even-diff-Ancestor ((,class(:background ,bg3)))) - `(ediff-even-diff-B ((,class(:background ,bg3)))) - `(ediff-even-diff-C ((,class(:background ,bg3)))) - `(ediff-fine-diff-A ((,class(:background nil :bold t :underline t)))) - `(ediff-fine-diff-Ancestor ((,class(:background nil :bold t :underline t)))) - `(ediff-fine-diff-B ((,class(:background nil :bold t :underline t)))) - `(ediff-fine-diff-C ((,class(:background nil :bold t :underline t)))) - `(ediff-odd-diff-A ((,class(:background ,bg4)))) - `(ediff-odd-diff-Ancestor ((,class(:background ,bg4)))) - `(ediff-odd-diff-B ((,class(:background ,bg4)))) - `(ediff-odd-diff-C ((,class(:background ,bg4)))) - -;;;;; ein - `(ein:cell-input-area((,class (:background ,bg2)))) - `(ein:cell-input-prompt ((,class (:foreground ,(if (eq variant 'dark) suc green))))) - `(ein:cell-output-prompt ((,class (:foreground ,err)))) - `(ein:notification-tab-normal ((,class (:foreground ,builtin)))) - `(ein:notification-tab-selected ((,class (:foreground ,(if (eq variant 'dark) suc green) :bold t)))) - -;;;;; eldoc - `(eldoc-highlight-function-argument ((,class (:foreground ,(if (eq variant 'dark) suc red) :bold t)))) - -;;;;; erc - `(erc-input-face ((,class (:foreground ,func)))) - `(erc-my-nick-face ((,class (:foreground ,key1)))) - `(erc-nick-default-face ((,class (:foreground ,inf)))) - `(erc-nick-prefix-face ((,class (:foreground ,yellow)))) - `(erc-notice-face ((,class (:foreground ,str)))) - `(erc-prompt-face ((,class (:foreground ,(if (eq variant 'dark) suc green) :bold t)))) - `(erc-timestamp-face ((,class (:foreground ,builtin)))) - -;;;;; eshell - `(eshell-ls-archive ((,class (:foreground ,red :weight bold)))) - `(eshell-ls-backup ((,class (:inherit font-lock-comment-face)))) - `(eshell-ls-clutter ((,class (:inherit font-lock-comment-face)))) - `(eshell-ls-directory ((,class (:foreground ,inf :weight bold)))) - `(eshell-ls-executable ((,class (:foreground ,suc :weight bold)))) - `(eshell-ls-missing ((,class (:inherit font-lock-warning-face)))) - `(eshell-ls-product ((,class (:inherit font-lock-doc-face)))) - `(eshell-ls-special ((,class (:foreground ,yellow :weight bold)))) - `(eshell-ls-symlink ((,class (:foreground ,cyan :weight bold)))) - `(eshell-ls-unreadable ((,class (:foreground ,base)))) - `(eshell-prompt ((,class (:foreground ,keyword :weight bold)))) - -;;;;; flycheck - `(flycheck-error ((,class (:foreground ,bg1 :background ,err)))) - `(flycheck-error-list-checker-name ((,class (:foreground ,keyword)))) - `(flycheck-fringe-error ((,class (:foreground ,err :weight bold)))) - `(flycheck-fringe-info ((,class (:foreground ,inf :weight bold)))) - `(flycheck-fringe-warning ((,class (:foreground ,war :weight bold)))) - `(flycheck-info - ((,(append '((supports :underline (:style line))) class) - (:underline (:style line :color ,inf))) - (,class (:foreground ,base :background ,inf :weight bold :underline t)))) - `(flycheck-warning ((,class (:foreground ,bg1 :background ,violet)))) - -;;;;; git-gutter-fr - `(git-gutter-fr:added ((,class (:foreground ,green :weight bold)))) - `(git-gutter-fr:deleted ((,class (:foreground ,war :weight bold)))) - `(git-gutter-fr:modified ((,class (:foreground ,inf :weight bold)))) - -;;;;; git-timemachine - `(git-timemachine-minibuffer-detail-face ((,class (:foreground ,inf :bold t :background ,org-h1-bg)))) - -;;;;; gnus - `(gnus-emphasis-highlight-words ((,class (:background ,(if (eq variant 'dark) err suc) :foreground ,(when (eq variant 'light) bg1))))) - `(gnus-header-content ((,class (:foreground ,keyword)))) - `(gnus-header-from ((,class (:foreground ,var)))) - `(gnus-header-name ((,class (:foreground ,comp)))) - `(gnus-header-subject ((,class (:foreground ,func :bold t)))) - `(gnus-summary-cancelled ((,class (:background ,(if (eq variant 'dark) err suc) :foreground ,bg1)))) - -;;;;; guide-key - `(guide-key/highlight-command-face ((,class (:foreground ,base)))) - `(guide-key/key-face ((,class (:foreground ,key1)))) - `(guide-key/prefix-command-face ((,class (:foreground ,key2 :weight bold)))) - -;;;;; helm - `(helm-bookmark-directory ((,class (:inherit helm-ff-directory)))) - `(helm-bookmark-file ((,class (:foreground ,base)))) - `(helm-bookmark-gnus ((,class (:foreground ,comp)))) - `(helm-bookmark-info ((,class (:foreground ,comp)))) - `(helm-bookmark-man ((,class (:foreground ,comp)))) - `(helm-bookmark-w3m ((,class (:foreground ,comp)))) - `(helm-buffer-directory ((,class (:foreground ,base :background ,bg1)))) - `(helm-buffer-file ((,class (:foreground ,base :background ,bg1)))) - `(helm-buffer-not-saved ((,class (:foreground ,comp :background ,bg1)))) - `(helm-buffer-process ((,class (:foreground ,builtin :background ,bg1)))) - `(helm-buffer-saved-out ((,class (:foreground ,base :background ,bg1)))) - `(helm-buffer-size ((,class (:foreground ,base :background ,bg1)))) - `(helm-candidate-number ((,class (:background ,bg1 :foreground ,inf :bold t)))) - `(helm-ff-directory ((,class (:foreground ,key1 :background ,bg1 :weight bold)))) - `(helm-ff-dotted-directory ((,class (:foreground ,key1 :background ,bg1 :weight bold)))) - `(helm-ff-executable ((,class (:foreground ,suc :background ,bg1 :weight normal)))) - `(helm-ff-file ((,class (:foreground ,base :background ,bg1 :weight normal)))) - `(helm-ff-invalid-symlink ((,class (:foreground ,red :background ,bg1 :weight bold)))) - `(helm-ff-prefix ((,class (:foreground ,bg1 :background ,keyword :weight normal)))) - `(helm-ff-symlink ((,class (:foreground ,cyan :background ,bg1 :weight bold)))) - `(helm-grep-cmd-line ((,class (:foreground ,base :background ,bg1)))) - `(helm-grep-file ((,class (:foreground ,base :background ,bg1)))) - `(helm-grep-finish ((,class (:foreground ,base :background ,bg1)))) - `(helm-grep-lineno ((,class (:foreground ,base :background ,bg1)))) - `(helm-grep-match ((,class (:foreground nil :background nil :inherit helm-match)))) - `(helm-grep-running ((,class (:foreground ,func :background ,bg1)))) - `(helm-header ((,class (:foreground ,base :background ,bg1 :underline nil :box nil)))) - `(helm-header-line-left-margin ((,class (:foreground ,inf :background ,nil)))) - `(helm-match ((,class (:inherit match)))) - `(helm-match-item ((,class (:inherit match)))) - `(helm-moccur-buffer ((,class (:foreground ,func :background ,bg1)))) - `(helm-selection ((,class (:background ,highlight :foreground, bg1)))) - `(helm-selection-line ((,class (:background ,bg2)))) - `(helm-separator ((,class (:foreground ,comp :background ,bg1)))) - `(helm-source-header ((,class (:background ,comp :foreground ,bg1 :bold t)))) - `(helm-time-zone-current ((,class (:foreground ,builtin :background ,bg1)))) - `(helm-time-zone-home ((,class (:foreground ,comp :background ,bg1)))) - `(helm-visible-mark ((,class (:foreground ,bg1 :background ,bg3)))) - -;;;;; helm-swoop - `(helm-swoop-target-line-block-face ((,class (:foreground ,base :background ,highlight)))) - `(helm-swoop-target-line-face ((,class (:foreground ,base :background ,highlight)))) - `(helm-swoop-target-word-face ((,class (:foreground ,bg1 :background ,suc)))) - -;;;;; ido - `(ido-first-match ((,class (:foreground ,comp :bold t)))) - `(ido-only-match ((,class (:foreground ,(if (eq variant 'dark) suc red) :bold t)))) - `(ido-subdir ((,class (:foreground ,key1)))) - `(ido-vertical-match-face ((,class (:foreground ,comp :underline nil)))) - -;;;;; info - `(info-header-xref ((,class (:foreground ,func :underline t)))) - `(info-menu ((,class (:foreground ,suc)))) - `(info-node ((,class (:foreground ,func :bold t)))) - `(info-quoted-name ((,class (:foreground ,builtin)))) - `(info-reference-item ((,class (:background nil :underline t :bold t)))) - `(info-string ((,class (:foreground ,str)))) - `(info-title-1 ((,class (:height 1.4 :bold t)))) - `(info-title-2 ((,class (:height 1.3 :bold t)))) - `(info-title-3 ((,class (:height 1.3)))) - `(info-title-4 ((,class (:height 1.2)))) - -;;;;; linum-mode - `(linum ((,class (:foreground ,base :background ,bg2)))) - `(nlinum ((,class (:foreground ,base :background ,bg2)))) - `(line-number ((,class (:foreground ,base :background ,bg2)))) - -;;;;; magit - `(magit-tag ((,class :background nil :foreground ,yellow))) - `(magit-blame-culprit ((,class :background ,org-h4-bg :foreground ,yellow))) - `(magit-blame-header ((,class :background ,org-h4-bg :foreground ,green))) - `(magit-blame-sha1 ((,class :background ,org-h4-bg :foreground ,func))) - `(magit-blame-subject ((,class :background ,org-h4-bg :foreground ,yellow))) - `(magit-blame-time ((,class :background ,org-h4-bg :foreground ,green))) - `(magit-blame-name ((,class :background ,org-h4-bg :foreground ,yellow))) - `(magit-blame-heading ((,class :background ,org-h4-bg :foreground ,green))) - `(magit-blame-hash ((,class :background ,org-h4-bg :foreground ,func))) - `(magit-blame-summary ((,class :background ,org-h4-bg :foreground ,yellow))) - `(magit-blame-date ((,class :background ,org-h4-bg :foreground ,green))) - `(magit-branch-local ((,class :background nil :foreground , func))) - `(magit-branch-remote ((,class :background nil :foreground ,green))) - `(magit-branch ((,class (:foreground ,const :weight bold)))) - `(magit-diff-context-highlight ((,class (:background ,bg3 :foreground ,base)))) - `(magit-diff-file-header ((,class (:background nil :foreground ,str)))) - `(magit-diff-hunk-header ((,class (:background nil :foreground ,builtin)))) - `(magit-hash ((,class (:foreground ,base)))) - `(magit-hunk-heading ((,class (:background ,bg3)))) - `(magit-hunk-heading-highlight ((,class (:background ,bg3)))) - `(magit-item-highlight ((,class :background ,bg2))) - `(magit-log-author ((,class (:foreground ,base)))) - `(magit-log-head-label-head ((,class (:background ,yellow :foreground ,bg1 :bold t)))) - `(magit-log-head-label-local ((,class (:background ,inf :foreground ,bg1 :bold t)))) - `(magit-log-head-label-remote ((,class (:background ,suc :foreground ,bg1 :bold t)))) - `(magit-log-head-label-tags ((,class (:background ,violet :foreground ,bg1 :bold t)))) - `(magit-log-head-label-wip ((,class (:background ,cyan :foreground ,bg1 :bold t)))) - `(magit-log-sha1 ((,class (:foreground ,str)))) - `(magit-process-ng ((,class (:foreground ,war :weight bold)))) - `(magit-process-ok ((,class (:foreground ,func :weight bold)))) - `(magit-section-heading ((,class (:foreground ,keyword :weight bold)))) - `(magit-section-highlight ((,class (:background ,bg2)))) - `(magit-section-title ((,class (:background ,bg1 :foreground ,builtin :weight bold)))) - -;;;;; mode-line - `(mode-line ((,class (:foreground ,bg1 :background ,active1 :box (:color ,m-line-brdr :line-width 0))))) - `(mode-line-inactive ((,class (:foreground ,white :background ,bg2 :box (:color ,m-line-brdr :line-width 0))))) - `(mode-line-buffer-id ((,class (:bold f :foreground ,bg1)))) - -;;;;; mode-line - `(sml/modified ((,class (:foreground ,bg1 :background ,red)))) - -;;;;; neotree - `(neo-dir-link-face ((,class (:foreground ,inf :weight bold)))) - `(neo-expand-btn-face ((,class (:foreground ,base)))) - `(neo-file-link-face ((,class (:foreground ,base)))) - `(neo-root-dir-face ((,class (:foreground ,func :weight bold)))) - -;;;;; org - `(org-agenda-clocking ((,class (:foreground ,comp)))) - `(org-agenda-date ((,class (:foreground ,var :height 1.1)))) - `(org-agenda-date-today ((,class (:weight bold :foreground ,keyword :height 1.3)))) - `(org-agenda-date-weekend ((,class (:weight normal :foreground ,base)))) - `(org-agenda-done ((,class (:foreground ,(if (eq variant 'dark) suc green) :bold t)))) - `(org-agenda-structure ((,class (:weight bold :foreground ,comp)))) - `(org-block ((,class (:foreground ,base)))) - `(org-block-background ((,class (:background ,org-block-bg)))) - `(org-clock-overlay ((,class (:foreground ,comp)))) - `(org-code ((,class (:foreground ,cyan)))) - `(org-column ((,class (:background ,highlight)))) - `(org-column-title ((,class (:background ,highlight)))) - `(org-date ((,class (:underline t :foreground ,var) ))) - `(org-date-selected ((,class (:background ,func :foreground ,bg1) ))) - `(org-document-info-keyword ((,class (:foreground ,str)))) - `(org-document-title ((,class (:foreground ,func :weight bold :height ,(if wpgtk-theme-org-height 1.4 1.0) :underline t)))) - `(org-done ((,class (:foreground ,(if (eq variant 'dark) suc green) :bold t :overline t :background ,org-h3-bg)))) - `(org-ellipsis ((,class (:foreground ,builtin)))) - `(org-footnote ((,class (:underline t :foreground ,base)))) - `(org-hide ((,class (:foreground ,base)))) - `(org-level-1 ((,class (:bold t :foreground ,inf :height ,(if wpgtk-theme-org-height 1.3 1.0) :background ,org-h1-bg)))) - `(org-level-2 ((,class (:bold t :foreground ,str :height ,(if wpgtk-theme-org-height 1.2 1.0) :background ,org-h2-bg)))) - `(org-level-3 ((,class (:bold nil :foreground ,green :height ,(if wpgtk-theme-org-height 1.1 1.0) :background ,org-h3-bg)))) - `(org-level-4 ((,class (:bold nil :foreground ,yellow :background ,org-h4-bg)))) - `(org-level-5 ((,class (:bold nil :foreground ,inf)))) - `(org-level-6 ((,class (:bold nil :foreground ,str)))) - `(org-level-7 ((,class (:bold nil :foreground ,green)))) - `(org-level-8 ((,class (:bold nil :foreground ,yellow)))) - `(org-link ((,class (:underline t :foreground ,comment)))) - `(org-mode-line-clock-overrun ((,class (:foreground ,err)))) - `(org-priority ((,class (:foreground ,war :bold t)))) - `(org-quote ((,class (:inherit org-block :slant italic)))) - `(org-scheduled ((,class (:foreground ,comp)))) - `(org-scheduled-today ((,class (:foreground ,func :weight bold :height 1.2)))) - `(org-sexp-date ((,class (:foreground ,base)))) - `(org-special-keyword ((,class (:foreground ,func)))) - `(org-table ((,class (:foreground ,yellow :background ,org-h4-bg)))) - `(org-todo ((,class (:foreground ,war :bold t :overline t :background ,org-h4-bg)))) - `(org-verbatim ((,class (:foreground ,inf)))) - `(org-verse ((,class (:inherit org-block :slant italic)))) - `(org-warning ((,class (:foreground ,err)))) - -;;;;; powerline - `(powerline-active1 ((,class (:background ,active2 :foreground ,base)))) - `(powerline-active2 ((,class (:background ,active2 :foreground ,base)))) - `(powerline-inactive1 ((,class (:background ,bg2 :foreground ,base)))) - `(powerline-inactive2 ((,class (:background ,bg2 :foreground ,base)))) - -;;;;; rainbow-delimiters - `(rainbow-delimiters-depth-1-face ((,class :foreground ,inf))) - `(rainbow-delimiters-depth-2-face ((,class :foreground ,func))) - `(rainbow-delimiters-depth-3-face ((,class :foreground ,str))) - `(rainbow-delimiters-depth-4-face ((,class :foreground ,green))) - `(rainbow-delimiters-depth-5-face ((,class :foreground ,yellow))) - `(rainbow-delimiters-depth-6-face ((,class :foreground ,inf))) - `(rainbow-delimiters-depth-7-face ((,class :foreground ,func))) - `(rainbow-delimiters-depth-8-face ((,class :foreground ,str))) - `(rainbow-delimiters-unmatched-face ((,class :foreground ,war))) - -;;;;; smartparens - `(sp-pair-overlay-face ((,class (:background ,highlight :foreground nil)))) - `(sp-show-pair-match-face ((,class (:foreground ,(if (eq variant 'dark) suc red) :weight bold :underline t)))) - -;;;;; term - `(term ((,class (:foreground ,base :background ,bg1)))) - `(term-color-black ((,class (:foreground ,bg4)))) - `(term-color-blue ((,class (:foreground ,inf)))) - `(term-color-cyan ((,class (:foreground ,cyan)))) - `(term-color-green ((,class (:foreground ,green)))) - `(term-color-magenta ((,class (:foreground ,builtin)))) - `(term-color-red ((,class (:foreground ,red)))) - `(term-color-white ((,class (:foreground ,base)))) - `(term-color-yellow ((,class (:foreground ,yellow)))) - -;;;;; which-key - `(which-key-command-description-face ((,class (:foreground ,base)))) - `(which-key-group-description-face ((,class (:foreground ,key2)))) - `(which-key-key-face ((,class (:foreground ,func :bold t)))) - `(which-key-separator-face ((,class (:background nil :foreground ,str)))) - `(which-key-special-key-face ((,class (:background ,func :foreground ,bg1)))) - -;;;;; other, need more work - `(ac-completion-face ((,class (:underline t :foreground ,keyword)))) - `(elixir-atom-face ((,class (:foreground ,func)))) - `(ffap ((,class (:foreground ,base)))) - `(flx-highlight-face ((,class (:foreground ,comp :underline nil)))) - `(font-latex-bold-face ((,class (:foreground ,comp)))) - `(font-latex-italic-face ((,class (:foreground ,key2 :italic t)))) - `(font-latex-match-reference-keywords ((,class (:foreground ,const)))) - `(font-latex-match-variable-keywords ((,class (:foreground ,var)))) - `(font-latex-string-face ((,class (:foreground ,str)))) - `(icompletep-determined ((,class :foreground ,builtin))) - `(js2-external-variable ((,class (:foreground ,comp )))) - `(js2-function-param ((,class (:foreground ,const)))) - `(js2-function-call ((,class (:inherit ,font-lock-function-name-face)))) - `(js2-jsdoc-html-tag-delimiter ((,class (:foreground ,str)))) - `(js2-jsdoc-html-tag-name ((,class (:foreground ,key1)))) - `(js2-jsdoc-value ((,class (:foreground ,str)))) - `(js2-private-function-call ((,class (:foreground ,const)))) - `(js2-private-member ((,class (:foreground ,base)))) - `(js3-error-face ((,class (:underline ,war)))) - `(js3-external-variable-face ((,class (:foreground ,var)))) - `(js3-function-param-face ((,class (:foreground ,key2)))) - `(js3-instance-member-face ((,class (:foreground ,const)))) - `(js3-jsdoc-tag-face ((,class (:foreground ,keyword)))) - `(js3-warning-face ((,class (:underline ,keyword)))) - `(mu4e-cited-1-face ((,class (:foreground ,base)))) - `(mu4e-cited-7-face ((,class (:foreground ,base)))) - `(mu4e-header-marks-face ((,class (:foreground ,comp)))) - `(mu4e-view-url-number-face ((,class (:foreground ,comp)))) - `(py-variable-name-face ((,class (:foreground ,var)))) - `(slime-repl-inputed-output-face ((,class (:foreground ,comp)))) - `(sh-quoted-text ((,class (:foreground ,func)))) - `(trailing-whitespace ((,class :foreground nil :background ,err))) - `(undo-tree-visualizer-current-face ((,class :foreground ,builtin))) - `(undo-tree-visualizer-default-face ((,class :foreground ,base))) - `(undo-tree-visualizer-register-face ((,class :foreground ,comp))) - `(undo-tree-visualizer-unmodified-face ((,class :foreground ,var))) - `(web-mode-builtin-face ((,class (:inherit ,font-lock-builtin-face)))) - `(web-mode-comment-face ((,class (:inherit ,font-lock-comment-face)))) - `(web-mode-constant-face ((,class (:inherit ,font-lock-constant-face)))) - `(web-mode-doctype-face ((,class (:inherit ,font-lock-comment-face)))) - `(web-mode-function-name-face ((,class (:inherit ,font-lock-function-name-face)))) - `(web-mode-html-attr-name-face ((,class (:foreground ,func)))) - `(web-mode-html-attr-value-face ((,class (:foreground ,keyword)))) - `(web-mode-html-tag-face ((,class (:foreground ,builtin)))) - `(web-mode-keyword-face ((,class (:foreground ,keyword)))) - `(web-mode-string-face ((,class (:foreground ,str)))) - `(web-mode-type-face ((,class (:inherit ,font-lock-type-face)))) - `(web-mode-warning-face ((,class (:inherit ,font-lock-warning-face))))))) - -(deftheme wpgtk "Theme for wpgtk template system") -(create-wpgtk-theme 'dark 'wpgtk) -(provide-theme 'wpgtk) - -;; Local Variables: -;; no-byte-compile: t -;; End: - -;;; wpgtk-theme.el ends here diff --git a/configs/shared/.emacs.d/wpc/alist.el b/configs/shared/.emacs.d/wpc/alist.el deleted file mode 100644 index f23109ce6a..0000000000 --- a/configs/shared/.emacs.d/wpc/alist.el +++ /dev/null @@ -1,277 +0,0 @@ -;;; alist.el --- Interface for working with associative lists -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Firstly, a rant: -;; In most cases, I find Elisp's APIs to be confusing. There's a mixture of -;; overloaded functions that leak the implementation details (TODO: provide an -;; example of this.) of the abstract data type, which I find privileges those -;; "insiders" who spend disproportionately large amounts of time in Elisp land, -;; and other functions with little-to-no pattern about the order in which -;; arguments should be applied. In theory, however, most of these APIs could -;; and should be much simpler. This module represents a step in that direction. -;; -;; I'm modelling these APIs after Elixir's APIs. -;; -;; On my wishlist is to create protocols that will allow generic interfaces like -;; Enum protocols, etc. Would be nice to abstract over... -;; - associative lists (i.e. alists) -;; - property lists (i.e. plists) -;; - hash tables -;; ...with some dictionary or map-like interface. This will probably end up -;; being quite similar to the kv.el project but with differences at the API -;; layer. -;; -;; Similar libraries: -;; - map.el: Comes bundled with recent versions of Emacs. -;; - asoc.el: Helpers for working with alists. asoc.el is similar to alist.el -;; because it uses the "!" convention for signalling that a function mutates -;; the underlying data structure. -;; - ht.el: Hash table library. -;; - kv.el: Library for dealing with key-value collections. Note that map.el -;; has a similar typeclass because it works with lists, hash-tables, or -;; arrays. -;; - a.el: Clojure-inspired way of working with key-value data structures in -;; Elisp. Works with alists, hash-tables, and sometimes vectors. -;; -;; Some API design principles: -;; - The "noun" (i.e. alist) of the "verb" (i.e. function) comes last to improve -;; composability with the threading macro (i.e. `->>') and to improve consumers' -;; intuition with the APIs. Learn this once, know it always. -;; -;; - Every function avoids mutating the alist unless it ends with !. -;; -;; - CRUD operations will be named according to the following table: -;; - "create" *and* "set" -;; - "read" *and* "get" -;; - "update" -;; - "delete" *and* "remove" -;; -;; For better or worse, all of this code expects alists in the form of: -;; ((first-name . "William") (last-name . "Carroll")) -;; -;; Special thanks to github.com/alphapapa/emacs-package-dev-handbook for some of -;; the idiomatic ways to update alists. -;; -;; TODO: Include a section that compares alist.el to a.el from -;; github.com/plexus/a.el. - -;; Dependencies: - -;; TODO: Consider dropping explicit dependency white-listing since all of these -;; should be available in my Emacs. The problem arises when this library needs -;; to be published, in which case, something like Nix and a build process could -;; possible insert the necessary require statements herein. Not sure how I feel -;; about this though. -(require 'maybe) -(require 'macros) -(require 'dash) -(require 'tuple) -(require 'maybe) - -;;; Code: - -;; TODO: Support function aliases for: -;; - create/set -;; - read/get -;; - update -;; - delete/remove - -;; Support mutative variants of functions with an ! appendage to their name. - -;; Ensure that the same message about only updating the first occurrence of a -;; key is consistent throughout documentation using string interpolation or some -;; other mechanism. - -;; TODO: Consider wrapping all of this with `(cl-defstruct alist xs)'. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Constants -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst alist/enable-tests? t - "When t, run the test suite.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO: Support a variadic version of this to easily construct alists. -(defun alist/new () - "Return a new, empty alist." - '()) - -;; Create -;; TODO: See if this mutates. -(defun alist/set (k v xs) - "Set K to V in XS." - (if (alist/has-key? k xs) - (progn - (setf (alist-get k xs) v) - xs) - (list/cons `(,k . ,v) xs))) - -(defun alist/set! (k v xs) - "Set K to V in XS mutatively. -Note that this doesn't append to the alist in the way that most alists handle - writing. If the k already exists in XS, it is overwritten." - (map-delete xs k) - (map-put xs k v)) - -;; Read -(defun alist/get (k xs) - "Return the value at K in XS; otherwise, return nil. -Returns the first occurrence of K in XS since alists support multiple entries." - (cdr (assoc k xs))) - -(defun alist/get-entry (k xs) - "Return the first key-value pair at K in XS." - (assoc k xs)) - -;; Update -;; TODO: Add warning about only the first occurrence being updated in the -;; documentation. -(defun alist/update (k f xs) - "Apply F to the value stored at K in XS. -If `K' is not in `XS', this function errors. Use `alist/upsert' if you're -interested in inserting a value when a key doesn't already exist." - (if (maybe/nil? (alist/get k xs)) - (error "Refusing to update: key does not exist in alist") - (alist/set k (funcall f (alist/get k xs)) xs))) - -(defun alist/update! (k f xs) - "Call F on the entry at K in XS. -Mutative variant of `alist/update'." - (alist/set! k (funcall f (alist/get k xs))xs)) - -;; TODO: Support this. -(defun alist/upsert (k v f xs) - "If K exists in `XS' call `F' on the value otherwise insert `V'." - (if (alist/get k xs) - (alist/update k f xs) - (alist/set k v xs))) - -;; Delete -;; TODO: Make sure `delete' and `remove' behave as advertised in the Elisp docs. -(defun alist/delete (k xs) - "Deletes the entry of K from XS. -This only removes the first occurrence of K, since alists support multiple - key-value entries. See `alist/delete-all' and `alist/dedupe'." - (remove (assoc k xs) xs)) - -(defun alist/delete! (k xs) - "Delete the entry of K from XS. -Mutative variant of `alist/delete'." - (delete (assoc k xs) xs)) - -;; Additions to the CRUD API -;; TODO: Implement this function. -(defun alist/dedupe-keys (xs) - "Remove the entries in XS where the keys are `equal'.") - -(defun alist/dedupe-entries (xs) - "Remove the entries in XS where the key-value pair are `equal'." - (delete-dups xs)) - -(defun alist/keys (xs) - "Return a list of the keys in XS." - (mapcar 'car xs)) - -(defun alist/values (xs) - "Return a list of the values in XS." - (mapcar 'cdr xs)) - -(defun alist/has-key? (k xs) - "Return t if XS has a key `equal' to K." - (maybe/some? (assoc k xs))) - -(defun alist/has-value? (v xs) - "Return t if XS has a value of V." - (maybe/some? (rassoc v xs))) - -(defun alist/count (xs) - "Return the number of entries in XS." - (length xs)) - -;; TODO: Should I support `alist/find-key' and `alist/find-value' variants? -(defun alist/find (p xs) - "Apply a predicate fn, P, to each key and value in XS and return the key of - the first element that returns t." - (let ((result (list/find (lambda (x) (funcall p (car x) (cdr x))) xs))) - (if result - (car result) - nil))) - -(defun alist/map-keys (f xs) - "Call F on the values in XS, returning a new alist." - (list/map (lambda (x) - `(,(funcall f (car x)) . ,(cdr x))) - xs)) - -(defun alist/map-values (f xs) - "Call F on the values in XS, returning a new alist." - (list/map (lambda (x) - `(,(car x) . ,(funcall f (cdr x)))) - xs)) - -(defun alist/reduce (acc f xs) - "Return a new alist by calling F on k v and ACC from XS. -F should return a tuple. See tuple.el for more information." - (->> (alist/keys xs) - (list/reduce acc - (lambda (k acc) - (funcall f k (alist/get k xs) acc))))) - -(defun alist/merge (a b) - "Return a new alist with a merge of alists, A and B. -In this case, the last writer wins, which is B." - (alist/reduce a #'alist/set b)) - -;; TODO: Support `-all' variants like: -;; - get-all -;; - delete-all -;; - update-all - -;; Scratch-pad -(macros/comment - (progn - (setq person '((first-name . "William") - (first-name . "William") - (last-name . "Carroll") - (last-name . "Another"))) - (alist/set 'last-name "Van Gogh" person) - (alist/get 'last-name person) - (alist/update 'last-name (lambda (x) "whoops") person) - (alist/delete 'first-name person) - (alist/keys person) - (alist/values person) - (alist/count person) - (alist/has-key? 'first-name person) - (alist/has-value? "William" person) - ;; (alist/dedupe-keys person) - (alist/dedupe-entries person) - (alist/count person))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Tests -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(when alist/enable-tests? - (prelude/assert - (equal '((2 . one) - (3 . two)) - (alist/map-keys #'1+ - '((1 . one) - (2 . two))))) - (prelude/assert - (equal '((one . 2) - (two . 3)) - (alist/map-values #'1+ - '((one . 1) - (two . 2)))))) - - -;; TODO: Support test cases for the entire API. - -(provide 'alist) -;;; alist.el ends here diff --git a/configs/shared/.emacs.d/wpc/bag.el b/configs/shared/.emacs.d/wpc/bag.el deleted file mode 100644 index c9511b18e7..0000000000 --- a/configs/shared/.emacs.d/wpc/bag.el +++ /dev/null @@ -1,66 +0,0 @@ -;;; bag.el --- Working with bags (aka multi-sets) -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; What is a bag? A bag should be thought of as a frequency table. It's a way -;; to convert a list of something into a set that allows duplicates. Isn't -;; allowing duplicates the whole thing with Sets? Kind of. But the interface -;; of Sets is something that bags resemble, so multi-set isn't as bag of a name -;; as it may first seem. -;; -;; If you've used Python's collections.Counter, the concept of a bag should be -;; familiar already. -;; -;; Interface: -;; - add :: x -> Bag(x) -> Bag(x) -;; - remove :: x -> Bag(x) -> Bag(x) -;; - union :: Bag(x) -> Bag(x) -> Bag(x) -;; - difference :: Bag(x) -> Bag(x) -> Bag(x) - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'number) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(cl-defstruct bag xs) - -(defun bag/update (f xs) - "Call F on alist in XS." - (let ((ys (bag-xs xs))) - (setf (bag-xs xs) (funcall f ys)))) - -(defun bag/new () - "Create an empty bag." - (make-bag :xs (alist/new))) - -(defun bag/contains? (x xs) - "Return t if XS has X." - (alist/has-key? x (bag-xs xs))) - -;; TODO: Tabling this for now since working with structs seems to be -;; disappointingly difficult. Where is `struct/update'? -;; (defun bag/add (x xs) -;; "Add X to XS.") - -;; TODO: What do we name delete vs. remove? -;; (defun bag/remove (x xs) -;; "Remove X from XS. -;; This is a no-op is X doesn't exist in XS.") - -(defun bag/from-list (xs) - "Map a list of `XS' into a bag." - (->> xs - (list/reduce - (bag/new) - (lambda (x acc) - (bag/add x 1 #'number/inc acc))))) - -(provide 'bag) -;;; bag.el ends here diff --git a/configs/shared/.emacs.d/wpc/bills.el b/configs/shared/.emacs.d/wpc/bills.el deleted file mode 100644 index fbdeb9d0f8..0000000000 --- a/configs/shared/.emacs.d/wpc/bills.el +++ /dev/null @@ -1,26 +0,0 @@ -;;; bills.el --- Helping me manage my bills -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; For personal use only. - -;;; Code: - -(defconst bills/whitelist '(("Council Tax" . "rbkc.gov.uk/onlinepayments/counciltaxpayments/") - ("Internet". "plus.net/member-centre/login")) - "Maps searchable labels to URLs to pay these bills.") - -(defun bills/url () - "Copies the URL to pay a bill onto the clipboard." - (ivy-read - "Bill: " - bills/whitelist - :action (lambda (entry) - (kill-new (cdr entry)) - (alert "Copied to clipboard!")))) - -(macros/comment - (bills/url)) - -(provide 'bills) -;;; bills.el ends here diff --git a/configs/shared/.emacs.d/wpc/bookmark.el b/configs/shared/.emacs.d/wpc/bookmark.el deleted file mode 100644 index 734ddaa13a..0000000000 --- a/configs/shared/.emacs.d/wpc/bookmark.el +++ /dev/null @@ -1,145 +0,0 @@ -;;; bookmark.el --- Saved files and directories on my filesystem -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; After enjoying and relying on Emacs's builtin `jump-to-register' command, I'd -;; like to recreate this functionality with a few extensions. -;; -;; Everything herein will mimmick my previous KBDs for `jump-to-register', which -;; were -j-. If the `bookmark-path' is a file, Emacs will -;; open a buffer with that file. If the `bookmark-path' is a directory, Emacs -;; will open an ivy window searching that directory. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'f) -(require 'buffer) -(require 'list) -(require 'string) -(require 'set) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Constants -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(cl-defstruct bookmark label path kbd) - -(defconst bookmark/install-kbds? t - "When t, install keybindings.") - -;; TODO: Consider hosting this function somewhere other than here, since it -;; feels useful above of the context of bookmarks. -;; TODO: Assess whether it'd be better to use the existing function: -;; `counsel-projectile-switch-project-action'. See the noise I made on GH for -;; more context: https://github.com/ericdanan/counsel-projectile/issues/137 - -(defun bookmark/handle-directory-dwim (path) - "Open PATH as either a project directory or a regular directory. -If PATH is `projectile-project-p', open with `counsel-projectile-find-file'. -Otherwise, open with `counsel-find-file'." - (if (projectile-project-p path) - (with-temp-buffer - (cd (projectile-project-p path)) - (call-interactively #'counsel-projectile-find-file)) - (let ((ivy-extra-directories nil)) - (counsel-find-file path)))) - -(defconst bookmark/handle-directory #'bookmark/handle-directory-dwim - "Function to call when a bookmark points to a directory.") - -(defconst bookmark/handle-file #'counsel-find-file-action - "Function to call when a bookmark points to a file.") - -(defconst bookmark/whitelist - (list - (make-bookmark :label "depot" - :path "~/depot" - :kbd "t") - (make-bookmark :label "org" - :path "~/Dropbox/org" - :kbd "o") - (make-bookmark :label "universe" - :path "~/universe" - :kbd "m") - (make-bookmark :label "dotfiles" - :path "~/dotfiles" - :kbd "d") - (make-bookmark :label "current project" - :path constants/current-project - :kbd "p")) - "List of registered bookmarks.") - -(defun bookmark/from-label (label) - "Return the bookmark with LABEL or nil." - (->> bookmark/whitelist - (list/find (lambda (b) (equal label (bookmark-label b)))))) - -(defun bookmark/magit-status () - "Use ivy to select a bookmark and jump to its `magit-status' buffer." - (interactive) - (let ((labels (set/new "dotfiles" "universe" "depot")) - (all-labels (->> bookmark/whitelist - (list/map (>> bookmark-label)) - set/from-list))) - (prelude/assert (set/subset? labels all-labels)) - (ivy-read "Repository: " - (set/to-list labels) - :require-match t - :action (lambda (label) - (->> label - bookmark/from-label - bookmark-path - magit-status))))) - -;; TODO: Consider `ivy-read' extension that takes a list of structs, -;; `struct-to-label' and `label-struct' functions. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; API -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun bookmark/open (b) - "Open bookmark, B, in a new buffer or an ivy minibuffer." - (let ((path (bookmark-path b))) - (cond - ((f-directory? path) - (funcall bookmark/handle-directory path)) - ((f-file? path) - (funcall bookmark/handle-file path))))) - -(defun bookmark/ivy-open () - "Use ivy to filter available bookmarks." - (interactive) - (ivy-read "Bookmark: " - (->> bookmark/whitelist - (list/map #'bookmark-label)) - :require-match t - :action (lambda (label) - (bookmark/open (bookmark/from-label label))))) - -(when bookmark/install-kbds? - (general-define-key - :prefix "" - :states '(normal) - "jj" #'bookmark/ivy-open) - (->> bookmark/whitelist - (list/map - (lambda (b) - (general-define-key - :prefix "" - :states '(normal) - (string/concat "j" (bookmark-kbd b)) - ;; TODO: Consider `cl-labels' so `which-key' minibuffer is more - ;; helpful. - (lambda () (interactive) (bookmark/open b)))))) - (general-define-key - :states '(normal) - :prefix "" - "gS" #'bookmark/magit-status)) - -(provide 'bookmark) -;;; bookmark.el ends here diff --git a/configs/shared/.emacs.d/wpc/buffer.el b/configs/shared/.emacs.d/wpc/buffer.el deleted file mode 100644 index d388818e58..0000000000 --- a/configs/shared/.emacs.d/wpc/buffer.el +++ /dev/null @@ -1,198 +0,0 @@ -;;; buffer.el --- Working with Emacs buffers -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Utilities for CRUDing buffers in Emacs. -;; -;; Many of these functions may seem unnecessary especially when you consider -;; there implementations. In general I believe that Elisp suffers from a -;; library disorganization problem. Providing simple wrapper functions that -;; rename functions or reorder parameters is worth the effort in my opinion if -;; it improves discoverability (via intuition) and improve composability. -;; -;; I support three ways for switching between what I'm calling "source code -;; buffers": -;; 1. Toggling previous: -;; 2. Using `ivy-read': b -;; TODO: These obscure evil KBDs. Maybe a hydra definition would be best? -;; 3. Cycling (forwards/backwards): C-f, C-b - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'prelude) -(require 'maybe) -(require 'set) -(require 'cycle) -(require 'struct) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst buffer/enable-tests? t - "When t, run the test suite.") - -(defconst buffer/install-kbds? t - "When t, install the keybindings defined herein.") - -(defconst buffer/source-code-blacklist - (set/new 'dired-mode - 'erc-mode - 'magit-status-mode - 'magit-process-mode - 'magit-log-mode - 'org-mode - 'fundamental-mode) - "A blacklist of major-modes to ignore for listing source code buffers.") - -(defconst buffer/source-code-timeout 2 - "Number of seconds to wait before invalidating the cycle.") - -(cl-defstruct source-code-cycle cycle last-called) - -(defun buffer/emacs-generated? (name) - "Return t if buffer, NAME, is an Emacs-generated buffer. -Some buffers are Emacs-generated but are surrounded by whitespace." - (let ((trimmed (s-trim name))) - (and (s-starts-with? "*" trimmed)))) - -(defun buffer/find (buffer-or-name) - "Find a buffer by its BUFFER-OR-NAME." - (get-buffer buffer-or-name)) - -(defun buffer/major-mode (name) - "Return the active `major-mode' in buffer, NAME." - (with-current-buffer (buffer/find name) - major-mode)) - -(defun buffer/source-code-buffers () - "Return a list of source code buffers. -This will ignore Emacs-generated buffers, like *Messages*. It will also ignore - any buffer whose major mode is defined in `buffer/source-code-blacklist'." - (->> (buffer-list) - (list/map #'buffer-name) - (list/reject #'buffer/emacs-generated?) - (list/reject (lambda (name) - (set/contains? (buffer/major-mode name) - buffer/source-code-blacklist))))) - -(defvar buffer/source-code-cycle-state - (make-source-code-cycle - :cycle (cycle/from-list (buffer/source-code-buffers)) - :last-called (ts-now)) - "State used to manage cycling between source code buffers.") - -(defun buffer/exists? (name) - "Return t if buffer, NAME, exists." - (maybe/some? (buffer/find name))) - -(defun buffer/new (name) - "Return a newly created buffer NAME." - (generate-new-buffer name)) - -(defun buffer/find-or-create (name) - "Find or create buffer, NAME. -Return a reference to that buffer." - (let ((x (buffer/find name))) - (if (maybe/some? x) - x - (buffer/new name)))) - -;; TODO: Should this consume: `display-buffer' or `switch-to-buffer'? -(defun buffer/show (buffer-or-name) - "Display the BUFFER-OR-NAME, which is either a buffer reference or its name." - (display-buffer buffer-or-name)) - -;; TODO: Move this and `buffer/cycle-prev' into a separate module that -;; encapsulates all of this behavior. - -(defun buffer/cycle (cycle-fn) - "Cycle forwards or backwards through `buffer/source-code-buffers'." - (let ((last-called (source-code-cycle-last-called - buffer/source-code-cycle-state)) - (cycle (source-code-cycle-cycle - buffer/source-code-cycle-state))) - (if (> (ts-diff (ts-now) last-called) - buffer/source-code-timeout) - (progn - (struct/set! source-code-cycle - cycle - (cycle/from-list (buffer/source-code-buffers)) - buffer/source-code-cycle-state) - (let ((cycle (source-code-cycle-cycle - buffer/source-code-cycle-state))) - (funcall cycle-fn cycle) - (switch-to-buffer (cycle/current cycle))) - (struct/set! source-code-cycle - last-called - (ts-now) - buffer/source-code-cycle-state)) - (progn - (funcall cycle-fn cycle) - (switch-to-buffer (cycle/current cycle)))))) - -(defun buffer/cycle-next () - "Cycle forward through the `buffer/source-code-buffers'." - (interactive) - (buffer/cycle #'cycle/next)) - -(defun buffer/cycle-prev () - "Cycle backward through the `buffer/source-code-buffers'." - (interactive) - (buffer/cycle #'cycle/prev)) - -(defun buffer/ivy-source-code () - "Use `ivy-read' to choose among all open source code buffers." - (interactive) - (ivy-read "Source code buffer: " - (-drop 1 (buffer/source-code-buffers)) - :sort nil - :action #'switch-to-buffer)) - -(defun buffer/show-previous () - "Call `switch-to-buffer' on the previously visited buffer. -This function ignores Emacs-generated buffers, i.e. the ones that look like - this: *Buffer*. It also ignores buffers that are `dired-mode' or `erc-mode'. - This blacklist can easily be changed." - (interactive) - (let* ((xs (buffer/source-code-buffers)) - (candidate (list/get 1 xs))) - (prelude/assert (maybe/some? candidate)) - (switch-to-buffer candidate))) - -(when buffer/install-kbds? - (general-define-key - :states '(normal) - "C-f" #'buffer/cycle-next - "C-b" #'buffer/cycle-prev) - (general-define-key - :prefix "" - :states '(normal) - "b" #'buffer/ivy-source-code - "" #'buffer/show-previous - "k" #'kill-buffer)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Tests -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(when buffer/enable-tests? - (prelude/assert - (list/all? #'buffer/emacs-generated? - '("*scratch*" - "*Messages*" - "*shell*" - "*Shell Command Output*" - "*Occur*" - "*Warnings*" - "*Help*" - "*Completions*" - "*Apropos*" - "*info*")))) - -(provide 'buffer) -;;; buffer.el ends here diff --git a/configs/shared/.emacs.d/wpc/bytes.el b/configs/shared/.emacs.d/wpc/bytes.el deleted file mode 100644 index d8bd2e2886..0000000000 --- a/configs/shared/.emacs.d/wpc/bytes.el +++ /dev/null @@ -1,109 +0,0 @@ -;;; bytes.el --- Working with byte values -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Functions to help with human-readable representations of byte values. -;; -;; Usage: -;; See the test cases for example usage. Or better yet, I should use a type of -;; structured documentation that would allow me to expose a view into the test -;; suite here. Is this currently possible in Elisp? -;; -;; API: -;; - serialize :: Integer -> String -;; -;; Wish list: -;; - Rounding: e.g. (bytes (* 1024 1.7)) => "2KB" - -;;; Code: - -;; TODO: Support -ibabyte variants like Gibibyte (GiB). - -;; Ranges: -;; B: [ 0, 1e3) -;; KB: [ 1e3, 1e6) -;; MB: [ 1e6, 1e6) -;; GB: [ 1e9, 1e12) -;; TB: [1e12, 1e15) -;; PB: [1e15, 1e18) -;; -;; Note: I'm currently not support exabytes because that causes the integer to -;; overflow. I imagine a larger integer type may exist, but for now, I'll -;; treat this as a YAGNI. - -(require 'prelude) -(require 'tuple) -(require 'math) -(require 'number) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Constants -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst bytes/kb (math/exp 2 10) - "Number of bytes in a kilobyte.") - -(defconst bytes/mb (math/exp 2 20) - "Number of bytes in a megabytes.") - -(defconst bytes/gb (math/exp 2 30) - "Number of bytes in a gigabyte.") - -(defconst bytes/tb (math/exp 2 40) - "Number of bytes in a terabyte.") - -(defconst bytes/pb (math/exp 2 50) - "Number of bytes in a petabyte.") - -(defconst bytes/eb (math/exp 2 60) - "Number of bytes in an exabyte.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun bytes/classify (x) - "Return unit that closest fits byte count, X." - (prelude/assert (number/whole? x)) - (cond - ((and (>= x 0) (< x bytes/kb)) 'byte) - ((and (>= x bytes/kb) (< x bytes/mb)) 'kilobyte) - ((and (>= x bytes/mb) (< x bytes/gb)) 'megabyte) - ((and (>= x bytes/gb) (< x bytes/tb)) 'gigabyte) - ((and (>= x bytes/tb) (< x bytes/pb)) 'terabyte) - ((and (>= x bytes/pb) (< x bytes/eb)) 'petabyte))) - -(defun bytes/to-string (x) - "Convert integer X into a human-readable string." - (let ((base-and-unit - (pcase (bytes/classify x) - ('byte (tuple/from 1 "B")) - ('kilobyte (tuple/from bytes/kb "KB")) - ('megabyte (tuple/from bytes/mb "MB")) - ('gigabyte (tuple/from bytes/gb "GB")) - ('terabyte (tuple/from bytes/tb "TB")) - ('petabyte (tuple/from bytes/pb "PB"))))) - (string/format "%d%s" - (round x (tuple/first base-and-unit)) - (tuple/second base-and-unit)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Tests -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(progn - (prelude/assert - (equal "1000B" (bytes/to-string 1000))) - (prelude/assert - (equal "2KB" (bytes/to-string (* 2 bytes/kb)))) - (prelude/assert - (equal "17MB" (bytes/to-string (* 17 bytes/mb)))) - (prelude/assert - (equal "419GB" (bytes/to-string (* 419 bytes/gb)))) - (prelude/assert - (equal "999TB" (bytes/to-string (* 999 bytes/tb)))) - (prelude/assert - (equal "2PB" (bytes/to-string (* 2 bytes/pb))))) - -(provide 'bytes) -;;; bytes.el ends here diff --git a/configs/shared/.emacs.d/wpc/cache.el b/configs/shared/.emacs.d/wpc/cache.el deleted file mode 100644 index 7b7e1aa2a3..0000000000 --- a/configs/shared/.emacs.d/wpc/cache.el +++ /dev/null @@ -1,80 +0,0 @@ -;;; cache.el --- Caching things -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; An immutable cache data structure. -;; -;; This is like a sideways stack, that you can pull values out from and re-push -;; to the top. It'd be like a stack supporting push, pop, pull. -;; -;; This isn't a key-value data-structure like you might expect from a -;; traditional cache. The name is subject to change, but the underlying idea of -;; a cache remains the same. -;; -;; Think about prescient.el, which uses essentially an LRU cache integrated into -;; counsel to help create a "clairovoyant", self-organizing list. -;; -;; Use-cases: -;; - Keeps an cache of workspaces sorted as MRU with an LRU eviction strategy. - -;;; Code: - -(require 'prelude) -(require 'struct) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(cl-defstruct cache xs) - -;; TODO: Prefer another KBD for yasnippet form completion than company-mode's -;; current KBD. - -(defun cache/from-list (xs) - "Turn list, XS, into a cache." - (make-cache :xs xs)) - -(defun cache/contains? (x xs) - "Return t if X in XS." - (->> xs - cache-xs - (list/contains? x))) - -(defun cache/touch (x xs) - "Ensure value X in cache, XS, is front of the list. -If X isn't in XS (using `equal'), insert it at the front." - (struct/update - cache - xs - (>> (list/reject (lambda (y) (equal x y))) - (list/cons x)) - xs)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Tests -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(progn - (let ((cache (cache/from-list '("chicken" "nugget")))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; contains?/2 - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (prelude/refute - (cache/contains? "turkey" cache)) - (prelude/assert - (cache/contains? "chicken" cache)) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; touch/2 - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (prelude/assert - (equal - (cache/touch "nugget" cache) - (cache/from-list '("nugget" "chicken")))) - (prelude/assert - (equal - (cache/touch "spicy" cache) - (cache/from-list '("spicy" "chicken" "nugget")))))) - -(provide 'cache) -;;; cache.el ends here diff --git a/configs/shared/.emacs.d/wpc/chrome.el b/configs/shared/.emacs.d/wpc/chrome.el deleted file mode 100644 index 133c7af355..0000000000 --- a/configs/shared/.emacs.d/wpc/chrome.el +++ /dev/null @@ -1,82 +0,0 @@ -;;; chrome.el --- Helpers for Google Chrome -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Some helper functions for working with Google Chrome. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'macros) -(require 'alist) -(require 'list) -(require 'general) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defvar chrome/install-kbds? t - "If t, install keybinding.") - -;; TODO: Consider modelling this as a rose-tree that can nest itself -;; arbitrarily. -;; TODO: Consider exporting existing chrome bookmarks. -(defconst chrome/label->url - '(("Google" . "www.google.com") - ("Hacker News" . "news.ycombinator.com") - ("Gmail" . "www.gmail.com") - ("WhatsApp" . "web.whatsapp.com") - ("Google Chat" . "chat/") - ("Google Calendar" . "calendar/") - ("Teknql" . "teknql.slack.com/messages") - ("Twitter" . "twitter.com")) - "Mapping labels to urls for my bookmarks.") - -(defconst chrome/splash-pages - '("Google Calendar" - "Gmail" - "Google Chat" - "WhatsApp" - "Teknql") - "The pages that should open when I open Chrome.") - -;; TODO: Add defensive check to start chrome if it isn't already open. - -;; TODO: Support option to create new session even if one already exists. - -(defun chrome/open-splash-pages () - "Opens Chrome with my preferred splash pages." - (interactive) - (->> chrome/splash-pages - (-map (lambda (x) (alist/get x chrome/label->url))) - chrome/open-urls)) - -;; TODO: Support optional kwargs. -(cl-defun chrome/open-url (url &key new-window?) - "Opens `URL' in google-chrome. -Will open without toolbars if APP-MODE? is t." - (shell-command (s-concat - "google-chrome " - (if new-window? "--new-window " "") - url))) - -(defun chrome/open-urls (urls) - "Open multiple `URLS' in chrome." - (chrome/open-url - (list/join " " urls))) - -(defun chrome/browse () - "Display a counsel window for browsing URLs." - (interactive) - (ivy-read - "URL: " - chrome/label->url - :action (lambda (entry) - (chrome/open-url (cdr entry))))) - -(provide 'chrome) -;;; chrome.el ends here diff --git a/configs/shared/.emacs.d/wpc/clipboard.el b/configs/shared/.emacs.d/wpc/clipboard.el deleted file mode 100644 index 0688c9d87f..0000000000 --- a/configs/shared/.emacs.d/wpc/clipboard.el +++ /dev/null @@ -1,44 +0,0 @@ -;;; clipboard.el --- Working with X11's pasteboard -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Simple functions for copying and pasting. -;; -;; Integrate with bburns/clipmon so that System Clipboard can integrate with -;; Emacs's kill-ring. -;; -;; Wish list: -;; - Create an Emacs integration with github.com/cdown/clipmenud. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'prelude) -(require 'ivy-clipmenu) - -(prelude/assert (prelude/executable-exists? "clipmenu")) -(prelude/assert (prelude/executable-exists? "clipmenud")) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(cl-defun clipboard/copy (x &key (message "[clipboard.el] Copied!")) - "Copy string, X, to X11's clipboard." - (kill-new x) - (message message)) - -(cl-defun clipboard/paste (&key (message "[clipboard.el] Pasted!")) - "Paste contents of X11 clipboard." - (yank) - (message message)) - -(defun clipboard/contents () - "Return the contents of the clipboard as a string." - (substring-no-properties (current-kill 0))) - -(provide 'clipboard) -;;; clipboard.el ends here diff --git a/configs/shared/.emacs.d/wpc/colorscheme.el b/configs/shared/.emacs.d/wpc/colorscheme.el deleted file mode 100644 index 830fc5ac3e..0000000000 --- a/configs/shared/.emacs.d/wpc/colorscheme.el +++ /dev/null @@ -1,96 +0,0 @@ -;;; colorscheme.el --- Syntax highlight and friends -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; -;; TODO: Clarify this. -;; Since I have my own definition of "theme", which couples wallpaper, font, -;; with Emacs's traditional notion of the word "theme", I'm choosing to use -;; "colorscheme" to refer to *just* the notion of syntax highlight etc. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'cycle) -(require 'general) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Constants -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defcustom colorscheme/install-kbds? t - "If non-nil, enable the keybindings.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defcustom colorscheme/whitelist - (cycle/from-list - (->> (custom-available-themes) - (list/map #'symbol-name) - (list/filter (>> (s-starts-with? "doom-"))) - (list/map #'intern))) - "The whitelist of colorschemes through which to cycle.") - -(defun colorscheme/current () - "Return the currently enabled colorscheme." - (cycle/current colorscheme/whitelist)) - -(defun colorscheme/disable-all () - "Disable all currently enabled colorschemes." - (interactive) - (->> custom-enabled-themes - (list/map #'disable-theme))) - -(defun colorscheme/set (theme) - "Call `load-theme' with `THEME', ensuring that the line numbers are bright. -There is no hook that I'm aware of to handle this more elegantly." - (load-theme theme t) - (prelude/set-line-number-color "#da5468")) - -(defun colorscheme/whitelist-set (colorscheme) - "Focus the COLORSCHEME in the `colorscheme/whitelist' cycle." - (cycle/focus (lambda (x) (equal x colorscheme)) colorscheme/whitelist) - (colorscheme/set (colorscheme/current))) - -(defun colorscheme/ivy-select () - "Load a colorscheme using ivy." - (interactive) - (let ((theme (ivy-read "Theme: " (cycle/to-list colorscheme/whitelist)))) - (colorscheme/disable-all) - (colorscheme/set (intern theme)))) - -(cl-defun colorscheme/cycle (&key forward?) - "Cycle next if `FORWARD?' is non-nil. -Cycle prev otherwise." - (disable-theme (cycle/current colorscheme/whitelist)) - (let ((theme (if forward? - (cycle/next colorscheme/whitelist) - (cycle/prev colorscheme/whitelist)))) - (colorscheme/set theme) - (message (s-concat "Active theme: " (symbol/to-string theme))))) - -(defun colorscheme/next () - "Disable the currently active theme and load the next theme." - (interactive) - (colorscheme/cycle :forward? t)) - -(defun colorscheme/prev () - "Disable the currently active theme and load the previous theme." - (interactive) - (colorscheme/cycle :forward? nil)) - -;; Keybindings -(when colorscheme/install-kbds? - (general-define-key - :prefix "" - :states '(normal) - "Ft" #'colorscheme/next - "Pt" #'colorscheme/prev)) - -(provide 'colorscheme) -;;; colorscheme.el ends here diff --git a/configs/shared/.emacs.d/wpc/constants.el b/configs/shared/.emacs.d/wpc/constants.el deleted file mode 100644 index 5bfedf5553..0000000000 --- a/configs/shared/.emacs.d/wpc/constants.el +++ /dev/null @@ -1,41 +0,0 @@ -;;; constants.el --- Constants for organizing my Emacs -*- lexical-binding: t -*- -;; Authpr: William Carroll - -;;; Commentary: -;; This file contains constants that are shared across my configuration. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'prelude) -(require 'f) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Configuration -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO: Consider merging `ui.el' and `misc.el' because those are the only -;; current consumers of these constants, and I'm unsure if the indirection that -;; globally defined constants introduces is worth it. - -(defconst constants/current-project "~/universe" - "Variable holding the directory for my currently active project.") - -(prelude/assert (f-directory? constants/current-project)) - -(defconst constants/mouse-kbds - '([mouse-1] [down-mouse-1] [drag-mouse-1] [double-mouse-1] [triple-mouse-1] - [mouse-2] [down-mouse-2] [drag-mouse-2] [double-mouse-2] [triple-mouse-2] - [mouse-3] [down-mouse-3] [drag-mouse-3] [double-mouse-3] [triple-mouse-3] - [mouse-4] [down-mouse-4] [drag-mouse-4] [double-mouse-4] [triple-mouse-4] - [mouse-5] [down-mouse-5] [drag-mouse-5] [double-mouse-5] [triple-mouse-5]) - "All of the mouse-related keybindings that Emacs recognizes.") - -(defconst constants/fill-column 80 - "Variable used to set the defaults for wrapping, highlighting, etc.") - -(provide 'constants) -;;; constants.el ends here diff --git a/configs/shared/.emacs.d/wpc/cycle.el b/configs/shared/.emacs.d/wpc/cycle.el deleted file mode 100644 index 9475ddd996..0000000000 --- a/configs/shared/.emacs.d/wpc/cycle.el +++ /dev/null @@ -1,155 +0,0 @@ -;;; cycle.el --- Simple module for working with cycles. -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Something like this may already exist, but I'm having trouble finding it, and -;; I think writing my own is a nice exercise for learning more Elisp. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'prelude) -(require 'math) -(require 'maybe) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Wish list -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; - TODO: Provide immutable variant. -;; - TODO: Replace mutable consumption with immutable variant. -;; - TODO: Replace indexing with (math/mod current cycle). - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; `current-index' tracks the current index -;; `xs' is the original list -(cl-defstruct cycle current-index previous-index xs) - -(defconst cycle/enable-tests? t - "When t, run the tests defined herein.") - -(defun cycle/new (&rest xs) - "Create an empty cycle." - (make-cycle :current-index 0 - :previous-index nil - :xs xs)) - -(defun cycle/from-list (xs) - "Create a cycle from a list of `XS'." - (make-cycle :current-index 0 - :previous-index nil - :xs xs)) - -(defun cycle/to-list (xs) - "Return the list representation of a cycle, XS." - (cycle-xs xs)) - -(defun next-index<- (lo hi x) - "Return the next index in a cycle when moving downwards. -- `LO' is the lower bound. -- `HI' is the upper bound. -- `X' is the current index." - (if (< (- x 1) lo) - (- hi 1) - (- x 1))) - -(defun next-index-> (lo hi x) - "Return the next index in a cycle when moving upwards. -- `LO' is the lower bound. -- `HI' is the upper bound. -- `X' is the current index." - (if (>= (+ 1 x) hi) - lo - (+ 1 x))) - -(defun cycle/previous-focus (cycle) - "Return the previously focused entry in CYCLE." - (let ((i (cycle-previous-index cycle))) - (if (maybe/some? i) - (nth i (cycle-xs cycle)) - nil))) - -;; TODO: Consider adding "!" to the function name herein since many of them -;; mutate the collection, and the APIs are beginning to confuse me. -(defun cycle/focus-previous! (xs) - "Jump to the item in XS that was most recently focused; return the cycle. -This will error when previous-index is nil. This function mutates the -underlying struct." - (let ((i (cycle-previous-index xs))) - (if (maybe/some? i) - (progn - (cycle/jump i xs) - (cycle/current xs)) - (error "Cannot focus the previous element since cycle-previous-index is nil")))) - -(defun cycle/next (xs) - "Return the next value in `XS' and update `current-index'." - (let* ((current-index (cycle-current-index xs)) - (next-index (next-index-> 0 (cycle/count xs) current-index))) - (struct/set! cycle previous-index current-index xs) - (struct/set! cycle current-index next-index xs) - (nth next-index (cycle-xs xs)))) - -(defun cycle/prev (xs) - "Return the previous value in `XS' and update `current-index'." - (let* ((current-index (cycle-current-index xs)) - (next-index (next-index<- 0 (cycle/count xs) current-index))) - (struct/set! cycle previous-index current-index xs) - (struct/set! cycle current-index next-index xs) - (nth next-index (cycle-xs xs)))) - -(defun cycle/current (cycle) - "Return the current value in `CYCLE'." - (nth (cycle-current-index cycle) (cycle-xs cycle))) - -(defun cycle/count (cycle) - "Return the length of `xs' in `CYCLE'." - (length (cycle-xs cycle))) - -(defun cycle/jump (i xs) - "Jump to the I index of XS." - (let ((current-index (cycle-current-index xs)) - (next-index (math/mod i (cycle/count xs)))) - (struct/set! cycle previous-index current-index xs) - (struct/set! cycle current-index next-index xs)) - xs) - -(defun cycle/focus (p cycle) - "Focus the element in CYCLE for which predicate, P, is t." - (let ((i (->> cycle - cycle-xs - (-find-index p)))) - (if i - (cycle/jump i cycle) - (error "No element in cycle matches predicate")))) - -(defun cycle/contains? (x xs) - "Return t if cycle, XS, has member X." - (->> xs - cycle-xs - (list/contains? x))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Tests -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(when cycle/enable-tests? - (let ((xs (cycle/new 1 2 3))) - (prelude/assert (maybe/nil? (cycle/previous-focus xs))) - (prelude/assert (= 1 (cycle/current xs))) - (prelude/assert (= 2 (cycle/next xs))) - (prelude/assert (= 1 (cycle/previous-focus xs))) - (prelude/assert (= 1 (->> xs (cycle/jump 0) cycle/current))) - (prelude/assert (= 2 (->> xs (cycle/jump 1) cycle/current))) - (prelude/assert (= 3 (->> xs (cycle/jump 2) cycle/current))) - (prelude/assert (= 2 (cycle/previous-focus xs))) - (prelude/assert (= 2 (cycle/focus-previous! xs))))) - -(provide 'cycle) -;;; cycle.el ends here diff --git a/configs/shared/.emacs.d/wpc/device.el b/configs/shared/.emacs.d/wpc/device.el deleted file mode 100644 index 03eb55beb7..0000000000 --- a/configs/shared/.emacs.d/wpc/device.el +++ /dev/null @@ -1,38 +0,0 @@ -;;; device.el --- Physical device information -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Functions for querying device information. - -;;; Code: - -(require 'dash) -(require 'alist) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst device/hostname->device - '(("zeno.lon.corp.google.com" . work-desktop) - ("seneca" . work-laptop)) - "Mapping hostname to a device symbol.") - -;; TODO: Should I generate these predicates? - -(defun device/classify () - "Return the device symbol for the current host or nil if not supported." - (alist/get system-name device/hostname->device)) - -(defun device/work-laptop? () - "Return t if current device is work laptop." - (equal 'work-laptop - (device/classify))) - -(defun device/work-desktop? () - "Return t if current device is work desktop." - (equal 'work-desktop - (device/classify))) - -(provide 'device) -;;; device.el ends here diff --git a/configs/shared/.emacs.d/wpc/display.el b/configs/shared/.emacs.d/wpc/display.el deleted file mode 100644 index 8e5b890303..0000000000 --- a/configs/shared/.emacs.d/wpc/display.el +++ /dev/null @@ -1,98 +0,0 @@ -;;; display.el --- Working with single or multiple displays -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Mostly wrappers around xrandr. -;; -;; TODO: Look into autorandr to see if it could be useful. -;; -;; Troubleshooting: -;; The following commands help me when I (infrequently) interact with xrandr. -;; - xrandr --listmonitors -;; - xrandr --query - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'prelude) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Constants -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst display/install-kbds? t - "When t, install the keybindings defined in this module.") - -;; TODO: Consider if this logic should be conditioned by `device/work-laptop?'. -(defconst display/laptop-monitor "eDP1" - "The xrandr identifier for my primary screen (on work laptop).") - -;; TODO: Why is HDMI-1, eDP-1 sometimes and HDMI1, eDP1 other times. -(defconst display/4k-monitor "HDMI1" - "The xrandr identifer for my 4K monitor.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO: Debug why something this scales to 4k appropriately and other times it -;; doesn't. -(defun display/enable-4k () - "Attempt to connect to my 4K monitor." - (interactive) - (prelude/start-process - :name "display/enable-4k" - :command (string/format - "xrandr --output %s --above %s --primary --auto --dpi 144" - display/4k-monitor - display/laptop-monitor))) - -(defun display/disable-4k () - "Disconnect from the 4K monitor." - (interactive) - (prelude/start-process - :name "display/disable-4k" - :command (string/format "xrandr --output %s --off" - display/4k-monitor))) - -(defun display/enable-laptop () - "Turn the laptop monitor off. -Sometimes this is useful when I'm sharing my screen in a Google Hangout and I - only want to present one of my monitors." - (interactive) - (prelude/start-process - :name "display/disable-laptop" - :command (string/format "xrandr --output %s --auto" - display/laptop-monitor))) - -(defun display/disable-laptop () - "Turn the laptop monitor off. -Sometimes this is useful when I'm sharing my screen in a Google Hangout and I - only want to present one of my monitors." - (interactive) - (prelude/start-process - :name "display/disable-laptop" - :command (string/format "xrandr --output %s --off" - display/laptop-monitor))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Keybindings -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(when display/install-kbds? - (general-define-key - :prefix "" - :states '(normal) - "d0" #'display/disable-laptop - "d1" #'display/enable-laptop) - (general-define-key - :prefix "" - :states '(normal) - "D0" #'display/disable-4k - "D1" #'display/enable-4k)) - -(provide 'display) -;;; display.el ends here diff --git a/configs/shared/.emacs.d/wpc/do.el b/configs/shared/.emacs.d/wpc/do.el deleted file mode 100644 index 7dc2b260fd..0000000000 --- a/configs/shared/.emacs.d/wpc/do.el +++ /dev/null @@ -1,54 +0,0 @@ -;;; do.el --- Small assertion library for Elisp -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Assertion library inspired by Elixir's core testing library. -;; -;; The goal here is to create this module without relying on other non-core -;; Elisp libraries. I will attempt to do this as long as I'm not sacrificing -;; the readability of this code nor the ease at which it can be written. -;; -;; A note on testing: -;; Another goal with this library is to blur the line between testing code and -;; runtime code. Developers should ideally be using `do/assert' and `do/refute' -;; in their library code. Because of this, I'm avoiding referring -;; to the notion of testing in the names of these functions. -;; -;; Hypothesis: -;; The lower the friction is for writing tests, the more likely people will -;; write tests. - -;; TODO: Support better error messages, which might include information about -;; line numbers in source code where the assertion failed. - -;; TODO: Consider offering the ability to have some of these functions compile -;; to nothing at runtime if developers want to use them while developing without -;; incurring the costs at runtime. - -;; TODO: Consider using this module instead of prelude.el. Right now, I'm -;; having troubling preferring one to the other. The benefit of this module is -;; that it's independent of prelude, but that might also be a downside, since -;; the messaging that asserting should be a critical part of any core library -;; like prelude. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defmacro do/assert (x) - "Errors unless X is t. -These are strict assertions and purposely do not rely on truthiness." - (let ((as-string (format "%s" x))) - `(unless (equal t ,x) - (error (concat "Assertion failed: " ,as-string))))) - -(defmacro do/refute (x) - "Errors unless X is nil." - (let ((as-string (format "%s" x))) - `(unless (eq nil ,x) - (error (concat "Refutation failed: " ,as-string))))) - -(provide 'do) -;;; do.el ends here diff --git a/configs/shared/.emacs.d/wpc/dotfiles.el b/configs/shared/.emacs.d/wpc/dotfiles.el deleted file mode 100644 index 2e78cf2137..0000000000 --- a/configs/shared/.emacs.d/wpc/dotfiles.el +++ /dev/null @@ -1,53 +0,0 @@ -;;; dotfiles.el --- Elisp to make dotfile management -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Quickly edit commonly used files. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'macros) -(require 'f) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; API -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst dotfiles/install-kbds? t - "When t, install the keybindings.") - -(defconst dotfiles/whitelist - '(("compton" . "~/.config/compton.conf") - ("dotfiles" . "~/dotfiles/") - ("functions" . "~/functions.zsh") - ("aliases" . "~/aliases.zsh") - ("variables" . "~/variables.zsh") - ("Xresources" . "~/.Xresources.shared") - ("xsession" . "~/.xsessionrc.shared") - ("tmux" . "~/.tmux.conf") - ("zshrc" . "~/.zshrc") - ("config.fish" . "~/.config/fish/config.fish") - ("configuration.nix" . "~/Dropbox/programming/nixify/configuration.nix") - ("init.el" . "~/.emacs.d/init.el") - ("init.vim" . "~/.config/nvim/init.vim")) - "Dotfiles that I commonly edit.") - -(defun dotfiles/edit () - "Select a dotfile from ivy and edit it in an Emacs buffer." - (interactive) - (ivy-read - "Dotfile: " - dotfiles/whitelist - :action (>> cdr find-file))) - -(defun dotfiles/find-emacs-file (name) - "Call `find-file' on NAME located in dotfiles's emacs.d directory." - (find-file - (f-join "~/dotfiles/configs/shared/.emacs.d" name))) - -(provide 'dotfiles) -;;; dotfiles.el ends here diff --git a/configs/shared/.emacs.d/wpc/dotted.el b/configs/shared/.emacs.d/wpc/dotted.el deleted file mode 100644 index 90ef39f92e..0000000000 --- a/configs/shared/.emacs.d/wpc/dotted.el +++ /dev/null @@ -1,49 +0,0 @@ -;;; dotted.el --- Working with dotted pairs in Elisp -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Part of my primitives library extensions in Elisp. Contrast my primitives -;; with the wrapper extensions that I provide, which expose immutable variants -;; of data structures like an list, alist, tuple, as well as quasi-typeclasses -;; like sequence, etc. - -;;; Code: - -(require 'prelude) -(require 'macros) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(cl-defun dotted/new (&optional a b) - "Create a new dotted pair (i.e. cons cell)." - (cons a b)) - -(defun dotted/instance? (x) - "Return t if X is a dotted pair." - (let ((b (cdr x))) - (and b (atom b)))) - -(defun dotted/first (x) - "Return the first element of X." - (car x)) - -(defun dotted/second (x) - "Return the second element of X." - (cdr x)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Tests -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(progn - (prelude/assert - (equal '(fname . "Bob") (dotted/new 'fname "Bob"))) - (prelude/assert - (dotted/instance? '(one . two))) - (prelude/refute - (dotted/instance? '(1 2 3)))) - -(provide 'dotted) -;;; dotted.el ends here diff --git a/configs/shared/.emacs.d/wpc/email.el b/configs/shared/.emacs.d/wpc/email.el deleted file mode 100644 index 6a266a717c..0000000000 --- a/configs/shared/.emacs.d/wpc/email.el +++ /dev/null @@ -1,11 +0,0 @@ -;;; email.el --- My Emacs email settings -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Attempting to configure to `notmuch' for my personal use. - -;;; Code: -(message "Not implemented.") - -(provide 'email) -;;; email.el ends here diff --git a/configs/shared/.emacs.d/wpc/entr.el b/configs/shared/.emacs.d/wpc/entr.el deleted file mode 100644 index ac2a5812c3..0000000000 --- a/configs/shared/.emacs.d/wpc/entr.el +++ /dev/null @@ -1,115 +0,0 @@ -;;; entr.el --- Working with terminals and entr -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Help make watch commands easier. -;; -;; This should be entirely temporary because in reality we should be able to use -;; Emacs's buffer watching abilities to run commands. -;; TODO: Explore Emacs integration that obviates `entr`. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'f) -(require 'buffer) -(require 'prelude) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO: Support a generic file-watcher for commonly used languages. -(defconst entr/major-mode->save-handler - '((python-mode . entr/handle-python3)) - "Mapping of language to the `after-save-hook' function it should register.") - -(defun entr/shell-command-to-buffer (cmd name) - "Run CMD in a shell and output to the buffer NAME. -The buffer is a find-or-create operation. -The buffer is erased between runs with `erase-buffer'." - (let ((b (buffer/find-or-create name))) - (with-current-buffer b (erase-buffer)) - (shell-command cmd b) - (buffer/show b))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Python -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO: This should be a top-level function. -(defconst entr/handle-python3 - (lambda () - (entr/shell-command-to-buffer - (format "python3 %s" (buffer-file-name)) - "*python3*")) - "Function that is registered as the `after-save-hook' for python3.") - -(defun entr/register-python3 () - "Register a buffer-local `after-save-hook' for calling python3 with filename." - (interactive) - (add-hook 'after-save-hook entr/handle-python3 nil t)) - -(defun entr/deregister-python3 () - "Remove the buffer-local `after-save-hook' for python3." - (interactive) - (remove-hook 'after-save-hook entr/handle-python3 t)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Protobuf -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun entr/format-protobuf () - "Formats a protobuf buffer." - (call-interactively #'clang-format)) - -;; TODO: Run this automatically with .proto file extensions. Do this after -;; verifying that `clang-format' complies with Google's style guide. -(defun entr/register-protobuf () - "Register a buffer-local `before-save-hook' for formatting protobuf buffers." - (interactive) - (add-hook - 'before-save-hook - #'entr/format-protobuf - nil - t)) - -;; TODO: Is there an interactive way to remove hooks in Emacs? -(defun entr/deregister-protobuf () - "Remove the buffer-local `before-save-hook' for protobuf." - (interactive) - (remove-hook - 'before-save-hook - #'entr/format-protobuf - t)) - -;; TODO: Support this. Currently the `intern' call is the problem. -;; (defun entr/ivy-remove-hook (hook) -;; "Use Counsel to remove a handler from HOOK." -;; (interactive) -;; (ivy-read -;; "Remove hook: " -;; (intern (prelude/prompt "Hook name: ")) -;; :action (lambda (x) (message x)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Miscellaneous -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun entr/command (command) - "Create a terminal instance with entr running COMMAND. -COMMAND is a function that is called with the current filename." - ;; Algorithm: - ;; - Get buffer's filename. - ;; - Open terminator running: `echo entr | entr `. - (interactive) - (with-current-buffer (current-buffer) - (let ((filename (buffer-file-name))) - (prelude/inspect - (format "echo %s | entr %s" filename (funcall command filename)))))) - -(provide 'entr) -;;; entr.el ends here diff --git a/configs/shared/.emacs.d/wpc/enum.el b/configs/shared/.emacs.d/wpc/enum.el deleted file mode 100644 index 078e797209..0000000000 --- a/configs/shared/.emacs.d/wpc/enum.el +++ /dev/null @@ -1,98 +0,0 @@ -;;; enum.el --- Enumerable protocol for Elisp -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Heavily influenced by Elixir. - -;; I will not be implement every function in the Enum library, since I don't -;; need every function. Some of the streaming functionality may prove difficult -;; to write in Elisp. We shall see. - -;; TODO: Implement the following functions: -;; - all?/2 -;; - any?/2 -;; - at/3 -;; - chunk_by/2 -;; - chunk_every/{2,3,4} -;; - chunk_while/4 -;; - concat/1 -;; - concat/2 -;; - count/{1,2} -;; - dedup/1 # prefer calling this function dedupe -;; - dedup_by/2 # same as above -;; - drop/2 -;; - drop_every/2 -;; - drop_while/2 -;; - each/2 -;; - empty?/1 -;; - fetch/2 -;; - fetch!/2 -;; - filter/2 -;; - find/3 -;; - find_index/2 -;; - find_value/3 -;; - flat_map/2 -;; - flat_map_reduce/3 -;; - group_by/3 -;; - intersperse/2 -;; - into/{2,3} -;; - join/2 -;; - map/2 -;; - map_every/3 -;; - map_join/3 -;; - map_reduce/3 -;; - max/2 -;; - max_by/3 -;; - member?/2 # consider calling this contains? -;; - min/2 -;; - min_by/2 -;; - min_max/2 # This is a great function because of O(n) time. -;; - min_max_by/3 -;; - random/1 # Consider just sample with num=1 -;; - reduce/{2,3} -;; - reduce_while/3 -;; - reject/2 -;; - reverse/{1,2} -;; - reverse_slice/3 -;; - scan/{2,3} -;; - shuffle/1 -;; - slice/{2,3} -;; - sort/{1,2} -;; - sort/2 -;; - sort_by/3 -;; - split/2 -;; - split_while/2 -;; - split_with/2 -;; - sum/1 -;; - take/2 -;; - take_every/2 -;; - take_random/2 # prefer calling this function sample -;; - take_while/2 -;; - to_list/1 -;; - uniq/1 # prefer calling this unique -;; - uniq_by/2 # prefer calling this unique-by -;; - unzip/1 -;; - with_index/2 -;; - zip/{1,2} - -;; TODO: Consider how to handle dispatching by type. - -;; TODO: Which types should be supported herein? -;; - linked-lists -;; - associative-lists -;; - cycles - -;; Warning: This module is a total work-in-progress, and it's quite possible -;; that I may never even finish it. - -;;; Code: - -(defun enum/count (xs) - "Return the number of elements in `XS'." - (cond - ((alist/instance? xs) (alist/count xs)) - ((list/instance? xs) (list/length xs))) - ) - -(provide 'enum) -;;; enum.el ends here diff --git a/configs/shared/.emacs.d/wpc/finance.el b/configs/shared/.emacs.d/wpc/finance.el deleted file mode 100644 index b124061ccb..0000000000 --- a/configs/shared/.emacs.d/wpc/finance.el +++ /dev/null @@ -1,119 +0,0 @@ -;;; finance.el --- Functions to help me organize my finances -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Using functions to organize my financial thinking. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'prelude) -(require 'math) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defvar finance/enable-tests? t - "When t, run the tests defined herein.") - -;; TODO: Support printing an org-table of these amount in a similar format to: -;; https://keisan.casio.com/exec/system/1234231998 -(cl-defun finance/future-value (amt - &key - num-years - (frequency 'monthly) - (interest-rate 0.06) - (payment-due-at 'beg) - (present-value 0)) - "Compute the Future Value of AMT. - -This function assumes that the interest rate is applied annually and not -monthly. - -This function will attempt to provide the following defaults: -- frequency: 'monthly -- interest-rate: 6% -- payment-due-at: 'beg -- present-value: 0.00" - (prelude/assert (set/contains? payment-due-at (set/new 'beg 'end))) - (prelude/assert (set/contains? frequency (set/new 'annually - 'semiannually - 'quarterly - 'monthly))) - (let ((pmt amt) - (k (alist/get frequency '((annually . 1) - (semiannually . 2) - (quarterly . 4) - (monthly . 12)))) - (r interest-rate) - (n num-years) - (pv present-value)) - (if (= 0 r) - (+ pv (* pmt n k)) - (if (equal 'beg payment-due-at) - (+ (* pv (math/exp (+ 1 (/ r k)) (* n k))) - (* pmt - (/ (- (math/exp (+ 1 (/ r k)) (* n k)) 1) - (/ r k)) - (+ 1 (/ r k)))) - (+ (* pv (math/exp (+ 1 (/ r k)) (* n k))) - (* pmt - (/ (- (math/exp (+ 1 (/ r k)) (* n k)) 1) - (/ r k)))))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Tests -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(when finance/enable-tests? - (prelude/assert - (equal "1551.27" - (string/format "%0.2f" - (finance/future-value - 9.99 - :interest-rate 0.05 - :num-years 10 - :frequency 'monthly - :payment-due-at 'end - :present-value 0)))) - (prelude/assert - (equal "14318.34" - (string/format "%0.2f" - (finance/future-value 10.0 :num-years 35)))) - (prelude/assert - (equal "4200.00" - (string/format "%0.2f" - (finance/future-value - 10.0 - :interest-rate 0.0 - :num-years 35 - :frequency 'monthly - :payment-due-at 'beg - :present-value 0)))) - (prelude/assert - (equal "14318.34" - (string/format "%0.2f" - (finance/future-value - 10.0 - :interest-rate 0.06 - :num-years 35 - :frequency 'monthly - :payment-due-at 'beg - :present-value 0)))) - (prelude/assert - (equal "38282.77" - (string/format "%0.2f" - (finance/future-value - 10.0 - :interest-rate 0.1 - :num-years 35 - :frequency 'monthly - :payment-due-at 'beg - :present-value 0))))) - -(provide 'finance) -;;; finance.el ends here diff --git a/configs/shared/.emacs.d/wpc/fonts.el b/configs/shared/.emacs.d/wpc/fonts.el deleted file mode 100644 index 3c6fe6bfeb..0000000000 --- a/configs/shared/.emacs.d/wpc/fonts.el +++ /dev/null @@ -1,153 +0,0 @@ -;;; fonts.el --- Font preferences -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Control my font preferences with ELisp. - -;;; Code: - -;; TODO: `defcustom' font-size. -;; TODO: `defcustom' fonts. -;; TODO: Remove wpc/ namespace. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'prelude) -(require 'cycle) -(require 'device) -(require 'maybe) -(require 'general) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Constants -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO: Troubleshoot why "8" appears so large on my desktop. - -;; TODO: Consider having a different font size when I'm using my 4K monitor. - -(defconst fonts/size - (pcase (device/classify) - ('work-laptop "9") - ('work-desktop "8")) - "My preferred default font-size, which is device specific.") - -(defconst fonts/keybindings? t - "Install the keybindings when non-nil.") - -(defconst fonts/size-step 10 - "The amount (%) by which to increase or decrease a font.") - -(defconst fonts/hacker-news-recommendations - '("APL385 Unicode" - "Go Mono" - "Sudo" - "Monoid" - "Input Mono Medium" ;; NOTE: Also "Input Mono Thin" is nice. - ) - "List of fonts optimized for programming I found in a HN article.") - -(defconst fonts/whitelist - (cycle/from-list - (list/concat - fonts/hacker-news-recommendations - '("JetBrainsMono" - "Mononoki Medium" - "Monospace" - "Operator Mono Light" - "Courier" - "Andale Mono" - "Source Code Pro" - "Terminus"))) - "This is a list of my preferred fonts.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO: fonts and fonts/whitelist make it difficult to name functions like -;; fonts/set as a generic Emacs function vs choosing a font from the whitelist. - -(cl-defun fonts/cycle (&key forward?) - "Cycle forwards when `FORWARD?' non-nil." - (let ((font (if forward? - (cycle/next fonts/whitelist) - (cycle/prev fonts/whitelist)))) - (message (s-concat "Active font: " font)) - (fonts/set font))) - -(defun fonts/next () - "Quickly cycle through preferred fonts." - (interactive) - (fonts/cycle :forward? t)) - -(defun fonts/prev () - "Quickly cycle through preferred fonts." - (interactive) - (fonts/cycle :forward? nil)) - -(defun fonts/set (font &optional size) - "Change the font to `FONT' with option integer, SIZE, in pixels." - (if (maybe/some? size) - (set-frame-font (string/format "%s %s" font size) nil t) - (set-frame-font font nil t))) - -(defun fonts/whitelist-set (font) - "Focuses the FONT in the `fonts/whitelist' cycle. -The size of the font is determined by `fonts/size'." - (prelude/assert (cycle/contains? font fonts/whitelist)) - (cycle/focus (lambda (x) (equal x font)) fonts/whitelist) - (fonts/set (fonts/current) fonts/size)) - -(defun fonts/ivy-select () - "Select a font from an ivy prompt." - (interactive) - (fonts/whitelist-set - (ivy-read "Font: " (cycle/to-list fonts/whitelist)))) - -(defun fonts/print-current () - "Message the currently enabled font." - (interactive) - (message - (string/format "[fonts] Current font: \"%s\"" - (fonts/current)))) - -(defun fonts/current () - "Return the currently enabled font." - (cycle/current fonts/whitelist)) - -(defun fonts/increase-size () - "Increase font size." - (interactive) - (->> (face-attribute 'default :height) - (+ fonts/size-step) - (set-face-attribute 'default (selected-frame) :height))) - -(defun fonts/decrease-size () - "Decrease font size." - (interactive) - (->> (face-attribute 'default :height) - (+ (- fonts/size-step)) - (set-face-attribute 'default (selected-frame) :height))) - -(defun fonts/reset-size () - "Restore font size to its default value." - (interactive) - (fonts/whitelist-set (fonts/current))) - -(when fonts/keybindings? - (progn - (general-define-key - :prefix "" - :states '(normal) - "Ff" #'fonts/next - "Pf" #'fonts/prev) - (general-define-key "s-9" #'fonts/ivy-select) - (general-define-key "s-0" #'fonts/reset-size) - (general-define-key "s-j" #'fonts/decrease-size) - (general-define-key "s-k" #'fonts/increase-size))) - -(provide 'fonts) -;;; fonts.el ends here diff --git a/configs/shared/.emacs.d/wpc/fs.el b/configs/shared/.emacs.d/wpc/fs.el deleted file mode 100644 index b1a79e280a..0000000000 --- a/configs/shared/.emacs.d/wpc/fs.el +++ /dev/null @@ -1,65 +0,0 @@ -;;; fs.el --- Make working with the filesystem easier -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Ergonomic alternatives for working with the filesystem. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'f) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun fs/ensure-file (path) - "Ensure that a file and its directories in `PATH' exist. -Will error for inputs with a trailing slash." - (when (s-ends-with? "/" path) - (error (format "Input path has trailing slash: %s" path))) - (->> path - f-dirname - fs/ensure-dir) - (f-touch path)) - -(f-dirname "/tmp/a/b/file.txt") - -(defun fs/ensure-dir (path) - "Ensure that a directory and its ancestor directories in `PATH' exist." - (->> path - f-split - (apply #'f-mkdir))) - -(defun fs/ls (dir &optional full-path?) - "List the files in `DIR' one-level deep. -Should behave similarly in spirit to the Unix command, ls. -If `FULL-PATH?' is set, return the full-path of the files." - (-drop 2 (directory-files dir full-path?))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Tests -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO: Support `refute' function / macro. -(ert-deftest fs/test/ensure-file () - (let ((file "/tmp/file/a/b/c/file.txt")) - ;; Ensure this file doesn't exist first to prevent false-positives. - (f-delete file t) - (fs/ensure-file file) - (should (and (f-exists? file) - (f-file? file))))) - -(ert-deftest fs/test/ensure-dir () - (let ((dir "/tmp/dir/a/b/c")) - ;; Ensure the directory doesn't exist. - (f-delete dir t) - (fs/ensure-dir dir) - (should (and (f-exists? dir) - (f-dir? dir))))) - -(provide 'fs) -;;; fs.el ends here diff --git a/configs/shared/.emacs.d/wpc/functions.el b/configs/shared/.emacs.d/wpc/functions.el deleted file mode 100644 index 2ef82d54bb..0000000000 --- a/configs/shared/.emacs.d/wpc/functions.el +++ /dev/null @@ -1,133 +0,0 @@ -;; functions.el --- Helper functions for my Emacs development -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; This file hopefully contains friendly APIs that making ELisp development more -;; enjoyable. - -;; TODO: Break these out into separate modules. - -;;; Code: -(defun wpc/evil-window-vsplit-right () - (interactive) - (evil-window-vsplit) - (windmove-right)) - -(defun wpc/evil-window-split-down () - (interactive) - (evil-window-split) - (windmove-down)) - -(defun wpc/reindent-defun-and-align-clojure-map () - (interactive) - (call-interactively #'paredit-reindent-defun) - (call-interactively #'clojure-align)) - -(defun wpc/find-file () - "Prefer project-based file-finding if inside of project; otherwise gracefully fallback." - (interactive) - (with-current-buffer (current-buffer) - (if (projectile-project-p) - (call-interactively #'counsel-projectile-find-file) - (call-interactively #'find-file)))) - -(defun wpc/find-file-split (filename) - "Creates a window split and then edits `filename'." - (interactive) - (evil-window-vsplit) - (find-file filename)) - -(defun wpc/find-or-create-js-test () - (->> buffer-file-name - (s-chop-suffix ".js") - (s-append ".test.js") - (find-file))) - -(defun wpc/find-or-create-js-module () - (->> buffer-file-name - (s-chop-suffix ".test.js") - (s-append ".js") - (find-file))) - -(defun wpc/find-or-create-js-store () - (->> buffer-file-name - (s-replace "index.js" "store.js") - (find-file))) - -(defun wpc/find-or-create-js-component () - (->> buffer-file-name - (s-replace "store.js" "index.js") - (find-file))) - -(defun wpc/toggle-between-js-test-and-module () - "Toggle between a Javascript test or module." - (interactive) - (if (s-ends-with? ".test.js" buffer-file-name) - (wpc/find-or-create-js-module) - (if (s-ends-with? ".js" buffer-file-name) - (wpc/find-or-create-js-test) - (message "Not in a Javascript file. Exiting...")))) - -(defun wpc/toggle-between-js-component-and-store () - "Toggle between a React component and its Redux store." - (interactive) - (if (s-ends-with? "index.js" buffer-file-name) - (wpc/find-or-create-js-store) - (if (or (s-ends-with? "store.js" buffer-file-name) - (s-ends-with? "store.test.js" buffer-file-name)) - (wpc/find-or-create-js-component) - (message "Not in a React/Redux file. Exiting...")))) - -(defun wpc/read-file-as-string (filename) - (with-temp-buffer - (insert-file-contents filename) - (s-trim (buffer-string)))) - -(defun wpc/create-snippet () - "Creates a window split and then opens the Yasnippet editor." - (interactive) - (evil-window-vsplit) - (call-interactively #'yas-new-snippet)) - -(defun wpc/jump-to-parent-file () - "Jumps to a React store or component's parent file. Useful for store or index file." - (interactive) - (-> buffer-file-name - f-dirname - (f-join "..") - (f-join (f-filename buffer-file-name)) - find-file)) - -(defun wpc/add-earmuffs (x) - "Returns X surrounded by asterisks." - (format "*%s*" x)) - -(defun wpc/put-file-name-on-clipboard () - "Put the current file name on the clipboard" - (interactive) - (let ((filename (if (equal major-mode 'dired-mode) - default-directory - (buffer-file-name)))) - (when filename - (with-temp-buffer - (insert filename) - (clipboard-kill-region (point-min) (point-max))) - (message filename)))) - -(s-replace "/" "x" "a/b/c") - -(defun wpc/evil-replace-under-point () - "Faster than typing %s//thing/g." - (interactive) - (let ((term (s-replace "/" "\\/" (symbol/to-string (symbol-at-point))))) - (save-excursion - (evil-ex (concat "%s/\\b" term "\\b/"))))) - -(defun buffer-dirname () - "Return the directory name of the current buffer as a string." - (->> buffer-file-name - f-dirname - f-filename)) - -(provide 'functions) -;;; functions.el ends here diff --git a/configs/shared/.emacs.d/wpc/google-stuff.el b/configs/shared/.emacs.d/wpc/google-stuff.el deleted file mode 100644 index 96c8056596..0000000000 --- a/configs/shared/.emacs.d/wpc/google-stuff.el +++ /dev/null @@ -1,215 +0,0 @@ -;;; google-stuff.el --- Working with Google infrastructure from Emacs -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: - -;; First, I must opine. Feel free to skip this section. In general, it seems -;; that the typical programmer's workflow suffer from what economists call -;; "inelastic demand". This means that any increase in the price of something -;; plummets the demand. Another way of saying this is that programmers are -;; "price sensitive" when it comes to adopting new workflows. -;; -;; For us, any deviation from our "established" workflow feels costly. This -;; makes sense to me because programming is already mentally taxing, so any -;; additional taxation can sometimes feel unbearable. Until programming changes -;; dramatically and we relieve our dependence on files and text for modeling -;; complex applications, this price sensitivity will most likely remain the -;; status quo. Therefore, it's critical to reduce the price of experimenting -;; with new tools such that new, superior workflows may emerge. In this vain, -;; this module attempts to surface "luxury tools" (i.e. dependency pruners, code -;; linters, code formatters) via Emacs to reduce the price of experimenting with -;; them. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'f) -(require 'ivy-helpers) -(require 'maybe) -(require 'device) -(require 'macros) -(require 'general) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO: Ensure a consistent and deliberate usage of `defvar', `defconst', and -;; `defcustom' across all Elisp modules. -(defcustom google-stuff/install-kbds? t - "When t, install the keybindings defined herein.") - -;; Definitions as explained by the highly knowledgeable Matthew (i.e. mjo@) -(defconst google-stuff/definitions - '( - ;; command-line tools - ("gcert" . "Requests a CorpSSH certificate.") - ("glogin" . "SSO (i.e. Single Sign-On) cookie.") - ("googlenetworkaccess" . "Device certificate that gives users a certificate -to access to the Google corp network.") - ("prodaccess" . "Sets up a LOAS session on Goobuntu.") - ;; general wtfs - ("LOAS" . "Distributed authentication service used by jobs in production and -corp to authenticate each other. It's more efficient than SSL and works with -Stubby.") - )) - -(defconst google-stuff/tools - '(("Depana" . "depana") - ("Build cleaner" . "build_cleaner") - ("Java formatter" . "google-java-format") - ("Proto formatter" . "clang-format")) - "Mapping of names of tools to the names of the executables that run them.") - -(use-package protobuf-mode - :config - (macros/support-file-extension "pb" protobuf-mode)) - -;; TODO: Straighten out fig, citc, google3 and have modules for each. - -;; TODO: Move this to a google3.el module. -(defconst google-stuff/root - "/google/src/cloud/wpcarro" - "The root directory to access google3.") - -;; TODO: Find a fast way to generate this. -(defconst google-stuff/citc-clients - '("auto-consult" - "ac-skeleton") - "A list of my active CitC clients.") - - -;; TODO: Can this be sourced from ~/.g4d? -(defconst google-stuff/citc-aliases - '(("google3" . "/google3") - ("escalations" . "/google3/corp/gtech/pto/tda/beacons_extension") - ("spewall_fe" . "/google3/alkali/apps/speakeasydashboard") - ("spewall_be" . "/google3/java/com/google/alkali/applications/speakeasydashboard") - ("spewall_protos" . "/google3/google/internal/alkali/applications/speakeasydashboard") - ("spewall_tests" . "/google3/javatests/com/google/alkali/applications/speakeasydashboard") - ("gti" . "/google3/experimental/engedu/gti/projects/week20190422/mtv/Team10") - ("authwf" . "/google3/customer_support/automation/workflow") - ("redwood" . "/google3/customer_support/kms/redwood/ui") - ("wf-fe" . "/google3/customer_support/kms/redwood/ui/client/components/item/workflow_editor") - ("ac (alkali)" . "/google3/google/internal/alkali/applications/casesconsultservice") - ("ac-server" . "/google3/java/com/google/alkali/applications/casesconsultservice/server/") - ("ac-server (tests)" . "/google3/javatests/com/google/alkali/applications/casesconsultservice/server/")) - "Mapping of a label to commonly visited locations in Google3.") - - -(defvar google-stuff/active-citc-client nil - "Currently active CitC client.") - -(defun google-stuff/depot-prefix () - "Return the current prefix for //depot/google3." - (string/format "/google/src/cloud/wpcarro/%s/google3/" - google-stuff/active-citc-client)) - -(defun google-stuff/cs-url () - "Return the code-search URL for the current buffer and line number." - (string/format "cs.corp.google.com/piper///depot/google3/%s?l=%s" - (s-chop-prefix - (google-stuff/depot-prefix) - (buffer-file-name)) - (line-number-at-pos))) - -(defun google-stuff/copy-cs-url () - "Copy the current file and line-position to the system clipboard." - (interactive) - (clipboard/copy (google-stuff/cs-url))) - -(defun google-stuff/open-buffer-in-cs () - "Open the current file in Google's CodeSearch." - (interactive) - (shell-command - (string/format "google-chrome '%s'" - (google-stuff/cs-url) - (line-number-at-pos)))) - -;; TODO: As a naming convention, should I prefer ivy or select? Or counsel? -(defun google-stuff/select-citc-client () - "Set `google-stuff/active-citc-client' with counsel." - (interactive) - (setq google-stuff/active-citc-client - (ivy-read "CitC Client: " google-stuff/citc-clients))) - -(defun google-stuff/remote-buffer? () - "Return t if buffer is one accessed via Tramp." - (with-current-buffer (current-buffer) - (if (file-remote-p default-directory) - t - nil))) - -(defun google-stuff/jump-to-citc-alias () - "Use `find-file' to open an alias registered in `google-stuff/citc-aliases'. -When on a corporate laptop, remote connections are made using Tramp." - (interactive) - (when (maybe/nil? google-stuff/active-citc-client) - (call-interactively #'google-stuff/select-citc-client)) - (ivy-helpers/kv - "Jump to CitC Alias: " - google-stuff/citc-aliases - (lambda (k v) - (->> v - ;; If I don't remove the leading slash, `f-join' won't return a valid - ;; path. - (s-chop-prefix "/") - (f-join google-stuff/root - google-stuff/active-citc-client) - (s-prepend (if (device/work-laptop?) "/ssh:wpcarro@desktop:" "")) - find-file)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Stuff I learned reading go/emacs -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; Fig -;; TODO: Make sure there are Evil-compatible KBDs for `fig-status'. -;; (require 'google-fig) - -;; This allows `find-file' handle "//depot/google3/devtools/editors/". -(require 'p4-files) -(p4-enable-file-name-handler) - -;; Blaze Support -;; - `google3-compile-current-file' is an excellent command! - -;; google3-eglot (uses CiderLSP) -;; TODO: Make sure the functionality is supported as advertised: -;; - auto-completion -;; - eglot-help-at-point for documentation. -;; - goto-definition -;; - `eglot-code-actions' fixits -;; - `eglot-rename' refactoring -(require 'google3-eglot) -(google3-eglot-setup) - -;; CodeSearch -;; TODO: Debug why this depends on google-piper and why I don't have that on my -;; desktop. -;; (require 'ivy-cs) - -;; Auto completion -;; TODO: Is the part of or separate from google3-eglot? Because google3-eglot -;; advertises auto-completion support. -(require 'google3-build-capf) -(google3-build-capf-enable-completions) -(add-to-list 'company-backends #'company-capf) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Keybindings -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(when google-stuff/install-kbds? - (general-define-key - :prefix "" - :states '(normal) - "Gs" #'fig-status - "Cs" #'google-stuff/open-buffer-in-cs - "jc" #'google-stuff/jump-to-citc-alias)) - -(provide 'google-stuff) -;;; google-stuff.el ends here diff --git a/configs/shared/.emacs.d/wpc/graph.el b/configs/shared/.emacs.d/wpc/graph.el deleted file mode 100644 index c68c308590..0000000000 --- a/configs/shared/.emacs.d/wpc/graph.el +++ /dev/null @@ -1,91 +0,0 @@ -;;; graph.el --- Working with in-memory graphs -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; -;; Remember that there are optimal three ways to model a graph: -;; 1. Edge List -;; 2. Vertex Table (a.k.a. Neighbors Table) -;; 3. Adjacency Matrix -;; -;; I may call these "Edges", "Neighbors", "Adjacencies" to avoid verbose naming. -;; For now, I'm avoiding dealing with Adjacency Matrices as I don't have an -;; immediate use-case for them. This is subject to change. -;; -;; There are also hybrid representations of graphs that combine the three -;; aforementioned models. I believe Erlang's digraph module models graphs in -;; Erlang Term Storage (i.e. ETS) this way. -;; TODO: Verify this claim. -;; -;; Graphs can be weighted or unweighted. They can also be directed or -;; undirected. -;; TODO: Create a table explaining all graph variants. -;; -;; TODO: Figure out the relationship of this module and tree.el, which should in -;; principle overlap. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'prelude) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; For now, I'll support storing *either* neighbors or edges in the graph struct -;; as long as both aren't set, since that introduces consistency issues. I may -;; want to handle that use-case in the future, but not now. -(cl-defstruct graph neighbors edges) - -;; TODO: How do you find the starting point for a topo sort? -(defun graph/sort (xs) - "Return a topological sort of XS.") - -(defun graph/from-edges (xs) - "Create a graph struct from the Edge List, XS. -The user must pass in a valid Edge List since asserting on the shape of XS might - be expensive." - (make-graph :edges xs)) - -(defun graph/from-neighbors (xs) - "Create a graph struct from a Neighbors Table, XS. -The user must pass in a valid Neighbors Table since asserting on the shape of - XS might be expensive." - (make-graph :neighbors xs)) - -(defun graph/instance? (xs) - "Return t if XS is a graph struct." - (graph-p xs)) - -;; TODO: Model each of the mapping functions into an isomorphism. -(defun graph/edges->neighbors (xs) - "Map Edge List, XS, into a Neighbors Table." - (prelude/assert (graph/instance? xs))) - -(defun graph/neighbors->edges (xs) - "Map Neighbors Table, XS, into an Edge List." - (prelude/assert (graph/instance? xs))) - -;; Below are three different models of the same unweighted, directed graph. - -(defvar graph/edges - '((a . b) (a . c) (a . e) - (b . c) (b . d) - (c . e) - (d . f) - (e . d) (e . f))) - -(defvar graph/neighbors - ((a b c e) - (b c d) - (c e) - (d f) - (e d g) - (f))) - -(provide 'graph) -;;; graph.el ends here diff --git a/configs/shared/.emacs.d/wpc/imdb.el b/configs/shared/.emacs.d/wpc/imdb.el deleted file mode 100644 index 2969da1409..0000000000 --- a/configs/shared/.emacs.d/wpc/imdb.el +++ /dev/null @@ -1,128 +0,0 @@ -;;; imdb.el --- Internet Movie Database -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Some Elisp to help me pick movies more quickly. - -;;; Code: - -(require 'f) -(require 'macros) -(require 'pcre2el) -(require 'random) -(require 'maybe) - -;; TODO: How do you support types herein? -(cl-defstruct movie - name - year - director - watched?) - -;; TODO: Support famous directors like: -;; - Wes Anderson -;; - Woody Allen -;; - Tarantino -;; - Coen Brothers -;; - Alfonso Cauron -;; - Alejandro González Iñárritu -;; - Alfred Hitchcock -;; - Stanley Kubrick - -;; TODO: Dump this into SQL. - -(defconst imdb/kubrick-films - (->> '((:watched? nil :year 1951 :name "Flying Padre") - (:watched? nil :year 1953 :name "Fear and Desire") - (:watched? nil :year 1953 :name "The Seafarers") - (:watched? nil :year 1955 :name "Killer's Kiss") - (:watched? nil :year 1956 :name "The Killing") - (:watched? nil :year 1957 :name "Paths of Glory") - (:watched? nil :year 1960 :name "Spartacus") - (:watched? nil :year 1962 :name "Lolita") - (:watched? nil :year 1964 :name "Dr. Strangelove") - (:watched? nil :year 1968 :name "2001: A Space Odyssey") - (:watched? t :year 1971 :name "A Clockwork Orange") - (:watched? nil :year 1975 :name "Barry Lyndon") - (:watched? nil :year 1980 :name "The Shining") - (:watched? t :year 1987 :name "Full Metal Jacket") - (:watched? nil :year 1999 :name "Eyes Wide Shut")) - (list/map (lambda (x) - (make-movie :name (plist-get :name x) - :year (plist-get :year x) - :director "Stanley Kubrick" - :watched? (plist-get :watched? x)))))) - -(defconst imdb/non-top-250 - (->> '("Doctor Zhivago" - ) - (list/map #'imdb/new-movie))) - -(defun imdb/new-movie (name) - "Create a new movie with NAME." - (make-movie :name name - :year nil - :director nil - :watched? nil)) - -(defun imdb/org->movie (line) - "Parse an org LINE into a movie struct." - (let ((match (s-match - (pcre-to-elisp "^\*\*\s(TODO|DONE)\s(.+)$") - line))) - (if (maybe/some? match) - (make-movie :name (list/get 2 match) - :year nil - :director nil - :watched? (equal "DONE" (list/get 1 match))) - (error (s-concat "Parsing error: " line))))) - -;; TODO: Store these in a database or define them herein. -(defun imdb/org->movies () - "Parse entire IMDB org file into movie structs." - (->> "~/Dropbox/org/imdb_top_250.org" - f-read - (s-split "\n") - (-drop 1) - (list/filter (>> (s-starts-with? "** "))) - (list/map #'imdb/org->movie))) - -(defun imdb/watched? (movie) - "Return t if MOVIE has been watched." - (movie-watched? movie)) - -(defconst imdb/movies (imdb/org->movies) - "Structs of all watched movies.") - -(defun imdb/unwatched () - "Return list of unwatched movies." - (->> imdb/movies - (list/filter (lambda (x) (not (imdb/watched? x)))))) - -(defun imdb/name (movie) - "Return name of MOVIE." - (movie-name movie)) - - -(defun imdb/suggest () - "Randomly select movie from unwatched list." - (->> (imdb/unwatched) - (random/choice) - (imdb/name))) - -(defun imdb/unwatched-list () - "Dump all unwatched movies into a list." - (f-write-text (->> (imdb/unwatched) - (list/map #'imdb/name) - (s-join "\n")) - 'utf-8 - "/tmp/unwatched.txt")) - -(macros/comment - (imdb/org->movies) - (imdb/unwatched-list) - (imdb/suggest) - ) - -(provide 'imdb) -;;; imdb.el ends here diff --git a/configs/shared/.emacs.d/wpc/irc.el b/configs/shared/.emacs.d/wpc/irc.el deleted file mode 100644 index b9a1e31317..0000000000 --- a/configs/shared/.emacs.d/wpc/irc.el +++ /dev/null @@ -1,177 +0,0 @@ -;;; irc.el --- Configuration for IRC chat -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Need to decide which client I will use for IRC. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'erc) -(require 'cycle) -(require 'string) -(require 'prelude) -(require 'alist) -(require 'set) -(require 'maybe) -(require 'macros) -(require 'password-store) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Configuration -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst irc/enable-tests? t - "When t, run the tests defined herein.") - -(setq erc-rename-buffers t) - -;; TODO: Find a way to avoid putting "freenode" and "#freenode" as channels -;; here. I'm doing it because when erc first connects, it's `(buffer-name)' is -;; "freenode", so when `irc/next-channel' is called, it 404s on the -;; `cycle/contains?' call in `irc/channel->cycle" unless "freenode" is there. To -;; make matters even uglier, when `erc-join-channel' is called with "freenode" -;; as the value, it connects to the "#freenode" channel, so unless "#freenode" -;; exists in this cycle also, `irc/next-channel' breaks again. This doesn't -;; pass my smell test. -(defconst irc/server->channels - `(("irc.freenode.net" . ,(cycle/new "freenode" "#freenode" "#nixos" "#emacs" "#pass")) - ("irc.corp.google.com" . ,(cycle/new "#omg" "#london" "#panic" "#prod-team"))) - "Mapping of IRC servers to a cycle of my preferred channels.") - -;; TODO: Assert that no two servers have a channel with the same name. We need -;; this because that's the assumption that underpins the `irc/channel->server' -;; function. This will probably be an O(n^2) operation. -(prelude/assert - (set/distinct? (set/from-list - (cycle/to-list - (alist/get "irc.freenode.net" - irc/server->channels))) - (set/from-list - (cycle/to-list - (alist/get "irc.corp.google.com" - irc/server->channels))))) - -(defun irc/channel->server (server->channels channel) - "Resolve an IRC server from a given CHANNEL." - (let ((result (alist/find (lambda (k v) (cycle/contains? channel v)) - server->channels))) - (prelude/assert (maybe/some? result)) - result)) - -(defun irc/channel->cycle (server->channels channel) - "Resolve an IRC's channels cycle from a given CHANNEL." - (alist/get (irc/channel->server server->channels channel) - server->channels)) - -;; Setting `erc-join-buffer' to 'bury prevents erc from stealing focus of the -;; current buffer when it connects to IRC servers. -(setq erc-join-buffer 'bury) - -;; TODO: Here is another horrible hack that should be revisted. -(setq erc-autojoin-channels-alist - (->> irc/server->channels - (alist/map-values #'cycle/to-list) - (alist/map-keys (>> (s-chop-prefix "irc.") - (s-chop-suffix ".net"))))) - -(defcustom irc/install-kbds? t - "When t, install the keybindings defined herein.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun irc/message (x) - "Print message X in a structured way." - (message (string/format "[irc.el] %s" x))) - -;; TODO: Integrate Google setup with Freenode setup. - -;; TODO: Support function or KBD for switching to an ERC buffer. - -(defun irc/kill-all-erc-processes () - "Kills all ERC buffers and processes." - (interactive) - (->> (erc-buffer-list) - (-map #'kill-buffer))) - -(defun irc/switch-to-erc-buffer () - "Switch to an ERC buffer." - (interactive) - (let ((buffers (erc-buffer-list))) - (if (list/empty? buffers) - (error "[irc.el] No ERC buffers available") - (switch-to-buffer (list/head (erc-buffer-list)))))) - -(defun irc/connect-to-freenode () - "Connect to Freenode IRC." - (interactive) - (erc-ssl :server "irc.freenode.net" - :port 6697 - :nick "wpcarro" - :password (password-store-get "programming/irc/freenode") - :full-name "William Carroll")) - -;; TODO: Handle failed connections. -(defun irc/connect-to-google () - "Connect to Google's Corp IRC using ERC." - (interactive) - (erc-ssl :server "irc.corp.google.com" - :port 6697 - :nick "wpcarro" - :full-name "William Carroll")) - -;; TODO: Prefer defining these with a less homespun solution. There is a -;; function call `erc-buffer-filter' that would be more appropriate for the -;; implementation of `irc/next-channel' and `irc/prev-channel'. -(defun irc/next-channel () - "Join the next channel for the active server." - (interactive) - (with-current-buffer (current-buffer) - (let ((cycle (irc/channel->cycle irc/server->channels (buffer-name)))) - (erc-join-channel - (cycle/next cycle)) - (irc/message - (string/format "Current IRC channel: %s" (cycle/current cycle)))))) - -(defun irc/prev-channel () - "Join the previous channel for the active server." - (interactive) - (with-current-buffer (current-buffer) - (let ((cycle (irc/channel->cycle irc/server->channels (buffer-name)))) - (erc-join-channel - (cycle/prev cycle)) - (irc/message - (string/format "Current IRC channel: %s" (cycle/current cycle)))))) - -(add-hook 'erc-mode-hook (disable auto-fill-mode)) -(add-hook 'erc-mode-hook (disable company-mode)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Keybindings -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(when irc/install-kbds? - (general-define-key - :keymaps 'erc-mode-map - "" #'irc/next-channel - "" #'irc/prev-channel)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Tests -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(when irc/enable-tests? - (prelude/assert - (equal - (irc/channel->server `(("irc.dairy.com" . ,(cycle/new "#cheese" "#milk")) - ("irc.color.com" . ,(cycle/new "#red" "#blue"))) - "#cheese") - "irc.dairy.com"))) - -(provide 'irc) -;;; irc.el ends here diff --git a/configs/shared/.emacs.d/wpc/iso.el b/configs/shared/.emacs.d/wpc/iso.el deleted file mode 100644 index c9ce4a48fc..0000000000 --- a/configs/shared/.emacs.d/wpc/iso.el +++ /dev/null @@ -1,95 +0,0 @@ -;;; iso.el --- Isomorphisms in Elisp -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Providing basic isomorphisms to improve code quality. - -;;; Code: - -(require 'dotted) -(require 'tuple) -(require 'symbol) -(require 'string) -(require 'list) -(require 'alist) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(cl-defstruct iso to from x) - -(defconst iso/whitelist - '((dotted . tuple) - (symbol . string)) - "Alist representing supported isomorphisms.") - -(defconst iso/vertices - (list/concat (alist/keys iso/whitelist) - (alist/values iso/whitelist)) - "List of all of the vertices in the iso graph.") - -(defun iso/classify (x) - "Return type of X." - (cond - ((string/instance? x) 'string) - ((symbol/instance? x) 'symbol) - ((dotted/instance? x) 'dotted) - ((tuple/instance? x) 'tuple))) - -(cl-defun iso/exists? (to from) - "Return t if an isomorphism of TO to FROM exists." - ;; TODO: All of this can be improved modelling this with a graph. - (cond - ;; to -> from - ((list/contains? to (alist/keys iso/whitelist)) - (list/contains? from (alist/values iso/whitelist))) - ;; from -> to - ((list/contains? from (alist/keys iso/whitelist)) - (list/contains? to (alist/values iso/whitelist))) - ;; doesn't exist - (t nil))) - -(progn - (prelude/assert - (iso/exists? 'symbol 'string)) - (prelude/assert - (iso/exists? 'dotted 'tuple)) - (prelude/refute - (iso/exists? 'dotted 'symbol)) - (prelude/refute - (iso/exists? 'symbol 'list))) - -;; TODO: Model this as a graph. -(defconst iso/morphisms - '((string . - '(symbol #') - )) - (list (:from 'string :to 'symbol :fn #'intern) - (:from 'symbol :to 'string :fn #'symbol-name) - ) - "") - -(defun iso/to (f x) - "Apply F to X's to." - (->> x - iso-to)) - -(->> (iso/new "william" :to 'symbol) - (iso/as-to #'symbol-name) - ) - -(cl-defun iso/new (x &key to) - "Create a new isomorphism of X mapping to TO." - (let ((from (iso/classify x))) - (prelude/assert (iso/exists? to from)) - (make-iso :from from - :to to - :x x))) - -(macros/comment - (iso/new "william" :to 'symbol) - (iso/new '(one . two) :to 'tuple)) - -(provide 'iso) -;;; iso.el ends here diff --git a/configs/shared/.emacs.d/wpc/ivy-clipmenu.el b/configs/shared/.emacs.d/wpc/ivy-clipmenu.el deleted file mode 100644 index f3896137bd..0000000000 --- a/configs/shared/.emacs.d/wpc/ivy-clipmenu.el +++ /dev/null @@ -1,134 +0,0 @@ -;;; ivy-clipmenu.el --- Emacs client for clipmenu -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Ivy integration with the clipboard manager, clipmenu. Essentially, clipmenu -;; turns your system clipboard into a list. -;; -;; To use this module, you must first install clipmenu and ensure that the -;; clipmenud daemon is running. Refer to the installation instructions at -;; github.com/cdown/clipmenu for those details. -;; -;; This module intentionally does not define any keybindings since I'd prefer -;; not to presume my users' preferences. Personally, I use EXWM as my window -;; manager, so I call `exwm-input-set-key' and map it to `ivy-clipmenu/copy'. -;; -;; Usually clipmenu integrates with rofi or dmenu. This Emacs module integrates -;; with ivy. Launch this when you want to select a clip. -;; -;; Clipmenu itself supports a variety of environment variables that allow you to -;; customize its behavior. These variables are respected herein. If you'd -;; prefer to customize clipmenu's behavior from within Emacs, refer to the -;; variables defined in this module. -;; -;; For more information: -;; - See `clipmenu --help`. -;; - Visit github.com/cdown/clipmenu. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'f) -(require 's) -(require 'dash) -(require 'ivy) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Variables -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defgroup ivy-clipmenu nil - "Ivy integration for clipmenu." - :group 'ivy) - -(defcustom ivy-clipmenu/directory - (or (getenv "XDG_RUNTIME_DIR") - (getenv "TMPDIR") - "/tmp") - "Base directory for clipmenu's data." - :type 'string - :group 'ivy-clipmenu) - -(defconst ivy-clipmenu/executable-version 5 - "The major version number for the clipmenu executable.") - -(defconst ivy-clipmenu/cache-directory - (f-join ivy-clipmenu/directory - (format "clipmenu.%s.%s" - ivy-clipmenu/executable-version - (getenv "USER"))) - "Directory where the clips are stored.") - -(defconst ivy-clipmenu/cache-file-pattern - (f-join ivy-clipmenu/cache-directory "line_cache_*") - "Glob pattern matching the locations on disk for clipmenu's labels.") - -(defcustom ivy-clipmenu/history-length - (or (getenv "CM_HISTLENGTH") 25) - "Limit the number of clips in the history. -This value defaults to 25.") - -(defvar ivy-clipmenu/history nil - "History for `ivy-clipmenu/copy'.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun ivy-clipmenu/parse-content (x) - "Parse the label from the entry in clipmenu's line-cache." - (->> (s-split " " x) - (-drop 1) - (s-join " "))) - -(defun ivy-clipmenu/list-clips () - "Return a list of the content of all of the clips." - (->> ivy-clipmenu/cache-file-pattern - f-glob - (-map (lambda (path) - (s-split "\n" (f-read path) t))) - -flatten - (-reject #'s-blank?) - (-sort #'string>) - (-map #'ivy-clipmenu/parse-content) - delete-dups - (-take ivy-clipmenu/history-length))) - -(defun ivy-clipmenu/checksum (content) - "Return the CRC checksum of CONTENT." - (s-trim-right - (with-temp-buffer - (call-process "/bin/bash" nil (current-buffer) nil "-c" - (format "cksum <<<'%s'" content)) - (buffer-string)))) - -(defun ivy-clipmenu/line-to-content (line) - "Map the chosen LINE from the line cache its content from disk." - (->> line - ivy-clipmenu/checksum - (f-join ivy-clipmenu/cache-directory) - f-read)) - -(defun ivy-clipmenu/do-copy (x) - "Copy string, X, to the system clipboard." - (kill-new x) - (message "[ivy-clipmenu.el] Copied!")) - -(defun ivy-clipmenu/copy () - "Use `ivy-read' to select and copy a clip. -It's recommended to bind this function to a globally available keymap." - (interactive) - (let ((ivy-sort-functions-alist nil)) - (ivy-read "Clipmenu: " - (ivy-clipmenu/list-clips) - :history 'ivy-clipmenu/history - :action (lambda (line) - (->> line - ivy-clipmenu/line-to-content - ivy-clipmenu/do-copy))))) - -(provide 'ivy-clipmenu) -;;; ivy-clipmenu.el ends here diff --git a/configs/shared/.emacs.d/wpc/ivy-helpers.el b/configs/shared/.emacs.d/wpc/ivy-helpers.el deleted file mode 100644 index c71a907a20..0000000000 --- a/configs/shared/.emacs.d/wpc/ivy-helpers.el +++ /dev/null @@ -1,31 +0,0 @@ -;;; ivy-helpers.el --- More interfaces to ivy -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Hopefully to improve my workflows. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'alist) -(require 'tuple) -(require 'string) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(cl-defun ivy-helpers/kv (prompt kv f) - "PROMPT users with the keys in KV and return its corresponding value. Calls F -with the key and value from KV." - (ivy-read - prompt - kv - :require-match t - :action (lambda (entry) - (funcall f (car entry) (cdr entry))))) - -;;; Code: -(provide 'ivy-helpers) -;;; ivy-helpers.el ends here diff --git a/configs/shared/.emacs.d/wpc/kaomoji.el b/configs/shared/.emacs.d/wpc/kaomoji.el deleted file mode 100644 index d6d509c146..0000000000 --- a/configs/shared/.emacs.d/wpc/kaomoji.el +++ /dev/null @@ -1,45 +0,0 @@ -;;; kaomoji.el --- Supporting kaomoji usage -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Simple keyboards like this make life a bit better. - -;;; Code: - -(defvar kaomoji/install-kbds? - nil - "Set to t if you'd like the keybindings to be installed.") - -(defconst kaomoji/symbols '(("Joy" . "(⌒‿⌒)") - ("Love" . "(ღ˘⌣˘ღ)") - ("Sympathy" . "ヽ(~_~(・_・ )ゝ") - ("Dissatisfaction" . "(＞﹏＜)") - ("Anger" . "ヽ(‵﹏´)ノ") - ("Hugging" . "(づ￣ ³￣)づ") - ("Hiding" . "┬┴┬┴┤( ͡° ͜ʖ├┬┴┬┴") - ("Sleeping" . "(－_－) zzZ") - ("Embarrassed" . "(×﹏×)") - ("Shrug" . "ヽ(ー_ー )ノ")) - "Alist of human-readable emotions to the kaomoji.") - -;; TODO: Consider supporting a hydra for these. - -(defun kaomoji/select () - "Interactively select a kaomoji and copy it to the clipboard." - (interactive) - (ivy-read - "Select a kaomoji: " - kaomoji/symbols - :action (lambda (entry) - (kill-new (cdr entry)) - (alert "Copied to clipboard!")))) - -;; TODO: Define Hydra for all custom keyboards. -;; TODO: Define a better keybinding in a different keymap. -(when kaomoji/install-kbds? - (general-define-key - :keymaps 'global - "M-k" #'kaomoji/select)) - -(provide 'kaomoji) -;;; kaomoji.el ends here diff --git a/configs/shared/.emacs.d/wpc/kbd.el b/configs/shared/.emacs.d/wpc/kbd.el deleted file mode 100644 index 49b346bc6e..0000000000 --- a/configs/shared/.emacs.d/wpc/kbd.el +++ /dev/null @@ -1,90 +0,0 @@ -;;; kbd.el --- Elisp keybinding -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; In order to stay organized, I'm attempting to dedicate KBD prefixes to -;; specific functions. I'm hoping I can be more deliberate with my keybinding -;; choices this way. -;; -;; Terminology: -;; For a more thorough overview of the terminology refer to `keybindings.md' -;; file. Here's a brief overview: -;; - workspace: Anything concerning EXWM workspaces. -;; - x11: Anything concerning X11 applications. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'prelude) -(require 'alist) -(require 'set) -(require 'string) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Constants -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst kbd/install-kbds? t - "When t, install keybindings defined herein.") - -(defconst kbd/prefixes - '((workspace . "s") - (x11 . "C-s")) - "Mapping of functions to designated keybinding prefixes to stay organized.") - -;; Assert that no keybindings are colliding. -(prelude/assert - (= (alist/count kbd/prefixes) - (->> kbd/prefixes - alist/values - set/from-list - set/count))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun kbd/raw (f x) - "Return the string keybinding for function F and appendage X. -Values for F include: -- workspace -- x11" - (prelude/assert (alist/has-key? f kbd/prefixes)) - (string/format - "%s-%s" - (alist/get f kbd/prefixes) - x)) - -(defun kbd/for (f x) - "Return the `kbd' for function F and appendage X. -Values for F include: -- workspace -- x11" - (kbd (kbd/raw f x))) - -;; TODO: Prefer copying human-readable versions to the clipboard. Right now -;; this isn't too useful. -(defun kbd/copy-keycode () - "Copy the pressed key to the system clipboard." - (interactive) - (message "[kbd] Awaiting keypress...") - (let ((key (read-key))) - (clipboard/copy (string/format "%s" key)) - (message (string/format "[kbd] \"%s\" copied!" key)))) - -(defun kbd/print-keycode () - "Prints the pressed keybinding." - (interactive) - (message "[kbd] Awaiting keypress...") - (message (string/format "[kbd] keycode: %s" (read-key)))) - -;; (when kbd/install-kbds? -;; (general-define-key -;; :prefix "" -;; "hr" #'kbd/print-keycode)) - -(provide 'kbd) -;;; kbd.el ends here diff --git a/configs/shared/.emacs.d/wpc/keybindings.el b/configs/shared/.emacs.d/wpc/keybindings.el deleted file mode 100644 index 755311483d..0000000000 --- a/configs/shared/.emacs.d/wpc/keybindings.el +++ /dev/null @@ -1,46 +0,0 @@ -;;; keybindings.el --- Centralizing my keybindings -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Attempting to centralize my keybindings to simplify my configuration. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'clipboard) -(require 'screen-brightness) -(require 'chrome) -(require 'scrot) -(require 'ivy-clipmenu) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Configuration -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defmacro keybinding/exwm (c fn) - "Bind C to FN using `exwm-input-set-key' with `kbd' applied to C." - `(exwm-input-set-key (kbd ,c) ,fn)) - -(keybinding/exwm "C-M-v" #'ivy-clipmenu/copy) - -(keybinding/exwm "" #'screen-brightness/increase) -(keybinding/exwm "" #'screen-brightness/decrease) - -(keybinding/exwm "" #'pulse-audio/toggle-mute) -(keybinding/exwm "" #'pulse-audio/decrease-volume) -(keybinding/exwm "" #'pulse-audio/increase-volume) -(keybinding/exwm "" #'pulse-audio/toggle-microphone) - -(keybinding/exwm "C-M-c" #'chrome/browse) - -(keybinding/exwm (kbd/raw 'x11 "s") #'scrot/select) - -;; TODO: I need this because my Ergodox EZ sends super+shift instead of just -;; super. Remove this once I fix my Ergodox. -(keybinding/exwm "C-S-s-s" #'scrot/select) - -(provide 'keybindings) -;;; keybindings.el ends here diff --git a/configs/shared/.emacs.d/wpc/keyboard.el b/configs/shared/.emacs.d/wpc/keyboard.el deleted file mode 100644 index ec50cabd27..0000000000 --- a/configs/shared/.emacs.d/wpc/keyboard.el +++ /dev/null @@ -1,152 +0,0 @@ -;;; keyboard.el --- Managing keyboard preferences with Elisp -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Setting key repeat and other values. -;; -;; Be wary of suspiciously round numbers. Especially those divisible by ten! - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'string) -(require 'number) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Constants -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO: Support clamping functions for repeat-{rate,delay} to ensure only valid -;; values are sent to xset. -(defcustom keyboard/repeat-rate 80 - "The number of key repeat signals sent per second.") - -(defcustom keyboard/repeat-delay 170 - "The number of milliseconds before autorepeat starts.") - -(defconst keyboard/repeat-rate-copy keyboard/repeat-rate - "Copy of `keyboard/repeat-rate' to support `keyboard/reset-key-repeat'.") - -(defconst keyboard/repeat-delay-copy keyboard/repeat-delay - "Copy of `keyboard/repeat-delay' to support `keyboard/reset-key-repeat'.") - -(defcustom keyboard/install-preferences? t - "When t, install keyboard preferences.") - -(defcustom keyboard/install-kbds? nil - "When t, install keybindings.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun keyboard/message (x) - "Message X in a structured way." - (message (string/format "[keyboard.el] %s" x))) - -(cl-defun keyboard/set-key-repeat (&key - (rate keyboard/repeat-rate) - (delay keyboard/repeat-delay)) - "Use xset to set the key-repeat RATE and DELAY." - (prelude/start-process - :name "keyboard/set-key-repeat" - :command (string/format "xset r rate %s %s" delay rate))) - -;; NOTE: Settings like this are machine-dependent. For instance I only need to -;; do this on my laptop and other devices where I don't have access to my split -;; keyboard. -;; NOTE: Running keysym Caps_Lock is not idempotent. If this is called more -;; than once, xmodmap will start to error about non-existent Caps_Lock symbol. -;; For more information see here: -;; https://unix.stackexchange.com/questions/108207/how-to-map-caps-lock-as-the-compose-key-using-xmodmap-portably-and-idempotently -(defun keyboard/swap-caps-lock-and-escape () - "Swaps the caps lock and escape keys using xmodmap." - (interactive) - ;; TODO: Ensure these work once the tokenizing in prelude/start-process works - ;; as expected. - (start-process "keyboard/swap-caps-lock-and-escape" nil "/usr/bin/xmodmap" "-e" - "remove Lock = Caps_Lock") - (start-process "keyboard/swap-caps-lock-and-escape" nil "/usr/bin/xmodmap" "-e" - "keysym Caps_Lock = Escape")) - -(defun keyboard/inc-repeat-rate () - "Increment `keyboard/repeat-rate'." - (interactive) - (setq keyboard/repeat-rate (number/inc keyboard/repeat-rate)) - (keyboard/set-key-repeat :rate keyboard/repeat-rate) - (keyboard/message - (string/format "Rate: %s" keyboard/repeat-rate))) - -(defun keyboard/dec-repeat-rate () - "Decrement `keyboard/repeat-rate'." - (interactive) - (setq keyboard/repeat-rate (number/dec keyboard/repeat-rate)) - (keyboard/set-key-repeat :rate keyboard/repeat-rate) - (keyboard/message - (string/format "Rate: %s" keyboard/repeat-rate))) - -(defun keyboard/inc-repeat-delay () - "Increment `keyboard/repeat-delay'." - (interactive) - (setq keyboard/repeat-delay (number/inc keyboard/repeat-delay)) - (keyboard/set-key-repeat :delay keyboard/repeat-delay) - (keyboard/message - (string/format "Delay: %s" keyboard/repeat-delay))) - -(defun keyboard/dec-repeat-delay () - "Decrement `keyboard/repeat-delay'." - (interactive) - (setq keyboard/repeat-delay (number/dec keyboard/repeat-delay)) - (keyboard/set-key-repeat :delay keyboard/repeat-delay) - (keyboard/message - (string/format "Delay: %s" keyboard/repeat-delay))) - -(defun keyboard/print-key-repeat () - "Print the currently set values for key repeat." - (interactive) - (keyboard/message - (string/format "Rate: %s. Delay: %s" - keyboard/repeat-rate - keyboard/repeat-delay))) - -(defun keyboard/set-preferences () - "Reset the keyboard preferences to their default values. -NOTE: This function exists because occasionally I unplug and re-plug in a - keyboard and all of the preferences that I set using xset disappear." - (interactive) - (keyboard/swap-caps-lock-and-escape) - (keyboard/set-key-repeat :rate keyboard/repeat-rate - :delay keyboard/repeat-delay) - ;; TODO: Implement this message function as a macro that pulls the current - ;; file name. - (keyboard/message "Keyboard preferences set!")) - -(defun keyboard/reset-key-repeat () - "Set key repeat rate and delay to original values." - (interactive) - (keyboard/set-key-repeat :rate keyboard/repeat-rate-copy - :delay keyboard/repeat-delay-copy) - (keyboard/message "Key repeat preferences reset.")) - -(when keyboard/install-preferences? - (keyboard/set-preferences)) - -;; TODO: Define minor-mode for this. -(when keyboard/install-kbds? - (general-unbind 'motion "C-i" "C-y") - (general-define-key - ;; TODO: Choose better KBDs for these that don't interfere with useful evil - ;; ones. - ;; Use C-y when you accidentally send the key-repeat too high or too low to - ;; be meaningful. - "C-y" #'keyboard/reset-key-repeat - "C-i" #'keyboard/inc-repeat-rate - "C-u" #'keyboard/dec-repeat-rate - "C-S-i" #'keyboard/inc-repeat-delay - "C-S-u" #'keyboard/dec-repeat-delay)) - -(provide 'keyboard) -;;; keyboard.el ends here diff --git a/configs/shared/.emacs.d/wpc/keymap.el b/configs/shared/.emacs.d/wpc/keymap.el deleted file mode 100644 index 87d340fcdb..0000000000 --- a/configs/shared/.emacs.d/wpc/keymap.el +++ /dev/null @@ -1,25 +0,0 @@ -;;; keymap.el --- Working with Elisp keymaps -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Very much a work-in-progress. - -;;; Code: - -(require 'macros) -(require 'symbol) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun keymap/pretty-print (x) - "Pretty prints `X'." - ;; TODO: Work-in-progress - (s-concat "\\{" (symbol/to-string x) "}")) - -(macros/comment - (keymap/pretty-print lispyville-mode-map)) - -(provide 'keymap) -;;; keymap.el ends here diff --git a/configs/shared/.emacs.d/wpc/laptop-battery.el b/configs/shared/.emacs.d/wpc/laptop-battery.el deleted file mode 100644 index 3ec03553d2..0000000000 --- a/configs/shared/.emacs.d/wpc/laptop-battery.el +++ /dev/null @@ -1,60 +0,0 @@ -;;; laptop-battery.el --- Display laptop battery information -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Some wrappers to obtain battery information. -;; -;; To troubleshoot battery consumpton look into the CLI `powertop`. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Roadmap -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO: Support functions that work with reporting battery stats. -;; TODO: low-battery-reporting-threshold -;; TODO: charged-battery-reporting-threshold -;; TODO: Format modeline battery information. -;; TODO: Provide better time information in the modeline. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'battery) -(require 'alist) -(require 'maybe) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun laptop-battery/available? () - "Return t if battery information is available." - (maybe/some? battery-status-function)) - -(defun laptop-battery/percentage () - "Return the current percentage of the battery." - (->> battery-status-function - funcall - (alist/get 112))) - -(defun laptop-battery/print-percentage () - "Return the current percentage of the battery." - (interactive) - (->> (laptop-battery/percentage) - message)) - -(defun laptop-battery/display () - "Display laptop battery percentage in the modeline." - (interactive) - (display-battery-mode 1)) - -(defun laptop-battery/hide () - "Hide laptop battery percentage in the modeline." - (interactive) - (display-battery-mode -1)) - -(provide 'laptop-battery) -;;; laptop-battery.el ends here diff --git a/configs/shared/.emacs.d/wpc/list.el b/configs/shared/.emacs.d/wpc/list.el deleted file mode 100644 index 5a63c8bd94..0000000000 --- a/configs/shared/.emacs.d/wpc/list.el +++ /dev/null @@ -1,235 +0,0 @@ -;;; list.el --- Functions for working with lists. -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Since I prefer having the `list/' namespace, I wrote this module to wrap many -;; of the functions that are defined in the the global namespace in ELisp. I -;; sometimes forget the names of these functions, so it's nice for them to be -;; organized like this. -;; -;; Motivation: -;; Here are some examples of function names that I cannot tolerate: -;; - `car': Return the first element (i.e. "head") of a linked list -;; - `cdr': Return the tail of a linked list - -;; As are most APIs for standard libraries that I write, this is heavily -;; influenced by Elixir's standard library. -;; -;; Elixir's List library: -;; - ++/2 -;; - --/2 -;; - hd/1 -;; - tl/1 -;; - in/2 -;; - length/1 -;; -;; Similar libraries: -;; - dash.el: Functional library that mimmicks Clojure. It is consumed herein. -;; - list-utils.el: Utility library that covers things that dash.el may not -;; cover. -;; stream.el: Elisp implementation of streams, "implemented as delayed -;; evaluation of cons cells." - -;; TODO: Consider naming this file linked-list.el. - -;; TODO: Support module-like macro that auto-namespaces functions. - -;; TODO: Consider wrapping most data structures like linked-lists, -;; associative-lists, etc in a `cl-defstruct', so that the dispatching by type -;; can be nominal instead of duck-typing. I'm not sure if this is a good idea -;; or not. If I do this, I should provide isomorphisms to map between idiomatic -;; ways of working with Elisp data structures and my wrapped variants. - -;; TODO: Are function aliases/synonyms even a good idea? Or do they just -;; bloat the API unnecessarily? - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO: Move `prelude/assert' elsewhere so that I can require it without -;; introducing the circular dependency of list.el -> prelude.el -> list.el. -;;(require 'prelude) -(require 'dash) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Constants -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst list/tests? t - "When t, run the test suite.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun list/new () - "Return a new, empty list." - '()) - -(defun list/concat (&rest lists) - "Joins `LISTS' into on list." - (apply #'-concat lists)) - -(defun list/join (joint xs) - "Join a list of strings, XS, with JOINT." - (if (list/empty? xs) - "" - (list/reduce (list/first xs) - (lambda (x acc) - (string/concat acc joint x)) - (list/tail xs)))) - -(defun list/length (xs) - "Return the number of elements in `XS'." - (length xs)) - -(defun list/get (i xs) - "Return the value in `XS' at `I', or nil." - (nth i xs)) - -(defun list/head (xs) - "Return the head of `XS'." - (car xs)) - -;; TODO: Learn how to write proper function aliases. -(defun list/first (xs) - "Alias for `list/head' for `XS'." - (list/head xs)) - -(defun list/tail (xs) - "Return the tail of `XS'." - (cdr xs)) - -(defun list/reverse (xs) - "Reverses `XS'." - (reverse xs)) - -(defun list/cons (x xs) - "Add `X' to the head of `XS'." - (cons x xs)) - -;; map, filter, reduce - -;; TODO: Create function adapters like swap. -;; (defun adapter/swap (f) -;; "Return a new function that wraps `F' and swaps the arguments." -;; (lambda (a b) -;; (funcall f b a))) - -;; TODO: Make this function work. -(defun list/reduce (acc f xs) - "Return over `XS' calling `F' on an element in `XS'and `ACC'." - (-reduce-from (lambda (acc x) (funcall f x acc)) acc xs)) - -;; TODO: Support this. It seems like `alist/set' is not working as I expected it -;; to. Perhaps we should add some tests to confirm the expected behavior. -;; (cl-defun list/index (f xs &key (transform (lambda (x) x))) -;; "Return a mapping of F applied to each x in XS to TRANSFORM applied to x. -;; The TRANSFORM function defaults to the identity function." -;; (->> xs -;; (list/reduce (alist/new) -;; (lambda (x acc) -;; (let ((k (funcall f x)) -;; (v (funcall transform x))) -;; (if (alist/has-key? k acc) -;; (setf (alist-get k acc) (list v)) -;; (setf (alist-get k acc) (list v)))))))) -;; (prelude/assert -;; (equal '(("John" . ("Cleese" "Malkovich")) -;; ("Thomas" . ("Aquinas"))) -;; (list/index (lambda (x) (plist-get x :first-name)) -;; '((:first-name "John" :last-name "Cleese") -;; (:first-name "John" :last-name "Malkovich") -;; (:first-name "Thomas" :last-name "Aquinas")) -;; :transform (lambda (x) (plist-get x :last-name))))) - -(defun list/map (f xs) - "Call `F' on each element of `XS'." - (-map f xs)) - -(defun list/map-indexed (f xs) - "Call `F' on each element of `XS' along with its index." - (-map-indexed (lambda (i x) (funcall f x i)) xs)) - -(defun list/filter (p xs) - "Return a subset of XS where predicate P returned t." - (list/reverse - (list/reduce - '() - (lambda (x acc) - (if (funcall p x) - (list/cons x acc) - acc)) - xs))) - -(defun list/reject (p xs) - "Return a subset of XS where predicate of P return nil." - (list/filter (lambda (x) (not (funcall p x))) xs)) - -(defun list/find (p xs) - "Return the first x in XS that passes P or nil." - (-find p xs)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Predicates -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun list/instance? (xs) - "Return t if `XS' is a list. -Be leery of using this with things like alists. Many data structures in Elisp - are implemented using linked lists." - (listp xs)) - -(defun list/empty? (xs) - "Return t if XS are empty." - (= 0 (list/length xs))) - -(defun list/all? (p xs) - "Return t if all `XS' pass the predicate, `P'." - (-all? p xs)) - -(defun list/any? (p xs) - "Return t if any `XS' pass the predicate, `P'." - (-any? p xs)) - -(defun list/contains? (x xs) - "Return t if X is in XS using `equal'." - (-contains? xs x)) - -;; TODO: Support dedupe. -;; TODO: Should we call this unique? Or distinct? - -;; TODO: Add tests. -(defun list/dedupe-adjacent (xs) - "Return XS without adjacent duplicates." - (prelude/assert (not (list/empty? xs))) - (list/reduce (list (list/first xs)) - (lambda (x acc) - (if (equal x (list/first acc)) - acc - (list/cons x acc))) - xs)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Tests -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; (when list/tests? -;; (prelude/assert -;; (= 0 -;; (list/length '()))) -;; (prelude/assert -;; (= 5 -;; (list/length '(1 2 3 4 5)))) -;; (prelude/assert -;; (= 16 -;; (list/reduce 1 (lambda (x acc) (+ x acc)) '(1 2 3 4 5)))) -;; (prelude/assert -;; (equal '(2 4 6 8 10) -;; (list/map (lambda (x) (* x 2)) '(1 2 3 4 5))))) - -(provide 'list) -;;; list.el ends here diff --git a/configs/shared/.emacs.d/wpc/list.nix b/configs/shared/.emacs.d/wpc/list.nix deleted file mode 100644 index e664ba6fd4..0000000000 --- a/configs/shared/.emacs.d/wpc/list.nix +++ /dev/null @@ -1,8 +0,0 @@ -{ pkgs ? import (builtins.fetchTarball - "https://github.com/tazjin/depot/archive/master.tar.gz") {} }: - -pkgs.writeElispBin { - name = "list"; - deps = epkgs: [ epkgs.dash ./prelude.nix ]; - src = ./list.el; -} diff --git a/configs/shared/.emacs.d/wpc/macros.el b/configs/shared/.emacs.d/wpc/macros.el deleted file mode 100644 index 5f7c93902e..0000000000 --- a/configs/shared/.emacs.d/wpc/macros.el +++ /dev/null @@ -1,95 +0,0 @@ -;;; macros.el --- Helpful variables for making my ELisp life more enjoyable -*- lexical-binding: t -*- -;; Authpr: William Carroll - -;;; Commentary: -;; This file contains helpful variables that I use in my ELisp development. - -;; TODO: Consider a macro solution for mimmicking OCaml's auto resolution of -;; dependencies using `load-path' and friends. - -;;; Code: - -(require 'f) -(require 'string) -(require 'symbol) - -;; TODO: Support `xi' lambda shorthand macro. - -(defmacro enable (mode) - "Helper for enabling `MODE'. -Useful in `add-hook' calls. Some modes, like `linum-mode' need to be called as -`(linum-mode 1)', so `(add-hook mode #'linum-mode)' won't work." - `#'(lambda nil (,mode 1))) - -(defmacro disable (mode) - "Helper for disabling `MODE'. -Useful in `add-hook' calls." - `#'(lambda nil (,mode -1))) - -(defmacro add-hooks (modes callback) - "Add multiple `MODES' for the `CALLBACK'. -Usage: (add-hooks '(one-mode-hook 'two-mode-hook) #'fn)" - `(dolist (mode ,modes) - (add-hook mode ,callback))) - -(defmacro add-hook-before-save (mode f) - "Register a hook, `F', for a mode, `MODE' more conveniently. -Usage: (add-hook-before-save 'reason-mode-hook #'refmt-before-save)" - `(add-hook ,mode - (lambda () - (add-hook 'before-save-hook ,f)))) - -;; TODO: Debug. -(defmacro macros/ilambda (&rest body) - "Surrounds `BODY' with an interactive lambda function." - `(lambda () - (interactive) - ,@body)) - -;; TODO: Privatize? -(defun namespace () - "Return the namespace for a function based on the filename." - (->> (buffer-file-name) - f-filename - f-base)) - -(defmacro macros/comment (&rest _) - "Empty comment s-expresion where `BODY' is ignored." - `nil) - -;; NOTE: Not prepending the "macros" to this macro, since brevity is its goal. -(defmacro >> (&rest forms) - "Compose a new, point-free function by composing FORMS together." - (let ((sym (gensym))) - `(lambda (,sym) - (->> ,sym ,@forms)))) - -;; TOOD: Support this. -(cl-defmacro macros/test - (&key function - test - args - expect - equality) - (let* ((namespace (namespace)) - (test-name (string/->symbol - (s-concat namespace - "/" - "test" - "/" - (s-chop-prefix - (s-concat namespace "/") - (symbol/to-string function)))))) - `(ert-deftest ,test-name () - ,test - (should (,equality (apply ,function ,args) - ,expect))))) - -(defmacro macros/support-file-extension (ext mode) - "Register MODE to automatically load with files ending with EXT extension. -Usage: (macros/support-file-extension \"pb\" protobuf-mode)" - (let ((extension (string/format "\\.%s\\'" ext))) - `(add-to-list 'auto-mode-alist '(,extension . ,mode)))) - -(provide 'macros) -;;; macros.el ends here diff --git a/configs/shared/.emacs.d/wpc/math.el b/configs/shared/.emacs.d/wpc/math.el deleted file mode 100644 index 3176d906b4..0000000000 --- a/configs/shared/.emacs.d/wpc/math.el +++ /dev/null @@ -1,59 +0,0 @@ -;;; math.el --- Math stuffs -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Containing some useful mathematical functions. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'maybe) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Constants -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst math/pi pi - "The number pi.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO: Support all three arguments. -;; Int -> Int -> Int -> Boolean -(cl-defun math/triangle-of-power (&key base power result) - ;; TODO: Assert two of three are set. - (cond - ((maybe/somes? base power result) - (error "All three arguments should not be set")) - ((maybe/somes? power result) - (message "power and result")) - ((maybe/somes? base result) - (log result base)) - ((maybe/somes? base power) - (expt base power)) - (t - (error "Two of the three arguments must be set")))) - -(defun math/mod (x y) - "Return X mod Y." - (mod x y)) - -(defun math/exp (x y) - "Return X raised to the Y." - (expt x y)) - -(defun math/round (x) - "Round X to nearest ones digit." - (round x)) - -(defun math/floor (x) - "Floor value X." - (floor x)) - -(provide 'math) -;;; math.el ends here diff --git a/configs/shared/.emacs.d/wpc/maybe.el b/configs/shared/.emacs.d/wpc/maybe.el deleted file mode 100644 index 0973b1ed65..0000000000 --- a/configs/shared/.emacs.d/wpc/maybe.el +++ /dev/null @@ -1,102 +0,0 @@ -;;; maybe.el --- Library for dealing with nil values -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Inspired by Elm's Maybe library. -;; -;; For now, a Nothing value will be defined exclusively as a nil value. I'm -;; uninterested in supported falsiness in this module even at risk of going -;; against the LISP grain. -;; -;; I'm avoiding introducing a struct to handle the creation of Just and Nothing -;; variants of Maybe. Perhaps this is a mistake in which case this file would -;; be more aptly named nil.el. I may change that. Because of this limitation, -;; functions in Elm's Maybe library like andThen, which is the monadic bind for -;; the Maybe type, doesn't have a home here since we cannot compose multiple -;; Nothing or Just values without a struct or some other construct. -;; -;; Possible names for the variants of a Maybe. -;; None | Some -;; Nothing | Something -;; None | Just -;; Nil | Set -;; -;; NOTE: In Elisp, values like '() (i.e. the empty list) are aliases for nil. -;; What else in Elisp is an alias in this way? -;; Examples: -;; TODO: Provide examples of other nil types in Elisp. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'prelude) -(require 'list) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Constants -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defvar maybe/test? t - "When t, run the test suite defined herein.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun maybe/nil? (x) - "Return t if X is nil." - (eq nil x)) - -(defun maybe/some? (x) - "Return t when X is non-nil." - (not (maybe/nil? x))) - -(defun maybe/nils? (&rest xs) - "Return t if all XS are nil." - (list/all? #'maybe/nil? xs)) - -(defun maybe/somes? (&rest xs) - "Return t if all XS are non-nil." - (list/all? #'maybe/some? xs)) - -(defun maybe/default (default x) - "Return DEFAULT when X is nil." - (if (maybe/nil? x) default x)) - -(defun maybe/map (f x) - "Apply F to X if X is not nil." - (if (maybe/some? x) - (funcall f x) - x)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Tests -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(when maybe/test? - ;; nil? - (prelude/assert (maybe/nil? nil)) - (prelude/refute (maybe/nil? t)) - ;; some? - (prelude/assert (maybe/some? 10)) - (prelude/refute (maybe/some? nil)) - ;; nils? - (prelude/assert (maybe/nils? nil nil nil nil)) - (prelude/refute (maybe/nils? nil t nil t)) - ;; somes? - (prelude/assert (maybe/somes? t 10 '(1 2 3) "some")) - (prelude/refute (maybe/somes? t nil '(1 2 3) "some")) - ;; default - (prelude/assert - (and (= 0 (maybe/default 5 0)) - (= 5 (maybe/default 5 nil)))) - ;; map - (prelude/assert - (and (= 2 (maybe/map #'1+ 1)) - (eq nil (maybe/map #'1+ nil))))) - -(provide 'maybe) -;;; maybe.el ends here diff --git a/configs/shared/.emacs.d/wpc/me-seconds.el b/configs/shared/.emacs.d/wpc/me-seconds.el deleted file mode 100644 index f03e5d07d7..0000000000 --- a/configs/shared/.emacs.d/wpc/me-seconds.el +++ /dev/null @@ -1,245 +0,0 @@ -;;; me-seconds.el --- How valuable is my time? -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Inspired by Google's concept of SWE-seconds, I decided to try and compute how -;; value my personal time is. -;; -;; This library should integrate with another library that handles currency -;; conversions using locally cached data for historial values and network -;; requests for current values. -;; -;; Context sensitivity: -;; Many of the values herein are based on my values that are a function of the -;; year, my current salary, my current company holiday policy, and my current -;; country holiday policy. As such, many of these constants need to be updated -;; whenever changes occur in order for these functions to be useful. -;; -;; Units of time: -;; - seconds -;; - minutes -;; - hours -;; - days -;; - weeks -;; - months -;; - years -;; -;; Wish list: -;; - I should create a money.el struct to work with herein. This module would -;; expose basic algebra for working with money structs, which would be handy. -;; - I should create a time.el struct for working with hours in the day. I'd -;; like to be able to do (+ 9:15 17:45) cleanly. -;; -;; Terminology: -;; SWE hours give an order of magnitude approximation to the cost of resources -;; in dollars per hour at 2115 hours per year. -;; - SWE hour (SWEh) -;; - SWE year (SWEy) -;; - SWE nominal -;; - SWE opportunity -;; -;; Other isomorphisms include: -;; - Borg GCU -;; - Borg RAM -;; - Tape (library) -;; - Tape (vault) -;; - Spindles (low latency) -;; - Spindles (throughput) -;; - Spindles (throughput) -;; - Tape (throughput) -;; - SWE (nominal) -;; - SWE (opportunity) - - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'macros) -(require 'string) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Constants -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun me-seconds/salary (amt) - "Return the yearly rate of AMT of money in GBP. -f :: Integer -> Rate" - (make-rate :money (make-money :whole amt :fractional 0 :currency 'GBP) - :unit 'year)) - -(defconst me-seconds/salary (me-seconds/salary 80000) - "My salary in GBP.") - -;; TODO: Consider changing these into units of time. -(defconst me-seconds/months-per-year 12 - "Number of months in a year.") - -(defconst me-seconds/days-per-year 365 - "Number of days in a year.") - -(defconst me-seconds/hours-per-year (* 24 me-seconds/days-per-year) - "Number of hours in a year.") - -(defconst me-seconds/minutes-per-year (* 60 me-seconds/hours-per-year) - "Number of minutes in a year.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Vacation -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst me-seconds/bank-holidays-per-year 8 - "Number of bank holidays in the UK each year.") - -(defconst me-seconds/pto-days-vacation-per-year 25 - "Number of days of paid-time-off I receive each year in the UK.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Sleeping -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst me-seconds/sleeping-hours-per-day 8 - "An approximation of the number of hours I sleep each night on average.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Waking -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst me-seconds/waking-hours-per-day - (- 24 me-seconds/sleeping-hours-per-night) - "An approximation of the number of hours I sleep each night on average.") - -;; TODO: Adjust this for vacation time. -(defconst me-seconds/waking-hours-per-year - (* me-seconds/waking-hours-per-day me-seconds/days-per-year) - "The number of hours that I work each year.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Working -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst me-seconds/working-hours-per-day - (- 17 9) - "An approximation of the number of hours I work each weekday on average. -Note that this differs from the assumed SWE hours per day calculation, which - assumes 9 working hours. See the discussion about this of go/rules-of-thumb.") - -(defconst me-seconds/working-hours-per-year 2115 - "This number is borrowed from go/rules-of-thumb.") - -;; Keep in mind that the following classifications of time: -;; - 9:00-17:00 M-F. Is this more expensive than time sleeping? -;; - Weekend -;; - Weekday -;; - Working hours -;; - Waking hours -;; - Sleeping hours -;; - Vacation hours -;; -;; TODO: Consider tax implications (i.e. after-tax amounts and pre-tax amounts). -;; -;; Should these all be treated the same since they all pull from the same pot of -;; time? Or perhaps there are multiples involved? Much to think about. How does -;; Google handle this? - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; Supported currencies: -;; - GBP -;; NOTE: Amount is an integer. -(cl-defstruct money whole fractional currency) -(cl-defstruct rate money unit) - -;; TODO: Add to money.el. -(defun money/to-string (x) - "Return the string representation of X. -f :: Money -> String" - (let ((currency (money-currency x)) - (whole (int-to-string (money-whole x))) - (fract (int-to-string (money-fractional x)))) - (pcase currency - ('GBP (string/concat "£" whole "." fract)) - ('USD (string/concat "$" whole "." fract)) - (_ (error (string/concat - "Currency: \"" - (symbol-name currency) - "\" not supported")))))) - -(macros/comment - (money/to-string - (make-money :whole 100 :fractional 99 :currency 'GBP))) - -;; TODO: Add to rate.el. -(defun rate/to-string (x) - "Message X as a rate. -f :: Rate -> String" - (string/concat - (money/to-string (rate-money x)) - " / " - (pcase (rate-unit x) - ('second "sec") - ('minute "min") - ('hour "hr") - ('day "day") - ('week "week") - ('month "month") - ('year "year")))) - -(macros/comment - (rate/to-string - (make-rate - :money (make-money :whole 10 :fractional 10 :currency 'GBP) - :unit 'day))) - -;; TODO: Move this to math.el? -(defun ensure-float (x) - "Ensures X is treated as a float." - (+ 0.0 x)) - -;; TODO: Move these to basic time mapping module. -;; TODO: Consider making this an isomorphism. -(defun minutes/to-hours (x) - "Convert X minutes to n hours." - (/ x 60.0)) - -(defun hours/to-minutes (x) - "Convert X hours to n minutes." - (* x 60)) - -(defun days/to-minutes (x) - "Convert X days to n minutes." - (* x 24 60)) - -(defun weeks/to-minutes (x) - "Convert X weeks to n minutes." - (* x 7 24 60)) - -(defun months/to-minutes (x) - "Convert X months to n minutes. -This approximates the number of days in a month to 30." - (* x 30 24 60)) - -;; TODO: Support algebraic functions with money structs. -;; TODO: Support isomorphisms for rates to other units of time. That would -;; subsume most of this module's use. -(defun me-seconds/value-per-minute (salary) - "Computes my value per minute based on my current SALARY. -Signature: f :: Rate -> Rate -This is assuming that all of my time is equally valuable. See the above - discussion about the various classifications of my time.") - -;; TODO: See note above about isomorphisms between various rates. -(defun me-seconds/value (salary x) - "Compute the value of X minutes of my time at my current SALARY. -f :: Rate -> Integer -> Money") - -(macros/comment - (rate/to-string me-seconds/salary) - ) - -(provide 'me-seconds) -;;; me-seconds.el ends here diff --git a/configs/shared/.emacs.d/wpc/monoid.el b/configs/shared/.emacs.d/wpc/monoid.el deleted file mode 100644 index 401d63c417..0000000000 --- a/configs/shared/.emacs.d/wpc/monoid.el +++ /dev/null @@ -1,30 +0,0 @@ -;;; monoid.el --- Working with Monoids in Elisp -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; The day has finally arrived where I'm using Monoids in Elisp. -;; -;; The monoid typeclass is as follows: -;; - empty :: a -;; - concat :: (list a) -> a - -;;; Code: - -;; TODO: Consider a prelude version that works for all Elisp types. -(defun monoid/classify (xs) - "Return the type of `XS'." - (cond - ((listp xs) 'list) - ((vectorp xs) 'vector) - ((stringp xs) 'string))) - - -(defun monoid/empty (xs) - "Return the empty monoid for the type `XS'." - (pcase (monoid/classify xs) - ('list '()) - ('vector []) - ('string ""))) - -(provide 'monoid) -;;; monoid.el ends here diff --git a/configs/shared/.emacs.d/wpc/number.el b/configs/shared/.emacs.d/wpc/number.el deleted file mode 100644 index f496349050..0000000000 --- a/configs/shared/.emacs.d/wpc/number.el +++ /dev/null @@ -1,153 +0,0 @@ -;;; number.el --- Functions for working with numbers -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; -;; Classifications of numbers: -;; - Natural: (a.k.a positive integers, counting numbers); {1, 2, 3, ... } -;; -;; - Whole: Natural Numbers, plus zero; {0, 1, 2, 3, ...} -;; -;; - Integers: Whole numbers plus all the negatives of the natural numbers; -;; {... , -2, -1, 0, 1, 2, ...} -;; -;; - Rational numbers: (a.k.a. fractions) where the top and bottom numbers are -;; integers; e.g., 1/2, 3/4, 7/2, ⁻4/3, 4/1. Note: The denominator cannot be -;; 0, but the numerator can be. -;; -;; - Real numbers: All numbers that can be written as a decimal. This includes -;; fractions written in decimal form e.g., 0.5, 0.75 2.35, ⁻0.073, 0.3333, or -;; 2.142857. It also includes all the irrational numbers such as π, √2 etc. -;; Every real number corresponds to a point on the number line. -;; -;; The functions defined herein attempt to capture the mathematical definitions -;; of numbers and their classifications as defined above. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'prelude) -(require 'dash) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst number/test? t - "When t, run the test suite defined herein.") - -;; TODO: What about int.el? - -;; TODO: How do we handle a number typeclass? - -(defun number/positive? (x) - "Return t if `X' is a positive number." - (> x 0)) - -(defun number/negative? (x) - "Return t if `X' is a positive number." - (< x 0)) - -;; TODO: Don't rely on this. Need to have 10.0 and 10 behave similarly. -(defun number/float? (x) - "Return t if `X' is a floating point number." - (floatp x)) - -(defun number/natural? (x) - "Return t if `X' is a natural number." - (and (number/positive? x) - (not (number/float? x)))) - -(defun number/whole? (x) - "Return t if `X' is a whole number." - (or (= 0 x) - (number/natural? x))) - -(defun number/integer? (x) - "Return t if `X' is an integer." - (or (number/whole? x) - (number/natural? (- x)))) - -;; TODO: How defensive should these guards be? Should we assert that the inputs -;; are integers before checking evenness or oddness? - -;; TODO: Look up Runar (from Unison) definition of handling zero as even or odd. - -;; TODO: How should rational numbers be handled? Lisp is supposedly famous for -;; its handling of rational numbers. -;; TODO: `calc-mode' supports rational numbers as "1:2" meaning "1/2" -;; (defun number/rational? (x)) - -;; TODO: Can or should I support real numbers? -;; (defun number/real? (x)) - -(defun number/even? (x) - "Return t if `X' is an even number." - (or (= 0 x) - (= 0 (mod x 2)))) - -(defun number/odd? (x) - "Return t if `X' is an odd number." - (not (number/even? x))) - -(defun number/dec (x) - "Subtract one from `X'. -While this function is undeniably trivial, I have unintentionally done (- 1 x) - when in fact I meant to do (- x 1) that I figure it's better for this function - to exist, and for me to train myself to reach for it and its inc counterpart." - (- x 1)) - -(defun number/inc (x) - "Add one to `X'." - (+ x 1)) - -;; TODO: Does this belong in a math module? Is math too vague? Or is number -;; too vague? -;; TODO: Resolve the circular dependency that this introduces with series.el, -;; and then re-enable this function and its tests below. -;; (defun number/factorial (x) -;; "Return factorial of `X'." -;; (cond -;; ((number/negative? x) (error "Will not take factorial of negative numbers")) -;; ((= 0 x) 1) -;; ;; NOTE: Using `series/range' introduces a circular dependency because: -;; ;; series -> number -> series. Conceptually, however, this should be -;; ;; perfectly acceptable. -;; (t (->> (series/range 1 x) -;; (list/reduce 1 #'*))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Tests -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(when number/test? - (prelude/assert - (number/positive? 10)) - (prelude/assert - (number/natural? 10)) - (prelude/assert - (number/whole? 10)) - (prelude/assert - (number/whole? 0)) - (prelude/assert - (number/integer? 10)) - ;; (prelude/assert - ;; (= 120 (number/factorial 5))) - (prelude/assert - (number/even? 6)) - (prelude/refute - (number/odd? 6)) - (prelude/refute - (number/positive? -10)) - (prelude/refute - (number/natural? 10.0)) - (prelude/refute - (number/natural? -10)) - (prelude/refute - (number/natural? -10.0))) - -(provide 'number) -;;; number.el ends here diff --git a/configs/shared/.emacs.d/wpc/org-helpers.el b/configs/shared/.emacs.d/wpc/org-helpers.el deleted file mode 100644 index ef99b18ee0..0000000000 --- a/configs/shared/.emacs.d/wpc/org-helpers.el +++ /dev/null @@ -1,29 +0,0 @@ -;;; org-helpers.el --- Utility functions for working with my Org setup -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Some small utility functions intended to make me more likely to use Org mode -;; more often. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'f) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst org-helpers/directory "~/Dropbox/org" - "The directory where I store most of my Org files.") - -(defun org-helpers/find-file (name) - "Call `find-file' on NAME in my org directory" - (find-file - (f-join org-helpers/directory name))) - -(provide 'org-helpers) -;;; org-helpers.el ends here diff --git a/configs/shared/.emacs.d/wpc/packages/wpc-clojure.el b/configs/shared/.emacs.d/wpc/packages/wpc-clojure.el deleted file mode 100644 index d9262cdda8..0000000000 --- a/configs/shared/.emacs.d/wpc/packages/wpc-clojure.el +++ /dev/null @@ -1,85 +0,0 @@ -;;; clojure.el --- My Clojure preferences -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Hosting my Clojure tooling preferences - -;;; Code: - -;; Helper functions - -;; (defun wpc/buffer-name-for-clojure-mode (mode) -;; (let* ((project-name (projectile-project-name)) -;; (cljs-name (concat "*cider-repl CLJS " project-name "*")) -;; (clj-name (concat "*cider-repl " project-name "*"))) -;; (cond ((eq mode 'clojurescript-mode) cljs-name) -;; ((eq mode 'clojure-mode) clj-name) -;; ((eq mode 'clojurec-mode) cljs-name)))) - -;; (defun wpc/repl-function-for-clojure-mode (mode) -;; (let ((project-name (projectile-project-name)) -;; (cljs-fn #'cider-jack-in-clojurescript) -;; (clj-fn #'cider-jack-in)) -;; (cond ((eq mode 'clojurescript-mode) cljs-fn) -;; ((eq mode 'clojure-mode) clj-fn) -;; ((eq mode 'clojurec-mode) cljs-fn)))) - -;; (defun wpc/find-or-create-clojure-or-clojurescript-repl () -;; (interactive) -;; (with-current-buffer (current-buffer) -;; (let ((buffer-name (wpc/buffer-name-for-clojure-mode major-mode)) -;; (repl-function (wpc/repl-function-for-clojure-mode major-mode))) -;; (if (get-buffer buffer-name) -;; (switch-to-buffer buffer-name) -;; (funcall repl-function))))) - -(use-package clojure-mode - :config - ;; from Ryan Schmukler: - (setq cljr-magic-require-namespaces - '(("io" . "clojure.java.io") - ("sh" . "clojure.java.shell") - ("jdbc" . "clojure.java.jdbc") - ("set" . "clojure.set") - ("time" . "java-time") - ("str" . "cuerdas.core") - ("path" . "pathetic.core") - ("walk" . "clojure.walk") - ("zip" . "clojure.zip") - ("async" . "clojure.core.async") - ("component" . "com.stuartsierra.component") - ("http" . "clj-http.client") - ("url" . "cemerick.url") - ("sql" . "honeysql.core") - ("csv" . "clojure.data.csv") - ("json" . "cheshire.core") - ("s" . "clojure.spec.alpha") - ("fs" . "me.raynes.fs") - ("ig" . "integrant.core") - ("cp" . "com.climate.claypoole") - ("re-frame" . "re-frame.core") - ("rf" . "re-frame.core") - ("re" . "reagent.core") - ("reagent" . "reagent.core") - ("u.core" . "utopia.core") - ("gen" . "clojure.spec.gen.alpha")))) - -(use-package cider - :config - (general-define-key - :keymaps 'cider-repl-mode-map - "C-l" #'cider-repl-clear-buffer - "C-u" #'kill-whole-line - "" #'cider-repl-previous-input - "" #'cider-repl-next-input - ;; "C-c 'j" #'wpc/find-or-create-clojure-or-clojurescript-repl - ) - ;; (setq cider-cljs-lein-repl - ;; "(do (require 'figwheel-sidecar.repl-api) - ;; (figwheel-sidecar.repl-api/start-figwheel!) - ;; (figwheel-sidecar.repl-api/cljs-repl))" - ;; cider-prompt-for-symbol nil) - ) - -(provide 'wpc-clojure) -;;; wpc-clojure.el ends here diff --git a/configs/shared/.emacs.d/wpc/packages/wpc-company.el b/configs/shared/.emacs.d/wpc/packages/wpc-company.el deleted file mode 100644 index 1152f496c2..0000000000 --- a/configs/shared/.emacs.d/wpc/packages/wpc-company.el +++ /dev/null @@ -1,28 +0,0 @@ -;;; company.el --- Autocompletion package, company, preferences -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Hosts my company mode preferences - -;;; Code: - -;; autocompletion client -(use-package company - :config - (general-define-key - :keymaps 'company-active-map - "C-j" #'company-select-next - "C-n" #'company-select-next - "C-k" #'company-select-previous - "C-p" #'company-select-previous - "C-d" #'company-show-doc-buffer) - (setq company-tooltip-align-annotations t) - (setq company-idle-delay 0) - (setq company-show-numbers t) - (setq company-minimum-prefix-length 2) - (setq company-dabbrev-downcase nil - company-dabbrev-ignore-case t) - (global-company-mode)) - -(provide 'wpc-company) -;;; wpc-company.el ends here diff --git a/configs/shared/.emacs.d/wpc/packages/wpc-dired.el b/configs/shared/.emacs.d/wpc/packages/wpc-dired.el deleted file mode 100644 index bc3915914b..0000000000 --- a/configs/shared/.emacs.d/wpc/packages/wpc-dired.el +++ /dev/null @@ -1,41 +0,0 @@ -;;; dired.el --- My dired preferences -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; File management in Emacs, if learned and configured properly, should be -;; capable to reduce my dependency on the terminal. - -;;; Code: - -;; TODO: Ensure sorting in dired is by type. - -;; TODO: Rename wpc-dired.el to file-management.el - -(progn - (require 'dired) - (setq dired-recursive-copies 'always - dired-recursive-deletes 'top - dired-dwim-target t) - (general-define-key - :keymaps 'dired-mode-map - :states '(normal) - ;; Overriding some KBDs defined in the evil-collection module. - "o" #'dired-find-file-other-window - "" nil ;; This unblocks some of my leader-prefixed KBDs. - "s" nil ;; This unblocks my window-splitting KBDs. - "c" #'find-file - "f" #'wpc/find-file - "-" (lambda () (interactive) (find-alternate-file ".."))) - (general-add-hook 'dired-mode-hook - (list (enable dired-hide-details-mode) - #'auto-revert-mode))) - -(progn - (require 'locate) - (general-define-key - :keymaps 'locate-mode-map - :states 'normal - "o" #'dired-find-file-other-window)) - -(provide 'wpc-dired) -;;; wpc-dired.el ends here diff --git a/configs/shared/.emacs.d/wpc/packages/wpc-docker.el b/configs/shared/.emacs.d/wpc/packages/wpc-docker.el deleted file mode 100644 index 270eaec6fe..0000000000 --- a/configs/shared/.emacs.d/wpc/packages/wpc-docker.el +++ /dev/null @@ -1,16 +0,0 @@ -;;; docker.el --- Docker preferences -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; My Docker preferences and configuration - -;;; Code: - -(use-package docker - :config - (setenv "DOCKER_TLS_VERIFY" "1") - (setenv "DOCKER_HOST" "tcp://10.11.12.13:2376") - (setenv "DOCKER_MACHINE_NAME" "name")) - -(provide 'wpc-docker) -;;; wpc-docker.el ends here diff --git a/configs/shared/.emacs.d/wpc/packages/wpc-elixir.el b/configs/shared/.emacs.d/wpc/packages/wpc-elixir.el deleted file mode 100644 index e64abe70fc..0000000000 --- a/configs/shared/.emacs.d/wpc/packages/wpc-elixir.el +++ /dev/null @@ -1,13 +0,0 @@ -;;; wpc-elixir.el --- Elixir / Erland configuration -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; My preferences for working with Elixir / Erlang projects - -;;; Code: -(use-package elixir-mode - :config - (add-hook-before-save 'elixir-mode-hook #'elixir-format)) - -(provide 'wpc-elixir) -;;; wpc-elixir.el ends here diff --git a/configs/shared/.emacs.d/wpc/packages/wpc-flycheck.el b/configs/shared/.emacs.d/wpc/packages/wpc-flycheck.el deleted file mode 100644 index d7bb834a62..0000000000 --- a/configs/shared/.emacs.d/wpc/packages/wpc-flycheck.el +++ /dev/null @@ -1,14 +0,0 @@ -;;; flycheck.el --- My flycheck configuration -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Hosts my Flycheck preferences - -;;; Code: - -(use-package flycheck - :config - (global-flycheck-mode)) - -(provide 'wpc-flycheck) -;;; wpc-flycheck.el ends here diff --git a/configs/shared/.emacs.d/wpc/packages/wpc-haskell.el b/configs/shared/.emacs.d/wpc/packages/wpc-haskell.el deleted file mode 100644 index e8ab16e585..0000000000 --- a/configs/shared/.emacs.d/wpc/packages/wpc-haskell.el +++ /dev/null @@ -1,56 +0,0 @@ -;;; haskell.el --- My Haskell preferences -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Hosts my Haskell development preferences - -;;; Code: - -;; Haskell support - -;; font-locking, glyph support, etc -(use-package haskell-mode - :config - (let ((m-symbols - '(("`mappend`" . "⊕") - ("<>" . "⊕")))) - (dolist (item m-symbols) (add-to-list 'haskell-font-lock-symbols-alist item))) - (setq haskell-font-lock-symbols t) - (add-hook-before-save 'haskell-mode #'haskell-align-imports)) - -;; LSP support -(use-package lsp-haskell - :after (haskell-mode) - :config - (setq lsp-haskell-process-path-hie "hie-wrapper") - (add-hook 'haskell-mode-hook #'lsp-haskell-enable) - (add-hook 'haskell-mode-hook #'flycheck-mode)) - -;; Test toggling -(defun haskell/module->test () - "Jump from a module to a test." - (let ((filename (->> buffer-file-name - (s-replace "/src/" "/test/") - (s-replace ".hs" "Test.hs") - find-file))) - (make-directory (f-dirname filename) t) - (find-file filename))) - -(defun haskell/test->module () - "Jump from a test to a module." - (let ((filename (->> buffer-file-name - (s-replace "/test/" "/src/") - (s-replace "Test.hs" ".hs") - ))) - (make-directory (f-dirname filename) t) - (find-file filename))) - -(defun haskell/test<->module () - "Toggle between test and module in Haskell." - (interactive) - (if (s-contains? "/src/" buffer-file-name) - (haskell/module->test) - (haskell/test->module))) - -(provide 'wpc-haskell) -;;; wpc-haskell.el ends here diff --git a/configs/shared/.emacs.d/wpc/packages/wpc-java.el b/configs/shared/.emacs.d/wpc/packages/wpc-java.el deleted file mode 100644 index 4f33ba962e..0000000000 --- a/configs/shared/.emacs.d/wpc/packages/wpc-java.el +++ /dev/null @@ -1,42 +0,0 @@ -;;; wpc-java.el --- Java configuration -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; When life gets you down, and you find yourself writing Java, remember: at -;; least you're using Emacs. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'prelude) -(require 'macros) - -(prelude/assert - (prelude/executable-exists? "google-java-format")) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Configuration -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO: Troubleshoot why this isn't running. -(add-hook-before-save - 'java-mode-hook - (lambda () - (call-interactively - #'google-java-format))) - -(add-hook 'java-mode-hook - (lambda () - (setq c-basic-offset 2 - tab-width 2))) - -;; TODO: Figure out whether I should use this or google-emacs. -;; (use-package lsp-java -;; :config -;; (add-hook 'java-mode-hook #'lsp)) - -(provide 'wpc-java) -;;; wpc-java.el ends here diff --git a/configs/shared/.emacs.d/wpc/packages/wpc-javascript.el b/configs/shared/.emacs.d/wpc/packages/wpc-javascript.el deleted file mode 100644 index 3de9fff3aa..0000000000 --- a/configs/shared/.emacs.d/wpc/packages/wpc-javascript.el +++ /dev/null @@ -1,83 +0,0 @@ -;; wpc-javascript.el --- My Javascript preferences -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; This module hosts my Javascript tooling preferences. This also includes -;; tooling for TypeScript and other frontend tooling. Perhaps this module will -;; change names to more accurately reflect that. -;; -;; Depends -;; - yarn global add prettier - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Configuration -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; Constants -(defconst wpc/js-hooks - '(js-mode-hook web-mode-hook typescript-mode-hook js2-mode-hook rjsx-mode-hook) - "All of the commonly used hooks for Javascript buffers.") - -(defconst wpc/frontend-hooks - (-insert-at 0 'css-mode-hook wpc/js-hooks) - "All of the commonly user hooks for frontend development.") - - -;; frontend indentation settings -(setq typescript-indent-level 2 - js-indent-level 2 - css-indent-offset 2) - -;; Flow for Javascript -(use-package add-node-modules-path - :config - (general-add-hook wpc/js-hooks #'add-node-modules-path)) - -(use-package web-mode - :mode "\\.html\\'" - :config - (setq web-mode-css-indent-offset 2) - (setq web-mode-code-indent-offset 2) - (setq web-mode-markup-indent-offset 2)) - -;; JSX highlighting -(use-package rjsx-mode - :mode "\\.js\\'" - :config - (general-unbind rjsx-mode-map "<" ">" "C-d") - (general-nmap - :keymaps 'rjsx-mode-map - "K" #'flow-minor-type-at-pos) - (setq js2-mode-show-parse-errors nil - js2-mode-show-strict-warnings nil)) - -(progn - (defun tide/setup () - (interactive) - (tide-setup) - (flycheck-mode 1) - (setq flycheck-check-syntax-automatically '(save mode-enabled)) - (eldoc-mode 1) - (tide-hl-identifier-mode 1) - (company-mode 1)) - (use-package tide - :config - (add-hook 'typescript-mode-hook #'tide/setup)) - (require 'web-mode) - (add-to-list 'auto-mode-alist '("\\.tsx\\'" . web-mode)) - (add-hook 'web-mode-hook - (lambda () - (when (string-equal "tsx" (f-ext buffer-file-name)) - (tide/setup)))) - (flycheck-add-mode 'typescript-tslint 'web-mode)) - -;; JS autoformatting -(use-package prettier-js - :after (rjsx-mode) - :config - (general-add-hook wpc/frontend-hooks #'prettier-js-mode)) - -(provide 'wpc-javascript) -;;; wpc-javascript.el ends here diff --git a/configs/shared/.emacs.d/wpc/packages/wpc-keybindings.el b/configs/shared/.emacs.d/wpc/packages/wpc-keybindings.el deleted file mode 100644 index 2ff4fe3758..0000000000 --- a/configs/shared/.emacs.d/wpc/packages/wpc-keybindings.el +++ /dev/null @@ -1,229 +0,0 @@ -;;; keybindings.el --- My Evil preferences -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; This module hosts my Evil preferences -;; -;; Wish List: -;; - restore support for concise (n ) instead of `general-mmap' -;; - restore support for `general-unbind' - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'general) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Packages -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; This may be contraversial, but I never use the prefix key, and I'd prefer to -;; have to bound to the readline function that deletes the entire line. -(general-unbind "C-u") - -(use-package evil - :init - ;; Should remove the warning messages on init. - (setq evil-want-integration t) - ;; TODO: Troubleshoot why this binding causes the following warning: - ;; "Warning (evil-collection): `evil-want-keybinding' was set to nil but not - ;; before loading evil." - (setq evil-want-keybinding nil) - (general-evil-setup) - :config - ;; Ensure that evil's command mode behaves with readline bindings. - (general-define-key - :keymaps 'evil-ex-completion-map - "C-a" #'move-beginning-of-line - "C-e" #'move-end-of-line - "C-k" #'kill-line - "C-u" #'evil-delete-whole-line - "C-v" #'evil-paste-after - "C-d" #'delete-char - "C-f" #'forward-char - "M-b" #'backward-word - "M-f" #'forward-word - "M-d" #'kill-word - "M-DEL" #'backward-kill-word - "C-b" #'backward-char) - ;; TODO: Ensure all of my custom keybindings end up in a single map that is - ;; easy to enable or disable. - (general-mmap - :keymaps 'override - "RET" #'evil-goto-line - "H" #'evil-first-non-blank - "L" #'evil-end-of-line - "_" #'ranger - "-" #'dired-jump - "sl" #'wpc/evil-window-vsplit-right - "sh" #'evil-window-vsplit - "sk" #'evil-window-split - "sj" #'wpc/evil-window-split-down) - (general-nmap - :keymaps 'override - "gd" #'xref-find-definitions - ;; Wrapping `xref-find-references' in the `let' binding to prevent xref from - ;; prompting. There are other ways to handle this variable, such as setting - ;; it globally with `setq' or buffer-locally with `setq-local'. For now, I - ;; prefer setting it with `let', which should bind it in the dynamic scope - ;; for the duration of the `xref-find-references' function call. - "gx" (lambda () - (interactive) - (let ((xref-prompt-for-identifier nil)) - (call-interactively #'xref-find-references)))) - (general-unbind 'motion "M-." "C-p") - (general-unbind 'normal "s" "M-." "C-p" "C-n") - (general-unbind 'insert "C-v" "C-d" "C-a" "C-e" "C-n" "C-p" "C-k") - (setq evil-symbol-word-search t) - (evil-mode 1)) - -;; TODO: Write `evil-collection' KBDs for `refine'. -;; evil keybindings -(use-package evil-collection - :after (evil) - :config - (evil-collection-init)) - -;; `evil-collection' does not support `magit', and the preferred way to get evil -;; kbds for magit is with `evil-magit'. -(use-package evil-magit) - -;; TODO: Consider moving this to another module. -(general-define-key - :prefix "" - :states '(normal) - "i" #'counsel-semantic-or-imenu - "I" #'ibuffer - "hk" #'helpful-callable - "hf" #'helpful-function - "hm" #'helpful-macro - "hc" #'helpful-command - "hk" #'helpful-key - "hv" #'helpful-variable - "hp" #'helpful-at-point - "s" #'flyspell-mode - "S" #'sort-lines - "a" #'wpc-terminal/toggle - "=" #'align - "p" #'flycheck-previous-error - "f" #'wpc/find-file - "n" #'flycheck-next-error - "N" #'smerge-next - "W" #'balance-windows - "gs" #'magit-status - "E" #'refine - "es" #'wpc/create-snippet - ;; TODO: Replace with `macros/ilambda' when that is working again. - "ev" (lambda () (interactive) (wpc/find-file-split "~/.config/nvim/init.vim")) - "ee" (lambda () (interactive) (wpc/find-file-split "~/.emacs.d/init.el")) - "ez" (lambda () (interactive) (wpc/find-file-split "~/.zshrc")) - "ea" (lambda () (interactive) (wpc/find-file-split "~/aliases.zsh")) - "ef" (lambda () (interactive) (wpc/find-file-split "~/functions.zsh")) - "el" (lambda () (interactive) (wpc/find-file-split "~/variables.zsh")) - "ex" (lambda () (interactive) (wpc/find-file-split "~/.Xresources")) - "em" (lambda () (interactive) (wpc/find-file-split "~/.tmux.conf")) - "l" #'locate - "L" #'list-packages - "B" #'magit-blame - "w" #'save-buffer - "r" #'wpc/evil-replace-under-point - "R" #'deadgrep) - -;; create comments easily -(use-package evil-commentary - :after (evil) - :config - (evil-commentary-mode)) - -;; evil surround -(use-package evil-surround - :after (evil) - :config - (global-evil-surround-mode 1)) - -;; I expect in insert mode: -;; C-a: beginning-of-line -;; C-e: end-of-line -;; C-b: backwards-char -;; C-f: forwards-char - -;; TODO: Move these KBD constants to kbd.el. - -(defconst wpc/up-kbds - '("C-p" "C-k" "" "") - "The keybindings that I expect to work for moving upwards in lists.") - -(defconst wpc/down-kbds - '("C-n" "C-j" "" "") - "The keybindings that I expect to work for moving downwards in lists.") - -(defconst wpc/left-kbds - '("C-b" "") - "The keybindings that I expect to move leftwards in insert-like modes.") - -(defconst wpc/right-kbds - '("C-f" "") - "The keybindings that I expect to move rightwards in insert-like modes.") - -(defun wpc/ensure-kbds (_ignore) - "Try to ensure that my keybindings retain priority over other minor modes." - (unless (eq (caar minor-mode-map-alist) 'wpc/kbds-minor-mode) - (let ((mykbds (assq 'wpc/kbds-minor-mode minor-mode-map-alist))) - (assq-delete-all 'wpc/kbds-minor-mode minor-mode-map-alist) - (add-to-list 'minor-mode-map-alist mykbds)))) - -;; Custom minor mode that ensures that my kbds are available no matter which -;; major or minor modes are active. -(add-hook 'after-load-functions #'wpc/ensure-kbds) - -;; TODO: Prefer using general and 'override maps to implement this. -(defvar wpc/kbds - (let ((map (make-sparse-keymap))) - (bind-keys :map map - ("M-q" . delete-window) - ("" . toggle-frame-fullscreen) - ("M-h" . windmove-left) - ("M-l" . windmove-right) - ("M-k" . windmove-up) - ("M-j" . windmove-down) - ("M-q" . delete-window)) - map) - "William Carroll's keybindings that should have the highest precedence.") - -;; Support pasting in M-:. -(general-define-key - :keymaps 'read-expression-map - "C-v" #'clipboard-yank - "C-S-v" #'clipboard-yank) - -(define-minor-mode wpc/kbds-minor-mode - "A minor mode so that my key settings override annoying major modes." - :init-value t - :lighter " wpc/kbds" - :keymap wpc/kbds) - -;; allow jk to escape -(use-package key-chord - :after (evil) - :config - (key-chord-mode 1) - (key-chord-define evil-insert-state-map "jk" 'evil-normal-state)) - -;; Ensure the Evil search results get centered vertically. -;; TODO: Consider packaging this up for others. -(progn - (defadvice isearch-update - (before advice-for-isearch-update activate) - (evil-scroll-line-to-center (line-number-at-pos))) - (defadvice evil-search-next - (after advice-for-evil-search-next activate) - (evil-scroll-line-to-center (line-number-at-pos))) - (defadvice evil-search-previous - (after advice-for-evil-search-previous activate) - (evil-scroll-line-to-center (line-number-at-pos)))) - -(provide 'wpc-keybindings) -;;; wpc-keybindings.el ends here diff --git a/configs/shared/.emacs.d/wpc/packages/wpc-lisp.el b/configs/shared/.emacs.d/wpc/packages/wpc-lisp.el deleted file mode 100644 index 1eeb8550a2..0000000000 --- a/configs/shared/.emacs.d/wpc/packages/wpc-lisp.el +++ /dev/null @@ -1,111 +0,0 @@ -;;; lisp.el --- Generic LISP preferences -*- lexical-binding: t -*- -;; Author: William Carroll - -;; parent (up) -;; child (down) -;; prev-sibling (left) -;; next-sibling (right) - -;;; Code: - -;; TODO: Consider having a separate module for each LISP dialect. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'general) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Configuration -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst wpc/lisp-mode-hooks - '(lisp-mode-hook - emacs-lisp-mode-hook - clojure-mode-hook - clojurescript-mode-hook - racket-mode-hook) - "List of LISP modes.") - -(use-package sly - :config - (setq inferior-lisp-program "sbcl") - (general-define-key - :keymaps 'sly-mode-map - :states '(normal) - :prefix "" - "x" #'sly-eval-defun - "X" #'sly-eval-buffer - "d" #'sly-describe-symbol)) - -(use-package rainbow-delimiters - :config - (general-add-hook wpc/lisp-mode-hooks #'rainbow-delimiters-mode)) - -(use-package racket-mode - :config - (general-define-key - :keymaps 'racket-mode-map - :states 'normal - :prefix "" - "x" #'racket-send-definition - "X" #'racket-run - "d" #'racket-describe) - (setq racket-program "~/.nix-profile/bin/racket")) - -(use-package lispyville - :init - (defconst lispyville-key-themes - '(c-w - operators - text-objects - prettify - commentary - slurp/barf-cp - wrap - additional - additional-insert - additional-wrap - escape) - "All available key-themes in Lispyville.") - :config - (general-add-hook wpc/lisp-mode-hooks #'lispyville-mode) - (lispyville-set-key-theme lispyville-key-themes) - (progn - (general-define-key - :keymaps 'lispyville-mode-map - :states 'motion - ;; first unbind - "M-h" nil - "M-l" nil) - (general-define-key - :keymaps 'lispyville-mode-map - :states 'normal - ;; first unbind - "M-j" nil - "M-k" nil - ;; second rebind - "C-s-h" #'lispyville-drag-backward - "C-s-l" #'lispyville-drag-forward - "C-s-e" #'lispyville-end-of-defun - "C-s-a" #'lispyville-beginning-of-defun))) - -;; Elisp -(use-package elisp-slime-nav - :config - (general-add-hook 'emacs-lisp-mode #'ielm-mode)) - -(general-define-key - :keymaps 'emacs-lisp-mode-map - :prefix "" - :states 'normal - "x" #'eval-defun - "X" #'eval-buffer - "d" (lambda () - (interactive) - (with-current-buffer (current-buffer) - (helpful-function (symbol-at-point))))) - -(provide 'wpc-lisp) -;;; wpc-lisp.el ends here diff --git a/configs/shared/.emacs.d/wpc/packages/wpc-misc.el b/configs/shared/.emacs.d/wpc/packages/wpc-misc.el deleted file mode 100644 index 167c4b88ab..0000000000 --- a/configs/shared/.emacs.d/wpc/packages/wpc-misc.el +++ /dev/null @@ -1,248 +0,0 @@ -;;; misc.el --- Hosting miscellaneous configuration -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; This is the home of any configuration that couldn't find a better home. - -;;; Code: - -;; Display time in the modeline -;; TODO: Save preferred date format strings and cycle through them since I waver -;; about which is my favorite. -(setq display-time-format "%R %a %d %b [%U of 52 weeks]") -(display-time-mode 1) - -;; disable custom variable entries from being written to ~/.emacs.d/init.el -(setq custom-file "~/.emacs.d/custom.el") -(load custom-file 'noerror) - -;; integrate Emacs with X11 clipboard -(setq select-enable-primary t) -(setq select-enable-clipboard t) -(general-def 'insert - "s-v" #'clipboard-yank - "C-S-v" #'clipboard-yank) - -;; transparently edit compressed files -(auto-compression-mode t) - -;; autowrap when over the fill-column -(setq-default auto-fill-function #'do-auto-fill) - -;; link to Emacs source code -;; TODO: Update this link. -(setq find-function-C-source-directory - "~/Dropbox/programming/emacs/src") - -;; change emacs prompts from "yes or no" -> "y or n" -(fset 'yes-or-no-p 'y-or-n-p) - -;; open photos in Emacs -(auto-image-file-mode 1) - -;; disable line-wrapping -(setq-default truncate-lines 1) - -;; shell file indentation -(setq sh-basic-offset 2) -(setq sh-indentation 2) - -;; Emacs library that interfaces with my Linux password manager. -(use-package password-store) - -;; Use en Emacs buffer as a REST client. -;; For more information: http://emacsrocks.com/e15.html -(use-package restclient) - -;; Run `package-lint' before publishing to MELPA. -(use-package package-lint) - -;; Parser combinators in Elisp. -(use-package parsec) - -;; disable company mode when editing markdown -;; TODO: move this out of wpc-misc.el and into a later file to call -;; `(disable company-mode)' -(use-package markdown-mode - :config - ;; TODO: Add assertion that pandoc is installed and it is accessible from - ;; Emacs. - (setq markdown-command "pandoc") - (setq markdown-split-window-direction 'right) - ;; (add-hook 'markdown-mode-hook #'markdown-live-preview-mode) - ) - -(use-package alert) - -(use-package refine) - -;; Required by some google-emacs package commands. -(use-package deferred) - -;; git integration -(use-package magit - :config - (setq magit-display-buffer-function - #'magit-display-buffer-fullframe-status-v1)) - -(use-package magit-popup) - -;; http -(use-package request) - -;; perl-compatible regular expressions -(use-package pcre2el) - -;; alternative to help -(use-package helpful) - -;; Emacs integration with direnv -(use-package direnv - :config - (direnv-mode)) - -;; Superior Elisp library for working with dates and times. -;; TODO: Put this where my other installations for dash.el, s.el, a.el, and -;; other utility Elisp libraries are located. -(use-package ts) - -;; persist history etc b/w Emacs sessions -(setq desktop-save 'if-exists) -(desktop-save-mode 1) -(setq desktop-globals-to-save - (append '((extended-command-history . 30) - (file-name-history . 100) - (grep-history . 30) - (compile-history . 30) - (minibuffer-history . 50) - (query-replace-history . 60) - (read-expression-history . 60) - (regexp-history . 60) - (regexp-search-ring . 20) - (search-ring . 20) - (shell-command-history . 50) - tags-file-name - register-alist))) - -;; config Emacs to use $PATH values -(use-package exec-path-from-shell - :if (memq window-system '(mac ns)) - :config - (exec-path-from-shell-initialize)) - -;; Emacs autosave, backup, interlocking files -(setq auto-save-default nil - make-backup-files nil - create-lockfiles nil) - -;; ensure code wraps at 80 characters by default -(setq-default fill-column constants/fill-column) - -(put 'narrow-to-region 'disabled nil) - -;; trim whitespace on save -(add-hook 'before-save-hook #'delete-trailing-whitespace) - -;; use tabs instead of spaces -(setq-default indent-tabs-mode nil) - -;; automatically follow symlinks -(setq vc-follow-symlinks t) - -;; fullscreen settings -(defvar ns-use-native-fullscreen nil) - -;; auto-close parens, brackets, quotes -(electric-pair-mode 1) - -(use-package yasnippet - :config - (setq yas-snippet-dirs '("~/.emacs.d/snippets/")) - (yas-global-mode 1)) - -(use-package projectile - :config - (projectile-mode t)) - -(use-package deadgrep - :config - (general-define-key - :keymaps 'deadgrep-mode-map - :states 'normal - "o" #'deadgrep-visit-result-other-window) - (setq-default deadgrep--context '(0 . 3)) - (defun deadgrep/region () - "Run a ripgrep search on the active region." - (interactive) - (deadgrep (region/to-string))) - (defun deadgrep/dwim () - "If a region is active, use that as the search, otherwise don't." - (interactive) - (with-current-buffer (current-buffer) - (if (region-active-p) - (setq deadgrep--additional-flags '("--multiline")) - (deadgrep/region) - (call-interactively #'deadgrep)))) - (advice-add - 'deadgrep--format-command - :filter-return - (lambda (cmd) - (replace-regexp-in-string - "^rg " "rg --hidden " cmd)))) - -;; TODO: Do I need this when I have swiper? -(use-package counsel) - -(use-package counsel-projectile) - -;; search Google, Stackoverflow from within Emacs -(use-package engine-mode - :config - (defengine google - "http://www.google.com/search?ie=utf-8&oe=utf-8&q=%s" - :keybinding "g") - (defengine stack-overflow - "https://stackoverflow.com/search?q=%s" - :keybinding "s")) - -;; EGlot (another LSP client) -(use-package eglot) - -;; Microsoft's Debug Adapter Protocol (DAP) -(use-package dap-mode - :after lsp-mode - :config - (dap-mode 1) - (dap-ui-mode 1)) - -;; Microsoft's Language Server Protocol (LSP) -(use-package lsp-ui - :config - (add-hook 'lsp-mode-hook #'lsp-ui-mode)) - -(use-package company-lsp - :config - (push 'company-lsp company-backends)) - -;; Wilfred/suggest.el - Tool for discovering functions basesd on declaring your -;; desired inputs and outputs. -(use-package suggest) - -;; Malabarba/paradox - Enhances the `list-packages' view. -(use-package paradox - :config - (paradox-enable)) - -;; TODO: Consider supporting a wpc-elisp.el package for Elisp tooling. -;; The following functions are quite useful for Elisp development: -;; - `emr-el-find-unused-definitions' -(use-package emr - :config - (define-key prog-mode-map (kbd "M-RET") #'emr-show-refactor-menu)) - -(defun wpc/frame-name () - "Return the name of the current frame." - (frame-parameter nil 'name)) - -(provide 'wpc-misc) -;;; wpc-misc.el ends here diff --git a/configs/shared/.emacs.d/wpc/packages/wpc-nix.el b/configs/shared/.emacs.d/wpc/packages/wpc-nix.el deleted file mode 100644 index 68d542e011..0000000000 --- a/configs/shared/.emacs.d/wpc/packages/wpc-nix.el +++ /dev/null @@ -1,56 +0,0 @@ -;;; wpc-nix.el --- Nix support -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Configuration to support working with Nix. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(prelude/assert (f-exists? "~/universe")) -(prelude/assert (f-exists? "~/depot")) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; Code: -(use-package nix-mode - :mode "\\.nix\\'") - -(defun nix/sly-from-universe (attribute) - "Start a Sly REPL configured with a Lisp matching a derivation - from my monorepo. - -This function was taken from @tazjin's depot and adapted for my monorepo. - - The derivation invokes nix.buildLisp.sbclWith and is built - asynchronously. The build output is included in the error - thrown on build failures." - (interactive "sAttribute: ") - (lexical-let* ((outbuf (get-buffer-create (format "*universe-out/%s*" attribute))) - (errbuf (get-buffer-create (format "*universe-errors/%s*" attribute))) - (expression (format "let depot = import {}; universe = import {}; in depot.nix.buildLisp.sbclWith [ universe.%s ]" attribute)) - (command (list "nix-build" "-E" expression))) - (message "Acquiring Lisp for .%s" attribute) - (make-process :name (format "depot-nix-build/%s" attribute) - :buffer outbuf - :stderr errbuf - :command command - :sentinel - (lambda (process event) - (unwind-protect - (pcase event - ("finished\n" - (let* ((outpath (s-trim (with-current-buffer outbuf (buffer-string)))) - (lisp-path (s-concat outpath "/bin/sbcl"))) - (message "Acquired Lisp for .%s at %s" attribute lisp-path) - (sly lisp-path))) - (_ (with-current-buffer errbuf - (error "Failed to build '%s':\n%s" attribute (buffer-string))))) - (kill-buffer outbuf) - (kill-buffer errbuf)))))) - -(provide 'wpc-nix) -;;; wpc-nix.el ends here diff --git a/configs/shared/.emacs.d/wpc/packages/wpc-ocaml.el b/configs/shared/.emacs.d/wpc/packages/wpc-ocaml.el deleted file mode 100644 index 26add2d6f9..0000000000 --- a/configs/shared/.emacs.d/wpc/packages/wpc-ocaml.el +++ /dev/null @@ -1,43 +0,0 @@ -;;; wpc-ocaml.el --- My OCaml preferences -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Tooling support for OCaml development. -;; -;; Dependencies: -;; - `opam install tuareg` -;; - `opam install merlin` -;; - `opam install user-setup && opam user-setup install` -;; - `opam install ocamlformat` - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'prelude) -(require 'f) - -(prelude/assert - (prelude/executable-exists? "opam")) - -(defvar opam-user-setup "~/.emacs.d/opam-user-setup.el" - "File for the OPAM Emacs integration.") - -(prelude/assert (f-file? opam-user-setup)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Configuration -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(use-package tuareg - :config - (add-hook-before-save 'tuareg-mode-hook #'ocamlformat-before-save)) - -;; ocamlformat -(require 'opam-user-setup "~/.emacs.d/opam-user-setup.el") -(require 'ocamlformat) - -(provide 'wpc-ocaml) -;;; wpc-ocaml.el ends here diff --git a/configs/shared/.emacs.d/wpc/packages/wpc-org.el b/configs/shared/.emacs.d/wpc/packages/wpc-org.el deleted file mode 100644 index 3263fb5038..0000000000 --- a/configs/shared/.emacs.d/wpc/packages/wpc-org.el +++ /dev/null @@ -1,70 +0,0 @@ -;;; org.el --- My org preferences -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Hosts my org mode preferences - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'f) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Configuration -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(setq org-directory "~/Dropbox/org") - -;; TODO: figure out how to nest this in (use-package org ...) -(setq org-capture-templates - `(("w" "work" entry (file+headline - ,(f-join org-directory "work.org") - "Tasks") - "* TODO %?") - ("p" "personal" entry (file+headline - ,(f-join org-directory "personal.org") - "Tasks") - "* TODO %? ") - ("i" "ideas" entry (file+headline - ,(f-join org-directory "ideas.org") - "Tasks") - "* %? ") - ("s" "shopping list" entry (file+headline - ,(f-join org-directory "shopping.org") - "Items") - "* TODO %? "))) - -(evil-set-initial-state 'org-mode 'normal) - -(use-package org - :config - (general-add-hook 'org-mode-hook - ;; TODO: consider supporting `(disable (list linum-mode company-mode))' - (list (disable linum-mode) - (disable company-mode))) - (general-define-key :prefix "C-c" - "l" #'org-store-link - "a" #'org-agenda - "c" #'org-capture) - (setq org-startup-folded nil) - (setq org-todo-keywords - '((sequence "TODO" "BLOCKED" "DONE"))) - (setq org-default-notes-file (f-join org-directory "notes.org")) - (setq org-agenda-files (list (f-join org-directory "work.org") - (f-join org-directory "personal.org"))) - ;; TODO: troubleshoot why `wpc/kbds-minor-mode', `wpc/ensure-kbds' aren't - ;; enough to override the following KBDs. See this discussion for more context - ;; on where the idea came from: - ;; https://stackoverflow.com/questions/683425/globally-override-key-binding-in-emacs - (general-unbind 'normal org-mode-map "M-h" "M-j" "M-k" "M-l")) - -(use-package org-bullets - :after (org) - :config - (general-add-hook 'org-mode-hook (enable org-bullets-mode))) - -(provide 'wpc-org) -;;; wpc-org.el ends here diff --git a/configs/shared/.emacs.d/wpc/packages/wpc-package.el b/configs/shared/.emacs.d/wpc/packages/wpc-package.el deleted file mode 100644 index 6f43330ecb..0000000000 --- a/configs/shared/.emacs.d/wpc/packages/wpc-package.el +++ /dev/null @@ -1,27 +0,0 @@ -;;; package.el --- My package configuration -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; This module hosts all of the settings required to work with ELPA, -;; MELPA, QUELPA, and co. - -;;; Code: - -(require 'package) -(add-to-list 'package-archives '("melpa" . "http://melpa.org/packages/")) -(package-initialize) - -(unless (package-installed-p 'use-package) - (package-refresh-contents) - (package-install 'use-package)) -(eval-when-compile - (require 'use-package)) -(setq use-package-always-ensure t) -(use-package general) - -(add-to-list 'load-path "~/.emacs.d/vendor/") -(add-to-list 'load-path "~/.emacs.d/wpc/") -(add-to-list 'load-path "~/.emacs.d/wpc/packages") - -(provide 'wpc-package) -;;; wpc-package.el ends here diff --git a/configs/shared/.emacs.d/wpc/packages/wpc-prolog.el b/configs/shared/.emacs.d/wpc/packages/wpc-prolog.el deleted file mode 100644 index 94e705b1b1..0000000000 --- a/configs/shared/.emacs.d/wpc/packages/wpc-prolog.el +++ /dev/null @@ -1,16 +0,0 @@ -;;; wpc-prolog.el --- For Prologging things -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Code configuring my Prolog work. - -;;; Code: - -(require 'macros) - -;; TODO: Notice that the .pl extension conflicts with Perl files. This may -;; become a problem should I start working with Perl. -(macros/support-file-extension "pl" prolog-mode) - -(provide 'wpc-prolog) -;;; wpc-prolog.el ends here diff --git a/configs/shared/.emacs.d/wpc/packages/wpc-python.el b/configs/shared/.emacs.d/wpc/packages/wpc-python.el deleted file mode 100644 index 25f1a4816a..0000000000 --- a/configs/shared/.emacs.d/wpc/packages/wpc-python.el +++ /dev/null @@ -1,21 +0,0 @@ -;;; wpc-python.el --- Python configuration -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; My Python configuration settings -;; -;; Depends -;; - `apti yapf` - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Configuration -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(use-package py-yapf - :config - (add-hook 'python-mode-hook #'py-yapf-enable-on-save)) - -(provide 'wpc-python) -;;; wpc-python.el ends here diff --git a/configs/shared/.emacs.d/wpc/packages/wpc-reasonml.el b/configs/shared/.emacs.d/wpc/packages/wpc-reasonml.el deleted file mode 100644 index 909c33d121..0000000000 --- a/configs/shared/.emacs.d/wpc/packages/wpc-reasonml.el +++ /dev/null @@ -1,29 +0,0 @@ -;;; wpc-reasonml.el --- My ReasonML preferences -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Tooling support for ReasonML development. -;; -;; Dependencies: -;; - `opam install tuareg` -;; - `opam install merlin` -;; - `opam install user-setup` -;; - `opam install ocamlformat` - -;;; Code: - -;; ReasonML configuration -(use-package reason-mode - :config - (add-hook-before-save 'reason-mode-hook #'refmt-before-save)) - -;; ReasonML LSP configuration -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection (f-full "~/programming/dependencies/reason-language-server")) - :major-modes '(reason-mode) - :notification-handlers (ht ("client/registerCapability" 'ignore)) - :priority 1 - :server-id 'reason-ls)) - -(provide 'wpc-reasonml) -;;; wpc-reasonml.el ends here diff --git a/configs/shared/.emacs.d/wpc/packages/wpc-rust.el b/configs/shared/.emacs.d/wpc/packages/wpc-rust.el deleted file mode 100644 index fafa27d18c..0000000000 --- a/configs/shared/.emacs.d/wpc/packages/wpc-rust.el +++ /dev/null @@ -1,34 +0,0 @@ -;;; wpc-rust.el --- Support Rust language -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Supports my Rust work. -;; -;; Dependencies: -;; - `rustup` -;; - `rustup component add rust-src` -;; - `rustup toolchain add nightly && cargo +nightly install racer` - - -;;; Code: -(use-package racer - :config - (setq rust-sysroot (->> "~/.cargo/bin/rustc --print sysroot" - shell-command-to-string - s-trim-right)) - (setq racer-rust-src-path (f-join rust-sysroot "lib/rustlib/src/rust/src")) - (add-hook 'racer-mode-hook #'eldoc-mode)) - -(use-package rust-mode - :config - (add-hook 'rust-mode-hook #'racer-mode) - (add-hook-before-save 'rust-mode-hook #'rust-format-buffer) - (define-key rust-mode-map - (kbd "TAB") - #'company-indent-or-complete-common) - (define-key rust-mode-map - (kbd "M-d") - #'racer-describe)) - -(provide 'wpc-rust) -;;; wpc-rust.el ends here diff --git a/configs/shared/.emacs.d/wpc/packages/wpc-shell.el b/configs/shared/.emacs.d/wpc/packages/wpc-shell.el deleted file mode 100644 index 803a3232ef..0000000000 --- a/configs/shared/.emacs.d/wpc/packages/wpc-shell.el +++ /dev/null @@ -1,17 +0,0 @@ -;;; wpc-shell.el --- POSIX Shell scripting support -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Helpers for my shell scripting. Includes bash, zsh, etc. - -;;; Code: - -(use-package flymake-shellcheck - :commands flymake-shellcheck-load - :init - (add-hook 'sh-mode-hook #'flymake-shellcheck-load)) - -(use-package fish-mode) - -(provide 'wpc-shell) -;;; wpc-shell.el ends here diff --git a/configs/shared/.emacs.d/wpc/packages/wpc-terminal.el b/configs/shared/.emacs.d/wpc/packages/wpc-terminal.el deleted file mode 100644 index c232bb85a7..0000000000 --- a/configs/shared/.emacs.d/wpc/packages/wpc-terminal.el +++ /dev/null @@ -1,70 +0,0 @@ -;;; terminal.el --- My cobbled together terminal -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; My attempts at creating a sane Emacs terminal. Most of this work was created -;; before I discovered and fully adopted EXWM. Prior to this, the appeal of -;; having terminals inside of Emacs was appealing. So appealing in fact that I -;; was willing to work with inferior alternatives to non-Emacs terminals -;; (e.g. `ansi-term') instead of GUI alternatives like `alacritty` because the -;; productivity gains of having a terminal inside of Emacs might outweigh the -;; shortcomings of that particular terminal. -;; -;; All of this changed, however, after discovering EXWM, since I can embed X11 -;; GUI windows inside of Emacs. Therefore, most of this module is maintained -;; for historical purposes. -;; -;; Benefits of `ansi-term': -;; - Color scheme remains consistent between Emacs and terminal. -;; - Same applies to my fonts. -;; -;; Downsides of `ansi-term': -;; - Paging feels sluggish with programs like `cat` and `less`. -;; - KBDs don't provide 100% coverage of what I expect from a terminal since -;; they were created to cooperate with Emacs. - -;;; Code: - -(require 'window) -(require 'buffer) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO: Model all open terminals within a dictionary. - -(defconst wpc-terminal/name - "wpc/terminal" - "The name of my terminal buffers.") - -(defun wpc-terminal/find-window () - "Return a reference to an existing terminal window or nil." - (->> wpc-terminal/name - wpc/add-earmuffs - window/find)) - -(defun wpc-terminal/find-buffer () - "Return a reference to an existing terminal buffer." - (->> wpc-terminal/name - wpc/add-earmuffs - buffer/find)) - -(defun wpc-terminal/find-or-create () - "Find or create a terminal window." - (let ((buffer (wpc-terminal/find-buffer))) - (if buffer - (buffer/show buffer) - (ansi-term "/usr/bin/zsh" wpc-terminal/name)))) - -;; TODO: Focus terminal after toggling it. -(defun wpc-terminal/toggle () - "Toggle a custom terminal session in Emacs." - (interactive) - (let ((window (wpc-terminal/find-window))) - (if window - (window/delete window) - (wpc-terminal/find-or-create)))) - -(provide 'wpc-terminal) -;;; wpc-terminal.el ends here diff --git a/configs/shared/.emacs.d/wpc/packages/wpc-ui.el b/configs/shared/.emacs.d/wpc/packages/wpc-ui.el deleted file mode 100644 index 6ac587c465..0000000000 --- a/configs/shared/.emacs.d/wpc/packages/wpc-ui.el +++ /dev/null @@ -1,179 +0,0 @@ -;;; wpc-ui.el --- Any related to the UI/UX goes here -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Hosts font settings, scrolling, color schemes. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'prelude) -(require 'alist) -(require 'themes) -(require 'device) -(require 'laptop-battery) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Configuration -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; increase line height -(setq-default line-spacing 4) - -;; Ensure that buffers update when their contents change on disk. -(global-auto-revert-mode t) - -;; smooth scrolling settings -(setq scroll-step 1 - scroll-conservatively 10000) - -;; clean up modeline -(use-package diminish - :config - (diminish 'emacs-lisp-mode "elisp") - (diminish 'evil-commentary-mode) - (diminish 'flycheck-mode) - (diminish 'auto-revert-mode) - (diminish 'which-key-mode) - (diminish 'yas-minor-mode) - (diminish 'lispyville-mode) - (diminish 'undo-tree-mode) - (diminish 'company-mode) - (diminish 'projectile-mode) - (diminish 'eldoc-mode) - ;; This is how to diminish `auto-fill-mode'. - (diminish 'auto-fill-function) - (diminish 'counsel-mode) - (diminish 'ivy-mode)) - -;; TODO: Further customize `mode-line-format' variable. -(delete 'mode-line-modes mode-line-format) -(delete '(vc-mode vc-mode) mode-line-format) - -;; disable startup screen -(setq inhibit-startup-screen t) - -;; disable toolbar -(tool-bar-mode -1) - -;; TODO: Re-enable `linum-mode' when I figure out why the theming is so ugly. -;; enable line numbers -;; (general-add-hook '(prog-mode-hook -;; text-mode-hook -;; conf-mode-hook) -;; (enable linum-mode)) - -;; set default buffer for Emacs -(setq initial-buffer-choice constants/current-project) - -;; TODO: Re-enable this when base16-wpgtk are looking better. -;; integration with wpgtk (in vendor directory) -;; (require 'wpgtk-theme) - -;; base-16 themes to integrate with wpgtk -;; (use-package base16-theme -;; :config -;; (require 'wpgtk) -;; (colorscheme/set 'base16-wpgtk)) - -;; premium Emacs themes -(use-package doom-themes - :config - (setq doom-themes-enable-bold t - doom-themes-enable-italic t) - (doom-themes-visual-bell-config) - (doom-themes-org-config)) - -;; file browsing -(use-package neotree - :config - (global-set-key [f8] #'neotree-toggle)) - -;; kbd discovery -(use-package which-key - :config - (setq which-key-idle-delay 0.25) - (which-key-mode)) - -;; completion framework -(use-package ivy - :config - (counsel-mode t) - (ivy-mode t) - (alist/set! #'counsel-M-x "" ivy-initial-inputs-alist) - ;; prefer using `helpful' variants - (progn - (setq counsel-describe-function-function #'helpful-callable) - (setq counsel-describe-variable-function #'helpful-variable)) - (general-define-key - :keymaps 'ivy-minibuffer-map - ;; prev - "C-k" #'ivy-previous-line - "" #'ivy-previous-line - ;; next - "C-j" #'ivy-next-line - "" #'ivy-next-line)) - -(use-package ivy-prescient - :config - (ivy-prescient-mode 1) - (prescient-persist-mode 1)) - -;; all-the-icons -(use-package all-the-icons - :config - (unless (f-exists? "~/.local/share/fonts/all-the-icons.ttf") - (all-the-icons-install-fonts))) - -;; icons for Ivy -(use-package all-the-icons-ivy - :after (ivy all-the-icons) - :config - (all-the-icons-ivy-setup)) - -;; disable menubar -(menu-bar-mode -1) - -;; reduce noisiness of auto-revert-mode -(setq auto-revert-verbose nil) - -;; highlight lines that are over `constants/fill-column' characters long -(use-package whitespace - :config - ;; TODO: This should change depending on the language and project. For - ;; example, Google Java projects prefer 100 character width instead of 80 - ;; character width. - (setq whitespace-line-column constants/fill-column) - (setq whitespace-style '(face lines-tail)) - (add-hook 'prog-mode-hook #'whitespace-mode)) - -;; dirname/filename instead of filename -(setq uniquify-buffer-name-style 'forward) - -;; highlight matching parens, brackets, etc -(show-paren-mode 1) - -;; hide the scroll-bars in the GUI -(scroll-bar-mode -1) - -;; TODO: Learn how to properly integrate this with dunst or another system-level -;; notification program. -;; GUI alerts in emacs -(use-package alert - :commands (alert) - :config - (setq alert-default-style 'notifier)) - -;; TODO: Should `device/work-laptop?' be a function or a constant that gets set -;; during initialization? -(when (device/work-laptop?) - (laptop-battery/display)) - -;; Load a theme -(themes/set "Solarized Light") - -(provide 'wpc-ui) -;;; wpc-ui.el ends here diff --git a/configs/shared/.emacs.d/wpc/playback.el b/configs/shared/.emacs.d/wpc/playback.el deleted file mode 100644 index e7ad4b2481..0000000000 --- a/configs/shared/.emacs.d/wpc/playback.el +++ /dev/null @@ -1,41 +0,0 @@ -;;; playback.el --- Control playback with Elisp -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; As you know, my whole universe is turning Elisp, so this should too! - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'prelude) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun playback/prev () - "Move to the previous song." - (interactive) - (prelude/start-process - :name "playback/prev" - :command "playerctl previous")) - -(defun playback/next () - "Move to the next song." - (interactive) - (prelude/start-process - :name "playback/next" - :command "playerctl next")) - -(defun playback/play-pause () - "Play or pause the current song." - (interactive) - (prelude/start-process - :name "playback/play-pause" - :command "playerctl play-pause")) - -(provide 'playback) -;;; playback.el ends here diff --git a/configs/shared/.emacs.d/wpc/polymorphism.el b/configs/shared/.emacs.d/wpc/polymorphism.el deleted file mode 100644 index 09045f7fb2..0000000000 --- a/configs/shared/.emacs.d/wpc/polymorphism.el +++ /dev/null @@ -1,37 +0,0 @@ -;;; polymorphism.el --- Sketching my ideas for polymorphism in Elisp -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Once again: modelled after Elixir. - -;;; Code: - -;; More sketches of Elisp polymorphism initiative. -;; -;; Two macros: -;; - `defprotocol' -;; - `definstance' -;; -;; Is it just a coincidence that these two macros have the same number of -;;characters or is that fate? I say fate. -;; -;; (defprotocol monoid -;; :functions (empty concat)) -;; -;; (definstance monoid vector -;; :empty -;; (lambda () []) -;; :concat -;; #'vector/concat) -;; -;; More sketching... -;; (defun monoid/empty () -;; "Sketch." -;; (funcall #'(,(monoid/classify)/empty))) -;; (defun monoid/concat (xs) -;; "Sketch." -;; (apply #'(,(monoid/classify)/concat) args)) - - -(provide 'polymorphism) -;;; polymorphism.el ends here diff --git a/configs/shared/.emacs.d/wpc/prelude.el b/configs/shared/.emacs.d/wpc/prelude.el deleted file mode 100644 index 6ef9e3ba7a..0000000000 --- a/configs/shared/.emacs.d/wpc/prelude.el +++ /dev/null @@ -1,149 +0,0 @@ -;;; prelude.el --- My attempt at augmenting Elisp stdlib -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Some of these ideas are scattered across other modules like `fs', -;; `string-functions', etc. I'd like to keep everything modular. I still don't -;; have an answer for which items belond in `misc'; I don't want that to become -;; a dumping grounds. Ideally this file will `require' all other modules and -;; define just a handful of functions. - -;; TODO: Consider removing all dependencies from prelude.el. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Third-party libraries -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 's) -(require 'dash) -(require 'f) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Libraries -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO: Maybe don't globally import everything here. Disable these and attepmt -;; to reload Emacs to assess damage. -(require 'string) -(require 'list) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Utilities -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun prelude/to-string (x) - "Convert X to a string." - (format "%s" x)) - -(defun prelude/inspect (&rest args) - "Message `ARGS' where ARGS are any type." - (->> args - (list/map #'prelude/to-string) - (apply #'string/concat) - message)) - -(defmacro prelude/call-process-to-string (cmd &rest args) - "Return the string output of CMD called with ARGS." - `(with-temp-buffer - (call-process ,cmd nil (current-buffer) nil ,@args) - (buffer-string))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Assertions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO: Should I `throw' instead of `error' here? -(defmacro prelude/assert (x) - "Errors unless X is t. -These are strict assertions and purposely do not rely on truthiness." - (let ((as-string (prelude/to-string x))) - `(unless (equal t ,x) - (error (string/concat "Assertion failed: " ,as-string))))) - -(defmacro prelude/refute (x) - "Errors unless X is nil." - (let ((as-string (prelude/to-string x))) - `(unless (equal nil ,x) - (error (string/concat "Refutation failed: " ,as-string))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Adapter functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun prelude/identity (x) - "Return X unchanged." - x) - -(defun prelude/const (x) - "Return a variadic lambda that will return X." - (lambda (&rest _) x)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Miscellaneous -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO: Consider packaging these into a linum-color.el package. -;; TODO: Generate the color used here from the theme. -(defvar linum/safe? nil - "Flag indicating whether or not it is safe to work with `linum-mode'.") - -(defvar linum/mru-color nil - "Stores the color most recently attempted to be applied.") - -(add-hook 'linum-mode-hook - (lambda () - (setq linum/safe? t) - (when (maybe/some? linum/mru-color) - (set-face-foreground 'linum linum/mru-color)))) - -(defun prelude/set-line-number-color (color) - "Safely set linum color to `COLOR'. - -If this is called before Emacs initializes, the color will be stored in -`linum/mru-color' and applied once initialization completes. - -Why is this safe? -If `(set-face-foreground 'linum)' is called before initialization completes, -Emacs will silently fail. Without this function, it is easy to introduce -difficult to troubleshoot bugs in your init files." - (if linum/safe? - (set-face-foreground 'linum color) - (setq linum/mru-color color))) - -(defun prelude/prompt (prompt) - "Read input from user with PROMPT." - (read-string prompt)) - -(cl-defun prelude/start-process (&key name command) - "Pass command string, COMMAND, and the function name, NAME. -This is a wrapper around `start-process' that has an API that resembles -`shell-command'." - ;; TODO: Fix the bug with tokenizing here, since it will split any whitespace - ;; character, even though it shouldn't in the case of quoted string in shell. - ;; e.g. - "xmodmap -e 'one two three'" => '("xmodmap" "-e" "'one two three'") - (prelude/refute (string/contains? "'" command)) - (let* ((tokens (string/split " " command)) - (program-name (list/head tokens)) - (program-args (list/tail tokens))) - (apply #'start-process - `(,(string/format "*%s<%s>*" program-name name) - ,nil - ,program-name - ,@program-args)))) - -(defun prelude/executable-exists? (name) - "Return t if CLI tool NAME exists according to `exec-path'." - (let ((file (locate-file name exec-path))) - (require 'maybe) - (if (maybe/some? file) - (f-exists? file) - nil))) - -(defmacro prelude/time (x) - "Print the time it takes to evaluate X." - `(benchmark 1 ',x)) - -(provide 'prelude) -;;; prelude.el ends here diff --git a/configs/shared/.emacs.d/wpc/prelude.nix b/configs/shared/.emacs.d/wpc/prelude.nix deleted file mode 100644 index 626d4526a2..0000000000 --- a/configs/shared/.emacs.d/wpc/prelude.nix +++ /dev/null @@ -1,11 +0,0 @@ -{ pkgs ? import (builtins.fetchTarball - "https://github.com/tazjin/depot/archive/master.tar.gz") {} }: - -# Ciruclar dependency warning: list.nix depends on prelude.nix, which depends on -# list.nix. -pkgs.writeElispBin { - name = "prelude"; - # If this can build with epkgs.ht, remove `(require 'ht)`. - deps = epkgs: [ epkgs.s epkgs.dash epkgs.f ./string.nix ./list.nix ]; - src = ./prelude.el; -} diff --git a/configs/shared/.emacs.d/wpc/pulse-audio.el b/configs/shared/.emacs.d/wpc/pulse-audio.el deleted file mode 100644 index dba4151a9e..0000000000 --- a/configs/shared/.emacs.d/wpc/pulse-audio.el +++ /dev/null @@ -1,66 +0,0 @@ -;;; pulse-audio.el --- Control audio with Elisp -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Because everything in my configuration is turning into Elisp these days. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'prelude) -(require 'string) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Constants -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst pulse-audio/step-size 5 - "The size by which to increase or decrease the volume.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun pulse-audio/message (x) - "Output X to *Messages*." - (message (string/format "[pulse-audio.el] %s" x))) - -(defun pulse-audio/toggle-mute () - "Mute the default sink." - (interactive) - (prelude/start-process - :name "pulse-audio/toggle-mute" - :command "pactl set-sink-mute @DEFAULT_SINK@ toggle") - (pulse-audio/message "Mute toggled.")) - -(defun pulse-audio/toggle-microphone () - "Mute the default sink." - (interactive) - (prelude/start-process - :name "pulse-audio/toggle-microphone" - :command "pactl set-source-mute @DEFAULT_SOURCE@ toggle") - (pulse-audio/message "Microphone toggled.")) - -(defun pulse-audio/decrease-volume () - "Low the volume output of the default sink." - (interactive) - (prelude/start-process - :name "pulse-audio/decrease-volume" - :command (string/format "pactl set-sink-volume @DEFAULT_SINK@ -%s%%" - pulse-audio/step-size)) - (pulse-audio/message "Volume decreased.")) - -(defun pulse-audio/increase-volume () - "Raise the volume output of the default sink." - (interactive) - (prelude/start-process - :name "pulse-audio/increase-volume" - :command (string/format "pactl set-sink-volume @DEFAULT_SINK@ +%s%%" - pulse-audio/step-size)) - (pulse-audio/message "Volume increased.")) - -(provide 'pulse-audio) -;;; pulse-audio.el ends here diff --git a/configs/shared/.emacs.d/wpc/pushover.el b/configs/shared/.emacs.d/wpc/pushover.el deleted file mode 100644 index fb06656cf4..0000000000 --- a/configs/shared/.emacs.d/wpc/pushover.el +++ /dev/null @@ -1,75 +0,0 @@ -;;; pushover.el --- Send generic messages to mobile device -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Pushover.net is a mobile app that accepts JSON. This supports loose -;; integration between things and mobile devices. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'request) -(require 'password-store) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst pushover/app-token - (password-store-get-field "api-keys/pushover.net" "emacs") - "App token for \"emacs\" application.") - -(defconst pushover/user-key - (password-store-get "api-keys/pushover.net") - "Key that identifies me to pushover.") - -(defconst pushover/url - "https://api.pushover.net/1/messages.json" - "URL to POST messages.") - -;; TODO: Rename module "pushover". - -(defun pushover/notify (message) - "Posts MESSAGE to all devices. -Here are the parameters that Pushover accepts: - -Required parameters: - - token - your application's API token - - user - the user/group key (not e-mail address) of your user (or you), - viewable when logged into our dashboard (often referred to as USER_KEY in - our documentation and code examples) - - message - your message - -Additional parameters (optional): - - attachment - an image attachment to send with the message; see attachments - for more information on how to upload files - device - your user's device name to send the message directly to that - device, rather than all of the user's devices (multiple devices may be - separated by a comma) - - title - your message's title, otherwise your app's name is used - - url - a supplementary URL to show with your message - - url_title - a title for your supplementary URL, otherwise just the URL is - shown - - priority - send as -2 to generate no notification/alert, -1 to always send - as a quiet notification, 1 to display as high-priority and bypass the user's - quiet hours, or 2 to also require confirmation from the user - - sound - the name of one of the sounds supported by device clients to - override the user's default sound choice - - timestamp - a Unix timestamp" - (request - pushover/url - :type "POST" - :params `(("token" . ,pushover/app-token) - ("user" . ,pushover/user-key) - ("message" . ,message)) - :data nil - :parser 'json-read - :success (cl-function - (lambda (&key data &allow-other-keys) - (message "Pushover.net notification sent!"))))) - -(provide 'pushover) -;;; pushover.el ends here diff --git a/configs/shared/.emacs.d/wpc/random.el b/configs/shared/.emacs.d/wpc/random.el deleted file mode 100644 index 148506c04d..0000000000 --- a/configs/shared/.emacs.d/wpc/random.el +++ /dev/null @@ -1,73 +0,0 @@ -;;; random.el --- Functions for working with randomness -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Functions for working with randomness. Some of this code is not as -;; functional as I'd like from. - -;;; Code: - -(require 'prelude) -(require 'number) -(require 'math) -(require 'series) -(require 'list) -(require 'set) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun random/int (x) - "Return a random integer from 0 to `X'." - (random x)) - -;; TODO: Make this work with sequences instead of lists. -(defun random/choice (xs) - "Return a random element of `XS'." - (let ((ct (list/length xs))) - (list/get - (random/int ct) - xs))) - -(defun random/boolean? () - "Randonly return t or nil." - (random/choice (list t nil))) - -;; TODO: This may not work if any of these generate numbers like 0, 1, etc. -(defun random/uuid () - "Return a generated UUID string." - (let ((eight (number/dec (math/triangle-of-power :base 16 :power 8))) - (four (number/dec (math/triangle-of-power :base 16 :power 4))) - (twelve (number/dec (math/triangle-of-power :base 16 :power 12)))) - (format "%x-%x-%x-%x-%x" - (random/int eight) - (random/int four) - (random/int four) - (random/int four) - (random/int twelve)))) - -(defun random/token (length) - "Return a randomly generated hexadecimal string of LENGTH." - (->> (series/range 0 (number/dec length)) - (list/map (lambda (_) (format "%x" (random/int 15)))) - (list/join ""))) - -;; TODO: Support random/sample -(defun random/sample (n xs) - "Return a randomly sample of list XS of size N." - (prelude/assert (and (>= n 0) (< n (list/length xs)))) - (cl-labels ((do-sample - (n xs y ys) - (if (= n (set/count ys)) - (->> ys - set/to-list - (list/map (lambda (i) - (list/get i xs)))) - (if (set/contains? y ys) - (do-sample n xs (random/int (list/length xs)) ys) - (do-sample n xs y (set/add y ys)))))) - (do-sample n xs (random/int (list/length xs)) (set/new)))) - -(provide 'random) -;;; random.el ends here diff --git a/configs/shared/.emacs.d/wpc/region.el b/configs/shared/.emacs.d/wpc/region.el deleted file mode 100644 index a2119b4c96..0000000000 --- a/configs/shared/.emacs.d/wpc/region.el +++ /dev/null @@ -1,20 +0,0 @@ -;;; region.el --- Functions for working with Emacs's regions -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Sometimes Emacs's function names and argument ordering is great; other times, -;; it isn't. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun region/to-string () - "Returns the string in the active region." - (buffer-substring-no-properties (region-beginning) - (region-end))) - -(provide 'region) -;;; region.el ends here diff --git a/configs/shared/.emacs.d/wpc/scheduler.el b/configs/shared/.emacs.d/wpc/scheduler.el deleted file mode 100644 index bae9532289..0000000000 --- a/configs/shared/.emacs.d/wpc/scheduler.el +++ /dev/null @@ -1,22 +0,0 @@ -;;; scheduler.el --- Sketches of scheduling -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Attempting to create a FSM for scheduling things in various ways: -;; -;; Scheduling policies: -;; - earliest due date: minimizes total lateness of all tasks in a pool. Put -;; the task with the latest due date last in the list and work backwards to -;; solve the precedence constraint (i.e. dependency issue). -;; - shortest processing time: maximizes number of tasks completed. Prioritize -;; tasks in the order of how long they will take to complete from shortest to -;; longest. This breaks down when precedence constraints are introduced. -;; -;; Tasks should inherit prioritization. - - - -;;; Code: - -(provide 'scheduler) -;;; scheduler.el ends here diff --git a/configs/shared/.emacs.d/wpc/scope.el b/configs/shared/.emacs.d/wpc/scope.el deleted file mode 100644 index 48aa85ad0e..0000000000 --- a/configs/shared/.emacs.d/wpc/scope.el +++ /dev/null @@ -1,99 +0,0 @@ -;;; scope.el --- Work with a scope data structure -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Exposing an API for working with a scope data structure in a non-mutative -;; way. -;; -;; What's a scope? Think of a scope as a stack of key-value bindings. - -;;; Code: - -(require 'alist) -(require 'stack) -(require 'struct) -(require 'macros) - -(cl-defstruct scope scopes) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Create -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun scope/new () - "Return an empty scope." - (make-scope :scopes (->> (stack/new) - (stack/push (alist/new))))) - -(defun scope/flatten (xs) - "Return a flattened representation of the scope, XS. -The newest bindings eclipse the oldest." - (->> xs - scope-scopes - stack/to-list - (list/reduce (alist/new) - (lambda (scope acc) - (alist/merge acc scope))))) - -(defun scope/push-new (xs) - "Push a new, empty scope onto XS." - (struct/update scope - scopes - (>> (stack/push (alist/new))) - xs)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Read -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun scope/get (k xs) - "Return K from XS if it's in scope." - (->> xs - scope/flatten - (alist/get k))) - -(defun scope/current (xs) - "Return the newest scope from XS." - (let ((xs-copy (copy-scope xs))) - (->> xs-copy - scope-scopes - stack/peek))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Update -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun scope/set (k v xs) - "Set value, V, at key, K, in XS for the current scope." - (struct/update scope - scopes - (>> (stack/map-top (>> (alist/set k v)))) - xs)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Delete -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun scope/pop (xs) - "Return a new scope without the top element from XS." - (->> xs - scope-scopes - stack/pop)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Predicates -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun scope/defined? (k xs) - "Return t if K is in scope of XS." - (->> xs - scope/flatten - (alist/has-key? k))) - -;; TODO: Find a faster way to write aliases like this. -(defun scope/instance? (xs) - "Return t if XS is a scope struct." - (scope-p xs)) - -(provide 'scope) -;;; scope.el ends here diff --git a/configs/shared/.emacs.d/wpc/screen-brightness.el b/configs/shared/.emacs.d/wpc/screen-brightness.el deleted file mode 100644 index ad51e7578c..0000000000 --- a/configs/shared/.emacs.d/wpc/screen-brightness.el +++ /dev/null @@ -1,45 +0,0 @@ -;;; screen-brightness.el --- Control laptop screen brightness -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Mainly just Elisp wrappers around `xbacklight`. - -;;; Code: - -;; TODO: Define some isomorphisms. E.g. int->string, string->int. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'prelude) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Constants -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst screen-brightness/step-size 15 - "The size of the increment or decrement step for the screen's brightness.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun screen-brightness/increase () - "Increase the screen brightness." - (interactive) - (prelude/start-process - :name "screen-brightness/increase" - :command (string/format "xbacklight -inc %s" screen-brightness/step-size)) - (message "[screen-brightness.el] Increased screen brightness.")) - -(defun screen-brightness/decrease () - "Decrease the screen brightness." - (interactive) - (prelude/start-process - :name "screen-brightness/decrease" - :command (string/format "xbacklight -dec %s" screen-brightness/step-size)) - (message "[screen-brightness.el] Decreased screen brightness.")) - -(provide 'screen-brightness) -;;; screen-brightness.el ends here diff --git a/configs/shared/.emacs.d/wpc/scrot.el b/configs/shared/.emacs.d/wpc/scrot.el deleted file mode 100644 index eeb12b3731..0000000000 --- a/configs/shared/.emacs.d/wpc/scrot.el +++ /dev/null @@ -1,64 +0,0 @@ -;; Author: William Carroll - -;;; Commentary: -;; scrot is a Linux utility for taking screenshots. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'f) -(require 'string) -(require 'ts) -(require 'clipboard) -(require 'kbd) - -(prelude/assert - (prelude/executable-exists? "scrot")) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst scrot/screenshot-directory "~/Downloads" - "The default directory for screenshot outputs.") - -(defconst scrot/path-to-executable "/usr/bin/scrot" - "Path to the scrot executable.") - -(defconst scrot/output-format "screenshot_%H:%M:%S_%Y-%m-%d.png" - "The format string for the output screenshot file. -See scrot's man page for more information.") - -(defun scrot/copy-image (path) - "Use xclip to copy the image at PATH to the clipboard. -This currently only works for PNG files because that's what I'm outputting" - (call-process "xclip" nil nil nil - "-selection" "clipboard" "-t" "image/png" path) - (message (string/format "[scrot.el] Image copied to clipboard!"))) - -(defmacro scrot/call (&rest args) - "Call scrot with ARGS." - `(call-process ,scrot/path-to-executable nil nil nil ,@args)) - -(defun scrot/fullscreen () - "Screenshot the entire screen." - (interactive) - (let ((screenshot-path (f-join scrot/screenshot-directory - (ts-format scrot/output-format (ts-now))))) - (scrot/call screenshot-path) - (scrot/copy-image screenshot-path))) - -(defun scrot/select () - "Click-and-drag to screenshot a region. -The output path is copied to the user's clipboard." - (interactive) - (let ((screenshot-path (f-join scrot/screenshot-directory - (ts-format scrot/output-format (ts-now))))) - (scrot/call "--select" screenshot-path) - (scrot/copy-image screenshot-path))) - -(provide 'scrot) -;;; scrot.el ends here diff --git a/configs/shared/.emacs.d/wpc/sequence.el b/configs/shared/.emacs.d/wpc/sequence.el deleted file mode 100644 index a5428ef044..0000000000 --- a/configs/shared/.emacs.d/wpc/sequence.el +++ /dev/null @@ -1,105 +0,0 @@ -;;; sequence.el --- Working with the "sequence" types -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Elisp supports a typeclass none as "sequence" which covers the following -;; types: -;; - list: '(1 2 3 4 5) -;; - vector: ["John" 27 :blue] -;; - string: "To be or not to be..." - -;; TODO: Document the difference between a "reduce" and a "fold". I.e. - reduce -;; has an initial value whereas fold uses the first element in the sequence as -;; the initial value. -;; -;; Note: This should be an approximation of Elixir's Enum protocol albeit -;; without streams. -;; -;; Elisp has done a lot of this work already and these are mostly wrapper -;; functions. -;; See the following list for reference: -;; - sequencep -;; - elt -;; - copy-sequence -;; - reverse -;; - nreverse -;; - sort -;; - seq-elt -;; - seq-length -;; - seqp -;; - seq-drop -;; - seq-take -;; - seq-take-while -;; - seq-drop-while -;; - seq-do -;; - seq-map -;; - seq-mapn -;; - seq-filter -;; - seq-remove -;; - seq-reduce -;; - seq-some -;; - seq-find -;; - seq-every-p -;; - seq-empty-p -;; - seq-count -;; - seq-sort -;; - seq-contains -;; - seq-position -;; - seq-uniq -;; - seq-subseq -;; - seq-concatenate -;; - seq-mapcat -;; - seq-partition -;; - seq-intersection -;; - seq-difference -;; - seq-group-by -;; - seq-into -;; - seq-min -;; - seq-max -;; - seq-doseq -;; - seq-let - -;;; Code: - -;; Perhaps we can provide default implementations for `filter' and `map' derived -;; from the `reduce' implementation. -;; (defprotocol sequence -;; :functions (reduce)) -;; (definstance sequence list -;; :reduce #'list/reduce -;; :filter #'list/filter -;; :map #'list/map) -;; (definstance sequence vector -;; :reduce #'vector/reduce) -;; (definstance sequence string -;; :reduce #'string) - -(defun sequence/classify (xs) - "Return the type of `XS'." - (cond - ((listp xs) 'list) - ((vectorp xs) 'vector) - ((stringp xs) 'string))) - -(defun sequence/reduce (acc f xs) - "Reduce of `XS' calling `F' on x and `ACC'." - (seq-reduce - (lambda (acc x) - (funcall f x acc)) - xs - acc)) - -;; Elixir also turned everything into a list for efficiecy reasons. - -(defun sequence/filter (p xs) - "Filter `XS' with predicate, `P'. -Returns a list regardless of the type of `XS'." - (seq-filter p xs)) - -(defun sequence/map (f xs) - "Maps `XS' calling `F' on each element. -Returns a list regardless of the type of `XS'." - (seq-map f xs)) - -(provide 'sequence) -;;; sequence.el ends here diff --git a/configs/shared/.emacs.d/wpc/series.el b/configs/shared/.emacs.d/wpc/series.el deleted file mode 100644 index 55e97f2789..0000000000 --- a/configs/shared/.emacs.d/wpc/series.el +++ /dev/null @@ -1,89 +0,0 @@ -;;; series.el --- Hosting common series of numbers -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Encoding number series as I learn about them. -;; -;; These are the following series I'm interested in supporting: -;; - Fibonacci -;; - Catalan numbers -;; - Figurate number series -;; - Triangular -;; - Square -;; - Pentagonal -;; - Hexagonal -;; - Lazy-caterer -;; - Magic square -;; - Look-and-say - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'number) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun series/range (beg end) - "Create a list of numbers from `BEG' to `END'. -This is an inclusive number range." - (if (< end beg) - (list/reverse - (number-sequence end beg)) - (number-sequence beg end))) - -(defun series/fibonacci-number (i) - "Return the number in the fibonacci series at `I'." - (cond - ((= 0 i) 0) - ((= 1 i) 1) - (t (+ (series/fibonacci-number (- i 1)) - (series/fibonacci-number (- i 2)))))) - -(defun series/fibonacci (n) - "Return the first `N' numbers of the fibonaccci series starting at zero." - (if (= 0 n) - '() - (list/reverse - (list/cons (series/fibonacci-number (number/dec n)) - (list/reverse - (series/fibonacci (number/dec n))))))) - -;; TODO: Consider memoization. -(defun series/triangular-number (i) - "Return the number in the triangular series at `I'." - (if (= 0 i) - 0 - (+ i (series/triangular-number (number/dec i))))) - -;; TODO: Improve performance. -;; TODO: Consider creating a stream protocol with `stream/next' and implement -;; this using that. -(defun series/triangular (n) - "Return the first `N' numbers of a triangular series starting at 0." - (if (= 0 n) - '() - (list/reverse - (list/cons (series/triangular-number (number/dec n)) - (list/reverse - (series/triangular (number/dec n))))))) - -(defun series/catalan-number (i) - "Return the catalan number in the series at `I'." - (if (= 0 i) - 1 - (/ (number/factorial (* 2 i)) - (* (number/factorial (number/inc i)) - (number/factorial i))))) - -(defun series/catalan (n) - "Return the first `N' numbers in a catalan series." - (->> (series/range 0 (number/dec n)) - (list/map #'series/catalan-number))) - -(provide 'series) -;;; series.el ends here diff --git a/configs/shared/.emacs.d/wpc/set.el b/configs/shared/.emacs.d/wpc/set.el deleted file mode 100644 index ff2db75d94..0000000000 --- a/configs/shared/.emacs.d/wpc/set.el +++ /dev/null @@ -1,171 +0,0 @@ -;;; set.el --- Working with mathematical sets -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; The set data structure is a collection that deduplicates its elements. - -;;; Code: - -(require 'ht) ;; friendlier API for hash-tables -(require 'dotted) -(require 'struct) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Wish List -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; - TODO: Support enum protocol for set. -;; - TODO: Prefer a different hash-table library that doesn't rely on mutative -;; code. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(cl-defstruct set xs) - -(defconst set/enable-testing? t - "Run tests when t.") - -(defun set/from-list (xs) - "Create a new set from the list XS." - (make-set :xs (->> xs - (list/map #'dotted/new) - ht-from-alist))) - -(defun set/new (&rest args) - "Create a new set from ARGS." - (set/from-list args)) - -(defun set/to-list (xs) - "Map set XS into a list." - (->> xs - set-xs - ht-keys)) - -(defun set/add (x xs) - "Add X to set XS." - (struct/update set - xs - (lambda (table) - (let ((table-copy (ht-copy table))) - (ht-set table-copy x nil) - table-copy)) - xs)) - -;; TODO: Ensure all `*/reduce' functions share the same API. -(defun set/reduce (acc f xs) - "Return a new set by calling F on each element of XS and ACC." - (->> xs - set/to-list - (list/reduce acc f))) - -(defun set/intersection (a b) - "Return the set intersection between sets A and B." - (set/reduce (set/new) - (lambda (x acc) - (if (set/contains? x b) - (set/add x acc) - acc)) - a)) - -(defun set/count (xs) - "Return the number of elements in XS." - (->> xs - set-xs - ht-size)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Predicates -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun set/empty? (xs) - "Return t if XS has no elements in it." - (= 0 (set/count xs))) - -(defun set/contains? (x xs) - "Return t if set XS has X." - (ht-contains? (set-xs xs) x)) - -;; TODO: Prefer using `ht.el' functions for this. -(defun set/equal? (a b) - "Return t if A and B share the name members." - (ht-equal? (set-xs a) - (set-xs b))) - -(defun set/distinct? (a b) - "Return t if sets A and B have no shared members." - (set/empty? (set/intersection a b))) - -(defun set/superset? (a b) - "Return t if set A contains all of the members of set B." - (->> b - set/to-list - (list/all? (lambda (x) (set/contains? x a))))) - -(defun set/subset? (a b) - "Return t if each member of set A is present in set B." - (set/superset? b a)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Tests -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(when set/enable-testing? - ;; set/distinct? - (prelude/assert - (set/distinct? (set/new 'one 'two 'three) - (set/new 'a 'b 'c))) - (prelude/refute - (set/distinct? (set/new 1 2 3) - (set/new 3 4 5))) - (prelude/refute - (set/distinct? (set/new 1 2 3) - (set/new 1 2 3))) - ;; set/equal? - (prelude/refute - (set/equal? (set/new 'a 'b 'c) - (set/new 'x 'y 'z))) - (prelude/refute - (set/equal? (set/new 'a 'b 'c) - (set/new 'a 'b))) - (prelude/assert - (set/equal? (set/new 'a 'b 'c) - (set/new 'a 'b 'c))) - ;; set/intersection - (prelude/assert - (set/equal? (set/new 2 3) - (set/intersection (set/new 1 2 3) - (set/new 2 3 4)))) - ;; set/{from,to}-list - (prelude/assert (equal '(1 2 3) - (->> '(1 1 2 2 3 3) - set/from-list - set/to-list))) - (let ((primary-colors (set/new "red" "green" "blue"))) - ;; set/subset? - (prelude/refute - (set/subset? (set/new "black" "grey") - primary-colors)) - (prelude/assert - (set/subset? (set/new "red") - primary-colors)) - ;; set/superset? - (prelude/refute - (set/superset? primary-colors - (set/new "black" "grey"))) - (prelude/assert - (set/superset? primary-colors - (set/new "red" "green" "blue"))) - (prelude/assert - (set/superset? primary-colors - (set/new "red" "blue")))) - ;; set/empty? - (prelude/assert (set/empty? (set/new))) - (prelude/refute (set/empty? (set/new 1 2 3))) - ;; set/count - (prelude/assert (= 0 (set/count (set/new)))) - (prelude/assert (= 2 (set/count (set/new 1 1 2 2))))) - -(provide 'set) -;;; set.el ends here diff --git a/configs/shared/.emacs.d/wpc/sre.el b/configs/shared/.emacs.d/wpc/sre.el deleted file mode 100644 index 1c8f6ddd9a..0000000000 --- a/configs/shared/.emacs.d/wpc/sre.el +++ /dev/null @@ -1,26 +0,0 @@ -;;; sre.el --- Site Reliability Engineering stuffs -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Storing some data that might be helpful in my ladder switch attempt. - -;;; Code: - -(defvar sre/introduction-email - "Hello! - -My name is William Carroll. I'm currently attempting a ladder switch. I have my -manager's approval to look for a new role because we believe I have been hired -for the wrong position. - -I'm eager to move ahead if there are any SRE openings in LON that fit my -profile. I'm happy to share more information with you about my background and -what I'm looking for. I've been attending the SRE Ops Review meetings in 6PS -weekly for awhile now, so we should be in the same office every Tuesday if -meeting in person is easier for you. - -Let me know!" - "Boilerplate email for reaching out to SRE hiring managers.") - -(provide 'sre) -;;; sre.el ends here diff --git a/configs/shared/.emacs.d/wpc/ssh.el b/configs/shared/.emacs.d/wpc/ssh.el deleted file mode 100644 index d703937573..0000000000 --- a/configs/shared/.emacs.d/wpc/ssh.el +++ /dev/null @@ -1,31 +0,0 @@ -;;; ssh.el --- When working remotely -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Configuration to make remote work easier. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'tramp) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO: Is "ssh" preferable to "scp"? -(setq tramp-default-method "ssh") - -;; Taken from: https://superuser.com/questions/179313/tramp-waiting-for-prompts-from-remote-shell -(setq tramp-shell-prompt-pattern "^[^$>\n]*[#$%>] *\\(\[[0-9;]*[a-zA-Z] *\\)*") - -;; TODO: Re-enable this in case "dumb" isn't the default. -;; (setq tramp-terminal-type "dumb") - -(setq tramp-verbose 10) - -(provide 'ssh) -;;; ssh.el ends here diff --git a/configs/shared/.emacs.d/wpc/stack.el b/configs/shared/.emacs.d/wpc/stack.el deleted file mode 100644 index 052ed881d2..0000000000 --- a/configs/shared/.emacs.d/wpc/stack.el +++ /dev/null @@ -1,93 +0,0 @@ -;;; stack.el --- Working with stacks in Elisp -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; A stack is a LIFO queue. -;; The design goal here is to expose an intuitive API for working with stacks in -;; non-mutative way. -;; -;; TODO: Consider naming a Functor instance "Mappable." -;; TODO: Consider naming a Foldable instance "Reduceable." -;; -;; TODO: Consider implementing an instance for Mappable. -;; TODO: Consider implementing an instance for Reduceable. - -;;; Code: - -(require 'list) - -(cl-defstruct stack xs) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Create -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun stack/new () - "Create an empty stack." - (make-stack :xs '())) - -(defun stack/from-list (xs) - "Create a new stack from the list, `XS'." - (list/reduce (stack/new) #'stack/push xs)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Read -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun stack/peek (xs) - "Look at the top element of `XS' without popping it off." - (->> xs - stack-xs - list/head)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Update -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun stack/push (x xs) - "Push `X' on `XS'." - (struct/update stack - xs - (>> (list/cons x)) - xs)) - -;; TODO: How to return something like {(list/head xs), (list/tail xs)} in Elixir -;; TODO: How to handle popping from empty stacks? -(defun stack/pop (xs) - "Return the stack, `XS', without the top element. -Since I cannot figure out a nice way of return tuples in Elisp, if you want to -look at the first element, use `stack/peek' before running `stack/pop'." - (struct/update stack - xs - (>> list/tail) - xs)) - -(defun stack/map-top (f xs) - "Apply F to the top element of XS." - (->> xs - stack/pop - (stack/push (funcall f (stack/peek xs))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Miscellaneous -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun stack/to-list (xs) - "Return XS as a list. -The round-trip property of `stack/from-list' and `stack/to-list' should hold." - (->> xs - stack-xs - list/reverse)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Predicates -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO: Create a macro that wraps `cl-defstruct' that automatically creates -;; things like `new', `instance?'. -(defun stack/instance? (xs) - "Return t if XS is a stack." - (stack-p xs)) - -(provide 'stack) -;;; stack.el ends here diff --git a/configs/shared/.emacs.d/wpc/string.el b/configs/shared/.emacs.d/wpc/string.el deleted file mode 100644 index f8694d5f18..0000000000 --- a/configs/shared/.emacs.d/wpc/string.el +++ /dev/null @@ -1,128 +0,0 @@ -;; string.el --- Library for working with strings -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Library for working with string. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 's) -(require 'dash) -;; TODO: Resolve the circular dependency that this introduces. -;; (require 'prelude) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst string/test? t - "When t, run the tests.") - -(defun string/contains? (c x) - "Return t if X is in C." - (s-contains? c x)) - -(defun string/hookify (x) - "Append \"-hook\" to X." - (s-append "-hook" x)) - -(defun string/split (y x) - "Map string X into a list of strings that were separated by Y." - (s-split y x)) - -(defun string/ensure-hookified (x) - "Ensure that X has \"-hook\" appended to it." - (if (s-ends-with? "-hook" x) - x - (string/hookify x))) - -(defun string/format (x &rest args) - "Format template string X with ARGS." - (apply #'format (cons x args))) - -(defun string/concat (&rest strings) - "Joins `STRINGS' into onto string." - (apply #'s-concat strings)) - -(defun string/->symbol (string) - "Maps `STRING' to a symbol." - (intern string)) - -(defun string/<-symbol (symbol) - "Maps `SYMBOL' into a string." - (symbol-name symbol)) - -(defun string/prepend (prefix x) - "Prepend `PREFIX' onto `X'." - (s-concat prefix x)) - -(defun string/append (postfix x) - "Appen `POSTFIX' onto `X'." - (s-concat x postfix)) - -(defun string/surround (s x) - "Surrounds `X' one each side with `S'." - (->> x - (string/prepend s) - (string/append s))) - -;; TODO: Define a macro for defining a function and a test. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Casing -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun string/caps->kebab (x) - "Change the casing of `X' from CAP_CASE to kebab-case." - (->> x - s-downcase - (s-replace "_" "-"))) - -(defun string/kebab->caps (x) - "Change the casing of X from CAP_CASE to kebab-case." - (->> x - s-upcase - (s-replace "-" "_"))) - -(defun string/lower->caps (x) - "Change the casing of X from lowercase to CAPS_CASE." - (->> x - s-upcase - (s-replace " " "_"))) - -(defun string/lower->kebab (x) - "Change the casing of `X' from lowercase to kebab-case." - (s-replace " " "-" x)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Predicates -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun string/instance? (x) - "Return t if X is a string." - (stringp x)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Tests -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; (when string/test? -;; (prelude/assert -;; (string= -;; (string/surround "-*-" "surround") -;; "-*-surround-*-")) -;; (prelude/assert -;; (string= -;; (string/caps->kebab "CAPS_CASE_STRING") -;; "caps-case-string")) -;; (prelude/assert -;; (string= -;; (string/kebab->caps "kebab-case-string") -;; "KEBAB_CASE_STRING"))) - -(provide 'string) -;;; string.el ends here diff --git a/configs/shared/.emacs.d/wpc/string.nix b/configs/shared/.emacs.d/wpc/string.nix deleted file mode 100644 index 1f815b26bb..0000000000 --- a/configs/shared/.emacs.d/wpc/string.nix +++ /dev/null @@ -1,8 +0,0 @@ -{ pkgs ? import (builtins.fetchTarball - "https://github.com/tazjin/depot/archive/master.tar.gz") {} }: - -pkgs.writeElispBin { - name = "string"; - deps = epkgs: [ epkgs.dash epkgs.s ./prelude.nix ]; - src = ./string.el; -} diff --git a/configs/shared/.emacs.d/wpc/struct.el b/configs/shared/.emacs.d/wpc/struct.el deleted file mode 100644 index 7d237d3259..0000000000 --- a/configs/shared/.emacs.d/wpc/struct.el +++ /dev/null @@ -1,88 +0,0 @@ -;;; struct.el --- Helpers for working with structs -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Provides new macros for working with structs. Also provides adapter -;; interfaces to existing struct macros, that should have more intuitive -;; interfaces. -;; -;; Sometimes `setf' just isn't enough. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Wish list -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; - TODO: Replace `symbol-name' and `intern' calls with isomorphism. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'string) -(require 'dash) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defvar struct/enable-tests? t - "When t, run the test suite defined herein.") - -(defmacro struct/update (type field f xs) - "Apply F to FIELD in XS, which is a struct of TYPE. -This is immutable." - (let ((copier (->> type - symbol-name - (string/prepend "copy-") - intern)) - (accessor (->> field - symbol-name - (string/prepend (string/concat (symbol-name type) "-")) - intern))) - `(let ((copy (,copier ,xs))) - (setf (,accessor copy) (funcall ,f (,accessor copy))) - copy))) - -(defmacro struct/set (type field x xs) - "Immutably set FIELD in XS (struct TYPE) to X." - (let ((copier (->> type - symbol-name - (string/prepend "copy-") - intern)) - (accessor (->> field - symbol-name - (string/prepend (string/concat (symbol-name type) "-")) - intern))) - `(let ((copy (,copier ,xs))) - (setf (,accessor copy) ,x) - copy))) - -(defmacro struct/set! (type field x xs) - "Set FIELD in XS (struct TYPE) to X mutably. -This is an adapter interface to `setf'." - (let ((accessor (->> field - symbol-name - (string/prepend (string/concat (symbol-name type) "-")) - intern))) - `(progn - (setf (,accessor ,xs) ,x) - ,xs))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Tests -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(when struct/enable-tests? - (cl-defstruct dummy name age) - (defvar test-dummy (make-dummy :name "Roofus" :age 19)) - (struct/set! dummy name "Doofus" test-dummy) - (prelude/assert (string= "Doofus" (dummy-name test-dummy))) - (let ((result (struct/set dummy name "Shoofus" test-dummy))) - ;; Test the immutability of `struct/set' - (prelude/assert (string= "Doofus" (dummy-name test-dummy))) - (prelude/assert (string= "Shoofus" (dummy-name result))))) - -(provide 'struct) -;;; struct.el ends here diff --git a/configs/shared/.emacs.d/wpc/symbol.el b/configs/shared/.emacs.d/wpc/symbol.el deleted file mode 100644 index 9119b29470..0000000000 --- a/configs/shared/.emacs.d/wpc/symbol.el +++ /dev/null @@ -1,43 +0,0 @@ -;; symbol.el --- Library for working with symbols. -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Library for working with symbols. - -;;; Code: - -;; TODO: Why is ivy mode map everywhere? - -(require 'string) - -;; Symbols -(defun symbol/as-string (callback x) - "Treat the symbol, X, as a string while applying CALLBACK to it. -Coerce back to a symbol on the way out." - (->> x - #'symbol-name - callback - #'intern)) - -(defun symbol/to-string (x) - "Map `X' into a string." - (string/<-symbol x)) - -(defun symbol/hookify (x) - "Append \"-hook\" to X when X is a symbol." - (symbol/as-string #'string/hookify x)) - -(defun symbol/ensure-hookified (x) - "Ensure that X has \"-hook\" appended to it when X is a symbol." - (symbol/as-string #'string/ensure-hookified x)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Predicates -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun symbol/instance? (x) - "Return t if X is a symbol." - (symbolp x)) - -(provide 'symbol) -;;; symbol.el ends here diff --git a/configs/shared/.emacs.d/wpc/terminator-themes.json b/configs/shared/.emacs.d/wpc/terminator-themes.json deleted file mode 100644 index e021ef1293..0000000000 --- a/configs/shared/.emacs.d/wpc/terminator-themes.json +++ /dev/null @@ -1,1794 +0,0 @@ -{ - "themes": [ - { - "name": "3024 Day", - "palette": "#090300:#db2d20:#01a252:#fded02:#01a0e4:#a16a94:#b5e4f4:#a5a2a2:#5c5855:#e8bbd0:#3a3432:#4a4543:#807d7c:#d6d5d4:#cdab53:#f7f7f7", - "background_color": "#f7f7f7", - "cursor_color": "#4a4543", - "foreground_color": "#4a4543", - "background_image": "None", - "type": "light" - }, - { - "name": "3024 Night", - "palette": "#090300:#db2d20:#01a252:#fded02:#01a0e4:#a16a94:#b5e4f4:#a5a2a2:#5c5855:#e8bbd0:#3a3432:#4a4543:#807d7c:#d6d5d4:#cdab53:#f7f7f7", - "background_color": "#090300", - "cursor_color": "#a5a2a2", - "foreground_color": "#a5a2a2", - "background_image": "None", - "type": "dark" - }, - { - "name": "Aci", - "background_color": "#0d1926", - "background_image": "None", - "cursor_color": "#c4e9ff", - "foreground_color": "#b4e1fd", - "palette": "#363636:#ff0883:#83ff08:#ff8308:#0883ff:#8308ff:#08ff83:#b6b6b6:#363636:#ff0883:#83ff08:#ff8308:#0883ff:#8308ff:#08ff83:#b6b6b6", - "type": "dark" - }, - { - "name": "Aco", - "background_color": "#1f1305", - "background_image": "None", - "cursor_color": "#bae2fb", - "foreground_color": "#b4e1fd", - "palette": "#3f3f3f:#ff0883:#83ff08:#ff8308:#0883ff:#8308ff:#08ff83:#bebebe:#474747:#ff1e8e:#8eff1e:#ff8e1e:#0883ff:#8e1eff:#1eff8e:#c4c4c4", - "type": "dark" - }, - { - "name": "AdventureTime", - "palette": "#050404:#bd0013:#4ab118:#e7741e:#0f4ac6:#665993:#70a598:#f8dcc0:#4e7cbf:#fc5f5a:#9eff6e:#efc11a:#1997c6:#9b5953:#c8faf4:#f6f5fb", - "background_color": "#1f1d45", - "cursor_color": "#efbf38", - "foreground_color": "#f8dcc0", - "background_image": "None", - "type": "dark" - }, - { - "name": "After Dark", - "background_color": "#10111b", - "cursor_color": "#aaaaaa", - "palette": "#2e3436:#ef4a9e:#00d2bc:#e7ca7a:#9399fa:#ca5bcc:#86d079:#d3d7cf:#555753:#ef4a9e:#00d2bc:#e7ca7a:#9399fa:#ca5bcc:#86d079:#eeeeec", - "type": "dark" - }, - { - "name": "Afterglow", - "palette": "#151515:#ac4142:#7e8e50:#e5b567:#6c99bb:#9f4e85:#7dd6cf:#d0d0d0:#505050:#ac4142:#7e8e50:#e5b567:#6c99bb:#9f4e85:#7dd6cf:#f5f5f5", - "background_color": "#212121", - "cursor_color": "#d0d0d0", - "foreground_color": "#d0d0d0", - "background_image": "None", - "type": "dark" - }, - { - "name": "AlienBlood", - "palette": "#112616:#7f2b27:#2f7e25:#717f24:#2f6a7f:#47587f:#327f77:#647d75:#3c4812:#e08009:#18e000:#bde000:#00aae0:#0058e0:#00e0c4:#73fa91", - "background_color": "#0f1610", - "cursor_color": "#73fa91", - "foreground_color": "#637d75", - "background_image": "None", - "type": "dark" - }, - { - "name": "Argonaut", - "palette": "#232323:#ff000f:#8ce10b:#ffb900:#008df8:#6d43a6:#00d8eb:#ffffff:#444444:#ff2740:#abe15b:#ffd242:#0092ff:#9a5feb:#67fff0:#ffffff", - "background_color": "#0e1019", - "cursor_color": "#ff0018", - "foreground_color": "#fffaf4", - "background_image": "None", - "type": "dark" - }, - { - "name": "Arthur", - "palette": "#3d352a:#cd5c5c:#86af80:#e8ae5b:#6495ed:#deb887:#b0c4de:#bbaa99:#554444:#cc5533:#88aa22:#ffa75d:#87ceeb:#996600:#b0c4de:#ddccbb", - "background_color": "#1c1c1c", - "cursor_color": "#e2bbef", - "foreground_color": "#ddeedd", - "background_image": "None", - "type": "dark" - }, - { - "name": "AtelierSulphurpool", - "palette": "#202746:#c94922:#ac9739:#c08b30:#3d8fd1:#6679cc:#22a2c9:#979db4:#6b7394:#c76b29:#293256:#5e6687:#898ea4:#dfe2f1:#9c637a:#f5f7ff", - "background_color": "#202746", - "cursor_color": "#979db4", - "foreground_color": "#979db4", - "background_image": "None", - "type": "dark" - }, - { - "name": "Atom", - "palette": "#000000:#fd5ff1:#87c38a:#ffd7b1:#85befd:#b9b6fc:#85befd:#e0e0e0:#000000:#fd5ff1:#94fa36:#f5ffa8:#96cbfe:#b9b6fc:#85befd:#e0e0e0", - "background_color": "#161719", - "cursor_color": "#d0d0d0", - "foreground_color": "#c5c8c6", - "background_image": "None", - "type": "dark" - }, - { - "name": "AtomOneLight", - "palette": "#000000:#de3e35:#3f953a:#d2b67c:#2f5af3:#950095:#3f953a:#bbbbbb:#000000:#de3e35:#3f953a:#d2b67c:#2f5af3:#a00095:#3f953a:#ffffff", - "background_color": "#f9f9f9", - "cursor_color": "#bbbbbb", - "foreground_color": "#2a2c33", - "background_image": "None", - "type": "light" - }, - { - "name": "ayu", - "palette": "#000000:#ff3333:#b8cc52:#e7c547:#36a3d9:#f07178:#95e6cb:#ffffff:#323232:#ff6565:#eafe84:#fff779:#68d5ff:#ffa3aa:#c7fffd:#ffffff", - "background_color": "#0f1419", - "cursor_color": "#f29718", - "foreground_color": "#e6e1cf", - "background_image": "None", - "type": "dark" - }, - { - "name": "Ayu mirage", - "background_color": "#212733", - "background_image": "None", - "cursor_color": "#FFD580", - "foreground_color": "#d9d7ce", - "palette": "#212733:#ff3333:#bae67e:#ffd580:#5ccfe6:#d4bfff:#5ccfe6:#3d4752:#3e4b59:#ff3333:#bae67e:#ffd580:#5ccfe6:#d4bfff:#5ccfe6:#eeeeec", - "type": "dark" - }, - { - "name": "ayu_light", - "palette": "#000000:#ff3333:#86b300:#f29718:#41a6d9:#f07178:#4dbf99:#ffffff:#323232:#ff6565:#b8e532:#ffc94a:#73d8ff:#ffa3aa:#7ff1cb:#ffffff", - "background_color": "#fafafa", - "cursor_color": "#ff6a00", - "foreground_color": "#5c6773", - "background_image": "None", - "type": "light" - }, - { - "name": "Azu", - "background_color": "#09111a", - "background_image": "None", - "cursor_color": "#d2e8fc", - "foreground_color": "#d9e6f2", - "palette": "#000000:#ac6d74:#74ac6d:#aca46d:#6d74ac:#a46dac:#6daca4:#e6e6e6:#262626:#d6b8bc:#bcd6b8:#d6d3b8:#b8bcd6:#d3b8d6:#b8d6d3:#ffffff", - "type": "dark" - }, - { - "name": "Batman", - "palette": "#1b1d1e:#e6dc44:#c8be46:#f4fd22:#737174:#747271:#62605f:#c6c5bf:#505354:#fff78e:#fff27d:#feed6c:#919495:#9a9a9d:#a3a3a6:#dadbd6", - "background_color": "#1b1d1e", - "cursor_color": "#fcef0c", - "foreground_color": "#6f6f6f", - "background_image": "None", - "type": "dark" - }, - { - "name": "Belafonte Day", - "palette": "#20111b:#be100e:#858162:#eaa549:#426a79:#97522c:#989a9c:#968c83:#5e5252:#be100e:#858162:#eaa549:#426a79:#97522c:#989a9c:#d5ccba", - "background_color": "#d5ccba", - "cursor_color": "#45373c", - "foreground_color": "#45373c", - "background_image": "None", - "type": "light" - }, - { - "name": "Belafonte Night", - "palette": "#20111b:#be100e:#858162:#eaa549:#426a79:#97522c:#989a9c:#968c83:#5e5252:#be100e:#858162:#eaa549:#426a79:#97522c:#989a9c:#d5ccba", - "background_color": "#20111b", - "cursor_color": "#968c83", - "foreground_color": "#968c83", - "background_image": "None", - "type": "dark" - }, - { - "name": "Bim", - "background_color": "#012849", - "background_image": "None", - "cursor_color": "#c4d0de", - "foreground_color": "#a9bed8", - "palette": "#2c2423:#f557a0:#a9ee55:#f5a255:#5ea2ec:#a957ec:#5eeea0:#918988:#918988:#f579b2:#bbee78:#f5b378:#81b3ec:#bb79ec:#81eeb2:#f5eeec", - "type": "dark" - }, - { - "name": "BirdsOfParadise", - "palette": "#573d26:#be2d26:#6ba18a:#e99d2a:#5a86ad:#ac80a6:#74a6ad:#e0dbb7:#9b6c4a:#e84627:#95d8ba:#d0d150:#b8d3ed:#d19ecb:#93cfd7:#fff9d5", - "background_color": "#2a1f1d", - "cursor_color": "#573d26", - "foreground_color": "#e0dbb7", - "background_image": "None", - "type": "dark" - }, - { - "name": "Blazer", - "palette": "#000000:#b87a7a:#7ab87a:#b8b87a:#7a7ab8:#b87ab8:#7ab8b8:#d9d9d9:#262626:#dbbdbd:#bddbbd:#dbdbbd:#bdbddb:#dbbddb:#bddbdb:#ffffff", - "background_color": "#0d1926", - "cursor_color": "#d9e6f2", - "foreground_color": "#d9e6f2", - "background_image": "None", - "type": "dark" - }, - { - "name": "Blitz", - "background_color": "#16141e", - "cursor_color": "#00ecc8", - "foreground_color": "#00ecc8", - "palette": "#2e3436:#f70047:#00ff7d:#fcdd42:#26b3d2:#b055f4:#ff8db4:#d3d7cf:#555753:#ff5555:#55ff55:#ffff55:#729fcf:#ff55ff:#34e2e2:#eeeeec", - "type": "dark" - }, - { - "name": "Bloody", - "background_color": "#1e1f29", - "background_image": "None", - "cursor_color": "#f9dc5c", - "foreground_color": "#aaaaaa", - "palette": "#2e3436:#ff512f:#b2ffa9:#fffd82:#3185fc:#dd2476:#66d7d1:#f2efea:#555753:#ff512f:#b2ffa9:#fffd82:#3185fc:#dd2476:#66d7d1:#f2efea", - "type": "dark" - }, - { - "name": "Borland", - "palette": "#4f4f4f:#ff6c60:#a8ff60:#ffffb6:#96cbfe:#ff73fd:#c6c5fe:#eeeeee:#7c7c7c:#ffb6b0:#ceffac:#ffffcc:#b5dcff:#ff9cfe:#dfdffe:#ffffff", - "background_color": "#0000a4", - "cursor_color": "#ffa560", - "foreground_color": "#ffff4e", - "background_image": "None", - "type": "dark" - }, - { - "name": "Bright Lights", - "palette": "#191919:#ff355b:#b7e876:#ffc251:#76d4ff:#ba76e7:#6cbfb5:#c2c8d7:#191919:#ff355b:#b7e876:#ffc251:#76d5ff:#ba76e7:#6cbfb5:#c2c8d7", - "background_color": "#191919", - "cursor_color": "#f34b00", - "foreground_color": "#b3c9d7", - "background_image": "None", - "type": "dark" - }, - { - "name": "Broadcast", - "palette": "#000000:#da4939:#519f50:#ffd24a:#6d9cbe:#d0d0ff:#6e9cbe:#ffffff:#323232:#ff7b6b:#83d182:#ffff7c:#9fcef0:#ffffff:#a0cef0:#ffffff", - "background_color": "#2b2b2b", - "cursor_color": "#ffffff", - "foreground_color": "#e6e1dc", - "background_image": "None", - "type": "dark" - }, - { - "name": "Brogrammer", - "palette": "#1f1f1f:#f81118:#2dc55e:#ecba0f:#2a84d2:#4e5ab7:#1081d6:#d6dbe5:#d6dbe5:#de352e:#1dd361:#f3bd09:#1081d6:#5350b9:#0f7ddb:#ffffff", - "background_color": "#131313", - "cursor_color": "#b9b9b9", - "foreground_color": "#d6dbe5", - "background_image": "None", - "type": "dark" - }, - { - "name": "C64", - "palette": "#090300:#883932:#55a049:#bfce72:#40318d:#8b3f96:#67b6bd:#ffffff:#000000:#883932:#55a049:#bfce72:#40318d:#8b3f96:#67b6bd:#f7f7f7", - "background_color": "#40318d", - "cursor_color": "#7869c4", - "foreground_color": "#7869c4", - "background_image": "None", - "type": "dark" - }, - { - "name": "Cai", - "background_color": "#09111a", - "background_image": "None", - "cursor_color": "#e3eef9", - "foreground_color": "#d9e6f2", - "palette": "#000000:#ca274d:#4dca27:#caa427:#274dca:#a427ca:#27caa4:#808080:#808080:#e98da3:#a3e98d:#e9d48d:#8da3e9:#d48de9:#8de9d4:#ffffff", - "type": "dark" - }, - { - "name": "Candy", - "background_color": "#000000", - "foreground_color": "#AAAAAA", - "cursor_color": "#aaaaaa", - "palette": "#2e3436:#fa2573:#a6e32d:#fc951e:#c48dff:#fa2573:#67d9f0:#f2f2f2:#555753:#fa2573:#8ae234:#fce94f:#729fcf:#fa2573:#34e2e2:#eeeeec", - "type": "dark" - }, - { - "name": "Chalk", - "palette": "#7d8b8f:#b23a52:#789b6a:#b9ac4a:#2a7fac:#bd4f5a:#44a799:#d2d8d9:#888888:#f24840:#80c470:#ffeb62:#4196ff:#fc5275:#53cdbd:#d2d8d9", - "background_color": "#2b2d2e", - "cursor_color": "#708284", - "foreground_color": "#d2d8d9", - "background_image": "None", - "type": "dark" - }, - { - "name": "Chalkboard", - "palette": "#000000:#c37372:#72c373:#c2c372:#7372c3:#c372c2:#72c2c3:#d9d9d9:#323232:#dbaaaa:#aadbaa:#dadbaa:#aaaadb:#dbaada:#aadadb:#ffffff", - "background_color": "#29262f", - "cursor_color": "#d9e6f2", - "foreground_color": "#d9e6f2", - "background_image": "None", - "type": "dark" - }, - { - "name": "Chalkby", - "background_color": "#1f2d2d", - "cursor_color": "#ffffff", - "cursor_color_fg": "False", - "foreground_color": "#ffffff", - "palette": "#2e3436:#ffb0b0:#c8ff9b:#fffca4:#6f9ceb:#9395d3:#bdeaff:#d3d7cf:#555753:#ffb0b0:#c8ff9b:#fffca4:#6f9ceb:#9395d3:#bdeaff:#eeeeec", - "type": "dark" - }, - { - "name": "Chesterish", - "background_color": "#293340", - "background_image": "None", - "cursor_color": "#2c85f7", - "foreground_color": "#cdd2e9", - "palette": "#293340:#e17e85:#61ba86:#ffec8e:#4cb2ff:#be86e3:#2dced0:#cdd2e9:#546386:#e17e85:#61ba86:#ffec8e:#4cb2ff:#be86e3:#2dced0:#cdd2e9", - "type": "dark" - }, - { - "name": "Ciapre", - "palette": "#181818:#810009:#48513b:#cc8b3f:#576d8c:#724d7c:#5c4f4b:#aea47f:#555555:#ac3835:#a6a75d:#dcdf7c:#3097c6:#d33061:#f3dbb2:#f4f4f4", - "background_color": "#191c27", - "cursor_color": "#92805b", - "foreground_color": "#aea47a", - "background_image": "None", - "type": "dark" - }, - { - "name": "CLRS", - "palette": "#000000:#f8282a:#328a5d:#fa701d:#135cd0:#9f00bd:#33c3c1:#b3b3b3:#555753:#fb0416:#2cc631:#fdd727:#1670ff:#e900b0:#3ad5ce:#eeeeec", - "background_color": "#ffffff", - "cursor_color": "#6fd3fc", - "foreground_color": "#262626", - "background_image": "None", - "type": "light" - }, - { - "name": "Cobalt Neon", - "palette": "#142631:#ff2320:#3ba5ff:#e9e75c:#8ff586:#781aa0:#8ff586:#ba46b2:#fff688:#d4312e:#8ff586:#e9f06d:#3c7dd2:#8230a7:#6cbc67:#8ff586", - "background_color": "#142838", - "cursor_color": "#c4206f", - "foreground_color": "#8ff586", - "background_image": "None", - "type": "dark" - }, - { - "name": "Cobalt2", - "palette": "#000000:#ff0000:#38de21:#ffe50a:#1460d2:#ff005d:#00bbbb:#bbbbbb:#555555:#f40e17:#3bd01d:#edc809:#5555ff:#ff55ff:#6ae3fa:#ffffff", - "background_color": "#132738", - "cursor_color": "#f0cc09", - "foreground_color": "#ffffff", - "background_image": "None", - "type": "dark" - }, - { - "name": "CrayonPonyFish", - "palette": "#2b1b1d:#91002b:#579524:#ab311b:#8c87b0:#692f50:#e8a866:#68525a:#3d2b2e:#c5255d:#8dff57:#c8381d:#cfc9ff:#fc6cba:#ffceaf:#b0949d", - "background_color": "#150707", - "cursor_color": "#68525a", - "foreground_color": "#68525a", - "background_image": "None", - "type": "dark" - }, - { - "name": "Dark Pastel", - "palette": "#000000:#ff5555:#55ff55:#ffff55:#5555ff:#ff55ff:#55ffff:#bbbbbb:#555555:#ff5555:#55ff55:#ffff55:#5555ff:#ff55ff:#55ffff:#ffffff", - "background_color": "#000000", - "cursor_color": "#bbbbbb", - "foreground_color": "#ffffff", - "background_image": "None", - "type": "dark" - }, - { - "name": "Darkside", - "palette": "#000000:#e8341c:#68c256:#f2d42c:#1c98e8:#8e69c9:#1c98e8:#bababa:#000000:#e05a4f:#77b869:#efd64b:#387cd3:#957bbe:#3d97e2:#bababa", - "background_color": "#222324", - "cursor_color": "#bbbbbb", - "foreground_color": "#bababa", - "background_image": "None", - "type": "dark" - }, - { - "name": "deep", - "palette": "#000000:#d70005:#1cd915:#d9bd26:#5665ff:#b052da:#50d2da:#e0e0e0:#535353:#fb0007:#22ff18:#fedc2b:#9fa9ff:#e09aff:#8df9ff:#ffffff", - "background_color": "#090909", - "cursor_color": "#d0d0d0", - "foreground_color": "#cdcdcd", - "background_image": "None", - "type": "dark" - }, - { - "name": "Desert", - "palette": "#4d4d4d:#ff2b2b:#98fb98:#f0e68c:#cd853f:#ffdead:#ffa0a0:#f5deb3:#555555:#ff5555:#55ff55:#ffff55:#87ceff:#ff55ff:#ffd700:#ffffff", - "background_color": "#333333", - "cursor_color": "#00ff00", - "foreground_color": "#ffffff", - "background_image": "None", - "type": "dark" - }, - { - "name": "DimmedMonokai", - "palette": "#3a3d43:#be3f48:#879a3b:#c5a635:#4f76a1:#855c8d:#578fa4:#b9bcba:#888987:#fb001f:#0f722f:#c47033:#186de3:#fb0067:#2e706d:#fdffb9", - "background_color": "#1f1f1f", - "cursor_color": "#f83e19", - "foreground_color": "#b9bcba", - "background_image": "None", - "type": "dark" - }, - { - "name": "DotGov", - "palette": "#191919:#bf091d:#3d9751:#f6bb34:#17b2e0:#7830b0:#8bd2ed:#ffffff:#191919:#bf091d:#3d9751:#f6bb34:#17b2e0:#7830b0:#8bd2ed:#ffffff", - "background_color": "#262c35", - "cursor_color": "#d9002f", - "foreground_color": "#ebebeb", - "background_image": "None", - "type": "dark" - }, - { - "name": "Dracula", - "background_color": "#1e1f29", - "background_image": "None", - "cursor_color": "#aaaaaa", - "foreground_color": "#f8f8f2", - "palette": "#44475a:#ff5555:#50fa7b:#f1fa8c:#8be9fd:#bd93f9:#ff79c6:#94a3a5:#000000:#ff5555:#50fa7b:#f1fa8c:#8be9fd:#bd93f9:#ff79c6:#ffffff", - "type": "dark" - }, - { - "name": "Duotone Dark", - "palette": "#1f1d27:#d9393e:#2dcd73:#d9b76e:#ffc284:#de8d40:#2488ff:#b7a1ff:#353147:#d9393e:#2dcd73:#d9b76e:#ffc284:#de8d40:#2488ff:#eae5ff", - "background_color": "#1f1d27", - "cursor_color": "#ff9839", - "foreground_color": "#b7a1ff", - "background_image": "None", - "type": "dark" - }, - { - "name": "Earthsong", - "palette": "#121418:#c94234:#85c54c:#f5ae2e:#1398b9:#d0633d:#509552:#e5c6aa:#675f54:#ff645a:#98e036:#e0d561:#5fdaff:#ff9269:#84f088:#f6f7ec", - "background_color": "#292520", - "cursor_color": "#f6f7ec", - "foreground_color": "#e5c7a9", - "background_image": "None", - "type": "dark" - }, - { - "name": "Elemental", - "palette": "#3c3c30:#98290f:#479a43:#7f7111:#497f7d:#7f4e2f:#387f58:#807974:#555445:#e0502a:#61e070:#d69927:#79d9d9:#cd7c54:#59d599:#fff1e9", - "background_color": "#22211d", - "cursor_color": "#facb80", - "foreground_color": "#807a74", - "background_image": "None", - "type": "dark" - }, - { - "name": "Elementary", - "palette": "#242424:#d71c15:#5aa513:#fdb40c:#063b8c:#e40038:#2595e1:#efefef:#4b4b4b:#fc1c18:#6bc219:#fec80e:#0955ff:#fb0050:#3ea8fc:#8c00ec", - "background_color": "#181818", - "cursor_color": "#bbbbbb", - "foreground_color": "#efefef", - "background_image": "None", - "type": "dark" - }, - { - "name": "Elio", - "background_color": "#041a3b", - "background_image": "None", - "cursor_color": "#fbfbfb", - "foreground_color": "#f2f2f2", - "palette": "#303030:#e1321a:#6ab017:#ffc005:#729FCF:#ec0048:#2aa7e7:#f2f2f2:#5d5d5d:#ff361e:#7bc91f:#ffd00a:#0071ff:#ff1d62:#4bb8fd:#a020f0", - "type": "dark" - }, - { - "name": "ENCOM", - "palette": "#000000:#9f0000:#008b00:#ffd000:#0081ff:#bc00ca:#008b8b:#bbbbbb:#555555:#ff0000:#00ee00:#ffff00:#0000ff:#ff00ff:#00cdcd:#ffffff", - "background_color": "#000000", - "cursor_color": "#bbbbbb", - "foreground_color": "#00a595", - "background_image": "None", - "type": "dark" - }, - { - "name": "Espresso", - "palette": "#353535:#d25252:#a5c261:#ffc66d:#6c99bb:#d197d9:#bed6ff:#eeeeec:#535353:#f00c0c:#c2e075:#e1e48b:#8ab7d9:#efb5f7:#dcf4ff:#ffffff", - "background_color": "#323232", - "cursor_color": "#d6d6d6", - "foreground_color": "#ffffff", - "background_image": "None", - "type": "dark" - }, - { - "name": "Espresso Libre", - "palette": "#000000:#cc0000:#1a921c:#f0e53a:#0066ff:#c5656b:#06989a:#d3d7cf:#555753:#ef2929:#9aff87:#fffb5c:#43a8ed:#ff818a:#34e2e2:#eeeeec", - "background_color": "#2a211c", - "cursor_color": "#ffffff", - "foreground_color": "#b8a898", - "background_image": "None", - "type": "dark" - }, - { - "name": "Fideloper", - "palette": "#292f33:#cb1e2d:#edb8ac:#b7ab9b:#2e78c2:#c0236f:#309186:#eae3ce:#092028:#d4605a:#d4605a:#a86671:#7c85c4:#5c5db2:#819090:#fcf4df", - "background_color": "#292f33", - "cursor_color": "#d4605a", - "foreground_color": "#dbdae0", - "background_image": "None", - "type": "dark" - }, - { - "name": "FirefoxDev", - "palette": "#002831:#e63853:#5eb83c:#a57706:#359ddf:#d75cff:#4b73a2:#dcdcdc:#001e27:#e1003f:#1d9000:#cd9409:#006fc0:#a200da:#005794:#e2e2e2", - "background_color": "#0e1011", - "cursor_color": "#708284", - "foreground_color": "#7c8fa4", - "background_image": "None", - "type": "dark" - }, - { - "name": "Firewatch", - "palette": "#585f6d:#d95360:#5ab977:#dfb563:#4d89c4:#d55119:#44a8b6:#e6e5ff:#585f6d:#d95360:#5ab977:#dfb563:#4c89c5:#d55119:#44a8b6:#e6e5ff", - "background_color": "#1e2027", - "cursor_color": "#f6f7ec", - "foreground_color": "#9ba2b2", - "background_image": "None", - "type": "dark" - }, - { - "name": "FishTank", - "palette": "#03073c:#c6004a:#acf157:#fecd5e:#525fb8:#986f82:#968763:#ecf0fc:#6c5b30:#da4b8a:#dbffa9:#fee6a9:#b2befa:#fda5cd:#a5bd86:#f6ffec", - "background_color": "#232537", - "cursor_color": "#fecd5e", - "foreground_color": "#ecf0fe", - "background_image": "None", - "type": "dark" - }, - { - "name": "Flat", - "palette": "#222d3f:#a82320:#32a548:#e58d11:#3167ac:#781aa0:#2c9370:#b0b6ba:#212c3c:#d4312e:#2d9440:#e5be0c:#3c7dd2:#8230a7:#35b387:#e7eced", - "background_color": "#002240", - "cursor_color": "#e5be0c", - "foreground_color": "#2cc55d", - "background_image": "None", - "type": "dark" - }, - { - "name": "Flatland", - "palette": "#1d1d19:#f18339:#9fd364:#f4ef6d:#5096be:#695abc:#d63865:#ffffff:#1d1d19:#d22a24:#a7d42c:#ff8949:#61b9d0:#695abc:#d63865:#ffffff", - "background_color": "#1d1f21", - "cursor_color": "#708284", - "foreground_color": "#b8dbef", - "background_image": "None", - "type": "dark" - }, - { - "name": "Floraverse", - "palette": "#08002e:#64002c:#5d731a:#cd751c:#1d6da1:#b7077e:#42a38c:#f3e0b8:#331e4d:#d02063:#b4ce59:#fac357:#40a4cf:#f12aae:#62caa8:#fff5db", - "background_color": "#0e0d15", - "cursor_color": "#bbbbbb", - "foreground_color": "#dbd1b9", - "background_image": "None", - "type": "dark" - }, - { - "name": "ForestBlue", - "palette": "#333333:#f8818e:#92d3a2:#1a8e63:#8ed0ce:#5e468c:#31658c:#e2d8cd:#3d3d3d:#fb3d66:#6bb48d:#30c85a:#39a7a2:#7e62b3:#6096bf:#e2d8cd", - "background_color": "#051519", - "cursor_color": "#9e9ecb", - "foreground_color": "#e2d8cd", - "background_image": "None", - "type": "dark" - }, - { - "name": "Freya", - "background_color": "#252e32", - "background_image": "None", - "cursor_color": "#839496", - "foreground_color": "#94a3a5", - "palette": "#073642:#dc322f:#859900:#b58900:#268bd2:#ec0048:#2aa198:#94a3a5:#586e75:#cb4b16:#859900:#b58900:#268bd2:#d33682:#2aa198:#6c71c4", - "type": "dark" - }, - { - "name": "FrontEndDelight", - "palette": "#242526:#f8511b:#565747:#fa771d:#2c70b7:#f02e4f:#3ca1a6:#adadad:#5fac6d:#f74319:#74ec4c:#fdc325:#3393ca:#e75e4f:#4fbce6:#8c735b", - "background_color": "#1b1c1d", - "cursor_color": "#cdcdcd", - "foreground_color": "#adadad", - "background_image": "None", - "type": "dark" - }, - { - "name": "FunForrest", - "palette": "#000000:#d6262b:#919c00:#be8a13:#4699a3:#8d4331:#da8213:#ddc265:#7f6a55:#e55a1c:#bfc65a:#ffcb1b:#7cc9cf:#d26349:#e6a96b:#ffeaa3", - "background_color": "#251200", - "cursor_color": "#e5591c", - "foreground_color": "#dec165", - "background_image": "None", - "type": "dark" - }, - { - "name": "Galaxy", - "palette": "#000000:#f9555f:#21b089:#fef02a:#589df6:#944d95:#1f9ee7:#bbbbbb:#555555:#fa8c8f:#35bb9a:#ffff55:#589df6:#e75699:#3979bc:#ffffff", - "background_color": "#1d2837", - "cursor_color": "#bbbbbb", - "foreground_color": "#ffffff", - "background_image": "None", - "type": "dark" - }, - { - "name": "Github", - "palette": "#3e3e3e:#970b16:#07962a:#f8eec7:#003e8a:#e94691:#89d1ec:#ffffff:#666666:#de0000:#87d5a2:#f1d007:#2e6cba:#ffa29f:#1cfafe:#ffffff", - "background_color": "#f4f4f4", - "cursor_color": "#3f3f3f", - "foreground_color": "#3e3e3e", - "background_image": "None", - "type": "light" - }, - { - "name": "Glacier", - "palette": "#2e343c:#bd0f2f:#35a770:#fb9435:#1f5872:#bd2523:#778397:#ffffff:#404a55:#bd0f2f:#49e998:#fddf6e:#2a8bc1:#ea4727:#a0b6d3:#ffffff", - "background_color": "#0c1115", - "cursor_color": "#6c6c6c", - "foreground_color": "#ffffff", - "background_image": "None", - "type": "dark" - }, - { - "name": "Grape", - "palette": "#2d283f:#ed2261:#1fa91b:#8ddc20:#487df4:#8d35c9:#3bdeed:#9e9ea0:#59516a:#f0729a:#53aa5e:#b2dc87:#a9bcec:#ad81c2:#9de3eb:#a288f7", - "background_color": "#171423", - "cursor_color": "#a288f7", - "foreground_color": "#9f9fa1", - "background_image": "None", - "type": "dark" - }, - { - "name": "Grass", - "palette": "#000000:#bb0000:#00bb00:#e7b000:#0000a3:#950062:#00bbbb:#bbbbbb:#555555:#bb0000:#00bb00:#e7b000:#0000bb:#ff55ff:#55ffff:#ffffff", - "background_color": "#13773d", - "cursor_color": "#8c2800", - "foreground_color": "#fff0a5", - "background_image": "None", - "type": "dark" - }, - { - "name": "Gruvbox Dark", - "palette": "#161819:#f73028:#aab01e:#f7b125:#719586:#c77089:#7db669:#faefbb:#7f7061:#be0f17:#868715:#cc881a:#377375:#a04b73:#578e57:#e6d4a3", - "background_color": "#1e1e1e", - "cursor_color": "#bbbbbb", - "foreground_color": "#e6d4a3", - "background_image": "None", - "type": "dark" - }, - { - "name": "Hardcore", - "palette": "#1b1d1e:#f92672:#a6e22e:#fd971f:#66d9ef:#9e6ffe:#5e7175:#ccccc6:#505354:#ff669d:#beed5f:#e6db74:#66d9ef:#9e6ffe:#a3babf:#f8f8f2", - "background_color": "#121212", - "cursor_color": "#bbbbbb", - "foreground_color": "#a0a0a0", - "background_image": "None", - "type": "dark" - }, - { - "name": "Harper", - "palette": "#010101:#f8b63f:#7fb5e1:#d6da25:#489e48:#b296c6:#f5bfd7:#a8a49d:#726e6a:#f8b63f:#7fb5e1:#d6da25:#489e48:#b296c6:#f5bfd7:#fefbea", - "background_color": "#010101", - "cursor_color": "#a8a49d", - "foreground_color": "#a8a49d", - "background_image": "None", - "type": "dark" - }, - { - "name": "Hemisu dark", - "background_image": "None", - "cursor_color": "#BAFFAA", - "foreground_color": "#FFFFFF", - "palette": "#444444:#FF0054:#B1D630:#9D895E:#67BEE3:#B576BC:#569A9F:#EDEDED:#777777:#D65E75:#BAFFAA:#ECE1C8:#9FD3E5:#DEB3DF:#B6E0E5:#FFFFFF", - "type": "dark" - }, - { - "name": "Hemisu light", - "background_color": "#EFEFEF", - "background_image": "None", - "cursor_color": "#FF0054", - "foreground_color": "#444444", - "palette": "#777777:#FF0055:#739100:#503D15:#538091:#5B345E:#538091:#999999:#999999:#D65E76:#9CC700:#947555:#9DB3CD:#A184A4:#85B2AA:#BABABA", - "type": "light" - }, - { - "name": "Highway", - "palette": "#000000:#d00e18:#138034:#ffcb3e:#006bb3:#6b2775:#384564:#ededed:#5d504a:#f07e18:#b1d130:#fff120:#4fc2fd:#de0071:#5d504a:#ffffff", - "background_color": "#222225", - "cursor_color": "#e0d9b9", - "foreground_color": "#ededed", - "background_image": "None", - "type": "dark" - }, - { - "name": "Hipster Green", - "palette": "#000000:#b6214a:#00a600:#bfbf00:#246eb2:#b200b2:#00a6b2:#bfbfbf:#666666:#e50000:#86a93e:#e5e500:#0000ff:#e500e5:#00e5e5:#e5e5e5", - "background_color": "#100b05", - "cursor_color": "#23ff18", - "foreground_color": "#84c138", - "background_image": "None", - "type": "dark" - }, - { - "name": "Homebrew", - "palette": "#000000:#990000:#00a600:#999900:#0000b2:#b200b2:#00a6b2:#bfbfbf:#666666:#e50000:#00d900:#e5e500:#0000ff:#e500e5:#00e5e5:#e5e5e5", - "background_color": "#000000", - "cursor_color": "#23ff18", - "foreground_color": "#00ff00", - "background_image": "None", - "type": "dark" - }, - { - "name": "Hurtado", - "palette": "#575757:#ff1b00:#a5e055:#fbe74a:#496487:#fd5ff1:#86e9fe:#cbcccb:#262626:#d51d00:#a5df55:#fbe84a:#89beff:#c001c1:#86eafe:#dbdbdb", - "background_color": "#000000", - "cursor_color": "#bbbbbb", - "foreground_color": "#dbdbdb", - "background_image": "None", - "type": "dark" - }, - { - "name": "Hybrid", - "palette": "#2a2e33:#b84d51:#b3bf5a:#e4b55e:#6e90b0:#a17eac:#7fbfb4:#b5b9b6:#1d1f22:#8d2e32:#798431:#e58a50:#4b6b88:#6e5079:#4d7b74:#5a626a", - "background_color": "#161719", - "cursor_color": "#b7bcba", - "foreground_color": "#b7bcba", - "background_image": "None", - "type": "dark" - }, - { - "name": "IC_Green_PPL", - "palette": "#1f1f1f:#fb002a:#339c24:#659b25:#149b45:#53b82c:#2cb868:#e0ffef:#032710:#a7ff3f:#9fff6d:#d2ff6d:#72ffb5:#50ff3e:#22ff71:#daefd0", - "background_color": "#3a3d3f", - "cursor_color": "#42ff58", - "foreground_color": "#d9efd3", - "background_image": "None", - "type": "dark" - }, - { - "name": "IC_Orange_PPL", - "palette": "#000000:#c13900:#a4a900:#caaf00:#bd6d00:#fc5e00:#f79500:#ffc88a:#6a4f2a:#ff8c68:#f6ff40:#ffe36e:#ffbe55:#fc874f:#c69752:#fafaff", - "background_color": "#262626", - "cursor_color": "#fc531d", - "foreground_color": "#ffcb83", - "background_image": "None", - "type": "dark" - }, - { - "name": "idleToes", - "palette": "#323232:#d25252:#7fe173:#ffc66d:#4099ff:#f680ff:#bed6ff:#eeeeec:#535353:#f07070:#9dff91:#ffe48b:#5eb7f7:#ff9dff:#dcf4ff:#ffffff", - "background_color": "#323232", - "cursor_color": "#d6d6d6", - "foreground_color": "#ffffff", - "background_image": "None", - "type": "dark" - }, - { - "name": "IR_Black", - "palette": "#4f4f4f:#fa6c60:#a8ff60:#fffeb7:#96cafe:#fa73fd:#c6c5fe:#efedef:#7b7b7b:#fcb6b0:#cfffab:#ffffcc:#b5dcff:#fb9cfe:#e0e0fe:#ffffff", - "background_color": "#000000", - "cursor_color": "#808080", - "foreground_color": "#f1f1f1", - "background_image": "None", - "type": "dark" - }, - { - "name": "Jackie Brown", - "palette": "#2c1d16:#ef5734:#2baf2b:#bebf00:#246eb2:#d05ec1:#00acee:#bfbfbf:#666666:#e50000:#86a93e:#e5e500:#0000ff:#e500e5:#00e5e5:#e5e5e5", - "background_color": "#2c1d16", - "cursor_color": "#23ff18", - "foreground_color": "#ffcc2f", - "background_image": "None", - "type": "dark" - }, - { - "name": "Japanesque", - "palette": "#343935:#cf3f61:#7bb75b:#e9b32a:#4c9ad4:#a57fc4:#389aad:#fafaf6:#595b59:#d18fa6:#767f2c:#78592f:#135979:#604291:#76bbca:#b2b5ae", - "background_color": "#1e1e1e", - "cursor_color": "#edcf4f", - "foreground_color": "#f7f6ec", - "background_image": "None", - "type": "dark" - }, - { - "name": "Jellybeans", - "palette": "#929292:#e27373:#94b979:#ffba7b:#97bedc:#e1c0fa:#00988e:#dedede:#bdbdbd:#ffa1a1:#bddeab:#ffdca0:#b1d8f6:#fbdaff:#1ab2a8:#ffffff", - "background_color": "#121212", - "cursor_color": "#ffa560", - "foreground_color": "#dedede", - "background_image": "None", - "type": "dark" - }, - { - "name": "JetBrains Darcula", - "palette": "#000000:#fa5355:#126e00:#c2c300:#4581eb:#fa54ff:#33c2c1:#adadad:#555555:#fb7172:#67ff4f:#ffff00:#6d9df1:#fb82ff:#60d3d1:#eeeeee", - "background_color": "#202020", - "cursor_color": "#ffffff", - "foreground_color": "#adadad", - "background_image": "None", - "type": "dark" - }, - { - "name": "Juicy", - "background_color": "#212121", - "cursor_color": "#fcfcfc", - "foreground_color": "#fcfcfc", - "palette": "#2e3436:#ff0945:#1aff81:#fff64a:#2bf1ff:#7b68ee:#98f4ff:#d3d7cf:#555753:#ff0945:#1aff81:#fff64a:#2bf1ff:#7b68ee:#98f4ff:#eeeeec", - "background_image": "None", - "type": "dark" - }, - { - "name": "Kibble", - "palette": "#4d4d4d:#c70031:#29cf13:#d8e30e:#3449d1:#8400ff:#0798ab:#e2d1e3:#5a5a5a:#f01578:#6ce05c:#f3f79e:#97a4f7:#c495f0:#68f2e0:#ffffff", - "background_color": "#0e100a", - "cursor_color": "#9fda9c", - "foreground_color": "#f7f7f7", - "background_image": "None", - "type": "dark" - }, - { - "name": "Later This Evening", - "palette": "#2b2b2b:#d45a60:#afba67:#e5d289:#a0bad6:#c092d6:#91bfb7:#3c3d3d:#454747:#d3232f:#aabb39:#e5be39:#6699d6:#ab53d6:#5fc0ae:#c1c2c2", - "background_color": "#222222", - "cursor_color": "#424242", - "foreground_color": "#959595", - "background_image": "None", - "type": "dark" - }, - { - "name": "Lavandula", - "palette": "#230046:#7d1625:#337e6f:#7f6f49:#4f4a7f:#5a3f7f:#58777f:#736e7d:#372d46:#e05167:#52e0c4:#e0c386:#8e87e0:#a776e0:#9ad4e0:#8c91fa", - "background_color": "#050014", - "cursor_color": "#8c91fa", - "foreground_color": "#736e7d", - "background_image": "None", - "type": "dark" - }, - { - "name": "LiquidCarbon", - "palette": "#000000:#ff3030:#559a70:#ccac00:#0099cc:#cc69c8:#7ac4cc:#bccccc:#000000:#ff3030:#559a70:#ccac00:#0099cc:#cc69c8:#7ac4cc:#bccccc", - "background_color": "#303030", - "cursor_color": "#ffffff", - "foreground_color": "#afc2c2", - "background_image": "None", - "type": "dark" - }, - { - "name": "LiquidCarbonTransparent", - "palette": "#000000:#ff3030:#559a70:#ccac00:#0099cc:#cc69c8:#7ac4cc:#bccccc:#000000:#ff3030:#559a70:#ccac00:#0099cc:#cc69c8:#7ac4cc:#bccccc", - "background_color": "#000000", - "cursor_color": "#ffffff", - "foreground_color": "#afc2c2", - "background_image": "None", - "type": "dark" - }, - { - "name": "LiquidCarbonTransparentInverse", - "palette": "#bccccd:#ff3030:#559a70:#ccac00:#0099cc:#cc69c8:#7ac4cc:#000000:#ffffff:#ff3030:#559a70:#ccac00:#0099cc:#cc69c8:#7ac4cc:#000000", - "background_color": "#000000", - "cursor_color": "#ffffff", - "foreground_color": "#afc2c2", - "background_image": "None", - "type": "dark" - }, - { - "name": "Lucy", - "background_color": "#1a1b23", - "cursor_color": "#af98e6", - "foreground_color": "#96979b", - "palette": "#2e3436:#fb7da7:#76c5a4:#e8d56d:#3465a4:#af98e6:#56c9db:#d3d7cf:#555753:#fb7da7:#76c5a4:#e8d56d:#729fcf:#af98e6:#56c9db:#eeeeec", - "type": "dark" - }, - { - "name": "Man Page", - "palette": "#000000:#cc0000:#00a600:#999900:#0000b2:#b200b2:#00a6b2:#cccccc:#666666:#e50000:#00d900:#e5e500:#0000ff:#e500e5:#00e5e5:#e5e5e5", - "background_color": "#fef49c", - "cursor_color": "#7f7f7f", - "foreground_color": "#000000", - "background_image": "None", - "type": "light" - }, - { - "name": "Mar", - "background_color": "#ffffff", - "background_image": "None", - "cursor_color": "#23476a", - "foreground_color": "#23476a", - "palette": "#000000:#b5407b:#7bb540:#b57b40:#407bb5:#7b40b5:#40b57b:#f8f8f8:#737373:#cd73a0:#a0cd73:#cda073:#73a0cd:#a073cd:#73cda0:#ffffff", - "type": "light" - }, - { - "name": "Material", - "palette": "#212121:#b7141f:#457b24:#f6981e:#134eb2:#560088:#0e717c:#efefef:#424242:#e83b3f:#7aba3a:#ffea2e:#54a4f3:#aa4dbc:#26bbd1:#d9d9d9", - "background_color": "#eaeaea", - "cursor_color": "#16afca", - "foreground_color": "#232322", - "background_image": "None", - "type": "light" - }, - { - "name": "Material colors", - "background_color": "#1E282C", - "background_image": "None", - "cursor_color": "#657B83", - "foreground_color": "#C3C7D1", - "palette": "#073641:#EB606B:#C3E88D:#F7EB95:#80CBC3:#FF2490:#AEDDFF:#FFFFFF:#002B36:#EB606B:#C3E88D:#F7EB95:#7DC6BF:#6C71C3:#34434D:#FFFFFF", - "type": "dark" - }, - { - "name": "Material-Ocean", - "background_color": "#0f111a", - "cursor_color": "#ffcc00", - "cursor_color_fg": "False", - "foreground_color": "#8f93a2", - "palette": "#2e3436:#ff5370:#c3e88d:#ffcb6b:#82aaff:#c792ea:#89ddff:#d3d7cf:#555753:#f07178:#c3e88d:#f78c6c:#729fcf:#bb80b3:#89ddff:#eeeeec", - "type": "dark" - }, - { - "name": "Material-Palenight", - "background_color": "#292d3e", - "cursor_color": "#ffcc00", - "cursor_color_fg": "False", - "foreground_color": "#a6accd", - "palette": "#2e3436:#ff5370:#c3e88d:#ffcb6b:#82aaff:#c792ea:#89ddff:#d3d7cf:#555753:#f07178:#c3e88d:#f78c6c:#729fcf:#bb80b3:#89ddff:#eeeeec", - "type": "dark" - }, - { - "name": "MaterialDark", - "palette": "#212121:#b7141f:#457b24:#f6981e:#134eb2:#560088:#0e717c:#efefef:#424242:#e83b3f:#7aba3a:#ffea2e:#54a4f3:#aa4dbc:#26bbd1:#d9d9d9", - "background_color": "#232322", - "cursor_color": "#16afca", - "foreground_color": "#e5e5e5", - "background_image": "None", - "type": "dark" - }, - { - "name": "Mathias", - "palette": "#000000:#e52222:#a6e32d:#fc951e:#c48dff:#fa2573:#67d9f0:#f2f2f2:#555555:#ff5555:#55ff55:#ffff55:#5555ff:#ff55ff:#55ffff:#ffffff", - "background_color": "#000000", - "cursor_color": "#bbbbbb", - "foreground_color": "#bbbbbb", - "background_image": "None", - "type": "dark" - }, - { - "name": "Medallion", - "palette": "#000000:#b64c00:#7c8b16:#d3bd26:#616bb0:#8c5a90:#916c25:#cac29a:#5e5219:#ff9149:#b2ca3b:#ffe54a:#acb8ff:#ffa0ff:#ffbc51:#fed698", - "background_color": "#1d1908", - "cursor_color": "#d3ba30", - "foreground_color": "#cac296", - "background_image": "None", - "type": "dark" - }, - { - "name": "Misterioso", - "palette": "#000000:#ff4242:#74af68:#ffad29:#338f86:#9414e6:#23d7d7:#e1e1e0:#555555:#ff3242:#74cd68:#ffb929:#23d7d7:#ff37ff:#00ede1:#ffffff", - "background_color": "#2d3743", - "cursor_color": "#000000", - "foreground_color": "#e1e1e0", - "background_image": "None", - "type": "dark" - }, - { - "name": "Miu", - "background_color": "#0d1926", - "background_image": "None", - "cursor_color": "#d7dee4", - "foreground_color": "#d9e6f2", - "palette": "#000000:#b87a7a:#7ab87a:#b8b87a:#7a7ab8:#b87ab8:#7ab8b8:#d9d9d9:#262626:#dbbdbd:#bddbbd:#dbdbbd:#bdbddb:#dbbddb:#bddbdb:#ffffff", - "type": "dark" - }, - { - "name": "Molokai", - "palette": "#121212:#fa2573:#98e123:#dfd460:#1080d0:#8700ff:#43a8d0:#bbbbbb:#555555:#f6669d:#b1e05f:#fff26d:#00afff:#af87ff:#51ceff:#ffffff", - "background_color": "#121212", - "cursor_color": "#bbbbbb", - "foreground_color": "#bbbbbb", - "background_image": "None", - "type": "dark" - }, - { - "name": "MonaLisa", - "palette": "#351b0e:#9b291c:#636232:#c36e28:#515c5d:#9b1d29:#588056:#f7d75c:#874228:#ff4331:#b4b264:#ff9566:#9eb2b4:#ff5b6a:#8acd8f:#ffe598", - "background_color": "#120b0d", - "cursor_color": "#c46c32", - "foreground_color": "#f7d66a", - "background_image": "None", - "type": "dark" - }, - { - "name": "Monokai dark", - "background_color": "#272822", - "background_image": "None", - "cursor_color": "#ffffff", - "foreground_color": "#f8f8f2", - "palette": "#75715e:#f92672:#a6e22e:#f4bf75:#66d9ef:#ae81ff:#2aa198:#f9f8f5:#272822:#f92672:#a6e22e:#f4bf75:#66d9ef:#ae81ff:#2aa198:#f9f8f5", - "type": "dark" - }, - { - "name": "Monokai Soda", - "palette": "#1a1a1a:#f4005f:#98e024:#fa8419:#9d65ff:#f4005f:#58d1eb:#c4c5b5:#625e4c:#f4005f:#98e024:#e0d561:#9d65ff:#f4005f:#58d1eb:#f6f6ef", - "background_color": "#1a1a1a", - "cursor_color": "#f6f7ec", - "foreground_color": "#c4c5b5", - "background_image": "None", - "type": "dark" - }, - { - "name": "Monokai Vivid", - "palette": "#121212:#fa2934:#98e123:#fff30a:#0443ff:#f800f8:#01b6ed:#ffffff:#838383:#f6669d:#b1e05f:#fff26d:#0443ff:#f200f6:#51ceff:#ffffff", - "background_color": "#121212", - "cursor_color": "#fb0007", - "foreground_color": "#f9f9f9", - "background_image": "None", - "type": "dark" - }, - { - "name": "N0tch2k", - "palette": "#383838:#a95551:#666666:#a98051:#657d3e:#767676:#c9c9c9:#d0b8a3:#474747:#a97775:#8c8c8c:#a99175:#98bd5e:#a3a3a3:#dcdcdc:#d8c8bb", - "background_color": "#222222", - "cursor_color": "#aa9175", - "foreground_color": "#a0a0a0", - "background_image": "None", - "type": "dark" - }, - { - "name": "Nebula", - "background_color": "#23262e", - "cursor_color": "#00e8c6", - "foreground_color": "#ffffff", - "palette": "#2e3436:#ff007a:#84ff39:#f3d56e:#7cb7ff:#c74ded:#00e8c6:#d3d7cf:#555753:#ff007a:#84ff39:#f3d56e:#7cb7ff:#c74ded:#00e8c6:#eeeeec", - "type": "dark" - }, - { - "name": "Neopolitan", - "palette": "#000000:#800000:#61ce3c:#fbde2d:#253b76:#ff0080:#8da6ce:#f8f8f8:#000000:#800000:#61ce3c:#fbde2d:#253b76:#ff0080:#8da6ce:#f8f8f8", - "background_color": "#271f19", - "cursor_color": "#ffffff", - "foreground_color": "#ffffff", - "background_image": "None", - "type": "dark" - }, - { - "name": "Neutron", - "palette": "#23252b:#b54036:#5ab977:#deb566:#6a7c93:#a4799d:#3f94a8:#e6e8ef:#23252b:#b54036:#5ab977:#deb566:#6a7c93:#a4799d:#3f94a8:#ebedf2", - "background_color": "#1c1e22", - "cursor_color": "#f6f7ec", - "foreground_color": "#e6e8ef", - "background_image": "None", - "type": "dark" - }, - { - "name": "Night Owl", - "background_color": "#011627", - "cursor_color": "#80a4c2", - "cursor_color_fg": "False", - "foreground_color": "#d6deeb", - "palette": "#2e3436:#ef5350:#80cbc4:#ffeb95:#82aaff:#c792ea:#addb67:#d3d7cf:#555753:#ef5350:#80cbc4:#ffeb95:#82aaff:#c792ea:#addb67:#eeeeec", - "type": "dark" - }, - { - "name": "NightLion v1", - "palette": "#4c4c4c:#bb0000:#5fde8f:#f3f167:#276bd8:#bb00bb:#00dadf:#bbbbbb:#555555:#ff5555:#55ff55:#ffff55:#5555ff:#ff55ff:#55ffff:#ffffff", - "background_color": "#000000", - "cursor_color": "#bbbbbb", - "foreground_color": "#bbbbbb", - "background_image": "None", - "type": "dark" - }, - { - "name": "NightLion v2", - "palette": "#4c4c4c:#bb0000:#04f623:#f3f167:#64d0f0:#ce6fdb:#00dadf:#bbbbbb:#555555:#ff5555:#7df71d:#ffff55:#62cbe8:#ff9bf5:#00ccd8:#ffffff", - "background_color": "#171717", - "cursor_color": "#bbbbbb", - "foreground_color": "#bbbbbb", - "background_image": "None", - "type": "dark" - }, - { - "name": "Nord", - "background_color": "#2E3440", - "cursor_color": "#D8DEE9", - "foreground_color": "#D8DEE9", - "palette": "#3B4252:#BF616A:#A3BE8C:#EBCB8B:#81A1C1:#B48EAD:#88C0D0:#E5E9F0:#4C566A:#BF616A:#A3BE8C:#EBCB8B:#81A1C1:#B48EAD:#8FBCBB:#ECEFF4", - "type": "dark" - }, - { - "name": "Novel", - "palette": "#000000:#cc0000:#009600:#d06b00:#0000cc:#cc00cc:#0087cc:#cccccc:#808080:#cc0000:#009600:#d06b00:#0000cc:#cc00cc:#0087cc:#ffffff", - "background_color": "#dfdbc3", - "cursor_color": "#73635a", - "foreground_color": "#3b2322", - "background_image": "None", - "type": "light" - }, - { - "name": "Obsidian", - "palette": "#000000:#a60001:#00bb00:#fecd22:#3a9bdb:#bb00bb:#00bbbb:#bbbbbb:#555555:#ff0003:#93c863:#fef874:#a1d7ff:#ff55ff:#55ffff:#ffffff", - "background_color": "#283033", - "cursor_color": "#c0cad0", - "foreground_color": "#cdcdcd", - "background_image": "None", - "type": "dark" - }, - { - "name": "Ocean", - "palette": "#000000:#990000:#00a600:#999900:#0000b2:#b200b2:#00a6b2:#bfbfbf:#666666:#e50000:#00d900:#e5e500:#0000ff:#e500e5:#00e5e5:#e5e5e5", - "background_color": "#224fbc", - "cursor_color": "#7f7f7f", - "foreground_color": "#ffffff", - "background_image": "None", - "type": "dark" - }, - { - "name": "Ocean dark", - "background_color": "#1c1f27", - "background_image": "None", - "cursor_color": "#a0a4b2", - "foreground_color": "#979cac", - "palette": "#4F4F4F:#AF4B57:#AFD383:#E5C079:#7D90A4:#A4799D:#85A6A5:#EEEDEE:#7B7B7B:#AF4B57:#CEFFAB:#FFFECC:#B5DCFE:#FB9BFE:#DFDFFD:#FEFFFE", - "type": "dark" - }, - { - "name": "OceanicMaterial", - "palette": "#000000:#ee2b2a:#40a33f:#ffea2e:#1e80f0:#8800a0:#16afca:#a4a4a4:#777777:#dc5c60:#70be71:#fff163:#54a4f3:#aa4dbc:#42c7da:#ffffff", - "background_color": "#1c262b", - "cursor_color": "#b3b8c3", - "foreground_color": "#c2c8d7", - "background_image": "None", - "type": "dark" - }, - { - "name": "Ollie", - "palette": "#000000:#ac2e31:#31ac61:#ac4300:#2d57ac:#b08528:#1fa6ac:#8a8eac:#5b3725:#ff3d48:#3bff99:#ff5e1e:#4488ff:#ffc21d:#1ffaff:#5b6ea7", - "background_color": "#222125", - "cursor_color": "#5b6ea7", - "foreground_color": "#8a8dae", - "background_image": "None", - "type": "dark" - }, - { - "name": "One dark", - "background_color": "#1e2127", - "background_image": "None", - "cursor_color": "#676c76", - "foreground_color": "#5c6370", - "palette": "#000000:#e06c75:#98c379:#d19a66:#61afef:#c678dd:#56b6c2:#abb2bf:#5c6370:#e06c75:#98c379:#d19a66:#61afef:#c678dd:#56b6c2:#fffefe", - "type": "dark" - }, - { - "name": "OneHalfDark", - "palette": "#282c34:#e06c75:#98c379:#e5c07b:#61afef:#c678dd:#56b6c2:#dcdfe4:#282c34:#e06c75:#98c379:#e5c07b:#61afef:#c678dd:#56b6c2:#dcdfe4", - "background_color": "#282c34", - "cursor_color": "#a3b3cc", - "foreground_color": "#dcdfe4", - "background_image": "None", - "type": "dark" - }, - { - "name": "OneHalfLight", - "palette": "#383a42:#e45649:#50a14f:#c18401:#0184bc:#a626a4:#0997b3:#fafafa:#4f525e:#e06c75:#98c379:#e5c07b:#61afef:#c678dd:#56b6c2:#ffffff", - "background_color": "#fafafa", - "cursor_color": "#bfceff", - "foreground_color": "#383a42", - "background_image": "None", - "type": "light" - }, - { - "name": "Pali", - "background_color": "#232e37", - "background_image": "None", - "cursor_color": "#e3ecf5", - "foreground_color": "#d9e6f2", - "palette": "#0a0a0a:#ab8f74:#74ab8f:#8fab74:#8f74ab:#ab748f:#748fab:#f2f2f2:#5d5d5d:#ff1d62:#9cc3af:#ffd00a:#af9cc3:#ff1d62:#4bb8fd:#a020f0", - "type": "dark" - }, - { - "name": "Panda", - "background_color": "#292a2b", - "cursor_color": "#f0eeee", - "foreground_color": "#e6e6e6", - "palette": "#676b79:#ff2c6d:#19f9d8:#ffb86c:#45a9f9:#b084eb:#6fc1ff:#d3d7cf:#676b79:#ff9ac1:#19f9d8:#ffcc95:#45a9f9:#b084eb:#6fc1ff:#eeeeec", - "background_image": "None", - "type": "dark" - }, - { - "name": "Pandora", - "palette": "#000000:#ff4242:#74af68:#ffad29:#338f86:#9414e6:#23d7d7:#e2e2e2:#3f5648:#ff3242:#74cd68:#ffb929:#23d7d7:#ff37ff:#00ede1:#ffffff", - "background_color": "#141e43", - "cursor_color": "#43d58e", - "foreground_color": "#e1e1e1", - "background_image": "None", - "type": "dark" - }, - { - "name": "Paraiso Dark", - "palette": "#2f1e2e:#ef6155:#48b685:#fec418:#06b6ef:#815ba4:#5bc4bf:#a39e9b:#776e71:#ef6155:#48b685:#fec418:#06b6ef:#815ba4:#5bc4bf:#e7e9db", - "background_color": "#2f1e2e", - "cursor_color": "#a39e9b", - "foreground_color": "#a39e9b", - "background_image": "None", - "type": "dark" - }, - { - "name": "Parasio Dark", - "palette": "#2f1e2e:#ef6155:#48b685:#fec418:#06b6ef:#815ba4:#5bc4bf:#a39e9b:#776e71:#ef6155:#48b685:#fec418:#06b6ef:#815ba4:#5bc4bf:#e7e9db", - "background_color": "#2f1e2e", - "cursor_color": "#a39e9b", - "foreground_color": "#a39e9b", - "background_image": "None", - "type": "dark" - }, - { - "name": "PaulMillr", - "palette": "#2a2a2a:#ff0000:#79ff0f:#e7bf00:#396bd7:#b449be:#66ccff:#bbbbbb:#666666:#ff0080:#66ff66:#f3d64e:#709aed:#db67e6:#7adff2:#ffffff", - "background_color": "#000000", - "cursor_color": "#4d4d4d", - "foreground_color": "#f2f2f2", - "background_image": "None", - "type": "dark" - }, - { - "name": "PencilDark", - "palette": "#212121:#c30771:#10a778:#a89c14:#008ec4:#523c79:#20a5ba:#d9d9d9:#424242:#fb007a:#5fd7af:#f3e430:#20bbfc:#6855de:#4fb8cc:#f1f1f1", - "background_color": "#212121", - "cursor_color": "#20bbfc", - "foreground_color": "#f1f1f1", - "background_image": "None", - "type": "dark" - }, - { - "name": "PencilLight", - "palette": "#212121:#c30771:#10a778:#a89c14:#008ec4:#523c79:#20a5ba:#d9d9d9:#424242:#fb007a:#5fd7af:#f3e430:#20bbfc:#6855de:#4fb8cc:#f1f1f1", - "background_color": "#f1f1f1", - "cursor_color": "#20bbfc", - "foreground_color": "#424242", - "background_image": "None", - "type": "light" - }, - { - "name": "Peppermint", - "background_image": "None", - "cursor_color": "#BBBBBB", - "foreground_color": "#c7c7c7", - "palette": "#353535:#E64569:#89D287:#DAB752:#439ECF:#D961DC:#64AAAF:#B3B3B3:#535353:#E4859A:#A2CCA1:#E1E387:#6FBBE2:#E586E7:#96DCDA:#DEDEDE", - "type": "dark" - }, - { - "name": "Piatto Light", - "palette": "#414141:#b23771:#66781e:#cd6f34:#3c5ea8:#a454b2:#66781e:#ffffff:#3f3f3f:#db3365:#829429:#cd6f34:#3c5ea8:#a454b2:#829429:#f2f2f2", - "background_color": "#ffffff", - "cursor_color": "#5e77c8", - "foreground_color": "#414141", - "background_image": "None", - "type": "light" - }, - { - "name": "Pnevma", - "palette": "#2f2e2d:#a36666:#90a57d:#d7af87:#7fa5bd:#c79ec4:#8adbb4:#d0d0d0:#4a4845:#d78787:#afbea2:#e4c9af:#a1bdce:#d7beda:#b1e7dd:#efefef", - "background_color": "#1c1c1c", - "cursor_color": "#e4c9af", - "foreground_color": "#d0d0d0", - "background_image": "None", - "type": "dark" - }, - { - "name": "Pro", - "palette": "#000000:#990000:#00a600:#999900:#2009db:#b200b2:#00a6b2:#bfbfbf:#666666:#e50000:#00d900:#e5e500:#0000ff:#e500e5:#00e5e5:#e5e5e5", - "background_color": "#000000", - "cursor_color": "#4d4d4d", - "foreground_color": "#f2f2f2", - "background_image": "None", - "type": "dark" - }, - { - "name": "Red Alert", - "palette": "#000000:#d62e4e:#71be6b:#beb86b:#489bee:#e979d7:#6bbeb8:#d6d6d6:#262626:#e02553:#aff08c:#dfddb7:#65aaf1:#ddb7df:#b7dfdd:#ffffff", - "background_color": "#762423", - "cursor_color": "#ffffff", - "foreground_color": "#ffffff", - "background_image": "None", - "type": "dark" - }, - { - "name": "Red Planet", - "palette": "#202020:#8c3432:#728271:#e8bf6a:#69819e:#896492:#5b8390:#b9aa99:#676767:#b55242:#869985:#ebeb91:#60827e:#de4974:#38add8:#d6bfb8", - "background_color": "#222222", - "cursor_color": "#c2b790", - "foreground_color": "#c2b790", - "background_image": "None", - "type": "dark" - }, - { - "name": "Red Sands", - "palette": "#000000:#ff3f00:#00bb00:#e7b000:#0072ff:#bb00bb:#00bbbb:#bbbbbb:#555555:#bb0000:#00bb00:#e7b000:#0072ae:#ff55ff:#55ffff:#ffffff", - "background_color": "#7a251e", - "cursor_color": "#ffffff", - "foreground_color": "#d7c9a7", - "background_image": "None", - "type": "dark" - }, - { - "name": "Relaxed", - "palette": "#151515:#bc5653:#909d63:#ebc17a:#6a8799:#b06698:#c9dfff:#d9d9d9:#636363:#bc5653:#a0ac77:#ebc17a:#7eaac7:#b06698:#acbbd0:#f7f7f7", - "background_color": "#353a44", - "cursor_color": "#d9d9d9", - "foreground_color": "#d9d9d9", - "background_image": "None", - "type": "dark" - }, - { - "name": "Rippedcasts", - "palette": "#000000:#cdaf95:#a8ff60:#bfbb1f:#75a5b0:#ff73fd:#5a647e:#bfbfbf:#666666:#eecbad:#bcee68:#e5e500:#86bdc9:#e500e5:#8c9bc4:#e5e5e5", - "background_color": "#2b2b2b", - "cursor_color": "#7f7f7f", - "foreground_color": "#ffffff", - "background_image": "None", - "type": "dark" - }, - { - "name": "Royal", - "palette": "#241f2b:#91284c:#23801c:#b49d27:#6580b0:#674d96:#8aaabe:#524966:#312d3d:#d5356c:#2cd946:#fde83b:#90baf9:#a479e3:#acd4eb:#9e8cbd", - "background_color": "#100815", - "cursor_color": "#524966", - "foreground_color": "#514968", - "background_image": "None", - "type": "dark" - }, - { - "name": "Ryuuko", - "palette": "#2c3941:#865f5b:#66907d:#b1a990:#6a8e95:#b18a73:#88b2ac:#ececec:#5d7079:#865f5b:#66907d:#b1a990:#6a8e95:#b18a73:#88b2ac:#ececec", - "background_color": "#2c3941", - "cursor_color": "#ececec", - "foreground_color": "#ececec", - "background_image": "None", - "type": "dark" - }, - { - "name": "Seafoam Pastel", - "palette": "#757575:#825d4d:#728c62:#ada16d:#4d7b82:#8a7267:#729494:#e0e0e0:#8a8a8a:#cf937a:#98d9aa:#fae79d:#7ac3cf:#d6b2a1:#ade0e0:#e0e0e0", - "background_color": "#243435", - "cursor_color": "#57647a", - "foreground_color": "#d4e7d4", - "background_image": "None", - "type": "dark" - }, - { - "name": "SeaShells", - "palette": "#17384c:#d15123:#027c9b:#fca02f:#1e4950:#68d4f1:#50a3b5:#deb88d:#434b53:#d48678:#628d98:#fdd39f:#1bbcdd:#bbe3ee:#87acb4:#fee4ce", - "background_color": "#09141b", - "cursor_color": "#fca02f", - "foreground_color": "#deb88d", - "background_image": "None", - "type": "dark" - }, - { - "name": "Seti", - "palette": "#323232:#c22832:#8ec43d:#e0c64f:#43a5d5:#8b57b5:#8ec43d:#eeeeee:#323232:#c22832:#8ec43d:#e0c64f:#43a5d5:#8b57b5:#8ec43d:#ffffff", - "background_color": "#111213", - "cursor_color": "#e3bf21", - "foreground_color": "#cacecd", - "background_image": "None", - "type": "dark" - }, - { - "name": "Shaman", - "palette": "#012026:#b2302d:#00a941:#5e8baa:#449a86:#00599d:#5d7e19:#405555:#384451:#ff4242:#2aea5e:#8ed4fd:#61d5ba:#1298ff:#98d028:#58fbd6", - "background_color": "#001015", - "cursor_color": "#4afcd6", - "foreground_color": "#405555", - "background_image": "None", - "type": "dark" - }, - { - "name": "Shel", - "background_color": "#2a201f", - "background_image": "None", - "cursor_color": "#6192d2", - "foreground_color": "#4882cd", - "palette": "#2c2423:#ab2463:#6ca323:#ab6423:#2c64a2:#6c24a2:#2ca363:#918988:#918988:#f588b9:#c2ee86:#f5ba86:#8fbaec:#c288ec:#8feeb9:#f5eeec", - "type": "dark" - }, - { - "name": "Slate", - "palette": "#222222:#e2a8bf:#81d778:#c4c9c0:#264b49:#a481d3:#15ab9c:#02c5e0:#ffffff:#ffcdd9:#beffa8:#d0ccca:#7ab0d2:#c5a7d9:#8cdfe0:#e0e0e0", - "background_color": "#222222", - "cursor_color": "#87d3c4", - "foreground_color": "#35b1d2", - "background_image": "None", - "type": "dark" - }, - { - "name": "Smyck", - "palette": "#000000:#b84131:#7da900:#c4a500:#62a3c4:#ba8acc:#207383:#a1a1a1:#7a7a7a:#d6837c:#c4f137:#fee14d:#8dcff0:#f79aff:#6ad9cf:#f7f7f7", - "background_color": "#1b1b1b", - "cursor_color": "#bbbbbb", - "foreground_color": "#f7f7f7", - "background_image": "None", - "type": "dark" - }, - { - "name": "Snazzy", - "background_color": "#242424", - "background_image": "None", - "cursor_color": "#97979b", - "foreground_color": "#eff0eb", - "palette": "#282a36:#ff5c57:#5af78e:#f3f99d:#57c7ff:#ff6ac1:#9aedfe:#f1f1f0:#686868:#ff5c57:#5af78e:#f3f99d:#57c7ff:#ff6ac1:#9aedfe:#eff0eb", - "type": "dark" - }, - { - "name": "SoftServer", - "palette": "#000000:#a2686a:#9aa56a:#a3906a:#6b8fa3:#6a71a3:#6ba58f:#99a3a2:#666c6c:#dd5c60:#bfdf55:#deb360:#62b1df:#606edf:#64e39c:#d2e0de", - "background_color": "#242626", - "cursor_color": "#d2e0de", - "foreground_color": "#99a3a2", - "background_image": "None", - "type": "dark" - }, - { - "name": "Solarized Darcula", - "palette": "#25292a:#f24840:#629655:#b68800:#2075c7:#797fd4:#15968d:#d2d8d9:#25292a:#f24840:#629655:#b68800:#2075c7:#797fd4:#15968d:#d2d8d9", - "background_color": "#3d3f41", - "cursor_color": "#708284", - "foreground_color": "#d2d8d9", - "background_image": "None", - "type": "dark" - }, - { - "name": "Solarized Dark", - "palette": "#002831:#d11c24:#738a05:#a57706:#2176c7:#c61c6f:#259286:#eae3cb:#001e27:#bd3613:#475b62:#536870:#708284:#5956ba:#819090:#fcf4dc", - "background_color": "#001e27", - "cursor_color": "#708284", - "foreground_color": "#708284", - "background_image": "None", - "type": "dark" - }, - { - "name": "Solarized Dark - Patched", - "palette": "#002831:#d11c24:#738a05:#a57706:#2176c7:#c61c6f:#259286:#eae3cb:#475b62:#bd3613:#475b62:#536870:#708284:#5956ba:#819090:#fcf4dc", - "background_color": "#001e27", - "cursor_color": "#708284", - "foreground_color": "#708284", - "background_image": "None", - "type": "dark" - }, - { - "name": "Solarized Dark Higher Contrast", - "palette": "#002831:#d11c24:#6cbe6c:#a57706:#2176c7:#c61c6f:#259286:#eae3cb:#006488:#f5163b:#51ef84:#b27e28:#178ec8:#e24d8e:#00b39e:#fcf4dc", - "background_color": "#001e27", - "cursor_color": "#f34b00", - "foreground_color": "#9cc2c3", - "background_image": "None", - "type": "dark" - }, - { - "name": "Solarized Light", - "palette": "#002831:#d11c24:#738a05:#a57706:#2176c7:#c61c6f:#259286:#eae3cb:#001e27:#bd3613:#475b62:#536870:#708284:#5956ba:#819090:#fcf4dc", - "background_color": "#fcf4dc", - "cursor_color": "#536870", - "foreground_color": "#536870", - "background_image": "None", - "type": "light" - }, - { - "name": "Spacedust", - "palette": "#6e5346:#e35b00:#5cab96:#e3cd7b:#0f548b:#e35b00:#06afc7:#f0f1ce:#684c31:#ff8a3a:#aecab8:#ffc878:#67a0ce:#ff8a3a:#83a7b4:#fefff1", - "background_color": "#0a1e24", - "cursor_color": "#708284", - "foreground_color": "#ecf0c1", - "background_image": "None", - "type": "dark" - }, - { - "name": "SpaceGray", - "palette": "#000000:#b04b57:#87b379:#e5c179:#7d8fa4:#a47996:#85a7a5:#b3b8c3:#000000:#b04b57:#87b379:#e5c179:#7d8fa4:#a47996:#85a7a5:#ffffff", - "background_color": "#20242d", - "cursor_color": "#b3b8c3", - "foreground_color": "#b3b8c3", - "background_image": "None", - "type": "dark" - }, - { - "name": "SpaceGray Eighties", - "palette": "#15171c:#ec5f67:#81a764:#fec254:#5486c0:#bf83c1:#57c2c1:#efece7:#555555:#ff6973:#93d493:#ffd256:#4d84d1:#ff55ff:#83e9e4:#ffffff", - "background_color": "#222222", - "cursor_color": "#bbbbbb", - "foreground_color": "#bdbaae", - "background_image": "None", - "type": "dark" - }, - { - "name": "SpaceGray Eighties Dull", - "palette": "#15171c:#b24a56:#92b477:#c6735a:#7c8fa5:#a5789e:#80cdcb:#b3b8c3:#555555:#ec5f67:#89e986:#fec254:#5486c0:#bf83c1:#58c2c1:#ffffff", - "background_color": "#222222", - "cursor_color": "#bbbbbb", - "foreground_color": "#c9c6bc", - "background_image": "None", - "type": "dark" - }, - { - "name": "Spiderman", - "palette": "#1b1d1e:#e60813:#e22928:#e24756:#2c3fff:#2435db:#3256ff:#fffef6:#505354:#ff0325:#ff3338:#fe3a35:#1d50ff:#747cff:#6184ff:#fffff9", - "background_color": "#1b1d1e", - "cursor_color": "#2c3fff", - "foreground_color": "#e3e3e3", - "background_image": "None", - "type": "dark" - }, - { - "name": "Spring", - "palette": "#000000:#ff4d83:#1f8c3b:#1fc95b:#1dd3ee:#8959a8:#3e999f:#ffffff:#000000:#ff0021:#1fc231:#d5b807:#15a9fd:#8959a8:#3e999f:#ffffff", - "background_color": "#ffffff", - "cursor_color": "#4d4d4c", - "foreground_color": "#4d4d4c", - "background_image": "None", - "type": "light" - }, - { - "name": "Square", - "palette": "#050505:#e9897c:#b6377d:#ecebbe:#a9cdeb:#75507b:#c9caec:#f2f2f2:#141414:#f99286:#c3f786:#fcfbcc:#b6defb:#ad7fa8:#d7d9fc:#e2e2e2", - "background_color": "#1a1a1a", - "cursor_color": "#fcfbcc", - "foreground_color": "#acacab", - "background_image": "None", - "type": "dark" - }, - { - "name": "Sundried", - "palette": "#302b2a:#a7463d:#587744:#9d602a:#485b98:#864651:#9c814f:#c9c9c9:#4d4e48:#aa000c:#128c21:#fc6a21:#7999f7:#fd8aa1:#fad484:#ffffff", - "background_color": "#1a1818", - "cursor_color": "#ffffff", - "foreground_color": "#c9c9c9", - "background_image": "None", - "type": "dark" - }, - { - "name": "Symfonic", - "palette": "#000000:#dc322f:#56db3a:#ff8400:#0084d4:#b729d9:#ccccff:#ffffff:#1b1d21:#dc322f:#56db3a:#ff8400:#0084d4:#b729d9:#ccccff:#ffffff", - "background_color": "#000000", - "cursor_color": "#dc322f", - "foreground_color": "#ffffff", - "background_image": "None", - "type": "dark" - }, - { - "name": "Teerb", - "palette": "#1c1c1c:#d68686:#aed686:#d7af87:#86aed6:#d6aed6:#8adbb4:#d0d0d0:#1c1c1c:#d68686:#aed686:#e4c9af:#86aed6:#d6aed6:#b1e7dd:#efefef", - "background_color": "#262626", - "cursor_color": "#e4c9af", - "foreground_color": "#d0d0d0", - "background_image": "None", - "type": "dark" - }, - { - "name": "Terminal Basic", - "palette": "#000000:#990000:#00a600:#999900:#0000b2:#b200b2:#00a6b2:#bfbfbf:#666666:#e50000:#00d900:#e5e500:#0000ff:#e500e5:#00e5e5:#e5e5e5", - "background_color": "#ffffff", - "cursor_color": "#7f7f7f", - "foreground_color": "#000000", - "background_image": "None", - "type": "light" - }, - { - "name": "Thayer Bright", - "palette": "#1b1d1e:#f92672:#4df840:#f4fd22:#2757d6:#8c54fe:#38c8b5:#ccccc6:#505354:#ff5995:#b6e354:#feed6c:#3f78ff:#9e6ffe:#23cfd5:#f8f8f2", - "background_color": "#1b1d1e", - "cursor_color": "#fc971f", - "foreground_color": "#f8f8f8", - "background_image": "None", - "type": "dark" - }, - { - "name": "The Hulk", - "palette": "#1b1d1e:#269d1b:#13ce30:#63e457:#2525f5:#641f74:#378ca9:#d9d8d1:#505354:#8dff2a:#48ff77:#3afe16:#506b95:#72589d:#4085a6:#e5e6e1", - "background_color": "#1b1d1e", - "cursor_color": "#16b61b", - "foreground_color": "#b5b5b5", - "background_image": "None", - "type": "dark" - }, - { - "name": "Tomorrow", - "palette": "#000000:#c82829:#718c00:#eab700:#4271ae:#8959a8:#3e999f:#ffffff:#000000:#c82829:#718c00:#eab700:#4271ae:#8959a8:#3e999f:#ffffff", - "background_color": "#ffffff", - "cursor_color": "#4d4d4c", - "foreground_color": "#4d4d4c", - "background_image": "None", - "type": "light" - }, - { - "name": "Tomorrow Night", - "palette": "#000000:#cc6666:#b5bd68:#f0c674:#81a2be:#b294bb:#8abeb7:#ffffff:#000000:#cc6666:#b5bd68:#f0c674:#81a2be:#b294bb:#8abeb7:#ffffff", - "background_color": "#1d1f21", - "cursor_color": "#c5c8c6", - "foreground_color": "#c5c8c6", - "background_image": "None", - "type": "dark" - }, - { - "name": "Tomorrow Night Blue", - "palette": "#000000:#ff9da4:#d1f1a9:#ffeead:#bbdaff:#ebbbff:#99ffff:#ffffff:#000000:#ff9da4:#d1f1a9:#ffeead:#bbdaff:#ebbbff:#99ffff:#ffffff", - "background_color": "#002451", - "cursor_color": "#ffffff", - "foreground_color": "#ffffff", - "background_image": "None", - "type": "dark" - }, - { - "name": "Tomorrow Night Bright", - "palette": "#000000:#d54e53:#b9ca4a:#e7c547:#7aa6da:#c397d8:#70c0b1:#ffffff:#000000:#d54e53:#b9ca4a:#e7c547:#7aa6da:#c397d8:#70c0b1:#ffffff", - "background_color": "#000000", - "cursor_color": "#eaeaea", - "foreground_color": "#eaeaea", - "background_image": "None", - "type": "dark" - }, - { - "name": "Tomorrow Night Eighties", - "palette": "#000000:#f2777a:#99cc99:#ffcc66:#6699cc:#cc99cc:#66cccc:#ffffff:#000000:#f2777a:#99cc99:#ffcc66:#6699cc:#cc99cc:#66cccc:#ffffff", - "background_color": "#2d2d2d", - "cursor_color": "#cccccc", - "foreground_color": "#cccccc", - "background_image": "None", - "type": "dark" - }, - { - "name": "ToyChest", - "palette": "#2c3f58:#be2d26:#1a9172:#db8e27:#325d96:#8a5edc:#35a08f:#23d183:#336889:#dd5944:#31d07b:#e7d84b:#34a6da:#ae6bdc:#42c3ae:#d5d5d5", - "background_color": "#24364b", - "cursor_color": "#d5d5d5", - "foreground_color": "#31d07b", - "background_image": "None", - "type": "dark" - }, - { - "name": "Treehouse", - "palette": "#321300:#b2270e:#44a900:#aa820c:#58859a:#97363d:#b25a1e:#786b53:#433626:#ed5d20:#55f238:#f2b732:#85cfed:#e14c5a:#f07d14:#ffc800", - "background_color": "#191919", - "cursor_color": "#fac814", - "foreground_color": "#786b53", - "background_image": "None", - "type": "dark" - }, - { - "name": "Twilight", - "palette": "#141414:#c06d44:#afb97a:#c2a86c:#44474a:#b4be7c:#778385:#ffffd4:#262626:#de7c4c:#ccd88c:#e2c47e:#5a5e62:#d0dc8e:#8a989b:#ffffd4", - "background_color": "#141414", - "cursor_color": "#ffffff", - "foreground_color": "#ffffd4", - "background_image": "None", - "type": "dark" - }, - { - "name": "Ubuntu", - "palette": "#2e3436:#cc0000:#4e9a06:#c4a000:#3465a4:#75507b:#06989a:#d3d7cf:#555753:#ef2929:#8ae234:#fce94f:#729fcf:#ad7fa8:#34e2e2:#eeeeec", - "background_color": "#300a24", - "cursor_color": "#bbbbbb", - "foreground_color": "#eeeeec", - "background_image": "None", - "type": "dark" - }, - { - "name": "UnderTheSea", - "palette": "#022026:#b2302d:#00a941:#59819c:#459a86:#00599d:#5d7e19:#405555:#384451:#ff4242:#2aea5e:#8ed4fd:#61d5ba:#1298ff:#98d028:#58fbd6", - "background_color": "#011116", - "cursor_color": "#4afcd6", - "foreground_color": "#ffffff", - "background_image": "None", - "type": "dark" - }, - { - "name": "Urple", - "palette": "#000000:#b0425b:#37a415:#ad5c42:#564d9b:#6c3ca1:#808080:#87799c:#5d3225:#ff6388:#29e620:#f08161:#867aed:#a05eee:#eaeaea:#bfa3ff", - "background_color": "#1b1b23", - "cursor_color": "#a063eb", - "foreground_color": "#877a9b", - "background_image": "None", - "type": "dark" - }, - { - "name": "Vag", - "background_color": "#191f1d", - "background_image": "None", - "cursor_color": "#e5f0fa", - "foreground_color": "#d9e6f2", - "palette": "#303030:#a87139:#39a871:#71a839:#7139a8:#a83971:#3971a8:#8a8a8a:#494949:#b0763b:#3bb076:#76b03b:#763bb0:#b03b76:#3b76b0:#cfcfcf", - "type": "dark" - }, - { - "name": "Vaughn", - "palette": "#25234f:#705050:#60b48a:#dfaf8f:#5555ff:#f08cc3:#8cd0d3:#709080:#709080:#dca3a3:#60b48a:#f0dfaf:#5555ff:#ec93d3:#93e0e3:#ffffff", - "background_color": "#25234f", - "cursor_color": "#ff5555", - "foreground_color": "#dcdccc", - "background_image": "None", - "type": "dark" - }, - { - "name": "Venom", - "background_color": "#060d14", - "cursor_color": "#9ecfa2", - "foreground_color": "#668198", - "palette": "#2e3436:#e94759:#9ecfa2:#f3efa9:#00898d:#9c21b0:#06989a:#d3d7cf:#555753:#ef2929:#8ae234:#fce94f:#729fcf:#ad7fa8:#34e2e2:#eeeeec", - "type": "dark" - }, - { - "name": "VibrantInk", - "palette": "#878787:#ff6600:#ccff04:#ffcc00:#44b4cc:#9933cc:#44b4cc:#f5f5f5:#555555:#ff0000:#00ff00:#ffff00:#0000ff:#ff00ff:#00ffff:#e5e5e5", - "background_color": "#000000", - "cursor_color": "#ffffff", - "foreground_color": "#ffffff", - "background_image": "None", - "type": "dark" - }, - { - "name": "Violet Dark", - "palette": "#56595c:#c94c22:#85981c:#b4881d:#2e8bce:#d13a82:#32a198:#c9c6bd:#45484b:#bd3613:#738a04:#a57705:#2176c7:#c61c6f:#259286:#c9c6bd", - "background_color": "#1c1d1f", - "cursor_color": "#708284", - "foreground_color": "#708284", - "background_image": "None", - "type": "dark" - }, - { - "name": "Violet Light", - "palette": "#56595c:#c94c22:#85981c:#b4881d:#2e8bce:#d13a82:#32a198:#d3d0c9:#45484b:#bd3613:#738a04:#a57705:#2176c7:#c61c6f:#259286:#c9c6bd", - "background_color": "#fcf4dc", - "cursor_color": "#536870", - "foreground_color": "#536870", - "background_image": "None", - "type": "light" - }, - { - "name": "WarmNeon", - "palette": "#000000:#e24346:#39b13a:#dae145:#4261c5:#f920fb:#2abbd4:#d0b8a3:#fefcfc:#e97071:#9cc090:#ddda7a:#7b91d6:#f674ba:#5ed1e5:#d8c8bb", - "background_color": "#404040", - "cursor_color": "#30ff24", - "foreground_color": "#afdab6", - "background_image": "None", - "type": "dark" - }, - { - "name": "Wez", - "palette": "#000000:#cc5555:#55cc55:#cdcd55:#5555cc:#cc55cc:#7acaca:#cccccc:#555555:#ff5555:#55ff55:#ffff55:#5555ff:#ff55ff:#55ffff:#ffffff", - "background_color": "#000000", - "cursor_color": "#53ae71", - "foreground_color": "#b3b3b3", - "background_image": "None", - "type": "dark" - }, - { - "name": "WildCherry", - "palette": "#000507:#d94085:#2ab250:#ffd16f:#883cdc:#ececec:#c1b8b7:#fff8de:#009cc9:#da6bac:#f4dca5:#eac066:#308cba:#ae636b:#ff919d:#e4838d", - "background_color": "#1f1726", - "cursor_color": "#dd00ff", - "foreground_color": "#dafaff", - "background_image": "None", - "type": "dark" - }, - { - "name": "Wombat", - "palette": "#000000:#ff615a:#b1e969:#ebd99c:#5da9f6:#e86aff:#82fff7:#dedacf:#313131:#f58c80:#ddf88f:#eee5b2:#a5c7ff:#ddaaff:#b7fff9:#ffffff", - "background_color": "#171717", - "cursor_color": "#bbbbbb", - "foreground_color": "#dedacf", - "background_image": "None", - "type": "dark" - }, - { - "name": "Wryan", - "palette": "#333333:#8c4665:#287373:#7c7c99:#395573:#5e468c:#31658c:#899ca1:#3d3d3d:#bf4d80:#53a6a6:#9e9ecb:#477ab3:#7e62b3:#6096bf:#c0c0c0", - "background_color": "#101010", - "cursor_color": "#9e9ecb", - "foreground_color": "#999993", - "background_image": "None", - "type": "dark" - }, - { - "name": "Zenburn", - "palette": "#4d4d4d:#705050:#60b48a:#f0dfaf:#506070:#dc8cc3:#8cd0d3:#dcdccc:#709080:#dca3a3:#c3bf9f:#e0cf9f:#94bff3:#ec93d3:#93e0e3:#ffffff", - "background_color": "#3f3f3f", - "cursor_color": "#73635a", - "foreground_color": "#dcdccc", - "background_image": "None", - "type": "dark" - } - ] -} \ No newline at end of file diff --git a/configs/shared/.emacs.d/wpc/terminator.el b/configs/shared/.emacs.d/wpc/terminator.el deleted file mode 100644 index 4794ce2d90..0000000000 --- a/configs/shared/.emacs.d/wpc/terminator.el +++ /dev/null @@ -1,94 +0,0 @@ -;;; terminator.el --- Experimenting with theming Terminator -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; I think most of this module is me getting carried away with the idea of -;; theming Terminator. Terminator themes are defined in a themes.json file. As -;; far as I know, Terminator does not support specifying these themes by name on -;; the command line, which would greatly simplify things. Terminator does -;; support passing a --profile flag, however, which can be used to specify the -;; themes. The idea, albeit quite awkward and over-engineered, was to create -;; these profile files on the fly and pass them to terminator. After around 45 -;; minutes of tinkering with this, the idea is starting to disenchant me. -;; -;; Alternative solutions include: -;; 1. Further investigating what other options Terminator supports. -;; 2. Using a different terminal emulator. -;; 3. Just right clicking Terminator and changing the themes manually. - -;;; Code: -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'prelude) -(require 'alist) -(require 'string) -(require 'json) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(cl-defstruct terminator/theme - foreground-color - background-color - cursor-color - palette) - -(defvar terminator/palettes - '((solarized-light . "#002831:#d11c24:#738a05:#a57706:#2176c7:#c61c6f:#259286:#eae3cb:#001e27:#bd3613:#475b62:#536870:#708284:#5956ba:#819090:#fcf4dc")) - "Mapping of theme names to the color palette that terminator expects.") - -(defconst terminator/profile-template "[global_config] - enabled_plugins = LaunchpadBugURLHandler, LaunchpadCodeURLHandler, APTURLHandler, TerminatorThemes -[keybindings] -[profiles] - [[default]] - background_color = \"%s\" - cursor_shape = ibeam - cursor_color = \"%s\" - font = Input Mono Medium 12 - foreground_color = \"%s\" - show_titlebar = False - scrollbar_position = hidden - palette = \"%s\" - use_system_font = False -[layouts] - [[default]] - [[[child1]]] - parent = window0 - type = Terminal - profile = Molokai - [[[window0]]] - parent = \"\" - type = Window -[plugins]" - "Template string of a terminator profile file.") - -(cl-defun terminator/render-profile (&key foreground-color - background-color - cursor-color - palette) - "Create a terminator profile with THEME as the palette." - (string/format terminator/profile-template - background-color - cursor-color - foreground-color - palette)) - -(defun terminator/as-heredoc (x) - "Return an EOF-terminator heredoc of X." - (string/format "<> 'solarized-light - terminator/render-profile - terminator/as-heredoc))) -(string/format terminator/profile-template - (alist/get 'solarized-light terminator/palettes)) - -(provide 'terminator) -;;; terminator.el ends here diff --git a/configs/shared/.emacs.d/wpc/themes.el b/configs/shared/.emacs.d/wpc/themes.el deleted file mode 100644 index ee81d3beed..0000000000 --- a/configs/shared/.emacs.d/wpc/themes.el +++ /dev/null @@ -1,204 +0,0 @@ -;;; themes.el --- Functions for working with my themes. -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: - - -;; Because I couldn't get cycle-themes to work, I'm writing my own version. -;; -;; Terminology: -;; - colorscheme: determines the colors used by syntax highlighting and other -;; Emacs UI elements. -;; - theme: Structural representation of a "theme" that includes colorscheme -;; (see above), font, wallpaper. "theme" is a superset of "colorscheme". -;; -;; Wishlist: -;; - TODO: Find a way to update the terminal (e.g. terminator) theme. -;; - TODO: Ensure terminal font is updated when Emacs font changes. -;; - TODO: Support a light theme. -;; - TODO: Support Rick & Morty theme. -;; - TODO: Support retro/arcade/80s theme. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'prelude) -(require 'alist) -(require 'symbol) -(require 'f) -(require 'wallpaper) -(require 'fonts) -(require 'cycle) -(require 'symbol) -(require 'random) -(require 'colorscheme) -(require 'dotted) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; The theme struct couples a font, a wallpaper, and a colorschemes. -(cl-defstruct theme - font - wallpaper - colorscheme) - -(defvar themes/current nil - "Store the name of the currently enabled theme.") - -(defconst themes/themes - (list (dotted/new - "Forest" - (make-theme - :font "Operator Mono Light" - :wallpaper "forest_8k.jpg" - :colorscheme 'doom-peacock)) - (dotted/new - "Geometry" - (make-theme - :font "Input Mono Medium" - :wallpaper "geometric_4k.jpg" - :colorscheme 'doom-molokai)) - (dotted/new - "Ice" - (make-theme - :font "Go Mono" - :wallpaper "construction_paper_iceberg_4k.jpg" - :colorscheme 'doom-dracula)) - (dotted/new - "Lego Manhattan" - (make-theme - :font "Input Mono Medium" - :wallpaper "lego_manhattan.jpg" - :colorscheme 'base16-atelier-sulphurpool)) - (dotted/new - "Shapely Patterns" - (make-theme - :font "Operator Mono Light" - :wallpaper "geometric_dark_4k.jpg" - :colorscheme 'doom-vibrant)) - ;; TODO: Support setting backgrounds as solid colors. - (dotted/new - "Gruvbox" - (make-theme - :font "JetBrainsMono" - :wallpaper "geometric_dark_4k.jpg" - :colorscheme 'doom-gruvbox)) - (dotted/new - "Solarized Light" - (make-theme - :font "JetBrainsMono" - :wallpaper "solarized_light_thinkpad.jpg" - :colorscheme 'doom-solarized-light)) - (dotted/new - "Lightness" - (make-theme - :font "Input Mono Medium" - :wallpaper "construction_paper_iceberg_4k.jpg" - :colorscheme 'doom-one-light)) - (dotted/new - "Edison Lightbulb" - (make-theme - :font "Mononoki Medium" - :wallpaper "lightbulb_4k.jpg" - :colorscheme 'base16-atelier-cave)) - (dotted/new - "Wall-E" - (make-theme - :font "Input Mono Medium" - :wallpaper "walle_4k.jpg" - :colorscheme 'doom-material)) - (dotted/new - "Galaxy" - (make-theme - :font "Source Code Pro" - :wallpaper "galaxy_4k.jpg" - :colorscheme 'doom-moonlight)) - (dotted/new - "Underwater" - (make-theme - :font "Go Mono" - ;; TODO: Change this wallpaper to an oceanic scene. - :wallpaper "galaxy_4k.jpg" - :colorscheme 'doom-solarized-dark)) - (dotted/new - "Fantasy Tree" - (make-theme - :font "Go Mono" - :wallpaper "fantasy_tree_4k.jpg" - :colorscheme 'doom-outrun-electric))) - "Predefined themes to suit my whims.") - -;; TODO: Choose between plural and singular names for Elisp modules. For -;; example, why have themes.el and colorscheme.el. I think singular is -;; preferable. -;; TODO: Decide between "message", "show", "print", "inspect" for naming -;; commands that output human-readable information to the "*Messages*" buffer. -;; TODO: Is there a idiomatic CL/Elisp way to print struct information? -(defun themes/print (name) - "Print a human-readable description of theme named NAME." - (let* ((theme (alist/get name themes/themes)) - (f (theme-font theme)) - (w (theme-wallpaper theme)) - (c (theme-colorscheme theme))) - (message (string/format - "[themes] Name: %s. Font: %s. Wallpaper: %s. Colorscheme: %s" - name f w c)))) - -;; TODO: Make this into a proper test. -(defun themes/debug () - "Print a human-readable description of theme named NAME." - (interactive) - (let ((theme (alist/get themes/current themes/themes))) - (prelude/assert (equal (theme-font theme) - (fonts/current))) - (prelude/assert (equal (theme-wallpaper theme) - (f-filename (wallpaper/current)))) - (prelude/assert (equal (theme-colorscheme theme) - (colorscheme/current))) - (message "[themes] Debug couldn't find any inconsistencies. All good!"))) - -;; TODO: Assert that all of the dependencies exist before attempting to load -;; theme. -;; TODO: Provide a friendlier way to define themes. -(defun themes/ivy-select () - "Use ivy to interactively load a theme." - (interactive) - (let* ((name (ivy-read "Theme: " (alist/keys themes/themes)))) - (message (string/format "name: %s" name)) - (themes/set name))) - -(defun themes/load (theme) - "Load the struct, THEME." - (colorscheme/disable-all) - (let* ((font (theme-font theme)) - (wallpaper (theme-wallpaper theme)) - (colorscheme (theme-colorscheme theme))) - (fonts/whitelist-set font) - (wallpaper/whitelist-set (f-join wallpaper/path-to-dir wallpaper)) - (colorscheme/whitelist-set colorscheme))) - -(defun themes/set (name) - "Set the currently enabled theme to the theme named NAME. -NAME needs to a key defined in `themes/themes'." - (prelude/assert (alist/has-key? name themes/themes)) - (themes/load (alist/get name themes/themes)) - (setq themes/current name)) - -(defun themes/print-current () - "Print the currently enabled theme." - (interactive) - (themes/print themes/current)) - -(defun themes/random () - "Return the name of a randomly selected theme in `themes/themes'." - (->> themes/themes - alist/keys - random/choice)) - -(provide 'themes) -;;; themes.el ends here diff --git a/configs/shared/.emacs.d/wpc/todo.el b/configs/shared/.emacs.d/wpc/todo.el deleted file mode 100644 index 236912c086..0000000000 --- a/configs/shared/.emacs.d/wpc/todo.el +++ /dev/null @@ -1,293 +0,0 @@ -;;; todo.el --- Bespoke task management system -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Marriage of my personal task-management system, which I've been using for 18 -;; months and is a mixture of handwritten notes, iOS notes, and org-mode files, -;; with Emacs's famous `org-mode'. -;; -;; For me, I'd like a live, reactive state management system. I'd like -;; `org-mode' to be a nice way of rendering my TODOs, but I think the -;; relationship with `org-mode' ends there. -;; -;; Intended to supplement my org-mode workflow. -;; -;; Wish-list: -;; - Daily emails for standups -;; - Templates for commonly occurring tasks - -;; Dependencies -(require 'dash) -(require 'f) -(require 'macros) - -;;; Code: - -;; TODO: Classify habits as 'daily, 'weekly, 'monthly, 'yearly, 'event-driven - -;; TODO: Consider serving these values up to a React webpage in Chrome. - -;; TODO: Classify meetings as either 'recurrent or 'ad-hoc. - -;; TODO: Support sorting by `type'. - -;; TODO: Support work-queue idea for "Tomorrow's todos." - -;; TODO: Support macro to generate all possible predicates for todo types. - -;; TODO: Support export to org-mode file - -;; TODO: Support generic way to quickly render a list - -(defcustom todo/install-kbds? t - "When t, install the keybindings.") - -;; TODO: Add documentation. -(cl-defstruct todo type label) - -;; TODO: Consider keeping this in Dropbox. -;; TODO: Support whether or not the todo is done. -(defconst todo/org-file-path "~/Dropbox/org/today.org") - -;; TODO: Support remaining function for each type. -;; TODO: Support completed function for each type. - -(defun todo/completed? (x) - "Return t is `X' is marked complete." - (todo-complete x)) - -;; TODO: Prefer `new-{task,habit,meeting}'. - -(defun todo/completed (xs) - "Return the todo items in `XS' that are marked complete." - (->> xs - (-filter #'todo/completed?))) - -(defun todo/remaining (xs) - "Return the todo items in `XS' that are not marked complete." - (->> xs - (-reject #'todo/completed?))) - -(defun todo/task (label) - "Convenience function for creating a task todo with `LABEL'." - (make-todo - :type 'task - :label label)) - -(defun todo/meeting (label) - "Convenience function for creating a meeting todo with `LABEL'." - (make-todo - :type 'meeting - :label label)) - -(defun todo/habit (label) - "Convenience function for creating a habit todo with `LABEL'." - (make-todo - :type 'habit - :label label)) - -(defun todo/task? (x) - "Return t if `X' is a task." - (equal 'task (todo-type x))) - -(defun todo/habit? (x) - "Return t if `X' is a habit." - (equal 'habit (todo-type x))) - -(defun todo/meeting? (x) - "Return t if `X' is a meeting." - (equal 'meeting (todo-type x))) - -(defun todo/label (x) - "Return the label of `X'." - (todo-label x)) - -;; TODO: Support moving todos between todo/{today,tomorrow}. -;; TODO: Consider modelling todo/{today,tomorrow} as queues instead of lists so that I can -;; append cheaply. - -;; TODO: Find an Elisp date library. - -;; TODO: type-driven development of this habit tree. -;; TODO: Create this tree on a whiteboard first. -;; (defconst todo/habits -;; '(:beginning-of-month -;; '("Create habit template for current month" -;; "Post mortem of previous month") -;; :monday '("Jiu Jitsu") -;; :tuesday '("Jiu Jitsu") -;; :wednesday '("Jiu Jitsu") -;; :thursday '("Salsa class") -;; :friday '("Jiu Jitsu") -;; :saturday '("Borough market") -;; :sunday '("Shave") -;; :weekday '(:arrive-at-work -;; '("Breakfast" -;; "Coffee" -;; "Placeholder") -;; :before-lunch -;; '("Lock laptop" -;; "Placeholder") -;; :home->work -;; '("Michel Thomas Italian lessons")) -;; :daily '(:morning -;; '("Meditate" -;; "Stretch") -;; :))) - -;; overlay weekday with specific weekdays (e.g. BJJ is only on M,T,W) - -;; TODO: Extend the record type to support duration estimations for AFK, K -;; calculations. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Habits -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO: Should I be writing this in ReasonML and Haskell? - -(defconst todo/monthly-habit-challenge - "InterviewCake.com" - "The monthly habit challenge I do for fifteen minutes each day.") - -(defconst todo/daily-habits - (->> (list "Meditate" - todo/monthly-habit-challenge) - (-map #'todo/habit))) - -(defconst todo/first-of-the-month-stack - '("Create habit template for current month" - "Reserve two dinners in London for dates" - "Post mortem of previous month" - "Create monthly financial budget in Google Sheets") - "A stack of habits that I do at the beginning of each month.") - -(defconst todo/adhoc-habits - (->> (list/concat - todo/first-of-the-month-stack) - (-map #'todo/habit)) - "Habits that I have no classification for at the moment.") - -;; TODO: Model this as a function. -(defconst todo/habits - (list/concat todo/daily-habits - todo/adhoc-habits) - "My habits for today.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Meetings -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO: Define "meeting". - -(defconst todo/daily-meetings - (->> '("Standup" - "Lunch") - (-map #'todo/meeting)) - "Daily, recurrent meetings.") - - -(defconst todo/day-of-week-meetings - '(:Monday '("Lunch") - :Tuesday '("Lunch") - :Wednesday '("Team Lunch") - :Thursday '("Lunch") - :Friday '("Lunch") - :Satuday '() - :Sunday '()) - "Meetings that occur depending on the current day of the week.") - -(parse-time-string "today") - -;; TODO: Support recurrent, non-daily meetings. - -(defconst todo/adhoc-meetings - (->> '("WSE Weekly Standup" - "Team Lunch" - "Karisa Explains It All") - (-map #'todo/meeting)) - "Non-recurrent meetings.") - -(defconst todo/meetings - (list/concat todo/daily-meetings - todo/adhoc-meetings) - "My meetings for today.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Tasks -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst todo/tasks - (->> '("GetEmailCase" - "Async node workflow" - "Support C-c in EXWM" - "Post-its for bathroom mirror" - "Visit AtomicHabit.com/scorecard" - "Visit AtomicHabit.com/habitstacking" - "Create GraphViz for Carpe Diem cirriculum" - "Create CitC client for local browsing of CE codebase" - "Respond to SRE emails") - (-map #'todo/task))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Work queues (today, tomorrow, someday) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO: Generate standup documents from DONE items in the state. - -;; TODO: Learn how to create a gen-server style of live, reactive state. -;; TODO: This should probably be `defconst' and a reference to the live state. -(defconst todo/today - (list/concat - todo/habits - todo/meetings - todo/tasks)) - -(defconst todo/tomorrow - '()) - -(defconst todo/someday - '()) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; View functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun todo/to-org (xs) - "Map `XS' into a string with `org-mode' syntax." - ;; TODO: Create function to DRY this code up. - (let ((meetings (->> xs - (-filter #'todo/meeting?) - (-map (lambda (x) - (s-concat "** TODO " (todo/label x)))) - (s-join "\n"))) - (tasks (->> xs - (-filter #'todo/task?) - (-map (lambda (x) - (s-concat "** TODO " (todo/label x)))) - (s-join "\n"))) - (habits (->> xs - (-filter #'todo/habit?) - (-map (lambda (x) - (s-concat "** TODO " (todo/label x)))) - (s-join "\n")))) - (s-join "\n" (list - (s-concat "* Meetings\n" meetings) - (s-concat "* Tasks\n" tasks) - (s-concat "* Habits\n" habits))))) - -(defun todo/export-to-org (xs) - "Export `XS' to `todo/org-file-path'." - (f-write-text (->> xs - todo/to-org) - 'utf-8 - todo/org-file-path)) - -(defun todo/orgify-today () - "Exports today's todos to an org file." - (interactive) - (todo/export-to-org todo/today) - (alert (string/concat "Exported today's TODOs to: " todo/org-file-path))) - -(provide 'todo) -;;; todo.el ends here diff --git a/configs/shared/.emacs.d/wpc/tree.el b/configs/shared/.emacs.d/wpc/tree.el deleted file mode 100644 index 43df4dc500..0000000000 --- a/configs/shared/.emacs.d/wpc/tree.el +++ /dev/null @@ -1,193 +0,0 @@ -;;; tree.el --- Working with Trees -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Some friendly functions that hopefully will make working with trees cheaper -;; and therefore more appealing! -;; -;; Tree terminology: -;; - leaf: node with zero children. -;; - root: node with zero parents. -;; - depth: measures a node's distance from the root node. This implies the -;; root node has a depth of zero. -;; - height: measures the longest traversal from a node to a leaf. This implies -;; that a leaf node has a height of zero. -;; - balanced? -;; -;; Tree variants: -;; - binary: the maximum number of children is two. -;; - binary search: the maximum number of children is two and left sub-trees are -;; lower in value than right sub-trees. -;; - rose: the number of children is variable. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'prelude) -(require 'list) -(require 'set) -(require 'tuple) -(require 'series) -(require 'random) -(require 'maybe) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(cl-defstruct tree xs) - -(cl-defstruct node value children) - -(cl-defun tree/node (value &optional children) - "Create a node struct of VALUE with CHILDREN." - (make-node :value value - :children children)) - -(defun tree/reduce-breadth (acc f xs) - "Reduce over XS breadth-first applying F to each x and ACC (in that order). -Breadth-first traversals guarantee to find the shortest path in a graph. - They're typically more difficult to implement than DFTs and may also incur - higher memory costs on average than their depth-first counterparts.") - -;; TODO: Support :order as 'pre | 'in | 'post. -;; TODO: Troubleshoot why I need defensive (nil? node) check. -(defun tree/reduce-depth (acc f node) - "Reduce over NODE depth-first applying F to each NODE and ACC. -F is called with each NODE, ACC, and the current depth. -Depth-first traversals have the advantage of typically consuming less memory - than their breadth-first equivalents would have. They're also typically - easier to implement using recursion. This comes at the cost of not - guaranteeing to be able to find the shortest path in a graph." - (cl-labels ((do-reduce-depth - (acc f node depth) - (let ((acc-new (funcall f node acc depth))) - (if (or (maybe/nil? node) - (tree/leaf? node)) - acc-new - (list/reduce - acc-new - (lambda (node acc) - (tree/do-reduce-depth - acc - f - node - (number/inc depth))) - (node-children node)))))) - (do-reduce-depth acc f node 0))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Helpers -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun tree/height (xs) - "Return the height of tree XS.") - -;; TODO: Troubleshoot why need for (nil? node). Similar misgiving -;; above. -(defun tree/leaf-depths (xs) - "Return a list of all of the depths of the leaf nodes in XS." - (list/reverse - (tree/reduce-depth - '() - (lambda (node acc depth) - (if (or (maybe/nil? node) - (tree/leaf? node)) - (list/cons depth acc) - acc)) - xs))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Generators -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO: Consider parameterizing height, forced min-max branching, random -;; distributions, etc. - -;; TODO: Bail out before stack overflowing by consider branching, current-depth. - -(cl-defun tree/random (&optional (value-fn (lambda (_) nil)) - (branching-factor 2)) - "Randomly generate a tree with BRANCHING-FACTOR using VALUE-FN to compute the -node values. VALUE-FN is called with the current-depth of the node. Useful for -generating test data. Warning this function can overflow the stack." - (cl-labels ((do-random - (d vf bf) - (make-node - :value (funcall vf d) - :children (->> (series/range 0 (number/dec bf)) - (list/map - (lambda (_) - (when (random/boolean?) - (do-random d vf bf)))))))) - (do-random 0 value-fn branching-factor))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Predicates -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun tree/instance? (tree) - "Return t if TREE is a tree struct." - (node-p tree)) - -(defun tree/leaf? (node) - "Return t if NODE has no children." - (maybe/nil? (node-children node))) - -(defun tree/balanced? (n xs) - "Return t if the tree, XS, is balanced. -A tree is balanced if none of the differences between any two depths of two leaf - nodes in XS is greater than N." - (> n (->> xs - tree/leaf-depths - set/from-list - set/count - number/dec))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Tests -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst tree/enable-testing? t - "When t, test suite runs.") - -;; TODO: Create set of macros for a proper test suite including: -;; - describe (arbitrarily nestable) -;; - it (arbitrarily nestable) -;; - line numbers for errors -;; - accumulated output for synopsis -;; - do we want describe *and* it? Why not a generic label that works for both? -(when tree/enable-testing? - (let ((tree-a (tree/node 1 - (list (tree/node 2 - (list (tree/node 5) - (tree/node 6))) - (tree/node 3 - (list (tree/node 7) - (tree/node 8))) - (tree/node 4 - (list (tree/node 9) - (tree/node 10)))))) - (tree-b (tree/node 1 - (list (tree/node 2 - (list (tree/node 5) - (tree/node 6))) - (tree/node 3) - (tree/node 4 - (list (tree/node 9) - (tree/node 10))))))) - ;; instance? - (prelude/assert (tree/instance? tree-a)) - (prelude/assert (tree/instance? tree-b)) - (prelude/refute (tree/instance? '(1 2 3))) - (prelude/refute (tree/instance? "oak")) - ;; balanced? - (prelude/assert (tree/balanced? 1 tree-a)) - (prelude/refute (tree/balanced? 1 tree-b)) - (message "Tests pass!"))) - -(provide 'tree) -;;; tree.el ends here diff --git a/configs/shared/.emacs.d/wpc/tuple.el b/configs/shared/.emacs.d/wpc/tuple.el deleted file mode 100644 index ccebf7299a..0000000000 --- a/configs/shared/.emacs.d/wpc/tuple.el +++ /dev/null @@ -1,86 +0,0 @@ -;;; tuple.el --- Tuple API for Elisp -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Work with cons cells with two elements with a familiar API for those who have -;; worked with tuples before. - -;;; Code: - -(cl-defstruct tuple first second) - -;; Create -(defun tuple/new () - "Return an empty tuple." - (make-tuple :first nil - :second nil)) - -(defun tuple/from (a b) - "Return a new tuple from A and B." - (make-tuple :first a - :second b)) - -(defun tuple/from-dotted (dp) - "Convert dotted pair, DP, into a tuple." - (tuple/from (car dp) (cdr dp))) - -;; Read -(defun tuple/first (pair) - "Return the first element of PAIR." - (tuple-first pair)) - -(defun tuple/second (pair) - "Return the second element of PAIR." - (tuple-second pair)) - -;; Update -(defun tuple/map-each (f g pair) - "Apply F to first, G to second in PAIR." - (->> pair - (tuple/map-first f) - (tuple/map-second g))) - -(defun tuple/map (f pair) - "Apply F to PAIR." - (let ((pair-copy (copy-tuple pair))) - (funcall f pair-copy))) - -(defun tuple/map-first (f pair) - "Apply function F to the first element of PAIR." - (let ((pair-copy (copy-tuple pair))) - (setf (tuple-first pair-copy) (funcall f (tuple/first pair-copy))) - pair-copy)) - -(defun tuple/map-second (f pair) - "Apply function F to the second element of PAIR." - (let ((pair-copy (copy-tuple pair))) - (setf (tuple-second pair-copy) (funcall f (tuple/second pair-copy))) - pair-copy)) - -(defun tuple/set-first (a pair) - "Return a new tuple with the first element set as A in PAIR." - (tuple/map-first (lambda (_) a) pair)) - -(defun tuple/set-second (b pair) - "Return a new tuple with the second element set as B in PAIR." - (tuple/map-second (lambda (_) b) pair)) - -;; Delete -(defun tuple/delete-first (pair) - "Return PAIR with the first element set to nil." - (tuple/set-first nil pair)) - -(defun tuple/delete-second (pair) - "Return PAIR with the second element set to nil." - (tuple/set-second nil pair)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Predicates -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun tuple/instance? (x) - "Return t if X is a tuple." - (tuple-p x)) - -(provide 'tuple) -;;; tuple.el ends here diff --git a/configs/shared/.emacs.d/wpc/vector.el b/configs/shared/.emacs.d/wpc/vector.el deleted file mode 100644 index 6d2fe20d12..0000000000 --- a/configs/shared/.emacs.d/wpc/vector.el +++ /dev/null @@ -1,81 +0,0 @@ -;;; vector.el --- Working with Elisp's Vector data type -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; It might be best to think of Elisp vectors as tuples in languages like -;; Haskell or Erlang. -;; -;; Not surprisingly, this API is modelled after Elixir's Tuple API. -;; -;; Some Elisp trivia: -;; - "Array": Usually means vector or string. -;; - "Sequence": Usually means list or "array" (see above). -;; -;; It might be a good idea to think of Array and Sequence as typeclasses in -;; Elisp. This is perhaps more similar to Elixir's notion of the Enum protocol. -;; -;; Intentionally not supporting a to-list function, because tuples can contain -;; heterogenous types whereas lists should contain homogenous types. - -;;; Code: - -;; TODO: Consider supporting an alias named tuple for vector. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst vector/enable-tests? t - "When t, run the tests defined herein.") - -;; TODO: Consider labelling variadic functions like `vector/concat*' -;; vs. `vector/concat'. -(defun vector/concat (&rest args) - "Return a new vector composed of all vectors in `ARGS'." - (apply #'vconcat args)) - -;; TODO: Here's a sketch of a protocol macro being consumed. -;; (definstance monoid vector -;; :empty (lambda () [])) - -(defun vector/prepend (x xs) - "Add `X' to the beginning of `XS'." - (vector/concat `[,x] xs)) - -(defun vector/append (x xs) - "Add `X' to the end of `XS'." - (vector/concat xs `[,x])) - -(defun vector/get (i xs) - "Return the value in `XS' at index, `I'." - (aref xs i)) - -(defun vector/set (i v xs) - "Set index `I' to value `V' in `XS'. -Returns a copy of `XS' with the updates." - (let ((copy (vconcat [] xs))) - (aset copy i v) - copy)) - -(defun vector/set! (i v xs) - "Set index `I' to value `V' in `XS'. -This function mutates XS." - (aset xs i v)) - -(when vector/enable-tests? - (let ((xs [1 2 3]) - (ys [1 2 3])) - (prelude/assert (= 1 (vector/get 0 ys))) - (vector/set 0 4 ys) - (prelude/assert (= 1 (vector/get 0 ys))) - (prelude/assert (= 1 (vector/get 0 xs))) - (vector/set! 0 4 xs) - (prelude/assert (= 4 (vector/get 0 xs))))) - -;; TODO: Decide between "remove" and "delete" as the appropriate verbs. -;; TODO: Implement this. -;; (defun vector/delete (i xs) -;; "Remove the element at `I' in `XS'.") - -(provide 'vector) -;;; vector.el ends here diff --git a/configs/shared/.emacs.d/wpc/wallpaper.el b/configs/shared/.emacs.d/wpc/wallpaper.el deleted file mode 100644 index 9aa41cd364..0000000000 --- a/configs/shared/.emacs.d/wpc/wallpaper.el +++ /dev/null @@ -1,92 +0,0 @@ -;;; wallpaper.el --- Control Linux desktop wallpaper -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Functions for setting desktop wallpaper. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'prelude) -(require 'fs) -(require 'cycle) -(require 'string) -(require 'general) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defcustom wallpaper/keybindings? t - "If non-nil, install the keybindings.") - -(defcustom wallpaper/path-to-dir - (f-expand "~/.local/share/wallpaper") - "Path to the images that will be used as the wallpaper.") - -(defconst wallpaper/whitelist - (cycle/from-list - (fs/ls wallpaper/path-to-dir t)) - "My preferred computer wallpapers.") - -(defun wallpaper/set (path) - "Set computer wallpaper to image at `PATH' using `feh` under-the-hood. -`PATH' can be absolute or relative since `f-expand' is called in the function - body to ensure feh can resolve the path." - (prelude/start-process - :name "wallpaper/set" - :command (string/format "feh --bg-scale --no-feh-bg %s" (f-expand path)))) - -(defun wallpaper/whitelist-set (wallpaper) - "Focuses the WALLPAPER in the `wallpaper/whitelist' cycle." - (cycle/focus (lambda (x) (equal x wallpaper)) wallpaper/whitelist) - (wallpaper/set (wallpaper/current))) - -(defun wallpaper/next () - "Cycles to the next wallpaper." - (interactive) - (let ((wallpaper (cycle/next wallpaper/whitelist))) - (wallpaper/set wallpaper) - (message (string/format "Active wallpaper: %s" (f-filename wallpaper))))) - -(defun wallpaper/prev () - "Cycles to the previous wallpaper." - (interactive) - (let ((wallpaper (cycle/prev wallpaper/whitelist))) - (wallpaper/set wallpaper) - (message (string/format "Active wallpaper: %s" (f-filename wallpaper))))) - -;; TODO: Define a macro that handles, next, prev, select, current for working -;; with cycles, since this is a common pattern. - -(defun wallpaper/print-current () - "Message the currently enabled wallpaper." - (interactive) - (message - (cycle/current wallpaper/whitelist))) - -(defun wallpaper/current () - "Return the currently enabled wallpaper." - (cycle/current wallpaper/whitelist)) - -(defun wallpaper/ivy-select () - "Use `counsel' to select and set a wallpaper from the `wallpaper/whitelist'." - (interactive) - (wallpaper/whitelist-set - (ivy-read "Select wallpaper: " (cycle/to-list wallpaper/whitelist)))) - -;; TODO: Create macro-based module system that will auto-namespace functions, -;; constants, etc. with the filename like `wallpaper'. - -(when wallpaper/keybindings? - (general-define-key - :prefix "" - :states '(normal) - "Fw" #'wallpaper/next - "Pw" #'wallpaper/prev)) - -(provide 'wallpaper) -;;; wallpaper.el ends here diff --git a/configs/shared/.emacs.d/wpc/window-manager.el b/configs/shared/.emacs.d/wpc/window-manager.el deleted file mode 100644 index cf7f1efeb7..0000000000 --- a/configs/shared/.emacs.d/wpc/window-manager.el +++ /dev/null @@ -1,647 +0,0 @@ -;;; window-manager.el --- Functions augmenting my usage of EXWM. -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; I switched to EXWM from i3, and I haven't looked back. One day I may write a -;; poem declaring my love for Emacs and EXWM. For now, I haven't the time. - -;; Wish list: -;; - TODO: Support different startup commands and layouts depending on laptop or -;; desktop. -;; - TODO: Support a Music named-workspace. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'alert) -(require 'prelude) -(require 'string) -(require 'cycle) -(require 'set) -(require 'kbd) -(require 'ivy-helpers) -(require 'display) -(require 'dotfiles) -(require 'org-helpers) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO: Move this function to another module. -(defun pkill (name) - "Call the pkill executable using NAME as its argument." - (interactive "sProcess name: ") - (call-process "pkill" nil nil nil name)) - -;; TODO: Associate `window-purpose' window-layouts with each of these named -;; workspaces. - -;; TODO: Associate KBDs for each of these named-layouts. - -;; TODO: Decide between window-manager, exwm, or some other namespace. - -;; TODO: Support (cycle/from-list '(current previous)) to toggle back and forth -;; between most recent workspace. - -;; TODO: Support ad hoc cycle for loading a few workspaces that can be cycled -;; between. (cycle/from-list '("Project" "Workspace")) - -;; TODO: Consider supporting a workspace for Racket, Clojure, Common Lisp, -;; Haskell, Elixir, and a few other languages. These could behave very similarly -;; to repl.it, which I've wanted to have locally for awhile now. - -;; TODO: Support MRU cache of workspaces for easily switching back-and-forth -;; between workspaces. - -(cl-defstruct exwm/named-workspace - label - index - kbd) - -(defconst exwm/install-workspace-kbds? t - "When t, install the keybindings to switch between named-workspaces.") - -;; TODO: Consume `cache/touch' after changing workspaces. Use this to enable -;; cycling through workspaces. - -(defconst exwm/named-workspaces - (list (make-exwm/named-workspace - :label "Web surfing" - :index 0 - :kbd "c") - (make-exwm/named-workspace - :label "Project" - :index 1 - :kbd "p") - (make-exwm/named-workspace - :label "Dotfiles" - :index 2 - :kbd "d") - (make-exwm/named-workspace - :label "Scratch" - :index 3 - :kbd "s") - (make-exwm/named-workspace - :label "Terminal" - :index 4 - :kbd "t") - (make-exwm/named-workspace - :label "Todos" - :index 5 - :kbd "o") - (make-exwm/named-workspace - :label "Chatter" - :index 6 - :kbd "h") - (make-exwm/named-workspace - :label "IRC" - :index 7 - :kbd "i") - (make-exwm/named-workspace - :label "Work" - :index 8 - :kbd "w")) - "List of `exwm/named-workspace' structs.") - -;; Assert that no two workspaces share KBDs. -(prelude/assert (= (list/length exwm/named-workspaces) - (->> exwm/named-workspaces - (list/map #'exwm/named-workspace-kbd) - set/from-list - set/count))) - -(defun window-manager/alert (x) - "Message X with a structured format." - (alert (string/concat "[exwm] " x))) - -;; Use Emacs as my primary window manager. -(use-package exwm - :config - (require 'exwm-config) - - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; Multiple Displays - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (require 'exwm-randr) - (exwm-randr-enable) - ;; TODO: Consider generating this plist. - ;; TODO: Replace integer index values with their named workspace equivalents. - (setq exwm-randr-workspace-monitor-plist - (list 0 display/4k-monitor - 1 display/laptop-monitor)) - - (evil-set-initial-state 'exwm-mode 'emacs) - (ido-mode 1) - (exwm-config-ido) - (setq exwm-workspace-number - (list/length exwm/named-workspaces)) - ;; EXWM supports "line-mode" and "char-mode". - ;; - ;; Note: It appears that calling `exwm-input-set-key' works if it's called - ;; during startup. Once a session has started, it seems like this function is - ;; significantly less useful. Is this a bug? - ;; - ;; Glossary: - ;; - char-mode: All keystrokes except `exwm' global ones are passed to the - ;; application. - ;; - line-mode: - ;; - ;; `exwm-input-global-keys' = {line,char}-mode; can also call `exwm-input-set-key' - ;; `exwm-mode-map' = line-mode - ;; `???' = char-mode. Is there a mode-map for this? - ;; - ;; TODO: What is `exwm-input-prefix-keys'? - ;; TODO: Once I get `exwm-input-global-keys' functions, drop support for - ;; `wpc/kbds'. - (let ((kbds `( - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; Window sizing - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - (:key "C-M-=" :fn balance-windows) - ;; TODO: Make sure these don't interfere with LISP KBDs. - (:key "C-M-j" :fn shrink-window) - (:key "C-M-k" :fn enlarge-window) - (:key "C-M-h" :fn shrink-window-horizontally) - (:key "C-M-l" :fn enlarge-window-horizontally) - - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; Window traversing - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - (:key "M-h" :fn windmove-left) - (:key "M-j" :fn windmove-down) - (:key "M-k" :fn windmove-up) - (:key "M-l" :fn windmove-right) - - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; Window splitting - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - (:key "M-\\" :fn evil-window-vsplit) - (:key "M--" :fn evil-window-split) - - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; Window deletion - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - (:key "M-q" :fn delete-window) - - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; Miscellaneous - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - (:key "M-:" :fn eval-expression) - (:key "M-SPC" :fn window-manager/apps) - (:key "M-x" :fn counsel-M-x) - (:key "" :fn exwm/next-workspace) - (:key "" :fn exwm/prev-workspace) - (:key "" :fn exwm/prev-workspace) - ;; doesn't work in X11 windows. - (:key "" :fn exwm/ivy-switch) - (:key "C-M-\\" :fn ivy-pass) - - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; REPLs - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - (:key ,(kbd/raw 'x11 "r") :fn exwm/ivy-find-or-create-repl) - - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; Workspaces - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - ;; NOTE: Here I need to generate lowercase and uppercase - ;; variants of each because my Ergodox is sending capitalized - ;; variants of the keycodes to EXWM. - (:key ,(kbd/raw 'workspace "l") :fn window-manager/logout) - (:key ,(kbd/raw 'workspace "L") :fn window-manager/logout) - (:key ,(kbd/raw 'workspace "i") :fn exwm/toggle-mode) - (:key ,(kbd/raw 'workspace "I") :fn exwm/toggle-mode)))) - (setq exwm-input-global-keys - (->> kbds - (-map (lambda (plist) - `(,(kbd (plist-get plist :key)) . ,(plist-get plist :fn))))))) - (setq exwm-input-simulation-keys - ;; TODO: Consider supporting M-d and other readline style KBDs. - '(([?\C-b] . [left]) - ([?\M-b] . [C-left]) - ([?\C-f] . [right]) - ([?\M-f] . [C-right]) - ([?\C-p] . [up]) - ([?\C-n] . [down]) - ([?\C-a] . [home]) - ([?\C-e] . [end]) - ([?\C-d] . [delete]) - ;; TODO: Assess whether or not this is a good idea. - ;; TODO: Ensure C-c copies. - ([?\C-c] . [C-c]))) - (exwm-enable)) - -;; TODO: Package workspace management in another module. - -;; Here is the code required to allow EXWM to cycle workspaces. -(defconst exwm/workspaces - (->> exwm/named-workspaces - cycle/from-list) - "Cycle of the my EXWM workspaces.") - -(prelude/assert - (= exwm-workspace-number - (list/length exwm/named-workspaces))) - -(defun exwm/next-workspace () - "Cycle forwards to the next workspace." - (interactive) - (exwm/change-workspace (cycle/next exwm/workspaces))) - -(defun exwm/prev-workspace () - "Cycle backwards to the previous workspace." - (interactive) - (exwm/change-workspace (cycle/prev exwm/workspaces))) - -;; TODO: Create friendlier API for working with EXWM. - -;; Here is the code required to toggle EXWM's modes. -(defun exwm/line-mode () - "Switch exwm to line-mode." - (call-interactively #'exwm-input-grab-keyboard) - (window-manager/alert "Switched to line-mode")) - -(defun exwm/char-mode () - "Switch exwm to char-mode." - (call-interactively #'exwm-input-release-keyboard) - (window-manager/alert "Switched to char-mode")) - -(defconst exwm/modes - (cycle/from-list (list #'exwm/char-mode - #'exwm/line-mode)) - "Functions to switch exwm modes.") - -(defun exwm/toggle-mode () - "Switch between line- and char- mode." - (interactive) - (with-current-buffer (window-buffer) - (when (eq major-mode 'exwm-mode) - (funcall (cycle/next exwm/modes))))) - -;; Ensure exwm apps open in char-mode. -(add-hook - 'exwm-manage-finish-hook - #'exwm/char-mode) - -;; Interface to the Linux password manager -;; TODO: Consider writing a better client for this. -(use-package ivy-pass) - -;; TODO: Prefer a more idiomatic Emacs way like `with-output-to-temp-buffer'. - -;; TODO: Create a mode similar to `help-mode' that also kills the buffer when -;; "q" is pressed since this is sensitive information that we probably don't -;; want persisting. - -;; TODO: Have this interactively show all of the listings in ~/.password-store -;; in an ivy list. -(defun password-store/show (key) - "Show the contents of KEY from the password-store in a buffer." - (interactive) - (let ((b (buffer/find-or-create (string/format "*password-store<%s>*" key)))) - (with-current-buffer b - (insert (password-store-get key)) - (help-mode)) - (buffer/show b))) - -;; TODO: I'm having difficulties with the Nix-built terminator. The one at -;; /usr/bin/terminator (i.e. built w/o Nix) works just fine. Using this, -;; however, cheapens my Nix setup. -(defconst exwm/preferred-terminal "terminator" - "My preferred terminal.") - -;; TODO: How do I handle this dependency? -(defconst exwm/preferred-browser "google-chrome" - "My preferred web browser.") - -(defun exwm/browser-open (&optional url) - "Opens the URL in `exwm/preferred-browser'." - (exwm/open - (string/format "%s %s" exwm/preferred-browser url) - :buffer-name (string/format "*%s*<%s>" exwm/preferred-browser url) - :process-name url)) - -;; TODO: Consider storing local state of all processes started with this command -;; for some nice ways to cycle through existing terminals, etc. -(defun exwm/terminal-open (cmd) - "Call CMD using `exwm/preferred-terminal'." - (exwm/open (string/format - "%s --command '%s'" - exwm/preferred-terminal - cmd) - :buffer-name (string/format "*%s*<%s>" exwm/preferred-terminal cmd) - :process-name cmd)) - -;; TODO: Create a KBD that calls the `C-x b' I call often. -;; TODO: Consider auto-generating KBDs for spawning these using the first -;; character in their name. Also assert that none of the generated keybindings -;; will clash with one another. -(defconst exwm/repls - '(("python" . (lambda () (exwm/terminal-open "python3"))) - ("zsh" . (lambda () (exwm/terminal-open "zsh"))) - ("fish" . (lambda () (exwm/terminal-open "fish"))) - ("nix" . (lambda () (exwm/terminal-open "nix repl"))) - ("racket" . racket-repl) - ;; NOTE: `ielm' as-is is a find-or-create operation. - ("elisp" . ielm)) - "Mapping of REPL labels to the commands needed to initialize those REPLs.") - -;; NOTE: Some of these commands split the window already. Some of these -;; commands find-or-create already. -;; -;; Find-or-create: -;; +---+---+ -;; | Y | N | -;; +---+---+ -;; python | | x | -;; zsh | | x | -;; racket | x | | -;; elisp | x | | -;; +---+---+ -;; -;; Split: -;; +---+---+ -;; | Y | N | -;; +---+---+ -;; python | | x | -;; zsh | | x | -;; racket | x | | -;; elisp | | x | -;; +---+---+ - -;; - Split: -;; - racket -(defun exwm/ivy-find-or-create-repl () - "Select a type of REPL using `ivy' and then find-or-create it." - (interactive) - (ivy-helpers/kv "REPLs: " - exwm/repls - (lambda (_ v) - (funcall v)))) - -;; KBDs to quickly open X11 applications. -(general-define-key - ;; TODO: Eventually switch this to a find-or-create operation. In general, I - ;; shouldn't need multiple instances of `python3` REPLs. - ;; TODO: Consider coupling these KBDs with the `exwm/ivy-find-or-create-repl' - ;; functionality defined above. - (kbd/raw 'x11 "n") (lambda () - (interactive) - (exwm/terminal-open "nix repl")) - (kbd/raw 'x11 "p") (lambda () - (interactive) - (exwm/terminal-open "python3")) - (kbd/raw 'x11 "t") (lambda () - (interactive) - (exwm/open exwm/preferred-terminal)) - (kbd/raw 'x11 "c") (lambda () - (interactive) - (exwm/open exwm/preferred-browser))) - -;; TODO: Support searching all "launchable" applications like OSX's Spotlight. -;; TODO: Model this as key-value pairs. -(defconst window-manager/applications - (list "google-chrome --new-window --app=https://chat.google.com" - "google-chrome --new-window --app=https://calendar.google.com" - "google-chrome --new-window --app=https://gmail.com" - "telegram-desktop" - "google-chrome --new-window --app=https://teknql.slack.com" - "google-chrome --new-window --app=https://web.whatsapp.com" - "google-chrome --new-window --app=https://irccloud.com" - exwm/preferred-browser - exwm/preferred-terminal) - "Applications that I commonly use. -These are the types of items that would usually appear in dmenu.") - -;; TODO: Consider replacing the `ivy-read' call with something like `hydra' that -;; can provide a small mode for accepting user-input. -;; TODO: Put this somewhere more diliberate. - -;; TODO: Configure the environment variables for xsecurelock so that the font is -;; smaller, different, and the glinux wallpaper doesn't show. -;; - XSECURELOCK_FONT="InputMono-Black 10" -;; - XSECURE_SAVER="" -;; - XSECURE_LOGO_IMAGE="" -;; Maybe just create a ~/.xsecurelockrc -;; TODO: Is there a shell-command API that accepts an alist and serializes it -;; into variables to pass to the shell command? -(defconst window-manager/xsecurelock - "/usr/share/goobuntu-desktop-files/xsecurelock.sh" - "Path to the proper xsecurelock executable. -The other path to xsecurelock is /usr/bin/xsecurelock, which works fine, but it -is not optimized for Goobuntu devices. Goobuntu attempts to check a user's -password using the network. When there is no network connection available, the -login attempts fail with an \"unknown error\", which isn't very helpful. To -avoid this, prefer the goobuntu wrapper around xsecurelock when on a goobuntu -device. This all relates to PAM (i.e. pluggable authentication modules).") - -(defun window-manager/logout () - "Prompt the user for options for logging out, shutting down, etc. - -The following options are supported: -- Lock -- Logout -- Suspend -- Hibernate -- Reboot -- Shutdown - -Ivy is used to capture the user's input." - (interactive) - (let* ((name->cmd `(("Lock" . ,window-manager/xsecurelock) - ("Logout" . "sudo systemctl stop lightdm") - ("Suspend" . ,(string/concat - window-manager/xsecurelock - " && systemctl suspend")) - ("Hibernate" . ,(string/concat - window-manager/xsecurelock - " && systemctl hibernate")) - ("Reboot" . "systemctl reboot") - ("Shutdown" . "systemctl poweroff")))) - (funcall - (lambda () - (shell-command - (alist/get (ivy-read "System: " (alist/keys name->cmd)) - name->cmd)))))) - -(cl-defun exwm/open (command &key - (process-name command) - (buffer-name command)) - "Open COMMAND, which should be an X11 window." - (start-process-shell-command process-name buffer-name command)) - -(cl-defun window-manager/execute-from-counsel (&key prompt list) - "Display a counsel menu of `LIST' with `PROMPT' and pipe the output through -`start-process-shell-command'." - (let ((x (ivy-read prompt list))) - (exwm/open - x - :buffer-name (string/format "*exwm/open*<%s>" x) - :process-name x))) - -(defun window-manager/apps () - "Open commonly used applications from counsel." - (interactive) - (window-manager/execute-from-counsel - :prompt "Application: " - :list window-manager/applications)) - -(defun exwm/label->index (label workspaces) - "Return the index of the workspace in WORKSPACES named LABEL." - (let ((workspace (->> workspaces - (list/find - (lambda (x) - (equal label - (exwm/named-workspace-label x))))))) - (if (prelude/set? workspace) - (exwm/named-workspace-index workspace) - (error (string/concat "No workspace found for label: " label))))) - -(defun exwm/register-kbd (workspace) - "Registers a keybinding for WORKSPACE struct. -Currently using super- as the prefix for switching workspaces." - (let ((handler (lambda () - (interactive) - (exwm/switch (exwm/named-workspace-label workspace)))) - (key (exwm/named-workspace-kbd workspace))) - (exwm-input-set-key - (kbd/for 'workspace key) - handler) - ;; Note: We need to capitalize the KBD here because of the signals that my - ;; Ergodox is sending Emacs on my desktop. - (exwm-input-set-key - (kbd/for 'workspace (s-capitalize key)) - handler))) - -(defun exwm/change-workspace (workspace) - "Switch EXWM workspaces to the WORKSPACE struct." - (exwm-workspace-switch (exwm/named-workspace-index workspace)) - (window-manager/alert - (string/format "Switched to: %s" (exwm/named-workspace-label workspace)))) - -(defun exwm/switch (label) - "Switch to a named workspaces using LABEL." - (cycle/focus (lambda (x) - (equal label - (exwm/named-workspace-label x))) - exwm/workspaces) - (exwm/change-workspace (cycle/current exwm/workspaces))) - -;; TODO: Assign an easy-to-remember keybinding to this. -(exwm-input-set-key (kbd "C-S-f") #'exwm/toggle-previous) -(defun exwm/toggle-previous () - "Focus the previously active EXWM workspace." - (interactive) - (exwm/change-workspace (cycle/focus-previous! exwm/workspaces))) - -(defun exwm/ivy-switch () - "Use ivy to switched between named workspaces." - (interactive) - (ivy-read - "Workspace: " - (->> exwm/named-workspaces - (list/map #'exwm/named-workspace-label)) - :action #'exwm/switch)) - -(when exwm/install-workspace-kbds? - (progn - (->> exwm/named-workspaces - (list/map #'exwm/register-kbd)) - (window-manager/alert "Registered workspace KBDs!"))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Startup Applications in `exwm/named-workspaces' -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(add-hook - 'exwm-init-hook - (lambda () - ;; TODO: Refactor this into a bigger solution where the named-workspaces are - ;; coupled to their startup commands. Expedience wins this time. - (progn - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; Chrome - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (progn - (exwm/switch "Web surfing") - ;; make sure this blocks. - ;; TODO: Support shell-cmd.el that has `shell-cmd/{sync,async}'. - ;; (call-process-shell-command "google-chrome") - ) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; Project - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (progn - (exwm/switch "Project") - (find-file constants/current-project)) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; Scratch - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (progn - (exwm/switch "Scratch") - (switch-to-buffer "*scratch*")) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; Terminal - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (progn - (exwm/switch "Terminal") - ;; TODO: Why does "gnome-terminal" work but not "terminator"? - ;; (call-process-shell-command "gnome-terminal") - ) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; Todos - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (progn - (exwm/switch "Todos") - (org-helpers/find-file "today-expected.org") - (wpc/evil-window-vsplit-right) - (org-helpers/find-file "today-actual.org")) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; Dotfiles - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (progn - (exwm/switch "Dotfiles") - (dotfiles/find-emacs-file "init.el") - (wpc/evil-window-vsplit-right) - (dotfiles/find-emacs-file "wpc/window-manager.el")) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; Chatter - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (progn - (exwm/switch "Chatter") - ;; TODO: Support the following chat applications: - ;; - Slack teknql - ;; - irccloud.net - ;; - web.whatsapp.com - ;; - Telegram - ;; NOTE: Perhaps all of these should be borderless. - ;; (call-process-shell-command "terminator") - ) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; Work - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (progn - (exwm/switch "Work") - ;; TODO: Support opening the following in chrome: - ;; - calendar - ;; - gmail - ;; - chat (in a horizontal split) - ) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; Reset to default - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (exwm/switch "Dotfiles")))) - -(provide 'window-manager) -;;; window-manager.el ends here diff --git a/configs/shared/.emacs.d/wpc/window.el b/configs/shared/.emacs.d/wpc/window.el deleted file mode 100644 index 132156bc44..0000000000 --- a/configs/shared/.emacs.d/wpc/window.el +++ /dev/null @@ -1,37 +0,0 @@ -;;; window.el --- Working with Emacs windows -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; Utilities to make CRUDing windows in Emacs easier. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'prelude) -(require 'macros) -(require 'maybe) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun window/find (name) - "Find a window by the NAME of the buffer it's hosting." - (let ((buffer (get-buffer name))) - (if (maybe/some? buffer) - (get-buffer-window buffer) - nil))) - -;; TODO: Find a way to incorporate these into function documentation. -(macros/comment - (window/find "*scratch*")) - -(defun window/delete (window) - "Delete the WINDOW reference." - (delete-window window)) - -(provide 'window) -;;; window.el ends here diff --git a/configs/shared/.emacs.d/wpc/wpgtk.el b/configs/shared/.emacs.d/wpc/wpgtk.el deleted file mode 100644 index 432d828843..0000000000 --- a/configs/shared/.emacs.d/wpc/wpgtk.el +++ /dev/null @@ -1,45 +0,0 @@ -;; wpgtk.el -- A base16 colorscheme template for wpgtk. - -;;; Commentary: - -;;; Authors: -;; Template: William Carroll - -;;; Code: - -(require 'base16-theme) -(require 'colorscheme) - -(defvar base16-wpgtk-colors - '(:base00 "#31213f" - :base01 "#E29B61" - :base02 "#E8C35F" - :base03 "#565B87" - :base04 "#A56785" - :base05 "#20A89E" - :base06 "#3CC2B5" - :base07 "#8de0e1" - :base08 "#629c9d" - :base09 "#E29B61" - :base0A "#E8C35F" - :base0B "#565B87" - :base0C "#A56785" - :base0D "#20A89E" - :base0E "#3CC2B5" - :base0F "#8de0e1") - "All colors for Base16 wpgtk are defined here.") - -;; Define the theme -(deftheme base16-wpgtk) - -;; Add all the faces to the theme -(base16-theme-define 'base16-wpgtk base16-wpgtk-colors) - -;; Mark the theme as provided -(provide-theme 'base16-wpgtk) - -(macros/comment - (colorscheme/set 'base16-wpgtk)) - -(provide 'wpgtk) -;;; wpgtk.el ends here diff --git a/configs/shared/.emacs.d/wpc/ynab.el b/configs/shared/.emacs.d/wpc/ynab.el deleted file mode 100644 index 7e132e20c2..0000000000 --- a/configs/shared/.emacs.d/wpc/ynab.el +++ /dev/null @@ -1,56 +0,0 @@ -;;; ynab.el --- Functions for YNAB's API -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; I'm not sure what the outcome of this project is. I'm just writing some -;; Elisp at the moment to document some of my cursory interactions with YNAB's -;; API. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'json) -(require 'a) -(require 'request) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defvar ynab/api-url "https://api.youneedabudget.com/v1/" - "The URL of the YNAB API.") - -(defun ynab/get-secret (name) - "Fetch and decrypt the secret for YNAB at NAME in the password store." - (password-store-get (format "%s/%s" "finance/youneedabudget.com" name))) - -(defvar ynab/personal-access-token - (ynab/get-secret "personal-access-token") - "My personal access token to YNAB's API.") - -(defvar ynab/budget-id - (ynab/get-secret "budget-id") - "The ID of my current budget on YNAB.") - -(defvar ynab/account-id - (ynab/get-secret "account-id") - "The ID of my current budget on YNAB.") - -(defun ynab/url-for-endpoint (endpoint) - "Return the URL for the YNAB ENDPOINT. -This will resolve any variables in the form of {variable_name} using a prefined -scope object." - (format "%s%s" ynab/api-url endpoint)) - -(macros/comment - ;; TODO: Use these this map to resolve variables in an endpoint URL like - ;; '/budgets/{budget_id}/'. - '((budget_id . (ynab/get-secret "budget-id")) - (account_id . (ynab/get-secret "account-id"))) - (request (ynab/url-for-endpoint "/budgets/{budget_id}/transactions"))) - -(provide 'ynab) -;;; ynab.el ends here diff --git a/configs/shared/.emacs.d/wpc/zle.el b/configs/shared/.emacs.d/wpc/zle.el deleted file mode 100644 index 1b01da9384..0000000000 --- a/configs/shared/.emacs.d/wpc/zle.el +++ /dev/null @@ -1,90 +0,0 @@ -;;; zle.el --- Functions to mimmick my ZLE KBDs -*- lexical-binding: t -*- -;; Author: William Carroll - -;;; Commentary: -;; This is primarily for personal use. The keybindings that I choose are those -;; that feel slightly mnemonic while also not shadowing important bindings. -;; It's quite possible that our tastes will differ here. -;; -;; All of these keybindings are intended to shave off milliseconds off your -;; typing. I don't expect these numbers to sum up to a meaningful amount. The -;; primary reason that I wrote this, is that it introduces a small amount of -;; structural editing to my workflow. I've been using these exact keybindings -;; on the command line, and I find them subtely delightful to use. So much so -;; that I decided to bring them to my Emacs configuration. -;; -;; ZLE is the Z-shell line editor. I have some KBDs and functions that I often -;; want in Emacs. -;; -;; Usage: -;; Consider running `(zle-minor-mode)' to run this globally. Depending on your -;; configuration, it could be non-disruptive, disruptive, or extremely -;; disruptive. -;; -;; TODO: Consider adding (general-unbind 'insert "C-v") herein. - -;;; Code: - -;; subshell (C-j) -(defun zle/subshell () - "Insert the characters necessary to create a subshell." - (interactive) - (insert-char ?$) - (insert-char ?\() - (save-excursion - (insert-char ?\)))) - -;; variable (C-v) -(defun zle/variable () - "Insert the characters to reference a variable." - (interactive) - (insert-char ?$) - (insert-char ?{) - (save-excursion - (insert-char ?}))) - -;; 2x dash (C-M--) -(defun zle/dash-dash () - "Insert the characters for flags with 2x dashes." - (interactive) - (insert-char ? ) - (insert-char ?-) - (insert-char ?-)) - -;; 1x quotes (M-') -(defun zle/single-quote () - "Insert the characters to quickly create single quotes." - (interactive) - (insert-char ? ) - (insert-char ?') - (save-excursion - (insert-char ?'))) - -;; 2x quotes (M-") -(defun zle/double-quote () - "Insert the characters to quickly create double quotes." - (interactive) - (insert-char ? ) - (insert-char ?\") - (save-excursion - (insert-char ?\"))) - -(defvar zle/kbds - (let ((map (make-sparse-keymap))) - (bind-keys :map map - ("C-j" . zle/subshell) - ("C-v" . zle/variable) - ("C-M--" . zle/dash-dash) - ("M-'" . zle/single-quote) - ("M-\"" . zle/double-quote)) - map) - "Keybindings shaving milliseconds off of typing.") - -(define-minor-mode zle-minor-mode - "A minor mode mirroring my ZLE keybindings." - :init-value nil - :lighter " zle" - :keymap zle/kbds) - -(provide 'zle) -;;; zle.el ends here diff --git a/emacs.nix b/emacs.nix deleted file mode 100644 index 895165394d..0000000000 --- a/emacs.nix +++ /dev/null @@ -1,140 +0,0 @@ -{ pkgs ? import {} -, tazjinsPkgs ? import (builtins.fetchGit "https://git.tazj.in") { - rev = "4c0e0d715f21eeb62594d198ba1eeccb1a2cfb13"; - } -}: - -let - # TODO: Move this function definition to a prelude.nix or elsewhere. - identity = x: x; - - # Here is a whitelist of all of the binary dependencies that Emacs relies - # on. These are separate from Emacs libraries like dash.el. - emacsBinPath = pkgs.lib.strings.makeBinPath [ pkgs.terminator ]; - - emacsWithPackages = (pkgs.emacsPackagesNgGen pkgs.emacs26).emacsWithPackages; - - # TODO: Learn more about melpa versus elpa to have a preference. - wpcarrosEmacs = emacsWithPackages (epkgs: - (with epkgs.elpaPackages; [ - exwm - ]) ++ - - (with epkgs.melpaPackages; [ - base16-theme - ivy-pass - clipmon # TODO: Prefer an Emacs client for clipmenud. - protobuf-mode # TODO: Determine if this is coming from google-emacs. - docker - evil - evil-collection - evil-magit - evil-commentary - evil-surround - key-chord - add-node-modules-path # TODO: Assess whether or not I need this with Nix. - web-mode - rjsx-mode - tide - prettier-js - flycheck - diminish - doom-themes - neotree # TODO: Remove this dependency from my config. - which-key - ivy - ivy-prescient - all-the-icons - all-the-icons-ivy - alert - nix-mode - racer - rust-mode - rainbow-delimiters - racket-mode - lispyville - elisp-slime-nav - py-yapf - reason-mode - elixir-mode - company - markdown-mode - refine - deferred - magit - request - pcre2el - helpful - exec-path-from-shell # TODO: Determine if Nix solves this problem. - yasnippet - projectile - deadgrep - counsel - counsel-projectile - engine-mode # TODO: Learn what this is. - eglot - dap-mode - lsp-ui - company-lsp - suggest - paradox - emr - flymake-shellcheck - fish-mode - tuareg - haskell-mode - lsp-haskell - use-package - general - clojure-mode - cider - f - dash - company - counsel - flycheck - ivy - magit - ]) ++ - - # tazjin's packages - (with tazjinsPkgs.tools.emacs-pkgs; [ - dottime - term-switcher - ])); - -# TODO: Do I need `pkgs.lib.fix`? -in pkgs.lib.fix(self: l: f: pkgs.writeShellScriptBin "wpcarros-emacs" '' - export PATH="${emacsBinPath}:$PATH" - exec ${wpcarrosEmacs}/bin/emacs \ - --debug-init \ - --no-site-file \ - --no-site-lisp \ - --directory ${ ./configs/shared/emacs.d/vendor } \ - --directory ${ ./configs/shared/emacs.d/wpc } \ - --directory ${ ./configs/shared/emacs.d/wpc/packages } \ - --load ${ ./configs/shared/emacs.d/init.el } \ - --no-init-file $@ -'' // { - # TODO: Ascertain whether I need this. - overrideEmacs = f': self l f'; - - # Call with a local.el file containing local system configuration. - withLocalConfig = confDir: self confDir f; - - # This accepts the path to a non-Nix built Emacs, so that X and GL linkage - # behaves as expected. - withLocalEmacs = emacsBin: pkgs.writeShellScriptBin "wpcarros-emacs" '' - export PATH="${emacsBinPath}:$PATH" - export EMACSLOADPATH="${wpcarrosEmacs.deps}/share/emacs/site-lisp:" - exec ${emacsBin} \ - --debug-init \ - --no-site-file \ - --no-site-lisp \ - --directory ${ ./configs/shared/emacs.d/vendor } \ - --directory ${ ./configs/shared/emacs.d/wpc } \ - --directory ${ ./configs/shared/emacs.d/wpc/packages } \ - --load ${ ./configs/shared/emacs.d/init.el } \ - --no-init-file $@ - ''; -}) null identity diff --git a/emacs/.emacs.d/init.el b/emacs/.emacs.d/init.el new file mode 100644 index 0000000000..0351ecedde --- /dev/null +++ b/emacs/.emacs.d/init.el @@ -0,0 +1,61 @@ +(require 'wpc-package) + +;; load order is intentional +(require 'constants) +(require 'wpc-misc) + +;; my libraries +(require 'functions) +(require 'prelude) +(require 'macros) +(require 'kaomoji) + +;; Google +;; (require 'google-stuff) + +;; Laptop XF-functionality +(require 'pulse-audio) +(require 'screen-brightness) + +;; miscellaneous +(require 'clipboard) +(require 'battery) +(require 'dotfiles) +(require 'bookmark) +(require 'keyboard) +(require 'irc) +(require 'email) +;; TODO: Consider renaming entr.el. +(require 'entr) +(require 'scrot) + +;; TODO: Remove path once published to MELPA. +;; TODO: How can I package this using Nix? +;; (require 'egg-timer "~/programming/egg-timer.el/egg-timer.el") + +;; TODO: Reconcile kbd.el, keybindings.el, wpc-keybindings.el, keyboard.el. +(require 'keybindings) +(require 'wpc-keybindings) +(require 'window-manager) +(require 'wpc-ui) +(require 'wpc-dired) +(require 'wpc-terminal) +(require 'wpc-org) +(require 'wpc-company) +;; TODO: Re-enable flycheck for all languages besides Elisp once I learn more +;; about the issue with the `emacs-lisp' `flycheck-checker'. +;; (require 'wpc-flycheck) +(require 'wpc-shell) +(require 'wpc-docker) +(require 'wpc-lisp) +(require 'wpc-haskell) +(require 'wpc-reasonml) +(require 'wpc-ocaml) +(require 'wpc-elixir) +(require 'wpc-nix) +(require 'wpc-rust) +(require 'wpc-clojure) +(require 'wpc-python) +(require 'wpc-javascript) +(require 'wpc-java) +(require 'wpc-prolog) diff --git a/emacs/.emacs.d/opam-user-setup.el b/emacs/.emacs.d/opam-user-setup.el new file mode 100644 index 0000000000..a23addefaf --- /dev/null +++ b/emacs/.emacs.d/opam-user-setup.el @@ -0,0 +1,145 @@ +;; ## added by OPAM user-setup for emacs / base ## cfd3c9b7837c85cffd0c59de521990f0 ## you can edit, but keep this line +(provide 'opam-user-setup) + +;; Base configuration for OPAM + +(defun opam-shell-command-to-string (command) + "Similar to shell-command-to-string, but returns nil unless the process + returned 0, and ignores stderr (shell-command-to-string ignores return value)" + (let* ((return-value 0) + (return-string + (with-output-to-string + (setq return-value + (with-current-buffer standard-output + (process-file shell-file-name nil '(t nil) nil + shell-command-switch command)))))) + (if (= return-value 0) return-string nil))) + +(defun opam-update-env (switch) + "Update the environment to follow current OPAM switch configuration" + (interactive + (list + (let ((default + (car (split-string (opam-shell-command-to-string "opam switch show --safe"))))) + (completing-read + (concat "opam switch (" default "): ") + (split-string (opam-shell-command-to-string "opam switch list -s --safe") "\n") + nil t nil nil default)))) + (let* ((switch-arg (if (= 0 (length switch)) "" (concat "--switch " switch))) + (command (concat "opam config env --safe --sexp " switch-arg)) + (env (opam-shell-command-to-string command))) + (when (and env (not (string= env ""))) + (dolist (var (car (read-from-string env))) + (setenv (car var) (cadr var)) + (when (string= (car var) "PATH") + (setq exec-path (split-string (cadr var) path-separator))))))) + +(opam-update-env nil) + +(defvar opam-share + (let ((reply (opam-shell-command-to-string "opam config var share --safe"))) + (when reply (substring reply 0 -1)))) + +(add-to-list 'load-path (concat opam-share "/emacs/site-lisp")) +;; OPAM-installed tools automated detection and initialisation + +(defun opam-setup-tuareg () + (add-to-list 'load-path (concat opam-share "/tuareg") t) + (load "tuareg-site-file")) + +(defun opam-setup-add-ocaml-hook (h) + (add-hook 'tuareg-mode-hook h t) + (add-hook 'caml-mode-hook h t)) + +(defun opam-setup-complete () + (if (require 'company nil t) + (opam-setup-add-ocaml-hook + (lambda () + (company-mode) + (defalias 'auto-complete 'company-complete))) + (require 'auto-complete nil t))) + +(defun opam-setup-ocp-indent () + (opam-setup-complete) + (autoload 'ocp-setup-indent "ocp-indent" "Improved indentation for Tuareg mode") + (autoload 'ocp-indent-caml-mode-setup "ocp-indent" "Improved indentation for Caml mode") + (add-hook 'tuareg-mode-hook 'ocp-setup-indent t) + (add-hook 'caml-mode-hook 'ocp-indent-caml-mode-setup t)) + +(defun opam-setup-ocp-index () + (autoload 'ocp-index-mode "ocp-index" "OCaml code browsing, documentation and completion based on build artefacts") + (opam-setup-add-ocaml-hook 'ocp-index-mode)) + +(defun opam-setup-merlin () + (opam-setup-complete) + (require 'merlin) + (opam-setup-add-ocaml-hook 'merlin-mode) + + (defcustom ocp-index-use-auto-complete nil + "Use auto-complete with ocp-index (disabled by default by opam-user-setup because merlin is in use)" + :group 'ocp_index) + (defcustom merlin-ac-setup 'easy + "Use auto-complete with merlin (enabled by default by opam-user-setup)" + :group 'merlin-ac) + + ;; So you can do it on a mac, where `C-` and `C-` are used + ;; by spaces. + (define-key merlin-mode-map + (kbd "C-c ") 'merlin-type-enclosing-go-up) + (define-key merlin-mode-map + (kbd "C-c ") 'merlin-type-enclosing-go-down) + (set-face-background 'merlin-type-face "skyblue")) + +(defun opam-setup-utop () + (autoload 'utop "utop" "Toplevel for OCaml" t) + (autoload 'utop-minor-mode "utop" "Minor mode for utop" t) + (add-hook 'tuareg-mode-hook 'utop-minor-mode)) + +(defvar opam-tools + '(("tuareg" . opam-setup-tuareg) + ("ocp-indent" . opam-setup-ocp-indent) + ("ocp-index" . opam-setup-ocp-index) + ("merlin" . opam-setup-merlin) + ("utop" . opam-setup-utop))) + +(defun opam-detect-installed-tools () + (let* + ((command "opam list --installed --short --safe --color=never") + (names (mapcar 'car opam-tools)) + (command-string (mapconcat 'identity (cons command names) " ")) + (reply (opam-shell-command-to-string command-string))) + (when reply (split-string reply)))) + +(defvar opam-tools-installed (opam-detect-installed-tools)) + +(defun opam-auto-tools-setup () + (interactive) + (dolist (tool opam-tools) + (when (member (car tool) opam-tools-installed) + (funcall (symbol-function (cdr tool)))))) + +(opam-auto-tools-setup) +;; ## end of OPAM user-setup addition for emacs / base ## keep this line +;; ## added by OPAM user-setup for emacs / tuareg ## b10f42abebd2259b784b70d1a7f7e426 ## you can edit, but keep this line +;; Set to autoload tuareg from its original switch when not found in current +;; switch (don't load tuareg-site-file as it adds unwanted load-paths) +(defun opam-tuareg-autoload (fct file doc args) + (let ((load-path (cons "/home/wpcarro/.opam/default/share/emacs/site-lisp" load-path))) + (load file)) + (apply fct args)) +(when (not (member "tuareg" opam-tools-installed)) + (defun tuareg-mode (&rest args) + (opam-tuareg-autoload 'tuareg-mode "tuareg" "Major mode for editing OCaml code" args)) + (defun tuareg-run-ocaml (&rest args) + (opam-tuareg-autoload 'tuareg-run-ocaml "tuareg" "Run an OCaml toplevel process" args)) + (defun ocamldebug (&rest args) + (opam-tuareg-autoload 'ocamldebug "ocamldebug" "Run the OCaml debugger" args)) + (defalias 'run-ocaml 'tuareg-run-ocaml) + (defalias 'camldebug 'ocamldebug) + (add-to-list 'auto-mode-alist '("\\.ml[iylp]?\\'" . tuareg-mode)) + (add-to-list 'auto-mode-alist '("\\.eliomi?\\'" . tuareg-mode)) + (add-to-list 'interpreter-mode-alist '("ocamlrun" . tuareg-mode)) + (add-to-list 'interpreter-mode-alist '("ocaml" . tuareg-mode)) + (dolist (ext '(".cmo" ".cmx" ".cma" ".cmxa" ".cmxs" ".cmt" ".cmti" ".cmi" ".annot")) + (add-to-list 'completion-ignored-extensions ext))) +;; ## end of OPAM user-setup addition for emacs / tuareg ## keep this line diff --git a/emacs/.emacs.d/snippets/c-mode/.yas-parents b/emacs/.emacs.d/snippets/c-mode/.yas-parents new file mode 100644 index 0000000000..d58dacb7a0 --- /dev/null +++ b/emacs/.emacs.d/snippets/c-mode/.yas-parents @@ -0,0 +1 @@ +text-mode \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/c-mode/stdio b/emacs/.emacs.d/snippets/c-mode/stdio new file mode 100644 index 0000000000..52bc717e47 --- /dev/null +++ b/emacs/.emacs.d/snippets/c-mode/stdio @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: +# key: sio +# -- +#include \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/c-mode/stdlib b/emacs/.emacs.d/snippets/c-mode/stdlib new file mode 100644 index 0000000000..5d44e8ed79 --- /dev/null +++ b/emacs/.emacs.d/snippets/c-mode/stdlib @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: +# key: slb +# -- +#include \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/c-mode/struct b/emacs/.emacs.d/snippets/c-mode/struct new file mode 100644 index 0000000000..6e9282f83c --- /dev/null +++ b/emacs/.emacs.d/snippets/c-mode/struct @@ -0,0 +1,7 @@ +# -*- mode: snippet -*- +# name: struct +# key: struct +# -- +typedef struct $1 { + $2 +} $1_t; \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/emacs-lisp-mode/.yas-parents b/emacs/.emacs.d/snippets/emacs-lisp-mode/.yas-parents new file mode 100644 index 0000000000..d58dacb7a0 --- /dev/null +++ b/emacs/.emacs.d/snippets/emacs-lisp-mode/.yas-parents @@ -0,0 +1 @@ +text-mode \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/emacs-lisp-mode/elisp-module-docs b/emacs/.emacs.d/snippets/emacs-lisp-mode/elisp-module-docs new file mode 100644 index 0000000000..8ea7b8f077 --- /dev/null +++ b/emacs/.emacs.d/snippets/emacs-lisp-mode/elisp-module-docs @@ -0,0 +1,11 @@ +# -*- mode: snippet -*- +# name: Elisp module docs +# key: emd +# -- +;;; `(-> (buffer-file-name) f-filename)` --- $2 -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; $3 + +;;; Code: \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/emacs-lisp-mode/function b/emacs/.emacs.d/snippets/emacs-lisp-mode/function new file mode 100644 index 0000000000..bfa888d526 --- /dev/null +++ b/emacs/.emacs.d/snippets/emacs-lisp-mode/function @@ -0,0 +1,8 @@ +# -*- mode: snippet -*- +# name: Function +# key: fn +# expand-env: ((yas-indent-line 'fixed)) +# -- +(defun $1 ($2) + "$3" + $4) \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/emacs-lisp-mode/generic-header b/emacs/.emacs.d/snippets/emacs-lisp-mode/generic-header new file mode 100644 index 0000000000..bf6e525f8c --- /dev/null +++ b/emacs/.emacs.d/snippets/emacs-lisp-mode/generic-header @@ -0,0 +1,7 @@ +# -*- mode: snippet -*- +# name: Header +# key: hdr +# -- +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; $1 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/emacs/.emacs.d/snippets/emacs-lisp-mode/library-header b/emacs/.emacs.d/snippets/emacs-lisp-mode/library-header new file mode 100644 index 0000000000..0f0ad5c4fc --- /dev/null +++ b/emacs/.emacs.d/snippets/emacs-lisp-mode/library-header @@ -0,0 +1,7 @@ +# -*- mode: snippet -*- +# name: Library header +# key: lib +# -- +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/emacs-lisp-mode/provide-footer b/emacs/.emacs.d/snippets/emacs-lisp-mode/provide-footer new file mode 100644 index 0000000000..2a0bcc33f7 --- /dev/null +++ b/emacs/.emacs.d/snippets/emacs-lisp-mode/provide-footer @@ -0,0 +1,6 @@ +# -*- mode: snippet -*- +# name: Provide footer +# key: elf +# -- +(provide '`(-> (buffer-file-name) f-filename f-no-ext)`) +;;; `(-> (buffer-file-name) f-filename)` ends here \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/haskell-mode/.yas-parents b/emacs/.emacs.d/snippets/haskell-mode/.yas-parents new file mode 100644 index 0000000000..d58dacb7a0 --- /dev/null +++ b/emacs/.emacs.d/snippets/haskell-mode/.yas-parents @@ -0,0 +1 @@ +text-mode \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/haskell-mode/derive-safe-copy b/emacs/.emacs.d/snippets/haskell-mode/derive-safe-copy new file mode 100644 index 0000000000..95f7d9deec --- /dev/null +++ b/emacs/.emacs.d/snippets/haskell-mode/derive-safe-copy @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: Derive Safe Copy +# key: dsc +# -- +deriveSafeCopy 0 'base ''$1 \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/haskell-mode/import-qualified b/emacs/.emacs.d/snippets/haskell-mode/import-qualified new file mode 100644 index 0000000000..4c4db62a8a --- /dev/null +++ b/emacs/.emacs.d/snippets/haskell-mode/import-qualified @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: Import qualified +# key: iq +# -- +import qualified $1 as $2 \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/haskell-mode/instance-defn b/emacs/.emacs.d/snippets/haskell-mode/instance-defn new file mode 100644 index 0000000000..10d194ce41 --- /dev/null +++ b/emacs/.emacs.d/snippets/haskell-mode/instance-defn @@ -0,0 +1,6 @@ +# -*- mode: snippet -*- +# name: Instance +# key: inst +# -- +instance $1 where + $2 = $3 \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/haskell-mode/language-extension b/emacs/.emacs.d/snippets/haskell-mode/language-extension new file mode 100644 index 0000000000..9d6084acb4 --- /dev/null +++ b/emacs/.emacs.d/snippets/haskell-mode/language-extension @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: language extension +# key: lang +# -- +{-# LANGUAGE $1 #-} \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/haskell-mode/separator b/emacs/.emacs.d/snippets/haskell-mode/separator new file mode 100644 index 0000000000..1ab0d762b6 --- /dev/null +++ b/emacs/.emacs.d/snippets/haskell-mode/separator @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: Separator +# key: - +# -- +-------------------------------------------------------------------------------- \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/haskell-mode/undefined b/emacs/.emacs.d/snippets/haskell-mode/undefined new file mode 100644 index 0000000000..7609f801f2 --- /dev/null +++ b/emacs/.emacs.d/snippets/haskell-mode/undefined @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: Undefiend +# key: nd +# -- +undefined \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/html-mode/.yas-parents b/emacs/.emacs.d/snippets/html-mode/.yas-parents new file mode 100644 index 0000000000..d58dacb7a0 --- /dev/null +++ b/emacs/.emacs.d/snippets/html-mode/.yas-parents @@ -0,0 +1 @@ +text-mode \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/html-mode/index-boilerplate b/emacs/.emacs.d/snippets/html-mode/index-boilerplate new file mode 100644 index 0000000000..3cea6ce003 --- /dev/null +++ b/emacs/.emacs.d/snippets/html-mode/index-boilerplate @@ -0,0 +1,18 @@ +# -*- mode: snippet -*- +# name: HTML index.html starter +# key: html +# -- + + + + + + $1 + + + + + + + + \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/java-mode/.yas-parents b/emacs/.emacs.d/snippets/java-mode/.yas-parents new file mode 100644 index 0000000000..d58dacb7a0 --- /dev/null +++ b/emacs/.emacs.d/snippets/java-mode/.yas-parents @@ -0,0 +1 @@ +text-mode \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/java-mode/public-static-void-main b/emacs/.emacs.d/snippets/java-mode/public-static-void-main new file mode 100644 index 0000000000..1839a27eb5 --- /dev/null +++ b/emacs/.emacs.d/snippets/java-mode/public-static-void-main @@ -0,0 +1,7 @@ +# -*- mode: snippet -*- +# name: public static void main +# key: psvm +# -- +public static void main(String[] args) { + $1 +} \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/lisp-mode/.yas-parents b/emacs/.emacs.d/snippets/lisp-mode/.yas-parents new file mode 100644 index 0000000000..d58dacb7a0 --- /dev/null +++ b/emacs/.emacs.d/snippets/lisp-mode/.yas-parents @@ -0,0 +1 @@ +text-mode \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/lisp-mode/defpackage b/emacs/.emacs.d/snippets/lisp-mode/defpackage new file mode 100644 index 0000000000..7f110a9718 --- /dev/null +++ b/emacs/.emacs.d/snippets/lisp-mode/defpackage @@ -0,0 +1,9 @@ +# -*- mode: snippet -*- +# name: Define package +# key: defp +# -- +(in-package #:cl-user) +(defpackage #:$1 + (:documentation "$2") + (:use #:cl)) +(in-package #:$1) \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/lisp-mode/function b/emacs/.emacs.d/snippets/lisp-mode/function new file mode 100644 index 0000000000..b1769cd3d1 --- /dev/null +++ b/emacs/.emacs.d/snippets/lisp-mode/function @@ -0,0 +1,7 @@ +# -*- mode: snippet -*- +# name: Function +# key: fn +# -- +(defun $1 ($2) + "$3" + $4) \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/lisp-mode/typed-function b/emacs/.emacs.d/snippets/lisp-mode/typed-function new file mode 100644 index 0000000000..a3c236821e --- /dev/null +++ b/emacs/.emacs.d/snippets/lisp-mode/typed-function @@ -0,0 +1,8 @@ +# -*- mode: snippet -*- +# name: Typed function +# key: tfn +# -- +(type $1 ($3) $4) +(defun $1 ($2) + "$5" + $6) \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/nix-mode/.yas-parents b/emacs/.emacs.d/snippets/nix-mode/.yas-parents new file mode 100644 index 0000000000..d58dacb7a0 --- /dev/null +++ b/emacs/.emacs.d/snippets/nix-mode/.yas-parents @@ -0,0 +1 @@ +text-mode \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/nix-mode/shell-nix b/emacs/.emacs.d/snippets/nix-mode/shell-nix new file mode 100644 index 0000000000..4c308bb51b --- /dev/null +++ b/emacs/.emacs.d/snippets/nix-mode/shell-nix @@ -0,0 +1,12 @@ +# -*- mode: snippet -*- +# name: shell.nix boilerplate +# key: import +# -- +with import {}; + +stdenv.mkDerivation { + name = "$1"; + buildInputs = [ + $2 + ]; +} \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/org-mode/.yas-parents b/emacs/.emacs.d/snippets/org-mode/.yas-parents new file mode 100644 index 0000000000..d58dacb7a0 --- /dev/null +++ b/emacs/.emacs.d/snippets/org-mode/.yas-parents @@ -0,0 +1 @@ +text-mode \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/org-mode/code-snippet b/emacs/.emacs.d/snippets/org-mode/code-snippet new file mode 100644 index 0000000000..4215b15992 --- /dev/null +++ b/emacs/.emacs.d/snippets/org-mode/code-snippet @@ -0,0 +1,7 @@ +# -*- mode: snippet -*- +# name: Code Snippet +# key: src +# -- +#+BEGIN_SRC $1 +$2 +#+END_SRC \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/org-mode/href b/emacs/.emacs.d/snippets/org-mode/href new file mode 100644 index 0000000000..ac65ea2e49 --- /dev/null +++ b/emacs/.emacs.d/snippets/org-mode/href @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: Org mode URL +# key: href +# -- +[[$1][$2]] \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/python-mode/.yas-parents b/emacs/.emacs.d/snippets/python-mode/.yas-parents new file mode 100644 index 0000000000..d58dacb7a0 --- /dev/null +++ b/emacs/.emacs.d/snippets/python-mode/.yas-parents @@ -0,0 +1 @@ +text-mode \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/python-mode/dunder-main b/emacs/.emacs.d/snippets/python-mode/dunder-main new file mode 100644 index 0000000000..4dd22dc0b2 --- /dev/null +++ b/emacs/.emacs.d/snippets/python-mode/dunder-main @@ -0,0 +1,6 @@ +# -*- mode: snippet -*- +# name: Dunder main (__main__) +# key: mn +# -- +if __name__ == "__main__": + main() \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/python-mode/function b/emacs/.emacs.d/snippets/python-mode/function new file mode 100644 index 0000000000..379ceda1a3 --- /dev/null +++ b/emacs/.emacs.d/snippets/python-mode/function @@ -0,0 +1,6 @@ +# -*- mode: snippet -*- +# name: Function +# key: fn +# -- +def $1($2): + $3 \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/python-mode/header b/emacs/.emacs.d/snippets/python-mode/header new file mode 100644 index 0000000000..db48adfec7 --- /dev/null +++ b/emacs/.emacs.d/snippets/python-mode/header @@ -0,0 +1,7 @@ +# -*- mode: snippet -*- +# name: Header +# key: hdr +# -- +################################################################################ +# $1 +################################################################################ \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/python-mode/init b/emacs/.emacs.d/snippets/python-mode/init new file mode 100644 index 0000000000..5c407495f5 --- /dev/null +++ b/emacs/.emacs.d/snippets/python-mode/init @@ -0,0 +1,6 @@ +# -*- mode: snippet -*- +# name: dunder init +# key: ctor +# -- +def __init__(self$1): + $2 \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/python-mode/shebang b/emacs/.emacs.d/snippets/python-mode/shebang new file mode 100644 index 0000000000..0f45ae782d --- /dev/null +++ b/emacs/.emacs.d/snippets/python-mode/shebang @@ -0,0 +1,6 @@ +# -*- mode: snippet -*- +# name: shebang +# key: shb +# -- +#!/usr/bin/env python +# -*- coding: utf-8 -*- diff --git a/emacs/.emacs.d/snippets/python-mode/utf-8 b/emacs/.emacs.d/snippets/python-mode/utf-8 new file mode 100644 index 0000000000..3babc73030 --- /dev/null +++ b/emacs/.emacs.d/snippets/python-mode/utf-8 @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: utf-8 +# key: utf +# -- +# -*- coding: utf-8 -*- \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/racket-mode/.yas-parents b/emacs/.emacs.d/snippets/racket-mode/.yas-parents new file mode 100644 index 0000000000..d58dacb7a0 --- /dev/null +++ b/emacs/.emacs.d/snippets/racket-mode/.yas-parents @@ -0,0 +1 @@ +text-mode \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/racket-mode/function b/emacs/.emacs.d/snippets/racket-mode/function new file mode 100644 index 0000000000..882c48ded3 --- /dev/null +++ b/emacs/.emacs.d/snippets/racket-mode/function @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: Function +# key: fn +# -- +(define ($1) $2) \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/racket-mode/lambda b/emacs/.emacs.d/snippets/racket-mode/lambda new file mode 100644 index 0000000000..b9a684588b --- /dev/null +++ b/emacs/.emacs.d/snippets/racket-mode/lambda @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: Lambda function +# key: ld +# -- +(λ ($1) $2) \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/racket-mode/lambda-symbol b/emacs/.emacs.d/snippets/racket-mode/lambda-symbol new file mode 100644 index 0000000000..254b9fd96b --- /dev/null +++ b/emacs/.emacs.d/snippets/racket-mode/lambda-symbol @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: Lambda symbol +# key: l +# -- +λ \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/reason-mode/.yas-parents b/emacs/.emacs.d/snippets/reason-mode/.yas-parents new file mode 100644 index 0000000000..d58dacb7a0 --- /dev/null +++ b/emacs/.emacs.d/snippets/reason-mode/.yas-parents @@ -0,0 +1 @@ +text-mode \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/reason-mode/function b/emacs/.emacs.d/snippets/reason-mode/function new file mode 100644 index 0000000000..6b4b6a5db2 --- /dev/null +++ b/emacs/.emacs.d/snippets/reason-mode/function @@ -0,0 +1,7 @@ +# -*- mode: snippet -*- +# name: Function +# key: fn +# -- +let $1 = (~$2:$3) => { + $4 +}; \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/reason-mode/switch b/emacs/.emacs.d/snippets/reason-mode/switch new file mode 100644 index 0000000000..40f34ff8d1 --- /dev/null +++ b/emacs/.emacs.d/snippets/reason-mode/switch @@ -0,0 +1,7 @@ +# -*- mode: snippet -*- +# name: Switch statement +# key: sw +# -- +switch ($1) { +| $2 => +} \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/rjsx-mode/.yas-parents b/emacs/.emacs.d/snippets/rjsx-mode/.yas-parents new file mode 100644 index 0000000000..d58dacb7a0 --- /dev/null +++ b/emacs/.emacs.d/snippets/rjsx-mode/.yas-parents @@ -0,0 +1 @@ +text-mode \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/rjsx-mode/action-extractor b/emacs/.emacs.d/snippets/rjsx-mode/action-extractor new file mode 100644 index 0000000000..62834a29ab --- /dev/null +++ b/emacs/.emacs.d/snippets/rjsx-mode/action-extractor @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: exactness +# key: $x +# -- +$Exact<$Call> \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/rjsx-mode/console-log b/emacs/.emacs.d/snippets/rjsx-mode/console-log new file mode 100644 index 0000000000..82ec3fd8e3 --- /dev/null +++ b/emacs/.emacs.d/snippets/rjsx-mode/console-log @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: Console.log helper +# key: clg +# -- +console.log($1) \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/rjsx-mode/const-defn b/emacs/.emacs.d/snippets/rjsx-mode/const-defn new file mode 100644 index 0000000000..8e35e61fc2 --- /dev/null +++ b/emacs/.emacs.d/snippets/rjsx-mode/const-defn @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: const definition +# key: cn +# -- +const $1 = '$2' \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/rjsx-mode/const-function b/emacs/.emacs.d/snippets/rjsx-mode/const-function new file mode 100644 index 0000000000..13f2018f22 --- /dev/null +++ b/emacs/.emacs.d/snippets/rjsx-mode/const-function @@ -0,0 +1,7 @@ +# -*- mode: snippet -*- +# name: const function +# key: cfn +# -- +const $1 = ($2) => { + $3 +} \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/rjsx-mode/destructure-const b/emacs/.emacs.d/snippets/rjsx-mode/destructure-const new file mode 100644 index 0000000000..2a52c57c75 --- /dev/null +++ b/emacs/.emacs.d/snippets/rjsx-mode/destructure-const @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: Destructuring a const +# key: cds +# -- +const { $1 } = $2 \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/rjsx-mode/fat-arrow b/emacs/.emacs.d/snippets/rjsx-mode/fat-arrow new file mode 100644 index 0000000000..187a2efc5a --- /dev/null +++ b/emacs/.emacs.d/snippets/rjsx-mode/fat-arrow @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: Fat arrow function +# key: fa +# -- +=> \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/rjsx-mode/fat-arrow-function b/emacs/.emacs.d/snippets/rjsx-mode/fat-arrow-function new file mode 100644 index 0000000000..694914a83c --- /dev/null +++ b/emacs/.emacs.d/snippets/rjsx-mode/fat-arrow-function @@ -0,0 +1,7 @@ +# -*- mode: snippet -*- +# name: Fat arrow function +# key: faf +# -- +() => { + $1 +} \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/rjsx-mode/import-destructured b/emacs/.emacs.d/snippets/rjsx-mode/import-destructured new file mode 100644 index 0000000000..ded3ce163a --- /dev/null +++ b/emacs/.emacs.d/snippets/rjsx-mode/import-destructured @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: Import destructured +# key: ids +# -- +import { $1 } from '$2' \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/rjsx-mode/import-react b/emacs/.emacs.d/snippets/rjsx-mode/import-react new file mode 100644 index 0000000000..0463f5cd55 --- /dev/null +++ b/emacs/.emacs.d/snippets/rjsx-mode/import-react @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: Import React dependency (ES6) +# key: ir +# -- +import React from 'react' diff --git a/emacs/.emacs.d/snippets/rjsx-mode/import-type b/emacs/.emacs.d/snippets/rjsx-mode/import-type new file mode 100644 index 0000000000..fcd51f687b --- /dev/null +++ b/emacs/.emacs.d/snippets/rjsx-mode/import-type @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: import type +# key: ixt +# -- +import type { $1 } from '$2' \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/rjsx-mode/import-x-from-y b/emacs/.emacs.d/snippets/rjsx-mode/import-x-from-y new file mode 100644 index 0000000000..09fa6df505 --- /dev/null +++ b/emacs/.emacs.d/snippets/rjsx-mode/import-x-from-y @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: import x from y +# key: ix +# -- +import $1 from '$2' \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/rjsx-mode/import-y b/emacs/.emacs.d/snippets/rjsx-mode/import-y new file mode 100644 index 0000000000..9f550e300d --- /dev/null +++ b/emacs/.emacs.d/snippets/rjsx-mode/import-y @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: import y +# key: iy +# -- +import '$1' \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/rjsx-mode/jest-describe-test b/emacs/.emacs.d/snippets/rjsx-mode/jest-describe-test new file mode 100644 index 0000000000..ed382d4f74 --- /dev/null +++ b/emacs/.emacs.d/snippets/rjsx-mode/jest-describe-test @@ -0,0 +1,10 @@ +# -*- mode: snippet -*- +# name: Jest describe/test block +# key: dsc +# -- +describe('$1', () => { + test('$2', () => { + + expect($3).toEqual($4) + }) +}) \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/rjsx-mode/jest-test b/emacs/.emacs.d/snippets/rjsx-mode/jest-test new file mode 100644 index 0000000000..12ca2e786d --- /dev/null +++ b/emacs/.emacs.d/snippets/rjsx-mode/jest-test @@ -0,0 +1,7 @@ +# -*- mode: snippet -*- +# name: Jest / Jasmine test +# key: tst +# -- +test('$1', () => { + expect($2).toBe($3) +}) \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/rjsx-mode/react-class-component b/emacs/.emacs.d/snippets/rjsx-mode/react-class-component new file mode 100644 index 0000000000..f2a93a31d9 --- /dev/null +++ b/emacs/.emacs.d/snippets/rjsx-mode/react-class-component @@ -0,0 +1,11 @@ +# -*- mode: snippet -*- +# name: React class extends +# key: clz +# -- +class $1 extends React.Component { + render() { + $2 + } +} + +export default $1 \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/rjsx-mode/redux-action b/emacs/.emacs.d/snippets/rjsx-mode/redux-action new file mode 100644 index 0000000000..7d24ffee41 --- /dev/null +++ b/emacs/.emacs.d/snippets/rjsx-mode/redux-action @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: redux-action +# key: rax +# -- +export const ${1:$$(string/lower->caps yas-text)} = '`(downcase (buffer-dirname))`/${1:$(string/caps->kebab yas-text)}' \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/rjsx-mode/typed-redux-action b/emacs/.emacs.d/snippets/rjsx-mode/typed-redux-action new file mode 100644 index 0000000000..c50e1f9d2e --- /dev/null +++ b/emacs/.emacs.d/snippets/rjsx-mode/typed-redux-action @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: typed-redux-action +# key: trax +# -- +export const ${1:$$(string/lower->caps yas-text)}: '`(downcase (buffer-dirname))`/${1:$(string/caps->kebab yas-text)}' = '`(downcase (buffer-dirname))`/${1:$(string/caps->kebab yas-text)}' \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/rust-mode/.yas-parents b/emacs/.emacs.d/snippets/rust-mode/.yas-parents new file mode 100644 index 0000000000..d58dacb7a0 --- /dev/null +++ b/emacs/.emacs.d/snippets/rust-mode/.yas-parents @@ -0,0 +1 @@ +text-mode \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/rust-mode/for-loop b/emacs/.emacs.d/snippets/rust-mode/for-loop new file mode 100644 index 0000000000..4d8e0e3bbd --- /dev/null +++ b/emacs/.emacs.d/snippets/rust-mode/for-loop @@ -0,0 +1,7 @@ +# -*- mode: snippet -*- +# name: for-loop +# key: for +# -- +for $1 in $2 { + $3 +} \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/rust-mode/match b/emacs/.emacs.d/snippets/rust-mode/match new file mode 100644 index 0000000000..bf0e876e2b --- /dev/null +++ b/emacs/.emacs.d/snippets/rust-mode/match @@ -0,0 +1,7 @@ +# -*- mode: snippet -*- +# name: match +# key: match +# -- +match $1 { + $2 => $3, +} \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/sh-mode/.yas-parents b/emacs/.emacs.d/snippets/sh-mode/.yas-parents new file mode 100644 index 0000000000..d58dacb7a0 --- /dev/null +++ b/emacs/.emacs.d/snippets/sh-mode/.yas-parents @@ -0,0 +1 @@ +text-mode \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/sh-mode/function b/emacs/.emacs.d/snippets/sh-mode/function new file mode 100644 index 0000000000..efa946bb27 --- /dev/null +++ b/emacs/.emacs.d/snippets/sh-mode/function @@ -0,0 +1,7 @@ +# -*- mode: snippet -*- +# name: Create function +# key: fn +# -- +$1() { + $2 +} \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/text-mode/.yas-parents b/emacs/.emacs.d/snippets/text-mode/.yas-parents new file mode 100644 index 0000000000..d58dacb7a0 --- /dev/null +++ b/emacs/.emacs.d/snippets/text-mode/.yas-parents @@ -0,0 +1 @@ +text-mode \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/text-mode/check-mark b/emacs/.emacs.d/snippets/text-mode/check-mark new file mode 100644 index 0000000000..7977819688 --- /dev/null +++ b/emacs/.emacs.d/snippets/text-mode/check-mark @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: Unicode checkmark +# key: uck +# -- +✓ \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/text-mode/x-mark b/emacs/.emacs.d/snippets/text-mode/x-mark new file mode 100644 index 0000000000..bc3c356a61 --- /dev/null +++ b/emacs/.emacs.d/snippets/text-mode/x-mark @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: Unicode ex-mark +# key: ux +# -- +✗ \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/web-mode/.yas-parents b/emacs/.emacs.d/snippets/web-mode/.yas-parents new file mode 100644 index 0000000000..d58dacb7a0 --- /dev/null +++ b/emacs/.emacs.d/snippets/web-mode/.yas-parents @@ -0,0 +1 @@ +text-mode \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/web-mode/header b/emacs/.emacs.d/snippets/web-mode/header new file mode 100644 index 0000000000..ae59c7a50f --- /dev/null +++ b/emacs/.emacs.d/snippets/web-mode/header @@ -0,0 +1,7 @@ +# -*- mode: snippet -*- +# name: Header +# key: hdr +# -- +/******************************************************************************* + * $1 + ******************************************************************************/ \ No newline at end of file diff --git a/emacs/.emacs.d/snippets/web-mode/index-boilerplate b/emacs/.emacs.d/snippets/web-mode/index-boilerplate new file mode 100644 index 0000000000..b791cdf86f --- /dev/null +++ b/emacs/.emacs.d/snippets/web-mode/index-boilerplate @@ -0,0 +1,18 @@ +# -*- mode: snippet -*- +# name: HTML index.html starter +# key: html +# -- + + + + + + $1 + + + + + + + + diff --git a/emacs/.emacs.d/vendor/dired+.el b/emacs/.emacs.d/vendor/dired+.el new file mode 100644 index 0000000000..2403b0af9c --- /dev/null +++ b/emacs/.emacs.d/vendor/dired+.el @@ -0,0 +1,13696 @@ +;;; dired+.el --- Extensions to Dired. +;; +;; Filename: dired+.el +;; Description: Extensions to Dired. +;; Author: Drew Adams +;; Maintainer: Drew Adams (concat "drew.adams" "@" "oracle" ".com") +;; Copyright (C) 1999-2019, Drew Adams, all rights reserved. +;; Created: Fri Mar 19 15:58:58 1999 +;; Version: 2019.04.21 +;; Package-Requires: () +;; Last-Updated: Sun Jul 21 09:47:33 2019 (-0700) +;; By: dradams +;; Update #: 11727 +;; URL: https://www.emacswiki.org/emacs/download/dired%2b.el +;; Doc URL: https://www.emacswiki.org/emacs/DiredPlus +;; Keywords: unix, mouse, directories, diredp, dired +;; Compatibility: GNU Emacs: 20.x, 21.x, 22.x, 23.x, 24.x, 25.x, 26.x +;; +;; Features that might be required by this library: +;; +;; `apropos', `apropos+', `autofit-frame', `avoid', `backquote', +;; `bookmark', `bookmark+', `bookmark+-1', `bookmark+-bmu', +;; `bookmark+-key', `bookmark+-lit', `button', `bytecomp', `cconv', +;; `cl', `cl-lib', `cmds-menu', `col-highlight', `crosshairs', +;; `dired', `dired+', `dired-aux', `dired-loaddefs', `dired-x', +;; `easymenu', `fit-frame', `font-lock', `font-lock+', +;; `format-spec', `frame-fns', `gv', `help+', `help-fns', +;; `help-fns+', `help-macro', `help-macro+', `help-mode', +;; `highlight', `hl-line', `hl-line+', `image', `image-dired', +;; `image-file', `image-mode', `info', `info+', `kmacro', +;; `macroexp', `menu-bar', `menu-bar+', `misc-cmds', `misc-fns', +;; `naked', `pp', `pp+', `radix-tree', `replace', `second-sel', +;; `strings', `syntax', `text-mode', `thingatpt', `thingatpt+', +;; `vline', `w32-browser', `w32browser-dlgopen', `wid-edit', +;; `wid-edit+', `widget'. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: +;; +;; Extensions to Dired. +;; +;; This file extends functionalities provided by standard GNU Emacs +;; files `dired.el', `dired-aux.el', and `dired-x.el'. +;; +;; Key bindings changed. Menus redefined. `diredp-mouse-3-menu' +;; popup menu added. New commands. Some commands enhanced. +;; +;; All of the new functions, variables, and faces defined here have +;; the prefix `diredp-' (for Dired Plus) in their names. +;; +;; +;; Wraparound Navigation +;; --------------------- +;; +;; In vanilla Dired, `dired-next-marked-file' (`M-}' or `* C-n') and +;; `dired-previous-marked-file' (`M-{' or `* C-p') wrap around when +;; you get to the end or the beginning of the Dired buffer. Handy. +;; +;; But the other navigation commands do not wrap around. In `Dired+' +;; they do, provided option `diredp-wrap-around-flag' is non-nil, +;; which it is by default. This means the following commands: +;; +;; `diredp-next-line' - `n', `C-n', `down', `SPC' +;; `diredp-previous-line' - `p', `C-p', `up' +;; `diredp-next-dirline' - `>' +;; `diredp-prev-dirline' - `<' +;; `diredp-next-subdir' - `C-M-n' +;; `diredp-prev-subdir' - `C-M-p' +;; +;; +;; Quick Viewing While Navigating +;; ------------------------------ +;; +;; You can use key `C-down' or `C-up' to navigate to the next or +;; previous file line, respectively, and at the same time show its +;; file in another window. The focus remains on the Dired buffer. +;; A numeric prefix arg means move that many lines first. +;; +;; Names of files and directories that match either of the options +;; `diredp-visit-ignore-extensions' or `diredp-visit-ignore-regexps' +;; are skipped. +;; +;; You can use `e' to show the file of the current line. If it is +;; already shown in the same frame, and if Dired is the only other +;; window there, then the file is hidden (its window is deleted). +;; +;; +;; Font-Lock Highlighting +;; ---------------------- +;; +;; If you want a maximum or minimum fontification for Dired mode, +;; then customize option `font-lock-maximum-decoration'. If you want +;; a different fontification level for Dired than for other modes, +;; you can do this too by customizing +;; `font-lock-maximize-decoration'. +;; +;; A few of the user options defined here have an effect on +;; font-locking, and this effect is established only when Dired+ is +;; loaded, which defines the font-lock keywords for Dired. These +;; options include `diredp-compressed-extensions', +;; `diredp-ignore-compressed-flag', `dired-omit-extensions', and +;; `diredp-omit-files-regexp'. This means that if you change the +;; value of such an option then you will see the change only in a new +;; Emacs session. +;; +;; (You can see the effect in the same session if you use `C-M-x' on +;; the `defvar' sexp for `diredp-font-lock-keywords-1', and then you +;; toggle font-lock off and back on.) +;; +;; +;; Act on All Files +;; ---------------- +;; +;; Most of the commands (such as `C' and `M-g') that operate on the +;; marked files have the added feature here that multiple `C-u' use +;; not the files that are marked or the next or previous N files, but +;; *all* of the files in the Dired buffer. Just what "all" files +;; means changes with the number of `C-u', as follows: +;; +;; `C-u C-u' - Use all files present, but no directories. +;; `C-u C-u C-u' - Use all files and dirs except `.' and `..'. +;; `C-u C-u C-u C-u' - use all files and dirs, `.' and `..'. +;; +;; (More than four `C-u' act the same as two.) +;; +;; This feature can be particularly useful when you have a Dired +;; buffer with files chosen from multiple directories. +;; +;; Note that in most cases this behavior is described only in the doc +;; string of function `dired-get-marked-files'. It is generally +;; *not* described in the doc strings of the various commands, +;; because that would require redefining each command separately +;; here. Instead, we redefine macro `dired-map-over-marks' and +;; function `dired-get-filename' in order to achieve this effect. +;; +;; Commands such as `dired-do-load' for which it does not make sense +;; to act on directories generally treat more than two `C-u' the same +;; as two `C-u'. +;; +;; Exceptions to the general behavior described here are called out +;; in the doc strings. In particular, the behavior of a prefix arg +;; for `dired-do-query-replace-regexp' is different, so that you can +;; use it also to specify word-delimited replacement. +;; +;; +;; Act on Marked (or All) Files Here and Below +;; ------------------------------------------- +;; +;; The prefix argument behavior just described does not apply to the +;; `diredp-*-recursive' commands. These commands act on the marked +;; files in the current Dired buffer or on all files in the directory +;; if none are marked. +;; +;; But these commands also handle marked subdirectories recursively, +;; in the same way. That is, they act also on the marked files in +;; any marked subdirectories, found recursively. If such a +;; descendant directory is listed in a Dired buffer then its marked +;; files and subdirs are handled the same way. If there is no Dired +;; buffer that lists a given marked subdirectory then all of its +;; files and subdirs are acted on. +;; +;; For most such here-and-below commands, a prefix argument means +;; ignore all marks. The commands then act on all files in the +;; current Dired buffer and all of its subdirectories, recursively. +;; +;; But here-and-below commands that unmark or change marks act +;; differently for different kinds of prefix argument: +;; +;; * A non-positive prefix arg means ignore subdir markings and act +;; instead on ALL subdirs. +;; +;; * A non-negative prefix arg means do not change marks on subdirs +;; themselves. +;; +;; For example, `M-+ U' removes all marks, including from marked +;; subdirs, recursively. `C-- M-+ U' removes them from all files in +;; all subdirs (marked or not), recursively. `C-9 M-+ U' removes all +;; marks, recursively, except the marks on subdirs themselves. `C-0 +;; M-+ U' acts like those two combined: it descends everywhere, +;; ignoring which subdirs are marked, but it does not remove marks +;; from subdirs themselves. +;; +;; All of the `diredp-*-recursive' commands are on prefix key `M-+', +;; and most are available on submenu `Marked Here and Below' of the +;; `Multiple' menu-bar menu. The commands that unmark and change +;; marks are also in submenu `Here and Below' of menu-bar menu +;; `Marks'. +;; +;; If you use library `Icicles' then you have the following +;; additional commands/keys that act recursively on marked files. +;; They are in the `Icicles' submenu of menu `Multiple' > `Marked +;; Here and Below'. +;; +;; * `M-+ M-s M-s' or `M-s M-s m' - Use Icicles search (and its +;; on-demand replace) on the marked files. +;; +;; * Save the names of the marked files: +;; +;; `M-+ C-M->' - Save as a completion set, for use during +;; completion (e.g. with `C-x C-f'). +;; +;; `M-+ C->' - Add marked names to the names in the current saved +;; completion set. +;; +;; `M-+ C-}' - Save persistently to an Icicles cache file, for +;; use during completion in another session. +;; +;; `icicle-dired-save-marked-to-fileset-recursive' - Like `M-+ +;; C-}', but save persistently to an Emacs fileset. +;; +;; `M-+ C-M-}' - Save to a Lisp variable. +;; +;; +;; In the other direction, if you have a saved set of file names then +;; you can use `C-M-<' (`icicle-dired-chosen-files-other-window') in +;; Dired to open a Dired buffer for just those files. So you can +;; mark some files and subdirs in a hierarchy of Dired buffers, use +;; `M-+ C-}' to save their names persistently, then later use `C-{' +;; to retrieve them, and `C-M-<' (in Dired) to open Dired on them. +;; +;; +;; Image Files +;; ----------- +;; +;; `Dired+' provides several enhancements regarding image files. +;; Most of these require standard library `image-dired.el'. One of +;; them, command `diredp-do-display-images', which displays all of +;; the marked image files, requires standard library `image-file.el'. +;; +;; `Dired+' loads these libraries automatically, if available, which +;; means an Emacs version that supports image display (Emacs 22 or +;; later). (You must of course have installed whatever else your +;; Emacs version needs to display images.) +;; +;; Besides command `diredp-do-display-images', see the commands whose +;; names have prefix `diredp-image-'. And see options +;; `diredp-image-preview-in-tooltip' and +;; `diredp-auto-focus-frame-for-thumbnail-tooltip-flag'. +;; +;; +;; Inserted Subdirs, Multiple Dired Buffers, Files from Anywhere,... +;; ----------------------------------------------------------------- +;; +;; These three standard Dired features are worth pointing out. The +;; third in particular is little known because (a) it is limited in +;; vanilla Dired and (b) you cannot use it interactively. +;; +;; * You can pass a glob pattern with wildcards to `dired' +;; interactively, as the file name. +;; +;; * You can insert multiple subdirectory listings into a single +;; Dired buffer using `i' on each subdir line. Use `C-u i' to +;; specify `ls' switches. Specifying switch `R' inserts the +;; inserted subdirectory's subdirs also, recursively. You can +;; also use `i' to bounce between a subdirectory line and its +;; inserted-listing header line. You can delete a subdir listing +;; using `C-u k' on its header line. You can hide/show an +;; inserted subdir using `$'. You can use `C-_' to undo any of +;; these operations. +;; +;; * You can open a Dired buffer for an arbitrary set of files from +;; different directories. You do this by invoking `dired' +;; non-interactively, passing it a cons of a Dired buffer name and +;; the file names. Relative file names are interpreted relative +;; to the value of `default-directory'. Use absolute file names +;; when appropriate. +;; +;; `Dired+' makes these features more useful. +;; +;; `$' is improved: It is a simple toggle - it does not move the +;; cursor forward. `M-$' advances the cursor, in addition to +;; toggling like `$'. `C-u $' does hide/show all (what `M-$' does in +;; vanilla Dired). +;; +;; `i' is improved in these ways: +;; +;; * Once a subdir has been inserted, `i' bounces between the subdir +;; listing and the subdir line in the parent listing. If the +;; parent dir is hidden, then `i' from a subdir opens the parent +;; listing so it can move to the subdir line there (Emacs 24+). +;; +;; * Vanilla Dired lets you create a Dired listing with files and +;; directories from arbitrary locations, but you cannot insert +;; (`i') such a directory if it is not in the same directory tree +;; as the `default-directory' used to create the Dired buffer. +;; `Dired+' removes this limitation; you can insert any non-root +;; directories (that is, not `/', `c:/', etc.). +;; +;; `Dired+' lets you create Dired buffers that contain arbitrary +;; files and directories interactively, not just using Lisp. Just +;; use a non-positive prefix arg (e.g., `C--') when invoking `dired'. +;; +;; You are then prompted for the Dired buffer name (anything you +;; like, not necessarily a directory name) and the individual files +;; and directories that you want listed. +;; +;; A non-negative prefix arg still prompts you for the `ls' switches +;; to use. (So `C-0' does both: prompts for `ls' switches and for +;; the Dired buffer name and the files to list.) +;; +;; `Dired+' adds commands for combining and augmenting Dired +;; listings: +;; +;; * `diredp-add-to-dired-buffer', bound globally to `C-x D A', lets +;; you add arbitrary file and directory names to an existing Dired +;; buffer. +;; +;; * `diredp-dired-union', bound globally to `C-x D U', lets you +;; take the union of multiple Dired listings, or convert an +;; ordinary Dired listing to an explicit list of absolute file +;; names. With a non-positive prefix arg, you can add extra file +;; and directory names, just as for `diredp-add-to-dired-buffer'. +;; +;; You can optionally add a header line to a Dired buffer using +;; toggle command `diredp-breadcrumbs-in-header-line-mode'. (A +;; header line remains at the top of the window - no need to scroll +;; to see it.) If you want to show the header line automatically in +;; all Dired buffers, you can do this: +;; +;; (add-hook 'dired-before-readin-hook +;; 'diredp-breadcrumbs-in-header-line-mode) +;; +;; Some other libraries, such as `Bookmark+' and `Icicles', make it +;; easy to create or re-create Dired buffers that list specific files +;; and have a particular set of markings. `Bookmark+' records Dired +;; buffers persistently, remembering `ls' switches, markings, subdir +;; insertions, and hidden subdirs. If you use `Icicles' then `dired' +;; is a multi-command: you can open multiple Dired buffers with one +;; `dired' invocation. +;; +;; Dired can help you manage projects. You might have multiple Dired +;; buffers with quite specific contents. You might have some +;; subdirectories inserted in the same Dired buffer, and you might +;; have separate Dired buffers for some subdirectories. Sometimes it +;; is useful to have both for the same subdirectory. And sometimes +;; it is useful to move from one presentation to the other. +;; +;; This is one motivation for the `Dired+' `diredp-*-recursive' +;; commands, which act on the marked files in marked subdirectories, +;; recursively. In one sense, these commands are an alternative to +;; using a single Dired buffer with inserted subdirectories. They +;; let you use the same operations on the files in a set of Dired +;; directories, without inserting those directories into an ancestor +;; Dired buffer. +;; +;; You can use command `diredp-dired-inserted-subdirs' to open a +;; separate Dired buffer for each of the subdirs that is inserted in +;; the current Dired buffer. Markings and Dired switches are +;; preserved. +;; +;; In the opposite direction, if you use `Icicles' then you can use +;; multi-command `icicle-dired-insert-as-subdir', which lets you +;; insert any number of directories you choose interactively into a +;; Dired ancestor directory listing. If a directory you choose to +;; insert already has its own Dired buffer, then its markings and +;; switches are preserved for the new, subdirectory listing in the +;; ancestor Dired buffer. +;; +;; +;; Hide/Show Details +;; ----------------- +;; +;; Starting with Emacs 24.4, listing details are hidden by default. +;; Note that this is different from the vanilla Emacs behavior, which +;; is to show details by default. +;; +;; Use `(' anytime to toggle this hiding. You can use option +;; `diredp-hide-details-initially-flag' to change the default/initial +;; state. See also option `diredp-hide-details-propagate-flag'. +;; +;; NOTE: If you do not want to hide details initially then you must +;; either (1) change `diredp-hide-details-initially-flag' using +;; Customize (recommended) or (2) set it to `nil' (e.g., using +;; `setq') *BEFORE* loading `dired+.el'. +;; +;; If you have an Emacs version older than 24.4, you can use library +;; `dired-details+.el' (plus `dired-details.el') to get similar +;; behavior. +;; +;; +;; Mode-Line +;; --------- +;; +;; The number of files and dirs that are marked with `*', and the +;; number that are flagged for deletion (marked `D') are indicated in +;; the mode-line. When the cursor is on such a line the indication +;; tells you how many more there are. For example, if the cursor is +;; on the line of the third file that is marked `*', and there are +;; seven of them total, then the mode-line shows `3/7*'. +;; +;; The mode-line also indicates, for the current listing (which could +;; be a subdir listing), how many files and dirs are listed. If the +;; cursor is on the 27th file in a listing of 78 files then the +;; mode-line shows 27/78. +;; +;; For counting files and dirs in a listing, option +;; `diredp-count-.-and-..-flag' controls whether to count the lines +;; for `.' and `..'. By default it is nil, meaning they are not +;; counted. +;; +;; +;; If You Use Dired+ in Terminal Mode +;; ---------------------------------- +;; +;; By default, Dired+ binds some keys that can be problematic in some +;; terminals when you use Emacs in terminal mode (i.e., `emacs -nw'). +;; This is controlled by option +;; `diredp-bind-problematic-terminal-keys'. +;; +;; In particular, keys that use modifiers Meta and Shift together can +;; be problematic. If you use Dired+ in text-only terminal, and you +;; find that your terminal does not support such keys, then you might +;; want to customize the option to set the value to `nil', and then +;; bind the commands to some other keys, which your terminal +;; supports. +;; +;; The problematic keys used by Dired+ include these: +;; +;; `M-M' (aka `M-S-m') - `diredp-chmod-this-file' +;; `M-O' (aka `M-S-o') - `diredp-chown-this-file' +;; `M-T' (aka `M-S-t') - `diredp-touch-this-file' +;; `C-M-B' (aka `C-M-S-b') - `diredp-do-bookmark-in-bookmark-file' +;; `C-M-G' (aka `C-M-S-g') - `diredp-chgrp-this-file' +;; `C-M-R' (aka `C-M-S-r') - `diredp-toggle-find-file-reuse-dir' +;; `C-M-T' (aka `C-M-S-t') - `dired-do-touch' +;; `M-+ M-B' (aka `M-+ M-S-b') - +;; `diredp-do-bookmark-dirs-recursive' +;; `M-+ C-M-B' (aka `M-+ C-M-S-b') - +;; `diredp-do-bookmark-in-bookmark-file-recursive' +;; `M-+ C-M-T' (aka `M-+ C-M-S-t') - `diredp-do-touch-recursive' +;; +;; (See also `(info "(org) TTY keys")' for more information about +;; keys that can be problematic in a text-only terminal.) +;; +;; +;; Faces defined here: +;; +;; `diredp-autofile-name', `diredp-compressed-file-suffix', +;; `diredp-date-time', `diredp-deletion', +;; `diredp-deletion-file-name', `diredp-dir-heading', +;; `diredp-dir-priv', `diredp-exec-priv', `diredp-executable-tag', +;; `diredp-file-name', `diredp-file-suffix', `diredp-flag-mark', +;; `diredp-flag-mark-line', `diredp-get-file-or-dir-name', +;; `diredp-ignored-file-name', `diredp-link-priv', +;; `diredp-mode-line-flagged', `diredp-mode-line-marked' +;; `diredp-omit-file-name', `diredp-no-priv', `diredp-number', +;; `diredp-other-priv', `diredp-rare-priv', `diredp-read-priv', +;; `diredp-symlink', `diredp-tagged-autofile-name', +;; `diredp-write-priv'. +;; +;; Commands defined here: +;; +;; `diredp-add-to-dired-buffer', `diredp-add-to-this-dired-buffer', +;; `diredp-do-apply-function', +;; `diredp-do-apply-function-recursive', +;; `diredp-async-shell-command-this-file', +;; `diredp-bookmark-this-file', +;; `diredp-breadcrumbs-in-header-line-mode' (Emacs 22+), +;; `diredp-byte-compile-this-file', `diredp-capitalize', +;; `diredp-capitalize-recursive', `diredp-capitalize-this-file', +;; `diredp-change-marks-recursive' (Emacs 22+), +;; `diredp-chgrp-this-file', `diredp-chmod-this-file', +;; `diredp-chown-this-file', +;; `diredp-compilation-files-other-window' (Emacs 24+), +;; `diredp-compress-this-file', +;; `diredp-copy-abs-filenames-as-kill', +;; `diredp-copy-abs-filenames-as-kill-recursive', +;; `diredp-copy-filename-as-kill-recursive', +;; `diredp-copy-tags-this-file', `diredp-copy-this-file', +;; `diredp-decrypt-this-file', `diredp-delete-this-file', +;; `diredp-describe-autofile', `diredp-describe-file', +;; `diredp-describe-marked-autofiles', `diredp-describe-mode', +;; `diredp-dired-for-files', `diredp-dired-for-files-other-window', +;; `diredp-dired-inserted-subdirs', `diredp-dired-plus-help', +;; `diredp-dired-recent-dirs', +;; `diredp-dired-recent-dirs-other-window', +;; `diredp-dired-this-subdir', `diredp-dired-union', +;; `diredp-do-async-shell-command-recursive', `diredp-do-bookmark', +;; `diredp-do-bookmark-dirs-recursive', +;; `diredp-do-bookmark-in-bookmark-file', +;; `diredp-do-bookmark-in-bookmark-file-recursive', +;; `diredp-do-bookmark-recursive', `diredp-do-chmod-recursive', +;; `diredp-do-chgrp-recursive', `diredp-do-chown-recursive', +;; `diredp-do-copy-recursive', `diredp-do-decrypt-recursive', +;; `diredp-do-delete-recursive', `diredp-do-display-images' (Emacs +;; 22+), `diredp-do-emacs-command', `diredp-do-encrypt-recursive', +;; `diredp-do-find-marked-files-recursive', `diredp-do-grep', +;; `diredp-do-grep-recursive', `diredp-do-hardlink-recursive', +;; `diredp-do-isearch-recursive', +;; `diredp-do-isearch-regexp-recursive', `diredp-do-lisp-sexp' +;; (Emacs 22+), `diredp-do-move-recursive', +;; `diredp-do-paste-add-tags', `diredp-do-paste-replace-tags', +;; `diredp-do-print-recursive', +;; `diredp-do-query-replace-regexp-recursive', +;; `diredp-do-redisplay-recursive', +;; `diredp-do-relsymlink-recursive', `diredp-do-remove-all-tags', +;; `diredp-do-search-recursive', `diredp-do-set-tag-value', +;; `diredp-do-shell-command-recursive', `diredp-do-sign-recursive', +;; `diredp-do-symlink-recursive', `diredp-do-tag', +;; `diredp-do-touch-recursive', `diredp-do-untag', +;; `diredp-do-verify-recursive', `diredp-downcase-recursive', +;; `diredp-downcase-this-file', `diredp-ediff', +;; `diredp-encrypt-this-file', `diredp-fileset', +;; `diredp-fileset-other-window', `diredp-find-a-file', +;; `diredp-find-a-file-other-frame', +;; `diredp-find-a-file-other-window', +;; `diredp-find-file-other-frame', +;; `diredp-find-file-reuse-dir-buffer', +;; `diredp-find-line-file-other-window', +;; `diredp-flag-auto-save-files-recursive', +;; `diredp-flag-region-files-for-deletion', +;; `diredp-grepped-files-other-window', `diredp-grep-this-file', +;; `diredp-hardlink-this-file', `diredp-highlight-autofiles-mode', +;; `diredp-image-dired-comment-file', +;; `diredp-image-dired-comment-files-recursive', +;; `diredp-image-dired-copy-with-exif-name', +;; `diredp-image-dired-create-thumb', +;; `diredp-image-dired-delete-tag', +;; `diredp-image-dired-delete-tag-recursive', +;; `diredp-image-dired-display-thumb', +;; `diredp-image-dired-display-thumbs-recursive', +;; `diredp-image-dired-edit-comment-and-tags', +;; `diredp-image-dired-tag-file', +;; `diredp-image-dired-tag-files-recursive', +;; `diredp-image-show-this-file', `diredp-insert-as-subdir', +;; `diredp-insert-subdirs', `diredp-insert-subdirs-recursive', +;; `diredp-kill-this-tree', `diredp-list-marked-recursive', +;; `diredp-load-this-file', `diredp-mark-autofiles', +;; `diredp-marked', `diredp-marked-other-window', +;; `diredp-marked-recursive', +;; `diredp-marked-recursive-other-window', +;; `diredp-mark-extension-recursive', +;; `diredp-mark-files-containing-regexp-recursive', +;; `diredp-mark-files-regexp-recursive', +;; `diredp-mark-files-tagged-all', `diredp-mark-files-tagged-none', +;; `diredp-mark-files-tagged-not-all', +;; `diredp-mark-files-tagged-some', +;; `diredp-mark-files-tagged-regexp', `diredp-mark-region-files', +;; `diredp-mark-sexp-recursive' (Emacs 22+), +;; `diredp-mark/unmark-autofiles', `diredp-mark/unmark-extension', +;; `diredp-mouse-3-menu', `diredp-mouse-backup-diff', +;; `diredp-mouse-copy-tags', `diredp-mouse-describe-autofile', +;; `diredp-mouse-describe-file', `diredp-mouse-diff', +;; `diredp-mouse-do-bookmark', `diredp-mouse-do-byte-compile', +;; `diredp-mouse-do-chgrp', `diredp-mouse-do-chmod', +;; `diredp-mouse-do-chown', `diredp-mouse-do-compress', +;; `diredp-mouse-do-copy', `diredp-mouse-do-delete', +;; `diredp-mouse-do-grep', `diredp-mouse-do-hardlink', +;; `diredp-mouse-do-load', `diredp-mouse-do-print', +;; `diredp-mouse-do-remove-all-tags', `diredp-mouse-do-rename', +;; `diredp-mouse-do-set-tag-value', +;; `diredp-mouse-do-shell-command', `diredp-mouse-do-symlink', +;; `diredp-mouse-do-tag', `diredp-mouse-do-untag', +;; `diredp-mouse-downcase', `diredp-mouse-ediff', +;; `diredp-mouse-find-line-file-other-window', +;; `diredp-mouse-find-file-other-frame', +;; `diredp-mouse-find-file-reuse-dir-buffer', +;; `diredp-mouse-flag-file-deletion', `diredp-mouse-mark', +;; `diredp-mouse-mark-region-files', `diredp-mouse-mark/unmark', +;; `diredp-mouse-unmark', `diredp-mouse-upcase', +;; `diredp-mouse-view-file', `diredp-move-file' (Emacs 24+), +;; `diredp-multiple-w32-browser-recursive', +;; `diredp-nb-marked-in-mode-name', `diredp-next-dirline', +;; `diredp-next-line', `diredp-next-subdir', `diredp-omit-marked', +;; `diredp-omit-unmarked', `diredp-paste-add-tags-this-file', +;; `diredp-paste-files', `diredp-paste-replace-tags-this-file', +;; `diredp-prev-dirline', `diredp-previous-line', +;; `diredp-prev-subdir', `diredp-print-this-file', +;; `diredp-relsymlink-this-file', +;; `diredp-remove-all-tags-this-file', `diredp-rename-this-file', +;; `diredp-send-bug-report', +;; `diredp-set-bookmark-file-bookmark-for-marked', +;; `diredp-set-bookmark-file-bookmark-for-marked-recursive', +;; `diredp-set-tag-value-this-file', +;; `diredp-shell-command-this-file', `diredp-show-metadata', +;; `diredp-show-metadata-for-marked', `diredp-sign-this-file', +;; `diredp-symlink-this-file', `diredp-tag-this-file', +;; `diredp-toggle-find-file-reuse-dir', +;; `diredp-toggle-marks-in-region', `diredp-touch-this-file', +;; `diredp-unmark-all-files-recursive' (Emacs 22+), +;; `diredp-unmark-all-marks-recursive' (Emacs 22+), +;; `diredp-unmark-autofiles', `diredp-unmark-files-tagged-all', +;; `diredp-unmark-files-tagged-none', +;; `diredp-unmark-files-tagged-not-all', +;; `diredp-unmark-files-tagged-some', `diredp-unmark-region-files', +;; `diredp-untag-this-file', `diredp-upcase-recursive', +;; `diredp-up-directory', `diredp-up-directory-reuse-dir-buffer', +;; `diredp-upcase-this-file', `diredp-verify-this-file', +;; `diredp-visit-next-file', `diredp-visit-previous-file', +;; `diredp-visit-this-file', `diredp-w32-drives', +;; `diredp-w32-drives-mode', `diredp-yank-files', +;; `global-dired-hide-details-mode' (Emacs 24.4+), +;; `toggle-diredp-find-file-reuse-dir'. +;; +;; User options defined here: +;; +;; `diredp-auto-focus-frame-for-thumbnail-tooltip-flag', +;; `diredp-bind-problematic-terminal-keys', +;; `diredp-compressed-extensions', `diredp-count-.-and-..-flag' +;; (Emacs 22+), `diredp-do-report-echo-limit', +;; `diredp-dwim-any-frame-flag' (Emacs 22+), +;; `diredp-image-preview-in-tooltip', `diff-switches', +;; `diredp-hide-details-initially-flag' (Emacs 24.4+), +;; `diredp-highlight-autofiles-mode', +;; `diredp-hide-details-propagate-flag' (Emacs 24.4+), +;; `diredp-ignore-compressed-flag', +;; `diredp-image-show-this-file-use-frame-flag' (Emacs 22+), +;; `diredp-list-file-attributes', `diredp-max-frames', +;; `diredp-move-file-dirs' (Emacs 24+), `diredp-omit-files-regexp' +;; `diredp-prompt-for-bookmark-prefix-flag', +;; `diredp-visit-ignore-extensions', `diredp-visit-ignore-regexps', +;; `diredp-w32-local-drives', `diredp-wrap-around-flag'. +;; +;; Non-interactive functions defined here: +;; +;; `derived-mode-p' (Emacs < 22), `diredp-all-files', +;; `diredp-ancestor-dirs', `diredp-apply-function-to-file-name', +;; `diredp-bookmark', +;; `diredp-create-files-non-directory-recursive', +;; `diredp-delete-dups', `diredp-delete-if', +;; `diredp-delete-if-not', `diredp-directories-within', +;; `diredp-dired-plus-description', +;; `diredp-dired-plus-description+links', +;; `diredp-dired-plus-help-link', `diredp-dired-union-1', +;; `diredp-dired-union-interactive-spec', `diredp-display-image' +;; (Emacs 22+), `diredp-do-chxxx-recursive', +;; `diredp-do-create-files-recursive', `diredp-do-grep-1', +;; `diredp-ensure-bookmark+', `diredp-ensure-mode', +;; `diredp-eval-lisp-sexp' (Emacs 22+), +;; `diredp-existing-dired-buffer-p', `diredp-fewer-than-2-files-p', +;; `diredp-fewer-than-echo-limit-files-p', +;; `diredp-fewer-than-N-files-p', `diredp-fileset-1', +;; `diredp-find-a-file-read-args', +;; `diredp-file-for-compilation-hit-at-point' (Emacs 24+), +;; `diredp-files-within', `diredp-files-within-1', +;; `diredp-fit-frame-unless-buffer-narrowed' (Emacs 24.4+), +;; `diredp-get-confirmation-recursive', `diredp-get-files', +;; `diredp-get-files-for-dir', `diredp-get-subdirs', +;; `diredp-hide-details-if-dired' (Emacs 24.4+), +;; `diredp-hide/show-details' (Emacs 24.4+), +;; `diredp-highlight-autofiles', `diredp-image-dired-required-msg', +;; `diredp-get-image-filename', `diredp-internal-do-deletions', +;; `diredp-invoke-emacs-command', `diredp-invoke-function-no-args', +;; `diredp-list-file', `diredp-list-files', `diredp-looking-at-p', +;; `diredp-make-find-file-keys-reuse-dirs', +;; `diredp-make-find-file-keys-not-reuse-dirs', `diredp-maplist', +;; `diredp-map-over-marks-and-report', `diredp-marked-here', +;; `diredp-mark-files-tagged-all/none', +;; `diredp-mark-files-tagged-some/not-all', +;; `diredp-nonempty-region-p', `diredp-parent-dir', +;; `diredp-paste-add-tags', `diredp-paste-replace-tags', +;; `diredp-read-bookmark-file-args', `diredp-read-command', +;; `diredp-read-expression' (Emacs 22+), +;; `diredp-read-include/exclude', `diredp-read-regexp', +;; `diredp-recent-dirs', `diredp-refontify-buffer', +;; `diredp-remove-if', `diredp-remove-if-not', +;; `diredp-report-file-result', `diredp--reuse-dir-buffer-helper', +;; `diredp-root-directory-p', `diredp-set-header-line-breadcrumbs' +;; (Emacs 22+), `diredp-set-tag-value', `diredp-set-union', +;; `diredp--set-up-font-locking', `diredp-string-match-p', +;; `diredp-tag', `diredp-this-file-marked-p', +;; `diredp-this-file-unmarked-p', `diredp-this-subdir', +;; `diredp-untag', `diredp-visit-ignore-regexp', +;; `diredp-y-or-n-files-p'. +;; +;; Variables defined here: +;; +;; `diredp-bookmark-menu', `diredp-file-line-overlay', +;; `diredp-files-within-dirs-done', `diredp-font-lock-keywords-1', +;; `diredp-hide-details-last-state' (Emacs 24.4+), +;; `diredp-hide-details-toggled' (Emacs 24.4+), +;; `diredp-hide/show-menu', `diredp-images-recursive-menu', +;; `diredp-last-copied-filenames', `diredp-list-files-map', +;; `diredp-loaded-p', `diredp-marks-recursive-menu', +;; `diredp-menu-bar-dir-menu', `diredp-menu-bar-marks-menu', +;; `diredp-menu-bar-multiple-menu', `diredp-menu-bar-regexp-menu', +;; `diredp-menu-bar-single-menu', `diredp-multiple-bookmarks-menu', +;; `diredp-multiple-delete-menu', `diredp-multiple-dired-menu', +;; `diredp-multiple-images-menu', +;; `diredp-multiple-encryption-menu', +;; `diredp-multiple-move-copy-link-menu', +;; `diredp-multiple-omit-menu', `diredp-multiple-recursive-menu', +;; `diredp-multiple-rename-menu', `diredp-multiple-search-menu', +;; `diredp-navigate-menu', `diredp-regexp-recursive-menu', +;; `diredp-re-no-dot', `diredp-single-bookmarks-menu', +;; `diredp-single-encryption-menu', `diredp-single-image-menu', +;; `diredp-single-move-copy-link-menu', `diredp-single-open-menu', +;; `diredp-single-rename-menu', `diredp-w32-drives-mode-map'. +;; +;; Macros defined here: +;; +;; `diredp-mark-if', `diredp-user-error', +;; `diredp-with-help-window'. +;; +;; +;; ***** NOTE: The following macros defined in `dired.el' have +;; been REDEFINED HERE: +;; +;; `dired-map-over-marks' - Treat multiple `C-u' specially. +;; +;; +;; ***** NOTE: The following functions defined in `dired.el' have +;; been REDEFINED or ADVISED HERE: +;; +;; `dired' - Handle non-positive prefix arg. +;; `dired-do-delete' - Display message to warn that marked, +;; not flagged, files will be deleted. +;; `dired-do-flagged-delete' - Display message to warn that flagged, +;; not marked, files will be deleted. +;; `dired-dwim-target-directory' - Uses `diredp-dwim-any-frame-flag'. +;; `dired-find-file' - Allow `.' and `..' (Emacs 20 only). +;; `dired-get-filename' - Test `./' and `../' (like `.', `..'). +;; `dired-get-marked-files' - Can include `.' and `..'. +;; Allow FILTER + DISTINGUISH-ONE-MARKED. +;; `dired-goto-file' - Fix Emacs bug #7126. +;; Remove `/' from dir before compare. +;; (Emacs < 24 only.) +;; `dired-hide-details-mode' - Respect new user options: +;; * `diredp-hide-details-initially-flag' +;; * `diredp-hide-details-propagate-flag' +;; (Emacs 24.4+) +;; `dired-insert-directory' - Compute WILDCARD arg for +;; `insert-directory' for individual file +;; (don't just use nil). (Emacs 23+, and +;; only for MS Windows) +;; `dired-insert-set-properties' - `mouse-face' on whole line. +;; `dired-flag-auto-save-files', `dired-mark-directories', +;; `dired-mark-executables', `dired-mark-files-containing-regexp', +;; `dired-mark-files-regexp', `dired-mark-symlinks' +;; - Use `diredp-mark-if', not `dired-mark-if'. +;; `dired-mark-files-regexp' - Add regexp to `regexp-search-ring'. +;; More matching possibilities. +;; Added optional arg LOCALP. +;; `dired-mark-pop-up' - Delete the window or frame popped up, +;; afterward, and bury its buffer. Do not +;; show a menu bar for pop-up frame. +;; `dired-other-frame' - Handle non-positive prefix arg. +;; `dired-other-window' - Handle non-positive prefix arg. +;; `dired-pop-to-buffer' - Put window point at bob (bug #12281). +;; (Emacs 22-24.1) +;; `dired-read-dir-and-switches' - Non-positive prefix arg behavior. +;; +;;; NOT YET: +;;; ;; `dired-readin-insert' - Use t as WILDCARD arg to +;;; ;; `dired-insert-directory'. (Emacs 23+, +;;; ;; and only for MS Windows) +;; +;; `dired-revert' - Reset `mode-line-process' to nil. +;; `dired-switches-escape-p' - Made compatible with Emacs 20, 21. +;; +;; +;; ***** NOTE: The following functions are included here with little +;; or no change to their definitions. They are here to +;; take advantage of the new definition of macro +;; `dired-map-over-marks': +;; +;; `dired-do-redisplay', `dired-map-over-marks-check', +;; `image-dired-dired-insert-marked-thumbs', +;; `image-dired-dired-toggle-marked-thumbs'. +;; +;; +;; ***** NOTE: The following functions defined in `dired-aux.el' have +;; been REDEFINED HERE: +;; +;; `dired-do-byte-compile', `dired-do-compress', `dired-do-load' - +;; Redisplay only if at most one file is being treated. +;; `dired-do-find-regexp', `dired-do-find-regexp-and-replace' - +;; Prefix arg lets you act on files other than those marked. +;; `dired-do-isearch', `dired-do-isearch-regexp', +;; `dired-do-query-replace-regexp', `dired-do-search' - +;; Use new `dired-get-marked-files'. +;; `dired-insert-subdir-newpos' - If not a descendant, put at eob. +;; `dired-insert-subdir-validate' - Do nothing: no restrictions. +;; `dired-maybe-insert-subdir' - Go back to subdir line if in listing. +;; `dired-handle-overwrite' - Added optional arg FROM, for listing. +;; `dired-copy-file(-recursive)', `dired-hardlink', `dired-query', +;; `dired-rename-file' - You can list (`l') the files involved. +;; +;; +;; ***** NOTE: The following functions defined in `dired-x.el' have +;; been REDEFINED HERE: +;; +;; `dired-copy-filename-as-kill' - +;; Put file names also in var `diredp-last-copied-filenames'. +;; `dired-do-find-marked-files' - +;; Call `dired-get-marked-files' with original ARG. +;; Added optional arg INTERACTIVEP - no error if nil and no files. +;; `dired-do-run-mail' - Require confirmation. +;; `dired-mark-sexp' - 1. Variable `s' -> `blks'. +;; 2. Fixes to `uid' and `gid'. +;; `dired-mark-unmarked-files' (Emacs < 24 only) - Emacs 24+ version. +;; `dired-simultaneous-find-file' - +;; Use separate frames instead of windows if `pop-up-frames' is +;; non-nil, or if prefix arg < 0. +;; +;; +;; ***** NOTE: (Emacs 20 only) The following variable defined in +;; `dired.el' has been REDEFINED HERE: +;; +;; `dired-move-to-filename-regexp' - Recognize file size in k etc. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Change Log: +;; +;; 2019/07/03 dadams +;; dired-mark-unmarked-files: Apply fix for Emacs bug #27465. +;; diredp-mark-if, diredp-mark-sexp(-recursive), dired-mark-unmarked-files: +;; Use char-after, not diredp-looking-at-p. +;; 2019/07/19 dadams +;; diredp-change-marks-recursive, diredp-unmark-all-files-recursive, +;; diredp-mark-files(-containing)-regexp-recursive, diredp-mark-sexp-recursive, diredp-mark-recursive-1: +;; Added missing PREDICATE arg in calls to diredp-get-subdirs. +;; 2019/06/25 dadams +;; diredp-mark-if, diredp-this-file-(un)marked-p: Use regexp-quote for marker char. +;; 2019/06/03 dadams +;; Removed autoload cookie for diredp-omit-files-regexp - it evaluates dired-omit-files, from dired-x.el. +;; Hard-require dired-x.el. (No reason not to.) Removed fboundp guards for it. +;; 2019/04/22 dadams +;; Added diredp-move-files-named-in-kill-ring. Bound to C-w. +;; 2019/04/21 dadams +;; Added redefinitions of dired-do-find-regexp, dired-do-find-regexp-and-replace. +;; diredp-multiple-search-menu: Added "Using TAGS Table" for dired-do-(query-replace|search). +;; 2019/04/20 dadams +;; Added: +;; diredp-map-over-marks-and-report, diredp-do-emacs-command, diredp-invoke-emacs-command, +;; diredp-read-command, diredp-do-lisp-sexp, diredp-eval-lisp-sexp, diredp-report-file-result, +;; diredp-do-report-echo-limit, diredp-fewer-than-N-files-p, diredp-fewer-than-echo-limit-files-p, +;; diredp-apply-function-to-file-name, diredp-invoke-function-no-args, diredp-list-file-attributes. +;; diredp-do-apply-function: Redefine to use diredp-map-over-marks-and-report. +;; diredp-dired-plus-description, diredp-menu-bar-multiple-menu: +;; Added diredp-do-emacs-command, diredp-do-lisp-sexp. +;; diredp-menu-bar-multiple-menu: Reordered items. +;; diredp-list-marked, diredp-*-recursive, diredp-describe-marked-autofiles: +;; Use diredp-list-file-attributes for DETAILS arg interactively. +;; diredp-yank-files, dired-query: Use diredp-list-file-attributes, not harcoded list (5 8). +;; diredp-set-bookmark-file-bookmark-for-marked-recursive: Corrected interactive spec. +;; 2019/04/16 dadams +;; Added: diredp-delete-if. +;; dired-map-over-marks-check: Added &rest argument FUN-ARGS, so FUN can accept arguments. +;; 2019/04/12 dadams +;; dired-get-marked-files: Do not add t to RESULT. Thx to Jeff Spencer for bug report. +;; If all marked is (t) for some reason reset it to nil, per vanilla Emacs 24+. +;; diredp-compressed-extensions: Added .rar, .rev. +;; 2019/04/10 dadams +;; Added diredp-read-expression (forgot it when added diredp-mark-sexp-recursive). +;; diredp-mark-sexp-recursive is thus only for Emacs 22+. +;; 2019/03/20 dadams +;; Added option diredp-omit-files-regexp. +;; Face diredp-omit-file-name: Added strike-through. +;; diredp-font-lock-keywords-1, for face diredp-omit-file-name: +;; Move to file name. Use diredp-omit-files-regexp. Append * for executable flag. Highlight whole line. +;; 2019/03/17 dadams +;; diredp-font-lock-keywords-1: +;; Use just dired-omit-files as regexp - its components already have ^...$. +;; Removed superfluous execute *'s in regexps and superfluous concat for compressed extensions. +;; Face diredp-omit-file-name: Removed :strike-through for default value. +;; 2019/03/16 dadms +;; Added face diredp-omit-file-name. +;; diredp-font-lock-keywords-1: Use face diredp-omit-file-name for dired-omit-files matches. +;; 2019/03/15 dadams +;; diredp-font-lock-keywords-1: Treat dired-omit-files like dired-omit-extensions. +;; 2019/01/27 dadams +;; Added: diredp-mark-files-containing-regexp-recursive. +;; Bound to M-+ % g. Added to diredp-marks-recursive-menu, diredp-regexp-recursive-menu. +;; 2019/01/17 dadams +;; Added: diredp-mark-sexp-recursive. Bound to M-+ M-(, M-+ * (. Added to diredp-marks-recursive-menu. +;; dired-query: Use dired-query-alist only when available. +;; diredp-move-file: Fix format string in error call. +;; diredp-mark-symlinks-recursive: Added missing DETAILS arg for diredp-mark-recursive-1. +;; 2019/01/01 dadams +;; Added: diredp-list-file. +;; Added redefinitions of dired-query, dired-handle-overwrite, dired-copy-file(-recursive), dired-rename-file, +;; dired-hardlink. +;; Added optional arg DETAILS to these functions: diredp-get-(subdirs|files), diredp-y-or-n-files-p, +;; diredp-list-(marked|files), diredp-yank-files, diredp-describe-marked-autofiles, plus all functions with +;; "recursive" in their name except diredp-get-confirmation-recursive. +;; Added optional arg DETAILS. +;; diredp-get-(subdirs|files), diredp-y-or-n-files-p, diredp-list-(marked|files), diredp-yank-files, +;; diredp-describe-marked-autofiles: +;; Added optional arg DETAILS. +;; diredp-list-files: Use dired-list-file, to optionally show details. +;; diredp-yank-files: Non-positive prefix arg shows details now. +;; 2018/12/02 dadams +;; dired-mark-pop-up: Work around Emacs 22 bug in dired-pop-to-buffer which can exit in Dired buffer. +;; 2018/10/17 dadams +;; dired-read-dir-and-switches: Removed mention of icicle-file-sort-first-time-p (no longer used in Icicles). +;; 2018/09/21 dadams +;; diredp-image-dired-edit-comment-and-tags, diredp-w32-drives: +;; Use pop-to-buffer-same-window, not switch-to-buffer. +;; 2018/09/14 dadams +;; Added: diredp-move-file-dirs, diredp-move-file. +;; 2018/06/30 dadams +;; Added: diredp-delete-if-not. +;; 2018/06/16 dadams +;; Added: diredp-visit-ignore-extensions, diredp-visit-ignore-regexps, diredp-visit-next-file, +;; diredp-visit-previous-file, diredp-visit-this-file, diredp-visit-ignore-regexp. +;; Bind the commands to C-down, C-up, e. +;; 2018/03/25 dadams +;; Added: diredp-user-error. +;; Updated for Emacs 27-pretest-2 change in dired-get-marked-files signature. +;; dired-get-marked-files: Added optional arg ERROR-IF-NONE-P. +;; diredp-list-marked, diredp-insert-subdirs, dired-do-(i)search(-regexp), dired-do-query-replace-regexp, +;; dired-do-find-marked-files, diredp-describe-marked-autofiles: +;; Added optional arg INTERACTIVEP. +;; Pass non-nil ERROR-IF-NONE-P to dired-get-marked-files when INTERACTIVEP. (See Emacs bug #30938.) +;; 2018/03/23 dadams +;; Added diredp-mark-if. Removed: redefinition of dired-mark-if. +;; Differences: msg and return value include both number of matches and number of changes. +;; Added redefinitions (use diredp-mark-if) of dired-flag-auto-save-files, +;; dired-mark-(files-containing-regexp|symlinks|directories|executables). +;; Everywhere: Use diredp-mark-if, not dired-mark-if. +;; 2018/03/03 dadams +;; diredp-delete-dups: defalias the symbol, not its symbol-function (dunno why I did the latter). +;; 2018/02/28 dadams +;; Added: diredp-last-copied-filenames, diredp-copy-abs-filenames-as-kill-recursive, +;; and redefinition of vanilla diredp-last-copied-filenames. +;; diredp-copy-abs-filenames-as-kill: Use diredp-ensure-mode in interactive spec. +;; diredp-copy-filename-as-kill-recursive: Update diredp-last-copied-filenames with filenames string. +;; diredp-yank-files: Require confirmation for pasting, using diredp-y-or-n-files-p. +;; Get file names from variable diredp-last-copied-filenames, not kill-ring. +;; Added NO-CONFIRM-P arg. +;; diredp-ensure-mode: Added doc string. +;; diredp-do-grep, diredp-do-grep-recursive: Changed bindings to C-M-G and M-+ C-M-G, due to M-g conflict. +;; 2018/02/27 dadams +;; Added: diredp-copy-abs-filenames-as-kill, diredp-yank-files (aka diredp-paste-files) (bound to C-y). +;; diredp-menu-bar-multiple-menu: Added diredp-copy-abs-filenames-as-kill. +;; diredp-menu-bar-dir-menu: Added diredp-yank-files. +;; 2018/01/11 dadams +;; diredp-get-files: +;; Set IGNORE-MARKS-P to non-nil if nothing marked here. (It was not getting all if nothing marked.) +;; diredp-marked-recursive(-other-window): +;; Corrected interactive spec, which was missing nil DIRNAME arg. Corrected body: use DIRNAME. +;; diredp-get-files-for-dir, diredp-do-bookmark-dirs-recursive, diredp-change-marks-recursive, +;; diredp-unmark-all-files-recursive, diredp-mark-files-regexp-recursive, diredp-mark-recursive-1, +;; diredp-do-delete-recursive: +;; Factor out (dired-buffers-for-dir (expand-file-name directory)). +;; 2018/01/03 dadams +;; dired-mark-files-regexp: Corrected doc string wrt prefix args. Thx to John Mastro. +;; diredp-do-grep-recursive: Removed unused optional arg IGNORE-MARKS-P. +;; diredp-marked-recursive(-other-window): Moved handling of optional arg from interactive spec to body. +;; 2018/01/02 dadams +;; Added: diredp-flag-auto-save-files-recursive. Bound to M-+ #. +;; diredp-get-file-or-dir-name, diredp-marked-here: Doubled backslashes to escape dots. +;; diredp-marked-here: Fixed regexp to match only double-dot, not single-dot. +;; diredp-flag-auto-save-files-recursive: Updated to include more M-+ keys. +;; diredp-marks-recursive-menu: Added diredp-flag-auto-save-files-recursive. +;; 2017/12/31 dadams +;; diredp-get-files-for-dir: Pass non-nil NO-DOT-DOT-P arg to diredp-marked-here. +;; dired-get-marked-files: Allow use of FILTER and DISTINGUISH-ONE-MARKED together. +;; diredp-marked-here: Added optional arg NO-DOT-DOT-P. +;; diredp-change-marks-recursive, diredp-unmark-all-files-recursive: Removed unused vars include-dirs, files. +;; 2017/12/30 dadams +;; Added: diredp-change-marks-recursive, diredp-unmark-all-files-recursive, diredp-unmark-all-marks-recursive. +;; Bound to M-+ * c, M-+ M-DEL, M-+ U, respectively. +;; diredp-menu-bar-marks-menu: Rename item Change Marks to Change Mark. +;; diredp-marks-recursive-menu, diredp-multiple-recursive-menu: +;; Added diredp-change-marks-recursive, diredp-unmark-all-(files|marks)-recursive. +;; 2017/12/21 dadams +;; Added: diredp-mark-recursive-1. Forgot to add it last June. +;; 2017/12/17 dadams +;; Removed: diredp-display-graphic-p. +;; Do not use diredp-display-graphic-p to allow binding diredp-bind-problematic-terminal-keys by default. +;; 2017/11/25 dadams +;; diredp-nb-marked-in-mode-name: Wrap last :eval sexp in save-excursion. +;; Protect Call dired-current-directory only when dired-subdir-alist. +;; 2017/10/23 dadams +;; Added: diredp-count-.-and-..-flag, diredp--reuse-dir-buffer-helper. +;; Removed: diredp-mouse-find-file. +;; diredp-find-file-reuse-dir-buffer, diredp-mouse-find-file-reuse-dir-buffer, +;; diredp-up-directory-reuse-dir-buffer: +;; Use diredp--reuse-dir-buffer-helper. +;; diredp-find-file-reuse-dir-buffer: Changed logic: do find-alternate-file only if target is a dir not in +;; Dired and current Dired buffer is in only this window. +;; diredp-mouse-find-file-reuse-dir-buffer: Added optional args FIND-FILE-FUNC and FIND-DIR-FUNC. +;; diredp-up-directory, diredp-up-directory-reuse-dir-buffer: Pass OTHER-WINDOW arg to diredp-w32-drives. +;; diredp-nb-marked-in-mode-name: Show also number of lines in current listing, and listing-relative lineno, +;; respecting diredp-count-.-and-..-flag. +;; diredp-find-a-file*: Added autoload cookies. +;; 2017/08/18 dadams +;; Fixed emacswiki URLs everywhere. They changed the locations and changed http to https. +;; 2017/06/30 dadams +;; Added: diredp-bind-problematic-terminal-keys, diredp-display-graphic-p. +;; Guard bindings of problematic keys with diredp-display-graphic-p & diredp-bind-problematic-terminal-keys. +;; Documented problematic keys for terminal mode in commentary. +;; 2017/06/23 dadams +;; Added: diredp-read-regexp (removed alias to read-regexp), diredp-marks-recursive-menu, +;; diredp-mark-executables-recursive (bound to M-+ * *), +;; diredp-mark-directories-recursive (bound to M-+ * /), +;; diredp-mark-extension-recursive (bound to M-+ * .), +;; diredp-mark-autofiles-recursive (bound to M-+ * B), +;; diredp-mark-executables-recursive (bound to M-+ * *), +;; diredp-mark-directories-recursive (bound to M-+ * /), +;; diredp-mark-symlinks-recursive (bound to M-+ * @), +;; Bind diredp-mark-autofiles to * B. +;; diredp-marked-here: Bind dired-marker-char to ?*. +;; diredp-mark-files-regexp-recursive: Better msgs - show total count. +;; Everywhere: Use diredp-looking-at, not looking-at. Use diredp-read-regexp, not dired-read-regexp. +;; 2017/05/30 dadams +;; Fixed typo: direp--set-up-font-locking -> diredp--set-up-font-locking. +;; 2017/05/22 dadams +;; Added: direp--set-up-font-locking. +;; Use direp--set-up-font-locking instead of lambda in dired-mode-hook. +;; 2017/04/09 dadams +;; Version 2017.04.09. +;; Added: diredp-multiple-move-copy-link-menu, diredp-multiple-rename-menu, diredp-multiple-dired-menu, +;; diredp-multiple-omit-menu, diredp-multiple-delete-menu, diredp-single-bookmarks-menu, +;; diredp-single-encryption-menu, diredp-single-image-menu, diredp-single-open-menu, +;; diredp-single-move-copy-link-menu, diredp-single-rename-menu. +;; Moved single menu items there. +;; Renamed: diredp-menu-bar-encryption-menu to diredp-multiple-encryption-menu, +;; diredp-menu-bar-mark-menu to diredp-menu-bar-marks-menu, +;; diredp-menu-bar-operate-menu to diredp-menu-bar-multiple-menu, +;; diredp-menu-bar-operate-bookmarks-menu to diredp-multiple-bookmarks-menu, +;; diredp-menu-bar-operate-recursive-menu to diredp-multiple-recursive-menu, +;; diredp-menu-bar-operate-search-menu to diredp-multiple-search-menu, +;; diredp-menu-bar-images-menu to diredp-multiple-images-menu, +;; diredp-menu-bar-images-recursive-menu to diredp-images-recursive-menu, +;; diredp-menu-bar-immediate-menu to diredp-menu-bar-single-menu, +;; diredp-menu-bar-regexp-recursive-menu to diredp-regexp-recursive-menu, +;; diredp-menu-bar-subdir-menu to diredp-menu-bar-dir-menu. +;; Added dired-do-rename to diredp-multiple-rename-menu. +;; diredp-nonempty-region-p: Ensure (mark) also. +;; 2017/03/30 dadams +;; Moved key bindings to end of file. Moved defgroup before defcustoms. +;; Bind dired-multiple-w32-browser to C-M-RET, diredp-multiple-w32-browser-recursive to M-+ C-M-RET. +;; 2017/03/29 dadams +;; Added: diredp-dired-union-other-window, diredp-add-to-dired-buffer-other-window. +;; diredp-dired-union-1: Added optional arg OTHERWIN. +;; diredp-dired-plus-description: Updated doc string. +;; diredp-menu-bar-subdir-menu: Added diredp-dired-for-files. +;; Bind diredp-w32-drives to :/, diredp-dired-inserted-subdirs to C-M-i. +;; Bind diredp-add-to-dired-buffer to C-x D A (not C-x E), diredp-dired-union to C-x D U (not C-x D), +;; diredp-fileset to C-x D S (not C-M-f), diredp-dired-recent-dirs to C-x D R (not C-x R), +;; diredp-dired-for-files to C-x D F, plus other-window versions. +;; 2017/03/24 dadams +;; Added defalias for dired-read-regexp. +;; diredp-mouse-3-menu: Removed second arg to mouse-save-then-kill. +;; 2017/02/20 dadams +;; diredp-(next|previous)-line, diredp-(next|prev)-dirline, diredp-(next|prev)-subdir: +;; Update interactive spec to use (in effect) ^p for prefix arg (for shift-select-mode). +;; 2017/01/12 dadams +;; dired-mark-files-regexp: Swapped prefix-arg behavior for relative and absolute name matching. +;; 2017/01/01 dadams +;; dired-mark-files-regexp: Fix to prompt for no prefix arg. +;; 2016/12/28 dadams +;; dired-mark-files-regexp: Corrected prompt string for Mark/UNmark. Thx to Tino Calancha. +;; 2016/11/20 dadams +;; diredp-menu-bar-operate-search-menu: Added dired-do-find-regexp and dired-do-find-regexp-and-replace. +;; Bind dired-do-search to M-a and dired-do-query(-replace)-regexp to M-q. +;; diredp-dired-plus-description: Added dired-do-find-regexp and dired-do-find-regexp-and-replace. +;; 2016/10/12 dadams +;; diredp-compressed-extensions: Added extensions .xz and .lzma. Thx to xuhdev (https://www.topbug.net/). +;; 2016/09/20 dadams +;; Emacs 25.1: Bind M-z to dired-do-compress-to (replaces c). (Emacs bug #24484.) +;; diredp-menu-bar-operate-menu: Added item: Compress to (dired-do-compress-to). +;; 2016/09/15 dadams +;; Added: diredp-max-frames. +;; dired-do-find-marked-files: Pass non-nil ARG to dired-get-marked-files only if it is a cons. +;; Clarified doc string wrt prefix arg. +;; dired-simultaneous-find-file: Require confirmation if more files than diredp-max-frames. +;; diredp-do-find-marked-files-recursive: Clarified doc string wrt prefix arg. +;; Thx to Tino Calancha. +;; 2016/09/14 dadams +;; diredp-dired-plus-description: Added entry for dired-hide-details-mode - ( key. +;; 2016/08/26 dadams +;; diredp-y-or-n-files-p: pop-to-buffer only when the buffer was created. +;; Update wrt vanilla (scroll actions). +;; diredp-do-query-replace-regexp-recursive: +;; Call diredp-get-confirmation-recursive. +;; Use only diredp-get-files, not dired-get-marked-files. +;; Non-positive prefix arg means DELIMITED. +;; 2016/08/08 dadams +;; diredp-menu-bar-mark-menu: +;; Added: dired-mark-files-containing-regexp, dired-mark-sexp, image-dired-mark-tagged-files, +;; 2016/05/28 dadams +;; diredp-mark-files-regexp-recursive: Use nil for dired-get-filename LOCALP arg. +;; dired-mark-files-regexp: Corrected doc string: absolute filename matching by default. +;; 2016/05/24 dadams +;; dired-mark-files-regexp: Added optional arg LOCALP, so can mark/unmark matching different file-name forms. +;; 2016/05/15 dadams +;; Added: diredp-bookmark-menu, diredp-hide/show-menu, diredp-navigate-menu. +;; Move insert after revert and rename it to Insert/Move-To This Subdir. Move create-directory before revert. +;; 2016/04/29 dadams +;; diredp-next-line: Respect goal-column. +;; 2016/01/24 dadams +;; Added: diredp-ensure-bookmark+, diredp-mark-autofiles, diredp-unmark-autofiles, +;; diredp-mark/unmark-autofiles, diredp-describe-autofile, diredp-show-metadata, +;; diredp-mouse-describe-autofile, diredp-describe-marked-autofiles, diredp-show-metadata-for-marked +;; Soft-require help-fns+.el (Emacs 22+) or help+20.el (Emacs 20-21). +;; Add to menu-bar menus: +;; diredp-(un)mark-autofiles, diredp-describe-autofile, diredp-describe-marked-autofiles. +;; diredp-menu-bar-immediate-menu: Add diredp-describe-file only if defined. +;; Bind diredp-describe-file to keys only if defined. +;; Use diredp-ensure-bookmark+ everywhere, instead of its definition. +;; diredp(-mouse)-describe-file: Define only if describe-file is defined. Removed raising error if not. +;; diredp-mouse-3-menu: Use diredp-describe-autofile if diredp-describe-file is not defined. +;; diredp-dired-plus-description: Add diredp-mouse-describe-autofile, when bound. +;; dired-mark-if: Do not count non-changes. +;; 2015/12/15 dadams +;; diredp-font-lock-keywords-1: Follow # with optional [/ ], for face diredp-number. Thx to Tino Calancha. +;; 2015/11/10 dadams +;; diredp-fileset(-other-window): Separate error msgs for unloaded filesets.el and empty filesets-data. +;; 2015/10/02 dadams +;; dired-mark-sexp: Like vanilla, skip extended attributes marker before setting NLINK. Thx to Tino Calancha. +;; 2015/09/29 dadams +;; diredp-delete-this-file: Redefined to use delete-file instead of dired-do-delete. +;; 2015/09/07 dadams +;; diredp-font-lock-keywords-1: Do not test diredp-ignore-compressed-flag when highlighting file names. +;; Use separate entries for compressed and non-compressed file names. +;; Added missing \\| before ignored compressed extensions. +;; 2015/09/06 dadams +;; diredp-compressed-extensions: Added .tgz. Removed duplicate .gz. +;; diredp-font-lock-keywords-1: Use regexp-opt where possible, instead of mapcar regexp-quote. +;; 2015/09/05 dadams +;; Added: diredp-compressed-extensions, diredp-ignore-compressed-flag, diredp-compressed-file-name, +;; diredp-dir-name. +;; diredp-font-lock-keywords-1: +;; Allow spaces in symlink names. Highlight compressed-file names, if diredp-ignore-compressed-flag. +;; Use diredp-compressed-extensions instead of hardcoding extensions. +;; Highlight d with diredp-dir-priv (fix). +;; Treat l in third column the same as - and d there. +;; Highlight whole line for D-flagged files, with face diredp-deletion-file-name. +;; Thx to Nick Helm. +;; 2015/08/30 dadams +;; dired-mark-sexp: Updated per Emacs 25 code. +;; 2015/07/30 dadams +;; diredp-fileset(-other-window): Changed key binding from C-x F to C-x C-M-f (conflicted with find-function). +;; 2015/06/24 dadams +;; Added: diredp-parent-dir, diredp-breadcrumbs-in-header-line-mode, diredp-set-header-line-breadcrumbs. +;; 2015/06/06 dadams +;; Added dired-other-(frame|window). +;; diredp-font-lock-keywords-1: +;; Use dired-re-maybe-mark and dired-re-inode-size for permission matchings and directory names. +;; dired(-other-(frame|window)) advice: +;; Add interactive spec, to handle arg <= 0 (broken by change to dired-read-dir-and-switches 2015/02/02). +;; diredp-dired-for-files: Typo: pass empy string. +;; 2015/06/05 dadams +;; Added: diredp-grepped-files-other-window as alias for diredp-compilation-files-other-window. +;; diredp-compilation-files-other-window: Added SWITCHES optional arg (prefix arg). +;; 2015/06/04 dadams +;; diredp-dired-for-files(-other-window): +;; Updated to fit change to dired-read-dir-and-switches made 2015/02/02: addition of READ-EXTRA-FILES-P. +;; Use prefix arg to prompt for switches. +;; 2015/05/31 dadams +;; Added: diredp-image-show-this-file,diredp-image-show-this-file-use-frame-flag, diredp-get-image-filename. +;; image-dired-dired-toggle-marked-thumbs, diredp-menu-bar-immediate-menu [image]: +;; Use diredp-get-image-filename. +;; Bound diredp-image-show-this-file to C-t I. +;; diredp-menu-bar-immediate-image-menu: Added diredp-image-show-this-file and dired-find-file. +;; Added autoload cookies for image commands. +;; 2015/04/16 dadams +;; Added: diredp-do-apply-function, diredp-do-apply-function-recursive. Added to menus. Bind to @, M-+ @. +;; dired-do-query-replace-regexp: Handle nil ARG properly. +;; 2015/03/26 dadams +;; Added: redefinitions of dired-do-isearch, dired-do-isearch-regexp, dired-do-query-replace-regexp, +;; dired-do-search, to handle multi-C-u. +;; Added: dired-nondirectory-p (Emacs 20), diredp-refontify-buffer. +;; dired-do-byte-compile, dired-do-load, : Corrected interactive spec, to treat more than two C-u as two. +;; dired-after-readin-hook: Add diredp-refontify-buffer. In particular, this ensures that reverting Dired +;; for a listing of explicit file names gets refontified. (Just turn-on-font-lock does not refontify.) +;; 2015/03/24 dadams +;; Added: diredp-compilation-files-other-window, diredp-file-for-compilation-hit-at-point. +;; 2015/03/06 dadams +;; Renamed: diredp-menu-bar-recursive-marked-menu to diredp-menu-bar-operate-recursive-menu. +;; Added: diredp-do-delete-recursive: M-+ D. Added to diredp-menu-bar-operate-recursive-menu. +;; Added: diredp-mark-files-regexp-recursive: M-+ % m. Added to diredp-menu-bar-regexp-recursive-menu. +;; 2015/03/04 dadams +;; Added: diredp-dwim-any-frame-flag, (redefinition of) dired-dwim-target-directory. +;; 2015/02/22 dadams +;; diredp-bookmark: Corrected for use without Bookmark+ - bookmark-store signature. +;; Pass correct value to bmkp-autofile-set for its MSG-P arg. +;; diredp-mouse-do-bookmark: Do not pass non-nil NO-MSG-P arg to diredp-bookmark. +;; 2015/02/03 dadams +;; Added: diredp-add-to-this-dired-buffer. +;; Removed: diredp-add-to-dired-buffer-other-window, diredp-dired-union-other-window. +;; diredp-dired-union-1: Removed optional arg OTHER-WINDOW-P. +;; diredp-menu-bar-subdir-menu: Added diredp-add-to-this-dired-buffer. +;; dired-read-dir-and-switches, diredp-dired-union-interactive-spec: +;; Added optional arg DIRED-BUFFER. If nil, use current buffer name as default when reading buffer name. +;; 2015/02/02 dadams +;; Added: diredp-add-to-dired-buffer, diredp-add-to-dired-buffer-other-window, diredp-set-union, +;; diredp-existing-dired-buffer-p. +;; Bind diredp-add-to-dired-buffer(-other-window) globally to C-x E, C-x 4 E. +;; diredp-dired-union(-other-window): +;; Added args DIRNAME and EXTRA. Pass them to diredp-dired-union-1. Moved "UNION" to *-interactive-spec. +;; Pass values for new args NO-DIRED-BUFS and READ-EXTRA-FILES-P to diredp-dired-union-interactive-spec. +;; diredp-dired-union-interactive-spec: +;; Added args NO-DIRED-BUFS and READ-EXTRA-FILES-P. Use (updated) dired-read-dir-and-switches. +;; Delete dead buffers from dired-buffers. Remove DIRNAME buffer as candidate. +;; Apply expand-file-name to default-directory. Return list of DIRNAME BUFS SWITCHES EXTRA-FILES. +;; diredp-dired-union-1: +;; Added args DIRED-NAME and EXTRA. +;; For existing Dired buffer whose dired-directory is a cons: +;; Include its current listing. Replace buffer with new one of same name, after deleting its window. +;; dired-read-dir-and-switches: +;; Added arg READ-EXTRA-FILES-P. +;; If chosen Dired buffer exists and is an ordinary listing then start out with its directory-files. +;; diredp-dired-union, diredp-fileset, diredp-dired-recent-dirs: Bind globally, not just in Dired mode. +;; 2015/01/30 dadams +;; dired-read-dir-and-switches: Remove any killed buffers from dired-buffers, before using for completion. +;; 2014/10/25 dadams +;; diredp-dired-union-interactive-spec: Typo: quote buffer-name-history. Pass other-window STRING. +;; diredp-dired-union-other-window: Pass other-window STRING. +;; dired-read-dir-and-switches: Include STRING for reading buffer name also. +;; dired (defadvice): Corrected doc string for prefix arg >= and <= 0. +;; 2014/10/15 dadams +;; diredp-hide-details-initially-flag: +;; Added :set, to ensure that diredp-hide-details-last-state is kept up-to-date. +;; 2014/09/28 dadams +;; Added: diredp-recent-dirs, diredp-read-include/exclude, diredp-root-directory-p, diredp-remove-if. +;; diredp-dired-recent-dirs(-other-window): Added optional ARG. Use diredp-recent-dirs. Pass SWITCHES. +;; dired-read-dir-and-switches: Use diredp-root-directory-p. +;; Bound diredp-dired-recent-dirs(-other-window) to C-x R and C-x 4 R. +;; Added diredp-dired-recent-dirs to Dir menu. +;; 2014/09/27 dadams +;; Added: diredp-dired-recent-dirs, diredp-dired-recent-dirs-other-window, diredp-delete-dups. +;; 2014/09/26 dadams +;; diredp-mouseover-help: dired-get-filename etc. has to be inside the save-excursion. +;; diredp-image-dired-create-thumb: Added FILE arg. Use numeric prefix arg as the new thumbnail size. +;; 2014/09/22 dadams +;; diredp-mouse-3-menu: Do not place overlay unless on a file/dir name (i.e., dired-get-filename). +;; 2014/09/15 dadams +;; dired-read-dir-and-switches: Made it (thus dired too) an Icicles multi-command. +;; dired (defadvice): Added doc about using it with Icicles. +;; 2014/09/14 dadams +;; Added: diredp-kill-this-tree. +;; Removed: diredp-dired-files(-other-window), diredp-dired-files-interactive-spec. +;; dired-read-dir-and-switches: +;; Based on diredp-dired-files-interactive-spec implementation now, but: +;; Moved unwind-protect outside call to list. completing-read, not read-string, for DIRBUF. +;; Do not allow inclusion of root directories. Protected icicle-sort-comparer with boundp. +;; dired-insert-subdir-validate: Make it a no-op. +;; dired advice (doc string): Mention wildcards, Icicles. +;; diredp-dired-for-files(-other-window): +;; Use dired-read-dir-and-switches and dired, not diredp-dired-files-interactive-spec and +;; diredp-dired-files. +;; diredp-menu-bar-immediate-menu, diredp-mouse-3-menu: +;; Added item for diredp-kill-this-tree. +;; Corrected visible condition: expand-file-name, so ~/ compares with its expansion. +;; diredp-font-lock-keywords-1: Include period (.) for diredp(-compressed)-file-suffix. +;; 2014/09/09 dadams +;; Added: dired-read-dir-and-switches. +;; Advise dired, for doc string. +;; dired-get-filename: Hack for Emacs 20-22, to expand ~/... +;; 2014/09/07 dadams +;; Added: redefinitions of dired-insert-subdir-newpos, dired-insert-subdir-validate. +;; 2014/07/26 dadams +;; diredp-do-find-marked-files-recursive: +;; Only ARG >= 0 ignores marks now. And ARG <= 0 means find but do not display. +;; 2014/07/13 dadams +;; diredp-mouseover-help: Wrap (goto-char pos) in save-excursion (Emacs bug #18011). +;; 2014/07/12 dadams +;; Faces diredp(-tagged)-autofile-name: Made paler/darker (less saturated). +;; Moved diredp-highlight-autofiles before diredp-highlight-autofiles-mode, so will be +;; defined for first revert. +;; diredp-mouse-3-menu: Renamed items Tag, Untag to Add Tags, Remove Tags. +;; diredp-dired-plus-description: Updated. +;; 2014/07/11 dadams +;; Added: diredp-highlight-autofiles-mode, diredp-highlight-autofiles, +;; diredp-autofile-name, diredp-tagged-autofile-name. +;; Soft-require bookmark+.el. Soft-require highlight.el if bookmark+.el is provided. +;; diredp-menu-bar-subdir-menu: Added item Toggle Autofile Highlighting. +;; Removed unused face: diredp-display-msg. +;; 2014/06/29 dadams +;; dired-get-marked-files, diredp-internal-do-deletions: +;; Remove nils from dired-map-over-marks result. +;; 2014/05/28 dadams +;; diredp-mode-line-marked: Use DarkViolet for both light and dark background modes. +;; 2014/05/23 dadams +;; Added: diredp-with-help-window. +;; diredp-list-files, diredp-dired-plus-help: +;; Use diredp-with-help-window, not with-output-to-temp-buffer. See Emacs bug #17109. +;; 2014/05/06 dadams +;; Added: diredp-image-dired-required-msg, diredp-list-files-map, +;; diredp-find-line-file-other-window, diredp-mouse-find-line-file-other-window, +;; image-dired-dired-toggle-marked-thumbs, diredp-list-marked. +;; Soft-require image-dired.el and image-file.el. +;; diredp-image-dired-create-thumb: Define unconditionally. +;; image-dired-dired-insert-marked-thumbs, diredp-image-dired-comment-file, +;; diredp-image-dired-tag-file, diredp-image-dired-delete-tag, +;; diredp-image-dired-display-thumb, diredp-image-dired-copy-with-exif-name, +;; diredp-image-dired-edit-comment-and-tags, diredp-do-display-images: +;; Define unconditionally and raise error if no image-(dired|file).el. +;; diredp-menu-bar-immediate-image-menu, diredp-menu-bar-images-menu, +;; diredp-menu-bar-images-recursive-menu, image-dired-mark-tagged-files: +;; Define unconditionally and use :enable. +;; diredp-menu-bar-images-menu, diredp-menu-bar-images-recursive-menu: +;; Add defalias so can use menu-item with :enable. +;; diredp-list-files: Add properties mouse-face, keymap, and help-echo. +;; diredp-mouseover-help: Make it work also for diredp-list-files listings. +;; image-dired-dired-insert-marked-thumbs: Add autoload cookie. +;; dired-get-marked-files: Pass non-nil 2nd arg to dired-get-filename, to include . and .. . +;; Bind diredp-list-marked to C-M-l and diredp-list-marked-recursive to M+ C-M-l. +;; diredp-insert-subdirs: Exclude . and .., as dired-get-marked-files can now include them. +;; diredp-menu-bar-operate-menu: Add diredp-menu-bar-operate-menu to menu. +;; diredp-dired-plus-description: Mention diredp-list-marked*. +;; 2014/05/03 dadams +;; dired-switches-escape-p: Use dired-switches-check if available, based on bug #17218 fix. +;; 2014/04/25 dadams +;; diredp-image-dired-create-thumb: +;; Do not call diredp-image-dired-create-thumb twice: reuse THUMB-NAME. +;; 2014/04/24 dadams +;; Added: diredp-mouseover-help, diredp-auto-focus-frame-for-thumbnail-tooltip-flag, +;; diredp-image-preview-in-tooltip. +;; dired-insert-set-properties: Show image-file preview in tooltip. +;; diredp-image-dired-create-thumb: Return thumbnail file name or nil. +;; 2014/04/23 dadams +;; Added: diredp-looking-at-p. +;; dired-insert-set-properties: Applied fix for bug #17228. +;; 2014/04/05 dadams +;; Added: diredp-do-bookmark-dirs-recursive. +;; Renamed from bmkp-create-dired-bookmarks-recursive in bookmark+-1.el (removed). +;; Bound to M-B (aka M-S-b). +;; Added to menus *-subdir-menu, *-operate-bookmarks-menu, *-bookmarks-menu. +;; diredp-get-confirmation-recursive: Added optional TYPE arg. +;; diredp-insert-subdirs-recursive: Call diredp-get-confirmation-recursive with TYPE arg. +;; 2014/02/16 dadams +;; dired-pop-to-buffer: Do not redefine for Emacs > 24.1. +;; dired-mark-pop-up: Updated doc string. +;; 2014/02/13 dadams +;; Added: diredp-fileset-other-window, diredp-fileset-1. +;; diredp-fileset: Use diredp-fileset-1. +;; Bind diredp-dired-union(-other-window) to C-x D, C-x 4 D, +;; diredp-fileset(-other-window) to C-x F, C-x 4 F. +;; Use diredp-fileset-other-window, not diredp-fileset, in menu. +;; 2014/02/03 dadams +;; Added: diredp-hide-subdir-nomove. +;; Added: dired-goto-file for Emacs 24+ - open hidden parent dir, so can goto destination. +;; Replace bindings for dired-hide-subdir with diredp-hide-subdir-nomove. +;; Bind dired-hide-subdir to M-$ (not $). +;; 2014/02/02 dadams +;; dired-goto-file: Redefine only for Emacs < 24. +;; 2014/01/15 dadams +;; Bind diredp-toggle-find-file-reuse-dir to C-M-R (aka C-M-S-r). +;; 2014/01/05 dadams +;; Bind dired-omit-mode (aka dired-omit-toggle) to C-x M-o. +;; 2013/12/05 dadams +;; diredp-do-grep-1: Call grep-default-command with arg, if grep+.el is loaded. +;; 2013/11/05 dadams +;; Added: diredp-get-subdirs. +;; diredp-get-files, diredp-get-files-for-dir, diredp-marked-here: Added optional arg NIL-IF-NONE-P. +;; diredp-get-files: Pass INCLUDE-DIRS-P to diredp-files-within. +;; 2013/11/04 dadams +;; Renamed Bookmarks submenus to Bookmark. +;; Added Bookmark Dired Buffer to Dir menu. +;; Alias dired-toggle-marks to dired-do-toggle for Emacs 20, instead of backwards for others. +;; Use dired-toggle-marks everywhere instead of dired-do-toggle. +;; 2013/11/03 dadams +;; Created submenus of Multiple menu: Bookmarks, Search. +;; Created submenus of Multiple > Marked Here and Below menu: +;; Images, Encryption, Search, Bookmarks. +;; Reordered menus. +;; 2013/09/26 dadams +;; diredp-next-line: Use let*, so line-move sees let bindings. +;; 2013/08/11 dadams +;; diredp-dired-files-interactive-spec: +;; Protect icicle-file-sort with boundp. Thx to Vladimir Lomov. +;; 2013/08/06 dadams +;; diredp-display-image,diredp-menu-bar-immediate-image-menu (:enable's): +;; Protect diredp-string-match-p from nil argument. +;; 2013/07/24 dadams +;; Added: diredp-nonempty-region-p. Use everywhere, in place of its definition. +;; 2013/07/21 dadams +;; Added: diredp-image-dired-(comment-file|copy-with-exif-name|(create|display)-thumb| +;; delete-tag|edit-comment-and-tags|tag-file), +;; diredp-string-match-p, diredp-menu-bar-immediate-image-menu. +;; Put this-file image commands on new menu diredp-menu-bar-immediate-image-menu. +;; diredp-menu-bar-images-menu: Added diredp-do-display-images. +;; Use diredp-string-match-p instead of string-match where appropriate. +;; diredp-find-a-file-read-args: Removed #' from lambda. +;; 2013/07/19 dadams +;; Added redefinition of dired-hide-details-mode. +;; Added: diredp-hide-details-propagate-flag, diredp-hide-details-initially-flag, +;; diredp-hide-details-last-state, diredp-hide-details-toggled, +;; diredp-hide-details-if-dired, global-dired-hide-details-mode, +;; diredp-fit-frame-unless-buffer-narrowed, diredp-hide/show-details, +;; diredp-do-display-images, diredp-display-image. +;; On dired-after-readin-hook: diredp-hide/show-details. +;; On dired-hide-details-mode-hook: diredp-fit-frame-unless-buffer-narrowed. +;; diredp-maplist: Use diredp-maplist, not maplist, in recursive call. +;; diredp-next-line: Added bobp test for negative ARG. +;; Emacs 20 line-move returns nil, so use (progn ... t). +;; Soft-require autofit-frame.el. +;; 2013/07/18 dadams +;; diredp-next-line: Protect visible-p with fboundp for Emacs 20. +;; 2013/07/17 dadams +;; Added: diredp-menu-bar-encryption-menu, diredp-menu-bar-images-menu, +;; diredp-menu-bar-immediate-encryption-menu, +;; diredp-(decrypt|verify|sign|encrypt)-this-file. +;; Added diredp-(decrypt|verify|sign|encrypt)-this-file to *-immediate-encryption-menu. +;; Moved encryption and image-dired items to the new Multiple submenus from Multiple menu. +;; 2013/07/15 dadams +;; Added: diredp-async-shell-command-this-file, diredp-do-async-shell-command-recursive. +;; Added them to menus. Bind diredp-do-async-shell-command-recursive to M-+ &. +;; diredp-menu-bar-mark-menu, diredp-dired-plus-description: Added dired-mark-omitted. +;; diredp-menu-bar-subdir-menu: Added dired-omit-mode, dired-hide-details-mode. +;; diredp-menu-bar-regexp-menu: Added image-dired-mark-tagged-files. +;; diredp-menu-bar-subdir-menu: Added dired-hide-details-mode. +;; diredp-shell-command-this-file: Corrected: provide file list to dired-do-shell-command. +;; 2013/07/13 dadams +;; diredp-font-lock-keywords-1: +;; Ensure diredp-dir-priv is not used for directory header of d:/... (Windows drive name). +;; dired-insert-directory: +;; Update wrt Emacs 24.4: Do dired-insert-set-properties last; use saved CONTENT-POINT. +;; dired-insert-set-properties: Updated for Emacs 24.4, for dired-hide-details-mode. +;; Add frame-fitting to dired-hide-details-mode-hook. +;; dired-mouse-find-file(-other-window): Error msg if click off a file name. +;; 2013/07/12 dadams +;; Added: diredp-wrap-around-flag, diredp-(next|previous)-(subdir|(dir)line). +;; Renamed dired-up-directory to diredp-up-directory. +;; Replaced vanilla commands by these new commands everywhere. +;; 2013/07/11 dadams +;; Added: diredp-up-directory-reuse-dir-buffer. +;; diredp-make-find-file-keys(-not)-reuse-dirs: Added diredp-up-directory-reuse-dir-buffer. +;; 2013/02/06 dadams +;; dired-mark-pop-up: goto point-min, so show start of file list. Thx to Michael Heerdegen. +;; 2013/01/28 dadams +;; Added redefinition of dired-do-run-mail. Fixes Emacs bug #13561. +;; 2012/12/18 dadams +;; diredp-ediff: Better default for FILE2. Thx to Michael Heerdegen. +;; Require subr-21.el for Emacs 20. +;; 2012/11/17 dadams +;; Added: derived-mode-p (for Emacs < 22), diredp-ensure-mode. +;; Use diredp-ensure-mode everywhere for mode, so compatible with Sunrise Commander etc. +;; 2012/11/01 dadams +;; Do not require ediff.el. It is required in diredp-ediff itself. +;; 2012/10/06 dadams +;; Added: minibuffer-with-setup-hook for code byte-compiled using Emacs < 22. +;; 2012/09/28 dadams +;; Moved dired-*w32* bindings after normal mouse bindings, so they override them. +;; 2012/09/05 dadams +;; diredp-(rename|copy|(rel)symlink|hardlink)-this-file: Bind use-file-dialog to nil. +;; 2012/08/26 dadams +;; Set font-lock-defaults to a 3-element list, so it works with font-menus(-da).el. +;; 2012/08/25 dadams +;; Added: redefinition of dired-pop-to-buffer (fix for bug #12281). +;; dired-mark-pop-up: If buffer is shown in a separate frame, do not show menu bar. +;; 2012/07/10 dadams +;; Removed unneeded substitute-key-definition for (next|previous)-line. +;; 2012/07/09 dadams +;; Added redefinition of dired-mark-files-regexp: Push REGEXP onto regexp-search-ring. +;; 2012/06/21 dadams +;; diredp-nb-marked-in-mode-name: +;; Add marker numbers regardless of name match. +;; Use text property dired+-mode-name to tell whether mode-name was already changed. +;; 2012/06/20 dadams +;; Added: diredp-nb-marked-in-mode-name, diredp-mode-line-(flagged|marked). Added to hooks. +;; Thx to Michael Heerdegen. +;; 2012/06/14 dadams +;; dired-mark-pop-up: Wrap save-excursion around window/frame deletion. +;; dired-do-redisplay: Updated wrt Emacs 23: bind, (then run) dired-after-readin-hook. +;; diredp-y-or-n-files-p: Corrected construction of prompt wrt final SPC. +;; 2012/06/13 dadams +;; dired-buffers-for-dir: Updated wrt Emacs 23: +;; If dired-directory is a list then expand FILE in DIR & check whether in cdr of list. +;; diredp-get-files-for-dir, diredp-files-within-1, diredp-insert-as-subdir: +;; Expand dir name before passing it to dired-buffers-for-dir. +;; 2012/06/05 dadams +;; MS Windows: Just do not define commands that are inappropriate for Windows (instead of +;; defining them to raise an error or making them invisible in menus). +;; 2012/06/02 dadams +;; Added: diredp-do-(print|encrypt|decrypt|sign|verify)-recursive. Menus. Keys. +;; diredp-do-move-recursive: Corrected to use dired-rename-file, not dired-copy-file. +;; 2012/05/30 dadams +;; diredp-insert-as-subdir: Added optional arg IN-DIRED-NOW-P. Pick up markings & switches +;; from sole Dired buffer for CHILD if not in Dired now. +;; 2012/05/29 dadams +;; Added: diredp-do-(chxxx|chgrp|chown|touch)-recursive, diredp-touch-this-file, +;; diredp-menu-bar-(immediate|operate)-bookmarks-menu. Added to menus. Bound to keys. +;; Factored bookmark stuff into Bookmark(s) submenus. +;; diredp-menu-bar-immediate-menu: Added dired-kill-subdir, [goto-subdir]. +;; diredp-dired-this-subdir, dired-maybe-insert-subdir: Corrected :visible/enable. +;; diredp-dired-inserted-subdirs: Do dired-(remember-marks|mark-remembered) in this-buff. +;; diredp-mouse-3-menu: +;; Do not use save-excursion, because some commands move point on purpose. Just return to +;; original point unless command intends to MOVEP. +;; Added to menu dired-maybe-insert-subdir (two entries), dired-kill-subdir. +;; Use *-this-file*, not *-do-*: copy|symlink|shell-command|grep|load (don't use :keys). +;; 2012/05/26 dadams +;; diredp-dired-inserted-subdirs, diredp-insert-as-subdir: +;; Preserve markings and switches in target buffer. +;; dired-mark-pop-up: Use unwind-protect. Bury buffer too. +;; diredp-do-chmod-recursive: Use only 5 args if < Emacs 23. +;; 2012/05/25 dadams +;; Added: diredp-insert-as-subdir, diredp-ancestor-dirs, diredp-maplist, +;; diredp-do-redisplay-recursive, diredp-do-chmod-recursive. +;; Bound diredp-do-chmod-recursive. to M-+ M and added to menu. +;; diredp-get-files: Added optional arg DONT-ASKP. +;; diredp-y-or-n-files-p: Kill list buffer if it was never shown. +;; dired-mark-pop-up: ignore error when delete frame/window. +;; 2012/05/22 dadams +;; diredp-get-files(-for-dir): Added optional arg INCLUDE-DIRS-P. +;; Added: diredp-insert-subdirs(-recursive), diredp(-this)-dired-inserted-subdir(s). +;; Added to menus. Bound diredp-insert-subdirs* to (M-+) M-i. +;; Bound diredp-capitalize(-recursive) to (M-+) %c. +;; Added diredp-dired-union-other-window to Dirs menu. +;; Updated diredp-dired-plus-description. +;; 2012/05/19 dadams +;; Added: diredp-image-dired-*-recursive, diredp-*link-recursive, +;; diredp-do-isearch(-regexp)-recursive, diredp-do-query-replace-regexp-recursive, +;; diredp-do-search-recursive, diredp-(capitalize|(up|down)case)-recursive, +;; diredp-create-files-non-directory-recursive. +;; Bound on M-+ prefix key. Added to menus. +;; diredp-get-files, diredp-y-or-n-files-p, diredp-list-files, diredp-list-marked-recursive: +;; Added optional arg PREDICATE. +;; diredp-do-create-files-recursive: Removed MARKER-CHAR arg. Hard-code to keep markings. +;; diredp-do-(copy|move)-recursive: Use arg IGNORE-MARKS-P (forgot to use it). +;; Removed MARKER-CHAR arg in call to d-d-c-f-r. +;; Added missing autoload cookies. +;; 2012/05/06 dadsms +;; diredp-y-or-n-files-p: Do not kill buffer *Files* - just bury it. +;; 2012/05/05 dadams +;; Added: diredp-do-bookmark-recursive, diredp-do-bookmark-in-bookmark-file-recursive, +;; diredp-set-bookmark-file-bookmark-for-marked-recursive. +;; Bound to M-+ M-b, M-+ C-M-B (aka C-M-S-b), M-+ C-M-b, respectively. Added to menus. +;; diredp-bookmark: Added optional arg FILE. +;; diredp-do-bookmark-in-bookmark-file: Added optional arg FILES. +;; diredp-dired-plus-description: Updated. +;; diredp-get-confirmation-recursive: Raise error if not in Dired. +;; diredp-do-bookmark-recursive, diredp-marked-recursive(-other-window), +;; diredp-multiple-w32-browser-recursive: +;; Use diredp-get-confirmation-recursive. +;; 2012/05/04 dadams +;; Added: dired-mark-unmarked-files for Emacs < 24. +;; diredp-do-create-files-recursive: Corrected for Emacs < 24. +;; diredp-do-create-files-recursive, diredp-(un)mark-files-tagged-regexp, +;; diredp(-mouse)-do-(un)tag, diredp(-mouse)-do-remove-all-tags, +;; diredp(-mouse)-do-paste-(add|replace)-tags, diredp(-mouse)-do-set-tag-value, +;; diredp(-mouse)-do-bookmark(-in-bookmark-file), diredp-find-a-file-read-args, +;; diredp-mouse-do-shell-command: +;; Use lexical-let(*), to get closures for free vars in lambdas. +;; 2012/04/28 dadams +;; Added: +;; diredp-copy-filename-as-kill-recursive, diredp-do-copy-recursive, +;; diredp-do-find-marked-files-recursive, diredp-do-grep-recursive, +;; diredp-do-move-recursive, diredp-do-shell-command-recursive, +;; diredp-list-marked-recursive, diredp-marked-recursive(-other-window), +;; diredp-multiple-w32-browser-recursive, diredp-do-create-files-recursive, +;; diredp-get-confirmation-recursive, diredp-list-files, diredp-y-or-n-files-p, +;; diredp-menu-bar-recursive-marked-menu. +;; diredp-get-files: Use diredp-y-or-n-files-p, not y-or-n-p. +;; Commented out dired-readin-insert - see comment. +;; Moved bookmark menu items to submenu Bookmarks. +;; Added keys (with M-+ prefix) and menu items for new (*-recursive) commands. +;; Reordered w32-browser stuff in menus. +;; diredp-do-grep: Combined defs for diff Emacs versions - do version test at runtime. +;; 2012/04/25 dadams +;; dired-insert-directory: Updated per Emacs 24. +;; 2012/04/23 dadams +;; Added (moved here from Icicles, and renamed prefix): +;; diredp-re-no-dot, diredp-get-files, diredp-get-files-for-dir, diredp-files-within, +;; diredp-files-within-dirs-done. +;; 2012/04/05 dadams +;; Added redefinition of dired-mark-pop-up, to fix Emacs bug #7533. If they ever fix it +;; then remove this hack. +;; 2012/03/13 dadams +;; diredp-dired(-for)-files(-other-window): +;; Bind: icicle-sort-comparer, icicle-all-candidates-list-alt-action-fn. +;; Use icicle-(un)bind-file-candidate-keys. +;; diredp-dired-files-interactive-spec: Updated doc strings accordingly. +;; 2012/03/07 dadams +;; Added: dired-switches-escape-p. +;; dired-get-filename: Updated wrt Emacs 24: +;; whitespace quoting for bug #10469, filename quoting per Emacs 23.3+, +;; MS Windows conversion of \ to / per Emacs 23.3+. +;; dired-goto-file: Escape whitespace, per Emacs 24 (for bug #10469). +;; 2012/03/02 dadams +;; Require cl.el at compile time even for Emacs 22+, for case macro. +;; 2012/02/28 dadams +;; Do not bother to soft-require mkhtml.el anymore. +;; 2012/02/18 dadams +;; Swapped keys for dired-w32(-browser|explore), so the former is M-RET, as in Bookmark+. +;; 2012/01/10 dadams +;; diredp-font-lock-keywords-1: Corrected for date/time when locale is used, not iso. +;; 2011/12/19 dadams +;; dired-insert-set-properties, dired-mark-sexp, diredp-(un)mark-region-files, +;; diredp-flag-region-files-for-deletion, diredp-mouse-3-menu: +;; Use line-(beginning|end)-position. +;; 2011/12/16 dadams +;; diredp-menu-bar-mark-menu: Removed Revert item. +;; diredp-menu-bar-subdir-menu: Add image-dired-dired-toggle-marked-thumbs. +;; diredp-mouse-3-menu: +;; Use commands bound to keys, so the keys show up in the menu. Prefer *-this-file. +;; Correct the mark/unmark/flag menu-item visibility. Added Capitalize. +;; 2011/12/09 dadams +;; diredp-w32-drives: Use dolist, not mapcar. +;; diredp-mouse-3-menu: Use easymenu to build the menu. Conditionalize some items. +;; Bind down-mouse-3, not mouse-3, to diredp-mouse-3-menu. (bind mouse-3 to ignore). +;; Added eval-when-compile for easymenu.el. +;; 2011/12//02 dadams +;; Added diredp-internal-do-deletions. +;; dired(-mouse)-do(-flagged)-delete, : Use diredp-internal-do-deletions, for trash. +;; 2011/11/29 dadams +;; diredp-read-bookmark-file-args: Corrected use of list of default file names: > Emacs 23.1. +;; 2011/10/31 dadams +;; dired-mode-hook: Call font-lock-refresh-defaults - see Emacs 24 bugs #6662 and #9919. +;; 2011/10/24 dadams +;; Protect dired-show-file-type with fboundp. +;; 2011/09/03 dadams +;; diredp-do-grep-1: Map shell-quote-argument over file names. Thx to Joe Bloggs. +;; 2011/08/07 dadams +;; diredp-bookmark (need to keep in sync with bmkp-make-record-for-target-file): +;; Instead of image-bookmark-make-record, use explicit function that includes file, type. +;; 2011/07/25 dadams +;; Changed featurep to eval-after-load, for bookmark+-1.el and w32-browser.el. +;; 2011/07/01 dadams +;; Fixed typo: dired-toggle-find-file-reuse-dir -> ...diredp.... Thx to pasja on Emacs Wiki. +;; 2011/06/18 dadams +;; Added: diredp-describe-mode, diredp-dired-plus-help(-link), diredp-help-button, +;; diredp-dired-plus-description(+links), diredp-send-bug-report. +;; Bound diredp-describe-mode to whatever describe-mode is bound to. +;; All menus, :enable with mark-active: Added transient-mark-mode and mark != point. +;; toggle-diredp-find-file-reuse-dir: Swapped which one is the alias. +;; diredp-w32-list-mapped-drives: Display *Shell Command Output* at end. +;; diredp-mouse-(describe-file|3-menu|mark/unmark|(find|view)-file(-other-window)): +;; save-excursion set-buffer -> with-current-buffer. +;; 2011/06/08 dadams +;; Added: diredp-dired-for-files(-other-window). +;; 2011/06/07 dadams +;; Bound dired-show-file-type to _, since y is diredp-relsymlink-this-file. +;; 2011/04/25 dadams +;; Added (from files+.el): dired(-mouse)-describe-file. Bound to C-h (C-)RET, added to menus. +;; 2011/04/23 dadams +;; Added, bound (T c, T M-w, T 0, T v, T p, T C-y, T q), and added to menus: +;; diredp-copy-tags-this-file, diredp-mouse-copy-tags, +;; diredp(-mouse)(-do)-remove-all-tags(-this-file), +;; diredp(-mouse)(-do)-set-tag-value(-this-file), +;; diredp(-mouse)(-do)-paste-(add|replace)-tags(-this-file). +;; diredp-mark-files-tagged-(all/none|some/not-all): Bound free var presentp. +;; dired-map-over-marks: Corrected: Bind NEWARG and use that, not ARG. +;; dired-get-marked-files: let* -> let. +;; dired-do-redisplay, diredp-mouse-diff: when/if -> and. +;; dired-readin-insert, dired-get-filename: if -> unless/when. +;; diredp-mouse-find-file-reuse-dir-buffer: with-current-buffer, not save... +;; diredp-mouse-mark/unmark: Removed unused bol/eol vars. +;; 2011/04/19 dadams +;; Added: diredp-(un)mark-files-tagged-((not-)all|none|some|regexp|all/none|some/not-all), +;; dired-mark-if. Added Tagged submenu for Mark menu. +;; Put tags commands on prefix key T, as in Bookmark+. Removed C-(M-)+/- tags-cmd bindings. +;; diredp-untag-this-file: Added prefix-arg behavior. +;; 2011/04/18 dadams +;; Added: diredp-prompt-for-bookmark-prefix-flag. +;; Use it in diredp(-mouse)-do-(un)tag, diredp-read-bookmark-file-args, +;; diredp(-mouse)-do-bookmark, diredp-(bookmark|(un)tag)-this-file. +;; diredp-(bookmark|(un)tag)-this-file, diredp(-do)-bookmark, diredp-(un)tag, +;; diredp-do-bookmark-in-bookmark-file, diredp-set-bookmark-file-bookmark-for-marked: +;; Made PREFIX arg optional. +;; 2011/04/17 dadams +;; Added: diredp-(bookmark|(un)tag)-this-file, diredp(-mouse)(-do)-(un)tag. +;; diredp-mouse-3-menu: Added: diredp-mouse-do-(un)tag. +;; diredp-menu-bar-immediate-menu: Added diredp-(un)tag-this-file, diredp-bookmark-this-file. +;; diredp-menu-bar-operate-menu: Added diredp-do-(un)tag. +;; Bound diredp-do-tag to C-+, diredp-tag-this-file to C-M-+, diredp-do-untag to C--, +;; diredp-untag-this-file to C-M--, diredp-bookmark-this-file to C-B. +;; diredp-bookmark: Use bmkp-autofile-set, not bmkp-file-target-set, so get autofile. +;; diredp-read-bookmark-file-args, diredp(-mouse)-do-bookmark: +;; Default for prefix is now an empty string, not the directory. +;; diredp-mouse-do-bookmark: Removed optional second arg. +;; Corrected typo: direp-read-bookmark-file-args -> diredp-read-bookmark-file-args. +;; 2011/03/25 dadams +;; diredp-bookmark: Fixed typo: bmkp-file-indirect-set -> bmkp-file-target-set. +;; 2011/02/11 dadams +;; diredp-deletion, diredp-deletion-file-name, diredp-executable-tag: +;; Made default the same for dark background as for light. +;; diredp-ignored-file-name: Made default a bit darker for dark background. +;; 2011/02/03 dadams +;; All deffaces: Provided default values for dark-background screens too. +;; 2011/01/12 dadams +;; dired-do-flagged-delete: Removed sit-for added on 1/02. +;; 2011/01/04 dadams +;; defsubst -> defun everywhere. +;; Removed autoload cookies from non def* sexps, defvar, and non-interactive functions. +;; Added some missing autoload cookies for defcustom and commands. +;; 2011/01/02 dadams +;; Added: diredp-this-file-(un)marked-p, diredp-toggle-marks-in-region. +;; diredp-(un)mark-region-files, diredp-flag-region-files-for-deletion: +;; Act only on marked/unmarked files (opposite). Fix 2nd arg to dired-mark-if. +;; diredp-mouse-3-menu: +;; If region is active and mouse3.el was loaded, then use its popup. +;; Fix Toggle Marked/Unmarked: +;; Use diredp-toggle-marks-in-region, so widen, show details and use bol/eol. +;; dired-do-flagged-delete: Added sit-for. +;; 2010/11/28 dadams +;; diredp-mouse-3-menu: Added Toggle Marked/Unmarked for region menu. +;; 2010/10/20 dadams +;; Moved Emacs 20 tweak to recognize k in file sizes to var dired-move-to-filename-regexp. +;; Added diredp-loaded-p. +;; 2010/10/19 dadams +;; diredp-font-lock-keywords-1: +;; Handle decimal pt in file size. Thx to Michael Heerdegen. +;; Enable Emacs 20/21 to handle -h option (decimal point size). +;; Renamed: face diredp-inode+size to diredp-number. +;; 2010/10/01 dadams +;; dired-goto-file: Avoid infloop from looking for dir line. Thx to not-use.dilines.net. +;; 2010/09/29 dadams +;; Added: diredp-dired-union(-1|-other-window|-interactive-spec). +;; dired-goto-file: fix for Emacs bug #7126. +;; 2010/09/27 dadams +;; Renamed diredp-dired-interactive-spec to diredp-dired-files-interactive-spec. +;; diredp-dired-files-interactive-spec: Respect file-list arg: kill existing Dired buffer. +;; Fix use of prefix arg for switches. +;; 2010/09/26 dadams +;; Added: dired-insert-directory: Compute WILDCARD arg for individual files. +;; Added: dired-readin-insert: Use t as WILDCARD arg to dired-insert-directory. +;; Added: diredp-dired-files(-other-window), diredp-dired-interactive-spec. +;; 2010/08/27 dadams +;; Use diredp-font-lock-keywords-1 properly as a second level of fontification. +;; Added: diredp-w32-drives(-mode(-map)), dired-up-directory. +;; 2010/08/07 dadams +;; dired-map-over-marks: Removed loop that used dired-between-files. +;; diredp-get-file-or-dir-name: test against subdir/..? also. +;; dired-do-find-marked-files: Pass original ARG to dired-get-marked-files. +;; 2010/08/05 dadams +;; diredp-bookmark: +;; Handle image files (and sound files, if Bookmark+ is used). +;; Use bmkp-file-indirect-set if available. +;; Use error-message-string to get failure msg. +;; 2010/07/11 dadams +;; Added: diredp-set-bookmark-file-bookmark-for-marked (C-M-b), diredp-mouse-do-bookmark, +;; diredp-do-bookmark-in-bookmark-file (C-M-B, aka C-M-S-b), diredp-read-bookmark-file-args. +;; Added them to the operate menu. Added diredp-do-bookmark to mouse-3 menu. +;; 2010/07/07 dadams +;; dired-do-*: Updated doc strings for prefix arg treatment from dired-map-over-marks-check. +;; Added missing autoload cookies. +;; 2010/05/29 dadams +;; diredp-bookmark: Use relative file name in bookmark name. +;; Removed defvar of directory-listing-before-filename-regexp. +;; 2010/05/28 dadams +;; Changed menu item for dired-create-directory to New Directory. Moved it before Up Dir. +;; 2010/03/19 dadams +;; diredp-font-lock-keywords-1: Handle date+time wrt regexp changes for Emacs 23.2. +;; 2010/01/31 dadams +;; diredp-bookmark: +;; Don't use bookmark-set or find-file-noselect - inline the needed bookmark-store code. +;; Call bookmark-maybe-load-default-file. Use rudimentary bookmark-make-record-function. +;; 2010/01/21 dadams +;; Renamed: +;; diredp-subst-find-alternate-for-find to diredp-make-find-file-keys-reuse-dirs +;; diredp-subst-find-for-find-alternate to diredp-make-find-file-keys-not-reuse-dirs. +;; diredp-make-find-file-keys(-not)-reuse-dirs: Handle also dired(-mouse)-w32-browser. +;; 2010/01/10 dadams +;; Added: face diredp-inode+size. Use in diredp-font-lock-keywords-1. +;; diredp-font-lock-keywords-1: Allow decimal point in file size. Thx to Regis. +;; 2010/01/05 dadams +;; dired-insert-set-properties: +;; Add text property dired-filename to the file name (for Emacs 23). +;; 2009/10/23 dadams +;; diredp-font-lock-keywords-1: Override `l' and `t' matches in headings with default face. +;; 2009/10/13 dadams +;; Added: diredp(-do)-bookmark. Added to Multiple menu, and bound to M-b. +;; 2009/10/11 dadams +;; diredp-menu-bar-immediate-menu: +;; Added items: image display items, dired-maybe-insert-subdir. +;; Test dired-do-relsymlink, not diredp-relsymlink-this-file. +;; diredp-menu-bar-operate-menu: +;; Added items: epa encryption items, image items, isearch items. +;; diredp-menu-bar-subdir-menu: +;; Added items: revert, isearch file names, dired-compare-directories. +;; Removed macro menu-item-any-version - use menu-item everywhere (works for Emacs 20+). +;; Added wdired-change-to-wdired-mode to subdir menu even for Emacs 20, if defined. +;; 2009/07/09 dadams +;; dired-goto-file: Make sure we have a string before calling directory-file-name. +;; 2009/05/08 dadams +;; dired-find-file (Emacs 20): Raise error if dired-get-filename returns nil. +;; 2009/04/26 dadams +;; dired-insert-set-properties, diredp-(un)mark-region-files, +;; diredp-flag-region-files-for-deletion, diredp-mouse-3-menu, diredp-mouse-mark/unmark: +;; Bind inhibit-field-text-motion to t, to ensure real eol. +;; 2008/12/17 dadams +;; diredp-font-lock-keywords-1: Don't do diredp-deletion, diredp-flag-mark for empty lines. +;; 2008/09/22 dadams +;; Added: diredp-fileset, diredp-get-file-or-dir-name, and redefinitions of +;; dired-map-over-marks, dired-find-file, and dired-mouse-find-file-other-window. +;; Added vanilla code to pick up macro dired-map-over-marks: +;; dired-get-marked-files, dired-do-delete, dired-map-over-marks-check, +;; dired-do-redisplay, image-dired-dired-insert-marked-thumbs. +;; diredp-find-file-other-frame, diredp-mouse-(find|view)-file: +;; Added nil t args to dired-get-filename calls. +;; diredp-do-grep(-1): Use new dired-get-marked-files instead of ad-hoc treatment of C-u. +;; 2008/09/21 dadams +;; diredp-marked(-other-window): Don't treat zero prefix arg as numerical (no empty Dired). +;; Added dired-find-file redefinition for Emacs 20. +;; 2008/09/11 dadams +;; diredp-do-grep: Plain C-u means grep all files in Dired buffer. +;; diredp-do-grep-1: Treat 'all value of FILES arg. +;; Added: diredp-all-files. +;; 2008/09/09 dadams +;; Added: diredp-marked(-other-window). Added to menus. Bound *-other-window to C-M-*. +;; 2008/09/07 dadams +;; Added: diredp(-mouse)-do-grep(-1), diredp-grep-this-file. +;; Bound diredp-do-grep to M-g. Added grep commands to menus. +;; 2008/07/18 dadams +;; Soft-require w32-browser.el. Bind its commands in Dired map and menus. +;; 2008/03/08 dadams +;; dired-maybe-insert-subdir: Fit one-window frame after inserting subdir. +;; 2008/03/07 dadams +;; Added: redefinitions of dired-maybe-insert-subdir, dired-goto-file, dired-get-filename. +;; Added: diredp-this-subdir. +;; 2007/11/27 dadams +;; diredp-mouse(-backup)-diff: If available, use icicle-read-string-completing. +;; 2007/09/23 dadams +;; Removed second arg to undefine-killer-commands. +;; 2007/07/27 dadams +;; diredp-font-lock-keywords-1: Allow also for bz2 compressed files - Thx to Andreas Eder. +;; 2006/09/03 dadams +;; diredp-font-lock-keywords-1: Corrected file size and inode number. Thx to Peter Barabas. +;; 2006/08/20 dadams +;; Added: diredp-find-a-file*. +;; 2006/06/18 dadams +;; diredp-font-lock-keywords-1: Highlight file name (also) of flagged files. +;; Use dired-del-marker instead of literal D. +;; Added: diredp-deletion-file-name. +;; 2006/03/31 dadams +;; No longer use display-in-minibuffer. +;; 2006/01/07 dadams +;; Added: link for sending bug report. +;; 2006/01/06 dadams +;; Added defgroup Dired-Plus and used it. Added :link. +;; 2006/01/04 dadams +;; Added defvar of directory-listing-before-filename-regexp, for Emacs 22 compatibility. +;; 2005/12/29 dadams +;; Added: diredp-mouse-mark/unmark-mark-region-files. +;; 2005/12/26 dadams +;; Updated groups. +;; 2005/12/05 dadams +;; diredp-ignored-file-name: Made it slightly darker. +;; 2005/11/05 dadams +;; Renamed all stuff defined here to have diredp- prefix. +;; diredp-relsymlink-this-file: Protected with fboundp. +;; Changed to soft require: dired-x.el. +;; Removed comment to require this inside eval-after-load. +;; 2005/11/03 dadams +;; Added: dired-display-msg. Replace blue-foreground-face with it. +;; Alias dired-do-toggle to dired-toggle-marks, if defined. +;; 2005/11/02 dadams +;; Added: dired-get-file-for-visit, dired(-mouse)-find-alternate-file*, +;; togglep-dired-find-file-reuse-dir, dired+-subst-find-*. +;; Use defface for all faces. Renamed without "-face". No longer require def-face-const. +;; dired-simultaneous-find-file: Minor bug fix (typo). +;; 2005/07/10 dadams +;; dired-unmark-all-files-no-query -> dired-unmark-all-marks +;; (thanks to Sivaram Neelakantan for bug report). +;; 2005/05/25 dadams +;; string-to-int -> string-to-number everywhere. +;; 2005/05/17 dadams +;; Updated to work with Emacs 22.x. +;; 2005/02/16 dadams +;; Added dired-mark/unmark-extension. Replaced dired-mark-extension with it everywhere. +;; 2005/01/08 dadams +;; Bind [S-mouse-1], instead of [S-down-mouse-1], to dired-mouse-mark-region-files. +;; 2004/11/20 dadams +;; dired-mark-sexp: Search for literal month names only for versions before Emacs 20. +;; Refined to deal with Emacs 21 < 21.3.50 (soon to be 22.x) +;; 2004/11/14 dadams +;; Bound dired-no-confirm to non-nil for dired-mouse-*. +;; Updated for Emacs 21 and improved highlighting: +;; Spaces OK in file and directory names. Highlight date/time and size. +;; 2004/10/17 dadams +;; Require cl only for Emacs 20, and only when compile. +;; 2004/10/01 dadams +;; Updated to work with Emacs 21 also. +;; 2004/04/02 dadams +;; dired-font-lock-keywords-1: Prefer using dired-omit-extensions +;; to completion-ignored-extensions, if available. +;; 2004/03/22 dadams +;; Added dired-mouse-mark-region-files and dired-mouse-mark/unmark. +;; 2000/09/27 dadams +;; 1. dired-font-lock-keywords-1: fixed for spaces in dir names. +;; 2. Added: dired-buffers-for-dir. +;; 1999/09/06 dadams +;; Added S-*-mouse-2 bindings (same as C-*-mouse-2). +;; 1999/08/26 dadams +;; 1. Added *-face vars and dired-font-lock-keywords-1. +;; 2. Added possibility to use dired-font-lock-keywords-1 via hook. +;; 1999/08/26 dadams +;; Changed key binding of dired-mouse-find-file from down-mouse-2 to mouse-2. +;; 1999/08/25 dadams +;; Changed (C-)(M-)mouse-2 bindings. +;; 1999/08/25 dadams +;; 1. Added cmds & menu bar and key bindings: (dired-)find-file-other-frame. +;; 2. Changed binding for dired-display-file. +;; 1999/03/26 dadams +;; 1. Get rid of Edit menu-bar menu. +;; 2. dired-mouse-3-menu: Changed popup titles and item names. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth +;; Floor, Boston, MA 02110-1301, USA. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Code: + +(eval-when-compile (require 'cl)) ;; case (plus, for Emacs 20: dolist, pop, push) +(eval-when-compile (require 'easymenu)) ;; easy-menu-create-menu + +(require 'dired) ;; dired-revert +(require 'dired-aux) ;; dired-bunch-files, dired-do-chxxx, dired-do-create-files, + ;; dired-mark-read-string, dired-read-shell-command, + ;; dired-run-shell-command, dired-shell-stuff-it +(require 'dired-x) ;; dired-do-relsymlink +(require 'autofit-frame nil t) ;; (no error if not found) fit-frame-if-one-window +(require 'bookmark+ nil t) ;; (no error if not found) + ;; bmkp-autofile-add-tags, bmkp-autofile-remove-tags, bmkp-autofile-set, bmkp-copied-tags, + ;; bmkp-current-bookmark-file, bmkp-describe-bookmark, bmkp-empty-file, bmkp-get-autofile-bookmark, + ;; bmkp-get-bookmark-in-alist, bmkp-get-tags, bmkp-read-tag-completing, + ;; bmkp-read-tags-completing, bmkp-refresh/rebuild-menu-list, bmkp-remove-all-tags, + ;; bmkp-same-file-p, bmkp-set-bookmark-file-bookmark, bmkp-set-sequence-bookmark, + ;; bmkp-set-tag-value, bmkp-some, bmkp-switch-bookmark-file, bmkp-tag-name + +;; For now at least, `highlight.el' is needed only if you use `bookmark+.el'. +(when (featurep 'bookmark+) (require 'highlight nil t)) ;; (no error if not found): + ;; hlt-highlight-region + +(if (> emacs-major-version 21) (require 'help-fns+ nil t) (require 'help+20 nil t)) ;; (no error if not found): + ;; describe-file + +(require 'misc-fns nil t) ;; (no error if not found): undefine-killer-commands +(require 'image-file nil t) ;; (no error if not found): image-file-name-regexp +(require 'image-dired nil t) ;; (no error if not found): + ;; image-dired-create-thumb, image-dired-create-thumbnail-buffer, + ;; image-dired-dired-after-readin-hook, image-dired-delete-tag, image-dired-dired-comment-files, + ;; image-dired-dired-display-external, image-dired-dired-display-image, + ;; image-dired-display-thumbs, image-dired-get-comment, image-dired-get-exif-file-name, + ;; image-dired-get-thumbnail-image, image-dired-insert-thumbnail, image-dired-line-up, + ;; image-dired-line-up-dynamic, image-dired-line-up-interactive, image-dired-line-up-method, + ;; image-dired-list-tags, image-dired-main-image-directory, image-dired-mark-tagged-files, + ;; image-dired-read-comment, image-dired-remove-tag, image-dired-save-information-from-widgets, + ;; image-dired-tag-files, image-dired-thumb-height, image-dired-thumbnail-buffer, + ;; image-dired-thumb-name, image-dired-thumb-size, image-dired-thumb-width, + ;; image-dired-widget-list, image-dired-write-comments, image-dired-write-tags +(when (memq system-type '(windows-nt ms-dos)) + ;; (no error if not found): + (require 'w32-browser nil t));; dired-w32explore, dired-w32-browser, dired-mouse-w32-browser, + ;; dired-multiple-w32-browser +(when (< emacs-major-version 21) (require 'subr-21)) ;; replace-regexp-in-string + +;; Provide macro for code byte-compiled using Emacs < 22. +(eval-when-compile + (when (< emacs-major-version 22) + (defmacro minibuffer-with-setup-hook (fun &rest body) + "Temporarily add FUN to `minibuffer-setup-hook' while executing BODY. +BODY should use the minibuffer at most once. +Recursive uses of the minibuffer are unaffected (FUN is not +called additional times). + +This macro actually adds an auxiliary function that calls FUN, +rather than FUN itself, to `minibuffer-setup-hook'." + ;; (declare (indent 1) (debug t)) + (let ((hook (make-symbol "setup-hook"))) + `(let (,hook) + (setq ,hook (lambda () + ;; Clear out this hook so it does not interfere + ;; with any recursive minibuffer usage. + (remove-hook 'minibuffer-setup-hook ,hook) + (funcall ,fun))) + (unwind-protect + (progn (add-hook 'minibuffer-setup-hook ,hook) ,@body) + (remove-hook 'minibuffer-setup-hook ,hook))))))) + +(defmacro diredp-user-error (&rest args) + `(if (fboundp 'user-error) (user-error ,@args) (error ,@args))) + +;; Define these for Emacs 20 and 21. +(unless (fboundp 'dired-get-file-for-visit) ; Emacs 22+ + (defun dired-get-file-for-visit () ; Not bound + "Get the current line's file name, with an error if file does not exist." + (interactive) + (let ((raw (dired-get-filename nil t)) ; Pass t for second arg so no error for `.' and `..'. + file-name) + (unless raw (error "No file on this line")) + (setq file-name (file-name-sans-versions raw t)) + (if (file-exists-p file-name) + file-name + (if (file-symlink-p file-name) + (error "File is a symlink to a nonexistent target") + (error "File no longer exists; type `g' to update Dired buffer"))))) + + (defun dired-find-alternate-file () ; Not bound + "In Dired, visit this file or directory instead of the Dired buffer." + (interactive) + (set-buffer-modified-p nil) + (find-alternate-file (dired-get-file-for-visit)))) + +;;;;;;;;;;;;;;;;;;;;;;; + + +(provide 'dired+) +(require 'dired+) ; Ensure loaded before compile this. + +;; Quiet the byte-compiler. +(defvar bmkp-copied-tags) ; In `bookmark+-1.el' +(defvar bmkp-current-bookmark-file) ; In `bookmark+-1.el' +(defvar bookmark-default-file) ; In `bookmark.el' +(defvar compilation-current-error) ; In `compile.el' +(defvar delete-by-moving-to-trash) ; Built-in, Emacs 23+ +(defvar dired-always-read-filesystem) ; In `dired.el', Emacs 26+ +(defvar dired-auto-revert-buffer) ; In `dired.el', Emacs 23+ +(defvar dired-create-files-failures) ; In `dired-aux.el', Emacs 22+ +(defvar dired-details-state) ; In `dired-details+.el' +(defvar dired-keep-marker-hardlink) ; In `dired-x.el' +(defvar dired-overwrite-confirmed) ; In `dired-aux.el' +(defvar dired-query-alist) ; In `dired-aux.el', Emacs < 24 +(defvar dired-recursive-copies) ; In `dired-aux.el', Emacs 22+ +(defvar dired-recursive-deletes) ; In `dired.el', Emacs 22+ +(defvar dired-shrink-to-fit) ; In `dired.el' +(defvar dired-switches-alist) ; In `dired.el' +(defvar dired-subdir-switches) ; In `dired.el' +(defvar dired-touch-program) ; Emacs 22+ +(defvar dired-use-ls-dired) ; Emacs 22+ +(defvar diredp-count-.-and-..-flag) ; Here, Emacs 22+ +(defvar diredp-hide-details-initially-flag) ; Here, Emacs 24.4+ +(defvar diredp-hide-details-last-state) ; Here, Emacs 24.4+ +(defvar diredp-hide-details-propagate-flag) ; Here, Emacs 24.4+ +(defvar diredp-hide-details-toggled) ; Here, Emacs 24.4+ +(defvar diredp-highlight-autofiles-mode) ; Here, Emacs 22+ +(defvar diredp-menu-bar-encryption-menu) ; Here, Emacs 23+ +(defvar diredp-menu-bar-images-recursive-menu) ; Here (old name) +(defvar diredp-menu-bar-regexp-recursive-menu) ; Here (old name) +(defvar diredp-menu-bar-subdir-menu) ; Here (old name) +(defvar diredp-move-file-dirs) ; Here, Emacs 24+ +(defvar diredp-single-bookmarks-menu) ; Here, if Bookmark+ is available +(defvar filesets-data) ; In `filesets.el' +(defvar grep-use-null-device) ; In `grep.el' +(defvar header-line-format) ; Emacs 22+ +(defvar icicle-file-sort) ; In `icicles-opt.el' +;; $$$$ (defvar icicle-file-sort-first-time-p) ; In `icicles-var.el' +(defvar icicle-files-ido-like-flag) ; In `icicles-opt.el' +(defvar icicle-ignored-directories) ; In `icicles-opt.el' +(defvar icicle-sort-comparer) ; In `icicles-opt.el' +(defvar image-dired-display-image-buffer) ; In `image-dired.el' +(defvar image-dired-line-up-method) ; In `image-dired.el' +(defvar image-dired-main-image-directory) ; In `image-dired.el' +(defvar image-dired-thumbnail-buffer) ; In `image-dired.el' +(defvar image-dired-thumb-height) ; In `image-dired.el' +(defvar image-dired-thumb-width) ; In `image-dired.el' +(defvar image-dired-widget-list) ; In `image-dired.el' +(defvar ls-lisp-use-insert-directory-program) ; In `ls-lisp.el' +(defvar minibuffer-default-add-function) ; In `simple.el', Emacs 23+ +(defvar mouse3-dired-function) ; In `mouse3.el' +(defvar read-file-name-completion-ignore-case) ; In `minibuffer.el', Emacs 23+. In C code, Emacs 22. +(defvar recentf-list) ; In `recentf.el' +(defvar switch-to-buffer-preserve-window-point) ; In `window.el', Emacs 24+ +(defvar tooltip-mode) ; In `tooltip.el' +(defvar vc-directory-exclusion-list) ; In `vc' +(defvar w32-browser-wait-time) ; In `w32-browser.el' + +;;;;;;;;;;;;;;;;;;;;;;; + +(defgroup Dired-Plus nil + "Various enhancements to Dired." + :prefix "diredp-" :group 'dired + :link `(url-link :tag "Send Bug Report" + ,(concat "mailto:" "drew.adams" "@" "oracle" ".com?subject=\ +dired+.el bug: \ +&body=Describe bug here, starting with `emacs -q'. \ +Don't forget to mention your Emacs and library versions.")) + :link '(url-link :tag "Other Libraries by Drew" + "https://www.emacswiki.org/emacs/DrewsElispLibraries") + :link '(url-link :tag "Download" + "https://www.emacswiki.org/emacs/download/dired%2b.el") + :link '(url-link :tag "Description" + "https://www.emacswiki.org/emacs/DiredPlus") + :link '(emacs-commentary-link :tag "Commentary" "dired+")) + +;;; Variables + +;; `dired-do-toggle' was renamed to `dired-toggle-marks' after Emacs 20. +(unless (fboundp 'dired-toggle-marks) (defalias 'dired-toggle-marks 'dired-do-toggle)) + +;;; This is duplicated in `diff.el' and `vc.el'. +;;;###autoload +(defcustom diff-switches "-c" + "*A string or list of strings specifying switches to be passed to diff." + :type '(choice string (repeat string)) + :group 'dired :group 'diff) + +;;;###autoload +(defcustom diredp-auto-focus-frame-for-thumbnail-tooltip-flag nil + "*Non-nil means automatically focus the frame for a thumbnail tooltip. +If nil then you will not see a thumbnail image tooltip when you +mouseover an image-file name in Dired, unless you first give the frame +the input focus (e.g., by clicking its title bar). + +This option has no effect if `diredp-image-preview-in-tooltip' is nil. +It also has no effect for Emacs versions prior to Emacs 22." + :type 'boolean :group 'Dired-Plus) + +;;;###autoload +(defcustom diredp-bind-problematic-terminal-keys t + "*Non-nil means bind some keys that might not work in a text-only terminal. +This applies to keys that use modifiers Meta and Shift together. +If you use Emacs in text-only terminal and your terminal does not +support the use of such keys then customize this option to nil." + :type 'boolean :group 'Dired-Plus) + +;;;###autoload +(defcustom diredp-compressed-extensions '(".tar" ".taz" ".tgz" ".arj" ".lzh" + ".lzma" ".xz" ".zip" ".z" ".Z" ".gz" ".bz2" ".rar" ".rev") + "*List of compressed-file extensions, for highlighting. + +Note: If you change the value of this option then you need to restart +Emacs to see the effect of the new value on font-locking." + :type '(repeat string) :group 'Dired-Plus) + +(when (> emacs-major-version 21) ; Emacs 22+ + (defcustom diredp-count-.-and-..-flag nil + "Non-nil means count `.' and `..' when counting files for mode-line." + :type 'boolean :group 'Dired-Plus)) + +;;;###autoload +(defcustom diredp-do-report-echo-limit 5 + "Echo result for each file, for fewer than this many files. +If more than this many files are acted on then there is no echoing. + +Used by some do-and-report commands such as `diredp-do-emacs-command'. +Results that are not echoed are anyway reported by `dired-log', so you +can show them with `?' in the Dired buffer." + :type '(restricted-sexp :match-alternatives (wholenump)) :group 'Dired-Plus) + +;;;###autoload +(defcustom diredp-dwim-any-frame-flag pop-up-frames + "*Non-nil means the target directory can be in a window in another frame. +Only visible frames are considered. +This is used by ``dired-dwim-target-directory'. +This option has no effect for Emacs versions before Emacs 22." + :type 'boolean :group 'Dired-Plus) + +(when (fboundp 'dired-hide-details-mode) ; Emacs 24.4+ + (defcustom diredp-hide-details-initially-flag t + "*Non-nil means hide details in Dired from the outset." + :type 'boolean :group 'Dired-Plus + :set (lambda (sym defs) + (custom-set-default sym defs) + (setq diredp-hide-details-last-state diredp-hide-details-initially-flag))) + + (defcustom diredp-hide-details-propagate-flag t + "*Non-nil means display the next Dired buffer the same way as the last. +The last `dired-hide-details-mode' value set is used by the next Dired +buffer created." + :type 'boolean :group 'Dired-Plus)) + +;; Emacs 20 only. +;;;###autoload +(unless (fboundp 'define-minor-mode) + (defcustom diredp-highlight-autofiles-mode t + "*Non-nil means highlight names of files that are autofile bookmarks. +Autofiles that have tags are highlighted using face +`diredp-tagged-autofile-name'. Those with no tags are highlighted +using face `diredp-autofile-name'. + +Setting this option directly does not take effect; use either +\\[customize] or command `diredp-highlight-autofiles-mode'. + +NOTE: When `dired+.el' is loaded (for the first time per Emacs +session), the highlighting is turned ON, regardless of the option +value. To prevent this and have the highlighting OFF by default, you +must do one of the following: + + * Put (diredp-highlight-autofiles-mode -1) in your init file, AFTER + it loads `dired+.el'. + + * Customize the option to `nil', AND ensure that your `custom-file' + (or the `custom-saved-variables' part of your init file) is + evaluated before `dired+.el' is loaded. + +This option has no effect unless you use libraries `Bookmark and +`highlight.el'." + :set (lambda (symbol value) (diredp-highlight-autofiles-mode (if value 1 -1))) + :initialize 'custom-initialize-default + :type 'boolean :group 'Dired-Plus :require 'dired+)) + +;;;###autoload +(defcustom diredp-ignore-compressed-flag t + "*Non-nil means to font-lock names of compressed files as ignored files. +This applies to filenames whose extensions are in +`diredp-compressed-extensions'. If nil they are highlighted using +face `diredp-compressed-file-name'. + +Note: If you change the value of this option then you need to restart +Emacs to see the effect of the new value on font-locking." + :type 'boolean :group 'Dired-Plus) + +;;;###autoload +(defcustom diredp-image-preview-in-tooltip (or (and (boundp 'image-dired-thumb-size) image-dired-thumb-size) + 100) + "*Whether and what kind of image preview to show in a tooltip. +The possible values are: + + `nil' : do not show a tooltip preview + integer N>0 : show a thumbnail preview of that size + `full' : show a full-size preview of the image + +To enable tooltip image preview you must turn on `tooltip-mode' and +load library `image-dired.el'. See also option +`diredp-auto-focus-frame-for-thumbnail-tooltip-flag'. + +This option has no effect for Emacs versions prior to Emacs 22." + :type '(choice + (restricted-sexp :tag "Show a thumnail image of size" + :match-alternatives ((lambda (x) (and (wholenump x) (not (zerop x)))))) + (const :tag "Show a full-size image preview" full) + (const :tag "OFF: Do not show an image preview" nil)) + :group 'Dired-Plus) + +;;;###autoload +(defcustom diredp-image-show-this-file-use-frame-flag t + "Non-nil means `diredp-image-show-this-file' uses another frame. +If nil then it uses another window. Using another frame means you +have more control over the image size when you use a prefix arg. + +If it uses another window then the prefix arg controls only the +minimum window height, not necessarily the image scale (height). + +\(If the buffer displaying the image is already considered a +special-display buffer by your Emacs setup, then a nil value of this +option has no effect.)" + :type 'boolean :group 'Dired-Plus) + +;;;###autoload +(defcustom diredp-list-file-attributes (list '(5 8) 'auto) + "Which file attributes `diredp-list-file' uses, and when." + :group 'Dired-Plus :type '(list (repeat integer) + (choice + (const :tag "Show automatically, immediately" 'auto) + (const :tag "Show on demand via `l'" 'on-demand)))) + +;;;###autoload +(defcustom diredp-max-frames 200 + "*Max number of frames, for commands that find files in separate frames. +These commands are `dired-do-find-marked-files' and +`diredp-do-find-marked-files-recursive'. See their descriptions for +the circumstances in which they show the files in separate frames." + :type '(restricted-sexp :match-alternatives ((lambda (x) (and (wholenump x) (not (zerop x)))))) + :group 'Dired-Plus) + +(when (fboundp 'file-equal-p) ; Emacs 24+ + (defcustom diredp-move-file-dirs () + "Alist of names of files and preferred directories to move them to. +File names should be relative (no directory component). +Target directory names should be absolute." + :group 'files :type '(alist :key-type file :value-type directory))) + +;; (Not used - just use the body directly in the option default value. +;; (defun diredp-omit-files-regexp () +;; "Return regexp to use for font-locking, using `dired-omit-files' as base." +;; (let* ((strg dired-omit-files) +;; (strg (if (eq ?^ (aref strg 0)) (substring strg 1) strg)) ; Remove initial ^ +;; (strg (replace-regexp-in-string "\\(\\\\[|]\\)\\^" "\\1" strg 'FIXEDCASE nil)) ; Remove other ^'s +;; (strg (replace-regexp-in-string "\\([$]\\)" "" strg 'FIXEDCASE nil))) ; Remove $'s +;; strg)) + +(defcustom diredp-omit-files-regexp (let* ((strg dired-omit-files) + (strg (if (eq ?^ (aref strg 0)) ; Remove initial ^ + (substring strg 1) + strg)) + (strg (replace-regexp-in-string "\\(\\\\[|]\\)\\^" ; Remove other ^'s + "\\1" + strg + 'FIXEDCASE + nil)) + (strg (replace-regexp-in-string "\\([$]\\)" ; Remove $'s + "" + strg + 'FIXEDCASE + nil))) + strg) + "Regexp for font-locking file names to be omitted by `dired-omit-mode'. +The regexp is matched only against the file name, but the entire line +is highlighted (with face `diredp-omit-file-name'). + +The default value of this option differs from that of +`dired-omit-files' by removing \"^\" from the beginning, and \"$\" +from the end, of each regexp choice. (The default value of +`dired-omit-files', at least prior to Emacs 27, uses \"^\" and \"$\", +but it should not.) + +If you want to control the beginning and end of choice matches then +use \"\\`\" and \"\\'\" instead of \"^\" and \"$\". + +Note: If you change the value of this option then you need to restart +Emacs to see the effect of the new value on font-locking." + :group 'Dired-Plus :type 'regexp) + +;;;###autoload +(defcustom diredp-prompt-for-bookmark-prefix-flag nil + "*Non-nil means prompt for a prefix string for bookmark names." + :type 'boolean :group 'Dired-Plus) + +;;;###autoload +(defcustom diredp-visit-ignore-regexps () + "Regexps matching file names for `diredp-visit-(next|previous)' to skip. +A file or directory name matching one of these regexps is skipped, +along with those with an extension in `diredp-visit-ignore-extensions'." + :type '(repeat regexp) :group 'Dired-Plus) + +;;;###autoload +(defcustom diredp-visit-ignore-extensions '("elc") + "Extensions of file names for `diredp-visit-(next|previous)' to skip. +A file name with one of these extensions is skipped, along with those +matching a regexp in `diredp-visit-ignore-regexps'." + :type '(repeat string) :group 'Dired-Plus) + +;;;###autoload +(defcustom diredp-w32-local-drives '(("C:" "Local disk")) + "*Local MS Windows drives that you want to use for `diredp-w32-drives'. +Each entry is a list (DRIVE DESCRIPTION), where DRIVE is the drive +name and DESCRIPTION describes DRIVE." + :type '(alist + :key-type (string :tag "Drive name") + :value-type (group (string :tag "Drive description"))) + :group 'Dired-Plus) + +;;;###autoload +(defcustom diredp-wrap-around-flag t + "*Non-nil means Dired \"next\" commands wrap around to buffer beginning." + :type 'boolean :group 'Dired-Plus) + +(when (fboundp 'dired-hide-details-mode) ; Emacs 24.4+ + (defvar diredp-hide-details-last-state diredp-hide-details-initially-flag + "Last `dired-hide-details-mode' value. +Initialized to the value of option `diredp-hide-details-initially-flag'.") + + (defvar diredp-hide-details-toggled nil + "Non-nil means you have already toggled hiding details in this buffer.") + (make-variable-buffer-local 'diredp-hide-details-toggled)) + +;; Same value as the default value of `icicle-re-no-dot'. +(defvar diredp-re-no-dot "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*" + "Regexp that matches anything except `.' and `..'.") + +(defvar diredp-w32-drives-mode-map (let ((map (make-sparse-keymap))) + (define-key map "q" 'bury-buffer) + (define-key map "\r" 'widget-button-press) + (define-key map [mouse-2] 'widget-button-click) + map) + "Keymap for `diredp-w32-drives-mode'.") + +;;; $$$$$$ Starting with Emacs 22, *-move-to* is defvaraliased to *-listing-before*. +;;; But `files+.el' defines *-listing-before*, so we define it here too. +;;; (unless (> emacs-major-version 21) +;;; (defvar directory-listing-before-filename-regexp dired-move-to-filename-regexp +;;; "Regular expression to match up to the file name in a directory listing. +;;; The default value is designed to recognize dates and times +;;; regardless of the language.")) + +;;; Macros + + +;; Unlike `dired-mark-if': +;; +;; 1. Value returned and message indicate both the number matched and the number changed. +;; 2. Added optional arg PLURAL, for irregular plurals (e.g. "directories"). +;; +(defmacro diredp-mark-if (predicate singular &optional plural) + "Mark files for PREDICATE, according to `dired-marker-char'. +PREDICATE is evaluated on each line, with point at beginning of line. +SINGULAR is a singular noun phrase for the type of files being marked. +Optional arg PLURAL is a plural noun phrase for the type of files + being marked. +If PLURAL is nil then SINGULAR should end with a noun that can be +pluralized by adding `s'. + +Return nil if no files matched PREDICATE. +Otherwise return a cons (CHANGED . MATCHED), where: + CHANGED is the number of markings that were changed by the operation. + MATCHED is the number of files that matched PREDICATE." + `(let ((inhibit-read-only t) + changed matched) + (save-excursion + (setq matched 0 + changed 0) + (when ,singular (message "%s %s%s..." + (cond ((eq dired-marker-char ?\040) "Unmarking") + ((eq dired-del-marker dired-marker-char) "Flagging") + (t "Marking")) + (or ,plural (concat ,singular "s")) + (if (eq dired-del-marker dired-marker-char) " for deletion" ""))) + (goto-char (point-min)) + (while (not (eobp)) + (when ,predicate + (setq matched (1+ matched)) + (unless (eq dired-marker-char (char-after)) + (delete-char 1) (insert dired-marker-char) (setq changed (1+ changed)))) + (forward-line 1)) + (when ,singular (message "%s %s%s%s newly %s%s" + matched + (if (= matched 1) ,singular (or ,plural (concat ,singular "s"))) + (if (not (= matched changed)) " matched, " "") + (if (not (= matched changed)) changed "") + (if (eq dired-marker-char ?\040) "un" "") + (if (eq dired-marker-char dired-del-marker) "flagged" "marked")))) + (and (> matched 0) (cons changed matched)))) + + +;; Just a helper function for `dired-map-over-marks'. +(defun diredp-get-file-or-dir-name (arg) + "Return name of next file or directory or nil if none. +Argument ARG: + `all-files-no-dirs' or nil means skip directories. + `all-files-no-dots' means skip `.' and `..'." + (let ((fname nil)) + (while (and (not fname) (not (eobp))) + (setq fname (dired-get-filename t t)) + (when (and fname (or (not arg) (eq arg 'all-files-no-dirs)) (file-directory-p fname)) + (setq fname nil)) + (when (and fname (eq arg 'all-files-no-dots) (or (member fname '("." "..")) + (diredp-string-match-p "/\\.\\.?$" fname))) + (setq fname nil)) + (forward-line 1)) + (forward-line -1) + fname)) + + +;; REPLACE ORIGINAL in `dired.el'. +;; +;; Treat multiple `C-u' specially. +;; +(defmacro dired-map-over-marks (body arg &optional show-progress + distinguish-one-marked) + "Eval BODY with point on each marked line. Return a list of BODY's results. +If no marked file could be found, execute BODY on the current line. +ARG, if non-nil, specifies the files to use instead of the marked files. + If ARG is an integer, use the next ARG files (previous -ARG, if < 0). + In that case, point is dragged along. This is so that commands on + the next ARG (instead of the marked) files can be easily chained. + If ARG is a cons with element 16, 64, or 256, corresponding to + `C-u C-u', `C-u C-u C-u', or `C-u C-u C-u C-u', then use all files + in the Dired buffer, where: + 16 includes NO directories (including `.' and `..') + 64 includes directories EXCEPT `.' and `..' + 256 includes ALL directories (including `.' and `..') + If ARG is otherwise non-nil, use the current file. +If optional third arg SHOW-PROGRESS evaluates to non-nil, + redisplay the Dired buffer after each file is processed. + +No guarantee is made about the position on the marked line. BODY must +ensure this itself, if it depends on this. + +Search starts at the beginning of the buffer, thus the car of the list +corresponds to the line nearest the end of the buffer. This is also +true for (positive and negative) integer values of ARG. + +BODY should not be too long, because it is expanded four times. + +If DISTINGUISH-ONE-MARKED is non-nil, then return (t FILENAME) instead + of (FILENAME), if only one file is marked." + ;; WARNING: BODY must not add new lines before point - this may cause an + ;; endless loop. This warning should not apply any longer, sk 2-Sep-1991 14:10. + `(prog1 + (let ((inhibit-read-only t) + (newarg ,arg) + multi-C-u case-fold-search found results) + (when (and (consp newarg) (> (prefix-numeric-value newarg) 4)) + (setq newarg (case (prefix-numeric-value newarg) + (16 'all-files-no-dirs) ; `C-u C-u' + (64 'all-files-no-dots) ; `C-u C-u C-u' + (256 'all-files) ; `C-u C-u C-u C-u' + (t 'all-files-no-dirs)) + multi-C-u t)) + (if (and newarg (not multi-C-u)) + (if (integerp newarg) + (progn ; No `save-excursion', want to move point. + (dired-repeat-over-lines newarg #'(lambda () + (when ,show-progress (sit-for 0)) + (setq results (cons ,body results)))) + (if (< newarg 0) (nreverse results) results)) + ;; Non-nil, non-integer ARG means use current file: + (list ,body)) + (let ((regexp (dired-marker-regexp)) + next-position) + (save-excursion + (goto-char (point-min)) + ;; Remember position of next marked file before BODY can insert lines before the + ;; just found file, confusing us by finding the same marked file again and again... + (setq next-position (and (if multi-C-u + (diredp-get-file-or-dir-name newarg) + (re-search-forward regexp nil t)) + (point-marker)) + found (not (null next-position))) + (while next-position + (goto-char next-position) + (when ,show-progress (sit-for 0)) + (setq results (cons ,body results)) + ;; move after last match + (goto-char next-position) + (forward-line 1) + (set-marker next-position nil) + (setq next-position (and (if multi-C-u + (diredp-get-file-or-dir-name newarg) + (re-search-forward regexp nil t)) + (point-marker))))) + (when (and ,distinguish-one-marked (= (length results) 1)) + (setq results (cons t results))) + (if found results (list ,body))))) + ;; `save-excursion' loses, again + (dired-move-to-filename))) + +;; Same as `icicle-with-help-window' in `icicles-mac.el' +;; and `bmkp-with-help-window' in `bookmark+-mac.el'. +(defmacro diredp-with-help-window (buffer &rest body) + "`with-help-window', if available; else `with-output-to-temp-buffer'." + (if (fboundp 'with-help-window) + `(with-help-window ,buffer ,@body) + `(with-output-to-temp-buffer ,buffer ,@body))) + +(put 'diredp-with-help-window 'common-lisp-indent-function '(4 &body)) + +;;; Utility functions + +;; Same as `imenup-delete-if-not'. +;; +(defun diredp-delete-if-not (predicate xs) + "Remove all elements of list XS that do not satisfy PREDICATE. +This operation is destructive, reusing conses of XS whenever possible." + (while (and xs (not (funcall predicate (car xs)))) + (setq xs (cdr xs))) + (let ((cl-p xs)) + (while (cdr cl-p) + (if (not (funcall predicate (cadr cl-p))) (setcdr cl-p (cddr cl-p)) (setq cl-p (cdr cl-p))))) + xs) + +;; Same as `imenup-delete-if'. +;; +(defun diredp-delete-if (predicate xs) + "Remove all elements of list XS that satisfy PREDICATE. +This operation is destructive, reusing conses of XS whenever possible." + (while (and xs (funcall predicate (car xs))) + (setq xs (cdr xs))) + (let ((cl-p xs)) + (while (cdr cl-p) + (if (funcall predicate (cadr cl-p)) + (setcdr cl-p (cddr cl-p)) + (setq cl-p (cdr cl-p))))) + xs) + +;; Same as `tap-string-match-p' in `thingatpt+.el'. +(if (fboundp 'string-match-p) + (defalias 'diredp-string-match-p 'string-match-p) ; Emacs 23+ + (defun diredp-string-match-p (regexp string &optional start) + "Like `string-match', but this saves and restores the match data." + (save-match-data (string-match regexp string start)))) + +(if (fboundp 'looking-at-p) + (defalias 'diredp-looking-at-p 'looking-at-p) ; Emacs 23+ + (defun diredp-looking-at-p (regexp) + "Like `looking-at', but this saves and restores the match data." + (save-match-data (looking-at regexp)))) + +;; `dired-read-regexp' does not accept DEFAULT and HISTORY for older Emacsen, so use this. +(defun diredp-read-regexp (prompt &optional default history) + "Read a regexp. +HISTORY defaults to `dired-regexp-history'." + (setq history (or history 'dired-regexp-history)) + (if (fboundp 'read-regexp) + (read-regexp prompt default history) + (read-from-minibuffer prompt nil nil nil history default))) + +(if (fboundp 'delete-dups) + (defalias 'diredp-delete-dups 'delete-dups) + (defun diredp-delete-dups (list) + "Destructively remove `equal' duplicates from LIST. +Store the result in LIST and return it. LIST must be a proper list. +Of several `equal' occurrences of an element in LIST, the first +one is kept." + (let ((tail list)) + (while tail + (setcdr tail (delete (car tail) (cdr tail))) + (setq tail (cdr tail)))) + list)) + +(defun diredp-nonempty-region-p () + "Return non-nil if region is active and non-empty." + (and transient-mark-mode mark-active (mark) (> (region-end) (region-beginning)))) + +(defun diredp-get-image-filename (&optional localp no-error-if-not-filep) + "Return the image-file name on this line, or nil if no image file. +If not in Dired (or a mode derived from Dired), then test the entire +text of the current line as the file name. + +The optional args are the same as for `dired-get-filename'. They are +ignored if not in a Dired mode. + +\(Prior to Emacs 22, this function just returns nil.)" + (let ((file (if (derived-mode-p 'dired-mode) + (dired-get-filename localp no-error-if-not-filep) + ;; Make it work also for `diredp-list-files' listings. + (buffer-substring-no-properties (line-beginning-position) (line-end-position))))) + (and file + (fboundp 'image-file-name-regexp) ; Emacs 22+, `image-file.el'. + (diredp-string-match-p (image-file-name-regexp) file) + file))) + +(defun diredp-root-directory-p (file) + "Return non-nil if FILE is a root directory." + (if (fboundp 'ange-ftp-root-dir-p) + (ange-ftp-root-dir-p (file-name-as-directory file)) + ;; This is essentially `ange-ftp-root-dir-p' applied to `file-name-as-directory'. + ;; If `ange-ftp-root-dir-p' changes, update this code. + (or (and (eq system-type 'windows-nt) (diredp-string-match-p "\\`[a-zA-Z]:[/\\]\\'" + (file-name-as-directory file))) + (string= "/" file)))) + +(defun diredp-parent-dir (file &optional relativep) + "Return the parent directory of FILE, or nil if none. +Optional arg RELATIVEP non-nil means return a relative name, that is, +just the parent component." + (let ((parent (file-name-directory (directory-file-name (expand-file-name file)))) + relparent) + (when relativep (setq relparent (file-name-nondirectory (directory-file-name parent)))) + (and (not (equal parent file)) (or relparent parent)))) + +(unless (fboundp 'derived-mode-p) ; Emacs 20, 21. + (defun derived-mode-p (&rest modes) + "Non-nil if the current major mode is derived from one of MODES. +Uses the `derived-mode-parent' property of the symbol to trace backwards." + (let ((parent major-mode)) + (while (and (not (memq parent modes)) (setq parent (get parent 'derived-mode-parent)))) + parent))) + +(defun diredp-ensure-mode () + "Raise an error if not in Dired or a mode derived from it." + (unless (derived-mode-p 'dired-mode) + (error "You must be in Dired or a mode derived from it to use this command"))) + +(defun diredp-ensure-bookmark+ () + (unless (require 'bookmark+ nil t) (error "This command requires library `bookmark+.el'"))) + + +(unless (fboundp 'dired-nondirectory-p) ; Emacs 20, 21. + (defun dired-nondirectory-p (file) + "Return non-nil if FILE is not a directory." + (not (file-directory-p file)))) + + +;;; Some of the redefinitions that follow are essentially unaltered vanilla Emacs code to be +;;; reloaded, to use the new definition of `dired-map-over-marks' here. + + +;; REPLACE ORIGINAL in `dired.el'. +;; +;; 1. Pass non-nil second arg to `dired-get-filename' so we can include `.' and `..'. +;; 2. Doc string is updated to reflect the new ARG behavior. +;; 3. Allow, unlike vanilla Emacs, use of FILTER and DISTINGUISH-ONE-MARKED together. +;; +(defun dired-get-marked-files (&optional localp arg filter distinguish-one-marked error-if-none-p) + "Return names of the marked files and directories as a list of strings. +The list is in the same order as the buffer, that is, the car is the + first marked file. +Values returned are normally absolute file names. +Optional arg LOCALP as in `dired-get-filename'. +Optional second argument ARG specifies files to use instead of marked. + Usually ARG comes from the command's prefix arg. + If ARG is an integer, use the next ARG files (previous -ARG, if < 0). + If ARG is a cons with element 16, 64, or 256, corresponding to + `C-u C-u', `C-u C-u C-u', or `C-u C-u C-u C-u', then use all files + in the Dired buffer, where: + 16 includes NO directories (including `.' and `..') + 64 includes directories EXCEPT `.' and `..' + 256 includes ALL directories (including `.' and `..') + If ARG is otherwise non-nil, use the current file. +Optional third argument FILTER, if non-nil, is a function to select + some of the files: those for which (funcall FILTER FILENAME) is + non-nil. +If DISTINGUISH-ONE-MARKED is non-nil, then return (t FILENAME) instead + of (FILENAME) if only one file is marked (after any filtering by + FILTER). +If ERROR-IF-NONE-P is non-nil, signal an error if the list of files is + empty. If ERROR-IF-NONE-P is a string then it is the error message. + +Note that the Dired+ version of this function differs from the vanilla +version in these respects: + +* There are more possibilities for argument ARG (prefix argument). +* Directories `.' and `..' can be included as marked. +* You can use arguments FILTER and DISTINGUISH-ONE-MARKED together." + (let ((all (delq nil (save-excursion (dired-map-over-marks (dired-get-filename localp 'NO-ERROR-IF-NOT-FILEP) + arg + nil + distinguish-one-marked)))) + result) + (when (equal all '(t)) (setq all nil)) ; Added by vanilla Emacs 24+. + (if (and distinguish-one-marked (eq (car all) t)) + (if (not filter) + all + (and (funcall filter (cadr all)) (list t (cadr all)))) + (dolist (file all) + (when (or (not filter) (funcall filter file)) (push file result))) + (when (and (null result) error-if-none-p) + (diredp-user-error (if (stringp error-if-none-p) error-if-none-p "No files specified"))) + result))) + + +;; REPLACE ORIGINAL in `dired-aux.el'. +;; +;; 1. Define here to make use of my `dired-map-over-marks'. +;; 2. Added &rest arg FUN-ARGS. +;; 3. Added doc string. +;; +(defun dired-map-over-marks-check (fun mark-arg op-symbol &optional show-progress &rest fun-args) + "Map FUN over marked lines and display failures. +FUN returns non-nil (the offending object, e.g. the short form of the +filename) for a failure and probably logs a detailed error explanation +using function `dired-log'. + +MARK-ARG is as the second argument of `dired-map-over-marks'. + +OP-SYMBOL is a symbol describing the operation performed (e.g. +`compress'). It is used with `dired-mark-pop-up' to prompt the user +\(e.g. with `Compress * [2 files]? ') and to display errors (e.g. +`Failed to compress 1 of 2 files - type ? for details (\"foo\")') + +SHOW-PROGRESS if non-nil means redisplay Dired after each file. + +FUN-ARGS is the list of any remaining args to +`dired-map-over-marks-check'. Function FUN is applied to these +arguments." + (and (dired-mark-confirm op-symbol mark-arg) + (let* ((results (dired-map-over-marks (apply fun fun-args) mark-arg show-progress)) ; FUN return vals. + (nb-results (length results)) + (failures (delq nil results)) + (nb-fail (length failures)) + (op-strg (if (eq op-symbol 'compress) "Compress or uncompress" (capitalize + (symbol-name op-symbol))))) + (if (null failures) + (message "%s: %d file%s." op-strg nb-results (dired-plural-s nb-results)) + (dired-log-summary (format "Failed to %s %d of %d file%s" + (downcase op-strg) nb-fail nb-results (dired-plural-s nb-results)) + failures))))) + +;; Like `dired-map-over-marks-check', but `dired-log-summary' is always called, and first arg passed is different. +;; +(defun diredp-map-over-marks-and-report (fun mark-arg op-symbol &optional show-progress &rest fun-args) + "Map FUN over marked lines and report the results. +FUN returns non-nil (the offending object, e.g. the short form of the +filename) for a failure and probably logs a detailed error explanation +using function `dired-log'. + +MARK-ARG is as the second argument of `dired-map-over-marks'. + +OP-SYMBOL is a symbol describing the operation performed (e.g. +`compress'). It is used with `dired-mark-pop-up' to prompt the user +\(e.g. with `Compress * [2 files]? ') and to display errors (e.g. +`Failed to compress 1 of 2 files - type ? to see why (\"foo\")') + +SHOW-PROGRESS if non-nil means redisplay Dired after each file. + +FUN-ARGS is the list of any remaining args to +`diredp-map-over-marks-and-report'. Function FUN is applied to these +arguments." + (and (dired-mark-confirm op-symbol mark-arg) + (let* ((results (dired-map-over-marks (apply fun fun-args) mark-arg show-progress)) ; FUN return vals. + (nb-results (length results)) + (failures (delq nil results)) + (nb-fail (length failures)) + (op-strg (capitalize (symbol-name op-symbol)))) + (dired-log-summary (format "%s for %d file%s%s" + op-strg nb-results (dired-plural-s nb-results) + (if failures (format ": %d failures" nb-fail) "")) + failures)))) + + +;; REPLACE ORIGINAL in `dired-aux.el'. +;; +(when (boundp 'dired-subdir-switches) ; Emacs 22+ + (defun dired-do-redisplay (&optional arg test-for-subdir) ; Bound to `l' + "Redisplay all marked (or next ARG) files. +If on a subdir line, redisplay that subdirectory. In that case, +a prefix arg lets you edit the `ls' switches used for the new listing. + +Dired remembers switches specified with a prefix arg, so that reverting +the buffer will not reset them. However, using `dired-undo' to re-insert +or delete subdirectories can bypass this machinery. Hence, you sometimes +may have to reset some subdirectory switches after a `dired-undo'. +You can reset all subdirectory switches to the default using +\\\\[dired-reset-subdir-switches]. +See Info node `(emacs)Subdir switches' for more details." + ;; Moves point if the next ARG files are redisplayed. + (interactive "P\np") + (if (and test-for-subdir (dired-get-subdir)) + (let* ((dir (dired-get-subdir)) + (switches (cdr (assoc-string dir dired-switches-alist)))) + (dired-insert-subdir dir (and arg (read-string "Switches for listing: " + (or switches + dired-subdir-switches + dired-actual-switches))))) + (message "Redisplaying...") + ;; `message' is much faster than making `dired-map-over-marks' show progress + (dired-uncache (if (consp dired-directory) (car dired-directory) dired-directory)) + (dired-map-over-marks (let ((fname (dired-get-filename)) + ;; Postpone readin hook map over all marked files (Bug#6810). + (dired-after-readin-hook nil)) + (message "Redisplaying... `%s'" fname) + (dired-update-file-line fname)) + arg) + (run-hooks 'dired-after-readin-hook) + (dired-move-to-filename) + (message "Redisplaying...done")))) + + +;; REPLACE ORIGINAL in `dired-aux.el'. +;; +(unless (boundp 'dired-subdir-switches) ; Emacs 20, 21 + (defun dired-do-redisplay (&optional arg test-for-subdir) ; Bound to `l' + "Redisplay all marked (or next ARG) files. +If on a subdir line, redisplay that subdirectory. In that case, +a prefix arg lets you edit the `ls' switches used for the new listing." + ;; Moves point if the next ARG files are redisplayed. + (interactive "P\np") + (if (and test-for-subdir (dired-get-subdir)) + (dired-insert-subdir (dired-get-subdir) + (and arg (read-string "Switches for listing: " dired-actual-switches))) + (message "Redisplaying...") + ;; `message' is much faster than making dired-map-over-marks show progress + (dired-uncache (if (consp dired-directory) (car dired-directory) dired-directory)) + (dired-map-over-marks (let ((fname (dired-get-filename))) + (message "Redisplaying... `%s'" fname) + (dired-update-file-line fname)) + arg) + (dired-move-to-filename) + (message "Redisplaying...done")))) + + +;; REPLACE ORIGINAL in `dired.el'. +;; +(when (fboundp 'get-window-with-predicate) ; Emacs 22+ + (defun dired-dwim-target-directory () + "Guess a target directory to use for Dired. +If there is a Dired buffer displayed in another window, use its +current subdir, else use current subdir of this Dired buffer." + (let ((this-dir (and (eq major-mode 'dired-mode) (dired-current-directory)))) + ;; Non-dired buffer may want to profit from this function, e.g. `vm-uudecode'. + (if dired-dwim-target + (let* ((other-win (get-window-with-predicate (lambda (window) + (with-current-buffer (window-buffer window) + (eq major-mode 'dired-mode))) + nil + (and diredp-dwim-any-frame-flag 'visible))) + (other-dir (and other-win (with-current-buffer (window-buffer other-win) + (and (eq major-mode 'dired-mode) (dired-current-directory)))))) + (or other-dir this-dir)) + this-dir)))) + + +;; REPLACE ORIGINAL in `dired.el'. +;; +;; 1. Added behavior for non-positive prefix arg: +;; * Construct a cons DIRNAME arg. +;; * Read a Dired buffer name (not a directory) for its car. +;; * If READ-EXTRA-FILES-P is non-nil then read any number of file and dir names, to be included as its cdr. +;; * If chosen Dired buffer exists and is an ordinary listing then start out with its `directory-files'. +;; +;; 2. If you use Icicles then this is a multi-command - see doc for `dired' defadvice. +;; +(defun dired-read-dir-and-switches (string &optional read-extra-files-p dired-buffer) + "Read arguments for `dired' commands. +STRING is added to the prompt after \"Dired \". If not \"\", it should +end with a space. + +With a non-negative prefix arg, read the `ls' switches. +With a non-negative prefix arg or none, read the directory to Dired. + +With a non-positive prefix arg: +* If DIRED-BUFFER is non-nil, it is the name of the Dired buffer to + use. Otherwise, read it (it is not necessarily a directory name). + If in Dired now, the current buffer name is the default. +* If READ-EXTRA-FILES-P is non-nil then read any number of directory + or file names, to make up the Dired arbitrary-files listing. You + can use file-name wildcards (i.e., `*' for globbing), to include the + matching files and directories. Use `C-g' when done entering the + files and directories to list. + +Return a list of arguments for `dired': (DIRNAME SWITCHES). DIRNAME +here has the same form as `dired-directory'. When a non-positive +prefix arg is used, DIRNAME is a cons of the buffer name and the list +of file names. + +If you use Icicles then reading uses Icicles completion, with +additional multi-command keys. See `dired' (defadvice doc)." + (let* ((switchs (and current-prefix-arg + (natnump (prefix-numeric-value current-prefix-arg)) + (read-string "Dired listing switches: " + dired-listing-switches))) + (icicle-candidate-action-fn + (lambda (cand) + (dired-other-window cand (and current-prefix-arg (read-string "Dired listing switches: " + dired-listing-switches))) + (select-window (minibuffer-window)) + (select-frame-set-input-focus (selected-frame)))) +;;; $$$$$$ Alternative: Could choose no-op for non-dir candidate. +;;; (icicle-candidate-action-fn +;;; (lambda (cand) +;;; (cond ((file-directory-p cand) +;;; (dired-other-window cand (and current-prefix-arg (read-string "Dired listing switches: " +;;; dired-listing-switches))) +;;; (select-window (minibuffer-window)) +;;; (select-frame-set-input-focus (selected-frame))) +;;; (t +;;; (message "Not a directory: `%s'" cand) (sit-for 2))))) + (icicle-all-candidates-list-alt-action-fn ; M-|' + (lambda (files) + (let ((enable-recursive-minibuffers t)) + (dired-other-window (cons (read-string (format "Dired %s(buffer name): " string)) files))))) + (icicle-sort-comparer (or (and (boundp 'icicle-file-sort) ; If not reading files + icicle-file-sort) ; then dirs first. + (and (> (prefix-numeric-value current-prefix-arg) 0) + 'icicle-dirs-first-p) + (and (boundp 'icicle-sort-comparer) + icicle-sort-comparer))) + + ;; The rest of the bindings are from `icicle-file-bindings', in `icicles-mac.el'. + (completion-ignore-case + (or (and (boundp 'read-file-name-completion-ignore-case) read-file-name-completion-ignore-case) + completion-ignore-case)) + (icicle-show-Completions-initially-flag (and (boundp 'icicle-show-Completions-initially-flag) + (or icicle-show-Completions-initially-flag + icicle-files-ido-like-flag))) + (icicle-top-level-when-sole-completion-flag (and (boundp 'icicle-top-level-when-sole-completion-flag) + (or icicle-top-level-when-sole-completion-flag + icicle-files-ido-like-flag))) + (icicle-default-value (and (boundp 'icicle-default-value) + (if (and icicle-files-ido-like-flag + icicle-default-value) + icicle-files-ido-like-flag + ;; Get default via `M-n', but do not insert it. + (and (memq icicle-default-value '(t nil)) + icicle-default-value)))) + (icicle-must-match-regexp (and (boundp 'icicle-file-match-regexp) + icicle-file-match-regexp)) + (icicle-must-not-match-regexp (and (boundp 'icicle-file-no-match-regexp) + icicle-file-no-match-regexp)) + (icicle-must-pass-after-match-predicate (and (boundp 'icicle-file-predicate) + icicle-file-predicate)) + (icicle-require-match-flag (and (boundp 'icicle-file-require-match-flag) + icicle-file-require-match-flag)) + (icicle-file-completing-p t) + (icicle-extra-candidates (and (boundp 'icicle-file-extras) icicle-file-extras)) + (icicle-transform-function 'icicle-remove-dups-if-extras) + ;; Put `icicle-file-sort' first. If already in the list, move it, else add it, to beginning. + (icicle--temp-orders (and (boundp 'icicle-sort-orders-alist) + (copy-sequence icicle-sort-orders-alist))) + (icicle-candidate-help-fn (lambda (cand) + (icicle-describe-file cand current-prefix-arg t))) + (icicle-candidate-alt-action-fn (and (boundp 'icicle-candidate-alt-action-fn) + (or icicle-candidate-alt-action-fn + (icicle-alt-act-fn-for-type "file")))) + (icicle-delete-candidate-object 'icicle-delete-file-or-directory) + (icicle-sort-orders-alist + (and (boundp 'icicle-sort-orders-alist) + (progn (when t ; $$$$ (and icicle-file-sort-first-time-p icicle-file-sort) + (setq icicle-sort-comparer icicle-file-sort)) + ; $$$$ (setq icicle-file-sort-first-time-p nil)) + (if icicle-file-sort + (let ((already-there (rassq icicle-file-sort icicle--temp-orders))) + (if already-there + (cons already-there (setq icicle--temp-orders (delete already-there + icicle--temp-orders))) + (cons `("by `icicle-file-sort'" ,@icicle-file-sort) icicle--temp-orders))) + icicle--temp-orders))))) + (when (fboundp 'icicle-bind-file-candidate-keys) (icicle-bind-file-candidate-keys)) + (unwind-protect + (list + (if (> (prefix-numeric-value current-prefix-arg) 0) + ;; If a dialog box is about to be used, call `read-directory-name' so the dialog + ;; code knows we want directories. Some dialog boxes can only select directories + ;; or files when popped up, not both. If no dialog box is used, call `read-file-name' + ;; because the user may want completion of file names for use in a wildcard pattern. + (funcall (if (and (fboundp 'read-directory-name) (next-read-file-uses-dialog-p)) + #'read-directory-name + #'read-file-name) + (format "Dired %s(directory): " string) nil default-directory nil) + (dolist (db dired-buffers) ; Remove any killed buffers from `dired-buffers' (even if DIRED-BUFFER). + (unless (buffer-name (cdr db)) (setq dired-buffers (delq db dired-buffers)))) + (let* ((dbufs (and (not dired-buffer) + (mapcar (lambda (db) (list (buffer-name (cdr db)))) dired-buffers))) + (dirbuf (or dired-buffer + (completing-read (format "Dired %s(buffer name): " string) dbufs nil nil nil nil + (and (derived-mode-p 'dired-mode) (buffer-name))))) + (files (and (diredp-existing-dired-buffer-p dirbuf) + (with-current-buffer (get-buffer dirbuf) + (and (not (consp dired-directory)) + (directory-files dired-directory 'FULL diredp-re-no-dot))))) + file) + (when read-extra-files-p + (while (condition-case nil ; Use lax completion, to allow wildcards. + (setq file (read-file-name "File or dir (C-g when done): ")) + (quit nil)) + ;; Do not allow root dir (`/' or a Windows drive letter, e.g. `d:/'). + (if (diredp-root-directory-p file) + (progn (message "Cannot choose root directory") (sit-for 1)) + (push file files)))) + (cons dirbuf files))) + switchs) + (when (fboundp 'icicle-unbind-file-candidate-keys) (icicle-unbind-file-candidate-keys))))) + + +;;; $$$$$$$$ An alternative implementation - different behavior. +;;; +;;; ;; REPLACE ORIGINAL in `dired.el'. +;;; ;; +;;; ;; Non-positive prefix arg means construct cons DIRNAME arg: Read Dired name and files/dirs. +;;; ;; +;;; (defun dired-read-dir-and-switches (string) +;;; "Read arguments for `dired'. +;;; With a non-negative prefix arg, prompt first for `ls' switches. +;;; With a non-positive prefix arg, read the Dired buffer name and then +;;; read any number of dir or file names, to make up the Dired listing. + +;;; STRING is appended to the prompt, unless prefix arg is non-positive. +;;; If non-empty, STRING should begin with a SPC." +;;; (let ((switches (and current-prefix-arg +;;; (>= (prefix-numeric-value current-prefix-arg) 0) +;;; (read-string "Dired listing switches: " dired-listing-switches))) +;;; (formt (format "Dired %s(directory): " string)) +;;; (entries ()) +;;; (curr-entry "")) +;;; (when (and current-prefix-arg (<= (prefix-numeric-value current-prefix-arg) 0)) +;;; (push (completing-read "Dired buffer name: " dired-buffers) entries) +;;; (setq curr-entry (read-file-name (format "Dir or file: ") nil "" 'MUST-MATCH)) +;;; (while (not (equal "" curr-entry)) +;;; (push curr-entry entries) +;;; (setq curr-entry (read-file-name (format "Dir or file: ") nil "" 'MUST-MATCH))) +;;; (unless (cadr entries) (push default-directory entries))) +;;; (list (or (nreverse entries) (if (and (fboundp 'next-read-file-uses-dialog-p) +;;; (next-read-file-uses-dialog-p)) +;;; (read-directory-name formt nil default-directory nil) +;;; (read-file-name formt nil default-directory nil))) +;;; switches))) + + +;; ADVISE ORIGINAL in `dired.el'. +;; +;; Add to doc string, to document non-positive prefix arg. +;; +(defadvice dired (before diredp-doc-cons-arg activate) + "Interactively, a prefix argument changes the behavior as follows: + +* If >= 0, you are first prompted for the `ls' switches to use. + +* If <= 0, you are prompted first for the name of the Dired buffer. + Then you are prompted repeatedly for the names of the directories + or files to list in the buffer. You can use file-name wildcards + (i.e., `*' for globbing), to include the matching files and + directories. Use `C-g' to end. + + In other words, instead of listing a single directory, the Dired + buffer can list any number of directories and file names, which can + even belong to different directory trees. + +The rest of this description applies only if you use Icicles. + +In Icicle mode this is a multi-command: You can cycle among file-name +completion candidates and act individually on those that name +directories. The action is to open Dired for the directory. While +cycling, these keys are active: + +\\\ +`C-mouse-2', `C-return' - Act on current completion candidate only +`C-down', `C-wheel-down' - Move to next completion candidate and act +`C-up', `C-wheel-up' - Move to previous completion candidate and act +`C-next' - Move to next apropos-completion candidate and act +`C-prior' - Move to previous apropos-completion candidate and act +`C-end' - Move to next prefix-completion candidate and act +`C-home' - Move to previous prefix-completion candidate and act +`\\[icicle-all-candidates-action]' - Act on *all* candidates, successively (careful!) +`\\[icicle-all-candidates-list-alt-action]' - Open Dired on all candidates + +When candidate action and cycling are combined (e.g. `C-next'), user +option `icicle-act-before-cycle-flag' determines which occurs first. + +With prefix `C-M-' instead of `C-', the same keys (`C-M-mouse-2', +`C-M-RET', `C-M-down', and so on) provide help about candidates. + +Use `mouse-2', `RET', or `S-RET' to finally choose a candidate, or +`C-g' to quit. + +These keys are also bound in the minibuffer during completion (`*' +means the key requires library `Bookmark+'): + + S-delete - Delete candidate file or (empty) dir + C-c + - Create a new directory + C-backspace - Go up one directory level + * C-x C-t * - Narrow to files with all of the tags you specify + * C-x C-t + - Narrow to files with some of the tags you specify + * C-x C-t % * - Narrow to files with all tags matching a regexp + * C-x C-t % + - Narrow to files with some tags matching a regexp + * C-x a + - Add tags to the current-candidate file + * C-x a - - Remove tags from the current-candidate file + * C-x m - Access file bookmarks (not just autofiles)" + (interactive (dired-read-dir-and-switches "" 'READ-EXTRA-FILES-P))) + + +;; ADVISE ORIGINAL in `dired.el'. +;; +;; Add to doc string, to document non-positive prefix arg. +;; +(defadvice dired-other-window (before diredp-doc-cons-arg activate) + "Interactively, a prefix argument changes the behavior. +A non-positive prefix arg lets you choose an explicit set of files and +directories to list. See the advice for `dired' for more information." + (interactive (dired-read-dir-and-switches "" 'READ-EXTRA-FILES-P))) + + +;; ADVISE ORIGINAL in `dired.el'. +;; +;; Add to doc string, to document non-positive prefix arg. +;; +(defadvice dired-other-frame (before diredp-doc-cons-arg activate) + "Interactively, a prefix argument changes the behavior. +A non-positive prefix arg lets you choose an explicit set of files and +directories to list. See the advice for `dired' for more information." + (interactive (dired-read-dir-and-switches "" 'READ-EXTRA-FILES-P))) + + +;; REPLACE ORIGINAL in `dired.el'. +;; +;; Made compatible with Emacs 20, 21, which do not have [:alnum]. +;; Also, this is defined here because it is used elsewhere in the file. +;; +(defun dired-switches-escape-p (switches) + "Return non-nil if the string SWITCHES contains `-b' or `--escape'." + (if (fboundp 'dired-switches-check) ; Emacs 24.4+ - see Emacs bug #17218. + (dired-switches-check switches "escape" "b") + ;; Do not match things like "--block-size" that happen to contain "b". + (if (> emacs-major-version 21) ; SWITCHES must be a string here, not nil. + (diredp-string-match-p "\\(\\`\\| \\)-[[:alnum:]]*b\\|--escape\\>" switches) + (diredp-string-match-p "\\(\\`\\| \\)-\\(\w\\|[0-9]\\)*b\\|--escape\\>" switches)))) + + +;; From `dired.el' + +(when (and (> emacs-major-version 22) (featurep 'ls-lisp+)) + +;;; 2012/04/26: Commented this out. +;;; Might need it again when update `ls-lisp+.el' to fix other things. +;;; +;;; ;; Use t as WILDCARD arg to `dired-insert-directory'. +;;; ;; +;;; (defun dired-readin-insert () +;;; ;; Insert listing for the specified dir (and maybe file list) +;;; ;; already in dired-directory, assuming a clean buffer. +;;; (let (dir file-list) +;;; (if (consp dired-directory) +;;; (setq dir (car dired-directory) +;;; file-list (cdr dired-directory)) +;;; (setq dir dired-directory +;;; file-list ())) +;;; (setq dir (expand-file-name dir)) +;;; (if (and (equal "" (file-name-nondirectory dir)) (not file-list)) +;;; ;; If we are reading a whole single directory... +;;; (dired-insert-directory dir dired-actual-switches nil nil t) +;;; (unless (file-readable-p (directory-file-name (file-name-directory dir))) +;;; (error "Directory `%s' inaccessible or nonexistent" dir)) +;;; ;; Else treat it as a wildcard spec. +;;; (dired-insert-directory dir dired-actual-switches file-list t t)))) + + + ;; REPLACE ORIGINAL in `dired.el'. + ;; + ;; Compute WILDCARD arg for `insert-directory' for individual file (don't just use nil). + ;; + (defun dired-insert-directory (dir switches &optional file-list wildcard hdr) + "Insert a directory listing of DIR, Dired style. +Use SWITCHES to make the listings. +If FILE-LIST is non-nil, list only those files. +Otherwise, if WILDCARD is non-nil, expand wildcards; + in that case, DIR should be a file name that uses wildcards. +In other cases, DIR should be a directory name or a directory filename. +If HDR is non-nil, insert a header line with the directory name." + (let ((opoint (point)) + (process-environment (copy-sequence process-environment)) + end) + (when (and + ;; Do not try to invoke `ls' if on DOS/Windows, where `ls-lisp' is used, unless + ;; the user really wants to use `ls', as indicated by + ;; `ls-lisp-use-insert-directory-program'. + (or (not (featurep 'ls-lisp)) ls-lisp-use-insert-directory-program) + (or (if (eq dired-use-ls-dired 'unspecified) + ;; Check if "ls --dired" gives exit code 0. Put it in `dired-use-ls-dired'. + (or (setq dired-use-ls-dired (eq 0 (call-process insert-directory-program + nil nil nil "--dired"))) + (progn (message "Command `ls' does not support switch `--dired' - see \ +`dired-use-ls-dired'.") + nil)) + dired-use-ls-dired) + (file-remote-p dir))) + (setq switches (concat "--dired " switches))) + ;; We used to specify the C locale here, to force English month names. This should not be + ;; necessary any more with the new value of `directory-listing-before-filename-regexp'. + (if file-list + (dolist (f file-list) + (let ((beg (point))) + ;; Compute wildcard arg for this file. + (insert-directory f switches (diredp-string-match-p "[[?*]" f) nil) + ;; Re-align fields, if necessary. + (dired-align-file beg (point)))) + (insert-directory dir switches wildcard (not wildcard))) + ;; Quote certain characters, unless `ls' quoted them for us. + (unless (dired-switches-escape-p dired-actual-switches) + (save-excursion + (setq end (point-marker)) + (goto-char opoint) + (while (search-forward "\\" end t) + (replace-match (apply #'propertize "\\\\" (text-properties-at (match-beginning 0))) + nil t)) + (goto-char opoint) + (while (search-forward "\^m" end t) + (replace-match (apply #'propertize "\\015" (text-properties-at (match-beginning 0))) + nil t)) + (set-marker end nil)) + ;; Comment in original, from some Emacs Dev developer: + ;; + ;; Replace any newlines in DIR with literal "\n" for the sake of the header line. To + ;; disambiguate a literal "\n" in the actual dirname, we also replace "\" with "\\". + ;; I think this should always be done, irrespective of the value of + ;; dired-actual-switches, because: + ;; i) Dired does not work with an unescaped newline in the directory name used in the + ;; header (bug=10469#28), and + ;; ii) "\" is always replaced with "\\" in the listing, so doing it in the header as + ;; well makes things consistent. + ;; But at present it is done only if "-b" is in ls-switches, because newlines in dirnames + ;; are uncommon, and people may have gotten used to seeing unescaped "\" in the headers. + ;; Note: adjust `dired-build-subdir-alist' if you change this. + (setq dir (replace-regexp-in-string "\\\\" "\\\\" dir nil t) + dir (replace-regexp-in-string "\n" "\\n" dir nil t))) + ;; If we used `--dired' and it worked, the lines are already indented. Else indent them. + (unless (save-excursion (goto-char opoint) (diredp-looking-at-p " ")) + (let ((indent-tabs-mode nil)) (indent-rigidly opoint (point) 2))) + ;; Insert text at the beginning to standardize things. + (let ((content-point opoint)) + (save-excursion + (goto-char opoint) + (when (and (or hdr wildcard) (not (and (looking-at "^ \\(.*\\):$") + (file-name-absolute-p (match-string 1))))) + ;; `dired-build-subdir-alist' will replace the name by its expansion, so it does not + ;; matter whether what we insert here is fully expanded, but it should be absolute. + (insert " " (directory-file-name (file-name-directory dir)) ":\n") + (setq content-point (point))) + (when wildcard + ;; Insert "wildcard" line where "total" line would be for a full dir. + (insert " wildcard " (file-name-nondirectory dir) "\n"))) + (dired-insert-set-properties content-point (point)))))) + + +;;; Image stuff. + +(defun diredp-image-dired-required-msg () + "Raise an error if `image-dired.el' is not loaded." + (unless (require 'image-dired nil t) (error "This command requires library `image-dired.el'"))) + +;; See `image-dired-create-thumb'. +;; Define this even if `image-dired.el' is not loaded. +;; Do NOT raise an error if not loaded, because this is used in `diredp-mouseover-help'. +;;;###autoload +(defun diredp-image-dired-create-thumb (file &optional arg) + "Create thumbnail image file for FILE (default: file on current line). +With a prefix arg, replace any existing thumbnail for FILE. +With a numeric prefix arg (not a cons), use it as the thumbnail size. +Return the name of the thumbnail image file, or nil if none." + (interactive (list (if (derived-mode-p 'dired-mode) + (dired-get-filename nil 'NO-ERROR) + ;; Make it work also for `diredp-list-files' listings. + (buffer-substring-no-properties (line-beginning-position) (line-end-position))) + current-prefix-arg)) + (and (fboundp 'image-dired-thumb-name) ; No-op (return nil) if `image-dired.el' not loaded. + (let ((thumb-name (image-dired-thumb-name file))) + (when arg (clear-image-cache)) + (when (or arg (not (file-exists-p thumb-name))) + (let ((image-dired-thumb-width (or (and arg (atom arg) arg) image-dired-thumb-width)) + (image-dired-thumb-height (or (and arg (atom arg) arg) image-dired-thumb-height))) + (unless (zerop (image-dired-create-thumb file thumb-name)) + (error "Thumbnail image file could not be created")))) + (and (file-exists-p thumb-name) thumb-name)))) + + +;; REPLACE ORIGINAL in `image-dired.el' (Emacs 22-23). +;; +;; 1. Raise an error if `image-dired.el' is not available. +;; 2. Repro it here so it picks up `Dired+' version of `dired-map-over-marks'. +;; +;;;###autoload +(defun image-dired-dired-insert-marked-thumbs () ; Bound to `C-t C-t' (Emacs 22-23) + "Insert thumbnails before file names of marked files in the Dired buffer." + (interactive (progn (diredp-image-dired-required-msg) ())) + (dired-map-over-marks + (let* ((image-pos (dired-move-to-filename)) + (image-file (dired-get-filename)) + (thumb-file (image-dired-get-thumbnail-image image-file)) + overlay) + ;; If image is not already added, then add it. + (unless (delq nil (mapcar (lambda (o) (overlay-get o 'put-image)) + ;; Can't use (overlays-at (point)), BUG? + (overlays-in (point) (1+ (point))))) + (put-image thumb-file image-pos) + (setq overlay (car (delq nil (mapcar (lambda (ov) (and (overlay-get ov 'put-image) ov)) + (overlays-in (point) (1+ (point))))))) + (overlay-put overlay 'image-file image-file) + (overlay-put overlay 'thumb-file thumb-file))) + nil) + (add-hook 'dired-after-readin-hook 'image-dired-dired-after-readin-hook nil t)) + + +;; REPLACE ORIGINAL in `image-dired.el' (Emacs 24+). +;; +;; 1. Raise an error if `image-dired.el' is not available. +;; 2. Repro it here so it picks up `Dired+' version of `dired-map-over-marks'. +;; +;;;###autoload +(defun image-dired-dired-toggle-marked-thumbs (&optional arg) ; Bound to `C-t C-t' (Emacs 24+) + "Toggle thumbnails in front of file names in Dired. +If no files are marked, insert or hide thumbnails on the current line. +With a numeric prefix arg N, ignore marked files and act on the next N +files (previous -N files, if N < 0)." + (interactive (progn (diredp-image-dired-required-msg) (list current-prefix-arg))) + (dired-map-over-marks + (let* ((image-pos (dired-move-to-filename)) + (image-file (diredp-get-image-filename nil 'NO-ERROR)) + thumb-file overlay) + (when image-file + (setq thumb-file (image-dired-get-thumbnail-image image-file)) + ;; If image is not already added, then add it. + (let* ((cur-ovs (overlays-in (point) (1+ (point)))) + (thumb-ov (car (diredp-remove-if-not (lambda (ov) (overlay-get ov 'thumb-file)) + cur-ovs)))) + (if thumb-ov + (delete-overlay thumb-ov) + (put-image thumb-file image-pos) + (setq overlay (car (delq nil (mapcar (lambda (ov) (and (overlay-get ov 'put-image) ov)) + (overlays-in (point) (1+ (point))))))) + (overlay-put overlay 'image-file image-file) + (overlay-put overlay 'thumb-file thumb-file))))) + arg + 'SHOW-PROGRESS) + (add-hook 'dired-after-readin-hook 'image-dired-dired-after-readin-hook nil t)) + +;; Corresponds to `image-dired-dired-comment-files'. +;;;###autoload +(defun diredp-image-dired-comment-file () + "Add comment to this image file." + (interactive (progn (diredp-image-dired-required-msg) ())) + (image-dired-write-comments (cons (dired-get-filename) (image-dired-read-comment)))) + +;; Corresponds to `image-dired-tag-files'. +;;;###autoload +(defun diredp-image-dired-tag-file () + "Tag this image file with an `image-dired' tag." + (interactive (progn (diredp-image-dired-required-msg) ())) + (image-dired-write-tags (cons (dired-get-filename) + (read-string "Tags to add (use `;' to separate): ")))) + +;; Corresponds to `image-dired-delete-tag'. +;;;###autoload +(defun diredp-image-dired-delete-tag () + "Remove an `image-dired' tag from this image file." + (interactive (progn (diredp-image-dired-required-msg) ())) + (image-dired-remove-tag (list (dired-get-filename)) (read-string "Tag to remove: "))) + +;; Corresponds to `image-dired-display-thumbs'. +;;;###autoload +(defun diredp-image-dired-display-thumb (&optional append) + "Pop to thumbnail of this image file, in `image-dired-thumbnail-buffer'. +If a thumbnail image does not yet exist for this file, create it. +With a prefix arg, append the thumbnail to the thumbnails buffer, +instead of clearing the buffer first." + (interactive (progn (diredp-image-dired-required-msg) (list current-prefix-arg))) + (let* ((dired-buf (current-buffer)) + (curr-file (dired-get-filename)) + (thumb-name (image-dired-thumb-name curr-file))) + (with-current-buffer (image-dired-create-thumbnail-buffer) + (let ((inhibit-read-only t)) + (if (not append) (erase-buffer) (goto-char (point-max))) + (if (and (not (file-exists-p thumb-name)) + (not (zerop (image-dired-create-thumb curr-file thumb-name)))) + (message "Cannot create thumbnail image for file `%s'" curr-file) + (image-dired-insert-thumbnail thumb-name curr-file dired-buf))) + (cond ((eq 'dynamic image-dired-line-up-method) (image-dired-line-up-dynamic)) + ((eq 'fixed image-dired-line-up-method) (image-dired-line-up)) + ((eq 'interactive image-dired-line-up-method) (image-dired-line-up-interactive)) + ((eq 'none image-dired-line-up-method) nil) + (t (image-dired-line-up-dynamic)))) + (pop-to-buffer image-dired-thumbnail-buffer))) + +;; Corresponds to `image-dired-copy-with-exif-file-name'. +;;;###autoload +(defun diredp-image-dired-copy-with-exif-name () + "Copy this image file to your main image directory. +Uses `image-dired-get-exif-file-name' to name the new file." + (interactive (progn (diredp-image-dired-required-msg) ())) + (let* ((curr-file (dired-get-filename)) + (new-name (format "%s/%s" (file-name-as-directory + (expand-file-name image-dired-main-image-directory)) + (image-dired-get-exif-file-name curr-file)))) + (message "Copying `%s' to `%s'..." curr-file new-name) + (copy-file curr-file new-name) + (message "Copying `%s' to `%s'...done" curr-file new-name))) + +;; Corresponds to `image-dired-dired-edit-comment-and-tags'. +;;;###autoload +(defun diredp-image-dired-edit-comment-and-tags () + "Edit comment and tags for this image file." + (interactive (progn (diredp-image-dired-required-msg) ())) + (setq image-dired-widget-list ()) + (let ((file (dired-get-filename))) + (if (fboundp 'pop-to-buffer-same-window) + (pop-to-buffer-same-window "*Image-Dired Edit Meta Data*") + (switch-to-buffer "*Image-Dired Edit Meta Data*")) + (kill-all-local-variables) + (make-local-variable 'widget-example-repeat) + (let ((inhibit-read-only t)) + (erase-buffer) + (remove-overlays) + (widget-insert + "\nEdit comment and tags for the image. Separate multiple tags +with a comma (`,'). Move forward among fields using `TAB' or `RET'. +Move backward using `S-TAB'. Click `Save' to save your edits or +`Cancel' to abandon them.\n\n") + (let* ((thumb-file (image-dired-thumb-name file)) + (img (create-image thumb-file)) + comment-widget tag-widget) + (insert-image img) + (widget-insert "\n\nComment: ") + (setq comment-widget (widget-create 'editable-field :size 60 :format "%v " + :value (or (image-dired-get-comment file) ""))) + (widget-insert "\nTags: ") + (setq tag-widget (widget-create 'editable-field :size 60 :format "%v " + :value (or (mapconcat #'identity (image-dired-list-tags file) ",") ""))) + ;; Save info in widgets to use when the user saves the form. + (setq image-dired-widget-list (append image-dired-widget-list + (list (list file comment-widget tag-widget)))) + (widget-insert "\n\n"))) + (widget-insert "\n") + (widget-create 'push-button :notify (lambda (&rest _ignore) + (image-dired-save-information-from-widgets) + (bury-buffer) + (message "Done")) + "Save") + (widget-insert " ") + (widget-create 'push-button :notify (lambda (&rest _ignore) + (bury-buffer) + (message "Operation canceled")) + "Cancel") + (widget-insert "\n") + (use-local-map widget-keymap) + (widget-setup) + (widget-forward 1))) ; Jump to the first widget. + +;;;###autoload +(defun diredp-do-display-images (&optional arg) + "Display the marked image files. +A prefix argument ARG specifies files to use instead of those marked. + An integer means use the next ARG files (previous -ARG, if < 0). + `C-u': Use the current file (whether or not any files are marked). + More than one `C-u' means use all files in the Dired buffer, as if + they were all marked." + (interactive (progn (unless (require 'image-file nil t) + (error "This command requires library `image-file.el'")) + (diredp-ensure-mode) + (list current-prefix-arg))) + (dired-map-over-marks-check #'diredp-display-image arg 'display\ image + (diredp-fewer-than-2-files-p arg))) + +(defun diredp-display-image () + "Display image file at point. Log an error using `dired-log'." + (let ((file (dired-get-filename 'LOCAL 'NO-ERROR)) + (failure nil)) + (save-excursion + (if (let ((inhibit-changing-match-data t)) + (and file (diredp-string-match-p (image-file-name-regexp) file))) + (condition-case err + (let ((find-file-run-dired nil)) (find-file-other-window file)) + (error (setq failure (error-message-string err)))) + (dired-log (format "Not an image file: `%s'" file)) + (setq failure t))) + (and failure ; Return nil for success. + (prog1 file ; Return file name for failure. + (unless (eq t failure) (dired-log "Cannot display image file `%s':\n%s\n" file failure) t))))) + +;;;###autoload +(defun diredp-image-show-this-file (&optional arg) + "Show the image file named on this line in another frame or window. +Option `diredp-image-show-this-file-use-frame-flag' which is used. + +With a prefix arg, shrink the image to fit a frame that many lines +high or a window at least that many lines high. +Otherwise, show the image full size. +Note: + * To show the image full size, you can also use `\\\\[dired-find-file]'. + * To show the image in another window, at whatever scale fits there, + you can use `\\[image-dired-dired-display-image]'." + (interactive (progn (diredp-image-dired-required-msg) (list current-prefix-arg))) + (image-dired-create-display-image-buffer) + (let ((fit-frame-inhibit-fitting-flag t) ; In `fit-frame.el'. + (img-file (diredp-get-image-filename))) + (if img-file + (with-current-buffer image-dired-display-image-buffer + (let* ((window-min-height (if arg + (prefix-numeric-value arg) + (ceiling (cdr (image-size (create-image img-file)))))) + (special-display-frame-alist (if diredp-image-show-this-file-use-frame-flag + (cons `(height . ,window-min-height) + special-display-frame-alist) + special-display-frame-alist)) + (special-display-buffer-names (if diredp-image-show-this-file-use-frame-flag + (cons image-dired-display-image-buffer + special-display-buffer-names) + special-display-buffer-names))) + (display-buffer image-dired-display-image-buffer) + (image-dired-display-image img-file (not arg)))) + (message "No image file here")))) ; An error is handled by `diredp-get-image-filename'. + +(defun diredp-report-file-result (file result failure echop) + (cond (failure + (when echop (message "Error for %s:\n%s\n" file failure) (sit-for 1)) + (dired-log "Error for %s:\n%s\n" file failure) + (dired-make-relative file)) ; Return file name for failure. + (t + (when echop (message "Result for %s:\n%s\n" file result) (sit-for 1)) + (dired-log "Result for %s:\n%s\n" file result) + nil))) ; Return nil for success. + +;;;###autoload +(defun diredp-do-emacs-command (command &optional arg) + "Invoke an Emacs COMMAND in each marked file. +Visit each marked file at its beginning, then invoke COMMAND. +You are prompted for the COMMAND. + +The result returned for each file is logged by `dired-log'. Use `?' +to see all such results and any error messages. If there are fewer +marked files than `diredp-do-report-echo-limit' then each result is +also echoed momentarily. + +A prefix argument behaves according to the ARG argument of +`dired-get-marked-files'. In particular, `C-u C-u' operates on all +files in the Dired buffer." + (interactive (progn (diredp-ensure-mode) + (list (diredp-read-command) current-prefix-arg))) + (save-selected-window + (diredp-map-over-marks-and-report + #'diredp-invoke-emacs-command arg 'invoke\ emacs\ command (diredp-fewer-than-2-files-p arg) + command (diredp-fewer-than-echo-limit-files-p arg)))) + +(defun diredp-invoke-emacs-command (command &optional echop) + "Visit file of this line at its beginning, then invoke COMMAND. +Log the result returned or any error. +Non-nil optional arg ECHOP means also echo the result." + (let* ((file (dired-get-filename)) + (failure (not (file-exists-p file))) + result) + (unless failure + (condition-case err + (with-current-buffer (find-file-noselect file) + (save-excursion + (goto-char (point-min)) + (setq result (call-interactively command)))) + (error (setq failure err)))) + (diredp-report-file-result file result failure echop))) + +(defun diredp-read-command (&optional prompt default) + "Read the name of a command and return a symbol with that name. +\(A command is anything that satisfies predicate `commandp'.) +Prompt with PROMPT, which defaults to \"Command: \". +By default, return the command named DEFAULT (or, with Emacs 23+, its +first element if DEFAULT is a list). (If DEFAULT does not name a +command then it is ignored.)" + (setq prompt (or prompt "Command: ")) + (let ((name (completing-read prompt obarray #'commandp t nil + 'extended-command-history default))) + (while (string= "" name) + (setq name (completing-read prompt obarray #'commandp t nil + 'extended-command-history default))) + (intern name))) + +(when (fboundp 'diredp-read-expression) ; Emacs 22+ + + (defun diredp-do-lisp-sexp (sexp &optional arg) + "Evaluate an Emacs-Lisp SEXP in each marked file. +Visit each marked file at its beginning, then evaluate SEXP. +You are prompted for the SEXP. + +The result returned for each file is logged by `dired-log'. Use `?' +to see all such results and any error messages. If there are fewer +marked files than `diredp-do-report-echo-limit' then each result is +also echoed momentarily. + +A prefix argument behaves according to the ARG argument of +`dired-get-marked-files'. In particular, `C-u C-u' operates on all +files in the Dired buffer." + (interactive (progn (diredp-ensure-mode) + (list (diredp-read-expression "Sexp: ") current-prefix-arg))) + (save-selected-window + (diredp-map-over-marks-and-report + #'diredp-eval-lisp-sexp arg 'eval\ elisp\ sexp (diredp-fewer-than-2-files-p arg) + sexp (diredp-fewer-than-echo-limit-files-p arg)))) + + (defun diredp-eval-lisp-sexp (sexp &optional echop) + "Visit file of this line at its beginning, then evaluate SEXP. +Log the result returned or any error. +Non-nil optional arg ECHOP means also echo the result." + (let* ((file (dired-get-filename)) + (failure (not (file-exists-p file))) + result) + (unless failure + (condition-case err + (with-current-buffer (find-file-noselect file) + (save-excursion + (goto-char (point-min)) + (setq result (eval-expression sexp)))) + (error (setq failure err)))) + (diredp-report-file-result file result failure echop))) + + ) + +;;; Face Definitions + +(defface diredp-autofile-name + '((((background dark)) (:background "#111313F03181")) ; Very dark blue + (t (:background "#EEECEC0FCE7E"))) ; Very pale goldenrod + "*Face used in Dired for names of files that are autofile bookmarks." + :group 'Dired-Plus :group 'font-lock-highlighting-faces) +(defvar diredp-autofile-name 'diredp-autofile-name) + +(defface diredp-compressed-file-name + '((((background dark)) (:foreground "Blue")) + (t (:foreground "Brown"))) + "*Face used for compressed file names." + :group 'Dired-Plus :group 'font-lock-highlighting-faces) +(defvar diredp-compressed-file-name 'diredp-compressed-file-name) + +(defface diredp-compressed-file-suffix + '((((background dark)) (:foreground "Blue")) + (t (:foreground "Yellow"))) + "*Face used for compressed file suffixes in Dired buffers. +This means the `.' plus the file extension. Example: `.zip'." + :group 'Dired-Plus :group 'font-lock-highlighting-faces) +(defvar diredp-compressed-file-suffix 'diredp-compressed-file-suffix) + +(defface diredp-date-time + '((((background dark)) (:foreground "#74749A9AF7F7")) ; ~ med blue + (t (:foreground "DarkGoldenrod4"))) + "*Face used for date and time in Dired buffers." + :group 'Dired-Plus :group 'font-lock-highlighting-faces) +(defvar diredp-date-time 'diredp-date-time) + +(defface diredp-deletion + '((t (:foreground "Yellow" :background "Red"))) + "*Face used for deletion flags (D) in Dired buffers." + :group 'Dired-Plus :group 'font-lock-highlighting-faces) +(defvar diredp-deletion 'diredp-deletion) + +(defface diredp-deletion-file-name + '((t (:foreground "Red"))) + "*Face used for names of deleted files in Dired buffers." + :group 'Dired-Plus :group 'font-lock-highlighting-faces) +(defvar diredp-deletion-file-name 'diredp-deletion-file-name) + +(defface diredp-dir-heading + '((((background dark)) (:foreground "Yellow" :background "#00003F3F3434")) ; ~ dark green + (t (:foreground "Blue" :background "Pink"))) + "*Face used for directory headings in Dired buffers." + :group 'Dired-Plus :group 'font-lock-highlighting-faces) +(defvar diredp-dir-heading 'diredp-dir-heading) + +(defface diredp-dir-name + '((((background dark)) + (:foreground "#7474FFFFFFFF" :background "#2C2C2C2C2C2C")) ; ~ cyan, dark gray + (t (:foreground "DarkRed" :background "LightGray"))) + "*Face used for directory names." + :group 'Dired-Plus :group 'font-lock-highlighting-faces) +(defvar diredp-dir-name 'diredp-dir-name) + +(defface diredp-dir-priv + '((((background dark)) + (:foreground "#7474FFFFFFFF" :background "#2C2C2C2C2C2C")) ; ~ cyan, dark gray + (t (:foreground "DarkRed" :background "LightGray"))) + "*Face used for directory privilege indicator (d) in Dired buffers." + :group 'Dired-Plus :group 'font-lock-highlighting-faces) +(defvar diredp-dir-priv 'diredp-dir-priv) + +(defface diredp-exec-priv + '((((background dark)) (:background "#4F4F3B3B2121")) ; ~ dark brown + (t (:background "LightSteelBlue"))) + "*Face used for execute privilege indicator (x) in Dired buffers." + :group 'Dired-Plus :group 'font-lock-highlighting-faces) +(defvar diredp-exec-priv 'diredp-exec-priv) + +;; For this to show up, you need `F' among the options in `dired-listing-switches'. +;; For example, I use "-alF" for `dired-listing-switches'. +(defface diredp-executable-tag + '((t (:foreground "Red"))) + "*Face used for executable tag (*) on file names in Dired buffers." + :group 'Dired-Plus :group 'font-lock-highlighting-faces) +(defvar diredp-executable-tag 'diredp-executable-tag) + +(defface diredp-file-name + '((((background dark)) (:foreground "Yellow")) + (t (:foreground "Blue"))) + "*Face used for file names (without suffixes) in Dired buffers. +This means the base name. It does not include the `.'." + :group 'Dired-Plus :group 'font-lock-highlighting-faces) +(defvar diredp-file-name 'diredp-file-name) + +(defface diredp-file-suffix + '((((background dark)) (:foreground "#7474FFFF7474")) ; ~ light green + (t (:foreground "DarkMagenta"))) + "*Face used for file suffixes in Dired buffers. +This means the `.' plus the file extension. Example: `.elc'." + :group 'Dired-Plus :group 'font-lock-highlighting-faces) +(defvar diredp-file-suffix 'diredp-file-suffix) + +(defface diredp-flag-mark + '((((background dark)) (:foreground "Blue" :background "#7575D4D41D1D")) ; ~ olive green + (t (:foreground "Yellow" :background "Blueviolet"))) + "*Face used for flags and marks (except D) in Dired buffers." + :group 'Dired-Plus :group 'font-lock-highlighting-faces) +(defvar diredp-flag-mark 'diredp-flag-mark) + +(defface diredp-flag-mark-line + '((((background dark)) (:background "#787831311414")) ; ~ dark red brown + (t (:background "Skyblue"))) + "*Face used for flagged and marked lines in Dired buffers." + :group 'Dired-Plus :group 'font-lock-highlighting-faces) +(defvar diredp-flag-mark-line 'diredp-flag-mark-line) + +(defface diredp-ignored-file-name + '((((background dark)) (:foreground "#C29D6F156F15")) ; ~ salmon + (t (:foreground "#00006DE06DE0"))) ; ~ dark cyan + "*Face used for files whose names are omitted based on the extension. +See also face `diredp-omit-file-name'." + :group 'Dired-Plus :group 'font-lock-highlighting-faces) +(defvar diredp-ignored-file-name 'diredp-ignored-file-name) + +(defface diredp-link-priv + '((((background dark)) (:foreground "#00007373FFFF")) ; ~ blue + (t (:foreground "DarkOrange"))) + "*Face used for link privilege indicator (l) in Dired buffers." + :group 'Dired-Plus :group 'font-lock-highlighting-faces) +(defvar diredp-link-priv 'diredp-link-priv) + +(when (> emacs-major-version 21) + (defface diredp-mode-line-marked + '((t (:foreground "DarkViolet"))) + "*Face for marked number in mode-line `mode-name' for Dired buffers." + :group 'Dired-Plus :group 'font-lock-highlighting-faces) + + (defface diredp-mode-line-flagged + '((t (:foreground "Red"))) + "*Face for flagged number in mode-line `mode-name' for Dired buffers." + :group 'Dired-Plus :group 'font-lock-highlighting-faces)) + +(defface diredp-no-priv + '((((background dark)) (:background "#2C2C2C2C2C2C")) ; ~ dark gray + (t (:background "LightGray"))) + "*Face used for no privilege indicator (-) in Dired buffers." + :group 'Dired-Plus :group 'font-lock-highlighting-faces) +(defvar diredp-no-priv 'diredp-no-priv) + +(defface diredp-number + '((((background dark)) (:foreground "#FFFFFFFF7474")) ; ~ light yellow + (t (:foreground "DarkBlue"))) + "*Face used for numerical fields in Dired buffers. +In particular, inode number, number of hard links, and file size." + :group 'Dired-Plus :group 'font-lock-highlighting-faces) +(defvar diredp-number 'diredp-number) + +(defface diredp-omit-file-name + (if (assq :inherit custom-face-attributes) ; Emacs 22+ + '((((background dark)) (:inherit diredp-ignored-file-name :strike-through "#555555555555")) ; ~ dark gray + (t (:inherit diredp-ignored-file-name :strike-through "#AAAAAAAAAAAA"))) ; ~ light gray + '((((background dark)) (:foreground "#C29D6F156F15")) ; ~ salmon + (t (:foreground "#00006DE06DE0")))) ; ~ dark cyan + "*Face used for files whose names will be omitted in `dired-omit-mode'. +This means file names that match regexp `diredp-omit-files-regexp'. +\(File names matching `dired-omit-extensions' are highlighted with face +`diredp-ignored-file-name' instead.)" + :group 'Dired-Plus :group 'font-lock-highlighting-faces) +(defvar diredp-omit-file-name 'diredp-omit-file-name) + +(defface diredp-other-priv + '((((background dark)) (:background "#111117175555")) ; ~ dark blue + (t (:background "PaleGoldenrod"))) + "*Face used for l,s,S,t,T privilege indicators in Dired buffers." + :group 'Dired-Plus :group 'font-lock-highlighting-faces) +(defvar diredp-other-priv 'diredp-other-priv) + +(defface diredp-rare-priv + '((((background dark)) (:foreground "Green" :background "#FFFF00008080")) ; ~ hot pink + (t (:foreground "Magenta" :background "SpringGreen"))) + "*Face used for rare privilege indicators (b,c,s,m,p,S) in Dired buffers." + :group 'Dired-Plus :group 'font-lock-highlighting-faces) +(defvar diredp-rare-priv 'diredp-rare-priv) + +(defface diredp-read-priv + '((((background dark)) (:background "#999932325555")) ; ~ burgundy / dark magenta + (t (:background "MediumAquamarine"))) + "*Face used for read privilege indicator (w) in Dired buffers." + :group 'Dired-Plus :group 'font-lock-highlighting-faces) +(defvar diredp-read-priv 'diredp-read-priv) + +(defface diredp-symlink + '((((background dark)) (:foreground "#00007373FFFF")) ; ~ blue + (t (:foreground "DarkOrange"))) + "*Face used for symbolic links in Dired buffers." + :group 'Dired-Plus :group 'font-lock-highlighting-faces) +(defvar diredp-symlink 'diredp-symlink) + +(defface diredp-tagged-autofile-name + '((((background dark)) (:background "#328C0411328C")) ; Very dark magenta + (t (:background "#CD73FBEECD73"))) ; Very pale green + "*Face used in Dired for names of files that are autofile bookmarks." + :group 'Dired-Plus :group 'font-lock-highlighting-faces) +(defvar diredp-tagged-autofile-name 'diredp-tagged-autofile-name) + +(defface diredp-write-priv + '((((background dark)) (:background "#25258F8F2929")) ; ~ dark green + (t (:background "Orchid"))) + "*Face used for write privilege indicator (w) in Dired buffers." + :group 'Dired-Plus :group 'font-lock-highlighting-faces) +(defvar diredp-write-priv 'diredp-write-priv) + +;; Fix Emacs 20 recognition of fields up through file name when size is expressed using `k' etc. +(when (and (< emacs-major-version 21) (not (boundp 'diredp-loaded-p)) + dired-move-to-filename-regexp ; These last two checks are just in case. + (eq (aref dired-move-to-filename-regexp 7) ?\ )) + (setq dired-move-to-filename-regexp (concat "[0-9][BkKMGTPEZY]?" + (substring dired-move-to-filename-regexp 7)))) + +;;; Define second level of fontifying. +(defvar diredp-font-lock-keywords-1 + (list + '("^ \\(.+:\\)$" 1 diredp-dir-heading) ; Directory headers + '("^ wildcard.*$" 0 'default) ; Override others, e.g. `l' for `diredp-other-priv'. + '("^ (No match).*$" 0 'default) ; Override others, e.g. `t' for `diredp-other-priv'. + '("[^ .]\\(\\.[^. /]+\\)$" 1 diredp-file-suffix) ; Suffix, including `.'. + '("\\([^ ]+\\) -> .+$" 1 diredp-symlink) ; Symbolic links + + ;; 1) Date/time and 2) filename w/o suffix. + ;; This is a bear, and it is fragile - Emacs can change `dired-move-to-filename-regexp'. + (if (or (not (fboundp 'version<)) (version< emacs-version "23.2")) + (list dired-move-to-filename-regexp + (list 1 'diredp-date-time t t) ; Date/time + (list (concat "\\(.+\\)\\(" (concat (funcall #'regexp-opt diredp-compressed-extensions) + "\\)[*]?$")) ; Compressed-file name + nil nil (list 0 diredp-compressed-file-name 'keep t))) + `(,dired-move-to-filename-regexp + (7 diredp-date-time t t) ; Date/time, locale (western or eastern) + (2 diredp-date-time t t) ; Date/time, ISO + (,(concat "\\(.+\\)\\(" (concat (funcall #'regexp-opt diredp-compressed-extensions) + "\\)[*]?$")) + nil nil (0 diredp-compressed-file-name keep t)))) ; Compressed-file suffix + (if (or (not (fboundp 'version<)) (version< emacs-version "23.2")) + (list dired-move-to-filename-regexp + (list 1 'diredp-date-time t t) ; Date/time + (list "\\(.+\\)$" nil nil (list 0 diredp-file-name 'keep t))) ; Filename + `(,dired-move-to-filename-regexp + (7 diredp-date-time t t) ; Date/time, locale (western or eastern) + (2 diredp-date-time t t) ; Date/time, ISO + ("\\(.+\\)$" nil nil (0 diredp-file-name keep t)))) ; Filename (not a compressed file) + + ;; Files to ignore. + ;; Use face `diredp-ignored-file-name' for omission by file-name extension. + ;; Use face `diredp-omit-file-name' for omission by entire file name. + (let* ((omit-exts (or (and (boundp 'dired-omit-extensions) dired-omit-extensions) + completion-ignored-extensions)) + (omit-exts (and omit-exts (mapconcat #'regexp-quote omit-exts "\\|"))) + (compr-exts (and diredp-ignore-compressed-flag + (concat "\\|" (mapconcat #'regexp-quote diredp-compressed-extensions "\\|"))))) + (list (concat "^ \\(.*\\(" omit-exts compr-exts "\\)[*]?\\)$") ; [*]? allows for executable flag (*). + 1 diredp-ignored-file-name t)) + `(,(concat "^.*" dired-move-to-filename-regexp + "\\(" diredp-omit-files-regexp "\\).*[*]?$") ; [*]? allows for executable flag (*). + (0 diredp-omit-file-name t)) + + ;; Compressed-file (suffix) + (list (concat "\\(" (funcall #'regexp-opt diredp-compressed-extensions) "\\)[*]?$") + 1 diredp-compressed-file-suffix t) + '("\\([*]\\)$" 1 diredp-executable-tag t) ; Executable (*) + + ;; Inode, hard-links, & file size (. and , are for the decimal point, depending on locale) + ;; See comment for `directory-listing-before-filename-regexp' in `files.el' or `files+.el'. + '("\\(\\([0-9]+\\([.,][0-9]+\\)?\\)[BkKMGTPEZY]?[ /]?\\)" 1 diredp-number) + + ;; Directory names - exclude d:/..., Windows drive letter in a dir heading. + (list (concat dired-re-maybe-mark dired-re-inode-size "\\(d\\)[^:]") + '(1 diredp-dir-priv t) '(".+" (dired-move-to-filename) nil (0 diredp-dir-name t))) + + (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]........\\(x\\)") ; o x + '(1 diredp-exec-priv)) + (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]........\\([lsStT]\\)") ; o misc + '(1 diredp-other-priv)) + (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl].......\\(w\\).") ; o w + '(1 diredp-write-priv)) + (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]......\\(r\\)..") ; o r + '(1 diredp-read-priv)) + (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl].....\\(x\\)...") ; g x + '(1 diredp-exec-priv)) + (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl].....\\([lsStT]\\)...") ; g misc + '(1 diredp-other-priv)) + (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]....\\(w\\)....") ; g w + '(1 diredp-write-priv)) + (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]...\\(r\\).....") ; g r + '(1 diredp-read-priv)) + (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]..\\(x\\)...") ; u x + '(1 diredp-exec-priv)) + (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]..\\([lsStT]\\)...") ; u misc + '(1 diredp-other-priv)) + (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl].\\(w\\)....") ; u w + '(1 diredp-write-priv)) + (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]\\(r\\).....") ; u r + '(1 diredp-read-priv)) + + (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]........\\([-rwxlsStT]\\)") ; o - + '(1 diredp-no-priv keep)) + (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl].......\\([-rwxlsStT]\\).") ; g - + '(1 diredp-no-priv keep)) + (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]......\\([-rwxlsStT]\\)..") ; u - + '(1 diredp-no-priv keep)) + (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl].....\\([-rwxlsStT]\\)...") ; o - + '(1 diredp-no-priv keep)) + (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]....\\([-rwxlsStT]\\)....") ; g - + '(1 diredp-no-priv keep)) + (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]...\\([-rwxlsStT]\\).....") ; u - + '(1 diredp-no-priv keep)) + (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]..\\([-rwxlsStT]\\)......") ; o - + '(1 diredp-no-priv keep)) + (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl].\\([-rwxlsStT]\\).......") ; g - + '(1 diredp-no-priv keep)) + (list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]\\([-rwxlsStT]\\)........") ; u - + '(1 diredp-no-priv keep)) + + (list (concat dired-re-maybe-mark dired-re-inode-size "\\([bcsmpS]\\)") ; (rare) + '(1 diredp-rare-priv keep)) + (list (concat dired-re-maybe-mark dired-re-inode-size "\\(l\\)[-rwxlsStT]") ; l + '(1 diredp-rare-priv keep)) + + (list (concat "^\\([^\n " (char-to-string dired-del-marker) "].*$\\)") + 1 diredp-flag-mark-line t) ; Flag/mark lines + (list (concat "^\\([^\n " (char-to-string dired-del-marker) "]\\)") ; Flags, marks (except D) + 1 diredp-flag-mark t) + + (list (concat "^\\([" (char-to-string dired-del-marker) "].*$\\)") ; Deletion-flagged lines + 1 diredp-deletion-file-name t) + (list (concat "^\\([" (char-to-string dired-del-marker) "]\\)") ; Deletion flags (D) + 1 diredp-deletion t) + + ) "2nd level of Dired highlighting. See `font-lock-maximum-decoration'.") + + +(defun diredp--set-up-font-locking () + "Add this to `dired-mode-hook' to provide for second-level fontifying." + (set (make-local-variable 'font-lock-defaults) + ;; Two levels. Use 3-element list, since it is standard to have one more + ;; than the number of levels. This is necessary for it to work with + ;; `font(-lock)-menus.el'. + '((dired-font-lock-keywords + dired-font-lock-keywords + diredp-font-lock-keywords-1) + t nil nil beginning-of-line)) + ;; Refresh `font-lock-keywords' from `font-lock-defaults' + (when (fboundp 'font-lock-refresh-defaults) (font-lock-refresh-defaults))) + +;;; Provide for the second level of fontifying. +(add-hook 'dired-mode-hook 'diredp--set-up-font-locking) + +;; Ensure that Dired buffers are refontified when you use `g' or otherwise read in the file list. +(defun diredp-refontify-buffer () + "Turn `font-lock-mode' off, then on." + (setq font-lock-mode nil) + (font-lock-mode)) +(add-hook 'dired-after-readin-hook 'diredp-refontify-buffer) + +;;; Function Definitions + +;;; $$$$$$$$ +;;; (defun diredp-dired-files (arg &optional switches) ; Not bound +;;; "Like `dired', but non-positive prefix arg prompts for files to list. +;;; This is like `dired' unless you use a non-positive prefix arg. +;;; In that case, you are prompted for names of files and directories to +;;; list, and then you are prompted for the name of the Dired buffer that +;;; lists them. Use `C-g' when you are done entering file names to list. + +;;; In all cases, when inputting a file or directory name you can use +;;; shell wildcards. + +;;; If you use Icicles, then in Icicle mode the following keys are bound +;;; in the minibuffer during completion (`*' means the key requires +;;; library `Bookmark+'): + +;;; M-| - Open Dired on the file names matching your input +;;; C-c + - Create a new directory +;;; *C-x a + - Add tags to the current-candidate file +;;; *C-x a - - Remove tags from the current-candidate file +;;; *C-x m - Access file bookmarks (not just autofiles)" +;;; (interactive (diredp-dired-files-interactive-spec "")) +;;; (when (consp arg) +;;; (let ((buf (dired-find-buffer-nocreate (car arg)))) ; Respect file list. +;;; (when buf (kill-buffer buf)))) +;;; (if (fboundp 'pop-to-buffer-same-window) +;;; (pop-to-buffer-same-window (dired-noselect arg switches)) +;;; (switch-to-buffer (dired-noselect arg switches)))) + +;;; (defun diredp-dired-files-other-window (arg &optional switches) ; Not bound +;;; "Same as `diredp-dired-files' except uses another window." +;;; (interactive (diredp-dired-files-interactive-spec "in other window ")) +;;; (when (consp arg) +;;; (let ((buf (dired-find-buffer-nocreate (car arg)))) ; Respect file list. +;;; (when buf (kill-buffer buf)))) +;;; (dired-other-window arg switches)) + +;;;###autoload +(defun diredp-dired-for-files (arg &optional switches) ; Bound to `C-x D F' + "Dired file names that you enter, in a Dired buffer that you name. +You are prompted for the name of the Dired buffer to use. +You are then prompted for names of files and directories to list, + which can be located anywhere. +Use `C-g' when you are done. + +With a prefix arg you are first prompted for the `ls' switches to use. + +See also `dired' (including the advice)." + (interactive (let ((current-prefix-arg (if current-prefix-arg 0 -1))) + (dired-read-dir-and-switches "" 'READ-EXTRA-FILES-P))) + (dired arg switches)) + +;;;###autoload +(defun diredp-dired-for-files-other-window (arg &optional switches) ; Bound to `C-x 4 D F' + "Same as `diredp-dired-for-files', except uses another window." + (interactive (let ((current-prefix-arg (if current-prefix-arg 0 -1))) + (dired-read-dir-and-switches "in other window " 'READ-EXTRA-FILES-P))) + (dired-other-window arg switches)) + +;;;###autoload +(defun diredp-dired-recent-dirs (buffer &optional arg) ; Bound to `C-x D R' + "Open Dired in BUFFER, showing recently used directories. +You are prompted for BUFFER. + +No prefix arg or a plain prefix arg (`C-u', `C-u C-u', etc.) means +list all of the recently used directories. + +With a prefix arg: +* If 0, `-', or plain (`C-u') then you are prompted for the `ls' + switches to use. +* If not plain (`C-u') then: + * If >= 0 then the directories to include are read, one by one. + * If < 0 then the directories to exclude are read, one by one. + +When entering directories to include or exclude, use `C-g' to end." + (interactive (list (completing-read "Dired buffer name: " dired-buffers) current-prefix-arg)) + (unless (require 'recentf nil t) (error "This command requires library `recentf.el'")) + (let ((switches (and (or (zerop (prefix-numeric-value arg)) (consp arg)) + (read-string "Dired listing switches: " dired-listing-switches)))) + (dired (cons (generate-new-buffer-name buffer) (diredp-recent-dirs arg)) switches))) + +;;;###autoload +(defun diredp-dired-recent-dirs-other-window (buffer &optional arg) ; Bound to `C-x 4 D R' + "Same as `diredp-dired-recent-dirs', but use other window." + (interactive (list (completing-read "Dired buffer name: " dired-buffers) current-prefix-arg)) + (unless (require 'recentf nil t) (error "This command requires library `recentf.el'")) + (let ((switches (and (or (zerop (prefix-numeric-value arg)) (consp arg) (eq '- arg)) + (read-string "Dired listing switches: " dired-listing-switches)))) + (dired-other-window (cons (generate-new-buffer-name buffer) (diredp-recent-dirs arg)) switches))) + +(defun diredp-recent-dirs (arg) + "Return a list of recently used directories. +ARG is as for `diredp-dired-recent-dirs'." + (let ((recent-dirs (diredp-remove-if #'diredp-root-directory-p + (diredp-delete-dups + (mapcar (lambda (f/d) + (if (file-directory-p f/d) f/d (file-name-directory f/d))) + recentf-list))))) + (if (and arg (atom arg)) + (diredp-read-include/exclude 'Dir recent-dirs (not (natnump (prefix-numeric-value arg)))) + recent-dirs))) + +(defun diredp-read-include/exclude (thing things &optional exclude) + "Read which THINGs to include (or to EXCLUDE, if non-nil) from list THINGS. +The things are read one by one. `C-g' stops reading. + +THING is a string or symbol naming the type of thing to read, e.g., +`File' or `Directory'. It is used only in the prompt, which is THING +followed by \" to exclude\" or \" to include\" and a reminder about `C-g'. + +A new list is returned - list THINGS is not modified." + (let* ((thgs (if exclude (copy-sequence things) ())) + (prompt (format "%s to %s (C-g when done): " thing (if exclude 'EXCLUDE 'INCLUDE))) + (completion-ignore-case (or (and (boundp 'read-file-name-completion-ignore-case) + (memq thing '(Dir Directory File "Dir" "Directory" "File")) ; Hack + read-file-name-completion-ignore-case) + completion-ignore-case)) + thing) + (while (condition-case nil + (setq thing (completing-read prompt (mapcar #'list things) nil t)) + (quit nil)) + (if exclude (delete thing thgs) + (push thing thgs))) + thgs)) + +;;; $$$$$$$$ +;;; (defun diredp-dired-files-interactive-spec (str) +;;; "`interactive' spec for `diredp-dired-files' commands. +;;; STR is a string appended to the prompt. +;;; With non-negative prefix arg, read switches. +;;; With non-positive prefix arg, read files and dirs to list and then the +;;; Dired buffer name. User uses `C-g' when done reading files and dirs. + +;;; If you use Icicles, then in Icicle mode the following keys are bound +;;; in the minibuffer during completion (`*' means the key requires +;;; library `Bookmark+'): + +;;; M-| - Open Dired on the file names matching your input +;;; C-c + - Create a new directory +;;; *C-x a + - Add tags to the current-candidate file +;;; *C-x a - - Remove tags from the current-candidate file +;;; *C-x m - Access file bookmarks (not just autofiles)" +;;; (list +;;; (unwind-protect +;;; (let ((icicle-sort-comparer (or (and (boundp 'icicle-file-sort) ;; If not reading files +;;; icicle-file-sort) ;; then dirs first. +;;; (and (> (prefix-numeric-value current-prefix-arg) 0) +;;; 'icicle-dirs-first-p) +;;; icicle-sort-comparer)) +;;; (icicle-all-candidates-list-alt-action-fn ; M-|' +;;; (lambda (files) +;;; (let ((enable-recursive-minibuffers t)) +;;; (dired-other-window (cons (read-string "Dired buffer name: ") files)))))) +;;; (when (fboundp 'icicle-bind-file-candidate-keys) (icicle-bind-file-candidate-keys)) +;;; (if (> (prefix-numeric-value current-prefix-arg) 0) +;;; ;; If a dialog box is about to be used, call `read-directory-name' so the dialog +;;; ;; code knows we want directories. Some dialog boxes can only select directories +;;; ;; or files when popped up, not both. +;;; (if (and (fboundp 'read-directory-name) (next-read-file-uses-dialog-p)) +;;; (read-directory-name (format "Dired %s(directory): " str) nil +;;; default-directory nil) +;;; (read-file-name (format "Dired %s(directory): " str) nil default-directory nil)) +;;; (let ((insert-default-directory nil) +;;; (files ()) +;;; file) +;;; (while (condition-case nil ; Use lax completion, to allow wildcards. +;;; (setq file (read-file-name "File or dir (C-g when done): ")) +;;; (quit nil)) +;;; (push file files)) +;;; (cons (read-string "Dired buffer name: " nil nil default-directory) files)))) +;;; (when (fboundp 'icicle-unbind-file-candidate-keys) +;;; (icicle-unbind-file-candidate-keys))) +;;; (and current-prefix-arg (natnump (prefix-numeric-value current-prefix-arg)) +;;; (read-string "Dired listing switches: " dired-listing-switches)))) + +;;;###autoload +(defun diredp-dired-union (dired-name dirbufs &optional switches extra) ; Bound to `C-x D U' + "Create a Dired buffer that is the union of some existing Dired buffers. +With a non-negative prefix arg, you are prompted for `ls' switches. +With a non-positive prefix arg, you are prompted for file and dir +names to add to the listing - see below. + +You are prompted for the name of the Dired union buffer. Completion +against names of existing Dired buffers is available, but you can +enter any other name to create a new Dired buffer of that name. + +If the union buffer name you choose names an existing Dired buffer, +then what happens depends on whether that buffer is an ordinary Dired +directory listing or a list of arbitrary file names. That is, it +depends on whether `dired-directory' is a directory name or a cons of +a Dired buffer name plus file names. + +* If the buffer is an ordinary Dired listing, then it is converted to + an explicit list of absolute file names, just as if these had been + chosen individually. The existing buffer and window are replaced by + new ones that show the explicit listing. (This replacement is + necessary because the list of files contained in an ordinary Dired + listing cannot be modified.) + +* If the buffer lists arbitrary file names explicitly, then it is + updated to include also the files from any Dired buffers and any + additional files that you specify. + +If the union buffer name you choose does not name an existing Dired +buffer, then its `default-directory' is the same as the +`default-directory' before invoking the command. + +If you use a non-positive prefix arg, then you can next choose +additional file and directory names to add to the listing. Use `C-g' +when done choosing them. + +Any directory names you choose this way are included as single entries +in the listing - the directory contents are not included (these +directories are not unioned). To instead include the contents of a +directory chosen this way, use a glob pattern: `/*' after the +directory name. + +You are then prompted for the Dired buffers to union. Use `C-g' when +done choosing them. These Dired listings to union are included in the +order that you chose them, and each entry is listed only once in the +new Dired buffer. + +The new Dired listing respects the markings, subdirectory insertions, +and hidden subdirectories of the selected Dired listings. However, in +case of conflict between marked or unmarked status for the same entry, +the entry is marked. Similarly, in case of conflict over an included +subdirectory between it being hidden or shown, it is hidden, but its +contained files are also listed. + +See also command `diredp-add-to-dired-buffer'. + +From Lisp: + DIRED-NAME is the name of the resulting Dired union buffer. + DIRBUFS is a list of the names of Dired buffers to union. + SWITCHES is a string of `ls' switches. + EXTRA is a list of files & directories to be included in the listing." + (interactive (diredp-dired-union-interactive-spec "UNION " + nil + (and current-prefix-arg + (<= (prefix-numeric-value current-prefix-arg) 0)))) + (diredp-dired-union-1 dired-name dirbufs switches extra)) + +;;;###autoload +(defun diredp-dired-union-other-window (dired-name dirbufs &optional switches extra) ; Bound to `C-x 4 D U' + "Same as `diredp-dired-union', except use other window." + (interactive (diredp-dired-union-interactive-spec "UNION " + nil + (and current-prefix-arg + (<= (prefix-numeric-value current-prefix-arg) 0)))) + (diredp-dired-union-1 dired-name dirbufs switches extra 'OTHERWIN)) + +;;;###autoload +(defun diredp-add-to-dired-buffer (dired-name to-add &optional switches) ; Bound to `C-x D A' + "Add individual file and directory names to a Dired buffer. +You are prompted for the buffer name. +With a prefix arg, you are also prompted for the `ls' switches. + +The buffer must either not exist yet or must list arbitrary file and +directory names. That is, it cannot be an ordinary Dired directory +listing - those cannot be modified. + +Any directory names you choose this way are included as single entries +in the listing - the directory contents are not included (these +directories are not unioned). To instead include the contents of a +directory chosen this way, use a glob pattern: `/*' after the +directory name. + +See also command `diredp-dired-union'. + +From Lisp: + DIRED-NAME is the name of the Dired buffer to modify. + TO-ADD is the list of files and dirs to add to it. + SWITCHES is the string of `ls' switches." + ;; Bind `current-prefix-arg' to force reading file/dir names. + ;; Read `ls' switches too, if user used prefix arg. + (interactive + (let* ((current-prefix-arg (if current-prefix-arg 0 -1)) + (all (diredp-dired-union-interactive-spec "add files/dirs " + 'NO-DIRED-BUFS + 'READ-EXTRA-FILES-P))) + (list (nth 0 all) (nth 3 all) (nth 2 all)))) + (diredp-dired-union-1 dired-name () switches to-add)) + +;;;###autoload +(defun diredp-add-to-dired-buffer-other-window (dired-name to-add &optional switches) ; Bound to `C-x 4 D A' + "Same as `diredp-add-to-dired-buffer', except use other window." + ;; Bind `current-prefix-arg' to force reading file/dir names. + ;; Read `ls' switches too, if user used prefix arg. + (interactive + (let* ((current-prefix-arg (if current-prefix-arg 0 -1)) + (all (diredp-dired-union-interactive-spec "add files/dirs " + 'NO-DIRED-BUFS + 'READ-EXTRA-FILES-P))) + (list (nth 0 all) (nth 3 all) (nth 2 all)))) + (diredp-dired-union-1 dired-name () switches to-add 'OTHERWIN)) + +;;;###autoload +(defun diredp-add-to-this-dired-buffer (dired-name to-add &optional switches) ; Not bound by default + "Same as `diredp-add-to-dired-buffer' for this Dired buffer." + ;; Bind `current-prefix-arg' to force reading file/dir names. + ;; Read `ls' switches too, if user used prefix arg. + (interactive + (progn (unless (derived-mode-p 'dired-mode) (error "Not in a Dired buffer")) + (let* ((current-prefix-arg (if current-prefix-arg 0 -1)) + (all (diredp-dired-union-interactive-spec "add files/dirs here " + 'NO-DIRED-BUFS + 'READ-EXTRA-FILES-P + (buffer-name)))) + (list (nth 0 all) (nth 3 all) (nth 2 all))))) + (diredp-dired-union-1 dired-name () switches to-add)) + +;; $$$$$ Maybe I should set `dired-sort-inhibit' to t for now (?), +;; since there is an Emacs bug (at least on Windows) that prevents +;; sorting from working for a Dired buffer with an explicit file list. +(defun diredp-dired-union-1 (dired-name dirbufs switches extra &optional otherwin) + "Helper for `diredp-dired-union' and `diredp-add-to-dired-buffer'. +Non-nil optional OTHERWIN means use other window for the Dired buffer. +See `diredp-dired-union' for the other argument descriptions." + (let ((dbuf (get-buffer dired-name)) + (files extra) + (marked ()) + (subdirs ()) + (hidden-dirs ()) + hid-here files-here) + (dolist (buf (reverse dirbufs)) + (with-current-buffer buf + (unwind-protect + (progn (setq hid-here (save-excursion (dired-remember-hidden)) + files-here (if (consp dired-directory) + (reverse (cdr dired-directory)) ; Reverse bc will push. + ())) + (unless files-here + (save-excursion ; This bit is more or less from `dired-toggle-marks'. + (goto-char (point-min)) + (while (not (eobp)) + (or (diredp-looking-at-p dired-re-dot) + (push (dired-get-filename nil 'NO-ERROR-P) files-here)) + (forward-line 1))) + (setq files-here (delq nil files-here))) + (dolist (hid-here hid-here) (push hid-here hidden-dirs)) + (dolist (sub (cdr (reverse dired-subdir-alist))) + (push (list (car sub)) subdirs)) + (dolist (mkd (dired-remember-marks (point-min) (point-max))) ; This unhides. + (push (car mkd) marked)) + (dolist (file files-here) + (when (or (not (file-name-absolute-p file)) (not (member file files))) + (push file files)))) + (save-excursion ; Hide subdirs that were hidden. + (dolist (dir hid-here) (when (dired-goto-subdir dir) (dired-hide-subdir 1))))))) + ;; For an existing Dired buffer having this name whose `dired-directory' is a cons: + ;; 1. Include the files and dirs already listed there. + ;; 2. Kill the current buffer and delete its window. A new buffer of the same name is created and shown. + (when dbuf + (with-current-buffer dbuf + (when (consp dired-directory) (setq files (diredp-set-union (cdr dired-directory) files))) + (let ((win (get-buffer-window dbuf 0))) (when win (delete-window win))) + (kill-buffer dbuf))) + (setq dbuf (dired-other-window (cons dired-name files) switches)) + (with-current-buffer dbuf + (let ((inhibit-read-only t)) + (dired-insert-old-subdirs subdirs) + (dired-mark-remembered ; Don't really need `expand-file-name' - already abs. + (mapcar (lambda (mf) (cons (expand-file-name mf dired-directory) 42)) marked)) + (save-excursion + (dolist (hdir hidden-dirs) (when (dired-goto-subdir hdir) (dired-hide-subdir 1)))))))) + +(defun diredp-dired-union-interactive-spec (string &optional no-dired-bufs read-extra-files-p dired-buffer) + "Read arguments for `diredp-dired-union' and `diredp-add-to-dired-buffer'. +STRING is appended to the prompt for the listing buffer name. +Non-nil NO-DIRED-BUFS means do not read Dired buffers to union. +Non-nil READ-EXTRA-FILES-P is passed to `dired-read-dir-and-switches', + and means read extra files to add to the listing. +Non-nil DIRED-BUFFER is passed to `dired-read-dir-and-switches'. + It is the name of the Dired union buffer." + (let* ((current-prefix-arg -1) + (dir+switches (dired-read-dir-and-switches string read-extra-files-p dired-buffer)) + (dirname (car dir+switches)) + (switches (cadr dir+switches)) + (dirbufs ()) + (bufs ()) + (extra-files ()) + buf) + (when (consp dirname) (setq extra-files (cdr dirname) + dirname (car dirname))) + (unless no-dired-bufs + ;; Remove any killed buffers from `dired-buffers'. Then use all but the target buffer as candidates. + (dolist (db dired-buffers) + (if (buffer-live-p (cdr db)) + (unless (equal dirname (buffer-name (cdr db))) + (push (cons (buffer-name (cdr db)) (car db)) dirbufs)) + (setq dired-buffers (delq db dired-buffers)))) + (while (and dirbufs (condition-case nil + (setq buf (completing-read "Existing Dired buffer to include (C-g when done): " + dirbufs nil t nil 'buffer-name-history + (and dirbufs (car (assoc (buffer-name) dirbufs))))) + (quit nil))) + (push buf bufs) + (setq dirbufs (delete (cons buf (with-current-buffer buf (expand-file-name default-directory))) + dirbufs))) + (setq bufs (nreverse bufs))) + (list dirname bufs switches extra-files))) + +(when (> emacs-major-version 23) ; `compilation--loc->file-struct' + + (defalias 'diredp-grepped-files-other-window 'diredp-compilation-files-other-window) + (defun diredp-compilation-files-other-window (&optional switches) + "Open Dired on the files indicated by compilation (e.g., `grep') hits. +Applies to any `compilation-mode'-derived buffer, such as `*grep*'. +You are prompted for the name of the new Dired buffer. +With a prefix arg you are first prompted for the `ls' switches. + +\(However, Emacs bug #20739 means that the switches are ignored.)" + (interactive (list (and current-prefix-arg (read-string "Dired listing switches: " dired-listing-switches)))) + (unless (compilation-buffer-p (current-buffer)) (error "Not in a buffer derived from `compilation-mode'")) + (let ((files ())) + (save-excursion (goto-char (point-min)) + (while (condition-case nil (compilation-next-file 1) (error nil)) + (setq compilation-current-error (point)) + (push (diredp-file-for-compilation-hit-at-point) files))) + (setq files (nreverse files)) + (dired-other-window + (cons (read-string "Dired buffer name: " nil nil (generate-new-buffer-name default-directory)) files) + switches))) + + (defun diredp-file-for-compilation-hit-at-point () + "Return the name of the file for the compilation hit at point. +The name is expanded in the directory for the last directory change." + (let* ((msg (compilation-next-error 0)) + (loc (compilation--message->loc msg)) + (filestruct (compilation--loc->file-struct loc)) + (file (caar filestruct)) + (dir (cadr (car filestruct)))) + (when dir (setq file (expand-file-name file dir))) + file)) + ) + +;;;###autoload +(defun diredp-fileset (flset-name) ; Bound to `C-x D S' + "Open Dired on the files in fileset FLSET-NAME." + (interactive + (progn (unless (require 'filesets nil t) (error "Feature `filesets' not provided")) + (unless filesets-data (error "`filesets-data' is empty")) + (list (completing-read "Open Dired on fileset: " filesets-data)))) + (diredp-fileset-1 flset-name)) + +;;;###autoload +(defun diredp-fileset-other-window (flset-name) ; Bound to `C-x 4 D S' + "Open Dired in another window on the files in fileset FLSET-NAME." + (interactive + (progn (unless (require 'filesets nil t) (error "Feature `filesets' not provided")) + (unless filesets-data (error "`filesets-data' is empty")) + (list (completing-read "Open Dired on fileset, in other window: " filesets-data)))) + (diredp-fileset-1 flset-name 'OTHER-WINDOW)) + +(defun diredp-fileset-1 (flset-name &optional other-window-p) + "Helper for `diredp-fileset(-other-window)'." + (let ((flset (filesets-get-fileset-from-name flset-name)) + (files ()) + (mode nil) + (dirfun (if other-window-p #'dired-other-window #'dired))) + (unless (or (setq mode (filesets-entry-mode flset)) ; ("my-fs" (:files "a" "b")) + (setq flset (cons "dummy" flset) ; (:files "a" "b") + mode (filesets-entry-mode flset))) + (error "Bad fileset: %S" flset-name)) + (message "Gathering file names...") + (dolist (file (filesets-get-filelist flset mode)) (push file files)) + (funcall dirfun (cons (generate-new-buffer-name flset-name) + (nreverse (mapcar (lambda (file) + (if (file-name-absolute-p file) + (expand-file-name file) + file)) + files)))))) + +;;;###autoload +(defun diredp-dired-this-subdir (&optional tear-off-p msgp) + "Open Dired for the subdir at or above point. +If point is not on a subdir line, but is in an inserted subdir +listing, then use that subdir. + +With a prefix arg: + If the subdir is inserted and point is in the inserted listing then + remove that listing and move to the ordinary subdir line. In other + words, when in an inserted listing, a prefix arg tears off the + inserted subdir to its own Dired buffer." + (interactive "P\np") + (diredp-ensure-mode) + (let* ((this-dir default-directory) + (this-subdir (diredp-this-subdir)) + (on-dir-line-p (atom this-subdir))) + (unless on-dir-line-p ; Subdir header line or non-directory file. + (setq this-subdir (car this-subdir))) + (unless (string= this-subdir this-dir) + (when tear-off-p + (unless on-dir-line-p + (dired-kill-subdir) ; Tear it off. + (dired-goto-file this-subdir))) ; Move to normal subdir line. + (dired-other-window this-subdir)))) + +;;;###autoload +(defun diredp-dired-inserted-subdirs (&optional no-show-p msgp) ; Bound to `C-M-i' + "Open Dired for each of the subdirs inserted in this Dired buffer. +A separate Dired buffer is used for each of them. +With a prefix arg, create the Dired buffers but do not display them. +Markings and current Dired switches are preserved." + (interactive "P\np") + (diredp-ensure-mode) + (let ((this-dir default-directory) + (this-buff (current-buffer)) + (this-frame (selected-frame)) + marked) + (unwind-protect + (save-selected-window + (dolist (entry dired-subdir-alist) + (unless (string= (car entry) this-dir) + (setq marked (with-current-buffer this-buff + (dired-remember-marks (dired-get-subdir-min entry) (dired-get-subdir-max entry)))) + (if (not no-show-p) + (dired-other-window (car entry) dired-actual-switches) + (dired-noselect (car entry) dired-actual-switches) + (when msgp (message "Dired buffers created but not shown"))) + (set-buffer this-buff) + (let ((inhibit-read-only t)) + (dired-mark-remembered marked)) + (set-buffer-modified-p nil)))) + (select-frame-set-input-focus this-frame)))) + + +;;; Actions on marked files and subdirs, recursively. + +(defun diredp-get-subdirs (&optional ignore-marks-p predicate details) + "Return subdirs from this Dired buffer and from marked subdirs, recursively. +If optional arg IGNORE-MARKS-P is non-nil then include all +subdirectories. Otherwise, include only those that are marked. + +Non-nil optional arg PREDICATE means include only subdirectory names +for which the PREDICATE returns non-nil. PREDICATE must accept a file +name as its only required argument. + +Optional arg DETAILS is passed to `diredp-get-files'." + (diredp-get-files ignore-marks-p (if predicate + `(lambda (name) (and (file-directory-p name) (funcall ,predicate name))) + #'file-directory-p) + 'INCLUDE-DIRS-P 'DONT-ASKP 'ONLY-MARKED-P details)) + +(defun diredp-get-files (&optional ignore-marks-p predicate include-dirs-p dont-askp only-marked-p details) + "Return file names from this Dired buffer and subdirectories, recursively. +The names are those that are marked in the current Dired buffer, or +all files in the directory if none are marked. Marked subdirectories +are handled recursively in the same way. + +If there is some included subdirectory that has a Dired buffer with +marked files, then (unless DONT-ASKP is non-nil) this asks you whether +to use the marked files in Dired buffers, as opposed to using all of +the files in included directories. To this y-or-n question you can +hit `l' to see the list of files that will be included (using +`diredp-list-files'). In that `l' listing you can mouseover to see +image-file previews or use `RET' or `mouse-2' to visit files. + +\(Directories in `icicle-ignored-directories' are skipped, if you use +Icicles. Otherwise, directories in `vc-directory-exclusion-list' are +skipped.) + +Non-nil IGNORE-MARKS-P means ignore all Dired markings: just get all +of the files in the current directory (and all of the subdirectories, +if INCLUDE-DIRS-P is non-nil). + +Non-nil PREDICATE means include only file names for which the +PREDICATE returns non-nil. PREDICATE must accept a file name as its +only required argument. + +Non-nil INCLUDE-DIRS-P means include marked subdirectory names (but +also handle those subdirs recursively, picking up their marked files +and subdirs). + +Non-nil DONT-ASKP means do not ask the user whether to use marked +instead of all. Act as if the user was asked and replied `y'. + +Non-nil optional arg ONLY-MARKED-P means collect only marked files, +instead of collecting all files if none are marked. This argument is +ignored if IGNORE-MARKS-P is non-nil. + +Optional arg DETAILS is passed to `diredp-y-or-n-files-p'." + (let ((askp (list nil))) ; The cons's car will be set to `t' if need to ask user. + (if ignore-marks-p + (diredp-files-within (directory-files default-directory 'FULL diredp-re-no-dot) + () nil include-dirs-p predicate) + ;; Pass FILES and ASKP to `diredp-get-files-for-dir', so we don't have to use them as + ;; free vars there. But that means that they each need to be a cons cell that we can + ;; modify, so we can get back the updated info. + (let ((files (list 'DUMMY))) ; The files picked up will be added to this list. + (diredp-get-files-for-dir default-directory files askp include-dirs-p only-marked-p) + (setq files (cdr files)) ; Remove `DUMMY' from the modifed list. + (if (or dont-askp + (not (car askp)) + (diredp-y-or-n-files-p "Use marked (instead of all) in subdir Dired buffers? " + files predicate details)) + (if predicate (diredp-remove-if-not predicate files) files) + (setq files ()) + (dolist (file (diredp-marked-here)) + (if (not (file-directory-p file)) + (when (or (not predicate) (funcall predicate file)) + (add-to-list 'files file)) + (when include-dirs-p (setq files (nconc files (list file)))) + (setq files (nconc files (diredp-files-within (directory-files file 'FULL diredp-re-no-dot) + () nil include-dirs-p predicate))))) + (nreverse files)))))) + +(defun diredp-get-files-for-dir (directory accum askp &optional include-dirs-p only-marked-p) + "Return marked file names for DIRECTORY and subdirectories, recursively. +Pick up names of all marked files in DIRECTORY if it has a Dired +buffer, or all files in DIRECTORY if not. Handle subdirs recursively +\(only marked subdirs, if Dired). + +ACCUM is an accumulator list: the files picked up in this call are +nconc'd to it. + +ASKP is a one-element list, the element indicating whether to ask the +user about respecting Dired markings. It is set here to `t' if there +is a Dired buffer for DIRECTORY. + +Non-nil optional arg INCLUDE-DIRS-P means include marked subdirectory +names (but also handle those subdirs recursively). + +Non-nil optional arg ONLY-MARKED-P means collect only marked files, +instead of collecting all files if none are marked. + +If there is more than one Dired buffer for DIRECTORY then raise an +error." + (let ((dbufs (dired-buffers-for-dir (expand-file-name directory)))) + (dolist (file (if (not dbufs) + (and (not only-marked-p) (directory-files directory 'FULL diredp-re-no-dot)) + (when (cadr dbufs) (error "More than one Dired buffer for `%s'" directory)) + (unless (equal directory default-directory) (setcar askp t)) + (with-current-buffer (car dbufs) (diredp-marked-here only-marked-p 'NO-DOT-DOT)))) + (if (not (file-directory-p file)) + (setcdr (last accum) (list file)) + (when include-dirs-p (setcdr (last accum) (list file))) + (diredp-get-files-for-dir file accum askp include-dirs-p only-marked-p))))) + +(defun diredp-marked-here (&optional only-marked-p no-dot-dot-p) + "Marked files and subdirs in this Dired buffer, or all if none are marked. +Non-nil optional arg ONLY-MARKED-P means return nil if none are +marked. +Non-nil optional arg NO-DOT-DOT-P means do not include marked `..'." + ;; If no file is marked, exclude `(FILENAME)': the unmarked file at cursor. + ;; If there are no marked files as a result, return all files and subdirs in the dir. + (let* ((dired-marker-char ?*) + (ff (condition-case nil ; Ignore error if on `.' or `..' and no file is marked. + (dired-get-marked-files + nil nil (and no-dot-dot-p + (lambda (mf) (not (diredp-string-match-p "/\\.\\.$" mf)))) + 'DISTINGUISH-ONE-MARKED) + (error nil)))) + (cond ((eq t (car ff)) (cdr ff)) ; Single marked + ((cadr ff) ff) ; Multiple marked + (t (and (not only-marked-p) ; None marked + (directory-files default-directory 'FULL diredp-re-no-dot 'NOSORT)))))) + +(defun diredp-y-or-n-files-p (prompt files &optional predicate details) + "PROMPT user with a \"y or n\" question about a list of FILES. +Return t if answer is \"y\". Otherwise, return nil. + +Like `y-or-n-p', but you can also hit `l' to display the list of files +that the confirmation is for, in buffer `*Files'. In that `'l' +listing you can mouseover to see image-file previews or use `RET' or +`mouse-2' to visit files. + +When finished, buffer `*Files*' is killed if it was never shown, or is +hidden and buried otherwise. Thus, if it was shown then it is still +available to revisit afterward (even if you quit using `C-g'). + +PREDICATE is passed to `diredp-list-files', to list only file names +for which it returns non-nil. + +DETAILS is passed to `diredp-list-files', to show details about FILES." + (let ((answer 'recenter)) + (cond (noninteractive + (setq prompt (concat prompt + (and (not (eq ?\ (aref prompt (1- (length prompt))))) " ") + "(y or n; l to show file list) ")) + (let ((temp-prompt prompt)) + (while (not (memq answer '(act skip))) + (let ((str (read-string temp-prompt))) + (cond ((member str '("y" "Y")) (setq answer 'act)) + ((member str '("n" "N")) (setq answer 'skip)) + (t (setq temp-prompt (concat "Please answer y or n. " prompt)))))))) + ((if (not (fboundp 'display-popup-menus-p)) + (and window-system (listp last-nonmenu-event) use-dialog-box) + (and (display-popup-menus-p) (listp last-nonmenu-event) use-dialog-box)) + (setq answer (x-popup-dialog t `(,prompt ("Yes" . act) ("No" . skip))))) + (t + (let ((list-buf (generate-new-buffer-name "*Files*")) + (list-was-shown nil)) + (unwind-protect + (progn + (define-key query-replace-map "l" 'show) + (setq prompt (concat prompt + (and (eq ?\ (aref prompt (1- (length prompt)))) + "" " ") + "(y or n; l to show file list) ")) + (while (let* ((reprompt-actions '(recenter scroll-up scroll-down + scroll-other-window scroll-other-window-down)) + (key (let ((cursor-in-echo-area t)) + (when minibuffer-auto-raise + (raise-frame (window-frame (minibuffer-window)))) + (if (fboundp 'read-key) + (read-key (propertize + (if (memq answer reprompt-actions) + prompt + (concat "Please answer y or n. " prompt)) + 'face 'minibuffer-prompt)) + (read-char-exclusive + (if (memq answer reprompt-actions) + prompt + (concat "Please answer y or n. " prompt))))))) + (setq answer (lookup-key query-replace-map (vector key) t)) + (case answer + ((skip act) nil) + (recenter (recenter) t) + (show (diredp-list-files files nil list-buf predicate details) + (setq list-was-shown t)) ; Record showing it. + (help (message "Use `l' to show file list") (sit-for 1)) + (scroll-up (condition-case nil (scroll-up-command) (error nil)) t) + (scroll-down (condition-case nil (scroll-down-command) (error nil)) t) + (scroll-other-window (condition-case nil (scroll-other-window) (error nil)) t) + (scroll-other-window-down (condition-case nil (scroll-other-window-down nil) + (error nil)) t) + ((exit-prefix quit) (signal 'quit nil) t) + (t (or (not (eq key ?\e)) (progn (signal 'quit nil) t))))) + (ding) + (discard-input))) + (when (get-buffer list-buf) + (save-window-excursion (pop-to-buffer list-buf) + (condition-case nil ; Ignore error if user already deleted. + (if (one-window-p) (delete-frame) (delete-window)) + (error nil)) + (if list-was-shown (bury-buffer list-buf) (kill-buffer list-buf)))) + (define-key query-replace-map "l" nil))))) + (let ((ret (eq answer 'act))) + (unless noninteractive (message "%s %s" prompt (if ret "y" "n"))) + ret))) + +(defvar diredp-list-files-map + (let ((map (make-sparse-keymap))) + (define-key map "q" 'quit-window) + (define-key map "\r" 'diredp-find-line-file-other-window) + (define-key map [mouse-2] 'diredp-mouse-find-line-file-other-window) + map) + "Keymap for `diredp-list-files' output.") +(fset 'diredp-list-files-map diredp-list-files-map) + +;;;###autoload +(defun diredp-find-line-file-other-window () + "Visit file named by current line, in another window. +The full text of the line is used as the file name." + (interactive) + (let ((file (buffer-substring-no-properties (line-beginning-position) (line-end-position)))) + (when file (find-file-other-window file)))) + +;;;###autoload +(defun diredp-mouse-find-line-file-other-window (e) + "Visit file named by clicked line, in another window. +The full text of the line is used as the file name." + (interactive "e") + (save-excursion (mouse-set-point e) (diredp-find-line-file-other-window))) + +;;;###autoload +(defun diredp-list-marked (&optional arg predicate interactivep details) ; Bound to `C-M-l' + "List the marked files in this Dired buffer. +A prefix arg specifies files to use instead of the marked files: + + * Numeric prefix arg N: The next N files (previous -N, if < 0). + * C-u C-u: All files, but no directories. + * C-u C-u C-u: All files and directories, except `.' and `..' + * C-u C-u C-u C-u: All files and directories, including `.' and `..' + * Any other prefix arg: The current line's file only. + +You can use `RET' or `mouse-2' to visit any of the files. +If `tooltip-mode' is on then moving the mouse over image-file names +shows image previews. + +When called from Lisp: + Non-nil optional arg PREDICATE is a file-name predicate. List only + the files for which it returns non-nil. + Non-nil optional arg DETAILS is passed to `diredp-list-files'." + (interactive (progn (diredp-ensure-mode) (list current-prefix-arg nil t diredp-list-file-attributes))) + (let ((files (dired-get-marked-files nil arg predicate 'DISTINGUISH-ONE interactivep))) + (diredp-list-files files nil nil nil details))) + +(defun diredp-list-files (files &optional dir bufname predicate details) + "Display FILES, a list of file names. Wildcard patterns are expanded. +The files are shown in a new buffer, `*Files*' by default. + +Optional arg DIR serves as the default directory for expanding file + names that are not absolute. It defaults to `default-directory'. + +Optional arg BUFNAME is the name of the buffer for the display. + It defaults to `*Files*' (or `*Files*' if `*Files*' exists). + +Optional arg PREDICATE is a predicate used to filter FILES: only files + satisfying PREDICATE are listed. + +Non-nil arg DETAILS means show details about each file, in addition to +the file name. It is passed to `diredp-list-file' (which see). + +File names listed are absolute. Mouseover gives help or an image-file +preview, and you can use `RET' or `mouse-2' to visit files." + (unless bufname (setq bufname (generate-new-buffer-name "*Files*"))) + (diredp-with-help-window + bufname + (princ "Files\n-----\n\n") + (let ((all-files-no-wildcards ()) + file-alist file-dir) + (dolist (file files) + (unless (or (string= file "") ; Ignore empty file names. + (and predicate (not (funcall predicate file)))) + (if (not (diredp-string-match-p "[[?*]" file)) + (add-to-list 'all-files-no-wildcards (diredp-list-file file details)) + (setq file-dir (or (file-name-directory file) default-directory) + file-alist (directory-files-and-attributes file-dir 'FULL "[[?*]" 'NOSORT)) + (dolist (ff file-alist) + (add-to-list 'all-files-no-wildcards (diredp-list-file file details)))))) + (save-excursion (dolist (fff (nreverse all-files-no-wildcards)) + (princ fff) (terpri))))) + (with-current-buffer bufname + (let ((buffer-read-only nil)) + (save-excursion + (goto-char (point-min)) + (forward-line 3) + (while (not (eobp)) + (add-text-properties (line-beginning-position) (line-end-position) + '(mouse-face highlight help-echo diredp-mouseover-help dired-filename t + ;; `keymap' does not work for Emacs 20. Could use `local-map' + ;; but that still leaves `RET' bound to `help-follow'. + keymap diredp-list-files-map)) + (forward-line 1)))) + (set-buffer-modified-p nil) + (setq buffer-read-only t) + (buffer-enable-undo))) + +(defun diredp-list-file (file &optional details) + "Return FILE name, expanded. +Non-nil optional arg DETAILS means append details about FILE to the +returned string. + +If DETAILS is a list of file attribute numbers then include only the +values of those attributes. Otherwise, include all attribute values." + (let ((file-dir (and details (or (file-name-directory file) default-directory))) + attrs) + (setq file (expand-file-name file file-dir)) + (when (and details (atom details)) (setq details '(0 1 2 3 4 5 6 7 8 9 10 11))) + (concat + file + (and details + (setq attrs (file-attributes file)) + (concat + "\n" + (and (memq 0 details) + (format " File Type: %s\n" + (cond ((eq t (nth 0 attrs)) "Directory") + ((stringp (nth 0 attrs)) (format "Symbolic link to `%s'" (nth 0 attrs))) + (t "Normal file")))) + (and (memq 8 details) + (format " Permissions: %s\n" (nth 8 attrs))) + (and (memq 7 details) (not (eq t (nth 0 attrs))) + (format " Size in bytes: %g\n" (nth 7 attrs))) + (and (memq 4 details) + (format-time-string " Time of last access: %a %b %e %T %Y (%Z)\n" (nth 4 attrs))) + (and (memq 5 details) + (format-time-string " Time of last modification: %a %b %e %T %Y (%Z)\n" (nth 5 attrs))) + (and (memq 6 details) + (format-time-string " Time of last status change: %a %b %e %T %Y (%Z)\n" (nth 6 attrs))) + (and (memq 1 details) + (format " Number of links: %d\n" (nth 1 attrs))) + (and (memq 2 details) + (format " User ID (UID): %s\n" (nth 2 attrs))) + (and (memq 3 details) + (format " Group ID (GID): %s\n" (nth 3 attrs))) + (and (memq 10 details) + (format " Inode: %S\n" (nth 10 attrs))) + (and (memq 11 details) + (format " Device number: %s\n" (nth 11 attrs)))))))) + +(defvar diredp-files-within-dirs-done () + "Directories already processed by `diredp-files-within'.") + + +;; Not used in the `Dired+' code yet. +(defun diredp-directories-within (&optional directory no-symlinks-p predicate) + "List of accessible directories within DIRECTORY. +Directories in `icicle-ignored-directories' are skipped, if you use +Icicles. Otherwise, directories in `vc-directory-exclusion-list' are +skipped. + +Optional arg DIRECTORY defaults to the value of `default-directory'. +Non-nil optional arg NO-SYMLINKS-P means do not follow symbolic links. +Non-nil optional arg PREDICATE must be a function that accepts a + file-name argument. Only directories that satisfy PREDICATE are + included in the result." + (unless directory (setq directory default-directory)) + (let ((dirs (diredp-files-within (directory-files directory 'FULL diredp-re-no-dot) + () no-symlinks-p 'INCLUDE-DIRS-P + #'file-directory-p))) + (if predicate (diredp-remove-if-not predicate dirs) dirs))) + +;; Args INCLUDE-DIRS-P and PREDICATE are not used in the `Dired+' code yet +;; (except in `diredp-directories-within', which also is not used yet). +;; +(defun diredp-files-within (file-list accum &optional no-symlinks-p include-dirs-p predicate) + "List of readable files in FILE-LIST, handling directories recursively. +FILE-LIST is a list of file names or a function that returns such. +If a function then invoke it with no args to get the list of files. + +Accessible directories in the list of files are processed recursively +to include their files and the files in their subdirectories. The +directories themselves are not included, unless optional arg +INCLUDE-DIRS-P is non-nil. (Directories in +`icicle-ignored-directories' are skipped, if you use Icicles. +Otherwise, directories in `vc-directory-exclusion-list' are skipped.) + +But if there is a Dired buffer for such a directory, and if FILE-LIST +is a function, then it is invoked in that Dired buffer to return the +list of files to use. E.g., if FILE-LIST is `dired-get-marked-files' +then only the marked files and subdirectories are included. If you +have more than one Dired buffer for a directory that is processed +here, then only the first one in `dired-buffers' is used. + +The list of files is accumulated in ACCUM, which is used for recursive +calls. + +Non-nil optional arg NO-SYMLINKS-P means do not follow symbolic links. + +Non-nil optional arg INCLUDE-DIRS-P means include directory names +along with the names of non-directories. + +Non-nil optional arg PREDICATE must be a function that accepts a +file-name argument. Only files (and possibly directories) that +satisfy PREDICATE are included in the result." + ;; Bind `diredp-files-within-dirs-done' for use as a free var in `diredp-files-within-1'. + (let ((diredp-files-within-dirs-done ())) + (nreverse (diredp-files-within-1 file-list accum no-symlinks-p include-dirs-p predicate)))) + +;; `diredp-files-within-dirs-done' is free here, bound in `diredp-files-within'. +(defun diredp-files-within-1 (file-list accum no-symlinks-p include-dirs-p predicate) + "Helper for `diredp-files-within'." + (let ((files (if (functionp file-list) (funcall file-list) file-list)) + (res accum) + file) + (when (and files predicate) (setq files (diredp-remove-if-not predicate files))) + (while files + (setq file (car files)) + (unless (and no-symlinks-p (file-symlink-p file)) + (if (file-directory-p file) + ;; Skip directory if ignored, already treated, or inaccessible. + (when (and (not (member (file-name-nondirectory file) + (if (boundp 'icicle-ignored-directories) + icicle-ignored-directories + (and (boundp 'vc-directory-exclusion-list) + vc-directory-exclusion-list)))) + (not (member (file-truename file) diredp-files-within-dirs-done)) + (file-accessible-directory-p file)) + (setq res (diredp-files-within-1 (or (and (functionp file-list) + (dired-buffers-for-dir + (expand-file-name file)) ; Removes killed buffers. + (with-current-buffer + (cdr (assoc (file-name-as-directory file) + dired-buffers)) + (funcall file-list))) + (directory-files file 'FULL diredp-re-no-dot)) + res no-symlinks-p include-dirs-p predicate)) + (when include-dirs-p (push file res)) + (push (file-truename file) diredp-files-within-dirs-done)) + (when (file-readable-p file) (push file res)))) + (pop files)) + res)) + +(defun diredp-remove-if (pred xs) + "A copy of list XS with no elements that satisfy predicate PRED." + (let ((result ())) + (dolist (x xs) (unless (funcall pred x) (push x result))) + (nreverse result))) + +(defun diredp-remove-if-not (pred xs) + "A copy of list XS with only elements that satisfy predicate PRED." + (let ((result ())) + (dolist (x xs) (when (funcall pred x) (push x result))) + (nreverse result))) + +(when (> emacs-major-version 21) ; Emacs 20 has no PREDICATE arg to `read-file-name'. + (defun diredp-insert-as-subdir (child ancestor &optional in-dired-now-p) + "Insert the current Dired dir into a Dired listing of an ancestor dir. +Ancestor means parent, grandparent, etc. at any level. +You are prompted for the ancestor directory. +The ancestor Dired buffer is selected. + +Markings and switches in the current Dired buffer are preserved for +the subdir listing in the ancestor Dired buffer. + +Note: If you use Icicles, then you can use +`icicle-dired-insert-as-subdir' instead: it is a multi-command. It +does the same thing, but it lets you insert any number of descendant +directories into a given ancestor-directory Dired buffer. + +Non-interactively: + Insert CHILD dir into Dired listing for ANCESTOR dir. + + Non-nil optional arg IN-DIRED-NOW-P means to use the current buffer + as the Dired buffer from which to pick up markings and switches. + Otherwise, pick them up from a Dired buffer for CHILD, if there is + exactly one such buffer." + (interactive (progn (diredp-ensure-mode) + (list default-directory + (completing-read + "Insert this dir into ancestor dir: " + (mapcar #'list (diredp-ancestor-dirs default-directory))) + t))) + (let ((child-dired-buf (if in-dired-now-p + (current-buffer) + (dired-buffers-for-dir (expand-file-name child)))) + (switches ()) + (marked ())) + (when (consp child-dired-buf) + (setq child-dired-buf (and (= 1 (length child-dired-buf)) (car child-dired-buf)))) + (when child-dired-buf + (with-current-buffer child-dired-buf + (setq switches dired-actual-switches + marked (dired-remember-marks (point-min) (point-max))))) + (dired-other-window ancestor) + (dired-insert-subdir child switches) + (when marked (let ((inhibit-read-only t)) (dired-mark-remembered marked))) + (set-buffer-modified-p nil)))) + +(defun diredp-ancestor-dirs (dir) + "Return a list of the ancestor directories of directory DIR." + (mapcar #'file-name-as-directory + (diredp-maplist (lambda (dd) (mapconcat #'identity (reverse dd) "/")) + (cdr (nreverse (split-string dir "/" t)))))) + +(defun diredp-maplist (function list) + "Map FUNCTION over LIST and its cdrs. +A simple, recursive version of the classic `maplist'." + (and list (cons (funcall function list) (diredp-maplist function (cdr list))))) + +(defun diredp-existing-dired-buffer-p (buffer-name) + "Return non-nil if BUFFER-NAME names a live, existing Dired buffer." + (let ((dbuf (get-buffer buffer-name))) + (and dbuf (buffer-live-p dbuf) (rassq dbuf dired-buffers)))) + +;; From `cl-seq.el', function `union', without keyword treatment. +;; (Same as `icicle-set-union' in `icicles-fn.el'.) +(defun diredp-set-union (list1 list2) + "Combine LIST1 and LIST2 using a set-union operation. +The result list contains all items that appear in either LIST1 or +LIST2. Comparison is done using `equal'. This is a non-destructive +function; it copies the data if necessary." + (cond ((null list1) list2) + ((null list2) list1) + ((equal list1 list2) list1) + (t + (unless (>= (length list1) (length list2)) + (setq list1 (prog1 list2 (setq list2 list1)))) ; Swap them. + (while list2 + (unless (member (car list2) list1) (setq list1 (cons (car list2) list1))) + (setq list2 (cdr list2))) + list1))) + +(when (fboundp 'file-equal-p) ; Emacs 24+ + (defun diredp-move-file (file &optional prompt-anyway) + "Move FILE to associated directory in `diredp-move-file-dirs'. +If no association, or if you use a prefix arg, prompt for directory." + (interactive (list (dired-get-filename) current-prefix-arg)) + (unless file (error "No file specified")) + (let* ((file-sans (file-name-nondirectory file)) + (dir (file-name-as-directory + (or (and (not prompt-anyway) + (cdr (assoc file-sans diredp-move-file-dirs))) + (read-directory-name "Move to: "))))) + (when (file-equal-p dir (file-name-directory file)) + (error "Cannot move to same directory: %s" dir)) + (dired-rename-file file dir nil) + (dired-add-file (expand-file-name file-sans dir)) + (message "Moved `%s' to `%s'" file-sans dir)))) + +(defvar diredp-last-copied-filenames () + "String list of file names last copied to the `kill-ring'. +Copying is done by `dired-copy-filename-as-kill' and related commands.") + + +;; REPLACE ORIGINAL in `dired-x.el'. +;; +;; Put text copied to kill ring in variable `diredp-last-copied-filenames'. +;; +(defun dired-copy-filename-as-kill (&optional arg) + "Copy names of marked (or next ARG) files into the kill ring. +The names are separated by a space. +With a zero prefix arg, use the absolute file name of each marked file. +With \\[universal-argument], use the file name relative to the Dired buffer's +`default-directory'. (This still may contain slashes if in a subdirectory.) + +If on a subdir headerline, use absolute subdirname instead; +prefix arg and marked files are ignored in this case. + +You can then feed the file name(s) to other commands with \\[yank]. + +The value of global variable `diredp-last-copied-filenames' is updated +to the string list of file name(s), so you can obtain it even after +the kill ring is modified." + (interactive "P") + (let* ((num-arg (prefix-numeric-value arg)) + (string (or (dired-get-subdir) + (mapconcat #'identity + (cond ((not arg) (dired-get-marked-files 'no-dir)) + ((zerop num-arg) (dired-get-marked-files)) + ((consp arg) (dired-get-marked-files t)) + (t (dired-get-marked-files 'no-dir num-arg))) + " ")))) + (unless (string= "" string) + (if (eq last-command 'kill-region) (kill-append string nil) (kill-new string)) + (setq diredp-last-copied-filenames (car kill-ring-yank-pointer)) + (message "%s" string)))) + +(defun diredp-copy-abs-filenames-as-kill () ; Not bound. + "Copy absolute names of marked files in Dired to the kill ring. +Also set variable `diredp-last-copied-filenames' to the string that +lists the file names. + +This is the same as using a zero prefix arg with command +`dired-copy-filename-as-kill', that is, \\`M-0 \\[dired-copy-filename-as-kill]'." + (interactive (diredp-ensure-mode)) + (dired-copy-filename-as-kill 0)) + +;;;###autoload +(defalias 'diredp-paste-files 'diredp-yank-files) ; Bound to `C-y'. +;;;###autoload +(defun diredp-yank-files (&optional dir no-confirm-p details) + "Paste files, whose absolute names you copied, to the current directory. +With a non-negative prefix arg you are instead prompted for the target + directory. +With a non-positive prefix arg you can see details about the files if + you hit `l' when prompted to confirm pasting. Otherwise you see only + the file names. The details you see are defined by option + `diredp-list-file-attributes'. + +You should have copied the list of file names as a string to the kill +ring using \\`M-0 \\[dired-copy-filename-as-kill]' or \ +\\[diredp-copy-abs-filenames-as-kill]. +Those commands also set variable `diredp-last-copied-filenames' to the +same string. `diredp-yank-files' uses the value of that variable, not +whatever is currently at the head of the kill ring. + +When called from Lisp: + +Optional arg NO-CONFIRM-P means do not ask for confirmation to copy. +Optional arg DETAILS is passed to `diredp-y-or-n-files-p'." + (interactive (list (and current-prefix-arg (natnump (prefix-numeric-value current-prefix-arg)) + (expand-file-name (read-directory-name "Yank files to directory: "))) + nil + (and current-prefix-arg + (<= (prefix-numeric-value current-prefix-arg) 0) + diredp-list-file-attributes))) + (setq dir (or dir (and (derived-mode-p 'dired-mode) (dired-current-directory)))) + (unless (file-directory-p dir) (error "Not a directory: `%s'" dir)) + (let ((files diredp-last-copied-filenames)) + (unless (stringp files) (error "No copied file names")) + (setq files (diredp-delete-if-not (lambda (file) (file-name-absolute-p file)) (split-string files))) + (unless files (error "No copied *absolute* file names (Did you use `M-0 w'?)")) + (if (and (not no-confirm-p) + (diredp-y-or-n-files-p "Paste files whose names you copied? " files nil details)) + (dired-create-files #'dired-copy-file "Copy" files + (lambda (from) (expand-file-name (file-name-nondirectory from) dir))) + (message "OK, file-pasting canceled")))) + +;;;###autoload +(defun diredp-move-files-named-in-kill-ring (&optional dir no-confirm-p details) ; Bound to `C-w' + "Move files, whose absolute names you copied, to the current directory. +With a non-negative prefix arg you are instead prompted for the target + directory. +With a non-positive prefix arg you can see details about the files if + you hit `l' when prompted to confirm pasting. Otherwise you see only + the file names. The details you see are defined by option + `diredp-list-file-attributes'. + +You should have copied the list of file names as a string to the kill +ring using \\`M-0 \\[dired-copy-filename-as-kill]' or \ +\\[diredp-copy-abs-filenames-as-kill]. +Those commands also set variable `diredp-last-copied-filenames' to the +same string. `diredp-move-files-named-in-kill-ring' uses the value of +that variable, not whatever is currently at the head of the kill ring. + +When called from Lisp: + +Optional arg NO-CONFIRM-P means do not ask for confirmation to move. +Optional arg DETAILS is passed to `diredp-y-or-n-files-p'." + (interactive (list (and current-prefix-arg (natnump (prefix-numeric-value current-prefix-arg)) + (expand-file-name (read-directory-name "Move files to directory: "))) + nil + (and current-prefix-arg + (<= (prefix-numeric-value current-prefix-arg) 0) + diredp-list-file-attributes))) + (setq dir (or dir (and (derived-mode-p 'dired-mode) (dired-current-directory)))) + (unless (file-directory-p dir) (error "Not a directory: `%s'" dir)) + (let ((files diredp-last-copied-filenames)) + (unless (stringp files) (error "No copied file names")) + (setq files (diredp-delete-if-not (lambda (file) (file-name-absolute-p file)) (split-string files))) + (unless files (error "No copied (absolute* file names (Did you use `M-0 w'?)")) + (if (and (not no-confirm-p) + (diredp-y-or-n-files-p "MOVE files whose names you copied? " files nil details)) + (dired-create-files #'dired-rename-file "Move" files + (lambda (from) (expand-file-name (file-name-nondirectory from) dir))) + (message "OK, file-moves canceled")))) + + +;;; Commands operating on marked at all levels below (recursively) + +(defun diredp-get-confirmation-recursive (&optional type) + "Get confirmation from user to act on all TYPE here and below. +If TYPE is nil use \"files\" in the confirmation prompt, else use TYPE. +Raise an error if not confirmed. +Raise an error first if not in Dired mode." + (diredp-ensure-mode) + (unless (y-or-n-p (format "Act on ALL %s (or all marked if any) in and UNDER this dir? " + (or type 'files))) + (error "OK, canceled"))) + +;;;###autoload +(when (> emacs-major-version 21) ; Emacs 22+ has KILL-ROOT parameter. + (defun diredp-kill-this-tree () + "Remove this subdir listing and lower listings." + (interactive) + (dired-kill-tree (dired-current-directory) nil 'KILL-ROOT))) + +;;;###autoload +(defun diredp-insert-subdirs (&optional switches interactivep) ; Bound to `M-i' + "Insert the marked subdirectories. +Like using \\`\\[dired-maybe-insert-subdir]' at each marked directory line." + (interactive (list (and current-prefix-arg + (read-string "Switches for listing: " + (or (and (boundp 'dired-subdir-switches) dired-subdir-switches) + dired-actual-switches))) + t)) + (dolist (subdir (dired-get-marked-files nil + nil + (lambda (fl) (and (file-directory-p fl) ; Exclude `.' and `..' + (not (diredp-string-match-p "/[.][.]?\\'" fl)))) + nil + interactivep)) + (dired-maybe-insert-subdir subdir switches))) + +;;;###autoload +(defun diredp-insert-subdirs-recursive (&optional ignore-marks-p details) ; Bound to `M-+ M-i' + "Insert the marked subdirs, including those in marked subdirs. +Like `diredp-insert-subdirs', but act recursively on subdirs. +The subdirs inserted are those that are marked in the current Dired +buffer, or ALL subdirs in the directory if none are marked. Marked +subdirectories are handled recursively in the same way (their marked +subdirs are inserted...). + +With a prefix argument, ignore all marks - include all files in this +Dired buffer and all subdirs, recursively. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-get-files'." + (interactive (progn (diredp-get-confirmation-recursive 'subdirs) + (list current-prefix-arg diredp-list-file-attributes))) + (dolist (subdir (diredp-get-files ignore-marks-p #'file-directory-p 'INCLUDE-SUBDIRS-P nil nil details)) + (dired-maybe-insert-subdir subdir))) + +;;;###autoload +(defun diredp-do-shell-command-recursive (command &optional ignore-marks-p details) ; Bound to `M-+ !' + "Run shell COMMAND on the marked files, including those in marked subdirs. +Like `dired-do-shell-command', but act recursively on subdirs. +The files included are those that are marked in the current Dired +buffer, or all files in the directory if none are marked. Marked +subdirectories are handled recursively in the same way. + +With a prefix argument, ignore all marks - include all files in this +Dired buffer and all subdirs, recursively. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-get-files'." + (interactive + (progn (diredp-get-confirmation-recursive) + (let* ((prompt "! on *: ") + (cmd (minibuffer-with-setup-hook + (lambda () + (set (make-local-variable 'minibuffer-default-add-function) + 'minibuffer-default-add-dired-shell-commands)) + (let ((dired-no-confirm t)) + (if (functionp 'dired-guess-shell-command) + ;; Guess cmd based only on files marked in current (top) dir. + (dired-guess-shell-command prompt (dired-get-marked-files t)) + (read-shell-command prompt nil nil)))))) + (list cmd current-prefix-arg diredp-list-file-attributes)))) + (dired-do-shell-command command nil (diredp-get-files ignore-marks-p nil nil nil nil details))) + +(when (fboundp 'dired-do-async-shell-command) ; Emacs 23+ + + (defun diredp-do-async-shell-command-recursive (command &optional ignore-marks-p details) + ; Bound to `M-+ &' + "Run async shell COMMAND on marked files, including in marked subdirs. +Like `dired-do-async-shell-command', but act recursively on subdirs. +The files included are those that are marked in the current Dired +buffer, or all files in the directory if none are marked. Marked +subdirectories are handled recursively in the same way. + +With a prefix argument, ignore all marks - include all files in this +Dired buffer and all subdirs, recursively. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-get-files'." + (interactive + (progn (diredp-get-confirmation-recursive) + (let* ((prompt "! on *: ") + (cmd (minibuffer-with-setup-hook + (lambda () + (set (make-local-variable 'minibuffer-default-add-function) + 'minibuffer-default-add-dired-shell-commands)) + (let ((dired-no-confirm t)) + (if (functionp 'dired-guess-shell-command) + ;; Guess cmd based only on files marked in current (top) dir. + (dired-guess-shell-command prompt (dired-get-marked-files t)) + (read-shell-command prompt nil nil)))))) + (list cmd current-prefix-arg diredp-list-file-attributes)))) + (dired-do-async-shell-command command nil (diredp-get-files ignore-marks-p nil nil nil nil details)))) + +;;;###autoload +(defun diredp-do-symlink-recursive (&optional ignore-marks-p details) ; Bound to `M-+ S' + "Make symbolic links to marked files, including those in marked subdirs. +Like `dired-do-symlink', but act recursively on subdirs to pick up the +files to link. + +The files included are those that are marked in the current Dired +buffer, or all files in the directory if none are marked. Marked +subdirectories are handled recursively in the same way. + +With a prefix argument, ignore all marks - include all files in this +Dired buffer and all subdirs, recursively. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-do-create-files-recursive'." + (interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg diredp-list-file-attributes))) + (diredp-do-create-files-recursive #'make-symbolic-link "Symlink" ignore-marks-p details)) + +(defun diredp-do-relsymlink-recursive (&optional ignore-marks-p details) ; Bound to `M-+ Y' + "Relative symlink all marked files, including those in marked subdirs into a dir. +Like `dired-do-relsymlink', but act recursively on subdirs to pick up the +files to link. + +The files included are those that are marked in the current Dired +buffer, or all files in the directory if none are marked. Marked +subdirectories are handled recursively in the same way. + +With a prefix argument, ignore all marks - include all files in this +Dired buffer and all subdirs, recursively. + +For absolute symlinks, use \\[diredp-do-symlink-recursive]. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-do-create-files-recursive'." + (interactive (progn (diredp-get-confirmation-recursive) + (list current-prefix-arg diredp-list-file-attributes))) + (diredp-do-create-files-recursive #'dired-make-relative-symlink "RelSymLink" ignore-marks-p details)) + +;;;###autoload +(defun diredp-do-hardlink-recursive (&optional ignore-marks-p details) ; Bound to `M-+ H' + "Add hard links for marked files, including those in marked subdirs. +Like `dired-do-hardlink', but act recursively on subdirs to pick up the +files to link. + +The files included are those that are marked in the current Dired +buffer, or all files in the directory if none are marked. Marked +subdirectories are handled recursively in the same way. + +With a prefix argument, ignore all marks - include all files in this +Dired buffer and all subdirs, recursively. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-do-create-files-recursive'." + (interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg diredp-list-file-attributes))) + (diredp-do-create-files-recursive #'dired-hardlink "Hardlink" ignore-marks-p details)) + +;;;###autoload +(defun diredp-do-print-recursive (&optional ignore-marks-p details) ; Bound to `M-+ P' + "Print the marked files, including those in marked subdirs. +Like `dired-do-print', but act recursively on subdirs to pick up the +files to print. + +The files included are those that are marked in the current Dired +buffer, or all files in the directory if none are marked. Marked +subdirectories are handled recursively in the same way. + +With a prefix argument, ignore all marks - include all files in this +Dired buffer and all subdirs, recursively. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-get-files'." + (interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg diredp-list-file-attributes))) + (let* ((file-list (diredp-get-files ignore-marks-p nil nil nil nil details)) + (command (dired-mark-read-string + "Print %s with: " + (mapconcat #'identity + (cons lpr-command (if (stringp lpr-switches) (list lpr-switches) lpr-switches)) + " ") + 'print nil file-list))) + (dired-run-shell-command (dired-shell-stuff-it command file-list nil)))) + +;;;###autoload +(defun diredp-image-dired-display-thumbs-recursive (&optional ignore-marks-p append do-not-pop details) + ; Bound to `M-+ C-t d' + "Display thumbnails of marked files, including those in marked subdirs. +Like `image-dired-display-thumbs', but act recursively on subdirs. +Optional arguments APPEND and DO-NOT-POP are as for +`image-dired-display-thumbs'. + +The files included are those that are marked in the current Dired +buffer, or all files in the directory if none are marked. Marked +subdirectories are handled recursively in the same way. + +With a prefix argument, ignore all marks - include all files in this +Dired buffer and all subdirs, recursively. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-get-files'." + (interactive (progn (diredp-image-dired-required-msg) + (diredp-get-confirmation-recursive) + (list current-prefix-arg nil nil diredp-list-file-attributes))) + (let ((buf (image-dired-create-thumbnail-buffer)) + thumb-name files dired-buf) + (setq files (diredp-get-files ignore-marks-p nil nil nil nil details) + dired-buf (current-buffer)) + (with-current-buffer buf + (let ((inhibit-read-only t)) + (if append (goto-char (point-max)) (erase-buffer)) + (mapc (lambda (curr-file) + (setq thumb-name (image-dired-thumb-name curr-file)) + (if (and (not (file-exists-p thumb-name)) + (not (= 0 (image-dired-create-thumb curr-file thumb-name)))) + (message "Thumb could not be created for file %s" curr-file) + (image-dired-insert-thumbnail thumb-name curr-file dired-buf))) + files)) + (case image-dired-line-up-method + (dynamic (image-dired-line-up-dynamic)) + (fixed (image-dired-line-up)) + (interactive (image-dired-line-up-interactive)) + (none nil) + (t (image-dired-line-up-dynamic)))) + (if do-not-pop + (display-buffer image-dired-thumbnail-buffer) + (pop-to-buffer image-dired-thumbnail-buffer)))) + +;;;###autoload +(defun diredp-image-dired-tag-files-recursive (&optional ignore-marks-p details) ; Bound to `M-+ C-t t' + "Tag marked files with an `image-dired' tag, including in marked subdirs. +Like `image-dired-tag-files', but act recursively on subdirs. +The files included are those that are marked in the current Dired +buffer, or all files in the directory if none are marked. Marked +subdirectories are handled recursively in the same way. + +With a prefix argument, ignore all marks - include all files in this +Dired buffer and all subdirs, recursively. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-get-files'." + (interactive (progn (diredp-image-dired-required-msg) + (diredp-get-confirmation-recursive) + (list current-prefix-arg diredp-list-file-attributes))) + (let ((tag (read-string "Tags to add (separate tags with a semicolon): "))) + (image-dired-write-tags (mapcar (lambda (x) (cons x tag)) + (diredp-get-files ignore-marks-p nil nil nil nil details))))) + +;;;###autoload +(defun diredp-image-dired-delete-tag-recursive (&optional ignore-marks-p details) ; Bound to `M-+ C-t r' + "Remove `image-dired' tag for marked files, including in marked subdirs. +Like `image-dired-delete-tag', but act recursively on subdirs. +The files included are those that are marked in the current Dired +buffer, or all files in the directory if none are marked. Marked +subdirectories are handled recursively in the same way. + +With a prefix argument, ignore all marks - include all files in this +Dired buffer and all subdirs, recursively. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-get-files'." + (interactive (progn (diredp-image-dired-required-msg) + (diredp-get-confirmation-recursive) + (list current-prefix-arg diredp-list-file-attributes))) + (image-dired-remove-tag (diredp-get-files ignore-marks-p nil nil nil nil details) + (read-string "Tag to remove: "))) + +;;;###autoload +(defun diredp-image-dired-comment-files-recursive (&optional ignore-marks-p details) + ; Bound to `M-+ C-t c' + "Add comment to marked files in dired, including those in marked subdirs. +Like `image-dired-dired-comment-files' but act recursively on subdirs. +The files included are those that are marked in the current Dired +buffer, or all files in the directory if none are marked. Marked +subdirectories are handled recursively in the same way. + +With a prefix argument, ignore all marks - include all files in this +Dired buffer and all subdirs, recursively. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-get-files'." + (interactive (progn (diredp-image-dired-required-msg) + (diredp-get-confirmation-recursive) + (list current-prefix-arg diredp-list-file-attributes))) + (let ((comment (image-dired-read-comment))) + (image-dired-write-comments (mapcar (lambda (curr-file) (cons curr-file comment)) + (diredp-get-files ignore-marks-p nil nil nil nil details))))) + +(when (> emacs-major-version 22) + + (defun diredp-do-decrypt-recursive (&optional ignore-marks-p details) ; Bound to `M-+ : d' + "Decrypt marked files, including those in marked subdirs. +Like `epa-dired-do-decrypt', but act recursively on subdirs to pick up +the files to decrypt. + +The files included are those that are marked in the current Dired +buffer, or all files in the directory if none are marked. Marked +subdirectories are handled recursively in the same way. + +With a prefix argument, ignore all marks - include all files in this +Dired buffer and all subdirs, recursively. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-get-files'." + (interactive (progn (diredp-get-confirmation-recursive) + (list current-prefix-arg diredp-list-file-attributes))) + (dolist (file (diredp-get-files ignore-marks-p nil nil nil nil details)) + (epa-decrypt-file (expand-file-name file))) + (revert-buffer)) + + (defun diredp-do-verify-recursive (&optional ignore-marks-p details) ; Bound to `M-+ : v' + "Verify marked files, including those in marked subdirs. +Like `epa-dired-do-verify', but act recursively on subdirs to pick up +the files to verify. + +The files included are those that are marked in the current Dired +buffer, or all files in the directory if none are marked. Marked +subdirectories are handled recursively in the same way. + +With a prefix argument, ignore all marks - include all files in this +Dired buffer and all subdirs, recursively. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-get-files'." + (interactive (progn (diredp-get-confirmation-recursive) + (list current-prefix-arg diredp-list-file-attributes))) + (dolist (file (diredp-get-files ignore-marks-p nil nil nil nil details)) + (epa-verify-file (expand-file-name file))) + (revert-buffer)) + + (defun diredp-do-sign-recursive (&optional ignore-marks-p details) ; Bound to `M-+ : s' + "Sign marked files, including those in marked subdirs. +Like `epa-dired-do-sign', but act recursively on subdirs to pick up +the files to sign. + +The files included are those that are marked in the current Dired +buffer, or all files in the directory if none are marked. Marked +subdirectories are handled recursively in the same way. + +With a prefix argument, ignore all marks - include all files in this +Dired buffer and all subdirs, recursively. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-get-files'." + (interactive (progn (diredp-get-confirmation-recursive) + (list current-prefix-arg diredp-list-file-attributes))) + (dolist (file (diredp-get-files ignore-marks-p nil nil nil nil details)) + (epa-sign-file (expand-file-name file) + (epa-select-keys (epg-make-context) "Select keys for signing. +If none are selected, the default secret key is used. ") + (y-or-n-p "Make a detached signature? "))) + (revert-buffer)) + + (defun diredp-do-encrypt-recursive (&optional ignore-marks-p details) ; Bound to `M-+ : e' + "Encrypt marked files, including those in marked subdirs. +Like `epa-dired-do-encrypt', but act recursively on subdirs to pick up +the files to encrypt. + +The files included are those that are marked in the current Dired +buffer, or all files in the directory if none are marked. Marked +subdirectories are handled recursively in the same way. + +With a prefix argument, ignore all marks - include all files in this +Dired buffer and all subdirs, recursively. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-get-files'." + (interactive (progn (diredp-get-confirmation-recursive) + (list current-prefix-arg diredp-list-file-attributes))) + (dolist (file (diredp-get-files ignore-marks-p nil nil nil nil details)) + (epa-encrypt-file (expand-file-name file) + (epa-select-keys (epg-make-context) "Select recipients for encryption. +If none are selected, symmetric encryption is performed. "))) + (revert-buffer))) + +;;;###autoload +(defun diredp-do-bookmark-recursive (&optional ignore-marks-p prefix details) ; Bound to `M-+ M-b' + "Bookmark the marked files, including those in marked subdirs. +Like `diredp-do-bookmark', but act recursively on subdirs. +The files included are those that are marked in the current Dired +buffer, or all files in the directory if none are marked. Marked +subdirectories are handled recursively in the same way. + +With a prefix argument, ignore all marks - include all files in this +Dired buffer and all subdirs, recursively. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-get-files'." + (interactive (progn (diredp-get-confirmation-recursive) + (list current-prefix-arg + (and diredp-prompt-for-bookmark-prefix-flag + (read-string "Prefix for bookmark name: ")) + diredp-list-file-attributes))) + (dolist (file (diredp-get-files ignore-marks-p nil nil nil nil details)) + (diredp-bookmark prefix file 'NO-MSG-P))) + +;;;###autoload +(defun diredp-do-bookmark-dirs-recursive (ignore-marks-p &optional details msgp) + "Bookmark this Dired buffer and marked subdirectory Dired buffers, recursively. +Create a Dired bookmark for this directory and for each of its marked +subdirectories. Handle each of the marked subdirectory similarly: +bookmark it and its marked subdirectories, and so on, recursively. +Name each of these Dired bookmarks with the Dired buffer name. + +After creating the Dired bookmarks, create a sequence bookmark, named +`DIRBUF and subdirs', where DIRBUF is the name of the original buffer. +This bookmark represents the whole Dired tree rooted in the directory +where you invoked the command. Jumping to this sequence bookmark +restores all of the Dired buffers making up the tree, by jumping to +each of their bookmarks. + +With a prefix arg, bookmark the marked and unmarked subdirectory Dired +buffers, recursively, that is, ignore markings. + +Note: + +* If there is more than one Dired buffer for a given subdirectory then + only the first such is used. + +* This command creates new bookmarks. It never updates or overwrites + an existing bookmark. + +You need library `Bookmark+' for this command. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-get-subdirs'." + (interactive (progn (unless (featurep 'bookmark+) + (error "You need library `Bookmark+' for this command")) + (diredp-get-confirmation-recursive 'subdirs) + (list current-prefix-arg diredp-list-file-attributes t))) + (diredp-ensure-mode) + (let ((sdirs (diredp-get-subdirs ignore-marks-p nil details)) + (snames ()) + dbufs) + (when (and msgp sdirs) (message "Checking descendant directories...")) + (dolist (dir (cons default-directory sdirs)) + (when (setq dbufs (dired-buffers-for-dir (expand-file-name dir))) ; Dirs with Dired buffers only. + (with-current-buffer (car dbufs) + (let ((bname (bookmark-buffer-name)) + (count 2)) + (while (and (bmkp-get-bookmark-in-alist bname 'NOERROR) (setq bname (format "%s[%d]" bname count)))) + (bookmark-set bname nil nil 'NO-UPDATE-P) ; Inhibit updating displayed list. + (push bname snames))))) + (let ((bname (format "%s and subdirs" (bookmark-buffer-name))) + (count 2)) + (while (and (bmkp-get-bookmark-in-alist bname 'NOERROR) (setq bname (format "%s[%d]" bname count)))) + (bmkp-set-sequence-bookmark bname (nreverse snames) -1 'MSGP)) + (bmkp-refresh/rebuild-menu-list nil))) + +;;;###autoload +(defun diredp-do-bookmark-in-bookmark-file-recursive (bookmark-file ; Bound to `M-+ C-M-B', aka `M-+ C-M-S-b') + &optional prefix ignore-marks-p bfile-bookmarkp details) + "Bookmark files here and below in BOOKMARK-FILE and save BOOKMARK-FILE. +Like `diredp-do-bookmark-in-bookmark-file', but act recursively on +subdirs. The files included are those that are marked in the current +Dired buffer, or all files in the directory if none are marked. +Marked subdirectories are handled recursively in the same way. + +With a prefix argument, ignore all marks - include all files in this +Dired buffer and all subdirs, recursively. + +When called from Lisp: + * Optional arg BFILE-BOOKMARKP non-nil means create a bookmark-file + bookmark for BOOKMARK-FILE. + * Optional arg DETAILS is passed to `diredp-get-files'." + (interactive + (progn (diredp-get-confirmation-recursive) + (let ((d-r-b-f-args (diredp-read-bookmark-file-args))) + (list (car d-r-b-f-args) + (cadr d-r-b-f-args) + (car (cddr d-r-b-f-args)) + nil + diredp-list-file-attributes)))) + (diredp-do-bookmark-in-bookmark-file bookmark-file prefix nil bfile-bookmarkp + (diredp-get-files ignore-marks-p nil nil nil nil details))) + +;;;###autoload +(defun diredp-set-bookmark-file-bookmark-for-marked-recursive (bookmark-file + &optional prefix ignore-marks-p details) + ; Bound to `M-+ C-M-b' + "Bookmark the marked files and create a bookmark-file bookmark for them. +Like `diredp-set-bookmark-file-bookmark-for-marked', but act +recursively on subdirs. + +The files included are those that are marked in the current Dired +buffer, or all files in the directory if none are marked. Marked +subdirectories are handled recursively in the same way. + +With a prefix argument, ignore all marks - include all files in this +Dired buffer and all subdirs, recursively. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-do-bookmark-in-bookmark-file-recursive'." + (interactive (progn (diredp-get-confirmation-recursive) + (let ((d-r-b-f-args (diredp-read-bookmark-file-args))) + (list (car d-r-b-f-args) + (cadr d-r-b-f-args) + (car (cddr d-r-b-f-args)) + diredp-list-file-attributes)))) + (diredp-ensure-bookmark+) + (diredp-do-bookmark-in-bookmark-file-recursive + bookmark-file prefix ignore-marks-p 'CREATE-BOOKMARK-FILE-BOOKMARK details)) + +;;;###autoload +(defun diredp-do-find-marked-files-recursive (&optional arg details) ; Bound to `M-+ F' + "Find marked files simultaneously, including those in marked subdirs. +Like `dired-do-find-marked-files', but act recursively on subdirs. +The files included are those that are marked in the current Dired +buffer, or all files in the directory if none are marked. Marked +subdirectories are handled recursively in the same way. + +With (explicit) numeric prefix ARG >= 0, find the files but do not +display them. + +With numeric prefix ARG <= 0, ignore all marks - include all files in +this Dired buffer and all subdirs, recursively. + +Note that prefix-argument behavior is different for this command than +for `dired-do-find-marked-files'. In particular, a negative numeric +prefix arg does not cause the files to be shown in separate frames. +Only non-nil `pop-up-frames' (or equivalent configuration) causes +the files to be shown in separate frames. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-get-files'." + (interactive (progn (diredp-get-confirmation-recursive) + (list current-prefix-arg diredp-list-file-attributes))) + (let ((narg (prefix-numeric-value arg))) + (dired-simultaneous-find-file (diredp-get-files (<= narg 0) nil nil nil nil details) + (and arg (>= narg 0) narg)))) + +(when (fboundp 'dired-do-isearch-regexp) ; Emacs 23+ + + (defun diredp-do-isearch-recursive (&optional ignore-marks-p details) ; Bound to `M-+ M-s a C-s' + "Isearch the marked files, including those in marked subdirs. +With a prefix argument, ignore all marks - include all files in this +Dired buffer and all subdirs, recursively. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-get-files'." + (interactive (progn (diredp-get-confirmation-recursive) + (list current-prefix-arg diredp-list-file-attributes))) + (multi-isearch-files (diredp-get-files ignore-marks-p nil nil nil nil details))) + + (defun diredp-do-isearch-regexp-recursive (&optional ignore-marks-p details) ; `M-+ M-s a C-M-s' + "Regexp-Isearch the marked files, including those in marked subdirs. +With a prefix argument, ignore all marks - include all files in this +Dired buffer and all subdirs, recursively. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-get-files'." + (interactive (progn (diredp-get-confirmation-recursive) + (list current-prefix-arg diredp-list-file-attributes))) + (multi-isearch-files-regexp (diredp-get-files ignore-marks-p nil nil nil nil details)))) + +(defun diredp-do-search-recursive (regexp &optional ignore-marks-p details) ; Bound to `M-+ A' + "Regexp-search the marked files, including those in marked subdirs. +With a prefix argument, ignore all marks - include all files in this +Dired buffer and all subdirs, recursively. + +Stops when a match is found. +To continue searching for the next match, use `\\[tags-loop-continue]'. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-get-files'." + (interactive (progn (diredp-get-confirmation-recursive) + (list (read-string "Search marked files (regexp): ") + current-prefix-arg + diredp-list-file-attributes))) + (tags-search regexp '(diredp-get-files ignore-marks-p nil nil nil nil details))) + +;;;###autoload +(defun diredp-do-query-replace-regexp-recursive (from to &optional arg details) + ; Bound to `M-+ Q' + "Do `query-replace-regexp' on marked files, including in marked subdirs. +Query-replace FROM with TO. + +Like `dired-do-query-replace', but act recursively on subdirs. +The files included are those that are marked in the current Dired +buffer, or all files in the directory if none are marked. Marked +subdirectories are handled recursively in the same way. + +With an (explicit) numeric prefix argument: + +* >= 0 means ignore all marks - include ALL files in this Dired buffer + and all subdirs, recursively. + +* <= 0 means replace only word-delimited matches. + +If you exit (`\\[keyboard-quit]', `RET' or `q'), you can resume the query replacement +using `\\[tags-loop-continue]'. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-get-files'." + (interactive (progn (diredp-get-confirmation-recursive) + (let ((common (query-replace-read-args "Query replace regexp in marked files" t t))) + (list (nth 0 common) + (nth 1 common) + current-prefix-arg + diredp-list-file-attributes)))) + (let* ((narg (and arg (prefix-numeric-value arg))) + (delimited (and narg (<= narg 0))) + (ignore-marks-p (and narg (>= narg 0))) + (files (diredp-get-files ignore-marks-p nil nil nil nil details)) + (fit-frame-min-width 30) + (fit-frame-min-height 15)) + (dolist (file files) + (let ((buffer (get-file-buffer file))) + (when (and buffer (with-current-buffer buffer buffer-read-only)) + (error "File `%s' is visited read-only" file)))) + (tags-query-replace from to delimited `',files))) + +;;;###autoload +(defun diredp-do-grep-recursive (command-args &optional details) ; Bound to `M+ C-M-G' + "Run `grep' on marked files, including those in marked subdirs. +Like `diredp-do-grep', but act recursively on subdirs. +The files included are those that are marked in the current Dired +buffer, or all files in the directory if none are marked. Marked +subdirectories are handled recursively in the same way. + +With a prefix argument, ignore all marks - include all files in this +Dired buffer and all subdirs, recursively. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-get-files'." + (interactive (progn (diredp-get-confirmation-recursive) + (unless (if (< emacs-major-version 22) + grep-command + (and grep-command (or (not grep-use-null-device) (eq grep-use-null-device t)))) + (grep-compute-defaults)) + (list (diredp-do-grep-1 + (diredp-get-files current-prefix-arg nil nil nil nil diredp-list-file-attributes))))) + (grep command-args)) + +;;;###autoload +(defun diredp-marked-recursive (dirname &optional ignore-marks-p details) ; Not bound to a key + "Open Dired on marked files, including those in marked subdirs. +Like `diredp-marked', but act recursively on subdirs. + +See `diredp-do-find-marked-files-recursive' for a description of the +files included. In particular, if no files are marked here or in a +marked subdir, then all files in the directory are included. + +With a prefix argument, ignore all marks - include all files in this +Dired buffer and all subdirs, recursively. + +When called from Lisp, DIRNAME here must be a string, not a cons. It +is used as the name of the new Dired buffer. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-get-files'." + (interactive (progn (diredp-get-confirmation-recursive) + (list nil current-prefix-arg diredp-list-file-attributes))) + (dired (cons (or dirname (generate-new-buffer-name (buffer-name))) + (diredp-get-files ignore-marks-p nil nil nil nil details)))) + +;;;###autoload +(defun diredp-marked-recursive-other-window (dirname &optional ignore-marks-p details) ; Bound to `M-+ C-M-*' + "Same as `diredp-marked-recursive', but uses a different window. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-get-files'." + (interactive (progn (diredp-get-confirmation-recursive) + (list nil current-prefix-arg diredp-list-file-attributes))) + (dired-other-window + (cons (or dirname (generate-new-buffer-name (buffer-name))) + (diredp-get-files ignore-marks-p nil nil nil nil details)))) + +;;;###autoload +(defun diredp-list-marked-recursive (&optional ignore-marks-p predicate details) ; Bound to `M-+ C-M-l' + "List the files marked here and in marked subdirs, recursively. +The files included are those that are marked in the current Dired +buffer, or all files in the directory if none are marked. Marked +subdirectories are handled recursively in the same way. + +With a prefix argument, all marks are ignored: all files in this Dired +buffer and all descendant directories are included. + +You can use `RET' or `mouse-2' to visit any of the files. +If `tooltip-mode' is on then moving the mouse over image-file names +shows image previews. + +When called from Lisp: + Non-nil optional arg IGNORE-MARKS-P means ignore marks. + Non-nil optional arg PREDICATE is a file-name predicate. List only + the files for which it returns non-nil. + Non-nil optional arg DETAILS is passed to `diredp-list-files'." + (interactive ; No need for `diredp-get-confirmation-recursive' here. + (progn (diredp-ensure-mode) (list current-prefix-arg nil diredp-list-file-attributes))) + (let ((files (diredp-get-files ignore-marks-p predicate))) (diredp-list-files files nil nil nil details))) + +;;;###autoload +(defun diredp-flag-auto-save-files-recursive (&optional arg details) ; `M-+ #' + "Flag all auto-save files for deletion, including in marked subdirs. +A non-negative prefix arg means to unmark (unflag) them instead. + +A non-positive prefix arg means to ignore subdir markings and act +instead on ALL subdirs. That is, flag all in this directory and all +descendant directories. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-mark-recursive-1'." + (interactive (list current-prefix-arg diredp-list-file-attributes)) + (let ((dired-marker-char dired-del-marker)) + (diredp-mark-recursive-1 arg "auto-save files" "auto-save file" '(diredp-looking-at-p "^.* #.+#$") details))) + +(when (fboundp 'char-displayable-p) ; Emacs 22+ + + (defun diredp-change-marks-recursive (old new &optional arg predicate details) ; `M-+ * c' + "Change all OLD marks to NEW marks, including those in marked subdirs. +The files included are those that are marked in the current Dired +buffer, or all files in the directory if none are marked. Marked +subdirectories are handled recursively in the same way. + +* A non-positive prefix arg means ignore subdir markings and act + instead on ALL subdirs. + +* A non-negative prefix arg means do not change marks on subdirs + themselves. + +Note: If there is more than one Dired buffer for a given subdirectory +then only the first such is used. + +When called from Lisp: + Non-nil arg PREDICATE is a file-name predicate. Act on only the + files for which it returns non-nil. + DETAILS is passed to `diredp-get-subdirs'." + (interactive + (progn (diredp-get-confirmation-recursive) + (let* ((cursor-in-echo-area t) + (old (progn (message "Change (old mark): ") (read-char))) + (new (progn (message "Change `%c' marks to (new mark): " old) (read-char)))) + (list old new current-prefix-arg nil diredp-list-file-attributes)))) + (let* ((numarg (and arg (prefix-numeric-value arg))) + (nosubs (natnump numarg)) + (ignore-marks (and numarg (<= numarg 0))) + (dired-marker-char new) + (sdirs (diredp-get-subdirs ignore-marks predicate details)) + (old-strg (format "\n%c" old)) + (count 0) + dbufs) + (unless (char-displayable-p old) (error "Not a displayable character: `%c'" old)) + (unless (char-displayable-p new) (error "Not a displayable character: `%c'" new)) + (message "Changing mark `%c' to `%c'..." old new) + (dolist (dir (cons default-directory sdirs)) + (when (setq dbufs (dired-buffers-for-dir (expand-file-name dir))) ; Dirs with Dired buffers only. + (with-current-buffer (car dbufs) + (let ((inhibit-read-only t) + (file nil)) + (save-excursion + (goto-char (point-min)) + (while (search-forward old-strg nil t) + (save-match-data (setq file (dired-get-filename 'no-dir t))) + ;; Do nothing if changing from UNmarked and not on a file or dir name. + (unless (and (= old ? ) (not file)) + ;; Do nothing if marked subdir and not changing subdir marks. + (unless (and nosubs file (file-directory-p file)) + (subst-char-in-region (match-beginning 0) (match-end 0) old new) + (setq count (1+ count)))))))))) + (message "%d mark%s changed from `%c' to `%c'" count (dired-plural-s count) old new))) + + (defun diredp-unmark-all-marks-recursive (&optional arg details) ; `M-+ U' + "Remove ALL marks everywhere, including in marked subdirs. +A prefix arg is as for `diredp-unmark-all-files-recursive'. +Note that a negative prefix arg (e.g. `C--') removes all marks from +this Dired buffer and then does the same recursively for each of its +subdirs. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-unmark-all-files-recursive'." + (interactive (progn (diredp-get-confirmation-recursive) + (list current-prefix-arg diredp-list-file-attributes))) + (diredp-unmark-all-files-recursive ?\r arg details)) + + (defun diredp-unmark-all-files-recursive (mark &optional arg predicate details) ; `M-+ M-DEL' + "Remove a given mark (or ALL) everywhere, including in marked subdirs. +You are prompted for the mark character to remove. If you hit `RET' +instead then ALL mark characters are removed. + +The files included are those that are marked in the current Dired +buffer, or all files in the directory if none are marked. Marked +subdirectories are handled recursively in the same way. + +* A non-positive prefix arg means ignore subdir markings and act + instead on ALL subdirs. + +* A non-negative prefix arg means do not change marks on subdirs + themselves. + +Note: If there is more than one Dired buffer for a given subdirectory +then only the first such is used. + +When called from Lisp: + Non-nil arg PREDICATE is a file-name predicate. Act on only the + files for which it returns non-nil. + DETAILS is passed to `diredp-get-subdirs'." + (interactive + (progn (diredp-get-confirmation-recursive) + (let* ((cursor-in-echo-area t) + (mrk (progn (message "Remove marks (RET means all): ") (read-char)))) + (list mrk current-prefix-arg nil diredp-list-file-attributes)))) + (let* ((numarg (and arg (prefix-numeric-value arg))) + (nosubs (natnump numarg)) + (ignore-marks (and numarg (<= numarg 0))) + (dired-marker-char ?\ ) ; Unmark + (sdirs (diredp-get-subdirs ignore-marks predicate details)) + (mrk-strg (format "\n%c" mark)) + (count 0) + dbufs) + (unless (char-displayable-p mark) (error "Not a displayable character: `%c'" mark)) + (if (eq mark ?\r) + (message "Unmarking ALL marks here and below...") + (message "Unmarking mark `%c' here and below..." mark)) + (dolist (dir (cons default-directory sdirs)) + (when (setq dbufs (dired-buffers-for-dir (expand-file-name dir))) ; Dirs with Dired buffers only. + (with-current-buffer (car dbufs) + (let ((inhibit-read-only t) + (file nil)) + (save-excursion + (goto-char (point-min)) + (while (if (eq mark ?\r) + (re-search-forward dired-re-mark nil t) + (search-forward mrk-strg nil t)) + (save-match-data (setq file (dired-get-filename 'no-dir t))) + ;; Do nothing if marked subdir and not changing subdir marks. + (unless (and nosubs file (file-directory-p file)) + (subst-char-in-region (match-beginning 0) (match-end 0) (preceding-char) ?\ )) + (setq count (1+ count)))))))) + (message "%d mark%s UNmarked" count (dired-plural-s count)))) + + ) + +(when (and (memq system-type '(windows-nt ms-dos)) (fboundp 'w32-browser)) + + (defun diredp-multiple-w32-browser-recursive (&optional ignore-marks-p details) + "Run Windows apps for with marked files, including those in marked subdirs. +Like `dired-multiple-w32-browser', but act recursively on subdirs. + +See `diredp-do-find-marked-files-recursive' for a description of the +files included. In particular, if no files are marked here or in a +marked subdir, then all files in the directory are included. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-get-files'." + (interactive (progn (diredp-get-confirmation-recursive) + (list current-prefix-arg diredp-list-file-attributes))) + (let ((files (diredp-get-files ignore-marks-p nil nil nil nil details))) + (while files + (w32-browser (car files)) + (sleep-for w32-browser-wait-time) + (setq files (cdr files))))) + + ) + +;;;###autoload +(defun diredp-copy-filename-as-kill-recursive (&optional arg details) ; Bound to `M-+ M-w' + "Copy names of marked files here and in marked subdirs, to `kill-ring'. +The names are separated by a space. + +Like `dired-copy-filename-as-kill', but act recursively on subdirs. +\(Do not copy subdir names themselves.) + +With no prefix arg, use relative file names. +With a zero prefix arg, use absolute file names. +With a plain prefix arg (`C-u'), use names relative to the current +Dired directory. (This might contain slashes if in a subdirectory.) + +If on a subdir headerline, use absolute subdir name instead - prefix +arg and marked files are ignored in this case. + +The files included are those that are marked in the current Dired +buffer, or all files in the directory if none are marked. Marked +subdirectories are handled recursively in the same way. + +The names are copied to the kill ring and to variable +`diredp-last-copied-filenames'. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-get-files'." + (interactive ; No need for `diredp-get-confirmation-recursive' here. + (progn (diredp-ensure-mode) (list current-prefix-arg diredp-list-file-attributes))) + (let* ((files (mapcar (cond ((zerop (prefix-numeric-value arg)) #'identity) + ((consp arg) (lambda (fn) (concat (dired-current-directory t) + (file-name-nondirectory fn)))) + (t (lambda (fn) (file-name-nondirectory fn)))) + (diredp-get-files nil nil nil nil nil details))) + (string (mapconcat #'identity files " "))) + (unless (string= "" string) + (if (eq last-command 'kill-region) (kill-append string nil) (kill-new string)) + (setq diredp-last-copied-filenames (car kill-ring-yank-pointer))) + (message "%s" string))) + +;;;###autoload +(defun diredp-copy-abs-filenames-as-kill-recursive (&optional ignore-marks-p details) ; Not bound. + "Copy absolute names of files marked here and in marked subdirs, recursively. +The names are copied to the kill ring and to variable +`dired-copy-filename-as-kill'. + +The files whose names are copied are those that are marked in the +current Dired buffer, or all files in the directory if none are +marked. Marked subdirectories are handled recursively in the same +way. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-copy-filename-as-kill-recursive'." + (interactive ; No need for `diredp-get-confirmation-recursive' here. + (progn (diredp-ensure-mode) (list current-prefix-arg diredp-list-file-attributes))) + (diredp-copy-filename-as-kill-recursive 0 details) + (setq diredp-last-copied-filenames (car kill-ring-yank-pointer))) + +;;;###autoload +(defun diredp-mark-files-regexp-recursive (regexp + &optional marker-char ignore-marks-p details) ; Bound to `M-+ % m' + "Mark all files matching REGEXP, including those in marked subdirs. +Like `dired-mark-files-regexp' but act recursively on marked subdirs. + +The file names to be matched by this command are always absolute - +they include the full directory. Note that this does NOT correspond +to the default behavior for `dired-mark-files-regexp'. The other +matching possibilities offered by `dired-mark-files-regexp' are not +available for this command. + +Directories `.' and `..' are never marked. + +A non-negative prefix arg means to UNmark the files instead. + +A non-positive prefix arg means to ignore subdir markings and act +instead on ALL subdirs. That is, mark all matching files in this +directory and all descendant directories. + +REGEXP is an Emacs regexp, not a shell wildcard. Thus, use `\\.o$' for +object files--just `.o' will mark more than you might think. + +REGEXP is added to `regexp-search-ring', for regexp search. + +Note: If there is more than one Dired buffer for a given subdirectory +then only the first such is used. + +When called from Lisp, DETAILS is passed to `diredp-get-subdirs'." + (interactive (let* ((numarg (and current-prefix-arg (prefix-numeric-value current-prefix-arg))) + (unmark (and numarg (>= numarg 0))) + (ignorep (and numarg (<= numarg 0)))) + (list (diredp-read-regexp (concat (if unmark "UNmark" "Mark") " files (regexp): ")) + (and unmark ?\040) + ignorep + diredp-list-file-attributes))) + (add-to-list 'regexp-search-ring regexp) ; Add REGEXP to `regexp-search-ring'. + (let ((dired-marker-char (or marker-char dired-marker-char)) + (sdirs (diredp-get-subdirs ignore-marks-p nil details)) + (matched 0) + (changed 0) + dbufs chg.mtch) + (message "%s files..." (if (eq ?\040 dired-marker-char) "UNmarking" "Marking")) + (dolist (dir (cons default-directory sdirs)) + (when (setq dbufs (dired-buffers-for-dir (expand-file-name dir))) ; Dirs with Dired buffers only. + (with-current-buffer (car dbufs) + (setq chg.mtch (diredp-mark-if (and (not (diredp-looking-at-p dired-re-dot)) + (not (eolp)) ; Empty line + (let ((fn (dired-get-filename nil 'NO-ERROR))) + (and fn (diredp-string-match-p regexp fn)))) + "file") + changed (+ changed (or (car chg.mtch) 0)) + matched (+ matched (or (cdr chg.mtch) 0)))))) + (message "%s file%s%s%s newly %s" + matched + (dired-plural-s matched) + (if (not (= matched changed)) " matched, " "") + (if (not (= matched changed)) changed "") + (if (eq ?\040 dired-marker-char) "unmarked" "marked")))) + +;;;###autoload +(defun diredp-mark-files-containing-regexp-recursive (regexp + &optional marker-char ignore-marks-p details) ; `M-+ % g' + "Mark files with contents containing a REGEXP match, including in marked subdirs. +Like `dired-mark-files-containing-regexp' but act recursively on +marked subdirs. + +A non-negative prefix arg means to UNmark the files instead. + +A non-positive prefix arg means to ignore subdir markings and act +instead on ALL subdirs. That is, mark all matching files in this +directory and all descendant directories. + +REGEXP is added to `regexp-search-ring', for regexp search. + +Note: If there is more than one Dired buffer for a given subdirectory +then only the first such is used. + +If a file is visited in a buffer and `dired-always-read-filesystem' is +nil, this looks in the buffer without revisiting the file, so the +results might be inconsistent with the file on disk if its contents +have changed since it was last visited. + +When called from Lisp, DETAILS is passed to `diredp-get-subdirs'." + + (interactive (let* ((numarg (and current-prefix-arg (prefix-numeric-value current-prefix-arg))) + (unmark (and numarg (>= numarg 0))) + (ignorep (and numarg (<= numarg 0)))) + (list (diredp-read-regexp (concat (if unmark "UNmark" "Mark") " files containing (regexp): ")) + (and unmark ?\040) + ignorep + diredp-list-file-attributes))) + (add-to-list 'regexp-search-ring regexp) ; Add REGEXP to `regexp-search-ring'. + (let ((dired-marker-char (or marker-char dired-marker-char)) + (sdirs (diredp-get-subdirs ignore-marks-p nil details)) + (matched 0) + (changed 0) + dbufs chg.mtch) + (message "%s files..." (if (eq ?\040 dired-marker-char) "UNmarking" "Marking")) + (dolist (dir (cons default-directory sdirs)) + (when (setq dbufs (dired-buffers-for-dir (expand-file-name dir))) ; Dirs with Dired buffers only. + (with-current-buffer (car dbufs) + (setq chg.mtch + (diredp-mark-if + (and (not (diredp-looking-at-p dired-re-dot)) + (not (eolp)) + (let ((fname (dired-get-filename nil t))) + + (and fname + (file-readable-p fname) + (not (file-directory-p fname)) + (let ((prebuf (get-file-buffer fname))) + (message "Checking %s" fname) + ;; For now, do it inside Emacs. Grep might be better if there are lots of files. + (if (and prebuf (or (not (boundp 'dired-always-read-filesystem)) + (not dired-always-read-filesystem))) ; Emacs 26+ + (with-current-buffer prebuf + (save-excursion (goto-char (point-min)) (re-search-forward regexp nil t))) + (with-temp-buffer + (insert-file-contents fname) + (goto-char (point-min)) + (re-search-forward regexp nil t))))))) + "file") + changed (+ changed (or (car chg.mtch) 0)) + matched (+ matched (or (cdr chg.mtch) 0)))))) + (message "%s file%s%s%s newly %s" + matched + (dired-plural-s matched) + (if (not (= matched changed)) " matched, " "") + (if (not (= matched changed)) changed "") + (if (eq ?\040 dired-marker-char) "unmarked" "marked")))) + +(defun diredp-mark-extension-recursive (extension &optional arg details) ; Bound to `M-+ * .' + "Mark all files with a certain EXTENSION, including in marked subdirs. +A `.' is not automatically prepended to the string entered. + +This is like `diredp-mark/unmark-extension', but this acts recursively +on marked subdirs, and a non-positive prefix arg acts differently. + +A non-negative prefix arg means to unmark them instead. + +A non-positive prefix arg means to ignore subdir markings and act +instead on ALL subdirs. That is, mark all in this directory and all +descendant directories. + +Non-interactively, EXTENSION is the extension (a string). It can also +be a list of extension strings. +Optional argument ARG is the prefix arg. + +When called from Lisp, DETAILS is passed to `diredp-mark-files-regexp-recursive'." + (interactive (let* ((numarg (and current-prefix-arg (prefix-numeric-value current-prefix-arg))) + (unmark (and numarg (>= numarg 0)))) + (list (diredp-read-regexp (concat (if unmark "UNmark" "Mark") " extension: ")) + current-prefix-arg + diredp-list-file-attributes))) + (let* ((numarg (and arg (prefix-numeric-value arg))) + (unmark (and numarg (>= numarg 0))) + (ignorep (and numarg (<= numarg 0)))) + (or (listp extension) (setq extension (list extension))) + (diredp-mark-files-regexp-recursive (concat ".+[.]\\(" + (mapconcat #'regexp-quote extension "\\|") + "\\)$") + (if unmark ?\040 dired-marker-char) + ignorep + details))) + +;; FIXME: Factor out code that is common with `dired-mark-sexp'. +;; +(when (fboundp 'minibuffer-with-setup-hook) ; Emacs 22+ + + (defun diredp-mark-sexp-recursive (predicate &optional arg details) ; Bound to `M-+ M-(', `M-+ * (' + "Mark files here and below for which PREDICATE returns non-nil. +Like `diredp-mark-sexp', but act recursively on subdirs. + +A non-negative prefix arg means to unmark those files instead. + +A non-positive prefix arg means to ignore subdir markings and act +instead on ALL subdirs. That is, mark all in this directory and all +descendant directories. + +PREDICATE is a lisp sexp that can refer to the following symbols as +variables: + + `mode' [string] file permission bits, e.g. \"-rw-r--r--\" + `nlink' [integer] number of links to file + `size' [integer] file size in bytes + `uid' [string] owner + `gid' [string] group (If the gid is not displayed by `ls', + this will still be set (to the same as uid)) + `time' [string] the time that `ls' displays, e.g. \"Feb 12 14:17\" + `name' [string] the name of the file + `sym' [string] if file is a symbolic link, the linked-to name, + else \"\" + `inode' [integer] the inode of the file (only for `ls -i' output) + `blks' [integer] the size of the file for `ls -s' output + (ususally in blocks or, with `-k', in Kbytes) +Examples: + Mark zero-length files: `(equal 0 size)' + Mark files last modified on Feb 2: `(string-match \"Feb 2\" time)' + Mark uncompiled Emacs Lisp files (`.el' file without a `.elc' file): + First, Dired just the source files: `dired *.el'. + Then, use \\[diredp-mark-sexp-recursive] with this sexp: + (not (file-exists-p (concat name \"c\"))) + +There's an ambiguity when a single integer not followed by a unit +prefix precedes the file mode: It is then parsed as inode number +and not as block size (this always works for GNU coreutils ls). + +Another limitation is that the uid field is needed for the +function to work correctly. In particular, the field is not +present for some values of `ls-lisp-emulation'. + +This function operates only on the Dired buffer content. It does not +refer at all to the underlying file system. Contrast this with +`find-dired', which might be preferable for the task at hand. + +When called from Lisp, DETAILS is passed to `diredp-get-subdirs'." + ;; Using `sym' = "", instead of nil, for non-linked files avoids the trap of + ;; (string-match "foo" sym) into which a user would soon fall. + ;; Use `equal' instead of `=' in the example, as it works on integers and strings. + ;; (interactive "xMark if (vars: inode,blks,mode,nlink,uid,gid,size,time,name,sym): \nP") + + (interactive + (let* ((numarg (and current-prefix-arg (prefix-numeric-value current-prefix-arg))) + (unmark (and numarg (>= numarg 0)))) + (diredp-get-confirmation-recursive) + (list (diredp-read-expression (format "%s if (Lisp expr): " (if current-prefix-arg "UNmark" "Mark"))) + current-prefix-arg + diredp-list-file-attributes))) + (message "%s" predicate) + (let* ((numarg (and arg (prefix-numeric-value arg))) + (unmark (and numarg (>= numarg 0))) + (ignorep (and numarg (<= numarg 0))) + (dired-marker-char (if unmark ?\040 dired-marker-char)) + (inode nil) + (blks ()) + (matched 0) + (changed 0) + dbufs chg.mtch mode nlink uid gid size time name sym) + (dolist (dir (cons default-directory (diredp-get-subdirs ignorep nil details))) + (when (setq dbufs (dired-buffers-for-dir (expand-file-name dir))) ; Dirs with Dired buffers only. + (with-current-buffer (car dbufs) + (setq chg.mtch + (diredp-mark-if + (save-excursion + (and + ;; Sets vars INODE BLKS MODE NLINK UID GID SIZE TIME NAME and SYM + ;; according to current file line. Returns `t' for success, nil if + ;; there is no file line. Upon success, these vars are set, to either + ;; nil or the appropriate value, so they need not be initialized. + ;; Moves point within the current line. + (dired-move-to-filename) + (let ((mode-len 10) ; Length of `mode' string. + ;; As in `dired.el', but with subexpressions \1=inode, \2=blks: + ;; GNU `ls -hs' suffixes the block count with a unit and prints it as a float + ;; FreeBSD does neither. + ;; $$$$$$ (dired-re-inode-size "\\s *\\([0-9]*\\)\\s *\\([0-9]*\\) ?") + (dired-re-inode-size (if (> emacs-major-version 24) + "\\=\\s *\\([0-9]+\\s +\\)?\ +\\(?:\\([0-9]+\\(?:\\.[0-9]*\\)?[BkKMGTPEZY]?\\)? ?\\)" + "\\s *\\([0-9]*\\)\\s *\\([0-9]*\\) ?")) + pos) + (beginning-of-line) + (forward-char 2) + (search-forward-regexp dired-re-inode-size nil t) + ;; `INODE', `BLKS', `MODE' + ;; XXX Might be a size not followed by a unit prefix. + ;; Could set `blks' to `inode' if it were otherwise nil, with similar reasoning + ;; as for setting `gid' to `uid', but it would be even more whimsical. + (setq inode (and (match-string 1) (string-to-number (match-string 1))) + blks (and (match-string 2) (if (fboundp 'dired-x--string-to-number) ; Emacs 25+ + (dired-x--string-to-number (match-string 2)) + (string-to-number (match-string 2)))) + mode (buffer-substring (point) (+ mode-len (point)))) + (forward-char mode-len) + ;; Skip any extended attributes marker ("." or "+"). + (unless (eq (char-after) ?\ ) (forward-char 1)) + (setq nlink (read (current-buffer))) ; `NLINK' + + ;; `UID' + ;; Another issue is that GNU `ls -n' right-justifies numerical UIDs and GIDs, + ;; while FreeBSD left-justifies them, so do not rely on a specific whitespace + ;; layout. Both of them right-justify all other numbers, though. + ;; XXX Return a number if the `uid' or `gid' seems to be numerical? + ;; $$$$$$ (setq uid (buffer-substring (+ (point) 1) (progn (forward-word 1) (point)))) + (setq uid (buffer-substring (progn (skip-chars-forward " \t") (point)) + (progn (skip-chars-forward "^ \t") (point)))) + (cond ((> emacs-major-version 24) + (dired-move-to-filename) + (save-excursion + (setq time ; `TIME' + ;; The regexp below tries to match from the last digit of the size + ;; field through a space after the date. Also, dates may have + ;; different formats depending on file age, so the date column need + ;; not be aligned to the right. + (buffer-substring + (save-excursion (skip-chars-backward " \t") (point)) + (progn (re-search-backward directory-listing-before-filename-regexp) + (skip-chars-forward "^ \t") + (1+ (point)))) + + size ; `SIZE' + (dired-x--string-to-number + ;; We know that there's some kind of number before point because + ;; the regexp search above succeeded. Not worth doing an extra + ;; check for leading garbage. + (buffer-substring (point) (progn (skip-chars-backward "^ \t") (point)))) + ;; If no `gid' is displayed, `gid' will be set to `uid' but user + ;; will then not reference it anyway in PREDICATE. + + gid ; `GID' + (buffer-substring (progn (skip-chars-backward " \t") (point)) + (progn (skip-chars-backward "^ \t") (point))))) + ;; `NAME', `SYM' + (setq name (buffer-substring (point) + (or (dired-move-to-end-of-filename t) (point))) + sym (if (diredp-looking-at-p " -> ") + (buffer-substring (progn (forward-char 4) (point)) + (line-end-position)) + ""))) + (t + (re-search-forward + (if (< emacs-major-version 20) + "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)" + dired-move-to-filename-regexp)) + (goto-char (match-beginning 1)) + (forward-char -1) + (setq size ; `SIZE' + (string-to-number (buffer-substring (save-excursion (backward-word 1) + (setq pos (point))) + (point)))) + (goto-char pos) + (backward-word 1) + ;; `GID', `TIME', `NAME', `SYM' + ;; if no `gid' is displayed, `gid' will be set to `uid' but user will then + ;; not reference it anyway in PREDICATE. + (setq gid (buffer-substring (save-excursion (forward-word 1) (point)) (point)) + time (buffer-substring (match-beginning 1) (1- (dired-move-to-filename))) + name (buffer-substring (point) (or (dired-move-to-end-of-filename t) + (point))) + sym (if (diredp-looking-at-p " -> ") + (buffer-substring (progn (forward-char 4) (point)) + (line-end-position)) + ""))))) + ;; Vanilla Emacs uses `lexical-binding' = t, and it passes bindings to `eval' + ;; as a second arg. We use `lexical-binding' = nil, and anyway there should + ;; be no need to pass the bindings. + (eval predicate))) + (format "'%s file" predicate))) + (setq changed (+ changed (or (car chg.mtch) 0)) + matched (+ matched (or (cdr chg.mtch) 0)))))) + (message "%s file%s%s%s newly %s" matched (dired-plural-s matched) + (if (not (= matched changed)) " matched, " "") + (if (not (= matched changed)) changed "") + (if (eq ?\040 dired-marker-char) "unmarked" "marked")))) + + (if (fboundp 'read--expression) ; Emacs 24.4+ + (defalias 'diredp-read-expression 'read--expression) + (defun diredp-read-expression (prompt &optional initial-contents) + (let ((minibuffer-completing-symbol t)) + (minibuffer-with-setup-hook + (lambda () ; Vanilla Emacs FIXME: call `emacs-lisp-mode'? + (add-function :before-until (local 'eldoc-documentation-function) + #'elisp-eldoc-documentation-function) + (eldoc-mode 1) + (add-hook 'completion-at-point-functions #'elisp-completion-at-point nil t) + (run-hooks 'eval-expression-minibuffer-setup-hook)) + (read-from-minibuffer + prompt initial-contents (if (boundp 'pp-read-expression-map) + pp-read-expression-map + read-expression-map) + t 'read-expression-history))))) + + ) + +;;;###autoload +(defun diredp-mark-autofiles-recursive (&optional arg details) ; Bound to `M-+ * B' + "Mark all autofiles, including in marked subdirs. +Autofiles are files that have an autofile bookmark. +A non-negative prefix arg means to unmark them instead. + +A non-positive prefix arg means to ignore subdir markings and act +instead on ALL subdirs. That is, mark all in this directory and all +descendant directories. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-mark-recursive-1'." + (interactive (list current-prefix-arg diredp-list-file-attributes)) + (diredp-ensure-bookmark+) + (diredp-ensure-mode) + (diredp-mark-recursive-1 arg "autofiles" "autofile" + '(and (not (diredp-looking-at-p dired-re-dot)) (not (eolp)) + (let ((fname (dired-get-filename nil t))) + (and fname (bmkp-get-autofile-bookmark fname)))) + details)) + +;;;###autoload +(defun diredp-mark-executables-recursive (&optional arg details) ; Bound to `M-+ * *' + "Mark all executable files, including in marked subdirs. +The files included are those that are marked in the current Dired +buffer, or all files in the directory if none are marked. Marked +subdirectories are handled recursively in the same way. + +A non-negative prefix arg means to unmark them instead. + +A non-positive prefix arg means to ignore subdir markings and act +instead on ALL subdirs. That is, mark all in this directory and all +descendant directories. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-mark-recursive-1'." + (interactive (list current-prefix-arg diredp-list-file-attributes)) + (diredp-mark-recursive-1 arg "executable files" "executable file" '(diredp-looking-at-p dired-re-exe) details)) + +;;;###autoload +(defun diredp-mark-directories-recursive (&optional arg details) ; Bound to `M-+ * /' + "Mark all directories except `.' and `..', including in marked subdirs. +The directories included are those that are marked in the current +Dired buffer, or all subdirs in the directory if none are marked. +Marked subdirectories are handled recursively in the same way. + +A non-negative prefix arg means to unmark them instead. + +A non-positive prefix arg means to ignore subdir markings and act +instead on ALL subdirs. That is, mark all in this directory and all +descendant directories. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-mark-recursive-1'." + (interactive (list current-prefix-arg diredp-list-file-attributes)) + (diredp-mark-recursive-1 arg "directories" "directory" '(and (diredp-looking-at-p dired-re-dir) + (not (diredp-looking-at-p dired-re-dot))) + details)) +;;;###autoload +(defun diredp-mark-symlinks-recursive (&optional arg details) ; Bound to `M-+ * @' + "Mark all symbolic links, including in marked subdirs. +The symlinks included are those that are marked in the current Dired +buffer, or all symlinks in the directory if none are marked. Marked +subdirectories are handled recursively in the same way. + +A non-negative prefix arg means to unmark them instead. + +A non-positive prefix arg means to ignore subdir markings and act +instead on ALL subdirs. That is, mark all in this directory and all +descendant directories. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-get-subdirs'." + (interactive (list current-prefix-arg diredp-list-file-attributes)) + (diredp-mark-recursive-1 arg "symlinks" "symbolic link" '(diredp-looking-at-p dired-re-sym) details)) + +(defun diredp-mark-recursive-1 (arg plural singular predicate-sexp details) + "Helper for `diredp-mark-*-recursive' commands." + (let* ((numarg (and arg (prefix-numeric-value arg))) + (unmark (and numarg (>= numarg 0))) + (ignorep (and numarg (<= numarg 0))) + (dired-marker-char (if unmark ?\040 dired-marker-char)) + (sdirs (diredp-get-subdirs ignorep nil details)) + (changed 0) + (matched 0) + dbufs chg.mtch) + (message "%s %s..." (if (eq ?\040 dired-marker-char) "UNmarking" "Marking") plural) + (dolist (dir (cons default-directory sdirs)) + (when (setq dbufs (dired-buffers-for-dir (expand-file-name dir))) ; Dirs with Dired buffers only. + (with-current-buffer (car dbufs) + (setq chg.mtch (diredp-mark-if (eval predicate-sexp) singular) + changed (+ changed (or (car chg.mtch) 0)) + matched (+ matched (or (cdr chg.mtch) 0)))))) + (message "%s %s%s%s newly %s" + matched + (if (= 1 matched) singular plural) + (if (not (= matched changed)) " matched, " "") + (if (not (= matched changed)) changed "") + (if (eq ?\040 dired-marker-char) "unmarked" "marked")))) + +;;;###autoload +(defun diredp-capitalize-recursive (&optional ignore-marks-p details) ; Bound to `M-+ % c' + "Rename marked files, including in marked subdirs, by capitalizing them. +Like `diredp-capitalize', but act recursively on subdirs. + +The files included are those that are marked in the current Dired +buffer, or all files in the directory if none are marked. Marked +subdirectories are handled recursively in the same way. + +With a prefix argument, ignore all marks - include all files in this +Dired buffer and all subdirs, recursively. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-create-files-non-directory-recursive'." + (interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg diredp-list-file-attributes))) + (diredp-create-files-non-directory-recursive + #'dired-rename-file #'capitalize "Rename by capitalizing:" ignore-marks-p details)) + +;;;###autoload +(defun diredp-upcase-recursive (&optional ignore-marks-p details) ; Bound to `M-+ % u' + "Rename marked files, including in marked subdirs, making them uppercase. +Like `dired-upcase', but act recursively on subdirs. + +The files included are those that are marked in the current Dired +buffer, or all files in the directory if none are marked. Marked +subdirectories are handled recursively in the same way. + +With a prefix argument, ignore all marks - include all files in this +Dired buffer and all subdirs, recursively. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-create-files-non-directory-recursive'." + (interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg diredp-list-file-attributes))) + (diredp-create-files-non-directory-recursive + #'dired-rename-file #'upcase "Rename to uppercase:" ignore-marks-p details)) + +;;;###autoload +(defun diredp-downcase-recursive (&optional ignore-marks-p details) ; Bound to `M-+ % l' + "Rename marked files, including in marked subdirs, making them lowercase. +Like `dired-downcase', but act recursively on subdirs. + +The files included are those that are marked in the current Dired +buffer, or all files in the directory if none are marked. Marked +subdirectories are handled recursively in the same way. + +With a prefix argument, ignore all marks - include all files in this +Dired buffer and all subdirs, recursively. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-create-files-non-directory-recursive'." + (interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg diredp-list-file-attributes))) + (diredp-create-files-non-directory-recursive + #'dired-rename-file #'downcase "Rename to lowercase:" ignore-marks-p details)) + +;;;###autoload +(defun diredp-do-apply-function-recursive (function &optional arg details) ; Bound to `M-+ @' + "Apply FUNCTION to the marked files. +Like `diredp-do-apply-function' but act recursively on subdirs and do +no result or error logging or echoing. + +The files acted on are those that are marked in the current Dired +buffer, or all files in the directory if none are marked. Marked +subdirectories are handled recursively in the same way. + +With a plain prefix ARG (`C-u'), visit each file and invoke FUNCTION + with no arguments. +Otherwise, apply FUNCTION to each file name. + +Any other prefix arg behaves according to the ARG argument of +`dired-get-marked-files'. In particular, `C-u C-u' operates on all +files in the Dired buffer. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-get-files'." + (interactive (progn (diredp-get-confirmation-recursive) + (list (read (completing-read "Function: " obarray 'functionp nil nil + (and (boundp 'function-name-history) 'function-name-history))) + current-prefix-arg + diredp-list-file-attributes))) + (if (and (consp arg) (< (car arg) 16)) + (dolist (file (diredp-get-files)) (with-current-buffer (find-file-noselect file) (funcall function))) + (dolist (file (diredp-get-files arg nil nil nil nil details)) (funcall function file)))) + +;;;###autoload +(defun diredp-do-delete-recursive (arg &optional details) ; Bound to `M-+ D' + "Delete marked (not flagged) files, including in marked subdirs. +Like `dired-do-delete' but act recursively on subdirs. + +The files to be deleted are those that are marked in the current Dired +buffer, or all files in the directory if none are marked. Marked +subdirectories are handled recursively in the same way. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-get-files' and `diredp-get-subdirs'." + (interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg diredp-list-file-attributes))) + (unless arg + (ding) + (message "NOTE: Deletion of files marked `%c' (not those flagged `%c')." + dired-marker-char dired-del-marker)) + (let* ((files (diredp-get-files nil nil nil nil 'ONLY-MARKED-P details)) + (count (length files)) + (trashing (and (boundp 'delete-by-moving-to-trash) delete-by-moving-to-trash)) + (succ 0)) + (if (dired-mark-pop-up + " *Deletions*" 'delete files dired-deletion-confirmer + (format "%s %s " (if trashing "Trash" "Delete") (dired-mark-prompt arg files))) + (let ((progress-reporter (and (fboundp 'make-progress-reporter) + (make-progress-reporter (if trashing "Trashing..." "Deleting...") + succ + count))) + (failures ())) + (unless progress-reporter (message "Deleting...")) + (dolist (file files) + (condition-case err + (progn (if (fboundp 'dired-delete-file) ; Emacs 22+ + (dired-delete-file file dired-recursive-deletes trashing) + ;; This test is equivalent to (and (file-directory-p file) (not (file-symlink-p file))) + ;; but more efficient. + (if (eq t (car (file-attributes file))) (delete-directory file) (delete-file file))) + (setq succ (1+ succ)) + (when (fboundp 'progress-reporter-update) + (progress-reporter-update progress-reporter succ))) + (error (dired-log "%s\n" err) ; Catch errors from failed deletions. + (setq failures (cons file failures)))) + (dired-clean-up-after-deletion file)) + (if failures + (dired-log-summary (format "%d of %d deletion%s failed" + (length failures) count (dired-plural-s count)) + failures) + (if (fboundp 'progress-reporter-done) + (progress-reporter-done progress-reporter) + (message "Deleting...done"))) + (let ((sdirs (diredp-get-subdirs nil nil details)) + dbufs) + (dolist (dir (cons default-directory sdirs)) + (when (setq dbufs (dired-buffers-for-dir (expand-file-name dir))) ; Dirs with Dired buffers only. + (with-current-buffer (car dbufs) (dired-revert)))))) + (message "OK. NO deletions performed")))) + +;;;###autoload +(defun diredp-do-move-recursive (&optional ignore-marks-p details) ; Bound to `M-+ R' + "Move marked files, including in marked subdirs, to a given directory. +Like `dired-do-rename', but act recursively on subdirs to pick up the +files to move. + +The files included are those that are marked in the current Dired +buffer, or all files in the directory if none are marked. Marked +subdirectories are handled recursively in the same way. + +This means move the marked files of marked subdirs and their marked +subdirs, etc. It does not mean move or rename the subdirs themselves +recursively. + +With a prefix argument, ignore all marks - include all files in this +Dired buffer and all subdirs, recursively. + +Renames any buffers that are visiting the files. + +The default suggested for the target directory depends on the value of +`dired-dwim-target', which see." + (interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg diredp-list-file-attributes))) + (diredp-do-create-files-recursive #'dired-rename-file "Move" ignore-marks-p details)) + +;;;###autoload +(defun diredp-do-copy-recursive (&optional ignore-marks-p details) ; Bound to `M-+ C' + "Copy marked files, including in marked subdirs, to a given directory. +Like `dired-do-copy', but act recursively on subdirs to pick up the +files to copy. + +The files included are those that are marked in the current Dired +buffer, or all files in the directory if none are marked. Marked +subdirectories are handled recursively in the same way. + +This means copy the marked files of marked subdirs and their marked +subdirs, etc. It does not mean copy the subdirs themselves +recursively. + +With a prefix argument, ignore all marks - include all files in this +Dired buffer and all subdirs, recursively. + +Preserves the last-modified date when copying, unless +`dired-copy-preserve-time' is nil. + +The default suggested for the target directory depends on the value of +`dired-dwim-target', which see. + +This command copies symbolic links by creating new ones, like UNIX +command `cp -d'. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-do-create-files-recursive'." + (interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg diredp-list-file-attributes))) + (let ((dired-recursive-copies nil)) ; Doesn't have to be nil, but let's not go overboard now. + (diredp-do-create-files-recursive #'dired-copy-file "Copy" ignore-marks-p details))) + +(defun diredp-do-create-files-recursive (file-creator operation ignore-marks-p &optional details) + "Create a new file for each marked file, including those in marked subdirs. +Like `dired-do-create-files', but act recursively on subdirs, and +always keep markings. +Prompts for the target directory, in which to create the files. +FILE-CREATOR and OPERATION are as in `dired-create-files'. +Non-nil IGNORE-MARKS-P means ignore all marks - include all files in this +Dired buffer and all subdirs, recursively. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-get-files'." + (lexical-let* ((fn-list (diredp-get-files ignore-marks-p nil nil nil nil details)) + (target-dir (dired-dwim-target-directory)) + (defaults (and (fboundp 'dired-dwim-target-defaults) ; Emacs 23+ + (dired-dwim-target-defaults fn-list target-dir))) + (target (expand-file-name + (if (fboundp 'minibuffer-with-setup-hook) ; Emacs 22+ + (minibuffer-with-setup-hook + (lambda () + (set (make-local-variable 'minibuffer-default-add-function) + nil) + (setq minibuffer-default defaults)) + (funcall (if (fboundp 'read-directory-name) + #'read-directory-name + #'read-file-name) + (concat operation " files to: ") + default-directory default-directory)) + (funcall (if (fboundp 'read-directory-name) + #'read-directory-name + #'read-file-name) + (concat operation "files to: ") + default-directory default-directory))))) + (unless (file-directory-p target) (error "Target is not a directory: `%s'" target)) + (dired-create-files + file-creator operation fn-list + #'(lambda (from) (expand-file-name (file-name-nondirectory from) target)) + ;; Hard-code `*' marker, or else it will be removed in lower dirs because the code uses + ;; `dired-file-marker', which only works in the current Dired directory. + ?*))) + +(defun diredp-create-files-non-directory-recursive (file-creator basename-constructor operation + &optional ignore-marks-p details) + "Apply FILE-CREATOR + BASENAME-CONSTRUCTOR to non-dir part of marked names. +Like `dired-create-files-non-directory', but act recursively on subdirs. + +The files acted on are those marked in the current Dired buffer, or +all files in the directory if none are marked. Marked subdirectories +are handled recursively in the same way. + +With non-nil IGNORE-MARKS-P, ignore all marks - include all files in +this Dired buffer and all subdirs, recursively. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-get-files'." + (let (rename-non-directory-query) + (dired-create-files + file-creator + operation + (diredp-get-files ignore-marks-p nil nil nil nil details) + #'(lambda (from) + (let ((to (concat (file-name-directory from) + (funcall basename-constructor (file-name-nondirectory from))))) + (and (let ((help-form (format "\ +Type SPC or `y' to %s one file, DEL or `n' to skip to next, +`!' to %s all remaining matches with no more questions." + (downcase operation) + (downcase operation)))) + (dired-query 'rename-non-directory-query (concat operation " `%s' to `%s'") + (dired-make-relative from) (dired-make-relative to))) + to))) + ;; Hard-code `*' marker, or else it will be removed in lower dirs because the code uses + ;; `dired-file-marker', which only works in the current Dired directory. + ?*))) + +(defun diredp-do-chxxx-recursive (attribute-name program op-symbol &optional ignore-marks-p default details) + "Change attributes of the marked files, including those in marked subdirs. +Refresh their file lines. + +Like `dired-do-chxxx', but act recursively on subdirs. The subdirs +acted on are those that are marked in the current Dired buffer, or all +subdirs in the directory if none are marked. Marked subdirectories +are handled recursively in the same way. + +ATTRIBUTE-NAME is a string describing the attribute to the user. +PROGRAM is the program used to change the attribute. +OP-SYMBOL is the type of operation (for use in `dired-mark-pop-up'). +Non-nil IGNORE-MARKS-P means ignore all marks - include all files in this + Dired buffer and all subdirs, recursively. +DEFAULT is the default value for reading the mark string. +DETAILS is passed to `diredp-get-files' and + `diredp-do-redisplay-recursive'." + (let* ((this-buff (current-buffer)) + (files (diredp-get-files ignore-marks-p nil nil nil nil details)) + (prompt (concat "Change " attribute-name " of %s to: ")) + (new-attribute (if (> emacs-major-version 22) + (dired-mark-read-string prompt nil op-symbol ignore-marks-p files default) + (dired-mark-read-string prompt nil op-symbol ignore-marks-p files))) + (operation (concat program " " new-attribute)) + failures) + (setq failures (dired-bunch-files 10000 (function dired-check-process) + (append (list operation program) + (unless (string-equal new-attribute "") + (if (equal attribute-name "Timestamp") + (list "-t" new-attribute) + (list new-attribute))) + (and (diredp-string-match-p "gnu" system-configuration) + '("--"))) ; -------------------------------- + files)) + (with-current-buffer this-buff (diredp-do-redisplay-recursive details 'MSGP)) + (when failures (dired-log-summary (format "%s: error" operation) nil)))) + +;;;###autoload +(defun diredp-do-chmod-recursive (&optional ignore-marks-p details) ; Bound to `M-+ M' + "Change the mode of the marked files, including those in marked subdirs. +Symbolic modes like `g+w' are allowed. + +Note that marked subdirs are not changed. Their markings are used only +to indicate that some of their files are to be changed. + +With a prefix argument, ignore all marks - include all files in this +Dired buffer and all subdirs, recursively. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-get-files' and `diredp-do-redisplay-recursive'." + (interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg diredp-list-file-attributes))) + (let* ((files (diredp-get-files ignore-marks-p nil nil nil nil details)) + (modestr (and (stringp (car files)) (nth 8 (file-attributes (car files))))) + (default (and (stringp modestr) + (string-match "^.\\(...\\)\\(...\\)\\(...\\)$" modestr) + (replace-regexp-in-string "-" "" (format "u=%s,g=%s,o=%s" + (match-string 1 modestr) + (match-string 2 modestr) + (match-string 3 modestr))))) + (modes (if (> emacs-major-version 22) + (dired-mark-read-string + "Change mode of marked files here and below to: " nil 'chmod + nil files default) + (dired-mark-read-string + "Change mode of marked files here and below to: " nil 'chmod + nil files)))) + (when (equal modes "") (error "No file mode specified")) + (dolist (file files) + (set-file-modes file (or (and (diredp-string-match-p "^[0-7]+" modes) (string-to-number modes 8)) + (file-modes-symbolic-to-number modes (file-modes file))))) + (diredp-do-redisplay-recursive details 'MSGP))) + +(unless (memq system-type '(windows-nt ms-dos)) + (defun diredp-do-chgrp-recursive (&optional ignore-marks-p details) + "Change the group of the marked (or next ARG) files. +With a prefix argument, ignore all marks - include all files in this +Dired buffer and all subdirs, recursively. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-do-chxxx-recursive'." + (interactive (list current-prefix-arg diredp-list-file-attributes)) + (diredp-do-chxxx-recursive "Group" "chgrp" 'chgrp ignore-marks-p nil details))) + +(unless (memq system-type '(windows-nt ms-dos)) + (defun diredp-do-chown-recursive (&optional ignore-marks-p details) + "Change the owner of the marked (or next ARG) files. +With a prefix argument, ignore all marks - include all files in this +Dired buffer and all subdirs, recursively. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-do-chxxx-recursive'." + (interactive (list current-prefix-arg diredp-list-file-attributes)) + (diredp-do-chxxx-recursive "Owner" dired-chown-program 'chown ignore-marks-p nil details))) + +;;;###autoload +(defun diredp-do-touch-recursive (&optional ignore-marks-p details) + "Change the timestamp of marked files, including those in marked subdirs. +This calls `touch'. Like `dired-do-touch', but act recursively on +subdirs. The subdirs inserted are those that are marked in the +current Dired buffer, or all subdirs in the directory if none are +marked. Marked subdirectories are handled recursively in the same +way. + +With a prefix argument, ignore all marks - include all files in this +Dired buffer and all subdirs, recursively. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-do-chxxx-recursive'." + (interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg diredp-list-file-attributes))) + (diredp-do-chxxx-recursive "Timestamp" (if (boundp 'dired-touch-program) + dired-touch-program ; Emacs 22+ + "touch") + 'touch + ignore-marks-p + (format-time-string "%Y%m%d%H%M.%S" (current-time)) + details)) + +;;;###autoload +(defun diredp-do-redisplay-recursive (&optional details msgp) + "Redisplay marked file lines, including those in marked subdirs. +Non-nil MSGP means show status messages. +Like `dired-do-redisplay' with no args, but act recursively on +subdirs. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-get-files'." + (interactive (progn (diredp-ensure-mode) + (unless (y-or-n-p "Act on all marked file lines in and UNDER this dir? ") + (error "OK, canceled")) + (list diredp-list-file-attributes t))) + (when msgp (message "Redisplaying...")) + (dolist (dir (cons default-directory + (diredp-get-files nil #'file-directory-p 'INCLUDE-SUBDIRS 'DONT-ASK nil details))) + (with-current-buffer (dired-noselect dir) + ;; `message' is much faster than making `dired-map-over-marks' show progress + (dired-uncache (if (consp dired-directory) (car dired-directory) dired-directory)) + (dired-map-over-marks + (let ((fname (dired-get-filename)) + ;; Postpone readin hook till we map over all marked files (Bug#6810). + (dired-after-readin-hook nil)) + (message "Redisplaying... %s" fname) + (dired-update-file-line fname)) + nil) + (run-hooks 'dired-after-readin-hook) + (dired-move-to-filename))) + (when msgp (message "Redisplaying...done"))) + + +;;; `diredp-marked(-other-window)' tries to treat SWITCHES, but SWITCHES seems to be ignored +;;; by `dired' when the DIRNAME arg is a cons, at least on MS Windows. I filed Emacs bug #952 +;;; on 2008-09-10, but this doesn't work in Emacs 20, 21, 22, or 23, so I don't know if it will +;;; ever be fixed. If it is declared a non-bug and it doesn't work on any platforms, then I'll +;;; remove SWITCHES here, alas. + +;;;###autoload +(defun diredp-marked (dirname &optional n switches) ; Not bound + "Open Dired on only the marked files or the next N files. +With a non-zero numeric prefix arg N, use the next abs(N) files. +A plain (`C-u'), zero, or negative prefix arg prompts for listing +switches as in command `dired'. + +Note that the marked files can include files in inserted +subdirectories, so the Dired buffer that is opened can contain files +from multiple directories in the same tree." + (interactive (progn (diredp-ensure-mode) + (let ((num (and current-prefix-arg + (atom current-prefix-arg) + (not (zerop (prefix-numeric-value current-prefix-arg))) + (abs (prefix-numeric-value current-prefix-arg))))) + (list (cons (generate-new-buffer-name (buffer-name)) (dired-get-marked-files t num)) + num + (and current-prefix-arg ; Switches + (or (consp current-prefix-arg) + (< (prefix-numeric-value current-prefix-arg) 0)) + (read-string "Dired listing switches: " dired-listing-switches)))))) + (unless (or n (save-excursion (goto-char (point-min)) + (and (re-search-forward (dired-marker-regexp) nil t) + (re-search-forward (dired-marker-regexp) nil t)))) + (error "No marked files")) + (dired dirname switches)) + +;;;###autoload +(defun diredp-marked-other-window (dirname &optional n switches) ; Bound to `C-M-*' + "Same as `diredp-marked', but uses a different window." + (interactive (progn (diredp-ensure-mode) + (let ((num (and current-prefix-arg + (atom current-prefix-arg) + (not (zerop (prefix-numeric-value current-prefix-arg))) + (abs (prefix-numeric-value current-prefix-arg))))) + (list (cons (generate-new-buffer-name (buffer-name)) (dired-get-marked-files t num)) + num + (and current-prefix-arg ; Switches + (or (consp current-prefix-arg) + (< (prefix-numeric-value current-prefix-arg) 0)) + (read-string "Dired listing switches: " dired-listing-switches)))))) + (unless (or n (save-excursion (goto-char (point-min)) + (and (re-search-forward (dired-marker-regexp) nil t) + (re-search-forward (dired-marker-regexp) nil t)))) + (error "No marked files")) + (dired-other-window dirname switches)) + + +;; Similar to `dired-mark-extension' in `dired-x.el'. +;; The difference is that this uses prefix arg to unmark, not to determine the mark character. +;;;###autoload +(defun diredp-mark/unmark-extension (extension &optional unmark-p) ; Bound to `* .' + "Mark all files with a certain EXTENSION for use in later commands. +A `.' is not automatically prepended to the string entered. +Non-nil prefix argument UNMARK-P means unmark instead of mark. + +Non-interactively, EXTENSION is the extension (a string). It can also + be a list of extension strings. +Optional argument UNMARK-P is the prefix arg." + (interactive (list (diredp-read-regexp (concat (if current-prefix-arg "UNmark" "Mark") "ing extension: ")) + current-prefix-arg)) + (or (listp extension) (setq extension (list extension))) + (dired-mark-files-regexp (concat ".";; Do not match names with nothing but an extension + "\\(" + (mapconcat #'regexp-quote extension "\\|") + "\\)$") + (and current-prefix-arg ?\040))) + +(defun diredp-mark-files-tagged-all/none (tags &optional none-p unmarkp prefix) + "Mark or unmark files tagged with all or none of TAGS. +TAGS is a list of strings, the tag names. +NONEP non-nil means mark/unmark files that have none of the TAGS. +UNMARKP non-nil means unmark; nil means mark. +PREFIX non-nil is the prefix of the autofile bookmarks to check. + +As a special case, if TAGS is empty, then mark or unmark the files +that have any tags at all, or if NONEP is non-nil then mark or unmark +those that have no tags at all." + (let ((dired-marker-char (if unmarkp ?\040 dired-marker-char))) + (diredp-mark-if (and (not (diredp-looking-at-p dired-re-dot)) (not (eolp)) + (let* ((fname (dired-get-filename nil t)) + (bmk (and fname (bmkp-get-autofile-bookmark fname nil prefix))) + (btgs (and bmk (bmkp-get-tags bmk))) + (presentp nil) + (allp (and btgs (catch 'diredp-m-f-t-an + (dolist (tag tags) + (setq presentp (assoc-default tag btgs nil t)) + (unless (if none-p (not presentp) presentp) + (throw 'diredp-m-f-t-an nil))) + t)))) + (if (null tags) + (if none-p (not btgs) btgs) + allp))) + (if none-p "no-tags-matching file" "all-tags-matching file")))) + +(defun diredp-mark-files-tagged-some/not-all (tags &optional notallp unmarkp prefix) + "Mark or unmark files tagged with any or not all of TAGS. +TAGS is a list of strings, the tag names. +NOTALLP non-nil means mark/unmark files that do not have all TAGS. +UNMARKP non-nil means unmark; nil means mark. +PREFIX non-nil is the prefix of the autofile bookmarks to check. + +As a special case, if TAGS is empty, then mark or unmark the files +that have any tags at all, or if NOTALLP is non-nil then mark or +unmark those that have no tags at all." + (let ((dired-marker-char (if unmarkp ?\040 dired-marker-char))) + (diredp-mark-if (and (not (diredp-looking-at-p dired-re-dot)) (not (eolp)) + (let* ((fname (dired-get-filename nil t)) + (bmk (and fname + (bmkp-get-autofile-bookmark fname nil prefix))) + (btgs (and bmk (bmkp-get-tags bmk))) + (presentp nil) + (allp (and btgs (catch 'diredp-m-f-t-sna + (dolist (tag tags) + (setq presentp (assoc-default tag btgs nil t)) + (when (if notallp (not presentp) presentp) + (throw 'diredp-m-f-t-sna t))) + nil)))) + (if (null tags) (if notallp (not btgs) btgs) allp))) + (if notallp "some-tags-not-matching file" "some-tags-matching file")))) + +;;;###autoload +(defun diredp-mark-files-tagged-all (tags &optional none-p prefix) ; `T m *' + "Mark all files that are tagged with *each* tag in TAGS. +As a special case, if TAGS is empty, then mark the files that have + any tags at all (i.e., at least one tag). +With a prefix arg, mark all that are *not* tagged with *any* TAGS. +You need library `bookmark+.el' to use this command." + (interactive (list (and (fboundp 'bmkp-read-tags-completing) (bmkp-read-tags-completing)) + current-prefix-arg + (and diredp-prompt-for-bookmark-prefix-flag + (read-string "Prefix for autofile bookmark names: ")))) + (diredp-ensure-bookmark+) + (diredp-ensure-mode) + (diredp-mark-files-tagged-all/none tags none-p nil prefix)) + +;;;###autoload +(defun diredp-mark-files-tagged-none (tags &optional allp prefix) ; `T m ~ +' + "Mark all files that are not tagged with *any* tag in TAGS. +As a special case, if TAGS is empty, then mark the files that have + no tags at all. +With a prefix arg, mark all that are tagged with *each* tag in TAGS. +You need library `bookmark+.el' to use this command." + (interactive (list (and (fboundp 'bmkp-read-tags-completing) (bmkp-read-tags-completing)) + current-prefix-arg + (and diredp-prompt-for-bookmark-prefix-flag + (read-string "Prefix for autofile bookmark names: ")))) + (diredp-ensure-bookmark+) + (diredp-ensure-mode) + (diredp-mark-files-tagged-all/none tags (not allp) nil prefix)) + +;;;###autoload +(defun diredp-mark-files-tagged-some (tags &optional somenotp prefix) ; `T m +' + "Mark all files that are tagged with *some* tag in TAGS. +As a special case, if TAGS is empty, then mark the files that have + any tags at all (i.e., at least one tag). +With a prefix arg, mark all that are *not* tagged with *all* TAGS. +You need library `bookmark+.el' to use this command." + (interactive (list (and (fboundp 'bmkp-read-tags-completing) (bmkp-read-tags-completing)) + current-prefix-arg + (and diredp-prompt-for-bookmark-prefix-flag + (read-string "Prefix for autofile bookmark names: ")))) + (diredp-ensure-bookmark+) + (diredp-ensure-mode) + (diredp-mark-files-tagged-some/not-all tags somenotp nil prefix)) + +;;;###autoload +(defun diredp-mark-files-tagged-not-all (tags &optional somep prefix) ; `T m ~ *' + "Mark all files that are not tagged with *all* TAGS. +As a special case, if TAGS is empty, then mark the files that have + no tags at all. +With a prefix arg, mark all that are tagged with *some* TAGS. +You need library `bookmark+.el' to use this command." + (interactive (list (and (fboundp 'bmkp-read-tags-completing) (bmkp-read-tags-completing)) + current-prefix-arg + (and diredp-prompt-for-bookmark-prefix-flag + (read-string "Prefix for autofile bookmark names: ")))) + (diredp-ensure-bookmark+) + (diredp-ensure-mode) + (diredp-mark-files-tagged-some/not-all tags (not somep) nil prefix)) + +;;;###autoload +(defun diredp-mark-files-tagged-regexp (regexp &optional notp prefix) ; `T m %' + "Mark files that have at least one tag that matches REGEXP. +With a prefix arg, mark all that are tagged but have no matching tags. +You need library `bookmark+.el' to use this command." + (interactive (list (read-string "Regexp: ") + current-prefix-arg + (and diredp-prompt-for-bookmark-prefix-flag + (read-string "Prefix for autofile bookmark names: ")))) + (diredp-ensure-bookmark+) + (diredp-ensure-mode) + (diredp-mark-if (and (not (diredp-looking-at-p dired-re-dot)) (not (eolp)) + (lexical-let* ((fname (dired-get-filename nil t)) + (bmk (and fname + (bmkp-get-autofile-bookmark fname nil prefix))) + (btgs (and bmk (bmkp-get-tags bmk))) + (anyp (and btgs (bmkp-some #'(lambda (tag) + (diredp-string-match-p + regexp + (bmkp-tag-name tag))) + btgs)))) + (and btgs (if notp (not anyp) anyp)))) + "some-tag-matching-regexp file")) + +;;;###autoload +(defun diredp-unmark-files-tagged-regexp (regexp &optional notp prefix) ; `T u %' + "Unmark files that have at least one tag that matches REGEXP. +With a prefix arg, unmark all that are tagged but have no matching tags. +You need library `bookmark+.el' to use this command." + (interactive (list (read-string "Regexp: ") + current-prefix-arg + (and diredp-prompt-for-bookmark-prefix-flag + (read-string "Prefix for autofile bookmark names: ")))) + (diredp-ensure-bookmark+) + (diredp-ensure-mode) + (let ((dired-marker-char ?\040)) + (diredp-mark-if (and (not (diredp-looking-at-p dired-re-dot)) (not (eolp)) + (lexical-let* ((fname (dired-get-filename nil t)) + (bmk (and fname (bmkp-get-autofile-bookmark fname nil prefix))) + (btgs (and bmk (bmkp-get-tags bmk))) + (anyp (and btgs (bmkp-some #'(lambda (tag) + (diredp-string-match-p + regexp + (bmkp-tag-name tag))) + btgs)))) + (and btgs (if notp (not anyp) anyp)))) + "some-tag-matching-regexp file"))) + +;;;###autoload +(defun diredp-unmark-files-tagged-all (tags &optional none-p prefix) ; `T u *' + "Unmark all files that are tagged with *each* tag in TAGS. +As a special case, if TAGS is empty, then unmark the files that have + any tags at all (i.e., at least one tag). +With a prefix arg, unmark all that are *not* tagged with *any* TAGS. +You need library `bookmark+.el' to use this command." + (interactive (list (and (fboundp 'bmkp-read-tags-completing) (bmkp-read-tags-completing)) + current-prefix-arg + (and diredp-prompt-for-bookmark-prefix-flag + (read-string "Prefix for autofile bookmark names: ")))) + (diredp-ensure-bookmark+) + (diredp-ensure-mode) + (diredp-mark-files-tagged-all/none tags none-p 'UNMARK prefix)) + +;;;###autoload +(defun diredp-unmark-files-tagged-none (tags &optional allp prefix) ; `T u ~ +' + "Unmark all files that are *not* tagged with *any* tag in TAGS. +As a special case, if TAGS is empty, then unmark the files that have + no tags at all. +With a prefix arg, unmark all that are tagged with *each* tag in TAGS. +You need library `bookmark+.el' to use this command." + (interactive (list (and (fboundp 'bmkp-read-tags-completing) (bmkp-read-tags-completing)) + current-prefix-arg + (and diredp-prompt-for-bookmark-prefix-flag + (read-string "Prefix for autofile bookmark names: ")))) + (diredp-ensure-bookmark+) + (diredp-ensure-mode) + (diredp-mark-files-tagged-all/none tags (not allp) 'UNMARK prefix)) + +;;;###autoload +(defun diredp-unmark-files-tagged-some (tags &optional somenotp prefix) ; `T u +' + "Unmark all files that are tagged with *some* tag in TAGS. +As a special case, if TAGS is empty, then unmark the files that have + any tags at all. +With a prefix arg, unmark all that are *not* tagged with *all* TAGS. +You need library `bookmark+.el' to use this command." + (interactive (list (and (fboundp 'bmkp-read-tags-completing) (bmkp-read-tags-completing)) + current-prefix-arg + (and diredp-prompt-for-bookmark-prefix-flag + (read-string "Prefix for autofile bookmark names: ")))) + (diredp-ensure-bookmark+) + (diredp-ensure-mode) + (diredp-mark-files-tagged-some/not-all tags somenotp 'UNMARK prefix)) + +;;;###autoload +(defun diredp-unmark-files-tagged-not-all (tags &optional somep prefix) ; `T u ~ *' + "Unmark all files that are *not* tagged with *all* TAGS. +As a special case, if TAGS is empty, then unmark the files that have + no tags at all. +With a prefix arg, unmark all that are tagged with *some* TAGS. +You need library `bookmark+.el' to use this command." + (interactive (list (and (fboundp 'bmkp-read-tags-completing) (bmkp-read-tags-completing)) + current-prefix-arg + (and diredp-prompt-for-bookmark-prefix-flag + (read-string "Prefix for autofile bookmark names: ")))) + (diredp-ensure-bookmark+) + (diredp-ensure-mode) + (diredp-mark-files-tagged-some/not-all tags (not somep) 'UNMARK prefix)) + +;;;###autoload +(defun diredp-do-tag (tags &optional prefix arg) ; `T > +' + "Tag the marked (or the next prefix argument) files. +You need library `bookmark+.el' to use this command. + +Hit `RET' to enter each tag, then hit `RET' again after the last tag. +You can use completion to enter each tag. Completion is lax: you are +not limited to existing tags. + +TAGS is a list of strings. PREFIX is as for `diredp-do-bookmark'. + +A prefix argument ARG specifies files to use instead of those marked. + An integer means use the next ARG files (previous -ARG, if < 0). + `C-u': Use the current file (whether or not any are marked). + `C-u C-u': Use all files in Dired, except directories. + `C-u C-u C-u': Use all files and directories, except `.' and `..'. + `C-u C-u C-u C-u': Use all files and all directories." + (interactive (progn (diredp-ensure-bookmark+) + (diredp-ensure-mode) + (list (bmkp-read-tags-completing) + (and diredp-prompt-for-bookmark-prefix-flag + (read-string "Prefix for autofile bookmark name: ")) + current-prefix-arg))) + (dired-map-over-marks-check (lexical-let ((pref prefix)) #'(lambda () (diredp-tag tags pref))) + arg 'tag (diredp-fewer-than-2-files-p arg))) + +(defun diredp-tag (tags &optional prefix) + "Add tags to the file or directory named on the current line. +You need library `bookmark+.el' to use this function. +The bookmark name is the non-directory portion of the file name, + prefixed by PREFIX if it is non-nil. +Return nil for success, file name otherwise." + (bookmark-maybe-load-default-file) + (let ((file (dired-get-file-for-visit)) + failure) + (condition-case err + (bmkp-autofile-add-tags file tags nil prefix) + (error (setq failure (error-message-string err)))) + (if (not failure) + nil ; Return nil for success. + (dired-log failure) + (dired-make-relative file)))) ; Return file name for failure. + +;;;###autoload +(defun diredp-mouse-do-tag (event) ; Not bound + "In Dired, add some tags to this file. +You need library `bookmark+.el' to use this command." + (interactive "e") + (diredp-ensure-bookmark+) + (diredp-ensure-mode) + (lexical-let ((mouse-pos (event-start event)) + (dired-no-confirm t) + (prefix (and diredp-prompt-for-bookmark-prefix-flag + (read-string "Prefix for bookmark name: ")))) + (select-window (posn-window mouse-pos)) + (goto-char (posn-point mouse-pos)) + (dired-map-over-marks-check #'(lambda () (diredp-tag (bmkp-read-tags-completing) prefix)) + 1 'tag t)) + (diredp-previous-line 1)) + +;;;###autoload +(defun diredp-do-untag (tags &optional prefix arg) ; `T > -' + "Remove some tags from the marked (or the next prefix arg) files. +You need library `bookmark+.el' to use this command. + +Hit `RET' to enter each tag, then hit `RET' again after the last tag. +You can use completion to enter each tag. Completion is lax: you are +not limited to existing tags. + +TAGS is a list of strings. PREFIX is as for `diredp-do-bookmark'. + +A prefix argument ARG specifies files to use instead of those marked. + An integer means use the next ARG files (previous -ARG, if < 0). + `C-u': Use the current file (whether or not any are marked). + `C-u C-u': Use all files in Dired, except directories. + `C-u C-u C-u': Use all files and directories, except `.' and `..'. + `C-u C-u C-u C-u': Use all files and all directories." + (interactive (progn (diredp-ensure-bookmark+) + (diredp-ensure-mode) + (list (bmkp-read-tags-completing) + (and diredp-prompt-for-bookmark-prefix-flag + (read-string "Prefix for bookmark name: ")) + current-prefix-arg))) + (dired-map-over-marks-check (lexical-let ((pref prefix)) + #'(lambda () (diredp-untag tags pref))) + arg 'untag (diredp-fewer-than-2-files-p arg))) + +(defun diredp-untag (tags &optional prefix) + "Remove some tags from the file or directory named on the current line. +You need library `bookmark+.el' to use this function. +The bookmark name is the non-directory portion of the file name, + prefixed by PREFIX if it is non-nil. +Return nil for success, file name otherwise." + (bookmark-maybe-load-default-file) + (let ((file (dired-get-file-for-visit)) + failure) + (condition-case err + (bmkp-autofile-remove-tags file tags nil prefix) + (error (setq failure (error-message-string err)))) + (if (not failure) + nil ; Return nil for success. + (dired-log failure) + (dired-make-relative file)))) ; Return file name for failure. + +;;;###autoload +(defun diredp-mouse-do-untag (event) ; Not bound + "In Dired, remove some tags from this file. +You need library `bookmark+.el' to use this command." + (interactive "e") + (diredp-ensure-bookmark+) + (diredp-ensure-mode) + (lexical-let ((mouse-pos (event-start event)) + (dired-no-confirm t) + (prefix (and diredp-prompt-for-bookmark-prefix-flag + (read-string "Prefix for bookmark name: ")))) + (select-window (posn-window mouse-pos)) + (goto-char (posn-point mouse-pos)) + (lexical-let* ((bmk (bmkp-get-autofile-bookmark (dired-get-filename) nil prefix)) + (btgs (and bmk (bmkp-get-tags bmk)))) + (unless btgs (error "File has no tags to remove")) + (dired-map-over-marks-check + #'(lambda () (diredp-untag (bmkp-read-tags-completing btgs) prefix)) 1 'untag t))) + (diredp-previous-line 1)) + +;;;###autoload +(defun diredp-do-remove-all-tags (&optional prefix arg) ; `T > 0' + "Remove all tags from the marked (or the next prefix arg) files. +You need library `bookmark+.el' to use this command. + +PREFIX is as for `diredp-do-bookmark'. + +A prefix argument ARG specifies files to use instead of those marked. + An integer means use the next ARG files (previous -ARG, if < 0). + `C-u': Use the current file (whether or not any are marked). + `C-u C-u': Use all files in Dired, except directories. + `C-u C-u C-u': Use all files and directories, except `.' and `..'. + `C-u C-u C-u C-u': Use all files and all directories." + (interactive (progn (diredp-ensure-bookmark+) + (diredp-ensure-mode) + (list (and diredp-prompt-for-bookmark-prefix-flag + (read-string "Prefix for bookmark name: ")) + current-prefix-arg))) + (lexical-let ((pref prefix)) + (dired-map-over-marks-check #'(lambda () (diredp-remove-all-tags pref)) arg 'remove-all-tags + (diredp-fewer-than-2-files-p arg)))) + +(defun diredp-remove-all-tags (&optional prefix) + "Remove all tags from the file or directory named on the current line. +You need library `bookmark+.el' to use this function. +The bookmark name is the non-directory portion of the file name, + prefixed by PREFIX if it is non-nil. +Return nil for success, file name otherwise." + (bookmark-maybe-load-default-file) + (let ((file (dired-get-file-for-visit)) + failure) + (condition-case err + (bmkp-remove-all-tags (bmkp-autofile-set file nil prefix)) + (error (setq failure (error-message-string err)))) + (if (not failure) + nil ; Return nil for success. + (dired-log failure) + (dired-make-relative file)))) ; Return file name for failure. + +;;;###autoload +(defun diredp-mouse-do-remove-all-tags (event) ; Not bound + "In Dired, remove all tags from the marked (or next prefix arg) files. +You need library `bookmark+.el' to use this command." + (interactive "e") + (diredp-ensure-bookmark+) + (diredp-ensure-mode) + (lexical-let ((mouse-pos (event-start event)) + (dired-no-confirm t) + (prefix (and diredp-prompt-for-bookmark-prefix-flag + (read-string "Prefix for bookmark name: ")))) + (select-window (posn-window mouse-pos)) + (goto-char (posn-point mouse-pos)) + (dired-map-over-marks-check #'(lambda () (diredp-remove-all-tags prefix)) + 1 'remove-all-tags t)) + (diredp-previous-line 1)) + +;;;###autoload +(defun diredp-do-paste-add-tags (&optional prefix arg) ; `T > p', `T > C-y' + "Add previously copied tags to the marked (or next prefix arg) files. +The tags were previously copied from a file to `bmkp-copied-tags'. +You need library `bookmark+.el' to use this command. + +A prefix argument ARG specifies files to use instead of those marked. + An integer means use the next ARG files (previous -ARG, if < 0). + `C-u': Use the current file (whether or not any are marked). + `C-u C-u': Use all files in Dired, except directories. + `C-u C-u C-u': Use all files and directories, except `.' and `..'. + `C-u C-u C-u C-u': Use all files and all directories." + (interactive (progn (diredp-ensure-bookmark+) + (diredp-ensure-mode) + (list (and diredp-prompt-for-bookmark-prefix-flag + (read-string "Prefix for autofile bookmark name: ")) + current-prefix-arg))) + (dired-map-over-marks-check (lexical-let ((pref prefix)) + #'(lambda () (diredp-paste-add-tags pref))) + arg 'paste-add-tags + (diredp-fewer-than-2-files-p arg))) + +(defun diredp-paste-add-tags (&optional prefix) + "Add previously copied tags to the file or directory on the current line. +The tags were previously copied from a file to `bmkp-copied-tags'. +You need library `bookmark+.el' to use this function. +The bookmark name is the non-directory portion of the file name, + prefixed by PREFIX if it is non-nil. +Return nil for success, file name otherwise." + (bookmark-maybe-load-default-file) + (let ((file (dired-get-file-for-visit)) + failure) + (condition-case err + (bmkp-autofile-add-tags file bmkp-copied-tags nil prefix) + (error (setq failure (error-message-string err)))) + (if (not failure) + nil ; Return nil for success. + (dired-log failure) + (dired-make-relative file)))) ; Return file name for failure. + +;;;###autoload +(defun diredp-mouse-do-paste-add-tags (event) ; Not bound + "In Dired, add previously copied tags to this file. +The tags were previously copied from a file to `bmkp-copied-tags'. +You need library `bookmark+.el' to use this command." + (interactive "e") + (diredp-ensure-bookmark+) + (diredp-ensure-mode) + (lexical-let ((mouse-pos (event-start event)) + (dired-no-confirm t) + (prefix (and diredp-prompt-for-bookmark-prefix-flag + (read-string "Prefix for bookmark name: ")))) + (select-window (posn-window mouse-pos)) + (goto-char (posn-point mouse-pos)) + (dired-map-over-marks-check #'(lambda () (diredp-paste-add-tags prefix)) + 1 'paste-add-tags t)) + (diredp-previous-line 1)) + +;;;###autoload +(defun diredp-do-paste-replace-tags (&optional prefix arg) ; `T > q' + "Replace tags for marked (or next prefix arg) files with copied tags. +The tags were previously copied from a file to `bmkp-copied-tags'. +You need library `bookmark+.el' to use this command. + +A prefix argument ARG specifies files to use instead of those marked. + An integer means use the next ARG files (previous -ARG, if < 0). + `C-u': Use the current file (whether or not any are marked). + `C-u C-u': Use all files in Dired, except directories. + `C-u C-u C-u': Use all files and directories, except `.' and `..'. + `C-u C-u C-u C-u': Use all files and all directories." + (interactive (progn (diredp-ensure-bookmark+) + (diredp-ensure-mode) + (list (and diredp-prompt-for-bookmark-prefix-flag + (read-string "Prefix for autofile bookmark name: ")) + current-prefix-arg))) + (dired-map-over-marks-check (lexical-let ((pref prefix)) + #'(lambda () (diredp-paste-replace-tags pref))) + arg 'paste-replace-tags (diredp-fewer-than-2-files-p arg))) + +(defun diredp-paste-replace-tags (&optional prefix) + "Replace tags for this file or dir with tags copied previously. +The tags were previously copied from a file to `bmkp-copied-tags'. +You need library `bookmark+.el' to use this function. +The bookmark name is the non-directory portion of the file name, + prefixed by PREFIX if it is non-nil. +Return nil for success, file name otherwise." + (bookmark-maybe-load-default-file) + (let ((file (dired-get-file-for-visit)) + failure) + (condition-case err + (progn (bmkp-remove-all-tags (bmkp-autofile-set file nil prefix)) + (bmkp-autofile-add-tags file bmkp-copied-tags nil prefix)) + (error (setq failure (error-message-string err)))) + (if (not failure) + nil ; Return nil for success. + (dired-log failure) + (dired-make-relative file)))) + +;;;###autoload +(defun diredp-mouse-do-paste-replace-tags (event) ; Not bound + "In Dired, replace tags for this file with tags copied previously. +The tags were previously copied from a file to `bmkp-copied-tags'. +You need library `bookmark+.el' to use this command." + (interactive "e") + (diredp-ensure-bookmark+) + (diredp-ensure-mode) + (lexical-let ((mouse-pos (event-start event)) + (dired-no-confirm t) + (prefix (and diredp-prompt-for-bookmark-prefix-flag + (read-string "Prefix for bookmark name: ")))) + (select-window (posn-window mouse-pos)) + (goto-char (posn-point mouse-pos)) + (dired-map-over-marks-check #'(lambda () (diredp-paste-replace-tags prefix)) + 1 'paste-replace-tags t)) + (diredp-previous-line 1)) + +;;;###autoload +(defun diredp-do-set-tag-value (tag value &optional prefix arg) ; `T > v' + "Set TAG value to VALUE, for the marked (or next prefix arg) files. +This does not change the TAG name. +You need library `bookmark+.el' to use this command. + +PREFIX is as for `diredp-do-bookmark'. + +A prefix argument ARG specifies files to use instead of those marked. + An integer means use the next ARG files (previous -ARG, if < 0). + `C-u': Use the current file (whether or not any are marked). + `C-u C-u': Use all files in Dired, except directories. + `C-u C-u C-u': Use all files and directories, except `.' and `..'. + `C-u C-u C-u C-u': Use all files and all directories." + (interactive (progn (diredp-ensure-bookmark+) + (diredp-ensure-mode) + (list (bmkp-read-tag-completing) + (read (read-string "Value: ")) + (and diredp-prompt-for-bookmark-prefix-flag + (read-string "Prefix for bookmark name: ")) + current-prefix-arg))) + (dired-map-over-marks-check (lexical-let ((tg tag) + (val value) + (pref prefix)) + #'(lambda () (diredp-set-tag-value tg val pref))) + arg 'set-tag-value (diredp-fewer-than-2-files-p arg))) + +(defun diredp-set-tag-value (tag value &optional prefix) + "Set TAG value to VALUE for this file or directory. +This does not change the TAG name. +You need library `bookmark+.el' to use this function. +The bookmark name is the non-directory portion of the file name, + prefixed by PREFIX if it is non-nil. +Return nil for success, file name otherwise." + (bookmark-maybe-load-default-file) + (let ((file (dired-get-file-for-visit)) + failure) + (condition-case err + (bmkp-set-tag-value (bmkp-autofile-set file nil prefix) tag value) + (error (setq failure (error-message-string err)))) + (if (not failure) + nil ; Return nil for success. + (dired-log failure) + (dired-make-relative file)))) ; Return file name for failure. + +;;;###autoload +(defun diredp-mouse-do-set-tag-value (event) ; Not bound + "In Dired, set the value of a tag for this file. +This does not change the tag name. +You need library `bookmark+.el' to use this command." + (interactive "e") + (diredp-ensure-bookmark+) + (diredp-ensure-mode) + (lexical-let ((mouse-pos (event-start event)) + (dired-no-confirm t) + (prefix (and diredp-prompt-for-bookmark-prefix-flag + (read-string "Prefix for bookmark name: ")))) + (select-window (posn-window mouse-pos)) + (goto-char (posn-point mouse-pos)) + (dired-map-over-marks-check #'(lambda () (diredp-set-tag-value (bmkp-read-tag-completing) + (read (read-string "Value: ")) + prefix)) + 1 'set-tag-value t)) + (diredp-previous-line 1)) + + +;; Define these even if `Bookmark+' is not loaded. +;;;###autoload +(defun diredp-mark-autofiles () ; Bound to `* B' + "Mark all autofiles, that is, files that have an autofile bookmark." + (interactive) + (diredp-ensure-bookmark+) + (diredp-ensure-mode) + (diredp-mark/unmark-autofiles)) + +;;;###autoload +(defun diredp-unmark-autofiles () + "Unmark all autofiles, that is, files that have an autofile bookmark." + (interactive) + (diredp-ensure-bookmark+) + (diredp-ensure-mode) + (diredp-mark/unmark-autofiles t)) + +;;;###autoload +(defun diredp-mark/unmark-autofiles (&optional unmarkp) + "Mark all autofiles, or unmark if UNMARKP is non-nil." + (let ((dired-marker-char (if unmarkp ?\040 dired-marker-char))) + (diredp-mark-if (and (not (diredp-looking-at-p dired-re-dot)) (not (eolp)) + (let ((fname (dired-get-filename nil t))) + (and fname (bmkp-get-autofile-bookmark fname)))) + "autofile"))) + +(when (and (fboundp 'bmkp-get-autofile-bookmark) ; Defined in `bookmark+-1.el'. + (fboundp 'hlt-highlight-region)) ; Defined in `highlight.el'. + + (defun diredp-highlight-autofiles () + "Highlight files that are autofile bookmarks. +Highlighting uses face `diredp-autofile-name'." + (save-excursion + (goto-char (point-min)) + (while (re-search-forward dired-move-to-filename-regexp nil t) + ;; If Dired details are hidden the match data gets changed. + (let* ((bmk (save-match-data + (bmkp-get-autofile-bookmark (buffer-substring (match-end 0) (line-end-position))))) + (tags (and bmk (bmkp-get-tags bmk)))) + (when bmk + (hlt-highlight-region (match-end 0) (line-end-position) + (if tags + 'diredp-tagged-autofile-name + 'diredp-autofile-name))))))) + + (cond ((fboundp 'define-minor-mode) + ;; Emacs 21+. Use `eval' so that even if the library is byte-compiled with Emacs 20, + ;; loading it into Emacs 21+ will define variable `diredp-highlight-autofiles-mode'. + (eval '(define-minor-mode diredp-highlight-autofiles-mode + "Toggle automatic highlighting of autofile bookmarks. +When you turn this on, it ensures that your bookmark file is loaded. + +NOTE: This mode is ON BY DEFAULT. More precisely, when `dired+.el' is +loaded (for the first time per Emacs session), the mode is turned ON. +To prevent this and have the mode OFF by default, you must do one of +the following: + + * Put (diredp-highlight-autofiles-mode -1) in your init file, AFTER + it loads `dired+.el'. + + * Customize option `diredp-highlight-autofiles-mode' to `nil', AND + ensure that your `custom-file' (or the `custom-saved-variables' + part of your init file) is evaluated before `dired+.el' is loaded. + +You need libraries `Bookmark and `highlight.el' for this command." + :init-value t :global t :group 'Dired-Plus :require 'dired+ + (if (not diredp-highlight-autofiles-mode) + (remove-hook 'dired-after-readin-hook #'diredp-highlight-autofiles) + (add-hook 'dired-after-readin-hook #'diredp-highlight-autofiles) + (bookmark-maybe-load-default-file)) + (when (derived-mode-p 'dired-mode) (dired-revert nil nil)) + (when (interactive-p) + (message "Dired highlighting of autofile bookmarks is now %s" + (if diredp-highlight-autofiles-mode "ON" "OFF")))))) + (t;; Emacs 20. + (defun diredp-highlight-autofiles-mode (&optional arg) + "Toggle automatic highlighting of autofile bookmarks. +When you turn this on, it ensures that your bookmark file is loaded. + +NOTE: This mode is ON BY DEFAULT. More precisely, when `dired+.el' is +loaded (for the first time per Emacs session), the mode is turned ON. +To prevent this and have the mode OFF by default, you must do one of +the following: + + * Put (diredp-highlight-autofiles-mode -1) in your init file, AFTER + it loads `dired+.el'. + + * Customize option `diredp-highlight-autofiles-mode' to `nil', AND + ensure that your `custom-file' (or the `custom-saved-variables' + part of your init file) is evaluated before `dired+.el' is loaded. + +You need libraries `Bookmark and `highlight.el' for this command." + (interactive (list (or current-prefix-arg 'toggle))) + (setq diredp-highlight-autofiles-mode (if (eq arg 'toggle) + (not diredp-highlight-autofiles-mode) + (> (prefix-numeric-value arg) 0))) + (if (not diredp-highlight-autofiles-mode) + (remove-hook 'dired-after-readin-hook #'diredp-highlight-autofiles) + (add-hook 'dired-after-readin-hook #'diredp-highlight-autofiles) + (bookmark-maybe-load-default-file)) + (when (derived-mode-p 'dired-mode) (dired-revert nil nil)) + (when (interactive-p) (message "Dired highlighting of autofile bookmarks is now %s" + (if diredp-highlight-autofiles-mode "ON" "OFF")))))) + + ;; Turn it ON BY DEFAULT. + (unless (or (boundp 'diredp-loaded-p) (get 'diredp-highlight-autofiles-mode 'saved-value)) + (diredp-highlight-autofiles-mode 1)) + ) + +;;;###autoload +(defun diredp-do-bookmark (&optional prefix arg) ; Bound to `M-b' + "Bookmark the marked (or the next prefix argument) files. +Each bookmark name is the non-directory portion of the file name, + prefixed by PREFIX if it is non-nil. +Interactively, you are prompted for the PREFIX if + `diredp-prompt-for-bookmark-prefix-flag' is non-nil. +The bookmarked position is the beginning of the file. +If you use library `bookmark+.el' then the bookmark is an autofile. + +A prefix argument ARG specifies files to use instead of those marked. + An integer means use the next ARG files (previous -ARG, if < 0). + `C-u': Use the current file (whether or not any are marked). + `C-u C-u': Use all files in Dired, except directories. + `C-u C-u C-u': Use all files and directories, except `.' and `..'. + `C-u C-u C-u C-u': Use all files and all directories." + (interactive (progn (diredp-ensure-mode) + (list (and diredp-prompt-for-bookmark-prefix-flag + (read-string "Prefix for bookmark name: ")) + current-prefix-arg))) + (dired-map-over-marks-check (lexical-let ((pref prefix)) + #'(lambda () (diredp-bookmark pref nil 'NO-MSG-P))) + arg 'bookmark (diredp-fewer-than-2-files-p arg))) + +;;;###autoload +(defun diredp-mouse-do-bookmark (event) ; Not bound + "In Dired, bookmark this file. See `diredp-do-bookmark'." + (interactive "e") + (lexical-let ((mouse-pos (event-start event)) + (dired-no-confirm t) + (prefix (and diredp-prompt-for-bookmark-prefix-flag + (read-string "Prefix for bookmark name: ")))) + (select-window (posn-window mouse-pos)) + (goto-char (posn-point mouse-pos)) + (dired-map-over-marks-check #'(lambda () (diredp-bookmark prefix nil)) nil 'bookmark t)) + (diredp-previous-line 1)) + +(defun diredp-bookmark (&optional prefix file no-msg-p) + "Bookmark the file or directory FILE. +If you use library `bookmark+.el' then the bookmark is an autofile. +Return nil for success or the file name otherwise. + +The bookmark name is the (non-directory) file name, prefixed by + optional arg PREFIX (a string) if non-nil. + +FILE defaults to the file name on the current Dired line. + +Non-nil optional arg NO-MSG-P means do not show progress messages." + (bookmark-maybe-load-default-file) + (let ((fil (or file (dired-get-file-for-visit))) + (failure nil)) + (condition-case err + (if (fboundp 'bmkp-autofile-set) ; Bookmark+ - just set an autofile bookmark. + (bmkp-autofile-set fil nil prefix nil (not no-msg-p)) + ;; Vanilla `bookmark.el' (or very old Bookmark+ version). + (let ((bookmark-make-record-function + (cond ((and (require 'image nil t) (require 'image-mode nil t) + (condition-case nil (image-type fil) (error nil))) + ;; Last two lines of function are from `image-bookmark-make-record'. + ;; But don't use that directly, because it uses + ;; `bookmark-make-record-default', which gets nil for `filename'. + (lambda () + `((filename . ,fil) + (position . 0) + ;; NEED to keep this part of code sync'd with `bmkp-make-record-for-target-file'. + (image-type . ,(image-type fil)) + (handler . image-bookmark-jump)))) ; In `image-mode.el'. + (t + (lambda () + `((filename . ,fil) + (position . 0))))))) + (bookmark-store (concat prefix (file-name-nondirectory fil)) (cdr (bookmark-make-record)) nil))) + (error (setq failure (error-message-string err)))) + (if (not failure) + nil ; Return nil for success. + (if (fboundp 'bmkp-autofile-set) + (dired-log failure) + (dired-log "Failed to create bookmark for `%s':\n%s\n" fil failure)) + (dired-make-relative fil)))) ; Return file name for failure. + +;;;###autoload +(defun diredp-set-bookmark-file-bookmark-for-marked (bookmark-file ; Bound to `C-M-b' + &optional prefix arg) + "Bookmark the marked files and create a bookmark-file bookmark for them. +The bookmarked position is the beginning of the file. +Jumping to the bookmark-file bookmark loads the set of file bookmarks. +You need library `bookmark+.el' to use this command. + +Each bookmark name is the non-directory portion of the file name, + prefixed by PREFIX if it is non-nil. +Interactively, you are prompted for PREFIX if + `diredp-prompt-for-bookmark-prefix-flag' is non-nil. + +A prefix argument ARG specifies files to use instead of those marked. + An integer means use the next ARG files (previous -ARG, if < 0). + `C-u': Use the current file (whether or not any are marked). + `C-u C-u': Use all files in Dired, except directories. + `C-u C-u C-u': Use all files and directories, except `.' and `..'. + `C-u C-u C-u C-u': Use all files and all directories. + +You are also prompted for the bookmark file, BOOKMARK-FILE. The +default is `.emacs.bmk' in the current directory, but you can enter +any file name, anywhere. + +The marked-file bookmarks are added to file BOOKMARK-FILE, but this +command does not make BOOKMARK-FILE the current bookmark file. To +make it current, just jump to the bookmark-file bookmark created by +this command. That bookmark (which bookmarks BOOKMARK-FILE) is +defined in that current bookmark file. + +Example: + + Bookmark file `~/.emacs.bmk' is current before invoking this command. + The current (Dired) directory is `/foo/bar'. + The marked files are bookmarked in the (possibly new) bookmark file + `/foo/bar/.emacs.bmk'. + The bookmarks for the marked files have names prefixed by `FOOBAR '. + The name of the bookmark-file bookmark is `Foobar Files'. + Bookmark `Foobar Files' is itself in bookmark file `~/.emacs.bmk'. + Bookmark file `~/.emacs.bmk' is current after invoking this command. + +You are prompted for the name of the bookmark-file bookmark, the +BOOKMARK-FILE for the marked-file bookmarks, and a PREFIX string for +each of the marked-file bookmarks. + +See also command `diredp-do-bookmark-in-bookmark-file'." + (interactive (diredp-read-bookmark-file-args)) + (diredp-ensure-bookmark+) + (diredp-do-bookmark-in-bookmark-file bookmark-file prefix arg 'CREATE-BOOKMARK-FILE-BOOKMARK)) + +;;;###autoload +(defun diredp-do-bookmark-in-bookmark-file (bookmark-file ; Bound to `C-M-B' (aka `C-M-S-b') + &optional prefix arg bfile-bookmarkp files) + "Bookmark marked files in BOOKMARK-FILE and save BOOKMARK-FILE. +The files bookmarked are the marked files, by default. +The bookmarked position is the beginning of the file. +You are prompted for BOOKMARK-FILE. The default is `.emacs.bmk' in +the current directory, but you can enter any file name, anywhere. +You need library `bookmark+.el' to use this command. + +The marked files are bookmarked in file BOOKMARK-FILE, but this +command does not make BOOKMARK-FILE the current bookmark file. To +make it current, use `\\[bmkp-switch-bookmark-file]' (`bmkp-switch-bookmark-file'). + +Each bookmark name is the non-directory portion of the file name, + prefixed by PREFIX if it is non-nil. +Interactively, you are prompted for PREFIX if + `diredp-prompt-for-bookmark-prefix-flag' is non-nil. + +Interactively, a prefix argument ARG specifies the files to use +instead of those marked. + + An integer means use the next ARG files (previous -ARG, if < 0). + `C-u': Use the current file (whether or not any are marked). + `C-u C-u': Use all files in Dired, except directories. + `C-u C-u C-u': Use all files and directories, except `.' and `..'. + `C-u C-u C-u C-u': Use all files and all directories. + +See also command `diredp-set-bookmark-file-bookmark-for-marked'. + +Non-interactively: + + * Non-nil BFILE-BOOKMARKP means create a bookmark-file bookmark for + BOOKMARK-FILE. + * Non-nil FILES is the list of files to bookmark." + (interactive (diredp-read-bookmark-file-args)) + (diredp-ensure-bookmark+) + (let ((bfile-exists-p (file-readable-p bookmark-file))) + (unless bfile-exists-p (bmkp-empty-file bookmark-file)) + (unless bmkp-current-bookmark-file (setq bmkp-current-bookmark-file bookmark-default-file)) + (let ((old-bmkp-current-bookmark-file bmkp-current-bookmark-file)) + (unwind-protect + (progn (bmkp-switch-bookmark-file bookmark-file) ; Changes `*-current-bookmark-file'. + (if files + (dolist (file files) (diredp-bookmark prefix file 'NO-MSG-P)) + (dired-map-over-marks-check + (lexical-let ((pref prefix)) #'(lambda () (diredp-bookmark pref nil 'NO-MSG-P))) + arg 'bookmark (diredp-fewer-than-2-files-p arg))) + (bookmark-save) + (unless bfile-exists-p (revert-buffer))) + (unless (bmkp-same-file-p old-bmkp-current-bookmark-file bmkp-current-bookmark-file) + (bmkp-switch-bookmark-file old-bmkp-current-bookmark-file 'NO-MSG)))) + (when bfile-bookmarkp (bmkp-set-bookmark-file-bookmark bookmark-file)))) + +(defun diredp-read-bookmark-file-args () + "Read args for `diredp-do-bookmark-in-bookmark-file' and similar." + (diredp-ensure-bookmark+) + (diredp-ensure-mode) + (list (let* ((insert-default-directory t) + (bmk-file (expand-file-name + (read-file-name + "Use bookmark file (default is in CURRENT dir): " nil + (if (or (> emacs-major-version 23) + (and (= emacs-major-version 23) (> emacs-minor-version 1))) + (list ".emacs.bmk" bookmark-default-file) + ".emacs.bmk"))))) + bmk-file) + (and diredp-prompt-for-bookmark-prefix-flag (read-string "Prefix for autofile bookmark names: ")) + current-prefix-arg)) + + +;; REPLACE ORIGINAL in `dired.el'. +;; +;; Allows for consp `dired-directory' too. +;; +(defun dired-buffers-for-dir (dir &optional file) + "Return a list of buffers that Dired DIR (top level or in-situ subdir). +If FILE is non-nil, include only those whose wildcard pattern (if any) +matches FILE. +The list is in reverse order of buffer creation, most recent last. +As a side effect, killed Dired buffers for DIR are removed from +`dired-buffers'." + (setq dir (file-name-as-directory dir)) + (let (result buf) + (dolist (elt dired-buffers) + (setq buf (cdr elt)) + (cond ((null (buffer-name buf)) ; Buffer is killed - clean up. + (setq dired-buffers (delq elt dired-buffers))) + ((dired-in-this-tree dir (car elt)) + (with-current-buffer buf + (and (assoc dir dired-subdir-alist) + (or (null file) + (if (stringp dired-directory) + ;; Allow for consp `dired-directory' too. + (let ((wildcards (file-name-nondirectory (if (consp dired-directory) + (car dired-directory) + dired-directory)))) + (or (zerop (length wildcards)) + (diredp-string-match-p (dired-glob-regexp wildcards) file))) + (member (expand-file-name file dir) (cdr dired-directory)))) + (setq result (cons buf result))))))) + result)) + + +;; If you use library `files+.el', you need not use these commands +;; explicitly, because that library redefines `find-file-read-args' to +;; do the same thing, in Dired mode. These are provided here in case +;; you want to bind them directly - for example, in case your code +;; does not use `find-file-read-args'. +;; +;;;###autoload +(defun diredp-find-a-file (filename &optional wildcards) ; Not bound + "`find-file', but use file on current line as default (`M-n')." + (interactive (diredp-find-a-file-read-args "Find file: " nil)) + (find-file filename wildcards)) + +;;;###autoload +(defun diredp-find-a-file-other-frame (filename &optional wildcards) ; Not bound + "`find-file-other-frame', but use file under cursor as default (`M-n')." + (interactive (diredp-find-a-file-read-args "Find file: " nil)) + (find-file-other-frame filename wildcards)) + +;;;###autoload +(defun diredp-find-a-file-other-window (filename &optional wildcards) ; Not bound + "`find-file-other-window', but use file under cursor as default (`M-n')." + (interactive (diredp-find-a-file-read-args "Find file: " nil)) + (find-file-other-window filename wildcards)) + +;;;###autoload +(defun diredp-find-a-file-read-args (prompt mustmatch) ; Not bound + (list (lexical-let ((find-file-default (abbreviate-file-name (dired-get-file-for-visit)))) + (minibuffer-with-setup-hook (lambda () + (setq minibuffer-default find-file-default)) + (read-file-name prompt nil default-directory mustmatch))) + t)) + +;;;###autoload +(defun diredp-find-file-reuse-dir-buffer () ; Not bound + "Like `dired-find-file', but reuse Dired buffers. +Unlike `dired-find-alternate-file' this does not use +`find-alternate-file' unless (1) the target is a directory that is not +yet visited as a Dired buffer, and (2) the current (Dired) buffer is +not visited also in some other window (possibly in an iconified +frame)." + (interactive) + (set-buffer-modified-p nil) + (let ((file (dired-get-file-for-visit))) + (diredp--reuse-dir-buffer-helper file))) + +;;;###autoload +(defun diredp-mouse-find-file-reuse-dir-buffer (event &optional find-file-func find-dir-func) ; Not bound + "Like `dired-mouse-find-file', but reuse Dired buffers. +Unlike `dired-find-alternate-file' this does not use +`find-alternate-file' unless (1) the target is a directory that is not +yet visited as a Dired buffer, and (2) the current (Dired) buffer is +not visited also in some other window (possibly in an iconified +frame). + +Non-nil optional args FIND-FILE-FUNC and FIND-DIR-FUNC specify +functions to visit the file and directory, respectively. +Defaults: `find-file' and `dired', respectively." + (interactive "e") + (let (window pos file) + (save-excursion + (setq window (posn-window (event-end event)) + pos (posn-point (event-end event))) + (unless (windowp window) (error "No file chosen")) + (set-buffer (window-buffer window)) + (goto-char pos) + (setq file (dired-get-file-for-visit))) + (select-window window) + (diredp--reuse-dir-buffer-helper file find-file-func find-dir-func))) + +(defun diredp--reuse-dir-buffer-helper (file &optional find-file-func find-dir-func other-window) + "Helper for commands `diredp-*-reuse-dir-buffer' commands. +Non-nil optional args FIND-FILE-FUNC and FIND-DIR-FUNC specify +functions to visit the file and directory, respectively. +Defaults: `find-file' and `dired', respectively. + +Unlike `dired-find-alternate-file' this does not use +`find-alternate-file' unless (1) the target is a directory that is not +yet visited as a Dired buffer, and (2) the current (Dired) buffer is +not visited also in some other window (possibly in an iconified +frame)." + (setq find-file-func (or find-file-func (if other-window #'find-file-other-window #'find-file)) + find-dir-func (or find-dir-func (if other-window #'dired-other-window #'dired))) + (let (;; This binding prevents problems with preserving point in windows displaying Dired buffers, because + ;; reverting a Dired buffer empties it, which changes the places where the markers used by + ;; `switch-to-buffer-preserve-window-point' point. + (switch-to-buffer-preserve-window-point (and (boundp 'switch-to-buffer-preserve-window-point) ; Emacs 24+ + (or (not (boundp 'dired-auto-revert-buffer)) + (not dired-auto-revert-buffer)) + switch-to-buffer-preserve-window-point)) + (find-file-run-dired t) + (wins ()) + (alt-find-file-func (if other-window + #'find-alternate-file-other-window + #'find-alternate-file)) + dir-bufs) + (if (or (not (file-directory-p file)) ; New is a not a directory + (dired-buffers-for-dir file) ; or there is a Dired buffer for it, even as a subdir. + (and (setq dir-bufs (dired-buffers-for-dir default-directory)) ; Dired bufs for current (old). + (progn + (dolist (buf dir-bufs) + (setq wins (append wins (get-buffer-window-list buf 'NOMINI 0)))) + (setq wins (delq nil wins)) + (cdr wins)))) ; More than one window showing current Dired buffer. + (if (file-directory-p file) + (or (and (cdr dired-subdir-alist) (dired-goto-subdir file)) ; New is a subdir inserted in current + (funcall find-dir-func file)) + (funcall find-file-func (file-name-sans-versions file t))) + (funcall alt-find-file-func (file-name-sans-versions file t))))) + +;;;###autoload +(defalias 'toggle-diredp-find-file-reuse-dir 'diredp-toggle-find-file-reuse-dir) +;;;###autoload +(defun diredp-toggle-find-file-reuse-dir (force-p) ; Bound to `C-M-R' (aka `C-M-S-r') + "Toggle whether Dired `find-file' commands reuse directories. +This applies also to `dired-w32-browser' commands and +`diredp-up-directory'. + +A prefix arg specifies directly whether or not to reuse. + If its numeric value is non-negative then reuse; else do not reuse. + +To set the behavior as a preference (default behavior), put this in +your ~/.emacs, where VALUE is 1 to reuse or -1 to not reuse: + + (diredp-toggle-find-file-reuse-dir VALUE) + +Note: This affects only these commands: + + `dired-find-file' + `dired-mouse-find-file' + +It does not affect the corresponding `-other-window' commands. Note +too that, by default, mouse clicks to open files or directories open +in another window: command `diredp-mouse-find-file-other-window', not +`dired-mouse-find-file'. If you want a mouse click to reuse a +directory then bind `mouse-2' to `dired-mouse-find-file' instead." + (interactive "P") + (if force-p ; Force. + (if (natnump (prefix-numeric-value force-p)) + (diredp-make-find-file-keys-reuse-dirs) + (diredp-make-find-file-keys-not-reuse-dirs)) + (if (where-is-internal 'dired-find-file dired-mode-map 'ascii) + (diredp-make-find-file-keys-reuse-dirs) + (diredp-make-find-file-keys-not-reuse-dirs)))) + +(defun diredp-make-find-file-keys-reuse-dirs () + "Make find-file keys reuse Dired buffers." + (substitute-key-definition 'diredp-up-directory 'diredp-up-directory-reuse-dir-buffer dired-mode-map) + (substitute-key-definition 'dired-find-file 'diredp-find-file-reuse-dir-buffer dired-mode-map) + (substitute-key-definition 'dired-mouse-find-file 'diredp-mouse-find-file-reuse-dir-buffer dired-mode-map) + ;; These commands are defined in `w32-browser.el' (for use with MS Windows). + (substitute-key-definition 'dired-w32-browser 'dired-w32-browser-reuse-dir-buffer dired-mode-map) + (substitute-key-definition 'dired-mouse-w32-browser 'dired-mouse-w32-browser-reuse-dir-buffer dired-mode-map) + (message "Reusing Dired buffers is now ON")) + +(defun diredp-make-find-file-keys-not-reuse-dirs () + "Make find-file keys not reuse Dired buffers (i.e. act normally)." + (substitute-key-definition 'diredp-up-directory-reuse-dir-buffer 'diredp-up-directory dired-mode-map) + (substitute-key-definition 'diredp-find-file-reuse-dir-buffer 'dired-find-file dired-mode-map) + (substitute-key-definition 'diredp-mouse-find-file-reuse-dir-buffer 'dired-mouse-find-file dired-mode-map) + ;; These commands are defined in `w32-browser.el' (for use with MS Windows). + (substitute-key-definition 'dired-w32-browser-reuse-dir-buffer 'dired-w32-browser dired-mode-map) + (substitute-key-definition 'dired-mouse-w32-browser-reuse-dir-buffer 'dired-mouse-w32-browser dired-mode-map) + (message "Reusing Dired buffers is now OFF")) + +;;;###autoload +(defun diredp-omit-marked () ; Not bound + "Omit lines of marked files. Return the number of lines omitted." + (interactive) + (let ((old-modified-p (buffer-modified-p)) + count) + (when (interactive-p) (message "Omitting marked lines...")) + (setq count (dired-do-kill-lines nil "Omitted %d line%s.")) + (set-buffer-modified-p old-modified-p) ; So no `%*' appear in mode-line. + count)) + +;;;###autoload +(defun diredp-omit-unmarked () ; Not bound + "Omit lines of unmarked files. Return the number of lines omitted." + (interactive) + (let ((old-modified-p (buffer-modified-p)) + count) + (dired-toggle-marks) + (message "Omitting unmarked lines...") + (setq count (diredp-omit-marked)) + (dired-toggle-marks) ; Marks all except `.', `..' + (set-buffer-modified-p old-modified-p) ; So no `%*' appear in mode-line. + count)) + +;;;###autoload +(defun diredp-ediff (file2) ; Bound to `=' + "Compare file at cursor with file FILE2 using `ediff'. +FILE2 defaults to the file at the cursor as well. If you enter just a +directory name for FILE2, then the file at the cursor is compared with +a file of the same name in that directory. FILE2 is the second file +given to `ediff'; the file at the cursor is the first. + +Try to guess a useful default value for FILE2, as follows: + +* If the mark is active, use the file at mark. +* Else if the file at cursor is a autosave file or a backup file, use + the corresponding base file. +* Else if there is any backup file for the file at point, use the + newest backup file for it. +* Else use the file at point." + (interactive (progn (require 'ediff) + (list (ediff-read-file-name ; In `ediff-util.el'. + (format "Compare %s with" (dired-get-filename t)) + (dired-current-directory) + (let* ((file (dired-get-filename)) + (file-sans-dir (file-name-nondirectory file)) + (file-dir (file-name-directory file)) + (file-at-mark (and transient-mark-mode + mark-active + (save-excursion (goto-char (mark t)) + (dired-get-filename t t)))) + (last-backup (file-newest-backup file))) + (cond + (file-at-mark) + ((auto-save-file-name-p file-sans-dir) + (expand-file-name (substring file-sans-dir 1 -1) file-dir)) + ((backup-file-name-p file-sans-dir) + (expand-file-name (file-name-sans-versions file-sans-dir) file-dir)) + (last-backup) + (t file))))))) + (ediff-files (dired-get-filename) file2)) ; In `ediff.el'. + +(defun diredp-fewer-than-N-files-p (arg n) + "Return non-nil iff fewer than N files are to be treated by dired. +More precisely, return non-nil iff ARG is nil and fewer than N +files are marked, or the absolute value of ARG is less than N." + (if arg + (and (integerp arg) (< (abs arg) n)) ; Next or previous file (or none). + (not (save-excursion ; Fewer than two marked files. + (goto-char (point-min)) + (re-search-forward (dired-marker-regexp) nil t n))))) + +(defun diredp-fewer-than-2-files-p (arg) + "Return non-nil iff fewer than two files are to be treated by dired. +More precisely, return non-nil iff ARG is nil and fewer than two +files are marked, or ARG is -1, 0 or 1." + (diredp-fewer-than-N-files-p arg 2)) + +(defun diredp-fewer-than-echo-limit-files-p (arg) + "Return non-nil iff < `diredp-do-report-echo-limit' files marked. +More precisely, return non-nil iff ARG is nil and fewer than two +files are marked, or ARG is -1, 0 or 1." + (diredp-fewer-than-N-files-p arg diredp-do-report-echo-limit)) + +;;;###autoload +(defun diredp-do-apply-function (function &optional arg) ; Bound to `@' + "Apply FUNCTION to the marked files. +You are prompted for the FUNCTION. + +With a plain prefix ARG (`C-u'), visit each file and invoke FUNCTION + with no arguments. +Otherwise, apply FUNCTION to each file name. + +Any prefix arg other than single `C-u' behaves according to the ARG +argument of `dired-get-marked-files'. In particular, `C-u C-u' +operates on all files in the Dired buffer. + +The result returned for each file is logged by `dired-log'. Use `?' +to see all such results and any error messages. If there are fewer +marked files than `diredp-do-report-echo-limit' then each result is +also echoed momentarily." + (interactive (progn (diredp-ensure-mode) + (list (read (completing-read "Function: " obarray 'functionp nil nil + (and (boundp 'function-name-history) + 'function-name-history))) + current-prefix-arg))) + (let ((use-no-args-p (and (consp arg) (< (car arg) 16)))) + (when use-no-args-p (setq arg ())) + (save-selected-window + (diredp-map-over-marks-and-report + (if use-no-args-p #'diredp-invoke-function-no-args #'diredp-apply-function-to-file-name) + arg + 'apply\ function (diredp-fewer-than-2-files-p arg) + function + (diredp-fewer-than-echo-limit-files-p arg))))) + +(defun diredp-invoke-function-no-args (fun &optional echop) + "Visit file of this line at its beginning, then invoke function FUN. +No arguments are passed to FUN. +Log the result returned or any error. +Non-nil optional arg ECHOP means also echo the result." + (let* ((file (dired-get-filename)) + (failure (not (file-exists-p file))) + result) + (unless failure + (condition-case err + (with-current-buffer (find-file-noselect file) + (save-excursion + (goto-char (point-min)) + (setq result (funcall fun)))) + (error (setq failure err)))) + (diredp-report-file-result file result failure echop))) + +(defun diredp-apply-function-to-file-name (fun &optional echop) + "Apply function FUN to (absolute) file name on this line. +Log the result returned or any error. +Non-nil optional arg ECHOP means also echo the result." + (let ((file (dired-get-filename)) + (failure nil) + result) + (condition-case err + (setq result (funcall fun file)) + (error (setq failure err))) + (diredp-report-file-result file result failure echop))) + + +;; REPLACE ORIGINAL in `dired-aux.el'. +;; +;; 1. Redisplay only if at most one file is being treated. +;; 2. Doc string reflects `Dired+'s version of `dired-map-over-marks-check'. +;; +;;;###autoload +(defun dired-do-compress (&optional arg) ; Bound to `Z' + "Compress or uncompress marked (or next prefix argument) files. +A prefix argument ARG specifies files to use instead of marked. + An integer means use the next ARG files (previous -ARG, if < 0). + `C-u': Use the current file (whether or not any are marked). + `C-u C-u': Use all files in Dired, except directories. + `C-u C-u C-u': Use all files and directories, except `.' and `..'. + `C-u C-u C-u C-u': Use all files and all directories." + (interactive "P") + (dired-map-over-marks-check #'dired-compress arg 'compress (diredp-fewer-than-2-files-p arg))) + + +;; REPLACE ORIGINAL in `dired-aux.el'. +;; +;; 1. Redisplay only if at most one file is being treated. +;; 2. Doc string reflects `Dired+'s version of `dired-map-over-marks-check'. +;; +;;;###autoload +(defun dired-do-byte-compile (&optional arg) ; Bound to `B' + "Byte compile marked Emacs Lisp files. +A prefix argument ARG specifies files to use instead of those marked. + * An integer means use the next ARG files (previous -ARG, if < 0). + * Two or more `C-u' (e.g. `C-u C-u') means ignore any marks and use + all files in the Dired buffer. + * Any other prefix arg means use the current file." + (interactive (let* ((arg current-prefix-arg) + (C-u (and (consp arg) arg))) + (when (and C-u (> (prefix-numeric-value arg) 16)) (setq arg '(16))) + (list arg))) + (dired-map-over-marks-check #'dired-byte-compile arg 'byte-compile + (diredp-fewer-than-2-files-p arg))) + + +;; REPLACE ORIGINAL in `dired-aux.el'. +;; +;; 1. Redisplay only if at most one file is being treated. +;; 2. Doc string reflects `Dired+' version of `dired-map-over-marks-check'. +;; +;;;###autoload +(defun dired-do-load (&optional arg) ; Bound to `L' + "Load the marked Emacs Lisp files. +A prefix argument ARG specifies files to use instead of those marked. + * An integer means use the next ARG files (previous -ARG, if < 0). + * Two or more `C-u' (e.g. `C-u C-u') means ignore any marks and use + all files in the Dired buffer. + * Any other prefix arg means use the current file." + (interactive (let* ((arg current-prefix-arg) + (C-u (and (consp arg) arg))) + (when (and C-u (> (prefix-numeric-value arg) 16)) (setq arg '(16))) + (list arg))) + (dired-map-over-marks-check #'dired-load arg 'load (diredp-fewer-than-2-files-p arg))) + + +(when (fboundp 'multi-isearch-files) + + ;; REPLACE ORIGINAL in `dired.el': + ;; + ;; 1. Added optional arg ARG, so you can act on next ARG files or on all files. + ;; 2. Added optional arg INTERACTIVEP. + ;; 3. Do not raise error if no files when not INTERACTIVEP. + ;; + (defun dired-do-isearch (&optional arg interactivep) + "Search for a string through all marked files using Isearch. +A prefix argument ARG specifies files to use instead of those marked. + * An integer means use the next ARG files (previous -ARG, if < 0). + * Two or more `C-u' (e.g. `C-u C-u') means ignore any marks and use + all files in the Dired buffer. + * Any other prefix arg means use the current file. +When invoked interactively, raise an error if no files are marked." + (interactive (let* ((arg current-prefix-arg) + (C-u (and (consp arg) arg))) + (when (and C-u (> (prefix-numeric-value arg) 16)) (setq arg '(16))) + (list arg t))) + (multi-isearch-files (dired-get-marked-files nil arg 'dired-nondirectory-p nil interactivep))) + + + ;; REPLACE ORIGINAL in `dired.el': + ;; + ;; 1. Added optional arg ARG, so you can act on next ARG files or on all files. + ;; 2. Added optional arg INTERACTIVEP. + ;; 3. Do not raise error if no files when not INTERACTIVEP. + ;; + (defun dired-do-isearch-regexp (&optional arg interactivep) + "Search for a regexp through all marked files using Isearch. +A prefix arg behaves as follows: + * An integer means use the next ARG files (previous -ARG, if < 0). + * Two or more `C-u' (e.g. `C-u C-u') means ignore any marks and use + all files in the Dired buffer. + * Any other prefix arg means use the current file. +When invoked interactively, raise an error if no files are marked." + (interactive (let* ((arg current-prefix-arg) + (C-u (and (consp arg) arg))) + (when (and C-u (> (prefix-numeric-value arg) 16)) (setq arg '(16))) + (list arg t))) + (multi-isearch-files-regexp (dired-get-marked-files nil arg 'dired-nondirectory-p nil interactivep))) + + ) + + +;; REPLACE ORIGINAL in `dired-aux.el': +;; +;; 1. Added optional arg ARG, so you can act on next ARG files or on all files. +;; 2. Added optional arg INTERACTIVEP. +;; 3. Do not raise error if no files when not INTERACTIVEP. +;; +;;;###autoload +(defun dired-do-search (regexp &optional arg interactivep) + "Search through all marked files for a match for REGEXP. +Stops when a match is found. +To continue searching for next match, use command \\[tags-loop-continue]. + +A prefix arg behaves as follows: + * An integer means use the next ARG files (previous -ARG, if < 0). + * Two or more `C-u' (e.g. `C-u C-u') means ignore any marks and use + all files in the Dired buffer. + * Any other prefix arg means use the current file. + +When invoked interactively, raise an error if no files are marked." + (interactive (let* ((arg current-prefix-arg) + (C-u (and (consp arg) arg))) + (when (and C-u (> (prefix-numeric-value arg) 16)) (setq arg '(16))) + (list (diredp-read-regexp "Search marked files (regexp): ") + arg + t))) + (tags-search regexp `(dired-get-marked-files nil ',arg 'dired-nondirectory-p nil ,interactivep))) + + +;; REPLACE ORIGINAL in `dired-aux.el': +;; +;; 1. Added optional arg ARG, so you can act on next ARG files or on all files. +;; 2. Added optional arg INTERACTIVEP. +;; 3. Do not raise error if no files when not INTERACTIVEP. +;; +;;;###autoload +(defun dired-do-query-replace-regexp (from to &optional arg interactivep) + "Do `query-replace-regexp' of FROM with TO, on all marked files. +NOTE: A prefix arg for this command acts differently than for other +commands, so that you can use it to request word-delimited matches. + +With a prefix argument: + * An odd number of plain `C-u': act on the marked files, but replace + only word-delimited matches. + * More than one plain `C-u': act on all files, ignoring whether any + are marked. + * Any other prefix arg: Act on the next numeric-prefix files. + +So for example: + * `C-u C-u C-u': act on all files, replacing word-delimited matches. + * `C-u 4': act on the next 4 files. `C-4' means the same thing. + * `C-u': act on the marked files, replacing word-delimited matches. + +When invoked interactively, raise an error if no files are marked. + +If you exit (\\[keyboard-quit], RET or q), you can resume the query replace +with the command \\[tags-loop-continue]." + (interactive (let ((common (query-replace-read-args "Query replace regexp in marked files" t t))) + (list (nth 0 common) + (nth 1 common) + current-prefix-arg + t))) + (let* ((argnum (and (consp arg) (prefix-numeric-value arg))) + (delimited (and argnum (eq (logand (truncate (log argnum 4)) 1) 1))) ; Odd number of plain `C-u'. + (all (and argnum (> argnum 4))) ; At least 3 plain `C-u'. + (dgmf-arg (dired-get-marked-files nil + (if (and arg (atom arg)) (abs arg) (and all '(16))) + 'dired-nondirectory-p + nil + interactivep))) + (dolist (file dgmf-arg) + (let ((buffer (get-file-buffer file))) + (when (and buffer (with-current-buffer buffer buffer-read-only)) + (error "File `%s' is visited read-only" file)))) + (tags-query-replace from to delimited `',dgmf-arg))) + + +(when (fboundp 'xref-collect-matches) ; Emacs 25+ + + + ;; REPLACE ORIGINAL in `dired-aux.el': + ;; + ;; 1. Added optional arg ARG, so you can act on next ARG files or on all files. + ;; 2. Added optional arg INTERACTIVEP. + ;; 3. Do not raise error if no files when not INTERACTIVEP. + ;; + (defun dired-do-find-regexp (regexp &optional arg interactivep) + "Find all matches for REGEXP in all marked files. +For any marked directory, all of its files are searched recursively. +However, files matching `grep-find-ignored-files' and subdirectories +matching `grep-find-ignored-directories' are skipped in the marked +directories. + +A prefix arg behaves as follows: + * An integer means use the next ARG files (previous -ARG, if < 0). + * Two or more `C-u' (e.g. `C-u C-u') means ignore any marks and use + all files in the Dired buffer. + * Any other prefix arg means use the current file. + +When invoked interactively, raise an error if no files are marked. + +REGEXP should use constructs supported by your local `grep' command." + (interactive (let* ((arg current-prefix-arg) + (C-u (and (consp arg) arg))) + (when (and C-u (> (prefix-numeric-value arg) 16)) (setq arg '(16))) + (list (diredp-read-regexp "Search marked files (regexp): ") + arg + t))) + (require 'grep) + (defvar grep-find-ignored-files) + (defvar grep-find-ignored-directories) + (let* ((files (dired-get-marked-files nil arg nil nil interactivep)) + (ignores (nconc (mapcar (lambda (s) (concat s "/")) grep-find-ignored-directories) + grep-find-ignored-files)) + (xrefs (mapcan (lambda (file) + (xref-collect-matches + regexp "*" file (and (file-directory-p file) ignores))) + files))) + (if xrefs + (xref--show-xrefs xrefs nil t) + (when interactivep (diredp-user-error "No matches for: %s" regexp))))) + + + ;; REPLACE ORIGINAL in `dired-aux.el': + ;; + ;; 1. Added optional arg ARG, so you can act on next ARG files or on all files. + ;; 2. Added optional arg INTERACTIVEP. + ;; 3. Do not raise error if no files when not INTERACTIVEP. + ;; +;;;###autoload + (defun dired-do-find-regexp-and-replace (from to &optional arg interactivep) + "Replace matches of FROM with TO, in all marked files. +For any marked directory, matches in all of its files are replaced, +recursively. However, files matching `grep-find-ignored-files' +and subdirectories matching `grep-find-ignored-directories' are skipped +in the marked directories. + +A prefix arg behaves as follows: + * An integer means use the next ARG files (previous -ARG, if < 0). + * Two or more `C-u' (e.g. `C-u C-u') means ignore any marks and use + all files in the Dired buffer. + * Any other prefix arg means use the current file. + +When invoked interactively, raise an error if no files are marked. + +REGEXP should use constructs supported by your local `grep' command." + (interactive (let ((common (query-replace-read-args "Query replace regexp in marked files" t t)) + (arg current-prefix-arg) + (C-u (and (consp arg) arg))) + (when (and C-u (> (prefix-numeric-value arg) 16)) (setq arg '(16))) + (list (nth 0 common) + (nth 1 common) + arg + t))) + (with-current-buffer (dired-do-find-regexp from arg interactivep) + (xref-query-replace-in-results from to))) + + ) + +;;;###autoload +(defun diredp-do-grep (command-args) ; Bound to `C-M-G' + "Run `grep' on marked (or next prefix arg) files. +A prefix argument behaves according to the ARG argument of +`dired-get-marked-files'. In particular, `C-u C-u' operates on all +files in the Dired buffer." + (interactive (progn (unless (if (< emacs-major-version 22) + grep-command + (and grep-command (or (not grep-use-null-device) (eq grep-use-null-device t)))) + (grep-compute-defaults)) + (list (diredp-do-grep-1)))) + (grep command-args)) + +;; Optional arg FILES is no longer used. It was used in `diredp-do-grep' before the +;; new `dired-get-marked-files'. +(defun diredp-do-grep-1 (&optional files) + "Helper function for `diredp-do-grep'. +Non-nil optional arg FILES are the files to grep, overriding the files +choice described for `diredp-do-grep'." + (let ((default (and (fboundp 'grep-default-command) + (if (fboundp 'grepp-default-regexp-fn) ; In `grep+.el'. + (grep-default-command (funcall (grepp-default-regexp-fn))) + (grep-default-command))))) + (read-from-minibuffer + "grep : " + (let ((up-to-files (concat grep-command " "))) + (cons (concat up-to-files + (mapconcat #'identity + (or files (mapcar 'shell-quote-argument + (dired-get-marked-files nil current-prefix-arg))) + " ")) + (- (length up-to-files) 2))) + nil nil 'grep-history default))) + +(when (memq system-type '(windows-nt ms-dos)) + (define-derived-mode diredp-w32-drives-mode fundamental-mode "Drives" + "Mode for Dired buffer listing MS Windows drives (local or remote)." + (setq buffer-read-only t))) + +;; The next two commands were originally taken from Emacs Wiki, page WThirtyTwoBrowseNetDrives: +;; https://www.emacswiki.org/emacs/WThirtyTwoBrowseNetDrives. They are referred to there as +;; commands `show-net-connections' and `netdir'. I am hoping that the contributor (anonymous) +;; does not mind my adapting them and including them in `Dired+'. + +(when (memq system-type '(windows-nt ms-dos)) + (defun diredp-w32-list-mapped-drives () ; Not bound + "List network connection information for shared MS Windows resources. +This just invokes the Windows `NET USE' command." + (interactive) + (shell-command "net use") + (display-buffer "*Shell Command Output*"))) + +(when (memq system-type '(windows-nt ms-dos)) + (defun diredp-w32-drives (&optional other-window-p) ; Bound to `:/' + "Visit a list of MS Windows drives for use by Dired. +With a prefix argument use another window for the list. +In the list, use `mouse-2' or `RET' to open Dired for a given drive. + +The drives listed are the remote drives currently available, as +determined by the Windows command `NET USE', plus the local drives +specified by option `diredp-w32-local-drives', which you can +customize. + +Note: When you are in Dired at the root of a drive (e.g. directory + `C:/'), command `diredp-up-directory' invokes this command. + So you can use `\\[diredp-up-directory]' to go up to the list of drives." + (interactive "P") + (require 'widget) + (let ((drive (copy-sequence diredp-w32-local-drives)) + (inhibit-read-only t)) + (with-temp-buffer + (insert (shell-command-to-string "net use")) + (goto-char (point-min)) + (while (re-search-forward "[A-Z]: +\\\\\\\\[^ ]+" nil t nil) + (setq drive (cons (split-string (match-string 0)) drive)))) + (if other-window-p + (pop-to-buffer "*Windows Drives*") + (if (fboundp 'pop-to-buffer-same-window) + (pop-to-buffer-same-window "*Windows Drives*") + (switch-to-buffer "*Windows Drives*"))) + (erase-buffer) + (widget-minor-mode 1) + (dolist (drv (sort drive (lambda (a b) (string-lessp (car a) (car b))))) + (lexical-let ((drv drv)) + (widget-create 'push-button + :notify (lambda (widget &rest ignore) (dired (car drv))) + (concat (car drv) " " (cadr drv)))) + (widget-insert "\n")) + (goto-char (point-min)) + (diredp-w32-drives-mode)))) + +;; $$$$$$ NO LONGER USED. Was used in `diredp-do-grep(-1)' before new `dired-get-marked-files'. +(defun diredp-all-files () + "List of all files shown in current Dired buffer. +Directories are not included." + (let ((pos (make-marker)) + (files ()) + file) + (save-excursion + (goto-char (point-min)) (beginning-of-line) + (while (not (eobp)) + (beginning-of-line) + (while (and (not (eobp)) (dired-between-files)) (forward-line 1)) + (save-excursion (forward-line 1) (move-marker pos (1+ (point)))) + (setq file (dired-get-filename nil t)) ; Non-nil second arg means "also . and ..". + (when file ; Remove directory portion if in same directory. + (setq file (dired-get-filename (dired-in-this-tree file default-directory) t))) + (unless (or (not file) (file-directory-p file)) (push file files)) + (goto-char pos)) + (move-marker pos nil)) + (setq files (sort files (if (and (featurep 'ls-lisp) + (not (symbol-value 'ls-lisp-use-insert-directory-program))) + 'ls-lisp-string-lessp + (if case-fold-search + (lambda (s1 s2) (string-lessp (upcase s1) (upcase s2))) + 'string-lessp)))))) + +(when (fboundp 'read-char-choice) ; Emacs 24+ + + + ;; REPLACE ORIGINAL in `dired-aux.el' + ;; + ;; `l' lists the files involved and prompts again. + ;; + (defun dired-query (sym prompt &rest args) + "Format PROMPT with ARGS, query user, and store the result in SYM. +The return value is either nil or t. + +The user can type: + `y' or `SPC' to accept once + `n' or `DEL' to skip once + `!' to accept this and subsequent queries + `l' list the files, showing details per `diredp-list-file-attributes' + `q' or `ESC' to decline this and subsequent queries + +If SYM is already bound to a non-nil value, this function may return +automatically without querying the user. If SYM is `!', return t; if +SYM is `q' or ESC, return nil." + (let* ((char (symbol-value sym)) + (char-choices '(?y ?\ ?n ?\177 ?! ?l ?q ?\e)) ; Use ?\ , not ?\s, for Emacs 20 byte-compiler. + (list-buf (generate-new-buffer-name "*Files*")) + (list-was-shown nil)) + (unwind-protect + (cond ((eq char ?!) t) ; Accept, and don't ask again. + ((memq char '(?q ?\e)) nil) ; Skip, and don't ask again. + (t ; No previous answer - ask now + (setq prompt (concat (apply (if (fboundp 'format-message) #'format-message #'format) + prompt + args) + (if help-form + (format " [Type ynlq! or %s] " (key-description (vector help-char))) + " [Type y, n, l, q or !] "))) + (set sym (setq char (read-char-choice prompt char-choices))) + (when (eq char ?l) ; List files and prompt again. + (diredp-list-files args nil nil nil diredp-list-file-attributes) + (set sym (setq char (read-char-choice prompt char-choices)))) + (and (memq char '(?y ?\ ?!)) t))) ; Use ?\ , not ?\s, for Emacs 20. + (when (get-buffer list-buf) + (save-window-excursion + (pop-to-buffer list-buf) + (condition-case nil ; Ignore error if user already deleted. + (if (one-window-p) (delete-frame) (delete-window)) + (error nil)) + (if list-was-shown (bury-buffer list-buf) (kill-buffer list-buf))))))) + + ) + +(unless (fboundp 'read-char-choice) ; Emacs 20-23 (modified the Emacs 23 version). Needs `dired-query-alist'. + + + ;; REPLACE ORIGINAL in `dired-aux.el' + ;; + ;; 1. `l' lists the files involved and prompts again. + ;; 2. Compatible with older Emacs versions (before Emacs 24): can use `dired-query-alist'. + ;; + (defun dired-query (qs-var qs-prompt &rest qs-args) + "Query user and return nil or t. +The user can type: + `y' or `SPC' to accept once + `n' or `DEL' to skip once + `!' to accept this and subsequent queries + `l' list the files, showing details per `diredp-list-file-attributes' + `q' or `ESC' to decline this and subsequent queries + +Store answer in symbol VAR (which must initially be bound to nil). +Format PROMPT with ARGS. +Binding variable `help-form' will help the user who types the help key." + (let* ((char (symbol-value qs-var)) + (dired-query-alist (cons '(?l . l) dired-query-alist)) + (action (cdr (assoc char dired-query-alist)))) + (cond ((eq 'yes action) t) ; Accept, and don't ask again. + ((eq 'no action) nil) ; Skip, and don't ask again. + (t ; No lasting effects from last time we asked - ask now. + (let ((cursor-in-echo-area t) + (executing-kbd-macro executing-kbd-macro) + (qprompt (concat qs-prompt + (if help-form + (format " [Type ynl!q or %s] " + (key-description (char-to-string help-char))) + " [Type y, n, l, q or !] "))) + done result elt) + (while (not done) + (apply #'message qprompt qs-args) + (setq char (set qs-var (read-event))) + (when (eq char ?l) ; List files and prompt again. + (diredp-list-files qs-args nil nil nil diredp-list-file-attributes) + (apply #'message qprompt qs-args) + (setq char (set qs-var (read-event)))) + (if (numberp char) + (cond ((and executing-kbd-macro (= char -1)) + ;; `read-event' returns -1 if we are in a keyboard macro and there are no more + ;; events in the macro. Try to get an event interactively. + (setq executing-kbd-macro nil)) + ((eq (key-binding (vector char)) 'keyboard-quit) (keyboard-quit)) + (t (setq done (setq elt (assoc char dired-query-alist))))))) + ;; Display the question with the answer. + (message "%s" (concat (apply #'format qprompt qs-args) (char-to-string char))) + (memq (cdr elt) '(t y yes))))))) + + ) + + +;; REPLACE ORIGINAL in `dired-aux.el'. +;; +;; 1. Use `diredp-this-subdir' instead of `dired-get-filename'. +;; 2. If on a subdir listing header line or a non-dir file in a subdir listing, go to +;; the line for the subdirectory in the parent directory listing. +;; 3. Fit one-window frame after inserting subdir. +;; +;;;###autoload +(defun dired-maybe-insert-subdir (dirname &optional switches no-error-if-not-dir-p) + ; Bound to `i' + "Move to Dired subdirectory line or subdirectory listing. +This bounces you back and forth between a subdirectory line and its +inserted listing header line. Using it on a non-directory line in a +subdirectory listing acts the same as using it on the subdirectory +header line. + +* If on a subdirectory line, then go to the subdirectory's listing, + creating it if not yet present. + +* If on a subdirectory listing header line or a non-directory file in + a subdirectory listing, then go to the line for the subdirectory in + the parent directory listing. + +* If on a non-directory file in the top Dired directory listing, do + nothing. + +Subdirectories are listed in the same position as for `ls -lR' output. + +With a prefix arg, you can edit the `ls' switches used for this +listing. Add `R' to the switches to expand the directory tree under a +subdirectory. + +Dired remembers the switches you specify with a prefix arg, so +reverting the buffer does not reset them. However, you might +sometimes need to reset some subdirectory switches after a +`dired-undo'. You can reset all subdirectory switches to the +default value using \\\\[dired-reset-subdir-switches]. See \ +Info node +`(emacs)Subdir switches' for more details." + (interactive (list (diredp-this-subdir) + (and current-prefix-arg + (read-string "Switches for listing: " + (or (and (boundp 'dired-subdir-switches) dired-subdir-switches) + dired-actual-switches))))) + (let ((opoint (point)) + (filename dirname)) + (cond ((consp filename) ; Subdir header line or non-directory file. + (setq filename (car filename)) + (if (assoc filename dired-subdir-alist) + (dired-goto-file filename) ; Subdir header line. + (dired-insert-subdir (substring (file-name-directory filename) 0 -1)))) + (t + ;; We don't need a marker for opoint as the subdir is always + ;; inserted *after* opoint. + (setq dirname (file-name-as-directory dirname)) + (or (and (not switches) (dired-goto-subdir dirname)) + (dired-insert-subdir dirname switches no-error-if-not-dir-p)) + ;; Push mark so that it's easy to go back. Do this after the + ;; insertion message so that the user sees the `Mark set' message. + (push-mark opoint) + (when (and (get-buffer-window (current-buffer)) ; Fit one-window frame. + (fboundp 'fit-frame-if-one-window)) ; In `autofit-frame.el'. + (fit-frame-if-one-window)))))) + +(defun diredp-this-subdir () + "This line's filename, if directory, or `dired-current-directory' list. +If on a directory line, then return the directory name. +Else return a singleton list of a directory name, which is as follows: + If on a subdirectory header line (either of the two lines), then use + that subdirectory name. Else use the parent directory name." + (or (let ((file (dired-get-filename nil t))) + (and file + (file-directory-p file) + (not (member (file-relative-name file (file-name-directory (directory-file-name file))) + '("." ".." "./" "../"))) + file)) + (list (dired-current-directory)))) + + +;; REPLACE ORIGINAL in `dired-aux.el' +;; +;; 1. Added optional arg FROM, which is also listed by `l' when prompted. +;; 2. Added missing doc string. +;; +(defun dired-handle-overwrite (to &optional from) + "Save old version of file TO that is to be overwritten. +`dired-overwrite-confirmed' and `overwrite-backup-query' are fluid vars +from `dired-create-files'. + +Optional arg FROM is a file being copied or renamed to TO. It is used +only when a user hits `l' to list files when asked whether to +overwrite." + (let (backup) + (when (and dired-backup-overwrite + dired-overwrite-confirmed + (setq backup (car (find-backup-file-name to))) + (or (eq 'always dired-backup-overwrite) + (dired-query 'overwrite-backup-query "Make backup for existing file `%s'? " to from))) + (rename-file to backup 0) ; Confirm overwrite of old backup. + (dired-relist-entry backup)))) + + +(when (fboundp 'dired-copy-file-recursive) ; Emacs 22+ + + + ;; REPLACE ORIGINAL in `dired-aux.el' + ;; + ;; 1. Pass also FROM to `dired-handle-overwrite', so `l' lists it too. + ;; 2. Added missing doc string. + ;; + (defun dired-copy-file (from to ok-if-already-exists) + "Copy file FROM to location TO. +Non-nil arg OK-IF-ALREADY-EXISTS is passed to `copy-file' or + `make-symbolic-link'. +Preserves the last-modified date when copying, unless +`dired-copy-preserve-time' is nil." + (dired-handle-overwrite to from) + (dired-copy-file-recursive from to ok-if-already-exists dired-copy-preserve-time t dired-recursive-copies)) + + + ;; REPLACE ORIGINAL in `dired-aux.el' + ;; + ;; 1. Pass also FROM to `dired-handle-overwrite', so `l' lists it too. + ;; 2. Added missing doc string. + ;; + (defun dired-copy-file-recursive (from to ok-if-already-exists &optional keep-time top recursive) + "Copy file FROM to location TO, handling directories in FROM recursively. +Non-nil arg OK-IF-ALREADY-EXISTS is passed to `copy-file' or + `make-symbolic-link'. +Non-nil optional arg KEEP-TIME is passed to `copy-file' or + `copy-directory'. +Non-nil optional arg TOP means do not bother with `dired-handle-overwrite'. +Non-nil optional arg RECURSIVE means recurse on any directories in + FROM, after confirmation if RECURSIVE is not `always'." + (when (and (eq t (car (file-attributes from))) (file-in-directory-p to from)) + (error "Cannot copy `%s' into its subdirectory `%s'" from to)) + (let ((attrs (file-attributes from))) + (if (and recursive + (eq t (car attrs)) + (or (eq recursive 'always) (yes-or-no-p (format "Recursive copies of %s? " from)))) + (copy-directory from to keep-time) + (or top (dired-handle-overwrite to from)) + (condition-case err + (if (stringp (car attrs)) ; It is a symlink + (make-symbolic-link (car attrs) to ok-if-already-exists) + (copy-file from to ok-if-already-exists keep-time)) + (file-date-error + (push (dired-make-relative from) dired-create-files-failures) + (dired-log "Can't set date on %s:\n%s\n" from err)))))) + + ) + + +;; REPLACE ORIGINAL in `dired-aux.el' +;; +;; 1. Pass also FILE to `dired-handle-overwrite', so `l' lists it too. +;; 2. Added missing doc string. +;; +(defun dired-rename-file (file newname ok-if-already-exists) + "Rename FILE to NEWNAME. +Non-nil arg OK-IF-ALREADY-EXISTS is passed to `rename-file'." + (dired-handle-overwrite newname file) + (rename-file file newname ok-if-already-exists) ; Error is caught in `-create-files'. + ;; Silently rename the visited file of any buffer visiting this file. + (and (get-file-buffer file) (with-current-buffer (get-file-buffer file) (set-visited-file-name newname nil t))) + (dired-remove-file file) + ;; See if it's an inserted subdir, and rename that, too. + (dired-rename-subdir file newname)) + + +;; REPLACE ORIGINAL in `dired-aux.el' +;; +;; Pass also FILE to `dired-handle-overwrite', so `l' lists it too. +;; +(defun dired-hardlink (file newname &optional ok-if-already-exists) + "Give FILE additional name NEWNAME. +Non-nil arg OK-IF-ALREADY-EXISTS is passed to `add-name-to-file'." + (dired-handle-overwrite newname file) + (add-name-to-file file newname ok-if-already-exists) ; Error is caught in -create-files'. + (dired-relist-file file)) ; Update the link count. + + +;; REPLACE ORIGINAL in `dired.el'. +;; +;; No-op: does nothing now. +;; +(defun dired-insert-subdir-validate (dirname &optional switches)) + + +;;; $$$$$$$$ +;;; ;; REPLACE ORIGINAL in `dired-aux.el'. +;;; ;; +;;; ;; 1. Do not require that DIRNAME be in the current directory tree (no error if not). +;;; ;; 2. Use `dolist' instead of `mapcar'. +;;; ;; +;;; (defun dired-insert-subdir-validate (dirname &optional switches) +;;; "Raise an error if it is invalid to insert DIRNAME with SWITCHES." +;;; ;;; (or (dired-in-this-tree dirname (expand-file-name default-directory)) ; REMOVED +;;; ;;; (error "%s: not in this directory tree" dirname)) +;;; (let ((real-switches (or switches (and (boundp 'dired-subdir-switches) ; Emacs 22+ +;;; dired-subdir-switches)))) +;;; (when real-switches +;;; (let (case-fold-search) +;;; (dolist (switchs '("F" "b")) ; Switches that matter for `dired-get-filename'. +;;; (unless (eq (null (diredp-string-match-p switchs real-switches)) +;;; (null (diredp-string-match-p switchs dired-actual-switches))) +;;; (error "Can't have dirs with and without `-%s' switches together" switchs))))))) + + +;; REPLACE ORIGINAL in `dired-aux.el'. +;; +;; If NEW-DIR is not a descendant of a directory in the buffer, put it at eob. +;; +(defun dired-insert-subdir-newpos (new-dir) + "Move to the proper position for inserting NEW-DIR, and return it. +Respect the order within each directory tree. But if NEW-DIR is not a +descendant of any directory in the buffer, then put it at the end." + (let ((alist dired-subdir-alist) + elt dir new-pos) + (while alist + (setq elt (car alist) + alist (cdr alist) + dir (car elt)) + (if (dired-tree-lessp dir new-dir) + (setq new-pos (dired-get-subdir-max elt) ; Position NEW-DIR after DIR. + alist ()) + (setq new-pos (point-max)))) + (goto-char new-pos)) + (unless (eobp) (forward-line -1)) + (insert "\n") + (point)) + + +;; This is like original `dired-hide-subdir' in `dired-aux.el', except: +;; +;; 1. Plain prefix arg means invoke `dired-hide-all'. Added optional arg NEXT. +;; 2. Do not move to the next subdir. +;; 3. Modified to work with also with older Emacs versions. +;; +(defun diredp-hide-subdir-nomove (arg &optional next) + "Hide or unhide the current directory. +Unlike `dired-hide-subdir', this does not advance the cursor to the +next directory header line. + +With a plain prefix arg (`C-u'), invoke `dired-hide-all' to hide or + show everything. +With a numeric prefix arg N, hide this subdirectory and the next N-1 + subdirectories." + (interactive "P") + (dired-hide-check) + (if (consp arg) + (dired-hide-all 'IGNORED) ; Arg needed for older Emacs versions. + (setq arg (prefix-numeric-value arg)) + (let ((modflag (buffer-modified-p))) + (while (>= (setq arg (1- arg)) 0) + (let* ((cur-dir (dired-current-directory)) + (hidden-p (dired-subdir-hidden-p cur-dir)) + (elt (assoc cur-dir dired-subdir-alist)) + (end-pos (1- (dired-get-subdir-max elt))) + buffer-read-only) + (goto-char (dired-get-subdir-min elt)) ; Keep header line visible, hide rest + (skip-chars-forward "^\n\r") + (if hidden-p + (subst-char-in-region (point) end-pos ?\r ?\n) + (subst-char-in-region (point) end-pos ?\n ?\r))) + (when next (dired-next-subdir 1 t))) + (if (fboundp 'restore-buffer-modified-p) + (restore-buffer-modified-p modflag) + (set-buffer-modified-p modflag))))) + +;;; ---------------------- +;;; If we instead renamed `diredp-hide-subdir-nomove' to `dired-hide-subdir' as a replacement, +;;; then we would define things this way: +;;; +;;; +;;; ;; REPLACE ORIGINAL in `dired-aux.el'. +;;; ;; +;;; ;; 1. Plain prefix arg means invoke `dired-hide-all'. Added optional arg NEXT. +;;; ;; +;;; ;; 2. Do not move to the next subdir. +;;; ;; +;;; ;; 3. Modified to work with also with older Emacs versions. +;;; ;; +;;; (defun dired-hide-subdir (arg &optional next) +;;; "Hide or unhide the current directory. +;;; Unlike `diredp-hide-subdir-goto-next', this does not advance the +;;; cursor to the next directory header line. +;;; +;;; With a plain prefix arg (`C-u'), invoke `dired-hide-all' to hide or +;;; show everything. +;;; With a numeric prefix arg N, hide this subdirectory and the next N-1 +;;; subdirectories." +;;; (interactive "P") +;;; (dired-hide-check) +;;; (if (consp arg) +;;; (dired-hide-all 'IGNORED) ; Arg needed for older Emacs versions. +;;; (setq arg (prefix-numeric-value arg)) +;;; (let ((modflag (buffer-modified-p))) +;;; (while (>= (setq arg (1- arg)) 0) +;;; (let* ((cur-dir (dired-current-directory)) +;;; (hidden-p (dired-subdir-hidden-p cur-dir)) +;;; (elt (assoc cur-dir dired-subdir-alist)) +;;; (end-pos (1- (dired-get-subdir-max elt))) +;;; buffer-read-only) +;;; (goto-char (dired-get-subdir-min elt)) ; Keep header line visible, hide rest +;;; (skip-chars-forward "^\n\r") +;;; (if hidden-p +;;; (subst-char-in-region (point) end-pos ?\r ?\n) +;;; (subst-char-in-region (point) end-pos ?\n ?\r))) +;;; (when next (dired-next-subdir 1 t))) +;;; (if (fboundp 'restore-buffer-modified-p) +;;; (restore-buffer-modified-p modflag) +;;; (set-buffer-modified-p modflag))))) +;;; +;;; (defun diredp-hide-subdir-goto-next (arg) +;;; "Hide or unhide current directory and move to next directory header line." +;;; (interactive "P") +;;; (dired-hide-subdir arg 'NEXT)) +;;; ---------------------- + + +;; REPLACE ORIGINAL in `dired-x.el'. +;; +;; Fix the `interactive' spec. This is the Emacs 24+ version, provided for earlier versions. +;; +(unless (> emacs-major-version 23) + (defun dired-mark-unmarked-files (regexp msg &optional unflag-p localp) + "Mark unmarked files matching REGEXP, displaying MSG. +REGEXP is matched against the entire file name. When called +interactively, prompt for REGEXP. +With prefix argument, unflag all those files. + +Non-interactively: + Returns t if any work was done, nil otherwise. + Optional fourth argument LOCALP is as in `dired-get-filename'." + (interactive (list (diredp-read-regexp "Mark unmarked files matching regexp (default all): ") + nil + current-prefix-arg + nil)) + (let ((dired-marker-char (if unflag-p ?\ dired-marker-char)) + (unmarkedp (eq (char-after) ?\ ))) + (diredp-mark-if (and (if unflag-p (not unmarkedp) unmarkedp) ; Fixes Emacs bug #27465. + (let ((fn (dired-get-filename localp 'NO-ERROR))) ; Uninteresting + (and fn (diredp-string-match-p regexp fn)))) + msg)))) + + +;; REPLACE ORIGINAL in `dired-x.el'. +;; +;; 1. Call `dired-get-marked-files' with original ARG, to get its multi-`C-u' behavior. +;; 2. Doc string updated to reflect change to `dired-simultaneous-find-file'. +;; 3. Added optional arg INTERACTIVEP. +;; 4. Do not raise error if no files when not INTERACTIVEP. +;; +;;;###autoload +(defun dired-do-find-marked-files (&optional arg interactivep) ; Bound to `F' + "Find marked files, displaying all of them simultaneously. +With no prefix argument: + +* If `pop-up-frames' is nil then split the current window across all + marked files, as evenly as possible. Remaining lines go to the + bottom-most window. The number of files that can be displayed this + way is restricted by the height of the current window and + `window-min-height'. + +* If `pop-up-frames' is non-nil then show each marked file in a + separate frame (not window). + +With a prefix argument: + +* One or more plain `C-u' behaves as for `dired-get-marked-files'. + In particular, `C-u C-u' means ignore any markings and operate on + ALL files and directories (except `.' and `..') in the Dired buffer. + +* A numeric prefix arg >= 0 means just find (visit) the marked files - + do not show them. + +* A numeric prefix arg < 0 means show each marked file in a separate + frame (not window). (This is the same behavior as no prefix arg + with non-nil `pop-up-frames'.) + +Note that a numeric prefix argument acts differently with this command +than it does with other `dired-do-*' commands: it does NOT act on the +next or previous (abs ARG) files, ignoring markings. + +To keep the Dired buffer displayed, split the window (e.g., `C-x 2') +first. To show only the marked files, type `\\[delete-other-windows]' first. + +When invoked interactively, raise an error if no files are marked." + (interactive "P\np") + (dired-simultaneous-find-file + (dired-get-marked-files nil (and (consp arg) arg) nil nil interactivep) + (and arg (prefix-numeric-value arg)))) + + +;; REPLACE ORIGINAL in `dired-x.el'. +;; +;; Use separate frames instead of windows if `pop-up-frames' is non-nil, +;; or if prefix arg is negative. +;; +(defun dired-simultaneous-find-file (file-list option) + "Visit all files in list FILE-LIST and display them simultaneously. +With non-nil OPTION >= 0, the files are found (visited) but not shown. + +If `pop-up-frames' is non-nil or if OPTION < 0, use a separate frame +for each file. (See also option `diredp-max-frames'.) + +Otherwise, the current window is split across all files in FILE-LIST, +as evenly as possible. Remaining lines go to the bottom-most window. +The number of files that can be displayed this way is restricted by +the height of the current window and the value of variable +`window-min-height'." + ;; This is not interactive because it is usually too clumsy to specify FILE-LIST interactively unless via dired. + (let (size) + (cond ((and option (natnump option)) + (while file-list (find-file-noselect (car file-list)) (pop file-list))) + ((or pop-up-frames option) + (let ((nb-files (length file-list))) + (when (and (> nb-files diredp-max-frames) + (not (y-or-n-p (format "Really show %d files in separate frames? " nb-files)))) + (error "OK, canceled")) + (while file-list (find-file-other-frame (car file-list)) (pop file-list)))) + (t + (setq size (/ (window-height) (length file-list))) + (when (> window-min-height size) (error "Too many files to show simultaneously")) + (find-file (car file-list)) + (pop file-list) + (while file-list + ;; Vertically split off a window of desired size. Upper window will have SIZE lines. + ;; Select lower (larger) window. We split it again. + (select-window (split-window nil size)) + (find-file (car file-list)) + (pop file-list)))))) + + +;;;;;; REPLACE ORIGINAL in both `dired.el' and `dired-x.el': +;;;;;; +;;;;;; 1. This incorporates the `dired-x.el' change to the `dired.el' +;;;;;; definition. This version works with or without using dired-x. +;;;;;; The `dired-x.el' version respects the var `dired-find-subdir'. +;;;;;; When `dired-find-subdir' is non-nil, this version is the same +;;;;;; as the `dired-x.el' version, except that a bug is corrected: +;;;;;; Whenever the argument to `dired-find-buffer-nocreate' is a cons, +;;;;;; the call to `dired-buffers-for-dir' gave a wrong type error. +;;;;;; This has been avoided by not respecting `dired-find-subdir' +;;;;;; whenever `dired-find-buffer-nocreate' is a cons. +;;;;;; For the case when `dired-find-subdir' is nil, see #2, below. +;;;;;; +;;;;;; 2. Unless `dired-find-subdir' is bound and non-nil: +;;;;;; If both DIRNAME and `dired-directory' are conses, then only +;;;;;; compare their cars (directories), not their explicit file lists +;;;;;; too. If equal, then update `dired-directory's file list to that +;;;;;; of DIRNAME. +;;;;;; +;;;;;; This prevents `dired-internal-noselect' (which is currently +;;;;;; `dired-find-buffer-nocreate's only caller) from creating a new +;;;;;; buffer in this case whenever a different set of files is present +;;;;;; in the cdr of DIRNAME and DIRNAME represents the same buffer as +;;;;;; `dired-directory'. +;;;;;; +;;;;;; If only one of DIRNAME and `dired-directory' is a cons, then +;;;;;; this returns nil. +;;;;;;;###autoload +;;;;(defun dired-find-buffer-nocreate (dirname &optional mode) +;;;; (let ((atomic-dirname-p (atom dirname))) +;;;; (if (and (boundp 'dired-find-subdir) dired-find-subdir atomic-dirname-p) +;;;; ;; This is the `dired-x.el' change: +;;;; (let* ((cur-buf (current-buffer)) +;;;; (buffers (nreverse (dired-buffers-for-dir dirname))) +;;;; (cur-buf-matches (and (memq cur-buf buffers) +;;;; ;; Files list (wildcards) must match, too: +;;;; (equal dired-directory dirname)))) +;;;; (setq buffers (delq cur-buf buffers)) ; Avoid using same buffer--- +;;;; (or (car (sort buffers (function dired-buffer-more-recently-used-p))) +;;;; (and cur-buf-matches cur-buf))) ; ---unless no other possibility. +;;;; ;; Comment from `dired.el': +;;;; ;; This differs from `dired-buffers-for-dir' in that it doesn't consider +;;;; ;; subdirs of `default-directory' and searches for the first match only. +;;;; (let ((blist dired-buffers) ; was (buffer-list) +;;;; found) +;;;; (or mode (setq mode 'dired-mode)) +;;;; (while blist +;;;; (if (null (buffer-name (cdr (car blist)))) +;;;; (setq blist (cdr blist)) +;;;; (save-excursion +;;;; (set-buffer (cdr (car blist))) +;;;; (if (not (and (eq major-mode mode) +;;;; ;; DIRNAME and `dired-directory' have the same dir, +;;;; ;; and if either of them has an explicit file list, +;;;; ;; then both of them do. In that case, update +;;;; ;; `dired-directory's file list from DIRNAME. +;;;; (if atomic-dirname-p +;;;; (and (atom dired-directory) ; Both are atoms. +;;;; (string= (file-truename dirname) +;;;; (file-truename dired-directory))) +;;;; (and (consp dired-directory) ; Both are conses. +;;;; (string= +;;;; (file-truename (car dirname)) +;;;; (file-truename (car dired-directory))) +;;;; ;; Update `dired-directory's file list. +;;;; (setq dired-directory dirname))))) +;;;; (setq blist (cdr blist)) +;;;; (setq found (cdr (car blist))) +;;;; (setq blist nil))))) +;;;; found)))) + + +;; REPLACE ORIGINAL in `dired-x.el'. +;; +;; Require confirmation. Fixes Emacs bug #13561. +;; +(defun dired-do-run-mail () + "If `dired-bind-vm' is non-nil, call `dired-vm', else call `dired-rmail'." + (interactive) + (unless (y-or-n-p "Read all marked mail folders? ") (error "OK, canceled")) + (if dired-bind-vm + ;; Read mail folder using vm. + (dired-vm) + ;; Read mail folder using rmail. + (dired-rmail))) + + +;; REPLACE ORIGINAL in `dired.el'. +;; +;; 1. Put `mouse-face' on whole line, not just file name. +;; 2. Add text property `dired-filename' to only the file name. +;; 3. Show image-file preview on mouseover, if `tooltip-mode' +;; and if `diredp-image-preview-in-tooltip'. +;; +(defun dired-insert-set-properties (beg end) + "Add various text properties to the lines in the region. +Highlight entire line upon mouseover. +Add text property `dired-filename' to the file name. +Handle `dired-hide-details-mode' invisibility spec (Emacs 24.4+)." + (let ((inhibit-field-text-motion t)) ; Just in case. + (save-excursion + (goto-char beg) + (while (< (point) end) + (condition-case nil + (cond ((dired-move-to-filename) + (add-text-properties (line-beginning-position) (line-end-position) + '(mouse-face highlight help-echo diredp-mouseover-help)) + (put-text-property + (point) (save-excursion (dired-move-to-end-of-filename) (point)) + 'dired-filename t) + (when (fboundp 'dired-hide-details-mode) ; Emacs 24.4+ + (put-text-property (+ (line-beginning-position) 1) (1- (point)) + 'invisible 'dired-hide-details-detail) + (dired-move-to-end-of-filename) + (when (< (+ (point) 4) (line-end-position)) + (put-text-property (+ (point) 4) (line-end-position) + 'invisible 'dired-hide-details-link)))) + ((fboundp 'dired-hide-details-mode) ; Emacs 24.4+ + (unless (or (diredp-looking-at-p "^$") (diredp-looking-at-p dired-subdir-regexp)) + (put-text-property (line-beginning-position) (1+ (line-end-position)) + 'invisible 'dired-hide-details-information)))) + (error nil)) + (forward-line 1))))) + +(defun diredp-mouseover-help (window buffer pos) + "Show `help-echo' help for a file name, in Dired. +If `tooltip-mode' is on and `diredp-image-preview-in-tooltip' says to +show an image preview, then do so. Otherwise, show text help." + (let ((image-dired-thumb-width (or (and (wholenump diredp-image-preview-in-tooltip) + diredp-image-preview-in-tooltip) + image-dired-thumb-width)) + (image-dired-thumb-height (or (and (wholenump diredp-image-preview-in-tooltip) + diredp-image-preview-in-tooltip) + image-dired-thumb-height)) + file) + (or (and (boundp 'tooltip-mode) tooltip-mode + (fboundp 'image-file-name-regexp) ; Emacs 22+, `image-file.el'. + diredp-image-preview-in-tooltip + (condition-case nil + (and (with-current-buffer buffer + (save-excursion (goto-char pos) + (diredp-string-match-p + (image-file-name-regexp) + (setq file (if (derived-mode-p 'dired-mode) + (dired-get-filename nil 'NO-ERROR) + ;; Make it work also for `diredp-list-files' listings. + (buffer-substring-no-properties (line-beginning-position) + (line-end-position))))))) + (or (not diredp-auto-focus-frame-for-thumbnail-tooltip-flag) + (progn (select-frame-set-input-focus (window-frame window)) t)) + (let ((img-file (if (eq 'full diredp-image-preview-in-tooltip) + file + (diredp-image-dired-create-thumb file)))) + (propertize " " 'display (create-image img-file)))) + (error nil))) + (if (fboundp 'describe-file) ; Library `help-fns+.el' + "mouse-2: visit in another window, C-h RET: describe" + "mouse-2: visit this file/dir in another window")))) + +;; `dired-hide-details-mode' enhancements. +(when (fboundp 'dired-hide-details-mode) ; Emacs 24.4+ + + (defun diredp-hide-details-if-dired () + "In Dired mode hide details. Outside Dired, do nothing." + (when (derived-mode-p 'dired-mode) (dired-hide-details-mode 1))) + + ;; Use `eval' of list so file byte-compiled in Emacs 20 will be OK in later versions. + (eval '(define-globalized-minor-mode global-dired-hide-details-mode + dired-hide-details-mode diredp-hide-details-if-dired)) + + (eval '(define-minor-mode dired-hide-details-mode + "Hide details in Dired mode." + (and diredp-hide-details-propagate-flag diredp-hide-details-last-state) + :group 'dired + (unless (derived-mode-p 'dired-mode) (error "Not a Dired buffer")) + (dired-hide-details-update-invisibility-spec) + (setq diredp-hide-details-toggled t) + (when diredp-hide-details-propagate-flag + (setq diredp-hide-details-last-state dired-hide-details-mode)) + (if dired-hide-details-mode + (add-hook 'wdired-mode-hook 'dired-hide-details-update-invisibility-spec nil t) + (remove-hook 'wdired-mode-hook 'dired-hide-details-update-invisibility-spec t)))) + + (defun diredp-hide/show-details () + "Hide/show details according to user options. +If `diredp-hide-details-propagate-flag' is non-nil and details have +never been hidden in the buffer, then hide/show according to your last +hide/show choice in any other Dired buffer or, if no last choice, +according to option `diredp-hide-details-initially-flag'." + (unless (or diredp-hide-details-toggled ; No op if hide/show already set. + (buffer-narrowed-p)) ; No-op when showing just newly copied file etc. + (cond (diredp-hide-details-propagate-flag + (dired-hide-details-mode (if diredp-hide-details-last-state 1 -1))) + (diredp-hide-details-initially-flag + (dired-hide-details-mode 1))))) + + (add-hook 'dired-after-readin-hook #'diredp-hide/show-details) + + (defun diredp-fit-frame-unless-buffer-narrowed () + "Fit frame unless Dired buffer is narrowed. +Requires library `autofit-frame.el'." + (when (and (get-buffer-window (current-buffer)) (not (buffer-narrowed-p))) + (fit-frame-if-one-window))) + + ;; Fit frame only if not narrowed. Put it on this hook because `dired-hide-details-mode' is + ;; invoked from `dired-after-readin-hook' via `diredp-hide/show-details', even for an update + ;; such as copying a file, where buffer is narrowed when invoked. + (when (fboundp 'fit-frame-if-one-window) ; In `autofit-frame.el'. + (add-hook 'dired-hide-details-mode-hook #'diredp-fit-frame-unless-buffer-narrowed))) + + +;; REPLACE ORIGINAL in `dired.el'. +;; +;; Reset `mode-line-process' to nil. +;; +(when (< emacs-major-version 21) + (or (fboundp 'old-dired-revert) (fset 'old-dired-revert (symbol-function 'dired-revert))) + (defun dired-revert (&optional arg noconfirm) + (setq mode-line-process nil) ; Set by, e.g., `find-dired'. + (old-dired-revert arg noconfirm))) + +;; Like `dired-up-directory', but go up to MS Windows drive if in top-level directory. +;; +;;;###autoload +(defun diredp-up-directory (&optional other-window) ; Bound to `^' + "Run Dired on parent directory of current directory. +Find the parent directory either in this buffer or another buffer. +Creates a buffer if necessary. + +With a prefix arg, Dired the parent directory in another window. + +On MS Windows, if you are already at the root directory, invoke +`diredp-w32-drives' to visit a navigable list of Windows drives." + (interactive "P") + (let* ((dir (dired-current-directory)) + (up (file-name-directory (directory-file-name dir)))) + (or (dired-goto-file (directory-file-name dir)) + ;; Only try `dired-goto-subdir' if buffer has more than one dir. + (and (cdr dired-subdir-alist) (dired-goto-subdir up)) + (progn (if other-window (dired-other-window up) (dired up)) + (dired-goto-file dir)) + (and (memq system-type '(windows-nt ms-dos)) (diredp-w32-drives other-window))))) + +;;;###autoload +(defun diredp-up-directory-reuse-dir-buffer (&optional other-window) ; Not bound + "Like `diredp-up-directory', but reuse Dired buffers. +With a prefix arg, Dired the parent directory in another window. + +On MS Windows, moving up from a root Dired buffer does not kill that +buffer (the Windows drives buffer is not really a Dired buffer)." + (interactive "P") + (let* ((dir (dired-current-directory)) + (dirfile (directory-file-name dir)) + (up (file-name-directory dirfile))) + (or (dired-goto-file dirfile) + ;; Only try `dired-goto-subdir' if buffer has more than one dir. + (and (cdr dired-subdir-alist) (dired-goto-subdir up)) ; It is a subdir inserted in current Dired. + (progn (diredp--reuse-dir-buffer-helper up nil nil other-window) + (dired-goto-file dir)) + (and (memq system-type '(windows-nt ms-dos)) (diredp-w32-drives other-window))))) + +;; Differs from `dired-next-line' in both wraparound and respect of `goal-column'. +;; +;;;###autoload +(defun diredp-next-line (arg) ; Bound to `SPC', `n', `C-n', `down' + "Move down lines then position cursor at filename. +If `goal-column' is non-nil then put the cursor at that column. +Optional prefix ARG says how many lines to move; default is one line. + +If `diredp-wrap-around-flag' is non-nil then wrap around if none is +found before the buffer end (buffer beginning, if ARG is negative). +Otherwise, just move to the buffer limit." + (interactive (let ((narg (prefix-numeric-value current-prefix-arg))) + (when (and (boundp 'shift-select-mode) shift-select-mode) (handle-shift-selection)) ; Emacs 23+ + (list narg))) ; Equivalent to "^p" + (let* ((line-move-visual nil) + ;; (goal-column nil) + + ;; Use `condition-case' and `(progn... t)' because Emacs < 22 `line-move' has no + ;; NO-ERROR arg and it always returns nil. + (no-more (or (not (condition-case nil (progn (line-move arg) t) (error nil))) + (if (< arg 0) (bobp) (eobp))))) + (when (and diredp-wrap-around-flag no-more) + (let ((diredp-wrap-around-flag nil)) + (goto-char (if (< arg 0) (point-max) (point-min))) + (diredp-next-line arg))) + ;; We never want to move point into an invisible line. + (while (and (fboundp 'invisible-p) ; Emacs 22+ + (invisible-p (point)) + (not (if (and arg (< arg 0)) (bobp) (eobp)))) + (forward-char (if (and arg (< arg 0)) -1 1))) + (unless goal-column (dired-move-to-filename)))) + +;; In Emacs < 22, `C-p' does not wrap around, because it never moves to the first header line. +;;;###autoload +(defun diredp-previous-line (arg) ; Bound to `p', `C-p', `up' + "Move up lines then position cursor at filename. +If `goal-column' is non-nil then put the cursor at that column. +Optional prefix ARG says how many lines to move; default is one line. + +If `diredp-wrap-around-flag' is non-nil then wrap around if none is +found before the buffer beginning (buffer end, if ARG is negative). +Otherwise, just move to the buffer limit." + (interactive (let ((narg (prefix-numeric-value current-prefix-arg))) + (when (and (boundp 'shift-select-mode) shift-select-mode) (handle-shift-selection)) ; Emacs 23+ + (list narg))) ; Equivalent to "^p" + (diredp-next-line (- (or arg 1)))) + +;;;###autoload +(defun diredp-next-dirline (arg &optional opoint) ; Bound to `>' + "Goto ARGth next directory file line. +If `diredp-wrap-around-flag' is non-nil then wrap around if none is +found before the buffer beginning (buffer end, if ARG is negative). +Otherwise, raise an error or, if NO-ERROR-IF-NOT-FOUND is nil, return +nil." + (interactive (let ((narg (prefix-numeric-value current-prefix-arg))) + (when (and (boundp 'shift-select-mode) shift-select-mode) (handle-shift-selection)) ; Emacs 23+ + (list narg))) ; Equivalent to "^p" + (or opoint (setq opoint (point))) + (if (if (> arg 0) + (re-search-forward dired-re-dir nil t arg) + (beginning-of-line) + (re-search-backward dired-re-dir nil t (- arg))) + (dired-move-to-filename) ; user may type `i' or `f' + (if diredp-wrap-around-flag + (let ((diredp-wrap-around-flag nil)) + (goto-char (if (< arg 0) (point-max) (point-min))) + (diredp-next-dirline arg opoint)) + (goto-char opoint) + (error "No more subdirectories")))) + +;;;###autoload +(defun diredp-prev-dirline (arg) ; Bound to `<' + "Goto ARGth previous directory file line." + (interactive (let ((narg (prefix-numeric-value current-prefix-arg))) + (when (and (boundp 'shift-select-mode) shift-select-mode) (handle-shift-selection)) ; Emacs 23+ + (list narg))) ; Equivalent to "^p" + (diredp-next-dirline (- arg))) + +;;;###autoload +(defun diredp-next-subdir (arg &optional no-error-if-not-found no-skip) ; Bound to `C-M-n' + "Go to the next subdirectory, regardless of level. +If ARG = 0 then go to this directory's header line. + +If `diredp-wrap-around-flag' is non-nil then wrap around if none is +found before the buffer end (buffer beginning, if ARG is negative). +Otherwise, raise an error or, if NO-ERROR-IF-NOT-FOUND is nil, return +nil. + +Non-nil NO-SKIP means do not move to end of header line, and return +the position moved to so far." + (interactive (let ((narg (prefix-numeric-value current-prefix-arg))) + (when (and (boundp 'shift-select-mode) shift-select-mode) (handle-shift-selection)) ; Emacs 23+ + (list narg))) ; Equivalent to "^p" + (let ((this-dir (dired-current-directory)) + pos index) + ;; `nth' with negative arg does not return nil but the first element + (setq index (if diredp-wrap-around-flag + (mod (- (dired-subdir-index this-dir) arg) (length dired-subdir-alist)) + (- (dired-subdir-index this-dir) arg)) + pos (and (>= index 0) (dired-get-subdir-min (nth index dired-subdir-alist)))) + (if pos + (progn (goto-char pos) + (or no-skip (skip-chars-forward "^\n\r")) + (point)) + (if no-error-if-not-found + nil ; Return nil if not found + (error "%s directory" (if (> arg 0) "Last" "First")))))) + +;;;###autoload +(defun diredp-prev-subdir (arg &optional no-error-if-not-found no-skip) ; Bound to `C-M-p' + "Go to the previous subdirectory, regardless of level. +When called interactively and not on a subdir line, go to this subdir's line. +Otherwise, this is a mirror image of `diredp-next-subdir'." + ;;(interactive "^p") + (interactive + (list (if current-prefix-arg + (let ((narg (prefix-numeric-value current-prefix-arg))) + (when (and (boundp 'shift-select-mode) shift-select-mode) (handle-shift-selection)) ; Emacs 23+ + narg) ; Equivalent to "^p" + ;; If on subdir start already then do not stay there. + (if (dired-get-subdir) 1 0)))) + (diredp-next-subdir (- arg) no-error-if-not-found no-skip)) + + +;; REPLACE ORIGINAL in `dired.el'. +;; +;; 1. Test also ./ and ../, in addition to . and .., for error "Cannot operate on `.' or `..'". +;; 2. Hack for Emacs 20-22, to expand `~/...'. +;; +(defun dired-get-filename (&optional localp no-error-if-not-filep) + "In Dired, return name of file mentioned on this line. +Value returned normally includes the directory name. + +Optional arg LOCALP: + `no-dir' means do not include directory name in result. + `verbatim' means return the name exactly as it occurs in the buffer. + Any other non-nil value means construct the name relative to + `default-directory', which still might contain slashes if point is + in a subdirectory. + +Non-nil optional arg NO-ERROR-IF-NOT-FILEP means treat `.' and `..' as +regular filenames and return nil if there is no filename on this line. +Otherwise, an error occurs in these cases." + (let ((case-fold-search nil) + (already-absolute nil) + file p1 p2) + (save-excursion (when (setq p1 (dired-move-to-filename (not no-error-if-not-filep))) + (setq p2 (dired-move-to-end-of-filename no-error-if-not-filep)))) + ;; nil if no file on this line but `no-error-if-not-filep' is t: + (when (setq file (and p1 p2 (buffer-substring p1 p2))) + ;; Get rid of the mouse-face property that file names have. + (set-text-properties 0 (length file) nil file) + + ;; Unquote names quoted by `ls' or by `dired-insert-directory'. + ;; Prior to Emacs 23.3, this code was written using `read' (see commented code below), + ;; because that is faster than substituting \007 (4 chars) -> ^G (1 char) etc. in a loop. + ;; Unfortunately, that implementation required hacks such as dealing with filenames + ;; with quotation marks in their names. + (while (string-match (if (> emacs-major-version 21) + "\\(?:[^\\]\\|\\`\\)\\(\"\\)" ; Shy group: Emacs 22+. + "\\([^\\]\\|\\`\\)\\(\"\\)") + file) + (setq file (replace-match "\\\"" nil t file 1))) + + ;; $$$ This was the code for that unquoting prior to Emacs 23.3: + ;; (setq file (read (concat "\"" ; Some `ls -b' do not escape quotes. But GNU `ls' is OK. + ;; (or (dired-string-replace-match + ;; "\\([^\\]\\|\\`\\)\"" file "\\1\\\\\"" nil t) + ;; file) + ;; "\""))) + + ;; This sexp was added by Emacs 24, to fix bug #10469: + ;; Unescape any spaces escaped by `ls -b'. + ;; Other `-b' quotes, such as \t and \n, work transparently. + (when (dired-switches-escape-p dired-actual-switches) + (let ((start 0) + (rep "") + (shift -1)) + (when (eq localp 'verbatim) (setq rep "\\\\" + shift +1)) + (while (string-match "\\(\\\\\\) " file start) + (setq file (replace-match rep nil t file 1) + start (+ shift (match-end 0)))))) + + ;; $$$ This sexp was added by Emacs 23.3. + (when (memq system-type '(windows-nt ms-dos)) + (save-match-data + (let ((start 0)) + (while (string-match "\\\\" file start) + (aset file (match-beginning 0) ?/) + (setq start (match-end 0)))))) + + ;; $$$ This sexp was added by Emacs 23.3. + ;; Hence we don't need to worry about converting `\\' back to `\'. + (setq file (read (concat "\"" file "\""))) + + ;; Above `read' returns a unibyte string if FILE contains eight-bit-control/graphic chars. + (when (and (fboundp 'string-to-multibyte) ; Emacs 22 + enable-multibyte-characters + (not (multibyte-string-p file))) + (setq file (string-to-multibyte file)))) + (and file + (file-name-absolute-p file) + ;; A relative file name can start with ~. Do not treat it as absolute in this context. + (not (eq (aref file 0) ?~)) + (setq already-absolute t)) + (cond ((null file) nil) + ((eq localp 'verbatim) file) + ;; This is the essential `Dired+' change: Added ./ and ../, not just . and .. + ((and (not no-error-if-not-filep) (member file '("." ".." "./" "../"))) + (error "Cannot operate on `.' or `..'")) + ((and (eq localp 'no-dir) already-absolute) + (file-name-nondirectory file)) + (already-absolute + (let ((handler (find-file-name-handler file nil))) + ;; check for safe-magic property so that we won't + ;; put /: for names that don't really need them. + ;; For instance, .gz files when auto-compression-mode is on. + (if (and handler (not (get handler 'safe-magic))) + (concat "/:" file) + file))) + ((eq localp 'no-dir) file) + ((equal (dired-current-directory) "/") + (setq file (concat (dired-current-directory localp) file)) + (let ((handler (find-file-name-handler file nil))) + ;; check for safe-magic property so that we won't + ;; put /: for names that don't really need them. + ;; For instance, .gz files when auto-compression-mode is on. + (if (and handler (not (get handler 'safe-magic))) + (concat "/:" file) + file))) + ;; Ugly hack for Emacs < 23, for which `ls-lisp-insert-directory' can insert a subdir + ;; using `~/...'. Expand `~/' for return value. + ((and (< emacs-major-version 23) file (file-name-absolute-p file) + (eq (aref file 0) ?~)) + (expand-file-name file)) + (t + (concat (dired-current-directory localp) file))))) + + +;; REPLACE ORIGINAL in `dired.el'. +;; +;; 1. Fixes Emacs bug #7126: Did not work with arbitrary file list (cons arg to `dired'). +;; 2. Remove `/' from directory name before comparing with BASE. +;; +(when (< emacs-major-version 24) + (defun dired-goto-file (file) ; Bound to `j' + "Go to line describing file FILE in this Dired buffer. +FILE must be an absolute file name. +Return buffer position on success, else nil." + ;; Loses if FILE contains control chars like "\007" for which `ls' inserts "?" or "\\007" + ;; into the buffer, so we won't find it in the buffer. + (interactive (prog1 ; Let push-mark display its message + (list (expand-file-name (read-file-name "Goto file: " (dired-current-directory)))) + (push-mark))) + (unless (file-name-absolute-p file) (error "File name `%s' is not absolute" file)) + (setq file (directory-file-name file)) ; does no harm if no directory + (let* ((case-fold-search nil) + (dir (file-name-directory file)) + (found nil)) + ;; `Dired+': Added this sexp. + (save-excursion + (goto-char (point-min)) + (let ((search-string (replace-regexp-in-string "\^m" "\\^m" file nil t)) + (here nil)) + (setq search-string (replace-regexp-in-string "\\\\" "\\\\" search-string nil t)) + + ;; Escape whitespace. Added per Emacs 24 addition in `unless' code below: + (when (and (dired-switches-escape-p dired-actual-switches) + (diredp-string-match-p "[ \t\n]" search-string)) + ;; FIXME: fix this for all possible file names (embedded control chars etc). + ;; Need to escape everything that `ls -b' escapes. + (setq search-string (replace-regexp-in-string " " "\\ " search-string nil t) + search-string (replace-regexp-in-string "\t" "\\t" search-string nil t) + search-string (replace-regexp-in-string "\n" "\\n" search-string nil t))) + + ;; Use HERE to ensure we do not keep searching for a directory entry. + (while (and (not (eobp)) (not found) (not (equal here (point)))) + (setq here (point)) + (if (search-forward (concat " " search-string) nil 'NO-ERROR) + ;; Must move to filename since an (actually correct) match could have been + ;; elsewhere on the line (e.g. "-" would match somewhere in permission bits). + (setq found (dired-move-to-filename)) + ;; If this isn't the right line, move forward to avoid trying this line again. + (forward-line 1))))) + + (unless found + (save-excursion + ;; The difficulty here is to get the result of `dired-goto-subdir' without really + ;; calling it, if we don't have any subdirs. + (when (if (string= dir (expand-file-name default-directory)) + (goto-char (point-min)) + (and (cdr dired-subdir-alist) (dired-goto-subdir dir))) + (let ((base (file-name-nondirectory file)) + (boundary (dired-subdir-max)) + search-string) + (setq search-string (replace-regexp-in-string "\^m" "\\^m" base nil t) + search-string (replace-regexp-in-string "\\\\" "\\\\" search-string nil t)) + + ;; Escape whitespace. Sexp added by Emacs 24: + (when (and (dired-switches-escape-p dired-actual-switches) + (diredp-string-match-p "[ \t\n]" search-string)) + ;; FIXME: fix this for all possible file names (embedded control chars etc). + ;; Need to escape everything that `ls -b' escapes. + (setq search-string (replace-regexp-in-string " " "\\ " search-string nil t) + search-string (replace-regexp-in-string "\t" "\\t" search-string nil t) + search-string (replace-regexp-in-string "\n" "\\n" search-string nil t))) + (while (and (not found) + ;; Filenames are preceded by SPC. This makes the search faster + ;; (e.g. for the filename "-"!). + (search-forward (concat " " search-string) boundary 'move)) + ;; `Dired+': Remove `/' from filename, then compare with BASE. + ;; Match could have BASE just as initial substring or + ;; or in permission bits or date or not be a proper filename at all. + (if (and (dired-get-filename 'no-dir t) + (equal base (directory-file-name (dired-get-filename 'no-dir t)))) + ;; Must move to filename since an (actually correct) match could have been + ;; elsewhere on the line (e.g. "-" would match somewhere in permission bits). + (setq found (dired-move-to-filename)) + ;; If this is not the right line, move forward to avoid trying this line again. + (forward-line 1))))))) + (and found (goto-char found))))) ; Return buffer position, or nil if not found. + + +;; REPLACE ORIGINAL in `dired.el'. +;; +;; If destination is in a hidden dir listing, open that listing and move to destination in it. +;; +(unless (< emacs-major-version 24) + (defun dired-goto-file (file) + "Go to line describing file FILE in this Dired buffer. +FILE must be an absolute file name. +Return buffer position on success, else nil." + ;; Loses if FILE contains control chars like "\007" for which `ls' inserts "?" or "\\007" + ;; into the buffer, so we won't find it in the buffer. + (interactive (prog1 (list (expand-file-name (read-file-name "Goto file: " (dired-current-directory)))) + (push-mark))) ; Let push-mark display its message. + (unless (file-name-absolute-p file) (error "File name `%s' is not absolute" file)) + (setq file (directory-file-name file)) ; Does no harm if not a directory + (let* ((case-fold-search nil) + (dir (file-name-directory file)) + (found + (or + ;; First, look for a listing under the absolute name. + (save-excursion (goto-char (point-min)) (dired-goto-file-1 file file (point-max))) + ;; Else look for it as a relative name. The difficulty is to get the result + ;; of `dired-goto-subdir' without calling it, if we don't have any subdirs. + (save-excursion + (when (if (string= dir (expand-file-name default-directory)) + (goto-char (point-min)) + (and (cdr dired-subdir-alist) (dired-goto-subdir dir))) + (when (dired-subdir-hidden-p (dired-current-directory)) + (diredp-hide-subdir-nomove 1)) ; Open hidden parent directory. + (dired-goto-file-1 (file-name-nondirectory file) file (dired-subdir-max))))))) + (and found (goto-char found))))) ; Return buffer position, or nil if not found. + + +;; REPLACE ORIGINAL in `dired.el': +;; +;; 1. Display a message to warn that flagged, not marked, files will be deleted. +;; 2. Use `diredp-internal-do-deletions', so it works with all Emacs versions. +;; +;;;###autoload +(defun dired-do-flagged-delete (&optional no-msg) ; Bound to `x' + "In Dired, delete the files flagged for deletion. +NOTE: This deletes flagged, not marked, files. +If arg NO-MSG is non-nil, no message is displayed. + +User option `dired-recursive-deletes' controls whether deletion of +non-empty directories is allowed." + (interactive) + (unless no-msg + (ding) + (message "NOTE: Deletion of files flagged `%c' (not those marked `%c')" + dired-del-marker dired-marker-char) + ;; Too slow/annoying, but without it the message is never seen: (sit-for 2) + ) + (let* ((dired-marker-char dired-del-marker) + (regexp (dired-marker-regexp)) + (case-fold-search nil)) + (if (save-excursion (goto-char (point-min)) (re-search-forward regexp nil t)) + (diredp-internal-do-deletions + ;; This cannot move point since last arg is nil. + (dired-map-over-marks (cons (dired-get-filename) (point)) nil) + nil + 'USE-TRASH-CAN) ; This arg is for Emacs 24+ only. + (unless no-msg (message "(No deletions requested.)"))))) + + +;; REPLACE ORIGINAL in `dired.el': +;; +;; 1. Display a message to warn that marked, not flagged, files will be deleted. +;; 2. Use `diredp-internal-do-deletions', so it works with all Emacs versions. +;; +;;;###autoload +(defun dired-do-delete (&optional arg) ; Bound to `D' + "Delete all marked (or next ARG) files. +NOTE: This deletes marked, not flagged, files. +`dired-recursive-deletes' controls whether deletion of +non-empty directories is allowed." + (interactive "P") + ;; This is more consistent with the file-marking feature than + ;; `dired-do-flagged-delete'. But it can be confusing to the user, + ;; especially since this is usually bound to `D', which is also the + ;; `dired-del-marker'. So offer this warning message: + (unless arg + (ding) + (message "NOTE: Deletion of files marked `%c' (not those flagged `%c')." + dired-marker-char dired-del-marker)) + (diredp-internal-do-deletions + ;; This can move point if ARG is an integer. + (dired-map-over-marks (cons (dired-get-filename) (point)) arg) + arg + 'USE-TRASH-CAN)) ; This arg is for Emacs 24+ only. + +(defun diredp-internal-do-deletions (file-alist arg &optional trash) + "`dired-internal-do-deletions', but for any Emacs version. +FILE-ALIST is an alist of files to delete, with their buffer positions. +ARG is the prefix arg. Filenames are absolute. +Non-nil TRASH means use the trash can." + ;; \(car FILE-ALIST) *must* be the *last* (bottommost) file in the dired + ;; buffer. That way as changes are made in the buffer they do not shift + ;; the lines still to be changed, so the (point) values in FILE-ALIST + ;; stay valid. Also, for subdirs in natural order, a subdir's files are + ;; deleted before the subdir itself - the other way around would not work." + (setq file-alist (delq nil file-alist)) ; nils could come from `dired-map-over-marks'. + (if (> emacs-major-version 23) + (dired-internal-do-deletions file-alist arg trash) + (dired-internal-do-deletions file-alist arg))) + + +;; REPLACE ORIGINAL in `dired.el': +;; +;; Put window point at bob. Fixes bug #12281. +;; +(when (and (> emacs-major-version 22) (or (< emacs-major-version 24) + (and (= emacs-major-version 24) (= emacs-minor-version 1)))) + (defun dired-pop-to-buffer (buf) + "Pop up buffer BUF in a way suitable for Dired." + (let ((split-window-preferred-function + (lambda (window) + (or (and (let ((split-height-threshold 0)) (window-splittable-p (selected-window))) + ;; Try to split the selected window vertically if that's possible. (Bug#1806) + (if (fboundp 'split-window-below) (split-window-below) (split-window-vertically))) + (split-window-sensibly window)))) + pop-up-frames) + (pop-to-buffer (get-buffer-create buf))) + (set-window-start (selected-window) (point-min)) + (when dired-shrink-to-fit + ;; Try to not delete window when we want to display less than `window-min-height' lines. + (fit-window-to-buffer (get-buffer-window buf) nil 1)))) + + +;; REPLACE ORIGINAL in `dired.el': +;; +;; 1. Delete the window or frame popped up, afterward, and bury its buffer. +;; Fixes Emacs bug #7533. +;; +;; 2, If buffer is shown in a separate frame, do not show a menu bar for that frame. +;; +(defun dired-mark-pop-up (buffer-or-name op-symbol files function &rest args) + "Return FUNCTION's result on ARGS after showing which files are marked. +Displays the file names in a buffer named BUFFER-OR-NAME, the default +name being \" *Marked Files*\". The buffer is not shown if there is +just one file, `dired-no-confirm' is t, or OP-SYMBOL is a member of +the list in `dired-no-confirm'. Uses function `dired-pop-to-buffer' +to show the buffer. + +The window is not shown if there is just one file, `dired-no-confirm' +is `t', or OP-SYMBOL is a member of `dired-no-confirm'. + +FILES is the list of marked files. It can also be (t FILENAME) +in the case of one marked file, to distinguish that from using +just the current file. + +FUNCTION should not manipulate the files. It should just read input +\(an argument or confirmation)." + (unless buffer-or-name (setq buffer-or-name " *Marked Files*")) + (let (result) + (if (or (eq dired-no-confirm t) + (memq op-symbol dired-no-confirm) + ;; If FILES defaulted to the current line's file. + (= (length files) 1)) + (setq result (apply function args)) + (with-current-buffer (get-buffer-create buffer-or-name) + (erase-buffer) + ;; Handle (t FILE) just like (FILE), here. That value is used (only in some cases), + ;; to mean just one file that was marked, rather than the current-line file. + (dired-format-columns-of-files (if (eq (car files) t) (cdr files) files)) + (remove-text-properties (point-min) (point-max) + '(mouse-face nil help-echo nil))) + (unwind-protect + (save-window-excursion + ;; Do not show menu bar, if buffer is popped up in a separate frame. + (let ((special-display-frame-alist (cons '(menu-bar-lines . 0) + special-display-frame-alist)) + (default-frame-alist (cons '(menu-bar-lines . 0) + default-frame-alist))) + (dired-pop-to-buffer buffer-or-name) + ;; Work around Emacs 22 bug in `dired-pop-to-buffer', which can exit with Dired buffer current. + (set-buffer buffer-or-name) + (goto-char (point-min))) + (setq result (apply function args))) + (save-excursion + (condition-case nil ; Ignore error if user already deleted window. + (progn (select-window (get-buffer-window buffer-or-name 0)) + (if (one-window-p) (delete-frame) (delete-window))) + (error nil))) + (bury-buffer buffer-or-name))) + result)) + + +;; REPLACE ORIGINAL in `dired.el': +;; +;; 1. Prefix arg has more possibilities. +;; 2, Added optional arg LOCALP, so you can mark/unmark matching different file-name forms. +;; 3. Push REGEXP onto `regexp-search-ring'. +;; +;;;###autoload +(defun dired-mark-files-regexp (regexp &optional marker-char localp) + "Mark all file names matching REGEXP for use in later commands. +`.' and `..' are never marked or unmarked by this command. + +Whether to mark or unmark, and what form of file name to match, are +governed by the prefix argument. For this, a plain (`C-u') or a +double-plain (`C-u C-u') prefix arg is considered only as such - it is +not considered numerically. + +Whether to mark or unmark: + + - No prefix arg, a positive arg, or a negative arg means mark. + + - Plain (`C-u'), double-plain (`C-u C-u'), or zero (e.g. `M-0' means + unmark. + +The form of a file name used for matching: + + - No prefix arg (to mark) or a plain prefix arg (`C-u', to unmark) + means use the relative file name (no directory part). + + - A negative arg (e.g. `M--', to mark) or a zero arg (e.g. `M-0', to + unmark) means use the absolute file name, that is, including all + directory components. + + - A positive arg (e.g. `M-+', to mark) or a double plain arg (`C-u + C-u', to unmark) means construct the name relative to + `default-directory'. For an entry in an inserted subdir listing, + this means prefix the relative file name (no directory part) with + the subdir name relative to `default-directory'. + +Note that the default matching behavior of this command is different +for Dired+ than it is for vanilla Emacs. Using a positive prefix arg +or a double plain prefix arg (`C-u C-u') gives you the same behavior +as vanilla Emacs (marking or unmarking, respectively): matching +against names that are relative to the `default-directory'. + +What Dired+ offers in addition is the possibility to match against +names that are relative (have no directory part - no prefix arg or +`C-u' to mark and unmark, respectively) or absolute (`M--' or `M-0', +respectively). The default behavior uses relative names because this +is likely to be the more common use case. But matching against +absolute names gives you more flexibility. + +REGEXP is an Emacs regexp, not a shell wildcard. Thus, use `\\.o$' +for object files--just `.o' might mark more than you might expect. + +REGEXP is added to `regexp-search-ring', for regexp search. + +Non-interactively: + MARKER-CHAR is the marker character - used for `dired-marker-char'. + LOCALP is passed to `dired-get-filename'. It determines the form of + filename that is matched against REGEXP." + (interactive (let* ((raw current-prefix-arg) + (C-u (and (consp raw) (= 4 (car raw)))) + (C-u-C-u (and (consp raw) (= 16 (car raw)))) + (num (and raw (prefix-numeric-value raw)))) + (list (diredp-read-regexp (concat (if (or (consp raw) (and num (zerop num))) + "UNmark" + "Mark") + " files (regexp): ")) + (and raw (or C-u C-u-C-u (zerop num)) ?\040) + (cond ((or (not raw) C-u) t) ; none, `C-u' + ((> num 0) nil) ; `M-+', `C-u C-u' + (t 'no-dir))))) ; `M--', `M-0' + (add-to-list 'regexp-search-ring regexp) ; Add REGEXP to `regexp-search-ring'. + (let ((dired-marker-char (or marker-char dired-marker-char))) + (diredp-mark-if (and (not (diredp-looking-at-p dired-re-dot)) + (not (eolp)) ; Empty line + (let ((fn (dired-get-filename localp t))) + (and fn (diredp-string-match-p regexp fn)))) + "file"))) + + +;; REPLACE ORIGINAL in `dired.el': +;; +;; Use `diredp-mark-if', not `dired-mark-if'. +;; +;;;###autoload +(defun dired-mark-files-containing-regexp (regexp &optional marker-char) + "Mark files with contents containing a REGEXP match. +A prefix argument means unmark them instead. +`.' and `..' are never marked. + +If a file is visited in a buffer and `dired-always-read-filesystem' is +nil, this looks in the buffer without revisiting the file, so the +results might be inconsistent with the file on disk if its contents +have changed since it was last visited." + (interactive + (list (diredp-read-regexp (concat (if current-prefix-arg "Unmark" "Mark") " files containing (regexp): ") + nil 'dired-regexp-history) + (and current-prefix-arg ?\040))) + (let ((dired-marker-char (or marker-char dired-marker-char))) + (diredp-mark-if (and (not (diredp-looking-at-p dired-re-dot)) + (not (eolp)) + (let ((fname (dired-get-filename nil t))) + (when (and fname (file-readable-p fname) (not (file-directory-p fname))) + (let ((prebuf (get-file-buffer fname))) + (message "Checking %s" fname) + ;; For now, do it inside Emacs. Grep might be better if there are lots of files. + (if (and prebuf (or (not (boundp 'dired-always-read-filesystem)) + (not dired-always-read-filesystem))) ; Emacs 26+ + (with-current-buffer prebuf + (save-excursion (goto-char (point-min)) (re-search-forward regexp nil t))) + (with-temp-buffer + (insert-file-contents fname) + (goto-char (point-min)) + (re-search-forward regexp nil t))))))) + "file"))) + + +;; REPLACE ORIGINAL in `dired.el': +;; +;; Use `diredp-mark-if', not `dired-mark-if'. +;; +;;;###autoload +(defun dired-mark-symlinks (unflag-p) + "Mark all symbolic links. +With prefix argument, unmark or unflag all those files." + (interactive "P") + (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char))) + (diredp-mark-if (diredp-looking-at-p dired-re-sym) "symbolic link"))) + + +;; REPLACE ORIGINAL in `dired.el': +;; +;; Use `diredp-mark-if', not `dired-mark-if'. +;; +;;;###autoload +(defun dired-mark-directories (unflag-p) + "Mark all directory file lines except `.' and `..'. +With prefix argument, unmark or unflag the files instead." + (interactive "P") + (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char))) + (diredp-mark-if (and (diredp-looking-at-p dired-re-dir) (not (diredp-looking-at-p dired-re-dot))) + "directory" "directories"))) + + +;; REPLACE ORIGINAL in `dired.el': +;; +;; Use `diredp-mark-if', not `dired-mark-if'. +;; +;;;###autoload +(defun dired-mark-executables (unflag-p) + "Mark all executable files. +With prefix argument, unmark or unflag the files instead." + (interactive "P") + (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char))) + (diredp-mark-if (diredp-looking-at-p dired-re-exe) "executable file"))) + + +;; REPLACE ORIGINAL in `dired.el': +;; +;; Use `diredp-mark-if', not `dired-mark-if'. +;; +;;;###autoload +(defun dired-flag-auto-save-files (&optional unflag-p) + "Flag for deletion files whose names suggest they are auto save files. +A prefix argument says to unmark or unflag the files instead." + (interactive "P") + (let ((dired-marker-char (if unflag-p ?\040 dired-del-marker))) + (diredp-mark-if + ;; It is less than general to check for # here, but it's the only way this runs fast enough. + (and (save-excursion (end-of-line) + (or (eq (preceding-char) ?#) + ;; Handle executables in case of -F option. Need not worry about the other kinds + ;; of markings that -F makes, since they won't appear on real auto-save files. + (and (eq (preceding-char) ?*) + (progn (forward-char -1) (eq (preceding-char) ?#))))) + (not (diredp-looking-at-p dired-re-dir)) + (let ((fname (dired-get-filename t t))) + (and fname (auto-save-file-name-p (file-name-nondirectory fname))))) + "auto-save file"))) + +;;;###autoload +(defun diredp-capitalize (&optional arg) ; Bound to `% c' + "Rename all marked (or next ARG) files by capitalizing them. +Makes the first char of the name uppercase and the others lowercase." + (interactive "P") + (dired-rename-non-directory #'capitalize "Rename by capitalizing:" arg)) + +;; This is more useful than a single-file version of `dired-do-delete'. +;;;###autoload +(defun diredp-delete-this-file (&optional use-trash-can) ; Bound to `C-k', `delete' + "In Dired, delete the file on the cursor line, upon confirmation. +This uses `delete-file'. +If the file is a symlink, remove the symlink. If the file has +multiple names, it continues to exist with the other names. + +For Emacs 24 and later, a prefix arg means that if +`delete-by-moving-to-trash' is non-nil then trash the file instead of +deleting it." + (interactive "P") + (let ((file (dired-get-filename))) + (if (not (yes-or-no-p (format "%s file `%s'? " (if (and use-trash-can delete-by-moving-to-trash) + "Trash" + "Permanently delete") + file))) + (message "OK - canceled") + (if (> emacs-major-version 23) (delete-file file use-trash-can) (delete-file file)) + (revert-buffer)))) + +;;; Versions of `dired-do-*' commands for just this line's file. +;;;###autoload +(defun diredp-capitalize-this-file () ; Bound to `M-c' + "In Dired, rename the file on the cursor line by capitalizing it. +Makes the first char of the name uppercase and the others lowercase." + (interactive) (diredp-capitalize 1)) + +;;;###autoload +(defun diredp-downcase-this-file () ; Bound to `M-l' + "In Dired, rename the file on the cursor line to lower case." + (interactive) (dired-downcase 1)) + +;;;###autoload +(defun diredp-upcase-this-file () ; Bound to `M-u' + "In Dired, rename the file on the cursor line to upper case." + (interactive) (dired-upcase 1)) + +;;;###autoload +(defun diredp-rename-this-file () ; Bound to `r' + "In Dired, rename the file on the cursor line." + (interactive) + (let ((use-file-dialog nil)) (dired-do-rename 1))) + +(when (fboundp 'epa-dired-do-encrypt) ; Emacs 23+ + (defun diredp-decrypt-this-file () + "In Dired, decrypt the file on the cursor line." + (interactive) + (let ((use-file-dialog nil)) (epa-dired-do-decrypt 1))) + + (defun diredp-encrypt-this-file () + "In Dired, encrypt the file on the cursor line." + (interactive) + (let ((use-file-dialog nil)) (epa-dired-do-encrypt 1))) + + (defun diredp-verify-this-file () + "In Dired, verify the file on the cursor line." + (interactive) + (let ((use-file-dialog nil)) (epa-dired-do-verify 1))) + + (defun diredp-sign-this-file () + "In Dired, sign the file on the cursor line." + (interactive) + (let ((use-file-dialog nil)) (epa-dired-do-sign 1)))) + +;;;###autoload +(defun diredp-copy-this-file () ; Not bound + "In Dired, copy the file on the cursor line." + (interactive) + (let ((use-file-dialog nil)) (dired-do-copy 1))) + +;;;###autoload +(defun diredp-relsymlink-this-file () ; Bound to `y' + "In Dired, make a relative symbolic link to file on cursor line." + (interactive) + (let ((use-file-dialog nil)) (dired-do-relsymlink 1))) + +;;;###autoload +(defun diredp-symlink-this-file () ; Not bound + "In Dired, make a symbolic link to the file on the cursor line." + (interactive) + (let ((use-file-dialog nil)) (dired-do-symlink 1))) + +;;;###autoload +(defun diredp-hardlink-this-file () ; Not bound + "In Dired, add a name (hard link) to the file on the cursor line." + (interactive) + (let ((use-file-dialog nil)) (dired-do-hardlink 1))) + +;;;###autoload +(defun diredp-print-this-file () ; Bound to `M-p' + "In Dired, print the file on the cursor line." + (interactive) (dired-do-print 1)) + +;;;###autoload +(defun diredp-grep-this-file () ; Not bound + "In Dired, grep the file on the cursor line." + (interactive) + (unless (and grep-command (or (< emacs-major-version 22) + (not grep-use-null-device) + (eq grep-use-null-device t))) + (grep-compute-defaults)) + (grep (diredp-do-grep-1 (list (dired-get-filename t))))) + +;;;###autoload +(defun diredp-compress-this-file () ; Bound to `z' + "In Dired, compress or uncompress the file on the cursor line." + (interactive) (dired-do-compress 1)) + +;;;###autoload +(defun diredp-async-shell-command-this-file (command filelist) ; Not bound + "Run a shell COMMAND asynchronously on the file on the Dired cursor line. +Like `diredp-shell-command-this-file', but adds `&' at the end of +COMMAND to execute it asynchronously. The command output appears in +buffer `*Async Shell Command*'." + (interactive (list (dired-read-shell-command (concat "& on " "%s: ") 1 (list (dired-get-filename t))) + (list (dired-get-filename t)))) + (unless (diredp-string-match-p "&[ \t]*\\'" command) (setq command (concat command " &"))) + (dired-do-shell-command command 1 filelist)) + +;;;###autoload +(defun diredp-shell-command-this-file (command filelist) ; Not bound + "In Dired, run a shell COMMAND on the file on the cursor line." + (interactive (list (dired-read-shell-command (concat "! on " "%s: ") 1 (list (dired-get-filename t))) + (list (dired-get-filename t)))) + (dired-do-shell-command command 1 filelist)) + +;;;###autoload +(defun diredp-bookmark-this-file (&optional prefix) ; Bound to `C-B' (`C-S-b') + "In Dired, bookmark the file on the cursor line. +See `diredp-do-bookmark'." + (interactive (progn (diredp-ensure-mode) + (list (and diredp-prompt-for-bookmark-prefix-flag + (read-string "Prefix for bookmark name: "))))) + (diredp-do-bookmark prefix 1)) + +;;;###autoload +(defun diredp-tag-this-file (tags &optional prefix) ; Bound to `T +' + "In Dired, add some tags to the file on the cursor line. +You need library `bookmark+.el' to use this command." + (interactive (progn (diredp-ensure-bookmark+) + (diredp-ensure-mode) + (list (bmkp-read-tags-completing) + (and diredp-prompt-for-bookmark-prefix-flag + (read-string "Prefix for bookmark name: "))))) + (diredp-do-tag tags prefix 1)) + +;;;###autoload +(defun diredp-untag-this-file (tags &optional prefix arg) ; Bound to `T -' + "In Dired, remove some tags from the file on the cursor line. +With a prefix arg, remove all tags from the file. +You need library `bookmark+.el' to use this command." + (interactive (progn (diredp-ensure-bookmark+) + (diredp-ensure-mode) + (let* ((pref (and diredp-prompt-for-bookmark-prefix-flag + (read-string "Prefix for bookmark name: "))) + (bmk (bmkp-get-autofile-bookmark (dired-get-filename) nil pref)) + (btgs (and bmk (bmkp-get-tags bmk)))) + (unless btgs (error "File has no tags to remove")) + (list (if current-prefix-arg btgs (bmkp-read-tags-completing btgs)) + pref + current-prefix-arg)))) + (diredp-do-untag tags prefix 1)) + +;;;###autoload +(defun diredp-remove-all-tags-this-file (&optional prefix msgp) ; Bound to `T 0' + "In Dired, remove all tags from this file. +You need library `bookmark+.el' to use this command." + (interactive (progn (diredp-ensure-bookmark+) + (diredp-ensure-mode) + (list (and diredp-prompt-for-bookmark-prefix-flag + (read-string "Prefix for bookmark name: ")) + 'MSG))) + (bookmark-maybe-load-default-file) + (diredp-do-remove-all-tags prefix 1)) + +;;;###autoload +(defun diredp-paste-add-tags-this-file (&optional prefix msgp) ; Bound to `T p', `T C-y' + "In Dired, add previously copied tags to this file. +See `diredp-paste-add-tags'. +You need library `bookmark+.el' to use this command." + (interactive (progn (diredp-ensure-bookmark+) + (diredp-ensure-mode) + (list (and diredp-prompt-for-bookmark-prefix-flag + (read-string "Prefix for bookmark name: ")) + 'MSG))) + (bookmark-maybe-load-default-file) + (diredp-do-paste-add-tags prefix 1)) + +;;;###autoload +(defun diredp-paste-replace-tags-this-file (&optional prefix msgp) ; Bound to `T q' + "In Dired, replace tags for this file with previously copied tags. +See `diredp-paste-replace-tags'. +You need library `bookmark+.el' to use this command." + (interactive (progn (diredp-ensure-bookmark+) + (diredp-ensure-mode) + (list (and diredp-prompt-for-bookmark-prefix-flag + (read-string "Prefix for bookmark name: ")) + 'MSG))) + (bookmark-maybe-load-default-file) + (diredp-do-paste-add-tags prefix 1)) + +;;;###autoload +(defun diredp-set-tag-value-this-file (tag value &optional prefix msgp) ; Bound to `T v' + "In Dired, Set value of TAG to VALUE for this file. +See `diredp-set-tag-value'. +You need library `bookmark+.el' to use this command." + (interactive (progn (diredp-ensure-bookmark+) + (diredp-ensure-mode) + (list (bmkp-read-tag-completing) + (read (read-string "Value: ")) + (and diredp-prompt-for-bookmark-prefix-flag + (read-string "Prefix for bookmark name: ")) + 'MSG))) + (bookmark-maybe-load-default-file) + (diredp-do-set-tag-value tag value prefix 1)) + +;;;###autoload +(defun diredp-copy-tags-this-file (&optional prefix msgp) ; Bound to `T c', `T M-w' + "In Dired, copy the tags from this file, so you can paste them to another. +See `diredp-copy-tags'. +You need library `bookmark+.el' to use this command." + (interactive (progn (diredp-ensure-bookmark+) + (diredp-ensure-mode) + (list (and diredp-prompt-for-bookmark-prefix-flag + (read-string "Prefix for bookmark name: ")) + 'MSG))) + (bookmark-maybe-load-default-file) + (let ((bmk (bmkp-get-autofile-bookmark (dired-get-filename) nil prefix))) + (and bmk (bmkp-copy-tags bmk msgp)))) + +;;;###autoload +(defun diredp-mouse-copy-tags (event) ; Not bound + "In Dired, copy the tags from this file, so you can paste them to another. +You need library `bookmark+.el' to use this command." + (interactive "e") + (let ((mouse-pos (event-start event)) + (dired-no-confirm t) + (prefix (and diredp-prompt-for-bookmark-prefix-flag + (read-string "Prefix for bookmark name: ")))) + (select-window (posn-window mouse-pos)) + (goto-char (posn-point mouse-pos)) + (diredp-copy-tags-this-file prefix 'MSG)) + (diredp-previous-line 1)) + +(when (fboundp 'describe-file) ; In `help-fns+.el' or `help+20.el'. + (defun diredp-describe-file (&optional internal-form-p) ; Bound to `C-h RET', `C-h C-RET' + "In Dired, describe this file or directory. +You need library `help-fns+.el' to use this command. +If the file has an autofile bookmark and you use library `Bookmark+', +then show also the bookmark information (tags etc.). In this case, a +prefix arg shows the internal form of the bookmark." + (interactive "P") + (describe-file (dired-get-filename nil t) internal-form-p)) + + (defun diredp-mouse-describe-file (event &optional internal-form-p) ; Not bound + "Describe the clicked file. +You need library `help-fns+.el' to use this command. +If the file has an autofile bookmark and you use library `Bookmark+', +then show also the bookmark information (tags etc.). In this case, a +prefix arg shows the internal form of the bookmark." + (interactive "e\nP") + (let (file) + (with-current-buffer (window-buffer (posn-window (event-end event))) + (save-excursion (goto-char (posn-point (event-end event))) + (setq file (dired-get-filename nil t)))) + (describe-file file internal-form-p)))) + +;; Define these even if `Bookmark+' is not loaded. +;;;###autoload +(defalias 'diredp-show-metadata 'diredp-describe-autofile) +;;;###autoload +(defun diredp-describe-autofile (&optional internal-form-p) + "Show the metadata for the file of the current line. +The file must name an autofile bookmark. The metadata is the bookmark +information. + +With a prefix argument, show the internal definition of the bookmark. + +You need library `bookmark+.el' for this command." + (interactive "P") + (diredp-ensure-bookmark+) + (diredp-ensure-mode) + (let ((bmk (save-match-data + (bmkp-get-autofile-bookmark (dired-get-filename nil t))))) + (unless bmk (error "Not on an autofile bookmark")) + (save-selected-window (if internal-form-p + (bmkp-describe-bookmark-internals bmk) + (bmkp-describe-bookmark bmk))))) + +(defun diredp-mouse-describe-autofile (event &optional internal-form-p) ; Not bound + "Show the metadata for the file whose name you click. +The file must name an autofile bookmark. The metadata is the bookmark +information. + +With a prefix argument, show the internal definition of the bookmark. + +You need library `bookmark+.el' for this command." + (interactive "e\nP") + (diredp-ensure-bookmark+) + (let (file) + (with-current-buffer (window-buffer (posn-window (event-end event))) + (diredp-ensure-mode) + (save-excursion (goto-char (posn-point (event-end event))) + (setq file (dired-get-filename nil t)))) + (let ((bmk (save-match-data (bmkp-get-autofile-bookmark file)))) + (unless bmk (error "Not an autofile bookmark")) + (save-selected-window (if internal-form-p + (bmkp-describe-bookmark-internals bmk) + (bmkp-describe-bookmark bmk)))))) + +;;;###autoload +(defalias 'diredp-show-metadata-for-marked 'diredp-describe-marked-autofiles) +;;;###autoload +(defun diredp-describe-marked-autofiles (&optional internal-form-p interactivep details) + "Show metadata for the marked files. +If no file is marked, describe ALL autofiles in this directory. +With a prefix argument, show the internal (Lisp) form of the metadata. +When invoked interactively, raise an error if no files are marked. +You need library `bookmark+.el' for this command. + +When called from Lisp, optional arg DETAILS is passed to +`diredp-get-files'." + (interactive (list current-prefix-arg t diredp-list-file-attributes)) + (diredp-ensure-bookmark+) + (let ((help-xref-following nil)) + (help-setup-xref (list `(lambda (_buf) + (with-current-buffer ,(current-buffer) (diredp-describe-marked-autofiles))) + internal-form-p) + (if (or (> emacs-major-version 23) + (and (= emacs-major-version 23) (> emacs-minor-version 1))) + (called-interactively-p 'interactive) + (interactive-p)))) + (diredp-with-help-window "*Help*" + (let ((marked (dired-get-marked-files nil nil nil 'DISTINGUISH-ONE-MARKED interactivep))) + (unless (cdr marked) + (message "Describing ALL autofiles here (none are marked)...") + (setq marked (diredp-get-files 'IGNORE-MARKS-P nil nil nil nil details))) + (if (eq t (car marked)) + (diredp-describe-autofile internal-form-p) + (dolist (bmk (delq nil (mapcar #'bmkp-get-autofile-bookmark marked))) + (if internal-form-p + (let* ((bname (bmkp-bookmark-name-from-record bmk)) + (help-text (format "%s\n%s\n\n%s" + bname (make-string (length bname) ?-) (pp-to-string bmk)))) + (princ help-text) (terpri)) + (princ (bmkp-bookmark-description bmk)) (terpri))))))) + +;;;###autoload +(defun diredp-byte-compile-this-file () ; Bound to `b' + "In Dired, byte compile the (Lisp source) file on the cursor line." + (interactive) (dired-do-byte-compile 1)) + +;;;###autoload +(defun diredp-load-this-file () ; Not bound + "In Dired, load the file on the cursor line." + (interactive) (dired-do-load 1)) + +;;;###autoload +(defun diredp-chmod-this-file () ; Bound to `M-m' + "In Dired, change the mode of the file on the cursor line." + (interactive) (dired-do-chmod 1)) + +(unless (memq system-type '(windows-nt ms-dos)) + (defun diredp-chgrp-this-file () ; Not bound + "In Dired, change the group of the file on the cursor line." + (interactive) (dired-do-chgrp 1))) + +(unless (memq system-type '(windows-nt ms-dos)) + (defun diredp-chown-this-file () ; Not bound + "In Dired, change the owner of the file on the cursor line." + (interactive) (dired-do-chown 1))) + +(when (fboundp 'dired-do-touch) + (defun diredp-touch-this-file () ; Not bound + "In Dired, `touch' (change the timestamp of) the file on the cursor line." + (interactive) (dired-do-touch 1))) + + +;; REPLACE ORIGINAL in `dired-x.el'. +;; +;; 1. Variable (symbol) `s' -> `blks'. +;; 2. Fixes to remove leading space from `uid' and allow `.' in `gid'. +;; 3. Cleaned up doc string and code a bit. +;; +;;;###autoload +(defun dired-mark-sexp (predicate &optional unmark-p) ; Bound to `M-(', `* (' + "Mark files for which PREDICATE returns non-nil. +With a prefix arg, unmark or unflag those files instead. + +PREDICATE is a lisp sexp that can refer to the following symbols as +variables: + + `mode' [string] file permission bits, e.g. \"-rw-r--r--\" + `nlink' [integer] number of links to file + `size' [integer] file size in bytes + `uid' [string] owner + `gid' [string] group (If the gid is not displayed by `ls', + this will still be set (to the same as uid)) + `time' [string] the time that `ls' displays, e.g. \"Feb 12 14:17\" + `name' [string] the name of the file + `sym' [string] if file is a symbolic link, the linked-to name, + else \"\" + `inode' [integer] the inode of the file (only for `ls -i' output) + `blks' [integer] the size of the file for `ls -s' output + (ususally in blocks or, with `-k', in Kbytes) +Examples: + Mark zero-length files: `(equal 0 size)' + Mark files last modified on Feb 2: `(string-match \"Feb 2\" time)' + Mark uncompiled Emacs Lisp files (`.el' file without a `.elc' file): + First, Dired just the source files: `dired *.el'. + Then, use \\[dired-mark-sexp] with this sexp: + (not (file-exists-p (concat name \"c\"))) + +There's an ambiguity when a single integer not followed by a unit +prefix precedes the file mode: It is then parsed as inode number +and not as block size (this always works for GNU coreutils ls). + +Another limitation is that the uid field is needed for the +function to work correctly. In particular, the field is not +present for some values of `ls-lisp-emulation'. + +This function operates only on the Dired buffer content. It does not +refer at all to the underlying file system. Contrast this with +`find-dired', which might be preferable for the task at hand." + ;; Using `sym' = "", instead of nil, for non-linked files avoids the trap of + ;; (string-match "foo" sym) into which a user would soon fall. + ;; Use `equal' instead of `=' in the example, as it works on integers and strings. + (interactive "xMark if (vars: inode,blks,mode,nlink,uid,gid,size,time,name,sym): \nP") + (message "%s" predicate) + (let ((dired-marker-char (if unmark-p ?\040 dired-marker-char)) + (inode nil) + (blks ()) + mode nlink uid gid size time name sym) + (diredp-mark-if + (save-excursion + (and + ;; Sets vars INODE BLKS MODE NLINK UID GID SIZE TIME NAME and SYM + ;; according to current file line. Returns `t' for success, nil if + ;; there is no file line. Upon success, these vars are set, to either + ;; nil or the appropriate value, so they need not be initialized. + ;; Moves point within the current line. + (dired-move-to-filename) + (let ((mode-len 10) ; Length of mode string. + ;; As in `dired.el', but with subexpressions \1=inode, \2=blks: + ;; GNU `ls -hs' suffixes the block count with a unit and prints it as a float; FreeBSD does neither. + ;; $$$$$$ (dired-re-inode-size "\\s *\\([0-9]*\\)\\s *\\([0-9]*\\) ?") + (dired-re-inode-size (if (> emacs-major-version 24) + "\\=\\s *\\([0-9]+\\s +\\)?\ +\\(?:\\([0-9]+\\(?:\\.[0-9]*\\)?[BkKMGTPEZY]?\\)? ?\\)" + "\\s *\\([0-9]*\\)\\s *\\([0-9]*\\) ?")) + pos) + (beginning-of-line) + (forward-char 2) + (search-forward-regexp dired-re-inode-size nil t) + ;; XXX Might be a size not followed by a unit prefix. Could set `blks' to `inode' if it were otherwise + ;; nil, with similar reasoning as for setting `gid' to `uid', but it would be even more whimsical. + (setq inode (and (match-string 1) (string-to-number (match-string 1))) + blks (and (match-string 2) (if (fboundp 'dired-x--string-to-number) + (dired-x--string-to-number (match-string 2)) ; Emacs 25+ + (string-to-number (match-string 2)))) + mode (buffer-substring (point) (+ mode-len (point)))) + (forward-char mode-len) + (unless (eq (char-after) ?\ ) (forward-char 1)) ; Skip any extended attributes marker ("." or "+"). + (setq nlink (read (current-buffer))) + ;; Karsten Wenger fixed uid. + + ;; Another issue is that GNU `ls -n' right-justifies numerical UIDs and GIDs, while FreeBSD + ;; left-justifies them, so do not rely on a specific whitespace layout. Both of them right-justify all + ;; other numbers, though. + ;; XXX Return a number if the `uid' or `gid' seems to be numerical? + ;; $$$$$$ (setq uid (buffer-substring (+ (point) 1) (progn (forward-word 1) (point)))) + (setq uid (buffer-substring (progn (skip-chars-forward " \t") (point)) + (progn (skip-chars-forward "^ \t") (point)))) + (cond ((> emacs-major-version 24) + (dired-move-to-filename) + (save-excursion + (setq time + ;; The regexp below tries to match from the last digit of the size field through a + ;; space after the date. Also, dates may have different formats depending on file age, + ;; so the date column need not be aligned to the right. + (buffer-substring (save-excursion (skip-chars-backward " \t") (point)) + (progn (re-search-backward directory-listing-before-filename-regexp) + (skip-chars-forward "^ \t") + (1+ (point)))) + size + (dired-x--string-to-number + ;; We know that there's some kind of number before point because the regexp search + ;; above succeeded. Not worth doing an extra check for leading garbage. + (buffer-substring (point) (progn (skip-chars-backward "^ \t") (point)))) + ;; If no `gid' is displayed, `gid' will be set to `uid' but user will then not reference + ;; it anyway in PREDICATE. + gid + (buffer-substring (progn (skip-chars-backward " \t") (point)) + (progn (skip-chars-backward "^ \t") (point))))) + (setq name (buffer-substring (point) (or (dired-move-to-end-of-filename t) (point))) + sym (if (diredp-looking-at-p " -> ") + (buffer-substring (progn (forward-char 4) (point)) (line-end-position)) + ""))) + (t + (re-search-forward + (if (< emacs-major-version 20) + "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)" + dired-move-to-filename-regexp)) + (goto-char (match-beginning 1)) + (forward-char -1) + (setq size (string-to-number (buffer-substring (save-excursion (backward-word 1) + (setq pos (point))) + (point)))) + (goto-char pos) + (backward-word 1) + ;; if no `gid' is displayed, `gid' will be set to `uid' but user will then not reference + ;; it anyway in PREDICATE. + (setq gid (buffer-substring (save-excursion (forward-word 1) (point)) (point)) + time (buffer-substring (match-beginning 1) (1- (dired-move-to-filename))) + name (buffer-substring (point) (or (dired-move-to-end-of-filename t) (point))) + sym (if (diredp-looking-at-p " -> ") + (buffer-substring (progn (forward-char 4) (point)) (line-end-position)) + ""))))) + ;; Vanilla Emacs uses `lexical-binding' = t, and it passes bindings to `eval' as a second arg. + ;; We use `lexical-binding' = nil, and anyway there should be no need to pass the bindings. + (eval predicate))) + (format "'%s file" predicate)))) + +(defun diredp-this-file-marked-p (&optional mark-char) + "Return non-nil if the file on this line is marked. +Optional arg MARK-CHAR is the type of mark to check. + If nil, then if the file has any mark, including `D', it is marked." + (and (dired-get-filename t t) (save-excursion + (beginning-of-line) + (if mark-char + (diredp-looking-at-p + (concat "^" (regexp-quote (char-to-string mark-char)))) + (not (diredp-looking-at-p "^ ")))))) + +(defun diredp-this-file-unmarked-p (&optional mark-char) + "Return non-nil if the file on this line is unmarked. +Optional arg MARK-CHAR is the type of mark to check. + If nil, then if the file has no mark, including `D', it is unmarked. + If non-nil, then it is unmarked for MARK-CHAR if it has no mark or + it has any mark except MARK-CHAR." + (and (dired-get-filename t t) (save-excursion + (beginning-of-line) + (if mark-char + (not (diredp-looking-at-p + (concat "^" (regexp-quote (char-to-string mark-char))))) + (diredp-looking-at-p "^ "))))) + +;;;###autoload +(defun diredp-mark-region-files (&optional unmark-p) ; Not bound + "Mark all of the files in the current region (if it is active). +With non-nil prefix arg, unmark them instead." + (interactive "P") + (let ((beg (min (point) (mark))) + (end (max (point) (mark))) + (inhibit-field-text-motion t)) ; Just in case. + (setq beg (save-excursion (goto-char beg) (line-beginning-position)) + end (save-excursion (goto-char end) (line-end-position))) + (let ((dired-marker-char (if unmark-p ?\040 dired-marker-char))) + (diredp-mark-if (and (<= (point) end) (>= (point) beg) (diredp-this-file-unmarked-p)) "region file")))) + +;;;###autoload +(defun diredp-unmark-region-files (&optional mark-p) ; Not bound + "Unmark all of the files in the current region (if it is active). +With non-nil prefix arg, mark them instead." + (interactive "P") + (let ((beg (min (point) (mark))) + (end (max (point) (mark))) + (inhibit-field-text-motion t)) ; Just in case. + (setq beg (save-excursion (goto-char beg) (line-beginning-position)) + end (save-excursion (goto-char end) (line-end-position))) + (let ((dired-marker-char (if mark-p dired-marker-char ?\040))) + (diredp-mark-if (and (<= (point) end) (>= (point) beg) (diredp-this-file-marked-p)) "region file")))) + +;;;###autoload +(defun diredp-flag-region-files-for-deletion () ; Not bound + "Flag all of the files in the current region (if it is active) for deletion." + (interactive) + (let ((beg (min (point) (mark))) + (end (max (point) (mark))) + (inhibit-field-text-motion t)) ; Just in case. + (setq beg (save-excursion (goto-char beg) (line-beginning-position)) + end (save-excursion (goto-char end) (line-end-position))) + (let ((dired-marker-char dired-del-marker)) + (diredp-mark-if (and (<= (point) end) (>= (point) beg) (diredp-this-file-unmarked-p ?\D)) + "region file")))) + +;;;###autoload +(defun diredp-toggle-marks-in-region (start end) ; Not bound + "Toggle marks in the region." + (interactive "r") + (save-excursion + (save-restriction + (if (not (fboundp 'dired-toggle-marks)) + ;; Pre-Emacs 22. Use bol, eol. If details hidden, show first. + (let ((details-hidden-p (and (boundp 'dired-details-state) (eq 'hidden dired-details-state)))) + (widen) + (when details-hidden-p (dired-details-show)) + (goto-char start) + (setq start (line-beginning-position)) + (goto-char end) + (setq end (line-end-position)) + (narrow-to-region start end) + (dired-toggle-marks) + (when details-hidden-p (dired-details-hide))) + (narrow-to-region start end) + (dired-toggle-marks)))) + (when (and (get-buffer-window (current-buffer)) (fboundp 'fit-frame-if-one-window)) + (fit-frame-if-one-window))) + + +;;; Mouse 3 menu. +;;;;;;;;;;;;;;;;; + +(defvar diredp-file-line-overlay nil) + +;;;###autoload +(defun diredp-mouse-3-menu (event) ; Bound to `mouse-3' + "Dired pop-up `mouse-3' menu, for files in selection or current line." + (interactive "e") + (if (not (and (fboundp 'mouse3-dired-use-menu) (diredp-nonempty-region-p))) + ;; No `mouse3.el' or no region. + (if (diredp-nonempty-region-p) + ;; Region + (let ((reg-choice (x-popup-menu + event + (list "Files in Region" + (list "" + '("Mark" . diredp-mark-region-files) + '("Unmark" . diredp-unmark-region-files) + '("Toggle Marked/Unmarked" . + diredp-toggle-marks-in-region) + '("Flag for Deletion" . + diredp-flag-region-files-for-deletion)))))) + (when reg-choice (call-interactively reg-choice))) + ;; Single file/dir (no region). + (let ((mouse-pos (event-start event)) + ;; Do not use `save-excursion', because some commands will move point on purpose. + ;; Just save original point and return to it unless MOVEP is set to non-nil. + (opoint (point)) + (movep nil) + (inhibit-field-text-motion t) ; Just in case. + choice bol eol file/dir-name) + (with-current-buffer (window-buffer (posn-window mouse-pos)) + (goto-char (posn-point mouse-pos)) + (setq bol (line-beginning-position) + eol (line-end-position)) + (unwind-protect + (when (setq file/dir-name (and (not (eobp)) (dired-get-filename nil t))) + (if diredp-file-line-overlay ; Don't re-create if exists. + (move-overlay diredp-file-line-overlay bol eol (current-buffer)) + (setq diredp-file-line-overlay (make-overlay bol eol)) + (overlay-put diredp-file-line-overlay 'face 'region)) + (sit-for 0) + (let ((map + (easy-menu-create-menu + "This File" + `( + ("Bookmark" :visible (featurep 'bookmark+) + ["Bookmark..." diredp-bookmark-this-file] + ["Add Tags..." diredp-tag-this-file + :visible (featurep 'bookmark+)] + ["Remove Tags..." diredp-untag-this-file + :visible (featurep 'bookmark+)] + ["Remove All Tags" diredp-remove-all-tags-this-file + :visible (featurep 'bookmark+)] + ["Copy Tags" diredp-copy-tags-this-file + :visible (featurep 'bookmark+)] + ["Paste Tags (Add)" diredp-paste-add-tags-this-file + :visible (featurep 'bookmark+)] + ["Paste Tags (Replace)" diredp-paste-replace-tags-this-file + :visible (featurep 'bookmark+)] + ["Set Tag Value..." diredp-set-tag-value-this-file + :visible (featurep 'bookmark+)] + ) + ["Describe" ',(if (if (> emacs-major-version 21) + (require 'help-fns+ nil t) + (require 'help+20 nil t)) + 'diredp-describe-file + 'diredp-describe-autofile)] ; Requires `bookmark+.el' + ;; Stuff from `Marks' menu. + ["Mark" dired-mark + :visible (not (eql (dired-file-marker file/dir-name) + dired-marker-char))] + ["Unmark" dired-unmark + :visible (dired-file-marker file/dir-name)] + ["Flag for Deletion" dired-flag-file-deletion + :visible (not (eql (dired-file-marker file/dir-name) + dired-del-marker))] + ["Delete..." diredp-delete-this-file] + "--" ; ------------------------------------------------------ + ;; Stuff from `Single' / `Multiple' menus. + ["Open" dired-find-file] + ["Open in Other Window" dired-find-file-other-window] + ["Open in Other Frame" diredp-find-file-other-frame] + ["Open Associated Windows App" dired-w32-browser + :visible (featurep 'w32-browser)] + ["Open in Windows Explorer" dired-w32explore + :visible (featurep 'w32-browser)] + ["View (Read Only)" dired-view-file] + ["--" 'ignore ; ------------------------------------------------- + :visible (or (atom (diredp-this-subdir)) ; Subdir line. + (not (equal (expand-file-name (dired-current-directory)) + (expand-file-name default-directory))))] ; Not top. + ["Insert This Subdir" + (lambda () (interactive) + (call-interactively #'dired-maybe-insert-subdir) + (setq movep t)) + :visible (and (atom (diredp-this-subdir)) + (not (assoc (file-name-as-directory (diredp-this-subdir)) + dired-subdir-alist))) + :enable (atom (diredp-this-subdir))] + ["Go To Inserted Subdir" + (lambda () (interactive) + (call-interactively #'dired-maybe-insert-subdir) + (setq movep t)) + :visible (and (atom (diredp-this-subdir)) + (assoc (file-name-as-directory (diredp-this-subdir)) + dired-subdir-alist)) + :enable (atom (diredp-this-subdir)) + :keys "i"] + ["Remove This Inserted Subdir" dired-kill-subdir + :visible (not (equal + (expand-file-name (dired-current-directory)) + (expand-file-name default-directory)))] ; In subdir, not top. + ["Remove This Inserted Subdir and Lower" diredp-kill-this-tree + :visible (and (fboundp 'diredp-kill-this-tree) + (not (equal + (expand-file-name (dired-current-directory)) + (expand-file-name default-directory))))] ; In subdir, not top. + ["Dired This Inserted Subdir (Tear Off)" + (lambda () (interactive) (diredp-dired-this-subdir t)) + :visible (not (equal (expand-file-name (dired-current-directory)) + (expand-file-name default-directory)))] ; In subdir, not top. + "--" ; ------------------------------------------------------ + ["Compare..." diredp-ediff] + ["Diff..." dired-diff] + ["Diff with Backup" dired-backup-diff] + + ["Bookmark..." diredp-bookmark-this-file + :visible (not (featurep 'bookmark+))] + "--" ; ------------------------------------------------------ + ["Rename to..." diredp-rename-this-file] + ["Capitalize" diredp-capitalize-this-file] + ["Upcase" diredp-upcase-this-file] + ["Downcase" diredp-downcase-this-file] + "--" ; ------------------------------------------------------ + ["Copy to..." diredp-copy-this-file] + ["Symlink to (Relative)..." diredp-relsymlink-this-file] + ["Symlink to..." diredp-symlink-this-file] + ["Hardlink to..." diredp-hardlink-this-file] + "--" ; ------------------------------------------------------ + ["Shell Command..." diredp-shell-command-this-file] + ["Asynchronous Shell Command..." + diredp-async-shell-command-this-file] + ["Print..." diredp-print-this-file] + ["Grep" diredp-grep-this-file] + ["Compress/Uncompress" diredp-compress-this-file] + ["Byte-Compile" diredp-byte-compile-this-file] + ["Load" diredp-load-this-file] + "--" ; ------------------------------------------------------ + ["Change Timestamp..." diredp-touch-this-file] + ["Change Mode..." diredp-chmod-this-file] + ["Change Group..." diredp-chgrp-this-file + :visible (fboundp 'diredp-chgrp-this-file)] + ["Change Owner..." diredp-chown-this-file + :visible (fboundp 'diredp-chown-this-file)])))) + (when diredp-file-line-overlay + (delete-overlay diredp-file-line-overlay)) + (setq choice (x-popup-menu event map)) + (when choice (call-interactively (lookup-key map (apply 'vector choice)))))) + (unless movep (goto-char opoint)))))) + ;; `mouse3.el' and active region. + (unless (eq mouse3-dired-function 'mouse3-dired-use-menu) + (funcall #'mouse3-dired-use-menu) + (revert-buffer)) + (let ((last-command 'mouse-save-then-kill)) (mouse-save-then-kill event)))) + + +;; REPLACE ORIGINAL in `dired.el' for Emacs 20. +;; +;; Allow `.' and `..', by using non-nil second arg to `dired-get-filename'. +;; +(when (< emacs-major-version 21) + (defun dired-find-file () ; Bound to `RET' + "In Dired, visit the file or directory named on this line." + (interactive) + (let* ((dgf-result (or (dired-get-filename nil t) (error "No file on this line"))) + (file-name (file-name-sans-versions dgf-result t))) + (if (file-exists-p file-name) + (find-file file-name) + (if (file-symlink-p file-name) + (error "File is a symlink to a nonexistent target") + (error "File no longer exists; type `g' to update Dired buffer")))))) + +;;;###autoload +(defun diredp-find-file-other-frame () ; Bound to `C-o' + "In Dired, visit this file or directory in another frame." + (interactive) + (find-file-other-frame (file-name-sans-versions (dired-get-filename nil t) t))) + +;;;###autoload +(defun diredp-mouse-find-file-other-frame (event) ; Bound to `M-mouse-2' + "In Dired, visit file or directory clicked on in another frame." + (interactive "e") + (let ((pop-up-frames t)) (dired-mouse-find-file-other-window event))) + + +;; REPLACE ORIGINAL in `dired.el'. +;; +;; Allow `.' and `..', by using non-nil second arg to `dired-get-filename'. +;; +;;;###autoload +(defun dired-mouse-find-file-other-window (event) ; Bound to `mouse-2' + "In Dired, visit the file or directory name you click on." + (interactive "e") + (let (file) + (with-current-buffer (window-buffer (posn-window (event-end event))) + (save-excursion (goto-char (posn-point (event-end event))) + (setq file (dired-get-filename nil t)))) + (unless (stringp file) (error "No file here")) + (select-window (posn-window (event-end event))) + (find-file-other-window (file-name-sans-versions file t)))) + +;;;###autoload +(defun diredp-mouse-view-file (event) ; Not bound + "Examine this file in view mode, returning to Dired when done. +When file is a directory, show it in this buffer if it is inserted; +otherwise, display it in another buffer." + (interactive "e") + (let (file) + (with-current-buffer (window-buffer (posn-window (event-end event))) + (save-excursion (goto-char (posn-point (event-end event))) + (setq file (dired-get-filename nil t)))) + (select-window (posn-window (event-end event))) + (if (file-directory-p file) + (or (and (cdr dired-subdir-alist) (dired-goto-subdir file)) (dired file)) + (view-file file)))) ; In `view.el'. + +;;;###autoload +(defun diredp-mouse-ediff (event) ; Not bound + "Compare this file (pointed by mouse) with file FILE2 using `ediff'. +FILE2 defaults to this file as well. If you enter just a directory +name for FILE2, then this file is compared with a file of the same +name in that directory. FILE2 is the second file given to `ediff'; +this file is the first given to it." + (interactive "e") + (require 'ediff) + (let ((mouse-pos (event-start event))) + (select-window (posn-window mouse-pos)) + (goto-char (posn-point mouse-pos)) + (call-interactively 'diredp-ediff))) + +;;;###autoload +(defun diredp-mouse-diff (event &optional switches) ; Not bound + "Compare this file (pointed by mouse) with file FILE2 using `diff'. +FILE2 defaults to the file at the mark. This file is the first file +given to `diff'. With prefix arg, prompt for second arg SWITCHES, +which are options for `diff'." + (interactive "e") + (let ((default (and (mark t) (save-excursion (goto-char (mark t)) + (dired-get-filename t t)))) + (mouse-pos (event-start event))) + (require 'diff) + (select-window (posn-window mouse-pos)) + (goto-char (posn-point mouse-pos)) + (let ((file2 (read-file-name (format "Diff %s with: %s" + (dired-get-filename t) + (if default (concat "(default " default ") ") "")) + (dired-current-directory) default t))) + (setq switches (and current-prefix-arg + (if (fboundp 'icicle-read-string-completing) ; In `icicles-fn.el' + (icicle-read-string-completing "Options for diff: " + (if (stringp diff-switches) + diff-switches + (mapconcat #'identity diff-switches " ")) + (lambda (c) + (diredp-string-match-p "switches" + (symbol-name c)))) + (read-string "Options for diff: " (if (stringp diff-switches) + diff-switches + (mapconcat #'identity diff-switches " ")))))) + (diff file2 (dired-get-filename t) switches)))) + +;;;###autoload +(defun diredp-mouse-backup-diff (event) ; Not bound + "Diff this file with its backup file or vice versa. +Use the latest backup, if there are several numerical backups. +If this file is a backup, diff it with its original. +The backup file is the first file given to `diff'. +With prefix arg, prompt for SWITCHES which are the options for `diff'." + (interactive "e") + (let ((switches (and current-prefix-arg + (if (fboundp 'icicle-read-string-completing) ; In `icicles-fn.el' + (icicle-read-string-completing "Options for diff: " + (if (stringp diff-switches) + diff-switches + (mapconcat #'identity diff-switches " ")) + (lambda (c) + (diredp-string-match-p "switches" + (symbol-name c)))) + (read-string "Options for diff: " (if (stringp diff-switches) + diff-switches + (mapconcat #'identity diff-switches " ")))))) + (mouse-pos (event-start event))) + (select-window (posn-window mouse-pos)) + (goto-char (posn-point mouse-pos)) + (diff-backup (dired-get-filename) switches))) + +;;;###autoload +(defun diredp-mouse-mark (event) ; Not bound + "In Dired, mark this file. +If on a subdir headerline, mark all its files except `.' and `..'. + +Use \\[dired-unmark-all-files] to remove all marks, +and \\[dired-unmark] on a subdir to remove the marks in this subdir." + (interactive "e") + (let ((mouse-pos (event-start event))) + (select-window (posn-window mouse-pos)) + (goto-char (posn-point mouse-pos))) + (if (and (cdr dired-subdir-alist) (dired-get-subdir)) + (save-excursion (dired-mark-subdir-files)) + (let ((buffer-read-only nil)) + (dired-repeat-over-lines 1 #'(lambda () (delete-char 1) (insert dired-marker-char))) + (diredp-previous-line 1)))) + +;;;###autoload +(defun diredp-mouse-unmark (event) ; Not bound + "In Dired, unmark this file. +If looking at a subdir, unmark all its files except `.' and `..'." + (interactive "e") + (let ((mouse-pos (event-start event))) + (select-window (posn-window mouse-pos)) + (goto-char (posn-point mouse-pos))) + (let ((dired-marker-char ?\040)) (dired-mark nil)) + (diredp-previous-line 1)) + +;;; This can be bound to [C-down-mouse-1] to give behavior similar to Windows Explorer. +;;; However, Emacs generally uses [C-down-mouse-1] for `mouse-buffer-menu'. +;;;###autoload +(defun diredp-mouse-mark/unmark (event) ; Not bound + "Mark/unmark file or directory at mouse EVENT." + (interactive "e") + (let* ((mouse-pos (event-start event)) + (inhibit-field-text-motion t) ; Just in case. + (file/dir-name (with-current-buffer (window-buffer (posn-window mouse-pos)) + (save-excursion + (goto-char (posn-point mouse-pos)) + (and (not (eobp)) (dired-get-filename nil t)))))) + ;; Return nil iff not on a file or directory name. + (and file/dir-name (cond ((dired-file-marker file/dir-name) + (diredp-mouse-unmark event) + (message "Unmarked: %s" file/dir-name)) + (t + (diredp-mouse-mark event) + (message "Marked: %s" file/dir-name)))))) + +;; This can be bound to [S-mouse-1] to give behavior similar to Windows Explorer. +;; If you do that, consider binding `diredp-mouse-mark/unmark' to `C-mouse-1'. +;; Alternatively, just bind `diredp-mouse-mark/unmark-mark-region-files' to [S-mouse-1]. +;;;###autoload +(defun diredp-mouse-mark-region-files (event) ; Bound to `S-mouse-1' + "Mark files between point and the mouse." + (interactive "e") + (call-interactively 'mouse-save-then-kill) + (diredp-mark-region-files)) + +;; This can be bound to [S-mouse-1] to give behavior similar to Windows Explorer. +;; If you don't bind `diredp-mouse-mark/unmark' to, for instance, `C-mouse-1', then +;; Consider binding this to [S-mouse-1]. +;;;###autoload +(defun diredp-mouse-mark/unmark-mark-region-files (event) ; Not bound + "Mark/unmark file or mark files in region. +If the file the cursor is on is marked, then mark all files between it + and the line clicked (included). +Otherwise (cursor's file is unmarked): + If the file clicked is marked, then unmark it. + If it is unmarked, then mark it." + (interactive "e") + (let ((mouse-pos (event-start event))) + ;; If same click same line as cursor, or cursor's line is marked, + ;; Then toggle the clicked line's mark. + ;; Else mark all files in region between point and clicked line (included). + (if (or (eq (count-lines (point-min) (posn-point mouse-pos)) + (count-lines (point-min) (point))) + (equal dired-marker-char (dired-file-marker (dired-get-filename nil t)))) + (diredp-mouse-mark/unmark event) + (call-interactively 'mouse-save-then-kill) + (diredp-mark-region-files)))) + +;;;###autoload +(defun diredp-mouse-flag-file-deletion (event) ; Not bound + "In Dired, flag this file for deletion. +If on a subdir headerline, mark all its files except `.' and `..'." + (interactive "e") + (let ((mouse-pos (event-start event))) + (select-window (posn-window mouse-pos)) + (goto-char (posn-point mouse-pos))) + (let ((dired-marker-char dired-del-marker)) (dired-mark 1)) + (diredp-previous-line 1)) + +;;;###autoload +(defun diredp-mouse-do-copy (event) ; Not bound + "In Dired, copy this file. +This normally preserves the last-modified date when copying." + (interactive "e") + (let ((mouse-pos (event-start event))) + (select-window (posn-window mouse-pos)) + (goto-char (posn-point mouse-pos))) + (dired-do-create-files 'copy #'dired-copy-file (if dired-copy-preserve-time "Copy [-p]" "Copy") + 1 dired-keep-marker-copy)) + +;;;###autoload +(defun diredp-mouse-do-rename (event) ; Not bound + "In Dired, rename this file." + (interactive "e") + (let ((mouse-pos (event-start event))) + (select-window (posn-window mouse-pos)) + (goto-char (posn-point mouse-pos))) + (dired-do-create-files 'move #'dired-rename-file "Move" 1 dired-keep-marker-rename "Rename")) + +;;;###autoload +(defun diredp-mouse-upcase (event) ; Not bound + "In Dired, rename this file to upper case." + (interactive "e") + (let ((mouse-pos (event-start event))) + (select-window (posn-window mouse-pos)) + (goto-char (posn-point mouse-pos))) + (dired-rename-non-directory #'upcase "Rename to uppercase:" nil)) + +;;;###autoload +(defun diredp-mouse-downcase (event) ; Not bound + "In Dired, rename this file to lower case." + (interactive "e") + (let ((mouse-pos (event-start event))) + (select-window (posn-window mouse-pos)) + (goto-char (posn-point mouse-pos))) + (dired-rename-non-directory #'downcase "Rename to lowercase:" nil)) + +;;;###autoload +(defun diredp-mouse-do-delete (event) ; Not bound + "In Dired, delete this file, upon confirmation." + (interactive "e") + (let ((mouse-pos (event-start event))) + (select-window (posn-window mouse-pos)) + (goto-char (posn-point mouse-pos))) + (diredp-internal-do-deletions (dired-map-over-marks (cons (dired-get-filename) (point)) 1) + 1 + 'USE-TRASH-CAN) ; This arg is for Emacs 24+ only. + (diredp-previous-line 1)) + +;;;###autoload +(defun diredp-mouse-do-shell-command (event) ; Not bound + "Run a shell COMMAND on this file. +If there is output, it goes to a separate buffer. + +No automatic redisplay of Dired buffers is attempted, as there's no +telling what files the command may have changed. Type +\\[dired-do-redisplay] to redisplay. + +The shell command has the top level directory as working directory, so +output files usually are created there instead of in a subdir." + ;;Functions dired-run-shell-command and dired-shell-stuff-it do the + ;;actual work and can be redefined for customization. + (interactive "e") + (lexical-let ((mouse-pos (event-start event)) + (command (dired-read-shell-command "! on %s: " nil (dired-get-marked-files t nil)))) + (select-window (posn-window mouse-pos)) + (goto-char (posn-point mouse-pos)) + (dired-bunch-files (- 10000 (length command)) + (lambda (&rest files) (dired-run-shell-command (dired-shell-stuff-it command files t 1))) + nil + (dired-get-marked-files t 1)))) + +;;;###autoload +(defun diredp-mouse-do-symlink (event) ; Not bound + "Make symbolic link to this file." + (interactive "e") + (let ((mouse-pos (event-start event))) + (select-window (posn-window mouse-pos)) + (goto-char (posn-point mouse-pos))) + (dired-do-create-files 'symlink #'make-symbolic-link "Symlink" 1 dired-keep-marker-symlink)) + +;;;###autoload +(defun diredp-mouse-do-hardlink (event) ; Not bound + "Make hard link (alias) to this file." + (interactive "e") + (let ((mouse-pos (event-start event))) + (select-window (posn-window mouse-pos)) + (goto-char (posn-point mouse-pos))) + (dired-do-create-files 'hardlink #'add-name-to-file "Hardlink" 1 dired-keep-marker-hardlink)) + +;;;###autoload +(defun diredp-mouse-do-print (event) ; Not bound + "Print this file. +Uses the shell command coming from variables `lpr-command' and +`lpr-switches' as default." + (interactive "e") + (let ((mouse-pos (event-start event))) + (select-window (posn-window mouse-pos)) + (goto-char (posn-point mouse-pos))) + (let* ((file (dired-get-filename)) + (command (dired-mark-read-string "Print %s with: " + (apply 'concat lpr-command " " lpr-switches) + 'print 1 (list file)))) + (dired-run-shell-command (dired-shell-stuff-it command (list file) nil)))) + +;;;###autoload +(defun diredp-mouse-do-grep (event) ; Not bound + "Run grep against this file." + (interactive "e") + (let ((mouse-pos (event-start event))) + (select-window (posn-window mouse-pos)) + (goto-char (posn-point mouse-pos))) + (unless grep-command (grep-compute-defaults)) + (grep (diredp-do-grep-1 (list (dired-get-filename t))))) + +;;;###autoload +(defun diredp-mouse-do-compress (event) ; Not bound + "Compress or uncompress this file." + (interactive "e") + (let ((mouse-pos (event-start event)) + (dired-no-confirm t)) + (select-window (posn-window mouse-pos)) + (goto-char (posn-point mouse-pos)) + (dired-map-over-marks-check #'dired-compress 1 'compress t)) + (diredp-previous-line 1)) + +;;;###autoload +(defun diredp-mouse-do-byte-compile (event) ; Not bound + "Byte compile this file." + (interactive "e") + (let ((mouse-pos (event-start event)) + (dired-no-confirm t)) + (select-window (posn-window mouse-pos)) + (goto-char (posn-point mouse-pos)) + (dired-map-over-marks-check #'dired-byte-compile 1 'byte-compile t)) + (diredp-previous-line 1)) + +;;;###autoload +(defun diredp-mouse-do-load (event) ; Not bound + "Load this Emacs Lisp file." + (interactive "e") + (let ((mouse-pos (event-start event)) + (dired-no-confirm t)) + (select-window (posn-window mouse-pos)) + (goto-char (posn-point mouse-pos)) + (dired-map-over-marks-check #'dired-load 1 'load t)) + (diredp-previous-line 1)) + +;;;###autoload +(defun diredp-mouse-do-chmod (event) ; Not bound + "Change the mode of this file. +This calls chmod, so symbolic modes like `g+w' are allowed." + (interactive "e") + (let ((mouse-pos (event-start event))) + (select-window (posn-window mouse-pos)) + (goto-char (posn-point mouse-pos))) + (dired-do-chxxx "Mode" "chmod" 'chmod 1) + (diredp-previous-line 1)) + +(unless (memq system-type '(windows-nt ms-dos)) + (defun diredp-mouse-do-chgrp (event) ; Not bound + "Change the group of this file." + (interactive "e") + (let ((mouse-pos (event-start event))) + (select-window (posn-window mouse-pos)) + (goto-char (posn-point mouse-pos))) + (dired-do-chxxx "Group" "chgrp" 'chgrp 1) + (diredp-previous-line 1))) + +(unless (memq system-type '(windows-nt ms-dos)) + (defun diredp-mouse-do-chown (event) ; Not bound + "Change the owner of this file." + (interactive "e") + (let ((mouse-pos (event-start event))) + (select-window (posn-window mouse-pos)) + (goto-char (posn-point mouse-pos))) + (dired-do-chxxx "Owner" dired-chown-program 'chown 1) + (diredp-previous-line 1))) + + +;;; Breadcrumbs + +(when (fboundp 'define-minor-mode) + + ;; Macro `define-minor-mode' is not defined in Emacs 20, so in order to be able to byte-compile + ;; this file in Emacs 20, prohibit byte-compiling of the `define-minor-mode' call. + ;; + (eval '(define-minor-mode diredp-breadcrumbs-in-header-line-mode + "Toggle the use of breadcrumbs in Dired header line. +With arg, show breadcrumbs iff arg is positive." + :init-value nil :group 'header-line :group 'Dired-Plus + (unless (derived-mode-p 'dired-mode) + (error "You must be in Dired or a mode derived from it to use this command")) + (if diredp-breadcrumbs-in-header-line-mode + (diredp-set-header-line-breadcrumbs) + (setq header-line-format (default-value 'header-line-format))))) + + (defun diredp-set-header-line-breadcrumbs () + "Show a header line with breadcrumbs to parent directories." + (let ((parent (diredp-parent-dir default-directory)) + (dirs ()) + (text "")) + (while parent + (push parent dirs) + (setq parent (diredp-parent-dir parent))) + (dolist (dir dirs) + (let* ((crumbs-map (make-sparse-keymap)) + (menu-map (make-sparse-keymap "Breadcrumbs in Header Line")) + ;; The next three are for showing the root as absolute and the rest as relative. + (rootp (diredp-root-directory-p dir)) + (parent-rootp (and (not rootp) (diredp-root-directory-p (diredp-parent-dir dir)))) + (rdir dir)) + ;; (define-key crumbs-map [header-line mouse-3] menu-map) + (unless rootp (setq rdir (file-name-nondirectory (directory-file-name dir)))) + (when dir + (setq rdir (propertize rdir + 'local-map (progn (define-key crumbs-map [header-line mouse-1] + `(lambda () (interactive) + (dired ,dir dired-actual-switches))) + (define-key crumbs-map [header-line mouse-2] + `(lambda () (interactive) + (dired-other-window ,dir dired-actual-switches))) + crumbs-map) + 'mouse-face 'mode-line-highlight + ;;'help-echo "mouse-1: Dired; mouse-2: Dired in other window; mouse-3: Menu")) + 'help-echo "mouse-1: Dired; mouse-2: Dired in other window")) + (setq text (concat text (if (or rootp parent-rootp) " " " / ") rdir))))) + (make-local-variable 'header-line-format) + (setq header-line-format text))) + + ;; Users can do this. + ;; + ;; (add-hook 'dired-before-readin-hook 'diredp-breadcrumbs-in-header-line-mode) + + ) + + +;;; `Dired+' Help + +;;;###autoload +(defun diredp-describe-mode (&optional buffer) + "Describe Dired mode, including Dired+ features. +This is `describe-mode' plus a description of Dired+ features. +For just the latter, use \\`\\[diredp-dired-plus-help]'." + (interactive "@") + (unless (derived-mode-p 'dired-mode) + (error "Use `diredp-dired-plus-help' if you want information about Dired+")) + (with-current-buffer (or buffer (current-buffer)) (describe-mode)) + (with-current-buffer (get-buffer-create "*Help*") + (save-excursion + (goto-char (point-min)) + (diredp-dired-plus-help-link) + (let ((buffer-read-only nil)) (insert "\n")) + (when (re-search-forward "Keybindings:\nkey\\s-+binding\n---\\s-+-------" nil t) + (goto-char (match-beginning 0)) + (let ((buffer-read-only nil)) + (insert "\f\n") + (diredp-dired-plus-description+links) + (insert "\f\n")))))) + +;;;###autoload +(defun diredp-dired-plus-help () + "Describe Dired+." + (interactive "@") + (diredp-with-help-window "*Help*" (diredp-dired-plus-description+links))) + +(defun diredp-dired-plus-description+links () + "Insert Dired+ help text in `*Help*'." + (with-current-buffer (get-buffer-create "*Help*") + (let ((buffer-read-only nil)) + (save-restriction + (narrow-to-region (point) (point)) + (diredp-dired-plus-help-link) + (insert (diredp-dired-plus-description)) + (goto-char (point-max)) + (insert "\n") + (diredp-dired-plus-help-link))))) + +(when (and (> emacs-major-version 21) + (require 'help-mode nil t) + (get 'help-xref 'button-category-symbol)) ; `button.el' + (define-button-type 'diredp-help-button + :supertype 'help-xref + 'help-function #'(lambda () (browse-url "https://www.emacswiki.org/emacs/DiredPlus")) + 'help-echo + (purecopy "mouse-2, RET: Dired+ documentation on the Emacs Wiki (requires \ +Internet access)"))) + +(defun diredp-dired-plus-help-link () + "Add Web link for Dired+ help, and reminder about sending bug report." + ;; Don't bother to do this for Emacs 21.3. Its `help-insert-xref-button' is different. + (when (and (> emacs-major-version 21) + (require 'help-mode nil t) + (fboundp 'help-insert-xref-button)) ; `help-mode.el'. + (let ((buffer-read-only nil)) + (help-insert-xref-button "[Dired+ Help on the Web]" 'diredp-help-button) + (insert (substitute-command-keys + "\t\tSend a Dired+ bug report:\n\t\t\t\t\t`\\[diredp-send-bug-report]'\n"))))) + +(defun diredp-dired-plus-description () + "Dired+ description." + (substitute-command-keys + (concat + "\\\ + Dired+ Features + --------------- + +To see or customize the Dired+ options or faces, use +`M-x customize-option diredp TAB' or `M-x customize-face diredp TAB'. + +Most keys listed here are in addition to those for vanilla Dired. + +Menus +----- + +Many Dired+ actions are available from the menu-bar menus and the +`mouse-3' context menu. This may include commands shown here as not +being bound to keys (i.e., listed as `M-x ...'). + +General Here +------------ + +" + (and (fboundp 'diredp-w32-drives) + " \\[diredp-w32-drives]\t\t- Go up to a list of MS Windows drives +") + (and (fboundp 'dired-hide-details-mode) + " \\[dired-hide-details-mode]\t\t- Hide/show details +") + + " \\[revert-buffer]\t\t- Refresh (sync and show all) + \\[diredp-toggle-find-file-reuse-dir]\t- Toggle reusing directories +" + " \\[diredp-marked-other-window]\t\t- Open Dired on marked files here + \\[diredp-dired-inserted-subdirs]\t\t- Dired separately each subdir inserted here +" + (and (featurep 'bookmark+) + " \\[diredp-highlight-autofiles-mode]\t- Toggle autofile highlighting + +") + + "General Globally +---------------- + +\\\ + \\[diredp-add-to-dired-buffer]\t- Add files to a Dired buffer + \\[diredp-fileset]\t- Open Dired on files in a fileset + \\[diredp-dired-recent-dirs]\t- Open Dired on recently used dirs + \\[diredp-dired-union]\t- Create union of some Dired buffers + \\[diredp-dired-for-files]\t- Open Dired on files located anywhere +\\\ + +Mouse +----- + + \\[diredp-mouse-3-menu]\t- Context-sensitive menu +" + + (and (where-is-internal 'diredp-mouse-describe-file dired-mode-map) + " \\[diredp-mouse-describe-file]\t- Describe file +") + + (and (where-is-internal 'diredp-mouse-describe-autofile dired-mode-map) + " \\[diredp-mouse-describe-autofile]\t- Describe autofile +") + + " \\[diredp-mouse-mark-region-files]\t\t- Mark all in region +" + + (and (fboundp 'dired-mouse-w32-browser) ; In `w32-browser.el'. + (where-is-internal 'dired-mouse-w32-browser dired-mode-map) + " \\[dired-mouse-w32-browser]\t\t- MS Windows `Open' action +") + (and (fboundp 'dired-mouse-w32-browser-reuse-dir-buffer) ; In `w32-browser.el'. + (where-is-internal 'dired-mouse-w32-browser-reuse-dir-buffer dired-mode-map) + " \\[dired-mouse-w32-browser-reuse-dir-buffer]\t- MS Windows `Open' action +") + + (and (where-is-internal 'dired-mouse-find-file dired-mode-map) + " \\[dired-mouse-find-file]\t- Open in this window +") + (and (where-is-internal 'diredp-mouse-find-file-reuse-dir-buffer dired-mode-map) + " \\[diredp-mouse-find-file-reuse-dir-buffer]\t- Open in this window +") + + (and (where-is-internal 'dired-mouse-find-file-other-window dired-mode-map) + " \\[dired-mouse-find-file-other-window]\t\t- Open in another window +") + + " \\[diredp-mouse-find-file-other-frame]\t\t- Open in another frame +" + + " +Marking +------- + + \\[dired-mark]\t\t- Mark this file/dir + \\[dired-unmark]\t\t- Unmark this file/dir + \\[dired-toggle-marks]\t\t- Toggle marked/unmarked + \\[dired-mark-sexp]\t\t- Mark all satisfying a predicate + \\[dired-unmark-all-marks]\t\t- Unmark all + \\[diredp-mark/unmark-extension]\t\t- Mark/unmark all that have a given extension +" + + (and (fboundp 'dired-mark-omitted) ; In `dired-x.el' Emacs 22+. + " \\[dired-mark-omitted]\t\t- Mark omitted +") + + " \\[diredp-mark-files-tagged-regexp]\t\t- Mark those with a tag that matches a regexp + \\[diredp-unmark-files-tagged-regexp]\t\t- Unmark those with a tag that matches a regexp + \\[diredp-mark-files-tagged-all]\t\t- Mark those with all of the given tags + \\[diredp-unmark-files-tagged-all]\t\t- Unmark those with all of the given tags + \\[diredp-mark-files-tagged-some]\t\t- Mark those with some of the given tags + \\[diredp-unmark-files-tagged-some]\t\t- Unmark those with some of the given tags + \\[diredp-mark-files-tagged-not-all]\t- Mark those without some of the given tags + \\[diredp-unmark-files-tagged-not-all]\t- Unmark those without some of the given tags + \\[diredp-mark-files-tagged-none]\t- Mark those with none of the given tags + \\[diredp-unmark-files-tagged-none]\t- Unmark those with none of the given tags +" + + " +Current file/subdir (current line) +---------------------------------- + + \\[diredp-describe-file]\t- Describe + \\[dired-find-file]\t\t- Open +" + (and (fboundp 'dired-mouse-w32-browser) ; In `w32-browser.el'. + (where-is-internal 'dired-mouse-w32-browser dired-mode-map) + " \\[dired-mouse-w32-browser]\t- MS Windows `Open' action + \\[dired-w32explore]\t- MS Windows Explorer +") + + " \\[diredp-byte-compile-this-file]\t\t- Byte-compile + \\[diredp-compress-this-file]\t\t- Compress/uncompress + \\[diredp-print-this-file]\t\t- Print + \\[diredp-relsymlink-this-file]\t\t- Create relative symlink + \\[diredp-delete-this-file]\t\t- Delete (with confirmation) + \\[diredp-rename-this-file]\t\t- Rename + \\[diredp-capitalize-this-file]\t\t- Capitalize (rename) + \\[diredp-upcase-this-file]\t\t- Rename to uppercase + \\[diredp-downcase-this-file]\t\t- Rename to lowercase + \\[diredp-ediff]\t\t- Ediff + \\[diredp-bookmark-this-file]\t\t- Bookmark +" + (and (featurep 'bookmark+) + " \\[diredp-tag-this-file]\t\t- Add some tags to this file/dir + \\[diredp-untag-this-file]\t\t- Remove some tags from this file/dir + \\[diredp-remove-all-tags-this-file]\t\t- Remove all tags from this file/dir + \\[diredp-copy-tags-this-file]\t\t- Copy the tags from this file/dir + \\[diredp-paste-add-tags-this-file]\t\t- Paste (add) copied tags to this file/dir + \\[diredp-paste-replace-tags-this-file]\t\t- Paste (replace) tags for this file/dir + \\[diredp-set-tag-value-this-file]\t\t- Set a tag value for this file/dir +") + + (and (fboundp 'dired-mouse-w32-browser-reuse-dir-buffer) ; In `w32-browser.el'. + (where-is-internal 'dired-mouse-w32-browser-reuse-dir-buffer dired-mode-map) + " \\[dired-mouse-w32-browser-reuse-dir-buffer]\t- MS Windows `Open' action + \\[dired-w32explore]\t- MS Windows Explorer +") + + " +Marked (or next prefix arg) files & subdirs here +------------------------------------------------ +" + (and (fboundp 'dired-multiple-w32-browser) ; In `w32-browser.el'. + " + \\[dired-multiple-w32-browser]\t- MS Windows `Open' action +") + + + " \\[diredp-list-marked]\t\t- List marked files and directories + \\[diredp-insert-subdirs]\t\t- Insert marked subdirectories + \\[dired-copy-filename-as-kill]\t\t- Copy names for pasting + M-o \\[dired-copy-filename-as-kill]\t\t- Copy absolute names for pasting + \\[diredp-yank-files]\t\t- Paste files whose absolute names you copied + \\[dired-do-find-marked-files]\t\t- Visit + \\[dired-do-copy]\t\t- Copy + \\[dired-do-rename]\t\t- Rename/move + \\[diredp-do-grep]\t\t- Run `grep' + \\[dired-do-search]\t\t- Search +" + (and (fboundp 'dired-do-find-regexp) ; Emacs 25+ + " \\[dired-do-find-regexp]\t\t- Search using `find' +") + + (if (fboundp 'dired-do-query-replace-regexp) ; Emacs 22+ + " \\[dired-do-query-replace-regexp]\t\t- Query-replace +" + " \\[dired-do-query-replace]\t\t- Query-replace +") + + (and (fboundp 'dired-do-find-regexp-and-replace) + " \\[dired-do-find-regexp-and-replace]\t\t- Query-replace using `find' +") + + (and (fboundp 'dired-do-isearch) + " \\[dired-do-isearch]\t- Isearch + \\[dired-do-isearch-regexp]\t- Regexp isearch +") + + (and (fboundp 'dired-do-async-shell-command) + " \\[dired-do-async-shell-command]\t\t- Run shell command asynchronously +") + + " \\[dired-do-shell-command]\t\t- Run shell command + \\[diredp-marked-other-window]\t\t- Dired + \\[dired-do-compress]\t\t- Compress + \\[dired-do-byte-compile]\t\t- Byte-compile + \\[dired-do-load]\t\t- Load (Emacs Lisp) + \\[diredp-do-apply-function]\t\t- Apply Lisp function + \\[diredp-do-emacs-command]\t\t- Invoke Emacs command +" + (and (fboundp 'diredp-read-expression) ; Emacs 22+ + " \\[diredp-do-lisp-sexp]\t\t- Evaluate Lisp sexp +") + + " \\[diredp-omit-marked]\t- Omit + \\[diredp-omit-unmarked]\t- Omit unmarked +" + + (and (featurep 'bookmark+) + " + \\[diredp-do-tag]\t\t- Add some tags to marked + \\[diredp-do-untag]\t\t- Remove some tags from marked + \\[diredp-do-remove-all-tags]\t\t- Remove all tags from marked + \\[diredp-do-paste-add-tags]\t- Paste (add) copied tags to marked + \\[diredp-do-paste-replace-tags]\t\t- Paste (replace) tags for marked + \\[diredp-do-set-tag-value]\t\t- Set a tag value for marked + \\[diredp-mark-files-tagged-regexp]\t\t- Mark those with a tag that matches a regexp + \\[diredp-mark-files-tagged-all]\t\t- Mark those with all of the given tags + \\[diredp-mark-files-tagged-some]\t\t- Mark those with some of the given tags + \\[diredp-mark-files-tagged-not-all]\t- Mark those without some of the given tags + \\[diredp-mark-files-tagged-none]\t- Mark those with none of the given tags + \\[diredp-unmark-files-tagged-regexp]\t\t- Unmark those with a tag that matches a regexp + \\[diredp-unmark-files-tagged-all]\t\t- Unmark those with all of the given tags + \\[diredp-unmark-files-tagged-some]\t\t- Unmark those with some of the given tags + \\[diredp-unmark-files-tagged-not-all]\t- Unmark those without some of the given tags + \\[diredp-unmark-files-tagged-none]\t- Unmark those with none of the given tags") + + " + + \\[diredp-do-bookmark]\t\t- Bookmark +" + + (and (featurep 'bookmark+) + " \\[diredp-set-bookmark-file-bookmark-for-marked]\t\t- \ +Bookmark and create bookmark-file bookmark + \\[diredp-do-bookmark-in-bookmark-file]\t- Bookmark in specific bookmark file +") + + " +Here and below (in marked subdirs) +---------------------------------- +" + (and (fboundp 'dired-multiple-w32-browser) ; In `w32-browser.el'. + " + \\[diredp-multiple-w32-browser-recursive]\t- MS Windows `Open' action +") + + " \\[diredp-list-marked-recursive]\t\t- List marked files and directories + \\[diredp-insert-subdirs-recursive]\t\t- Insert marked subdirectories + \\[diredp-copy-filename-as-kill-recursive]\t\t- Copy names for pasting + \\[diredp-do-find-marked-files-recursive]\t\t\t- Visit + \\[diredp-do-print-recursive]\t\t\t- Print + \\[diredp-do-copy-recursive]\t\t\t- Copy + \\[diredp-do-move-recursive]\t\t\t- Move + \\[diredp-do-touch-recursive]\t\t- Touch (update timestamp) + \\[diredp-do-chmod-recursive]\t\t\t- Change mode + + \\[diredp-do-symlink-recursive]\t\t\t- Add symbolic links + \\[diredp-do-relsymlink-recursive]\t\t\t- Add relative symbolic links + \\[diredp-do-hardlink-recursive]\t\t\t- Add hard links + + \\[diredp-capitalize-recursive]\t\t- Capitalize + \\[diredp-downcase-recursive]\t\t- Downcase + \\[diredp-upcase-recursive]\t\t- Upcase +" + (and (fboundp 'epa-dired-do-encrypt) ; Emacs 23+ + " + \\[diredp-do-encrypt-recursive]\t\t- Encrypt + \\[diredp-do-decrypt-recursive]\t\t- Decrypt + \\[diredp-do-sign-recursive]\t\t- Sign + \\[diredp-do-verify-recursive]\t\t- Verify +") + + " + \\[diredp-do-grep-recursive]\t\t- `grep' + \\[diredp-do-search-recursive]\t\t\t- Search + \\[diredp-do-query-replace-regexp-recursive]\t\t\t- Query-replace + \\[diredp-do-isearch-recursive]\t\t- Isearch + \\[diredp-do-isearch-regexp-recursive]\t- Regexp isearch +" + (and (fboundp 'diredp-do-async-shell-command-recursive) ; Emacs 23+ + " + \\[diredp-do-async-shell-command-recursive]\t\t\t- Run shell command asynchronously +") + + " \\[diredp-do-shell-command-recursive]\t\t\t- Run shell command + \\[diredp-do-apply-function-recursive]\t\t\t- Apply Lisp function + + \\[diredp-marked-recursive-other-window]\t\t- Dired + \\[diredp-list-marked-recursive]\t\t- List + + \\[diredp-image-dired-comment-files-recursive]\t\t- Add image comment + \\[diredp-image-dired-display-thumbs-recursive]\t\t- Show thumbnail images + \\[diredp-image-dired-tag-files-recursive]\t\t- Tag images + \\[diredp-image-dired-delete-tag-recursive]\t\t- Delete image tags + + \\[diredp-do-bookmark-recursive]\t\t- Bookmark +" + (and (featurep 'bookmark+) + " \\[diredp-do-bookmark-in-bookmark-file-recursive]\t\t- Bookmark in bookmark file + \\[diredp-set-bookmark-file-bookmark-for-marked-recursive]\t\t- Create bookmark-file bookmark +") + + " + \\[diredp-mark-directories-recursive]\t\t- Mark directories + \\[diredp-mark-executables-recursive]\t\t- Mark executables + \\[diredp-mark-symlinks-recursive]\t\t- Mark symbolic links + \\[diredp-mark-files-containing-regexp-recursive]\t\t- Mark content regexp matches + \\[diredp-mark-files-regexp-recursive]\t\t- Mark filename regexp matches +" + (and (featurep 'bookmark+) + " \\[diredp-mark-autofiles-recursive]\t\t- Mark autofiles +") + " \\[diredp-flag-auto-save-files-recursive]\t\t\t- Flag auto-save + \\[diredp-do-delete-recursive]\t\t\t- Delete marked (not flagged) + \\[diredp-change-marks-recursive]\t\t- Change marks + \\[diredp-unmark-all-files-recursive]\t\t- Remove a given mark + \\[diredp-unmark-all-marks-recursive]\t\t\t- Remove all marks +" + (and (featurep 'bookmark+) +" + +Tagging +------- + + \\[diredp-tag-this-file]\t\t- Add some tags to this file/dir + \\[diredp-untag-this-file]\t\t- Remove some tags from this file/dir + \\[diredp-remove-all-tags-this-file]\t\t- Remove all tags from this file/dir + \\[diredp-copy-tags-this-file]\t\t- Copy the tags from this file/dir + \\[diredp-paste-add-tags-this-file]\t\t- Paste (add) copied tags to this file/dir + \\[diredp-paste-replace-tags-this-file]\t\t- Paste (replace) tags for this file/dir + \\[diredp-set-tag-value-this-file]\t\t- Set a tag value for this file/dir + \\[diredp-do-tag]\t\t- Add some tags to marked + \\[diredp-do-untag]\t\t- Remove some tags from marked + \\[diredp-do-remove-all-tags]\t\t- Remove all tags from marked + \\[diredp-do-paste-add-tags]\t- Paste (add) copied tags to marked + \\[diredp-do-paste-replace-tags]\t\t- Paste (replace) tags for marked + \\[diredp-do-set-tag-value]\t\t- Set a tag value for marked + \\[diredp-mark-files-tagged-regexp]\t\t- Mark those with a tag that matches a regexp + \\[diredp-mark-files-tagged-all]\t\t- Mark those with all of the given tags + \\[diredp-mark-files-tagged-some]\t\t- Mark those with some of the given tags + \\[diredp-mark-files-tagged-not-all]\t- Mark those without some of the given tags + \\[diredp-mark-files-tagged-none]\t- Mark those with none of the given tags + \\[diredp-unmark-files-tagged-regexp]\t\t- Unmark those with a tag that matches a regexp + \\[diredp-unmark-files-tagged-all]\t\t- Unmark those with all of the given tags + \\[diredp-unmark-files-tagged-some]\t\t- Unmark those with some of the given tags + \\[diredp-unmark-files-tagged-not-all]\t- Unmark those without some of the given tags + \\[diredp-unmark-files-tagged-none]\t- Unmark those with none of the given tags +") + + " +Bookmarking +----------- + + \\[diredp-bookmark-this-file]\t\t- Bookmark this file/dir + \\[diredp-do-bookmark]\t\t- Bookmark marked" + + (and (featurep 'bookmark+) + " + \\[diredp-set-bookmark-file-bookmark-for-marked]\t\t- \ +Bookmark marked and create bookmark-file bookmark + \\[diredp-do-bookmark-in-bookmark-file]\t- Bookmark marked, in specific bookmark file +") + + " \\[diredp-do-bookmark-recursive]\t- Bookmark marked, here and below +" + (and (featurep 'bookmark+) + " \\[diredp-do-bookmark-in-bookmark-file-recursive]\t- \ +Bookmark marked, here and below, in specific file + \\[diredp-set-bookmark-file-bookmark-for-marked-recursive]\t- \ +Set bookmark-file bookmark for marked here and below +") + + ))) + +(when (> emacs-major-version 21) + (defun diredp-nb-marked-in-mode-name () + "Show number of marked, flagged, and current-list lines in mode-line. +\(Flagged means flagged for deletion.) +If the current line is marked/flagged and there are others +marked/flagged after it then show `N/M', where `N' is the number +marked/flagged through the current line and `M' is the total number +marked/flagged. + +If the current line is for a file then show `L/T', where `L' is the +line number in the current listing and `T' is the number of files in +that listing. If option `diredp-count-.-and-..-flag' is non-nil then +count also `.' and `..'. + +Also abbreviate `mode-name', using \"Dired/\" instead of \"Dired by\"." + (let ((mname (format-mode-line mode-name))) + ;; Property `dired+-mode-name' indicates whether `mode-name' has been changed. + (unless (get-text-property 0 'dired+-mode-name mname) + (save-match-data + (setq mode-name + `(,(propertize (if (string-match "^[dD]ired \\(by \\)?\\(.*\\)" mname) + (format "Dired/%s" (match-string 2 mname)) + mname) + 'dired+-mode-name t) + (:eval (let* ((dired-marker-char (if (eq ?D dired-marker-char) + ?* ; `dired-do-flagged-delete' binds it. + dired-marker-char)) + (marked-regexp (dired-marker-regexp)) + (nb-marked (count-matches marked-regexp + (point-min) (point-max)))) + (if (not (> nb-marked 0)) + "" + (propertize + (format " %s%d%c" + (save-excursion + (forward-line 0) + (if (diredp-looking-at-p (concat marked-regexp ".*")) + (format "%d/" (1+ (count-matches + marked-regexp + (point-min) (point)))) + "")) + nb-marked dired-marker-char) + 'face 'diredp-mode-line-marked 'dired+-mode-name t)))) + (:eval (let* ((flagged-regexp (let ((dired-marker-char dired-del-marker)) + (dired-marker-regexp))) + (nb-flagged (count-matches flagged-regexp + (point-min) (point-max)))) + (if (not (> nb-flagged 0)) + "" + (propertize + (format " %s%dD" + (save-excursion + (forward-line 0) + (if (diredp-looking-at-p (concat flagged-regexp ".*")) + (format "%d/" (1+ (count-matches + flagged-regexp + (point-min) (point)))) + "")) + nb-flagged) + 'face 'diredp-mode-line-flagged)))) + (:eval (save-excursion + (let ((this 0) + (total 0) + (o-pt (line-beginning-position)) + (e-pt (or (condition-case nil + (let ((diredp-wrap-around-flag nil)) + (save-excursion + (diredp-next-subdir 1) + (line-beginning-position))) + (error nil)) + (save-excursion (goto-char (point-max)) (line-beginning-position))))) + (when dired-subdir-alist (dired-goto-subdir (dired-current-directory))) + (while (and (<= (point) e-pt) + (< (point) (point-max))) ; Hack to work around Emacs display-engine bug. + (when (condition-case nil + (dired-get-filename nil diredp-count-.-and-..-flag) + (error nil)) + (when (<= (line-beginning-position) o-pt) (setq this (1+ this))) + (setq total (1+ total))) + (forward-line 1)) + (if (not (> this 0)) (format " %d" total) (format " %d/%d" this total))))))))))) + + (add-hook 'dired-after-readin-hook 'diredp-nb-marked-in-mode-name) + ;; This one is needed for `find-dired', because it does not call `dired-readin'. + (add-hook 'dired-mode-hook 'diredp-nb-marked-in-mode-name)) + +;;;###autoload +(defun diredp-send-bug-report () + "Send a bug report about a Dired+ problem." + (interactive) + (browse-url (format (concat "mailto:" "drew.adams" "@" "oracle" ".com?subject=\ +Dired+ bug: \ +&body=Describe bug below, using a precise recipe that starts with `emacs -Q' or `emacs -q'. \ +File `dired+.el' has a header `Update #' that you can use to identify it.\ +%%0A%%0AEmacs version: %s.") + (emacs-version)))) + +(defun diredp-visit-ignore-regexp () ; Taken from `image-file-name-regexp'. + "Return a regular expression matching file names to skip. +This is used by `dired-visit-(next|previous)'." + (let ((exts-regexp (and diredp-visit-ignore-extensions + (concat "\\." (regexp-opt (nconc (mapcar #'upcase diredp-visit-ignore-extensions) + diredp-visit-ignore-extensions) + t) + "\\'")))) + (if diredp-visit-ignore-regexps + (mapconcat #'identity (if exts-regexp + (cons exts-regexp diredp-visit-ignore-regexps) + diredp-visit-ignore-regexps) + "\\|") + exts-regexp))) + +;;;###autoload +(defun diredp-visit-next-file (&optional arg) ; Bound to `C-down' + "Move down a line and visit its file in another window. +With numeric prefix arg N, move down N-1 lines first. + +After moving N lines, skip any lines with file names that match either +`diredp-visit-ignore-extensions' or `diredp-visit-ignore-regexps'. + +Kill the last buffer visited by a `dired-visit-*' command." + (interactive "p") + (dired-next-line arg) + (while (diredp-string-match-p (diredp-visit-ignore-regexp) (dired-get-file-for-visit)) + (dired-next-line 1)) + (diredp-visit-this-file)) + +;;;###autoload +(defun diredp-visit-previous-file (&optional arg) ; Bound to `C-up' + "Move up a line and visit its file in another window. +With numeric prefix arg N, move up N-1 lines first. + +After moving N lines, skip any lines with file names that match either +`diredp-visit-ignore-extensions' or `diredp-visit-ignore-regexps'. + +Kill the last buffer visited by a `dired-visit-*' command." + (interactive "p") + (dired-previous-line arg) + (while (diredp-string-match-p (diredp-visit-ignore-regexp) (dired-get-file-for-visit)) + (dired-previous-line 1)) + (diredp-visit-this-file)) + +;;;###autoload +(defun diredp-visit-this-file () ; Bound to `e' (replaces `dired-find-file' binding) + "View the file on this line in another window in the same frame. +If it was not already shown there then kill the previous buffer +visited by a `dired-visit-*' command. + +If it was already shown there, and if it and Dired are the only +windows there, then delete its window (toggle : show/hide the file)." + (interactive) + (let ((file (dired-get-file-for-visit)) + (obuf (current-buffer)) + (shown nil) + fwin) + (unless (or (and (fboundp 'window-parent) (window-parent)) + (not (one-window-p 'NOMINI))) + (split-window)) + (save-selected-window + (other-window 1) + (setq fwin (selected-window)) + (unless (or (setq shown (or (equal (current-buffer) (get-file-buffer file)) + (memq (current-buffer) (dired-buffers-for-dir file)))) + (equal obuf (current-buffer))) + (kill-buffer (current-buffer)))) + (if shown + (when (= 2 (count-windows 'NOMINI)) (delete-window fwin)) + (set-window-buffer fwin (find-file-noselect file))))) + +;;; Key Bindings. + + +;; Menu Bar. +;; New order is (left -> right): +;; +;; Dir Regexp Mark Multiple Single + +;; Get rid of menu bar predefined in `dired.el'. +(define-key dired-mode-map [menu-bar] nil) +;; Get rid of Edit menu bar menu to save space. +(define-key dired-mode-map [menu-bar edit] 'undefined) + + +;; `Single' menu. +;; +;; REPLACE ORIGINAL `Immediate' menu in `dired.el'. +;; +(defvar diredp-menu-bar-single-menu (make-sparse-keymap "Single")) +(define-key dired-mode-map [menu-bar immediate] (cons "Single" diredp-menu-bar-single-menu)) + +;; We don't use `define-obsolete-variable-alias' so that byte-compilation in older Emacs +;; works for newer Emacs too. +(when (fboundp 'defvaralias) ; Emacs 22+ + (defvaralias 'diredp-menu-bar-immediate-menu 'diredp-menu-bar-single-menu)) +(make-obsolete-variable 'diredp-menu-bar-immediate-menu 'diredp-menu-bar-single-menu) ; 2017-04-09 + +(if (fboundp 'diredp-describe-file) + (define-key diredp-menu-bar-single-menu [diredp-describe-file] + '(menu-item "Describe" diredp-describe-file + :help "Describe the file or directory at cursor")) + (define-key diredp-menu-bar-single-menu [diredp-describe-autofile] + '(menu-item "Describe" diredp-describe-autofile + :help "Describe the autofile at cursor" + :enable (featurep 'bookmark+)))) +(define-key diredp-menu-bar-single-menu [separator-describe] '("--")) ; --------------------- + +(when (fboundp 'diredp-chown-this-file) + (define-key diredp-menu-bar-single-menu [chown] + '(menu-item "Change Owner..." diredp-chown-this-file + :help "Change the owner of file at cursor"))) +(when (fboundp 'diredp-chgrp-this-file) + (define-key diredp-menu-bar-single-menu [chgrp] + '(menu-item "Change Group..." diredp-chgrp-this-file + :help "Change the group of file at cursor"))) +(define-key diredp-menu-bar-single-menu [chmod] + '(menu-item "Change Mode..." diredp-chmod-this-file + :help "Change mode (attributes) of file at cursor")) +(when (fboundp 'dired-do-touch) ; Emacs 22+ + (define-key diredp-menu-bar-single-menu [touch] + '(menu-item "Change Timestamp (`touch')..." diredp-touch-this-file + :help "Change the timestamp of file at cursor, using `touch'"))) +(define-key diredp-menu-bar-single-menu [separator-change] '("--")) ; ----------------------- + +(define-key diredp-menu-bar-single-menu [print] + '(menu-item "Print..." diredp-print-this-file + :help "Print file at cursor, supplying print command")) +(define-key diredp-menu-bar-single-menu [grep] + '(menu-item "Grep..." diredp-grep-this-file :help "Grep file at cursor")) +(define-key diredp-menu-bar-single-menu [compress] + '(menu-item "Compress/Uncompress" diredp-compress-this-file + :help "Compress/uncompress file at cursor")) +(define-key diredp-menu-bar-single-menu [command] + '(menu-item "Shell Command..." diredp-shell-command-this-file + :help "Run a shell command on file at cursor")) +(define-key diredp-menu-bar-single-menu [diredp-async-shell-command-this-file] + '(menu-item "Asynchronous Shell Command..." diredp-async-shell-command-this-file + :help "Run a shell command asynchronously on file at cursor")) +(define-key diredp-menu-bar-single-menu [compile] + '(menu-item "Byte Compile" diredp-byte-compile-this-file + :help "Byte-compile this Emacs Lisp file")) +(define-key diredp-menu-bar-single-menu [load] + '(menu-item "Load" diredp-load-this-file + :help "Load this Emacs Lisp file")) + +(when (fboundp 'mkhtml-dired-files) ; In `mkhtml.el'. + (define-key diredp-menu-bar-single-menu [mkhtml-dired-files] + '(menu-item "Create HTML" mkhtml-dired-files + :help "Create an HTML file corresponding to file at cursor"))) +(define-key diredp-menu-bar-single-menu [separator-misc] '("--")) ; ------------------------- + +(define-key diredp-menu-bar-single-menu [delete] + '(menu-item "Delete" diredp-delete-this-file :help "Delete file at cursor")) +(define-key diredp-menu-bar-single-menu [separator-delete] '("--")) ; ----------------------- + +(define-key diredp-menu-bar-single-menu [backup-diff] + '(menu-item "Diff with Backup" dired-backup-diff + :help "Diff file at cursor with its latest backup")) +(define-key diredp-menu-bar-single-menu [diff] + '(menu-item "Diff..." dired-diff + :help "Compare file at cursor with another file using `diff'")) +(define-key diredp-menu-bar-single-menu [ediff] + '(menu-item "Compare..." diredp-ediff :help "Compare file at cursor with another file")) +(define-key diredp-menu-bar-single-menu [separator-diff] '("--")) ; ------------------------- + +(define-key diredp-menu-bar-single-menu [diredp-kill-this-tree] + '(menu-item "Remove This Inserted Subdir and Lower" diredp-kill-this-tree + :visible (and (fboundp 'diredp-kill-this-tree) + (not (equal + (expand-file-name (dired-current-directory)) + (expand-file-name default-directory)))))) ; In subdir, not top. +(define-key diredp-menu-bar-single-menu [dired-kill-subdir] + '(menu-item "Remove This Inserted Subdir" dired-kill-subdir + :visible (not (equal (expand-file-name (dired-current-directory)) + (expand-file-name default-directory))))) ; In subdir, not top. +(define-key diredp-menu-bar-single-menu [diredp-dired-this-subdir] + '(menu-item "Dired This Inserted Subdir (Tear Off)" + (lambda () (interactive) (diredp-dired-this-subdir t)) + :visible (and (cdr dired-subdir-alist) ; First is current dir. Must have at least one more. + (not (equal (expand-file-name (dired-current-directory)) + (expand-file-name default-directory)))) ; Must be sub, not top. + :help "Open Dired for subdir at or above point, tearing it off if inserted")) +(define-key diredp-menu-bar-single-menu [insert-subdir] + '(menu-item "Insert This Subdir" dired-maybe-insert-subdir + :visible (and (atom (diredp-this-subdir)) + (not (assoc (file-name-as-directory (diredp-this-subdir)) dired-subdir-alist))) + :enable (atom (diredp-this-subdir)) + :help "Insert a listing of this subdirectory")) +(define-key diredp-menu-bar-single-menu [goto-subdir] + '(menu-item "Go To Inserted Subdir" dired-maybe-insert-subdir + :visible (and (atom (diredp-this-subdir)) + (assoc (file-name-as-directory (diredp-this-subdir)) dired-subdir-alist)) + :enable (atom (diredp-this-subdir)) + :help "Go to the inserted listing of this subdirectory")) +(define-key diredp-menu-bar-single-menu [separator-subdir] '("--" ; ------------------------ + :visible (or (atom (diredp-this-subdir)) ; Subdir line. + (not (equal (expand-file-name (dired-current-directory)) + (expand-file-name default-directory)))))) ; Not top. + +(define-key diredp-menu-bar-single-menu [view] + '(menu-item "View (Read Only)" dired-view-file + :help "Examine file at cursor in read-only mode")) +(define-key diredp-menu-bar-single-menu [display] + '(menu-item "Display in Other Window" dired-display-file + :help "Display file at cursor in a different window")) + + +;; `Single' > `Open' menu. +;; +(defvar diredp-single-open-menu (make-sparse-keymap "Rename") + "`Open' submenu for Dired menu-bar `Single' menu.") +(define-key diredp-menu-bar-single-menu [multiple-open] (cons "Open" diredp-single-open-menu)) + +;; On Windows, bind more. +(eval-after-load "w32-browser" + '(progn + (define-key diredp-single-open-menu [dired-w32-browser] + '(menu-item "Open Associated Windows App" dired-w32-browser + :help "Open file using the Windows app associated with its file type")) + (define-key diredp-single-open-menu [dired-w32explore] + '(menu-item "Open in Windows Explorer" dired-w32explore + :help "Open file in Windows Explorer")))) +(define-key diredp-single-open-menu [find-file-other-frame] + '(menu-item "Open in Other Frame" diredp-find-file-other-frame + :help "Edit file at cursor in a different frame")) +(define-key diredp-single-open-menu [find-file-other-window] + '(menu-item "Open in Other Window" dired-find-file-other-window + :help "Edit file at cursor in a different window")) +(define-key diredp-single-open-menu [find-file] + '(menu-item "Open" dired-find-file :help "Edit file at cursor")) + + +;; `Single' > `Rename' menu. +;; +(defvar diredp-single-rename-menu (make-sparse-keymap "Rename") + "`Rename' submenu for Dired menu-bar `Single' menu.") +(define-key diredp-menu-bar-single-menu [multiple-case] (cons "Rename" diredp-single-rename-menu)) + +(define-key diredp-single-rename-menu [single-rename-capitalize] + '(menu-item "Capitalize" diredp-capitalize-this-file + :help "Capitalize (initial caps) name of file at cursor")) +(define-key diredp-single-rename-menu [single-rename-downcase] + '(menu-item "Downcase" diredp-downcase-this-file + ;; When running on plain MS-DOS, there is only one letter-case for file names. + :enable (or (not (fboundp 'msdos-long-file-names)) (msdos-long-file-names)) + :help "Rename file at cursor to a lower-case name")) +(define-key diredp-single-rename-menu [single-rename-upcase] + '(menu-item "Upcase" diredp-upcase-this-file + :enable (or (not (fboundp 'msdos-long-file-names)) (msdos-long-file-names)) + :help "Rename file at cursor to an upper-case name")) + + +;; `Single' > `Move / Copy / Link' menu. +;; +(defvar diredp-single-move-copy-link-menu (make-sparse-keymap "Move / Copy / Link") + "`Move / Copy / Link' submenu for Dired menu-bar `Single' menu.") +(define-key diredp-menu-bar-single-menu [multiple-move-copy-link] + (cons "Move / Copy / Link" diredp-single-move-copy-link-menu)) + +(define-key diredp-single-move-copy-link-menu [single-hardlink] + '(menu-item "Hardlink to..." diredp-hardlink-this-file + :help "Make hard links for current or marked files")) +(define-key diredp-single-move-copy-link-menu [single-symlink] + '(menu-item "Symlink to (Absolute)..." diredp-symlink-this-file + :help "Make absolute symbolic link for file at cursor")) +(define-key diredp-single-move-copy-link-menu [single-relsymlink] + '(menu-item "Symlink to (Relative)..." diredp-relsymlink-this-file + :help "Make relative symbolic link for file at cursor")) +(define-key diredp-single-move-copy-link-menu [single-copy] + '(menu-item "Copy to..." diredp-copy-this-file :help "Copy file at cursor")) +(define-key diredp-single-move-copy-link-menu [single-rename] + '(menu-item "Move to..." diredp-rename-this-file + :help "Rename file at cursor, or move it to a different directory")) + + +;; `Single' > `Image' menu. +;; +(defvar diredp-single-image-menu (make-sparse-keymap "Image")) +(defalias 'diredp-single-image-menu diredp-single-image-menu) +(define-key diredp-menu-bar-single-menu [image] + '(menu-item "Image" diredp-single-image-menu + :enable (let ((img-file (diredp-get-image-filename 'LOCALP 'NO-ERROR))) + (and (fboundp 'image-dired-dired-display-image) img-file)))) + +(define-key diredp-single-image-menu [diredp-image-dired-display-thumb] + '(menu-item "Go To Thumbnail" diredp-image-dired-display-thumb + :help "Pop to buffer showing the thumbnail of this image file")) +(define-key diredp-single-image-menu [diredp-image-dired-create-thumb] + '(menu-item "Create Thumbnail" diredp-image-dired-create-thumb + :help "Create a thumbnail image for this image file")) +(define-key diredp-single-image-menu [diredp-image-dired-edit-comment-and-tags] + '(menu-item "Edit Comment and Tags..." diredp-image-dired-edit-comment-and-tags + :help "Edit comment and tags for this image file")) +(define-key diredp-single-image-menu [diredp-image-dired-delete-tag] + '(menu-item "Delete Image Tag..." diredp-image-dired-delete-tag + :help "Remove an `image-dired' tag from this image file")) +(define-key diredp-single-image-menu [diredp-image-dired-tag-file] + '(menu-item "Add Tags..." diredp-image-dired-tag-file + :help "Add tags to this image file")) +(define-key diredp-single-image-menu [diredp-image-dired-comment-file] + '(menu-item "Add Comment..." diredp-image-dired-comment-file + :help "Add a comment to this image file")) +(define-key diredp-single-image-menu [diredp-image-dired-copy-with-exif-name] + '(menu-item "Copy with EXIF Name" diredp-image-dired-copy-with-exif-name + :help "Copy this image file to main image dir using EXIF name")) +(define-key diredp-single-image-menu [image-dired-dired-display-external] + '(menu-item "Display Externally" image-dired-dired-display-external + :help "Display image using external viewer")) +(define-key diredp-single-image-menu [image-dired-dired-display-image] + '(menu-item "Display to Fit Other Window" image-dired-dired-display-image + :help "Display scaled image to fit a separate window")) +(define-key diredp-single-image-menu [diredp-image-show-this-file] + '(menu-item "Display Full Size Or Smaller" diredp-image-show-this-file + :help "Display image full size or at least prefix-arg lines high")) +(define-key diredp-single-image-menu [dired-find-file] + '(menu-item "Display Full Size" dired-find-file + :help "Display image full size")) + + +;; `Single' > `Encryption' menu. +;; +(when (fboundp 'epa-dired-do-encrypt) ; Emacs 23+ + (defvar diredp-single-encryption-menu (make-sparse-keymap "Encryption")) + (define-key diredp-menu-bar-single-menu [encryption] + (cons "Encryption" diredp-single-encryption-menu)) + + (define-key diredp-single-encryption-menu [diredp-decrypt-this-file] + '(menu-item "Decrypt..." (lambda () + (interactive) + (epa-decrypt-file (expand-file-name (dired-get-filename + nil 'NO-ERROR-P)))) + :help "Decrypt this file")) + (define-key diredp-single-encryption-menu [diredp-verify-this-file] + '(menu-item "Verify..." (lambda () + (interactive) + (epa-verify-file (expand-file-name (dired-get-filename + nil 'NO-ERROR-P)))) + :help "Verify this file")) + (define-key diredp-single-encryption-menu [diredp-sign-this-file] + '(menu-item "Sign..." (lambda () + (interactive) + (epa-sign-file (expand-file-name (dired-get-filename + nil 'NO-ERROR-P)) + (epa-select-keys (epg-make-context) + "Select keys for signing. +If no one is selected, default secret key is used. " + nil t))) + :help "Encrypt this file")) + (define-key diredp-single-encryption-menu [diredp-encrypt-this-file] + '(menu-item "Encrypt..." (lambda () + (interactive) + (epa-encrypt-file (expand-file-name (dired-get-filename + nil 'NO-ERROR-P)) + (epa-select-keys + (epg-make-context) + "Select recipients for encryption. +If no one is selected, symmetric encryption will be performed. " + nil t))) + :help "Sign this file"))) + + +;; `Single' > `Bookmark' menu. +;; +(when (require 'bookmark+ nil t) + (defvar diredp-single-bookmarks-menu (make-sparse-keymap "Bookmark")) + (define-key diredp-menu-bar-single-menu [bookmark] + (cons "Bookmark" diredp-single-bookmarks-menu)) + + (define-key diredp-single-bookmarks-menu [diredp-set-tag-value-this-file] + '(menu-item "Set Tag Value..." diredp-set-tag-value-this-file + :help "Set the value (not the name) of a given tag for this file")) + (define-key diredp-single-bookmarks-menu [diredp-paste-replace-tags-this-file] + '(menu-item "Paste Tags (Replace)" diredp-paste-replace-tags-this-file + :help "Replace tags for this file with previously copied tags")) + (define-key diredp-single-bookmarks-menu [diredp-paste-add-tags-this-file] + '(menu-item "Paste Tags (Add)" diredp-paste-add-tags-this-file + :help "Add previously copied tags to this file")) + (define-key diredp-single-bookmarks-menu [diredp-copy-tags-this-file] + '(menu-item "Copy Tags" diredp-copy-tags-this-file + :help "Copy the tags from this file, so you can paste them to another")) + (define-key diredp-single-bookmarks-menu [diredp-remove-all-tags-this-file] + '(menu-item "Remove All Tags" diredp-remove-all-tags-this-file + :help "Remove all tags from the file at cursor")) + (define-key diredp-single-bookmarks-menu [diredp-untag-this-file] + '(menu-item "Remove Tags..." diredp-untag-this-file + :help "Remove some tags from the file at cursor (`C-u': remove all tags)")) + (define-key diredp-single-bookmarks-menu [diredp-tag-this-file] + '(menu-item "Add Tags..." diredp-tag-this-file :help "Add some tags to the file at cursor")) + (define-key diredp-single-bookmarks-menu [diredp-bookmark-this-file] + '(menu-item "Bookmark..." diredp-bookmark-this-file + :help "Bookmark the file at cursor (create/set autofile)"))) + + +;; `Multiple' menu. +;; +;; REPLACE ORIGINAL "Operate" menu in `dired.el'. +;; +(defvar diredp-menu-bar-multiple-menu (make-sparse-keymap "Multiple")) +(define-key dired-mode-map [menu-bar operate] (cons "Multiple" diredp-menu-bar-multiple-menu)) + +;; We don't use `define-obsolete-variable-alias' so that byte-compilation in older Emacs +;; works for newer Emacs too. +(when (fboundp 'defvaralias) ; Emacs 22+ + (defvaralias 'diredp-menu-bar-operate-menu 'diredp-menu-bar-multiple-menu)) +(make-obsolete-variable 'diredp-menu-bar-operate-menu 'diredp-menu-bar-multiple-menu) ; 2017-04-09 + +(define-key diredp-menu-bar-multiple-menu [diredp-describe-marked-autofiles] + '(menu-item "Describe Marked Autofiles" diredp-describe-marked-autofiles + :help "Show the metadata for the marked files that are autofiles" + :enable (featurep 'bookmark+))) +(define-key diredp-menu-bar-multiple-menu [separator-describe] '("--")) ; ----------------------- + +(unless (memq system-type '(windows-nt ms-dos)) + (define-key diredp-menu-bar-multiple-menu [chown] + '(menu-item "Change Owner..." dired-do-chown + :help "Change the owner of marked files"))) +(unless (memq system-type '(windows-nt ms-dos)) + (define-key diredp-menu-bar-multiple-menu [chgrp] + '(menu-item "Change Group..." dired-do-chgrp + :help "Change the owner of marked files"))) +(define-key diredp-menu-bar-multiple-menu [chmod] + '(menu-item "Change Mode..." dired-do-chmod + :help "Change mode (attributes) of marked files")) +(when (fboundp 'dired-do-touch) ; Emacs 22+ + (define-key diredp-menu-bar-multiple-menu [touch] + '(menu-item "Change Timestamp (`touch')..." dired-do-touch + :help "Change the timestamp of the marked files, using `touch'"))) +(define-key diredp-menu-bar-multiple-menu [separator-change] '("--")) ; ------------------------- + +(when (fboundp 'diredp-read-expression) ; Emacs 22+ + (define-key diredp-menu-bar-multiple-menu [diredp-do-lisp-sexp] + '(menu-item "Eval Sexp..." diredp-do-lisp-sexp + :help "Evaluate an Emacs-Lisp sexp in each marked file"))) +(define-key diredp-menu-bar-multiple-menu [diredp-do-emacs-command] + '(menu-item "Invoke Emacs Command..." diredp-do-emacs-command + :help "Invoke an Emacs command in each marked file")) +(define-key diredp-menu-bar-multiple-menu [diredp-do-apply-function] + '(menu-item "Apply Function..." diredp-do-apply-function + :help "Apply a Lisp function to each marked file name (`C-u': file contents, not name)")) +(define-key diredp-menu-bar-multiple-menu [print] + '(menu-item "Print..." dired-do-print :help "Print marked files, supplying print command")) +(define-key diredp-menu-bar-multiple-menu [compress] + '(menu-item "Compress/Uncompress" dired-do-compress :help "Compress/uncompress marked files")) +(when (fboundp 'dired-do-compress-to) + (define-key diredp-menu-bar-multiple-menu [compress-to] + '(menu-item "Compress to..." dired-do-compress-to + :help "Compress marked files and dirs together, in the same archive"))) +(define-key diredp-menu-bar-multiple-menu [command] + '(menu-item "Shell Command..." dired-do-shell-command + :help "Run a shell command on each marked file")) +(when (fboundp 'dired-do-async-shell-command) ; Emacs 23+ + (define-key diredp-menu-bar-multiple-menu [async-command] + '(menu-item "Asynchronous Shell Command..." dired-do-async-shell-command + :help "Run a shell command asynchronously on each marked file"))) +(define-key diredp-menu-bar-multiple-menu [compile] + '(menu-item "Byte Compile" dired-do-byte-compile :help "Byte-compile marked Emacs Lisp files")) +(define-key diredp-menu-bar-multiple-menu [load] + '(menu-item "Load" dired-do-load :help "Load marked Emacs Lisp files")) + +(unless (require 'bookmark+ nil t) + (define-key diredp-menu-bar-multiple-menu [diredp-bookmark-this-file] + '(menu-item "Bookmark..." diredp-bookmark-this-file :help "Bookmark the file at cursor"))) +(when (fboundp 'mkhtml-dired-files) ; In `mkhtml.el'. + (define-key diredp-menu-bar-multiple-menu [mkhtml-dired-files] + '(menu-item "Create HTML" mkhtml-dired-files + :help "Create HTML files corresponding to marked files"))) +(define-key diredp-menu-bar-multiple-menu [separator-misc] '("--")) ; --------------------------- + +(define-key diredp-menu-bar-multiple-menu [diredp-copy-abs-filenames-as-kill] + '(menu-item "Copy Marked Names as Absolute" diredp-copy-abs-filenames-as-kill + :help "Copy absolute names of marked files to the kill ring" + :keys "M-0 w")) +(define-key diredp-menu-bar-multiple-menu [kill-ring] + '(menu-item "Copy Marked Names" dired-copy-filename-as-kill + :help "Copy names of marked files to the kill ring, for pasting")) +(define-key diredp-menu-bar-multiple-menu [diredp-list-marked] + '(menu-item "List Marked Files" diredp-list-marked + :help "List the files marked here (C-u C-u: all, C-u C-u C-u: all + dirs)")) +(define-key diredp-menu-bar-multiple-menu [diredp-insert-subdirs] + '(menu-item "Insert Subdirs" diredp-insert-subdirs + :help "Insert the marked subdirectories - like using `i' at each marked dir")) +;; On Windows, bind more. +(eval-after-load "w32-browser" + '(define-key diredp-menu-bar-multiple-menu [dired-multiple-w32-browser] + '(menu-item "Open Associated Windows Apps" dired-multiple-w32-browser + :help "Open files using the Windows apps associated with their file types"))) +(when (fboundp 'dired-do-find-marked-files) + (define-key diredp-menu-bar-multiple-menu [find-files] + '(menu-item "Open" dired-do-find-marked-files ; In `dired-x.el'. + :help "Open each marked file for editing"))) + + +;; `Multiple' > `Dired' menu. +;; +(defvar diredp-multiple-dired-menu (make-sparse-keymap "Dired") + "`Dired' submenu for Dired menu-bar `Multiple' menu.") +(define-key diredp-menu-bar-multiple-menu [multiple-dired] + `(menu-item "Dired" ,diredp-multiple-dired-menu + :enable (save-excursion (goto-char (point-min)) + (and (re-search-forward (dired-marker-regexp) nil t) + (re-search-forward (dired-marker-regexp) nil t))) + :help "Open Dired on marked files and dirs only")) + +(define-key diredp-multiple-dired-menu [diredp-marked-other-window] + '(menu-item "Dired Marked in Other Window" diredp-marked-other-window + :enable (save-excursion (goto-char (point-min)) + (and (re-search-forward (dired-marker-regexp) nil t) + (re-search-forward (dired-marker-regexp) nil t))) + :help "Open Dired on marked files and dirs only, in other window")) +(define-key diredp-multiple-dired-menu [diredp-marked] + '(menu-item "Dired Marked" diredp-marked + :enable (save-excursion (goto-char (point-min)) + (and (re-search-forward (dired-marker-regexp) nil t) + (re-search-forward (dired-marker-regexp) nil t))) + :help "Open Dired on marked files and dirs only")) + + +;; `Multiple' > `Omit' menu. +;; +(defvar diredp-multiple-omit-menu (make-sparse-keymap "Omit") + "`Omit' submenu for Dired menu-bar `Multiple' menu.") +(define-key diredp-menu-bar-multiple-menu [multiple-omit] (cons "Omit" diredp-multiple-omit-menu)) + +(define-key diredp-multiple-omit-menu [omit-unmarked] + '(menu-item "Omit Unmarked" diredp-omit-unmarked :help "Hide lines of unmarked files")) +(define-key diredp-multiple-omit-menu [omit-marked] + '(menu-item "Omit Marked" diredp-omit-marked :help "Hide lines of marked files")) + + +;; `Multiple' > `Delete' menu. +;; +(defvar diredp-multiple-delete-menu (make-sparse-keymap "Delete") + "`Delete' submenu for Dired menu-bar `Multiple' menu.") +(define-key diredp-menu-bar-multiple-menu [multiple-delete] (cons "Delete" diredp-multiple-delete-menu)) + +(define-key diredp-multiple-delete-menu [delete-flagged] + '(menu-item "Delete Flagged" dired-do-flagged-delete + :help "Delete all files flagged for deletion (D)")) +(define-key diredp-multiple-delete-menu [delete] + '(menu-item "Delete Marked (not Flagged)" dired-do-delete + :help "Delete current file or all marked files (not flagged files)")) + + +;; `Multiple' > `Rename' menu. +;; +(defvar diredp-multiple-rename-menu (make-sparse-keymap "Rename") + "`Rename' submenu for Dired menu-bar `Multiple' menu.") +(define-key diredp-menu-bar-multiple-menu [multiple-case] (cons "Rename" diredp-multiple-rename-menu)) + +(define-key diredp-multiple-rename-menu [multiple-rename-rename] + '(menu-item "Move to Dir... / Rename This..." dired-do-rename + :help "Move marked (or next N) files, or rename current file")) + +(define-key diredp-multiple-rename-menu [multiple-rename-capitalize] + '(menu-item "Capitalize" diredp-capitalize + :help "Capitalize (initial caps) the names of all marked files")) +(define-key diredp-multiple-rename-menu [multiple-rename-downcase] + '(menu-item "Downcase" dired-downcase + :enable (or (not (fboundp 'msdos-long-file-names)) (msdos-long-file-names)) + :help "Rename marked files to lowercase names")) +(define-key diredp-multiple-rename-menu [multiple-rename-upcase] + '(menu-item "Upcase" dired-upcase + :enable (or (not (fboundp 'msdos-long-file-names)) (msdos-long-file-names)) + :help "Rename marked files to uppercase names")) + + +;; `Multiple' > `Move / Copy / Link' menu. +;; +(defvar diredp-multiple-move-copy-link-menu (make-sparse-keymap "Move / Copy / Link") + "`Move / Copy / Link' submenu for Dired menu-bar `Multiple' menu.") +(define-key diredp-menu-bar-multiple-menu [multiple-move-copy-link] + (cons "Move / Copy / Link" diredp-multiple-move-copy-link-menu)) + +(define-key diredp-multiple-move-copy-link-menu [multiple-move-copy-link-hardlink] + '(menu-item "Hardlink to..." dired-do-hardlink + :help "Make hard links for current or marked files")) +(define-key diredp-multiple-move-copy-link-menu [multiple-move-copy-link-symlink] + '(menu-item "Symlink to (Absolute)..." dired-do-symlink ; In `dired-aux.el'. + :help "Make absolute symbolic links for current or marked files")) +(define-key diredp-multiple-move-copy-link-menu [multiple-move-copy-link-relsymlink] + '(menu-item "Symlink to (Relative)..." dired-do-relsymlink ; In `dired-x.el'. + :help "Make relative symbolic links for current or marked files")) +(define-key diredp-multiple-move-copy-link-menu [multiple-move-copy-link-copy] + '(menu-item "Copy to..." dired-do-copy :help "Copy current file or all marked files")) +(define-key diredp-multiple-move-copy-link-menu [multiple-move-copy-link-rename] + '(menu-item "Move to..." dired-do-rename :help "Rename current file or move marked files")) + + +;; `Multiple' > `Images' menu. +;; +(defvar diredp-multiple-images-menu (make-sparse-keymap "Images")) +(defalias 'diredp-multiple-images-menu diredp-multiple-images-menu) +(define-key diredp-menu-bar-multiple-menu [images] + '(menu-item "Images" diredp-multiple-images-menu + :enable (fboundp 'image-dired-display-thumbs))) + +;; We don't use `define-obsolete-variable-alias' so that byte-compilation in older Emacs +;; works for newer Emacs too. +(when (fboundp 'defvaralias) ; Emacs 22+ + (defvaralias 'diredp-menu-bar-images-menu 'diredp-multiple-images-menu)) +(make-obsolete-variable 'diredp-menu-bar-images-menu 'diredp-multiple-images-menu) ; 2017-04-09 + +;; Remove the items from `Multiple' menu. +(define-key diredp-menu-bar-multiple-menu [image-dired-delete-tag] nil) +(define-key diredp-menu-bar-multiple-menu [image-dired-tag-files] nil) +(define-key diredp-menu-bar-multiple-menu [image-dired-dired-comment-files] nil) +(define-key diredp-menu-bar-multiple-menu [image-dired-display-thumbs] nil) + +;; Add them to `Multiple' > `Images' menu. +(define-key diredp-multiple-images-menu [image-dired-delete-tag] + '(menu-item "Delete Tag..." image-dired-delete-tag + :help "Delete tag from marked image files")) +(define-key diredp-multiple-images-menu [image-dired-tag-files] + '(menu-item "Add Tags..." image-dired-tag-files + :help "Add tags to marked image files")) +(define-key diredp-multiple-images-menu [image-dired-dired-comment-files] + '(menu-item "Add Comment..." image-dired-dired-comment-files + :help "Add comment to marked image files")) +(define-key diredp-multiple-images-menu [image-dired-display-thumbs] + '(menu-item "Display Thumbnails" image-dired-display-thumbs + :help "Display thumbnails for marked image files")) +(define-key diredp-multiple-images-menu [diredp-do-display-images] + '(menu-item "Display" diredp-do-display-images + :help "Display the marked image files")) + + +;; `Multiple' > `Encryption' menu. +;; +(when (fboundp 'epa-dired-do-encrypt) ; Emacs 23+ + (defvar diredp-multiple-encryption-menu (make-sparse-keymap "Encryption")) + (define-key diredp-menu-bar-multiple-menu [encryption] + (cons "Encryption" diredp-multiple-encryption-menu)) + + ;; We don't use `define-obsolete-variable-alias' so that byte-compilation in older Emacs + ;; works for newer Emacs too. + (when (fboundp 'defvaralias) ; Emacs 22+ + (defvaralias 'diredp-menu-bar-encryption-menu 'diredp-multiple-encryption-menu)) + (make-obsolete-variable 'diredp-menu-bar-encryption-menu 'diredp-multiple-encryption-menu) ; 2017-04-09 + + (when (boundp 'diredp-menu-bar-encryption-menu) + (defalias 'diredp-menu-bar-encryption-menu diredp-menu-bar-encryption-menu)) + (make-obsolete 'diredp-menu-bar-encryption-menu 'diredp-multiple-encryption-menu) ; 2017-04-09 + + ;; Remove the items from `Multiple' menu. + (define-key diredp-menu-bar-multiple-menu [epa-dired-do-decrypt] nil) + (define-key diredp-menu-bar-multiple-menu [epa-dired-do-verify] nil) + (define-key diredp-menu-bar-multiple-menu [epa-dired-do-sign] nil) + (define-key diredp-menu-bar-multiple-menu [epa-dired-do-encrypt] nil) + + ;; Add them to `Multiple' > `Encryption' menu. + (define-key diredp-multiple-encryption-menu [epa-dired-do-decrypt] + '(menu-item "Decrypt..." epa-dired-do-decrypt :help "Decrypt the marked files")) + (define-key diredp-multiple-encryption-menu [epa-dired-do-verify] + '(menu-item "Verify..." epa-dired-do-verify :help "Verify the marked files")) + (define-key diredp-multiple-encryption-menu [epa-dired-do-sign] + '(menu-item "Sign..." epa-dired-do-sign :help "Sign the marked files")) + (define-key diredp-multiple-encryption-menu [epa-dired-do-encrypt] + '(menu-item "Encrypt..." epa-dired-do-encrypt :help "Encrypt the marked files"))) + + +;; `Multiple' > `Search' menu. +;; +(defvar diredp-multiple-search-menu (make-sparse-keymap "Search")) +(define-key diredp-menu-bar-multiple-menu [search] + (cons "Search" diredp-multiple-search-menu)) + +;; We don't use `define-obsolete-variable-alias' so that byte-compilation in older Emacs +;; works for newer Emacs too. +(when (fboundp 'defvaralias) ; Emacs 22+ + (defvaralias 'diredp-menu-bar-operate-search-menu 'diredp-multiple-search-menu)) +(make-obsolete-variable 'diredp-menu-bar-operate-search-menu 'diredp-multiple-search-menu) ; 2017-04-09 + +(when (fboundp 'dired-do-isearch-regexp) ; Emacs 23+ + (define-key diredp-multiple-search-menu [isearch-regexp] + '(menu-item "Isearch Regexp Files..." dired-do-isearch-regexp + :help "Incrementally search marked files for regexp")) + (define-key diredp-multiple-search-menu [isearch] + '(menu-item "Isearch Files..." dired-do-isearch + :help "Incrementally search marked files for string"))) +(when (fboundp 'dired-do-find-regexp-and-replace) + (define-key diredp-multiple-search-menu [find-query-replace] + '(menu-item "Query Replace Using `find'..." dired-do-find-regexp-and-replace + :help "Replace regexp in marked files using `find'"))) +(define-key diredp-multiple-search-menu [query-replace] + (if (< emacs-major-version 21) + '(menu-item "Query Replace Using TAGS Table..." dired-do-query-replace) + '(menu-item "Query Replace Using TAGS Table..." dired-do-query-replace-regexp + :help "Replace regexp in marked files using tags in a TAGS table"))) +(when (fboundp 'dired-do-find-regexp) + (define-key diredp-multiple-search-menu [find-regexp] + '(menu-item "Search Files Using `find'..." dired-do-find-regexp + :help "Search marked files for regexp using `find'"))) +(define-key diredp-multiple-search-menu [search] + '(menu-item "Search Files Using TAGS Table..." dired-do-search + :help "Search marked files for regexp using tags in a TAGS table")) +(define-key diredp-multiple-search-menu [grep] + '(menu-item "Grep..." diredp-do-grep :help "Grep marked, next N, or all files shown")) + + +;; `Multiple' > `Bookmark' menu. +;; +(defvar diredp-multiple-bookmarks-menu (make-sparse-keymap "Bookmark")) +(define-key diredp-menu-bar-multiple-menu [bookmark] + (cons "Bookmark" diredp-multiple-bookmarks-menu)) + +;; We don't use `define-obsolete-variable-alias' so that byte-compilation in older Emacs +;; works for newer Emacs too. +(when (fboundp 'defvaralias) ; Emacs 22+ + (defvaralias 'diredp-menu-bar-operate-bookmarks-menu 'diredp-multiple-bookmarks-menu)) +(make-obsolete-variable 'diredp-menu-bar-operate-bookmarks-menu 'diredp-multiple-bookmarks-menu) ; 2017-04-09 + +(when (require 'bookmark+ nil t) + (define-key diredp-multiple-bookmarks-menu [diredp-do-set-tag-value] + '(menu-item "Set Tag Value..." diredp-do-set-tag-value + :help "Set the value of a given tag for the marked or next N files")) + (define-key diredp-multiple-bookmarks-menu [diredp-do-paste-replace-tags] + '(menu-item "Paste Tags (Replace)" diredp-do-paste-replace-tags + :help "Replace tags for the marked or next N files with copied tags")) + (define-key diredp-multiple-bookmarks-menu [diredp-do-paste-add-tags] + '(menu-item "Paste Tags (Add)" diredp-do-paste-add-tags + :help "Add previously copied tags to the marked or next N files")) + (define-key diredp-multiple-bookmarks-menu [diredp-do-remove-all-tags] + '(menu-item "Remove All Tags" diredp-do-remove-all-tags + :help "Remove all tags from the marked or next N files")) + (define-key diredp-multiple-bookmarks-menu [diredp-do-untag] + '(menu-item "Remove Tags..." diredp-do-untag + :help "Remove some tags from the marked or next N files")) + (define-key diredp-multiple-bookmarks-menu [diredp-do-tag] + '(menu-item "Add Tags..." diredp-do-tag + :help "Add some tags to the marked or next N files")) + (define-key diredp-multiple-bookmarks-menu [separator-book-2] '("--"))) ; ------------ + +(define-key diredp-multiple-bookmarks-menu + [diredp-do-bookmark-in-bookmark-file-recursive] + '(menu-item "Bookmark in Bookmark File (Here and Below)..." + diredp-do-bookmark-in-bookmark-file-recursive + :help "Bookmark marked files (including in marked subdirs) in bookmark file and save it")) +(define-key diredp-multiple-bookmarks-menu + [diredp-set-bookmark-file-bookmark-for-marked-recursive] + '(menu-item "Create Bookmark-File Bookmark (Here and Below)..." + diredp-set-bookmark-file-bookmark-for-marked-recursive + :help "Create a bookmark-file bookmark for marked files, including in marked subdirs")) +(define-key diredp-multiple-bookmarks-menu [diredp-do-bookmark-dirs-recursive] + '(menu-item "Bookmark Dirs (Here and Below)..." diredp-do-bookmark-dirs-recursive + :help "Bookmark this Dired buffer and marked subdirectory Dired buffers, recursively.")) +(define-key diredp-multiple-bookmarks-menu [diredp-do-bookmark-recursive] + '(menu-item "Bookmark (Here and Below)..." diredp-do-bookmark-recursive + :help "Bookmark the marked files, including those in marked subdirs")) +(define-key diredp-multiple-bookmarks-menu [separator-book-1] '("--")) ; --------------- + +(define-key diredp-multiple-bookmarks-menu [diredp-do-bookmark-in-bookmark-file] + '(menu-item "Bookmark in Bookmark File..." diredp-do-bookmark-in-bookmark-file + :help "Bookmark the marked files in BOOKMARK-FILE and save BOOKMARK-FILE")) +(define-key diredp-multiple-bookmarks-menu [diredp-set-bookmark-file-bookmark-for-marked] + '(menu-item "Create Bookmark-File Bookmark..." diredp-set-bookmark-file-bookmark-for-marked + :help "Create a bookmark-file bookmark, and bookmark the marked files in it")) +(define-key diredp-multiple-bookmarks-menu [diredp-do-bookmark] + '(menu-item "Bookmark..." diredp-do-bookmark :help "Bookmark the marked or next N files")) + + +;; `Multiple' > `Marked Here and Below' menu. +;; +(defvar diredp-multiple-recursive-menu (make-sparse-keymap "Marked Here and Below")) +(define-key diredp-menu-bar-multiple-menu [operate-recursive] + (cons "Marked Here and Below" diredp-multiple-recursive-menu)) + +;; We don't use `define-obsolete-variable-alias' so that byte-compilation in older Emacs +;; works for newer Emacs too. +(when (fboundp 'defvaralias) ; Emacs 22+ + (defvaralias 'diredp-menu-bar-operate-recursive-menu 'diredp-multiple-recursive-menu)) +(make-obsolete-variable 'diredp-menu-bar-operate-recursive-menu 'diredp-multiple-recursive-menu) ; 2017-04-09 + +(when (fboundp 'diredp-do-chown-recursive) + (define-key diredp-multiple-recursive-menu [chown] + '(menu-item "Change Owner..." diredp-do-chown-recursive + :help "Change the owner of marked files, including those in marked subdirs"))) +(when (fboundp 'diredp-do-chgrp-recursive) + (define-key diredp-multiple-recursive-menu [chgrp] + '(menu-item "Change Group..." diredp-do-chgrp-recursive + :help "Change the owner of marked files, including those in marked subdirs"))) +(define-key diredp-multiple-recursive-menu [chmod] + '(menu-item "Change Mode..." diredp-do-chmod-recursive + :help "Change mode (attributes) of marked files, including those in marked subdirs")) +(when (fboundp 'dired-do-touch) ; Emacs 22+ + (define-key diredp-multiple-recursive-menu [touch] + '(menu-item "Change Timestamp (`touch')..." diredp-do-touch-recursive + :help "Change timestamp of marked files, including those in marked subdirs"))) +(define-key diredp-multiple-recursive-menu [separator-change] '("--")) ; ---------------- + +(define-key diredp-multiple-recursive-menu [diredp-do-apply-function-recursive] + '(menu-item "Apply Lisp Function..." diredp-do-apply-function-recursive + :help "Apply a Lisp function to the marked files, including those in marked subdirs")) +(define-key diredp-multiple-recursive-menu [diredp-do-print-recursive] + '(menu-item "Print..." diredp-do-print-recursive + :help "Print the marked files, including those in marked subdirs")) +(define-key diredp-multiple-recursive-menu [diredp-do-shell-command-recursive] + '(menu-item "Shell Command..." diredp-do-shell-command-recursive + :help "Run shell command on the marked files, including those in marked subdirs")) +(when (fboundp 'dired-do-async-shell-command) ; Emacs 23+ + (define-key diredp-multiple-recursive-menu [diredp-do-async-shell-command-recursive] + '(menu-item "Asynchronous Shell Command..." diredp-do-async-shell-command-recursive + :help "Run shell command asynchronously on marked files, including in marked subdirs"))) + +(when (fboundp 'diredp-unmark-all-marks-recursive) ; Emacs 22+ + (define-key diredp-multiple-recursive-menu [separator-1] '("--")) ; ------------ + (define-key diredp-multiple-recursive-menu [diredp-change-marks-recursive] + '(menu-item "Change Mark..." diredp-change-marks-recursive + :help "Change all OLD marks to NEW marks, including those in marked subdirs")) + (define-key diredp-multiple-recursive-menu [diredp-unmark-all-files-recursive] + '(menu-item "Unmark Marked-With..." diredp-unmark-all-files-recursive + :help "Remove a given mark everywhere, including in marked subdirs")) + (define-key diredp-multiple-recursive-menu [diredp-unmark-all-marks-recursive] + '(menu-item "Unmark All..." diredp-unmark-all-marks-recursive + :help "Remove ALL marks everywhere, including in marked subdirs"))) + +(define-key diredp-multiple-recursive-menu [separator-misc] '("--")) ; ------------------ + +(define-key diredp-multiple-recursive-menu [diredp-do-delete-recursive] + '(menu-item "Delete Marked (not Flagged)" diredp-do-delete-recursive + :help "Delete marked (not flagged) files, including in marked subdirs")) +(define-key diredp-multiple-recursive-menu [separator-delete] '("--")) ; ---------------- + +(define-key diredp-multiple-recursive-menu [diredp-do-hardlink-recursive] + '(menu-item "Hardlink to..." diredp-do-hardlink-recursive + :help "Make hard links for marked files, including those in marked subdirs")) +(define-key diredp-multiple-recursive-menu [diredp-do-symlink-recursive] + '(menu-item "Symlink to (Absolute)..." diredp-do-symlink-recursive + :help "Make absolute symbolic links for marked files, including those in marked subdirs")) +(define-key diredp-multiple-recursive-menu [diredp-do-relsymlink-recursive] + '(menu-item "Symlink to (Relative)..." diredp-do-relsymlink-recursive + :help "Make relative symbolic links for marked files, including those in marked subdirs")) +(define-key diredp-multiple-recursive-menu [diredp-do-copy-recursive] + '(menu-item "Copy to..." diredp-do-copy-recursive + :help "Copy marked files, including in marked subdirs, to a given directory")) +(define-key diredp-multiple-recursive-menu [diredp-do-move-recursive] + '(menu-item "Move to..." diredp-do-move-recursive + :help "Move marked files, including in marked subdirs, to a given directory")) +(define-key diredp-multiple-recursive-menu [separator-copy-move] '("--")) ; ------------- + +(define-key diredp-multiple-recursive-menu [diredp-capitalize-recursive] + '(menu-item "Capitalize" diredp-capitalize-recursive + :enable (or (not (fboundp 'msdos-long-file-names)) (msdos-long-file-names)) + :help "Capitalize the names of all marked files, including in marked subdirs")) +(define-key diredp-multiple-recursive-menu [diredp-downcase-recursive] + '(menu-item "Downcase" diredp-downcase-recursive + :enable (or (not (fboundp 'msdos-long-file-names)) (msdos-long-file-names)) + :help "Rename marked files, including in marked subdirs, to lowercase names")) +(define-key diredp-multiple-recursive-menu [diredp-upcase-recursive] + '(menu-item "Upcase" diredp-upcase-recursive + :enable (or (not (fboundp 'msdos-long-file-names)) (msdos-long-file-names)) + :help "Rename marked files, including in marked subdirs, to uppercase names")) +(define-key diredp-multiple-recursive-menu [separator-lettercase] '("--")) ; ------------ + +(define-key diredp-multiple-recursive-menu [diredp-list-marked-recursive] + '(menu-item "List Marked Files" diredp-list-marked-recursive + :help "List the files marked here and in marked subdirs, recursively")) +(define-key diredp-multiple-recursive-menu [diredp-copy-filename-as-kill-recursive] + '(menu-item "Copy File Names (to Paste)" diredp-copy-filename-as-kill-recursive + :help "Copy names of files marked here and in marked subdirs, to `kill-ring'")) +(define-key diredp-multiple-recursive-menu [diredp-insert-subdirs-recursive] + '(menu-item "Insert Subdirs" diredp-insert-subdirs-recursive + :help "Insert the marked subdirectories, gathered recursively")) +(define-key diredp-multiple-recursive-menu [separator-dirs] '("--")) ; ------------------ + +(define-key diredp-multiple-recursive-menu [diredp-marked-recursive-other-window] + '(menu-item "Dired (Marked) in Other Window" diredp-marked-recursive-other-window + :help "Open Dired (in other window) on marked files, including those in marked subdirs")) +(define-key diredp-multiple-recursive-menu [diredp-marked-recursive] + '(menu-item "Dired (Marked)" diredp-marked-recursive + :help "Open Dired on marked files, including those in marked subdirs")) +;; On Windows, bind more. +(eval-after-load "w32-browser" + '(define-key diredp-multiple-recursive-menu [diredp-multiple-w32-browser-recursive] + '(menu-item "Open Associated Windows Apps" diredp-multiple-w32-browser-recursive + :help "Run Windows apps for with marked files, including those in marked subdirs"))) +(define-key diredp-multiple-recursive-menu [diredp-do-find-marked-files-recursive] + '(menu-item "Open" diredp-do-find-marked-files-recursive + :help "Find marked files simultaneously, including those in marked subdirs")) + + +;; `Multiple' > `Marked Here and Below' > `Images' menu. +;; +(defvar diredp-images-recursive-menu (make-sparse-keymap "Images")) +(defalias 'diredp-images-recursive-menu diredp-images-recursive-menu) + +;; We don't use `define-obsolete-variable-alias' so that byte-compilation in older Emacs +;; works for newer Emacs too. +(when (fboundp 'defvaralias) ; Emacs 22+ + (defvaralias 'diredp-menu-bar-images-recursive-menu 'diredp-images-recursive-menu)) +(make-obsolete-variable 'diredp-menu-bar-images-recursive-menu 'diredp-images-recursive-menu) ; 2017-04-09 + +(when (boundp 'diredp-menu-bar-images-recursive-menu) + (defalias 'diredp-menu-bar-images-recursive-menu diredp-menu-bar-images-recursive-menu)) +(make-obsolete 'diredp-menu-bar-images-recursive-menu 'diredp-images-recursive-menu) ; 2017-04-09 + +(define-key diredp-multiple-recursive-menu [images] + '(menu-item "Images" diredp-images-recursive-menu + :enable (fboundp 'image-dired-delete-tag))) +(define-key diredp-images-recursive-menu [diredp-image-dired-delete-tag-recursive] + '(menu-item "Delete Image Tag..." diredp-image-dired-delete-tag-recursive + :help "Remove an `image-dired' tag from marked files, including those in marked subdirs")) +(define-key diredp-images-recursive-menu [diredp-image-dired-tag-files-recursive] + '(menu-item "Add Image Tags..." diredp-image-dired-tag-files-recursive + :help "Add `image-dired' tags to marked files, including those in marked subdirs")) +(define-key diredp-images-recursive-menu [diredp-image-dired-comment-files-recursive] + '(menu-item "Add Image Comment..." diredp-image-dired-comment-files-recursive + :help "Add image comment to marked files, including those in marked subdirs")) +(define-key diredp-images-recursive-menu [diredp-image-dired-display-thumbs-recursive] + '(menu-item "Display Image Thumbnails" diredp-image-dired-display-thumbs-recursive + :help "Show thumbnails for marked image files, including those in marked subdirs")) + + +;; `Multiple' > `Marked Here and Below' > `Encryption' menu. +;; +(when (fboundp 'epa-dired-do-encrypt) ; Emacs 23+ + (defvar diredp-menu-bar-encryption-recursive-menu (make-sparse-keymap "Encryption")) + (define-key diredp-multiple-recursive-menu [encryption] + (cons "Encryption" diredp-menu-bar-encryption-recursive-menu)) + (define-key diredp-menu-bar-encryption-recursive-menu [diredp-do-decrypt-recursive] + '(menu-item "Decrypt..." diredp-do-decrypt-recursive + :help "Decrypt marked files, including those in marked subdirs")) + (define-key diredp-menu-bar-encryption-recursive-menu [diredp-do-verify-recursive] + '(menu-item "Verify..." diredp-do-verify-recursive + :help "Verify marked files, including those in marked subdirs")) + (define-key diredp-menu-bar-encryption-recursive-menu [diredp-do-sign-recursive] + '(menu-item "Sign..." diredp-do-sign-recursive + :help "Sign marked files, including those in marked subdirs")) + (define-key diredp-menu-bar-encryption-recursive-menu [diredp-do-encrypt-recursive] + '(menu-item "Encrypt..." diredp-do-encrypt-recursive + :help "Encrypt marked files, including those in marked subdirs"))) + + +;; `Multiple' > `Marked Here and Below' > `Search' menu. +;; +(defvar diredp-menu-bar-search-recursive-menu (make-sparse-keymap "Search")) +(define-key diredp-multiple-recursive-menu [search] + (cons "Search" diredp-menu-bar-search-recursive-menu)) +(when (fboundp 'dired-do-isearch-regexp) ; Emacs 23+ + (define-key diredp-menu-bar-search-recursive-menu [diredp-do-isearch-regexp-recursive] + '(menu-item "Isearch Regexp Files..." diredp-do-isearch-regexp-recursive + :help "Incrementally regexp search marked files, including those in marked subdirs")) + (define-key diredp-menu-bar-search-recursive-menu [diredp-do-isearch-recursive] + '(menu-item "Isearch Files..." diredp-do-isearch-recursive + :help "Incrementally search marked files, including those in marked subdirs"))) +(define-key diredp-menu-bar-search-recursive-menu [diredp-do-query-replace-regexp-recursive] + '(menu-item "Query Replace..." diredp-do-query-replace-regexp-recursive + :help "Replace regexp in marked files, including those in marked subdirs")) +(define-key diredp-menu-bar-search-recursive-menu [diredp-do-search-recursive] + '(menu-item "Search Files..." diredp-do-search-recursive + :help "Regexp search marked files, including those in marked subdirs")) +(define-key diredp-menu-bar-search-recursive-menu [diredp-do-grep-recursive] + '(menu-item "Grep..." diredp-do-grep-recursive + :help "Run `grep' on the marked files, including those in marked subdirs")) + + +;; `Multiple' > `Marked Here and Below' > `Bookmark' menu. +;; +(defvar diredp-menu-bar-bookmarks-recursive-menu (make-sparse-keymap "Bookmark")) +(define-key diredp-multiple-recursive-menu [bookmarks] + (cons "Bookmark" diredp-menu-bar-bookmarks-recursive-menu)) +(define-key diredp-menu-bar-bookmarks-recursive-menu + [diredp-do-bookmark-in-bookmark-file-recursive] + '(menu-item "Bookmark in Bookmark File..." diredp-do-bookmark-in-bookmark-file-recursive + :help "Bookmark marked files, including those in marked subdirs, in a bookmark file")) +(define-key diredp-menu-bar-bookmarks-recursive-menu + [diredp-set-bookmark-file-bookmark-for-marked-recursive] + '(menu-item "Create Bookmark-File Bookmark..." + diredp-set-bookmark-file-bookmark-for-marked-recursive + :help "Create a bookmark-file bookmark for marked files, including in marked subdirs")) +(define-key diredp-menu-bar-bookmarks-recursive-menu [diredp-do-bookmark-dirs-recursive] + '(menu-item "Bookmark Dirs..." diredp-do-bookmark-dirs-recursive + :help "Bookmark this Dired buffer and marked subdirectory Dired buffers, recursively.")) +(define-key diredp-menu-bar-bookmarks-recursive-menu [diredp-do-bookmark-recursive] + '(menu-item "Bookmark..." diredp-do-bookmark-recursive + :help "Bookmark the marked files, including those in marked subdirs")) + + + +;; `Regexp' menu. +;; +;; REPLACE ORIGINAL `Regexp' menu in `dired.el'. +;; +(defvar diredp-menu-bar-regexp-menu (make-sparse-keymap "Regexp")) +(define-key dired-mode-map [menu-bar regexp] (cons "Regexp" diredp-menu-bar-regexp-menu)) + +(define-key diredp-menu-bar-regexp-menu [hardlink] + '(menu-item "Hardlink to..." dired-do-hardlink-regexp ; In `dired-aux.el'. + :help "Make hard links for files matching regexp")) +(define-key diredp-menu-bar-regexp-menu [symlink] + '(menu-item "Symlink to (Absolute)..." dired-do-symlink-regexp ; In `dired-aux.el'. + :help "Make absolute symbolic links for files matching regexp")) +(define-key diredp-menu-bar-regexp-menu [relsymlink] + '(menu-item "Symlink to (Relative)..." dired-do-relsymlink-regexp ; In `dired-x.el'. + :help "Make relative symbolic links for files matching regexp")) +(define-key diredp-menu-bar-regexp-menu [copy] + '(menu-item "Copy to..." dired-do-copy-regexp ; In `dired-aux.el'. + :help "Copy marked files matching regexp")) +(define-key diredp-menu-bar-regexp-menu [rename] + '(menu-item "Move to..." dired-do-rename-regexp ; In `dired-aux.el'. + :help "Move marked files matching regexp")) +(define-key diredp-menu-bar-regexp-menu [flag] + '(menu-item "Flag..." dired-flag-files-regexp :help "Flag files matching regexp for deletion")) +(define-key diredp-menu-bar-regexp-menu [image-dired-mark-tagged-files] + '(menu-item "Mark Image Files Tagged..." image-dired-mark-tagged-files + :enable (fboundp 'image-dired-mark-tagged-files) + :help "Mark image files whose image tags match regexp")) +(define-key diredp-menu-bar-regexp-menu [mark-cont] + '(menu-item "Mark Containing..." dired-mark-files-containing-regexp + :help "Mark files whose contents matches regexp")) +(define-key diredp-menu-bar-regexp-menu [mark] + '(menu-item "Mark..." dired-mark-files-regexp + :help "Mark files matching regexp")) + + +;; `Regexp' > `Here and Below' menu. +;; +(defvar diredp-regexp-recursive-menu (make-sparse-keymap "Here and Below")) +(define-key diredp-menu-bar-regexp-menu [mark-recursive] + (cons "Here and Below" diredp-regexp-recursive-menu)) +(define-key diredp-regexp-recursive-menu [diredp-mark-files-regexp-recursive] + '(menu-item "Mark Named..." diredp-mark-files-regexp-recursive + :help "Mark all file names matching a regexp, including those in marked subdirs")) +(define-key diredp-regexp-recursive-menu [diredp-mark-files-containing-regexp-recursive] + '(menu-item "Mark Containing..." diredp-mark-files-containing-regexp-recursive + :help "Mark all files with content matching a regexp, including in marked subdirs")) + +;; We don't use `define-obsolete-variable-alias' so that byte-compilation in older Emacs +;; works for newer Emacs too. +(when (fboundp 'defvaralias) ; Emacs 22+ + (defvaralias 'diredp-menu-bar-regexp-recursive-menu 'diredp-regexp-recursive-menu)) +(make-obsolete-variable 'diredp-menu-bar-regexp-recursive-menu 'diredp-regexp-recursive-menu) ; 2017-04-09 + +(when (boundp 'diredp-menu-bar-regexp-recursive-menu) + (defalias 'diredp-menu-bar-regexp-recursive-menu diredp-menu-bar-regexp-recursive-menu)) +(make-obsolete 'diredp-menu-bar-regexp-recursive-menu 'diredp-regexp-recursive-menu) ; 2017-04-09 + + +;; "Marks" menu. +;; +;; REPLACE ORIGINAL `Marks' menu in `dired.el'. +;; +(defvar diredp-menu-bar-marks-menu (make-sparse-keymap "Marks")) +(define-key dired-mode-map [menu-bar mark] (cons "Marks" diredp-menu-bar-marks-menu)) + +;; We don't use `define-obsolete-variable-alias' so that byte-compilation in older Emacs +;; works for newer Emacs too. +(when (fboundp 'defvaralias) ; Emacs 22+ + (defvaralias 'diredp-menu-bar-mark-menu 'diredp-menu-bar-marks-menu)) +(make-obsolete-variable 'diredp-menu-bar-mark-menu 'diredp-menu-bar-marks-menu) ; 2017-04-09 + +(define-key diredp-menu-bar-marks-menu [prev] + '(menu-item "Previous Marked" dired-prev-marked-file :help "Move to previous marked file")) +(define-key diredp-menu-bar-marks-menu [next] + '(menu-item "Next Marked" dired-next-marked-file :help "Move to next marked file")) +(define-key diredp-menu-bar-marks-menu [marks] + '(menu-item "Change Mark..." dired-change-marks + :help "Replace a given mark character with another")) +(define-key diredp-menu-bar-marks-menu [toggle-marks] + (if (> emacs-major-version 21) + '(menu-item "Toggle Marked/Unmarked" dired-toggle-marks + :help "Mark unmarked files, unmark marked ones") + '(menu-item "Toggle Marked/Unmarked" dired-toggle-marks + :help "Mark unmarked files, unmark marked ones"))) + + +;; `Marks' > `Tagged' menu. +;; +(when (require 'bookmark+ nil t) + (defvar diredp-marks-tags-menu (make-sparse-keymap "Tagged (Autofiles)") + "`Tags' submenu for Dired menu-bar `Marks' menu.") + (define-key diredp-menu-bar-marks-menu [mark-tags] (cons "Tagged" diredp-marks-tags-menu)) + + (define-key diredp-marks-tags-menu [diredp-unmark-files-tagged-none] + '(menu-item "Unmark Not Tagged with Any..." diredp-unmark-files-tagged-none + :help "Unmark files that are not tagged with *any* of the tags you enter")) + (define-key diredp-marks-tags-menu [diredp-unmark-files-tagged-not-all] + '(menu-item "Unmark Not Tagged with All..." diredp-unmark-files-tagged-not-all + :help "Unmark files that are not tagged with *all* tags")) + (define-key diredp-marks-tags-menu [diredp-unmark-files-tagged-some] + '(menu-item "Unmark Tagged with Some..." diredp-unmark-files-tagged-some + :help "Unmark files that are tagged with at least one of the tags you enter")) + (define-key diredp-marks-tags-menu [diredp-unmark-files-tagged-all] + '(menu-item "Unmark Tagged with All..." diredp-unmark-files-tagged-all + :help "Unmark files that are tagged with *each* tag you enter")) + (define-key diredp-marks-tags-menu [diredp-unmark-files-tagged-regexp] + '(menu-item "Unmark Tagged Matching Regexp..." diredp-unmark-files-tagged-regexp + :help "Unmark files that have at least one tag that matches a regexp")) + (define-key diredp-marks-tags-menu [separator-marks-tags] '("--")) ; ------------------------- + + (define-key diredp-marks-tags-menu [diredp-mark-files-tagged-none] + '(menu-item "Mark Not Tagged with Any..." diredp-mark-files-tagged-none + :help "Mark files that are not tagged with *any* of the tags you enter")) + (define-key diredp-marks-tags-menu [diredp-mark-files-tagged-not-all] + '(menu-item "Mark Not Tagged with All..." diredp-mark-files-tagged-not-all + :help "Mark files that are not tagged with *all* tags")) + (define-key diredp-marks-tags-menu [diredp-mark-files-tagged-some] + '(menu-item "Mark Tagged with Some..." diredp-mark-files-tagged-some + :help "Mark files that are tagged with at least one of the tags you enter")) + (define-key diredp-marks-tags-menu [diredp-mark-files-tagged-all] + '(menu-item "Mark Tagged with All..." diredp-mark-files-tagged-all + :help "Mark files that are tagged with *each* tag you enter")) + (define-key diredp-marks-tags-menu [diredp-mark-files-tagged-regexp] + '(menu-item "Mark Tagged Matching Regexp..." diredp-mark-files-tagged-regexp + :help "Mark files that have at least one tag that matches a regexp"))) + + +;; `Marks' > `Omit' menu. +;; +(defvar diredp-marks-omit-menu (make-sparse-keymap "Omit") + "`Omit' submenu for Dired menu-bar `Marks' menu.") +(define-key diredp-menu-bar-marks-menu [marks-omit] (cons "Omit" diredp-marks-omit-menu)) + +(define-key diredp-marks-omit-menu [marks-omit-unmarked] + '(menu-item "Omit Unmarked" diredp-omit-unmarked :help "Hide lines of unmarked files")) +(define-key diredp-marks-omit-menu [marks-omit-marked] + '(menu-item "Omit Marked" diredp-omit-marked :help "Hide lines of marked files")) + + +;; `Marks' > `Flag' menu. +;; +(defvar diredp-marks-flag-menu (make-sparse-keymap "Flag") + "`Flag' submenu for Dired menu-bar `Marks' menu.") +(define-key diredp-menu-bar-marks-menu [mark-flag] (cons "Flag" diredp-marks-flag-menu)) + +(define-key diredp-marks-flag-menu [marks-flag-extension] + '(menu-item "Flag Extension..." dired-flag-extension ; In `dired-x.el' + :help "Flag all files that have a certain extension, for deletion")) +(define-key diredp-marks-flag-menu [marks-flag-garbage-files] + '(menu-item "Flag Garbage Files" dired-flag-garbage-files + :help "Flag unneeded files for deletion")) +(define-key diredp-marks-flag-menu [marks-flag-backup-files] + '(menu-item "Flag Backup Files" dired-flag-backup-files + :help "Flag all backup files for deletion")) +(define-key diredp-marks-flag-menu [marks-flag-auto-save-files] + '(menu-item "Flag Auto-save Files" dired-flag-auto-save-files + :help "Flag auto-save files for deletion")) +(define-key diredp-marks-flag-menu [marks-flag-region] + '(menu-item "Flag Region" diredp-flag-region-files-for-deletion + :visible (diredp-nonempty-region-p) + :help "Flag all files in the region (selection) for deletion")) +(when (< emacs-major-version 21) + (put 'diredp-flag-region-files-for-deletion 'menu-enable '(diredp-nonempty-region-p))) +(define-key diredp-marks-flag-menu [marks-flag-deletion] + '(menu-item "Flag This" dired-flag-file-deletion + :visible (not (diredp-nonempty-region-p)) + :help "Flag current line's file for deletion")) + + +;; `Marks' > `Unmark' menu. +;; +(defvar diredp-marks-unmark-menu (make-sparse-keymap "Unmark") + "`Unmark' submenu for Dired menu-bar `Marks' menu.") +(define-key diredp-menu-bar-marks-menu [mark-mark] (cons "Unmark" diredp-marks-unmark-menu)) + +(define-key diredp-marks-unmark-menu [unmark-autofiles] + '(menu-item "Unmark Autofiles" diredp-unmark-autofiles + :help "Unmark all autofiles (bookmarks with same name as file)" + :enable (featurep 'bookmark+))) +(define-key diredp-marks-unmark-menu [unmark-all] + '(menu-item "Unmark All" dired-unmark-all-marks :help "Remove all marks from all files")) +(define-key diredp-marks-unmark-menu [unmark-with] + '(menu-item "Unmark Marked-With..." dired-unmark-all-files + :help "Remove a specific mark (or all marks) from every file")) +(define-key diredp-marks-unmark-menu [unmark-region] + '(menu-item "Unmark Region" diredp-unmark-region-files + :visible (diredp-nonempty-region-p) + :help "Unmark all files in the region (selection)")) +(when (< emacs-major-version 21) + (put 'diredp-unmark-region-files 'menu-enable '(diredp-nonempty-region-p))) +(define-key diredp-marks-unmark-menu [unmark-this] + '(menu-item "Unmark This" dired-unmark + :visible (not (diredp-nonempty-region-p)) + :help "Unmark or unflag current line's file")) + + +;; `Marks' > `Mark' menu. +;; +(defvar diredp-marks-mark-menu (make-sparse-keymap "Mark") + "`Mark' submenu for Dired menu-bar `Marks' menu.") +(define-key diredp-menu-bar-marks-menu [marks-mark] (cons "Mark" diredp-marks-mark-menu)) + +(define-key diredp-marks-mark-menu [marks-mark-sexp] + '(menu-item "Mark If..." dired-mark-sexp ; In `dired-x.el'. + :help "Mark files that satisfy specified condition")) +(define-key diredp-marks-mark-menu [marks-image-dired-mark-tagged-files] + '(menu-item "Mark Image Files Tagged..." image-dired-mark-tagged-files + :enable (fboundp 'image-dired-mark-tagged-files) ; In `image-dired.el'. + :help "Mark image files whose image tags match regexp")) +(define-key diredp-marks-mark-menu [marks-mark-cont] + '(menu-item "Mark Content Matching Regexp..." dired-mark-files-containing-regexp + :help "Mark files whose contents matches regexp")) +(define-key diredp-marks-mark-menu [marks-mark...] + '(menu-item "Mark Name Matching Regexp..." dired-mark-files-regexp + :help "Mark file names matching regexp")) +(when (fboundp 'dired-mark-omitted) ; In `dired-x.el', Emacs 22+. + (define-key diredp-marks-mark-menu [marks-mark-omitted] + '(menu-item "Mark Omitted..." dired-mark-omitted + :help "Mark all omitted files and subdirectories"))) +(define-key diredp-marks-mark-menu [marks-mark-extension] + '(menu-item "Mark Extension..." diredp-mark/unmark-extension + :help "Mark all files with specified extension")) +(define-key diredp-marks-mark-menu [marks-mark-autofiles] + '(menu-item "Mark Autofiles" diredp-mark-autofiles + :help "Mark all autofiles (bookmarks with same name as file)" + :enable (featurep 'bookmark+))) +(define-key diredp-marks-mark-menu [marks-mark-symlinks] + '(menu-item "Mark Symlinks" dired-mark-symlinks + :visible (fboundp 'make-symbolic-link) :help "Mark all symbolic links")) +(define-key diredp-marks-mark-menu [marks-mark-directories] + '(menu-item "Mark Directories" dired-mark-directories + :help "Mark all directories except `.' and `..'")) +(define-key diredp-marks-mark-menu [marks-mark-directory] + '(menu-item "Mark Old Backups" dired-clean-directory + :help "Flag old numbered backups for deletion")) +(define-key diredp-marks-mark-menu [marks-mark-executables] + '(menu-item "Mark Executables" dired-mark-executables :help "Mark all executable files")) +(define-key diredp-marks-mark-menu [marks-mark-region] + '(menu-item "Mark Region" diredp-mark-region-files + :visible (diredp-nonempty-region-p) + :help "Mark all of the files in the region (selection)")) +(when (< emacs-major-version 21) + (put 'diredp-mark-region-files 'menu-enable '(diredp-nonempty-region-p))) +(define-key diredp-marks-mark-menu [marks-mark-this] + '(menu-item "Mark This" dired-mark + :visible (not (diredp-nonempty-region-p)) + :help "Mark current line's file for future operations")) + + +;; `Marks' > `Here and Below' menu. +;; +(defvar diredp-marks-recursive-menu (make-sparse-keymap "Here and Below")) +(define-key diredp-menu-bar-marks-menu [mark-recursive] + (cons "Here and Below" diredp-marks-recursive-menu)) + +(define-key diredp-marks-recursive-menu [diredp-flag-auto-save-files-recursive] + '(menu-item "Flag Auto-Save Files..." diredp-flag-auto-save-files-recursive + :help "Flag all auto-save files for deletion, including those in marked subdirs")) +(when (fboundp 'diredp-unmark-all-marks-recursive) ; Emacs 22+ + (define-key diredp-marks-recursive-menu [diredp-change-marks-recursive] + '(menu-item "Change Mark..." diredp-change-marks-recursive + :help "Change all OLD marks to NEW marks, including those in marked subdirs")) + (define-key diredp-marks-recursive-menu [diredp-unmark-all-files-recursive] + '(menu-item "Unmark Marked-With..." diredp-unmark-all-files-recursive + :help "Remove a given mark everywhere, including in marked subdirs")) + (define-key diredp-marks-recursive-menu [diredp-unmark-all-marks-recursive] + '(menu-item "Unmark All..." diredp-unmark-all-marks-recursive + :help "Remove ALL marks everywhere, including in marked subdirs")) + (define-key diredp-marks-recursive-menu [separator-1] '("--"))) ; ------------ +(define-key diredp-marks-recursive-menu [diredp-mark-sexp-recursive] + '(menu-item "If..." diredp-mark-sexp-recursive + :help "Mark files satisfying specified condition, including those in marked subdirs")) +(define-key diredp-marks-recursive-menu [diredp-mark-files-containing-regexp-recursive] + '(menu-item "Containing Regexp..." diredp-mark-files-containing-regexp-recursive + :help "Mark all files with content matching a regexp, including in marked subdirs")) +(define-key diredp-marks-recursive-menu [diredp-mark-files-regexp-recursive] + '(menu-item "Named Regexp..." diredp-mark-files-regexp-recursive + :help "Mark all file names matching a regexp, including those in marked subdirs")) +(define-key diredp-marks-recursive-menu [diredp-mark-extension-recursive] + '(menu-item "Extension..." diredp-mark-extension-recursive + :help "Mark all files with a given extension, including those in marked subdirs")) +(define-key diredp-marks-recursive-menu [diredp-mark-autofiles-recursive] + '(menu-item "Autofiles" diredp-mark-autofiles-recursive + :help "Mark all files with a given extension, including those in marked subdirs" + :enable (featurep 'bookmark+))) +(define-key diredp-marks-recursive-menu [diredp-mark-symlinks-recursive] + '(menu-item "Symbolic Links" diredp-mark-symlinks-recursive + :help "Mark all symbolic links, including those in marked subdirs")) +(define-key diredp-marks-recursive-menu [diredp-mark-directories-recursive] + '(menu-item "Directories" diredp-mark-directories-recursive + :help "Mark all directories, including those in marked subdirs")) +(define-key diredp-marks-recursive-menu [diredp-mark-executables-recursive] + '(menu-item "Executables" diredp-mark-executables-recursive + :help "Mark all executable files, including those in marked subdirs")) + + +;; "Dir" menu. +;; +;; REPLACE ORIGINAL `Subdir' menu in `dired.el'. +;; +(defvar diredp-menu-bar-dir-menu (make-sparse-keymap "Dir")) +(define-key dired-mode-map [menu-bar subdir] (cons "Dir" diredp-menu-bar-dir-menu)) + +;; We don't use `define-obsolete-variable-alias' so that byte-compilation in older Emacs +;; works for newer Emacs too. +(when (fboundp 'defvaralias) ; Emacs 22+ + (defvaralias 'diredp-menu-bar-subdir-menu 'diredp-dir-menu)) +(make-obsolete-variable 'diredp-menu-bar-subdir-menu 'diredp-dir-menu) ; 2017-04-09 + +(when (boundp 'diredp-menu-bar-subdir-menu) + (defalias 'diredp-menu-bar-subdir-menu diredp-menu-bar-subdir-menu)) +(make-obsolete 'diredp-menu-bar-subdir-menu 'diredp-dir-menu) ; 2017-04-09 + + +;; `Dir' > `Hide/Show' menu. +;; +(defvar diredp-hide/show-menu (make-sparse-keymap "Hide/Show") + "`Hide/Show' submenu for Dired menu-bar `Dir' menu.") +(define-key diredp-menu-bar-dir-menu [hide-show] (cons "Hide/Show" diredp-hide/show-menu)) + +(when (fboundp 'dired-omit-mode) + (define-key diredp-hide/show-menu [dired-omit-mode] + '(menu-item "Hide/Show Uninteresting (Omit Mode)" dired-omit-mode + :help "Toggle omission of uninteresting files (Omit mode)"))) +(when (fboundp 'dired-hide-details-mode) ; Emacs 24.4+ + (define-key diredp-hide/show-menu [hide-details] + '(menu-item "Hide/Show Details" dired-hide-details-mode + :help "Hide or show less important fields of directory listing"))) +(define-key diredp-hide/show-menu [hide-all] + '(menu-item "Hide/Show All Subdirs" dired-hide-all + :help "Hide all subdirectories, leave only header lines")) +(define-key diredp-hide/show-menu [hide-subdir] + '(menu-item "Hide/Show Subdir" diredp-hide-subdir-nomove + :help "Hide or unhide current directory listing")) + + +;; `Dir' > `Bookmark' menu. +;; +(defvar diredp-bookmark-menu (make-sparse-keymap "Bookmark") + "`Bookmark' submenu for Dired menu-bar `Dir' menu.") +(define-key diredp-menu-bar-dir-menu [bookmark] (cons "Bookmark" diredp-bookmark-menu)) + +(define-key diredp-bookmark-menu [diredp-highlight-autofiles-mode] + '(menu-item "Toggle Autofile Highlighting" diredp-highlight-autofiles-mode + :help "Toggle whether to highlight autofile bookmarks" + :visible (and (featurep 'bookmark+) (featurep 'highlight)))) +(define-key diredp-bookmark-menu [diredp-do-bookmark-dirs-recursive] + '(menu-item "Bookmark Dirs Here and Below..." diredp-do-bookmark-dirs-recursive + :help "Bookmark this Dired buffer and marked subdirectory Dired buffers, recursively.")) +(define-key diredp-bookmark-menu [bookmark-dired] + '(menu-item "Bookmark Dired Buffer..." bookmark-set :help "Bookmark this Dired buffer")) + + +;; `Dir' > `Navigate' menu. +;; +(defvar diredp-navigate-menu (make-sparse-keymap "Navigate") + "`Navigate' submenu for Dired menu-bar `Dir' menu.") +(define-key diredp-menu-bar-dir-menu [navigate] (cons "Navigate" diredp-navigate-menu)) + +(define-key diredp-navigate-menu [insert] + '(menu-item "Move To This Subdir" dired-maybe-insert-subdir + :help "Move to subdirectory line or listing")) +(define-key diredp-navigate-menu [tree-down] + '(menu-item "Tree Down" dired-tree-down :help "Go to first subdirectory header down the tree")) +(define-key diredp-navigate-menu [tree-up] + '(menu-item "Tree Up" dired-tree-up :help "Go to first subdirectory header up the tree")) +(define-key diredp-navigate-menu [up] + '(menu-item "Up Directory" diredp-up-directory :help "Dired the parent directory")) +(define-key diredp-navigate-menu [prev-subdir] + '(menu-item "Prev Subdir" diredp-prev-subdir :help "Go to previous subdirectory header line")) +(define-key diredp-navigate-menu [next-subdir] + '(menu-item "Next Subdir" diredp-next-subdir :help "Go to next subdirectory header line")) +(define-key diredp-navigate-menu [prev-dirline] + '(menu-item "Prev Dirline" diredp-prev-dirline :help "Move to previous directory-file line")) +(define-key diredp-navigate-menu [next-dirline] + '(menu-item "Next Dirline" diredp-next-dirline :help "Move to next directory-file line")) + +(define-key diredp-menu-bar-dir-menu [separator-subdir] '("--")) ; -------------------------- + +(define-key diredp-menu-bar-dir-menu [image-dired-dired-toggle-marked-thumbs] + '(menu-item "Toggle Image Thumbnails" image-dired-dired-toggle-marked-thumbs + :enable (fboundp 'image-dired-dired-toggle-marked-thumbs) + :help "Add or remove image thumbnails in front of marked file names")) +(when (fboundp 'dired-isearch-filenames) ; Emacs 23+ + (define-key diredp-menu-bar-dir-menu [isearch-filenames-regexp] + '(menu-item "Isearch Regexp in File Names..." dired-isearch-filenames-regexp + :help "Incrementally search for regexp in file names only")) + (define-key diredp-menu-bar-dir-menu [isearch-filenames] + '(menu-item "Isearch in File Names..." dired-isearch-filenames + :help "Incrementally search for literal text in file names only."))) +(when (or (> emacs-major-version 21) (fboundp 'wdired-change-to-wdired-mode)) + (define-key diredp-menu-bar-dir-menu [wdired-mode] + '(menu-item "Edit File Names (WDired)" wdired-change-to-wdired-mode + :help "Put a Dired buffer in a mode in which filenames are editable" + :keys "C-x C-q" :filter (lambda (x) (and (derived-mode-p 'dired-mode) x))))) +(define-key diredp-menu-bar-dir-menu [diredp-yank-files] + '(menu-item "Paste Files from Copied Absolute Names" diredp-yank-files + :help "Paste files here whose absolute names you copied" + :enable (catch 'dir-menu--yank-files + (let ((files (car kill-ring-yank-pointer))) + (and (stringp files) + (dolist (file (split-string files)) + (unless (file-name-absolute-p file) (throw 'dir-menu--yank-files nil))))) + t))) +(when (fboundp 'dired-compare-directories) ; Emacs 22+ + (define-key diredp-menu-bar-dir-menu [compare-directories] + '(menu-item "Compare Directories..." dired-compare-directories + :help "Mark files with different attributes in two Dired buffers"))) + +(define-key diredp-menu-bar-dir-menu [separator-dired-on-set] '("--")) ; -------------------- + +(define-key diredp-menu-bar-dir-menu [diredp-dired-recent-dirs] + '(menu-item "Dired Recent Directories..." diredp-dired-recent-dirs + :visible (boundp 'recentf-list) :enable (and (boundp 'recentf-list) (consp recentf-list)) + :help "Open a Dired buffer for recently used directories")) +(define-key diredp-menu-bar-dir-menu [diredp-dired-inserted-subdirs] + '(menu-item "Dired Each Inserted Subdir..." diredp-dired-inserted-subdirs + :enable (cdr dired-subdir-alist) ; First elt is current dir. Must have at least one more. + :help "Open Dired separately for each of the inserted subdirectories")) +(define-key diredp-menu-bar-dir-menu [diredp-add-to-this-dired-buffer] + '(menu-item "Add Entries Here..." diredp-add-to-this-dired-buffer + :help "Add individual file and directory names to the listing" + :keys "C-x E")) +(define-key diredp-menu-bar-dir-menu [diredp-dired-union] + '(menu-item "Dired Union..." diredp-dired-union + :help "Open Dired for the union of some existing Dired buffers")) +(define-key diredp-menu-bar-dir-menu [diredp-fileset-other-window] + '(menu-item "Dired Fileset..." diredp-fileset-other-window + :enable (> emacs-major-version 21) :help "Open Dired on an Emacs fileset")) +(define-key diredp-menu-bar-dir-menu [diredp-dired-for-files] + '(menu-item "Dired Files Located Anywhere" diredp-dired-for-files + :help "Open Dired on specific files whose names you provide")) +(define-key diredp-menu-bar-dir-menu [diredp-marked-other-window] + '(menu-item "Dired Marked Files in Other Window" diredp-marked-other-window + :enable (save-excursion (goto-char (point-min)) + (and (re-search-forward (dired-marker-regexp) nil t) + (re-search-forward (dired-marker-regexp) nil t))) + :help "Open Dired on marked files only, in other window")) +(define-key diredp-menu-bar-dir-menu [diredp-marked] + '(menu-item "Dired Marked Files" diredp-marked + :enable (save-excursion (goto-char (point-min)) + (and (re-search-forward (dired-marker-regexp) nil t) + (re-search-forward (dired-marker-regexp) nil t))) + :help "Open Dired on marked files only")) +(define-key diredp-menu-bar-dir-menu [dired] + '(menu-item "Dired (Filter via Wildcards)..." dired + :help "Explore a directory (you can provide wildcards)")) + +(define-key diredp-menu-bar-dir-menu [separator-dired] '("--")) ; --------------------- + +(define-key diredp-menu-bar-dir-menu [insert] + '(menu-item "Insert/Move-To This Subdir" dired-maybe-insert-subdir + :help "Move to subdirectory line or listing")) +(define-key diredp-menu-bar-dir-menu [revert] + '(menu-item "Refresh (Sync \& Show All)" revert-buffer :help "Update directory contents")) +(define-key diredp-menu-bar-dir-menu [create-directory] ; Moved from "Immediate". + '(menu-item "New Directory..." dired-create-directory :help "Create a directory")) + + +;;; Mouse-3 menu binding. +(define-key dired-mode-map [down-mouse-3] 'diredp-mouse-3-menu) +(define-key dired-mode-map [mouse-3] 'ignore) + + +;;; Non-menu Dired bindings. + +;; Move `dired-omit-mode' to `C-x M-o', so prefix key `M-o' is free for face/font-lock stuff. +(define-key dired-mode-map "\C-x\M-o" (if (fboundp 'dired-omit-mode) 'dired-omit-mode 'dired-omit-toggle)) +(when (memq (lookup-key dired-mode-map "\M-o") '(dired-omit-mode dired-omit-toggle)) + (define-key dired-mode-map "\M-o" nil)) + +;; These are global, not just Dired mode. They are on prefix key `C-x D'. +(unless (lookup-key ctl-x-map "D") + (define-key ctl-x-map "D" nil) ; For Emacs 20 + (define-key ctl-x-map "DA" 'diredp-add-to-dired-buffer) ; `C-x D A' + (define-key ctl-x-map "DF" 'diredp-dired-for-files) ; `C-x D F' + (define-key ctl-x-map "DR" 'diredp-dired-recent-dirs) ; `C-x D R' + (define-key ctl-x-map "DS" 'diredp-fileset) ; `C-x D S' + (define-key ctl-x-map "DU" 'diredp-dired-union)) ; `C-x D U' + +(unless (lookup-key ctl-x-4-map "D") + (define-key ctl-x-4-map "D" nil) ; For Emacs 20 + (define-key ctl-x-4-map "DA" 'diredp-add-to-dired-buffer-other-window) ; `C-x 4 D A' + (define-key ctl-x-4-map "DF" 'diredp-dired-for-files-other-window) ; `C-x 4 D F' + (define-key ctl-x-4-map "DR" 'diredp-dired-recent-dirs-other-window) ; `C-x 4 D R' + (define-key ctl-x-4-map "DS" 'diredp-fileset-other-window) ; `C-x 4 D S' + (define-key ctl-x-4-map "DU" 'diredp-dired-union-other-window)) ; `C-x 4 D U' + +;; Navigation +(substitute-key-definition 'dired-up-directory 'diredp-up-directory dired-mode-map) +(substitute-key-definition 'dired-next-line 'diredp-next-line dired-mode-map) +(substitute-key-definition 'dired-previous-line 'diredp-previous-line dired-mode-map) +(substitute-key-definition 'dired-next-dirline 'diredp-next-dirline dired-mode-map) +(substitute-key-definition 'dired-prev-dirline 'diredp-prev-dirline dired-mode-map) +(substitute-key-definition 'dired-next-subdir 'diredp-next-subdir dired-mode-map) +(substitute-key-definition 'dired-prev-subdir 'diredp-prev-subdir dired-mode-map) + + +(define-key dired-mode-map [S-down-mouse-1] 'ignore) ; (normally `mouse-set-font') +;; `diredp-mouse-mark-region-files' provides Windows-Explorer behavior +;; for selecting (marking) files. +(define-key dired-mode-map [S-mouse-1] 'diredp-mouse-mark-region-files) ; `S-mouse-1' +(define-key dired-mode-map [mouse-2] 'dired-mouse-find-file-other-window) ; `mouse-2' +;; But be aware that `dired-sort-menu.el' binds `S-mouse-2' to `dired-sort-menu-popup'. +(define-key dired-mode-map [S-down-mouse-2] 'dired-mouse-find-file) ; `S-mouse-2' +(define-key dired-mode-map [S-mouse-2] 'ignore) +(define-key dired-mode-map [M-mouse-2] 'diredp-mouse-find-file-other-frame) ; `M-mouse-2' + +;; On Windows, bind more. +(eval-after-load "w32-browser" + '(progn + (define-key dired-mode-map [(control return)] 'dired-w32explore) ; `C-RET' + (define-key dired-mode-map [(meta return)] 'dired-w32-browser) ; `M-RET' + (define-key dired-mode-map [mouse-2] 'dired-mouse-w32-browser) ; `mouse-2' + (define-key dired-mode-map (kbd "") 'dired-multiple-w32-browser))) ; `C-M-RET' + +(when (fboundp 'diredp-w32-drives) + (when (< emacs-major-version 21) (define-key dired-mode-map ":" nil)) ; For Emacs 20 + (define-key dired-mode-map ":/" 'diredp-w32-drives)) ; `:/' + +;; Other keyboard keys +(define-key dired-mode-map "@" 'diredp-do-apply-function) ; `@' +(define-key dired-mode-map "\$" 'diredp-hide-subdir-nomove) ; `$' +(define-key dired-mode-map "\M-$" 'dired-hide-subdir) ; `M-$' +(define-key dired-mode-map "=" 'diredp-ediff) ; `=' +;; This replaces the `dired-x.el' binding of `dired-mark-extension'. +(define-key dired-mode-map "*." 'diredp-mark/unmark-extension) ; `* .' +(define-key dired-mode-map "*B" 'diredp-mark-autofiles) ; `* B' +(define-key dired-mode-map [(control meta ?*)] 'diredp-marked-other-window) ; `C-M-*' +(define-key dired-mode-map "\M-a" 'dired-do-search) ; `M-a' +(define-key dired-mode-map "\M-b" 'diredp-do-bookmark) ; `M-b' +(define-key dired-mode-map "\C-\M-b" 'diredp-set-bookmark-file-bookmark-for-marked) ; `C-M-b' +(when diredp-bind-problematic-terminal-keys + (define-key dired-mode-map [(control meta shift ?b)] ; `C-M-B' (aka `C-M-S-b') + 'diredp-do-bookmark-in-bookmark-file)) +(define-key dired-mode-map "e" 'diredp-visit-this-file) ; `e' (was `dired-find-file') +(define-key dired-mode-map [C-down] 'diredp-visit-next-file) ; `C-down' (was `forward-paragraph') +(define-key dired-mode-map [C-up] 'diredp-visit-previous-file) ; `C-up' (was `backward-paragraph') +(define-key dired-mode-map "\C-\M-G" 'diredp-do-grep) ; `C-M-G' +(when (fboundp 'mkhtml-dired-files) ; In `mkhtml.el'. + (define-key dired-mode-map "\M-h" 'mkhtml-dired-files)) ; `M-h' +(define-key dired-mode-map "\C-\M-i" 'diredp-dired-inserted-subdirs) ; `C-M-i' +(define-key dired-mode-map "\M-q" (if (< emacs-major-version 21) + 'dired-do-query-replace + 'dired-do-query-replace-regexp)) ; `M-q' +(when diredp-bind-problematic-terminal-keys + (define-key dired-mode-map [(control meta shift ?r)] ; `C-M-R' (aka `C-M-S-r') + 'diredp-toggle-find-file-reuse-dir)) +(define-key dired-mode-map "U" 'dired-unmark-all-marks) ; `U' +(substitute-key-definition 'describe-mode 'diredp-describe-mode ; `h', `C-h m' + dired-mode-map (current-global-map)) + +;; Tags - same keys as in `*Bookmark List*'. +;; +;; NOTE: If this changes then need to update `dired-sort-menu+.el' to reflect the changes. +;; +(define-key dired-mode-map "T" nil) ; For Emacs 20 +(define-key dired-mode-map "T+" 'diredp-tag-this-file) ; `T +' +(define-key dired-mode-map "T-" 'diredp-untag-this-file) ; `T -' +(define-key dired-mode-map "T0" 'diredp-remove-all-tags-this-file) ; `T 0' +(define-key dired-mode-map "Tc" 'diredp-copy-tags-this-file) ; `T c' +(define-key dired-mode-map "Tp" 'diredp-paste-add-tags-this-file) ; `T p' +(define-key dired-mode-map "Tq" 'diredp-paste-replace-tags-this-file) ; `T q' +(define-key dired-mode-map "Tv" 'diredp-set-tag-value-this-file) ; `T v' +(define-key dired-mode-map "T\M-w" 'diredp-copy-tags-this-file) ; `T M-w' +(define-key dired-mode-map "T\C-y" 'diredp-paste-add-tags-this-file) ; `T C-y' +(define-key dired-mode-map "T>+" 'diredp-do-tag) ; `T > +' +(define-key dired-mode-map "T>-" 'diredp-do-untag) ; `T > -' +(define-key dired-mode-map "T>0" 'diredp-do-remove-all-tags) ; `T > 0' +(define-key dired-mode-map "T>p" 'diredp-do-paste-add-tags) ; `T > p' +(define-key dired-mode-map "T>q" 'diredp-do-paste-replace-tags) ; `T > q' +(define-key dired-mode-map "T>v" 'diredp-do-set-tag-value) ; `T > v' +(define-key dired-mode-map "T>\C-y" 'diredp-do-paste-add-tags) ; `T > C-y' +(define-key dired-mode-map "Tm%" 'diredp-mark-files-tagged-regexp) ; `T m %' +(define-key dired-mode-map "Tm*" 'diredp-mark-files-tagged-all) ; `T m *' +(define-key dired-mode-map "Tm+" 'diredp-mark-files-tagged-some) ; `T m +' +(define-key dired-mode-map "Tm~*" 'diredp-mark-files-tagged-not-all) ; `T m ~ *' +(define-key dired-mode-map "Tm~+" 'diredp-mark-files-tagged-none) ; `T m ~ +' +(define-key dired-mode-map "Tu%" 'diredp-unmark-files-tagged-regexp) ; `T u %' +(define-key dired-mode-map "Tu*" 'diredp-unmark-files-tagged-all) ; `T u *' +(define-key dired-mode-map "Tu+" 'diredp-unmark-files-tagged-some) ; `T u +' +(define-key dired-mode-map "Tu~*" 'diredp-unmark-files-tagged-not-all) ; `T u ~ *' +(define-key dired-mode-map "Tu~+" 'diredp-unmark-files-tagged-none) ; `T u ~ +' +;; $$$$$$ (define-key dired-mode-map [(control ?+)] 'diredp-do-tag) +;; $$$$$$ (define-key dired-mode-map [(control ?-)] 'diredp-do-untag) + + +;; Vanilla Emacs binds `c' to `dired-do-compress-to'. Use `M-z' instead'. +;; (`dired-sort-menu.el' binds `c' to `dired-sort-menu-toggle-ignore-case'.) +;; +(when (fboundp 'dired-do-compress-to) ; Emacs 25+ + (define-key dired-mode-map (kbd "M-z") 'dired-do-compress-to)) + + +;; Commands for operating on the current line's file. When possible, +;; these are lower-case versions of the upper-case commands for operating on +;; the marked files. (Most of the other corresponding lower-case letters are already +;; defined and cannot be used here.) + +;; $$$$$$ (define-key dired-mode-map [(control meta ?+)] 'diredp-tag-this-file) +;; $$$$$$ (define-key dired-mode-map [(control meta ?-)] 'diredp-untag-this-file) +(define-key dired-mode-map "\r" 'dired-find-file) ; `RET' +(when (fboundp 'diredp-describe-file) + (define-key dired-mode-map (kbd "C-h RET") 'diredp-describe-file) ; `C-h RET' + (define-key dired-mode-map (kbd "C-h C-") 'diredp-describe-file)) ; `C-h C-RET' +(define-key dired-mode-map "%c" 'diredp-capitalize) ; `% c' +(define-key dired-mode-map "b" 'diredp-byte-compile-this-file) ; `b' +(define-key dired-mode-map [(control shift ?b)] 'diredp-bookmark-this-file) ; `C-B' +(define-key dired-mode-map "\M-c" 'diredp-capitalize-this-file) ; `M-c' +(when (and (fboundp 'diredp-chgrp-this-file) diredp-bind-problematic-terminal-keys) + (define-key dired-mode-map [(control meta shift ?g)] 'diredp-chgrp-this-file)) ; `C-M-G' (aka `C-M-S-g') +(define-key dired-mode-map "\M-i" 'diredp-insert-subdirs) ; `M-i' +(define-key dired-mode-map "\M-l" 'diredp-downcase-this-file) ; `M-l' +(define-key dired-mode-map "\C-\M-l" 'diredp-list-marked) ; `C-M-l' +(when diredp-bind-problematic-terminal-keys + (define-key dired-mode-map [(meta shift ?m)] 'diredp-chmod-this-file)) ; `M-M' (aka `M-S-m') +(define-key dired-mode-map "\C-o" 'diredp-find-file-other-frame) ; `C-o' +(when (and (fboundp 'diredp-chown-this-file) diredp-bind-problematic-terminal-keys) + (define-key dired-mode-map [(meta shift ?o)] 'diredp-chown-this-file)) ; `M-O' (aka `M-S-o') +(define-key dired-mode-map "\C-\M-o" 'dired-display-file) ; `C-M-o' (not `C-o') +(define-key dired-mode-map "\M-p" 'diredp-print-this-file) ; `M-p' +(define-key dired-mode-map "r" 'diredp-rename-this-file) ; `r' +(when (fboundp 'image-dired-dired-display-image) + (define-key dired-mode-map "\C-tI" 'diredp-image-show-this-file)) ; `C-t I' +(when diredp-bind-problematic-terminal-keys + (define-key dired-mode-map [(meta shift ?t)] 'diredp-touch-this-file) ; `M-T' (aka `M-S-t') + (define-key dired-mode-map [(control meta shift ?t)] 'dired-do-touch)) ; `C-M-T' (aka `C-M-S-t') +(define-key dired-mode-map "\M-u" 'diredp-upcase-this-file) ; `M-u' +(define-key dired-mode-map "y" 'diredp-relsymlink-this-file) ; `y' +(define-key dired-mode-map "\C-w" 'diredp-move-files-named-in-kill-ring) ; `C-w' +(define-key dired-mode-map "\C-y" 'diredp-yank-files) ; `C-y' +(define-key dired-mode-map "z" 'diredp-compress-this-file) ; `z' +(when (fboundp 'dired-show-file-type) + (define-key dired-mode-map "_" 'dired-show-file-type)) ; `_' (underscore) +(substitute-key-definition 'kill-line 'diredp-delete-this-file ; `C-k', `delete', `deleteline' + dired-mode-map (current-global-map)) + + +;; Commands that handle marked below, recursively. +;; Use `M-+' as a prefix key for all such commands. + +(define-prefix-command 'diredp-recursive-map) +(define-key dired-mode-map "\M-+" diredp-recursive-map) ; `M-+' + +(when (fboundp 'char-displayable-p) ; Emacs 22+ + (define-key diredp-recursive-map "\M-\C-?" 'diredp-unmark-all-files-recursive)) ; `M-DEL' +(define-key diredp-recursive-map "@" 'diredp-do-apply-function-recursive) ; `@' +(define-key diredp-recursive-map "#" 'diredp-flag-auto-save-files-recursive) ; `#' +(define-key diredp-recursive-map "*@" 'diredp-mark-symlinks-recursive) ; `* @' +(define-key diredp-recursive-map "**" 'diredp-mark-executables-recursive) ; `* *' +(define-key diredp-recursive-map "*/" 'diredp-mark-directories-recursive) ; `* /' +(define-key diredp-recursive-map "*." 'diredp-mark-extension-recursive) ; `* .' +(define-key diredp-recursive-map "*(" 'diredp-mark-sexp-recursive) ; `* (' +(define-key diredp-recursive-map "*B" 'diredp-mark-autofiles-recursive) ; `* B' +(when (fboundp 'char-displayable-p) ; Emacs 22+ + (define-key diredp-recursive-map "*c" 'diredp-change-marks-recursive)) ; `* c' +(define-key diredp-recursive-map "*%" 'diredp-mark-files-regexp-recursive) ; `* %' +(when (> emacs-major-version 22) + (define-key diredp-recursive-map ":d" 'diredp-do-decrypt-recursive) ; `: d' + (define-key diredp-recursive-map ":e" 'diredp-do-encrypt-recursive) ; `: e' + (define-key diredp-recursive-map ":s" 'diredp-do-sign-recursive) ; `: s' + (define-key diredp-recursive-map ":v" 'diredp-do-verify-recursive)) ; `: v' +(define-key diredp-recursive-map "%c" 'diredp-capitalize-recursive) ; `% c' +(define-key diredp-recursive-map "%g" 'diredp-mark-files-containing-regexp-recursive) ; `% g' +(define-key diredp-recursive-map "%l" 'diredp-downcase-recursive) ; `% l' +(define-key diredp-recursive-map "%m" 'diredp-mark-files-regexp-recursive) ; `% m' +(define-key diredp-recursive-map "%u" 'diredp-upcase-recursive) ; `% u' +(when (fboundp 'dired-do-async-shell-command) ; Emacs 23+ + (define-key diredp-recursive-map "&" 'diredp-do-async-shell-command-recursive)) ; `&' +(define-key diredp-recursive-map "!" 'diredp-do-shell-command-recursive) ; `!' +(define-key diredp-recursive-map (kbd "C-M-*") 'diredp-marked-recursive-other-window) ; `C-M-*' +(define-key diredp-recursive-map "A" 'diredp-do-search-recursive) ; `A' +(define-key diredp-recursive-map "\M-b" 'diredp-do-bookmark-recursive) ; `M-b' +(when diredp-bind-problematic-terminal-keys + (define-key diredp-recursive-map [(meta shift ?b)] ; `M-B' (aka `M-S-b') + 'diredp-do-bookmark-dirs-recursive)) +(define-key diredp-recursive-map (kbd "C-M-b") ; `C-M-b' + 'diredp-set-bookmark-file-bookmark-for-marked-recursive) +(when diredp-bind-problematic-terminal-keys + (define-key diredp-recursive-map [(control meta shift ?b)] ; `C-M-B' (aka `C-M-S-b') + 'diredp-do-bookmark-in-bookmark-file-recursive)) +(define-key diredp-recursive-map "C" 'diredp-do-copy-recursive) ; `C' +(define-key diredp-recursive-map "D" 'diredp-do-delete-recursive) ; `D' +(define-key diredp-recursive-map "F" 'diredp-do-find-marked-files-recursive) ; `F' +(when (fboundp 'diredp-do-chgrp-recursive) + (define-key diredp-recursive-map "G" 'diredp-do-chgrp-recursive)) ; `G' +(define-key diredp-recursive-map "\C-\M-G" 'diredp-do-grep-recursive) ; `C-M-G' +(define-key diredp-recursive-map "H" 'diredp-do-hardlink-recursive) ; `H' +(define-key diredp-recursive-map "\M-i" 'diredp-insert-subdirs-recursive) ; `M-i' +(define-key diredp-recursive-map "\C-\M-l" 'diredp-list-marked-recursive) ; `C-M-l' +(define-key diredp-recursive-map "M" 'diredp-do-chmod-recursive) ; `M' +(when (fboundp 'diredp-do-chown-recursive) + (define-key diredp-recursive-map "O" 'diredp-do-chown-recursive)) ; `O' +(define-key diredp-recursive-map "P" 'diredp-do-print-recursive) ; `P' +(define-key diredp-recursive-map "Q" 'diredp-do-query-replace-regexp-recursive) ; `Q' +(define-key diredp-recursive-map "R" 'diredp-do-move-recursive) ; `R' +(define-key diredp-recursive-map "S" 'diredp-do-symlink-recursive) ; `S' +(define-key diredp-recursive-map (kbd "M-s a C-s") ; `M-s a C-s' + 'diredp-do-isearch-recursive) +(define-key diredp-recursive-map (kbd "M-s a C-M-s") ; `M-s a C-M-s' + 'diredp-do-isearch-regexp-recursive) +(when diredp-bind-problematic-terminal-keys + (define-key diredp-recursive-map [(control meta shift ?t)] + 'diredp-do-touch-recursive)) ; `C-M-T' (aka `C-M-S-t') +(define-key diredp-recursive-map "\C-tc" 'diredp-image-dired-comment-files-recursive) ; `C-t c' +(define-key diredp-recursive-map "\C-td" 'diredp-image-dired-display-thumbs-recursive) ; `C-t d' +(define-key diredp-recursive-map "\C-tr" 'diredp-image-dired-delete-tag-recursive) ; `C-t r' +(define-key diredp-recursive-map "\C-tt" 'diredp-image-dired-tag-files-recursive) ; `C-t t' +(when (fboundp 'char-displayable-p) ; Emacs 22+ + (define-key diredp-recursive-map "U" 'diredp-unmark-all-marks-recursive)) ; `U' +(define-key diredp-recursive-map "\M-(" 'diredp-mark-sexp-recursive) ; `M-(' +(define-key diredp-recursive-map "\M-w" 'diredp-copy-filename-as-kill-recursive) ; `M-w' +(define-key diredp-recursive-map "Y" 'diredp-do-relsymlink-recursive) ; `Y' + +(eval-after-load "w32-browser" + '(define-key diredp-recursive-map (kbd "") 'diredp-multiple-w32-browser-recursive)) ; `C-M-RET' + +;; Undefine some bindings that would try to modify a Dired buffer. Their key sequences will +;; then appear to the user as available for local (Dired) definition. +(when (fboundp 'undefine-killer-commands) (undefine-killer-commands dired-mode-map)) + +;;;;;;;;;;;; + +(setq diredp-loaded-p t) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; dired+.el ends here diff --git a/emacs/.emacs.d/vendor/org-clubhouse.el b/emacs/.emacs.d/vendor/org-clubhouse.el new file mode 100644 index 0000000000..ba1f004a24 --- /dev/null +++ b/emacs/.emacs.d/vendor/org-clubhouse.el @@ -0,0 +1,365 @@ +;;; private/grfn/org-clubhouse.el + +(require 'dash) +(require 'dash-functional) +(require 's) +(require 'org) +(require 'org-element) +(require 'cl) + +;;; +;;; Configuration +;;; + +(defvar org-clubhouse-auth-token nil + "Authorization token for the Clubhouse API") + +(defvar org-clubhouse-team-name nil + "Team name to use in links to Clubhouse +ie https://app.clubhouse.io//stories") + +(defvar org-clubhouse-project-ids nil + "Specific list of project IDs to synchronize with clubhouse. +If unset all projects will be synchronized") + +(defvar org-clubhouse-workflow-name "Default") + +(defvar org-clubhouse-state-alist + '(("LATER" . "Unscheduled") + ("[ ]" . "Ready for Development") + ("TODO" . "Ready for Development") + ("OPEN" . "Ready for Development") + ("ACTIVE" . "In Development") + ("PR" . "Review") + ("DONE" . "Merged") + ("[X]" . "Merged") + ("CLOSED" . "Merged"))) + +;;; +;;; Utilities +;;; + +(defun ->list (vec) (append vec nil)) + +(defun reject-archived (item-list) + (-filter (lambda (item) (equal :json-false (alist-get 'archived item))) item-list)) + +(defun alist->plist (key-map alist) + (->> key-map + (-map (lambda (key-pair) + (let ((alist-key (car key-pair)) + (plist-key (cdr key-pair))) + (list plist-key (alist-get alist-key alist))))) + (-flatten-n 1))) + +(defun alist-get-equal (key alist) + "Like `alist-get', but uses `equal' instead of `eq' for comparing keys" + (->> alist + (-find (lambda (pair) (equal key (car pair)))) + (cdr))) + +;;; +;;; Org-element interaction +;;; + +;; (defun org-element-find-headline () +;; (let ((current-elt (org-element-at-point))) +;; (if (equal 'headline (car current-elt)) +;; current-elt +;; (let* ((elt-attrs (cadr current-elt)) +;; (parent (plist-get elt-attrs :post-affiliated))) +;; (goto-char parent) +;; (org-element-find-headline))))) + +(defun org-element-find-headline () + (let ((current-elt (org-element-at-point))) + (when (equal 'headline (car current-elt)) + (cadr current-elt)))) + +(defun org-element-extract-clubhouse-id (elt) + (when-let ((clubhouse-id-link (plist-get elt :CLUBHOUSE-ID))) + (string-match + (rx "[[" (one-or-more anything) "]" + "[" (group (one-or-more digit)) "]]") + clubhouse-id-link) + (string-to-int (match-string 1 clubhouse-id-link)))) + + + +(defun org-element-clubhouse-id () + (org-element-extract-clubhouse-id + (org-element-find-headline))) + +;;; +;;; API integration +;;; + +(defvar org-clubhouse-base-url* "https://api.clubhouse.io/api/v2") + +(defun org-clubhouse-auth-url (url) + (concat url + "?" + (url-build-query-string + `(("token" ,org-clubhouse-auth-token))))) + +(defun org-clubhouse-baseify-url (url) + (if (s-starts-with? org-clubhouse-base-url* url) url + (concat org-clubhouse-base-url* + (if (s-starts-with? "/" url) url + (concat "/" url))))) + +(defun org-clubhouse-request (method url &optional data) + (message "%s %s %s" method url (prin1-to-string data)) + (let* ((url-request-method method) + (url-request-extra-headers + '(("Content-Type" . "application/json"))) + (url-request-data data) + (buf)) + + (setq url (-> url + org-clubhouse-baseify-url + org-clubhouse-auth-url)) + + (setq buf (url-retrieve-synchronously url)) + + (with-current-buffer buf + (goto-char url-http-end-of-headers) + (prog1 (json-read) (kill-buffer))))) + +(cl-defun to-id-name-pairs + (seq &optional (id-attr 'id) (name-attr 'name)) + (->> seq + ->list + (-map (lambda (resource) + (cons (alist-get id-attr resource) + (alist-get name-attr resource)))))) + +(cl-defun org-clubhouse-fetch-as-id-name-pairs + (resource &optional + (id-attr 'id) + (name-attr 'name)) + "Returns the given resource from clubhouse as (id . name) pairs" + (let ((resp-json (org-clubhouse-request "GET" resource))) + (-> resp-json + ->list + reject-archived + (to-id-name-pairs id-attr name-attr)))) + +(defun org-clubhouse-link-to-story (story-id) + (format "https://app.clubhouse.io/%s/story/%d" + org-clubhouse-team-name + story-id)) + +(defun org-clubhouse-link-to-epic (epic-id) + (format "https://app.clubhouse.io/%s/epic/%d" + org-clubhouse-team-name + epic-id)) + +(defun org-clubhouse-link-to-project (project-id) + (format "https://app.clubhouse.io/%s/project/%d" + org-clubhouse-team-name + project-id)) + +;;; +;;; Caching +;;; + + + +(defvar org-clubhouse-cache-clear-functions ()) + +(defmacro defcache (name &optional docstring &rest body) + (let* ((doc (when docstring (list docstring))) + (cache-var-name (intern (concat (symbol-name name) + "-cache"))) + (clear-cache-function-name + (intern (concat "clear-" (symbol-name cache-var-name))))) + `(progn + (defvar ,cache-var-name :no-cache) + (defun ,name () + ,@doc + (when (equal :no-cache ,cache-var-name) + (setq ,cache-var-name (progn ,@body))) + ,cache-var-name) + (defun ,clear-cache-function-name () + (interactive) + (setq ,cache-var-name :no-cache)) + + (push (quote ,clear-cache-function-name) + org-clubhouse-cache-clear-functions)))) + +(defun org-clubhouse-clear-cache () + (interactive) + (-map #'funcall org-clubhouse-cache-clear-functions)) + +;;; +;;; API resource functions +;;; + +(defcache org-clubhouse-projects + "Returns projects as (project-id . name)" + (org-clubhouse-fetch-as-id-name-pairs "projects")) + +(defcache org-clubhouse-epics + "Returns projects as (project-id . name)" + (org-clubhouse-fetch-as-id-name-pairs "epics")) + +(defcache org-clubhouse-workflow-states + "Returns worflow states as (name . id) pairs" + (let* ((resp-json (org-clubhouse-request "GET" "workflows")) + (workflows (->list resp-json)) + ;; just assume it exists, for now + (workflow (-find (lambda (workflow) + (equal org-clubhouse-workflow-name + (alist-get 'name workflow))) + workflows)) + (states (->list (alist-get 'states workflow)))) + (to-id-name-pairs states + 'name + 'id))) + +(defun org-clubhouse-stories-in-project (project-id) + "Returns the stories in the given project as org bugs" + (let ((resp-json (org-clubhouse-request "GET" (format "/projects/%d/stories" project-id)))) + (->> resp-json ->list reject-archived + (-reject (lambda (story) (equal :json-true (alist-get 'completed story)))) + (-map (lambda (story) + (cons + (cons 'status + (cond + ((equal :json-true (alist-get 'started story)) + 'started) + ((equal :json-true (alist-get 'completed story)) + 'completed) + ('t + 'open))) + story))) + (-map (-partial #'alist->plist + '((name . :title) + (id . :id) + (status . :status))))))) + +;;; +;;; Story creation +;;; + +(cl-defun org-clubhouse-create-story-internal + (title &key project-id epic-id) + (assert (and (stringp title) + (integerp project-id) + (or (null epic-id) (integerp epic-id)))) + (org-clubhouse-request + "POST" + "stories" + (json-encode + `((name . ,title) + (project_id . ,project-id) + (epic_id . ,epic-id))))) + +(defun org-clubhouse-prompt-for-project (cb) + (ivy-read + "Select a project: " + (-map #'cdr (org-clubhouse-projects)) + :require-match t + :history 'org-clubhouse-project-history + :action (lambda (selected) + (let ((project-id + (->> (org-clubhouse-projects) + (-find (lambda (proj) + (string-equal (cdr proj) selected))) + car))) + (message "%d" project-id) + (funcall cb project-id))))) + +(defun org-clubhouse-prompt-for-epic (cb) + (ivy-read + "Select an epic: " + (-map #'cdr (org-clubhouse-epics)) + :history 'org-clubhouse-epic-history + :action (lambda (selected) + (let ((epic-id + (->> (org-clubhouse-epics) + (-find (lambda (proj) + (string-equal (cdr proj) selected))) + car))) + (message "%d" epic-id) + (funcall cb epic-id))))) + +(defun org-clubhouse-populate-created-story (story) + (let ((elt (org-element-find-headline)) + (story-id (alist-get 'id story)) + (epic-id (alist-get 'epic_id story)) + (project-id (alist-get 'project_id story))) + + (org-set-property "clubhouse-id" + (org-make-link-string + (org-clubhouse-link-to-story story-id) + (number-to-string story-id))) + + (org-set-property "clubhouse-epic" + (org-make-link-string + (org-clubhouse-link-to-epic epic-id) + (alist-get epic-id (org-clubhouse-epics)))) + + (org-set-property "clubhouse-project" + (org-make-link-string + (org-clubhouse-link-to-project project-id) + (alist-get project-id (org-clubhouse-projects)))) + + (org-todo "TODO"))) + +(defun org-clubhouse-create-story () + (interactive) + ;; (message (org-element-find-headline)) + (when-let ((elt (org-element-find-headline)) + (title (plist-get elt :title))) + (if (plist-get elt :CLUBHOUSE-ID) + (message "This headline is already a clubhouse story!") + (org-clubhouse-prompt-for-project + (lambda (project-id) + (when project-id + (org-clubhouse-prompt-for-epic + (lambda (epic-id) + (let* ((story (org-clubhouse-create-story-internal + title + :project-id project-id + :epic-id epic-id))) + (org-clubhouse-populate-created-story story)))))))))) + +;;; +;;; Story updates +;;; + +(cl-defun org-clubhouse-update-story-internal + (story-id &rest attrs) + (assert (and (integerp story-id) + (listp attrs))) + (org-clubhouse-request + "PUT" + (format "stories/%d" story-id) + (json-encode attrs))) + +(defun org-clubhouse-update-status () + (when-let (clubhouse-id (org-element-clubhouse-id)) + (let* ((elt (org-element-find-headline)) + (todo-keyword (-> elt (plist-get :todo-keyword) (substring-no-properties)))) + (message todo-keyword) + (when-let ((clubhouse-workflow-state + (alist-get-equal todo-keyword org-clubhouse-state-alist)) + (workflow-state-id + (alist-get-equal clubhouse-workflow-state (org-clubhouse-workflow-states)))) + (org-clubhouse-update-story-internal + clubhouse-id + :workflow_state_id workflow-state-id) + (message "Successfully updated clubhouse status to \"%s\"" + clubhouse-workflow-state))))) + +(define-minor-mode org-clubhouse-mode + :init-value nil + :group 'org + :lighter "Org-Clubhouse" + :keymap '() + (add-hook 'org-after-todo-state-change-hook + 'org-clubhouse-update-status + nil + t)) diff --git a/emacs/.emacs.d/vendor/reason-indent.el b/emacs/.emacs.d/vendor/reason-indent.el new file mode 100644 index 0000000000..8fd3c94258 --- /dev/null +++ b/emacs/.emacs.d/vendor/reason-indent.el @@ -0,0 +1,304 @@ +;;; reason-indent.el --- Indentation functions for ReasonML -*-lexical-binding: t-*- + +;; Portions Copyright (c) 2015-present, Facebook, Inc. All rights reserved. + +;;; Commentary: + +;; Indentation functions for Reason. + +;;; Code: + +(defconst reason-re-ident "[[:word:][:multibyte:]_][[:word:][:multibyte:]_[:digit:]]*") + +(defcustom reason-indent-offset 2 + "Indent Reason code by this number of spaces." + :type 'integer + :group 'reason-mode + :safe #'integerp) + +(defun reason-looking-back-str (str) + "Like `looking-back' but for fixed strings rather than regexps. +Works around some regexp slowness. +Argument STR string to search for." + (let ((len (length str))) + (and (> (point) len) + (equal str (buffer-substring-no-properties (- (point) len) (point)))))) + +(defun reason-paren-level () + "Get the level of nesting inside parentheses." + (nth 0 (syntax-ppss))) + +(defun reason-in-str-or-cmnt () + "Return whether point is currently inside a string or a comment." + (nth 8 (syntax-ppss))) + +(defun reason-rewind-past-str-cmnt () + "Rewind past string or comment." + (goto-char (nth 8 (syntax-ppss)))) + +(defun reason-rewind-irrelevant () + "Rewind past irrelevant characters (whitespace of inside comments)." + (interactive) + (let ((starting (point))) + (skip-chars-backward "[:space:]\n") + (if (reason-looking-back-str "*/") (backward-char)) + (if (reason-in-str-or-cmnt) + (reason-rewind-past-str-cmnt)) + (if (/= starting (point)) + (reason-rewind-irrelevant)))) + +(defun reason-align-to-expr-after-brace () + "Align the expression at point to the expression after the previous brace." + (save-excursion + (forward-char) + ;; We don't want to indent out to the open bracket if the + ;; open bracket ends the line + (when (not (looking-at "[[:blank:]]*\\(?://.*\\)?$")) + (when (looking-at "[[:space:]]") + (forward-word 1) + (backward-word 1)) + (current-column)))) + +(defun reason-align-to-prev-expr () + "Align the expression at point to the previous expression." + (let ((alignment (save-excursion + (forward-char) + ;; We don't want to indent out to the open bracket if the + ;; open bracket ends the line + (when (not (looking-at "[[:blank:]]*\\(?://.*\\)?$")) + (if (looking-at "[[:space:]]") + (progn + (forward-word 1) + (backward-word 1)) + (backward-char)) + (current-column))))) + (if (not alignment) + (save-excursion + (forward-char) + (forward-line) + (back-to-indentation) + (current-column)) + alignment))) + +;;; Start of a reason binding +(defvar reason-binding + (regexp-opt '("let" "type" "module" "fun"))) + +(defun reason-beginning-of-defun (&optional arg) + "Move backward to the beginning of the current defun. + +With ARG, move backward multiple defuns. Negative ARG means +move forward. + +This is written mainly to be used as `beginning-of-defun-function'. +Don't move to the beginning of the line. `beginning-of-defun', +which calls this, does that afterwards." + (interactive "p") + (re-search-backward (concat "^\\(" reason-binding "\\)\\_>") + nil 'move (or arg 1))) + +(defun reason-end-of-defun () + "Move forward to the next end of defun. + +With argument, do it that many times. +Negative argument -N means move back to Nth preceding end of defun. + +Assume that this is called after ‘beginning-of-defun’. So point is +at the beginning of the defun body. + +This is written mainly to be used as `end-of-defun-function' for Reason." + (interactive) + ;; Find the opening brace + (if (re-search-forward "[{]" nil t) + (progn + (goto-char (match-beginning 0)) + ;; Go to the closing brace + (condition-case nil + (forward-sexp) + (scan-error + ;; The parentheses are unbalanced; instead of being unable to fontify, just jump to the end of the buffer + (goto-char (point-max))))) + ;; There is no opening brace, so consider the whole buffer to be one "defun" + (goto-char (point-max)))) + +(defun reason-rewind-to-beginning-of-current-level-expr () + "Rewind to the beginning of the expression on the current level of nesting." + (interactive) + (let ((current-level (reason-paren-level))) + (back-to-indentation) + (when (looking-at "=>") + (reason-rewind-irrelevant) + (back-to-indentation)) + (while (> (reason-paren-level) current-level) + (backward-up-list) + (back-to-indentation)))) + +(defun reason-mode-indent-line () + "Indent current line." + (interactive) + (let ((indent + (save-excursion + (back-to-indentation) + ;; Point is now at beginning of current line + (let* ((level (reason-paren-level)) + (baseline + ;; Our "baseline" is one level out from the indentation of the expression + ;; containing the innermost enclosing opening bracket. That + ;; way if we are within a block that has a different + ;; indentation than this mode would give it, we still indent + ;; the inside of it correctly relative to the outside. + (if (= 0 level) + 0 + (save-excursion + (reason-rewind-irrelevant) + (if (save-excursion + (reason-rewind-to-beginning-of-current-level-expr) + (looking-at "<")) + (progn + (reason-rewind-to-beginning-of-current-level-expr) + (current-column)) + (progn + (backward-up-list) + (reason-rewind-to-beginning-of-current-level-expr) + + (cond + ((looking-at "switch") + (current-column)) + + ((looking-at "|") + (+ (current-column) (* reason-indent-offset 2))) + + (t + (let ((current-level (reason-paren-level))) + (save-excursion + (while (and (= current-level (reason-paren-level)) + (not (looking-at reason-binding))) + (reason-rewind-irrelevant) + (reason-rewind-to-beginning-of-current-level-expr)) + (+ (current-column) reason-indent-offset))))))))))) + (cond + ;; A function return type is indented to the corresponding function arguments + ((looking-at "=>") + (+ baseline reason-indent-offset)) + + ((reason-in-str-or-cmnt) + (cond + ;; In the end of the block -- align with star + ((looking-at "*/") (+ baseline 1)) + ;; Indent to the following shape: + ;; /* abcd + ;; * asdf + ;; */ + ;; + ((looking-at "*") (+ baseline 1)) + ;; Indent to the following shape: + ;; /* abcd + ;; asdf + ;; */ + ;; + (t (+ baseline (+ reason-indent-offset 1))))) + + ((looking-at ""))) + (backward-up-list) + (reason-rewind-to-beginning-of-current-level-expr) + (cond + ((looking-at "switch") baseline) + + (jsx? (current-column)) + + (t (- baseline reason-indent-offset)))))) + + ;; Doc comments in /** style with leading * indent to line up the *s + ((and (nth 4 (syntax-ppss)) (looking-at "*")) + (+ 1 baseline)) + + ;; If we're in any other token-tree / sexp, then: + (t + (or + ;; If we are inside a pair of braces, with something after the + ;; open brace on the same line and ending with a comma, treat + ;; it as fields and align them. + (when (> level 0) + (save-excursion + (reason-rewind-irrelevant) + (backward-up-list) + ;; Point is now at the beginning of the containing set of braces + (reason-align-to-expr-after-brace))) + + (progn + (back-to-indentation) + (cond ((looking-at (regexp-opt '("and" "type"))) + baseline) + ((save-excursion + (reason-rewind-irrelevant) + (= (point) 1)) + baseline) + ((save-excursion + (while (looking-at "|") + (reason-rewind-irrelevant) + (back-to-indentation)) + (looking-at (regexp-opt '("type")))) + (+ baseline reason-indent-offset)) + ((looking-at "|\\|/[/*]") + baseline) + ((and (> level 0) + (save-excursion + (reason-rewind-irrelevant) + (backward-up-list) + (reason-rewind-to-beginning-of-current-level-expr) + (looking-at "switch"))) + (+ baseline reason-indent-offset)) + ((save-excursion + (reason-rewind-irrelevant) + (looking-back "[{;,\\[(]" (- (point) 2))) + baseline) + ((and + (save-excursion + (reason-rewind-irrelevant) + (reason-rewind-to-beginning-of-current-level-expr) + (and (looking-at reason-binding) + (not (progn + (forward-sexp) + (forward-sexp) + (skip-chars-forward "[:space:]\n") + (looking-at "="))))) + (not (save-excursion + (skip-chars-backward "[:space:]\n") + (reason-looking-back-str "=>")))) + (save-excursion + (reason-rewind-irrelevant) + (backward-sexp) + (reason-align-to-prev-expr))) + ((save-excursion + (reason-rewind-irrelevant) + (looking-back "<\/.*?>" (- (point) 30))) + baseline) + (t + (save-excursion + (reason-rewind-irrelevant) + (reason-rewind-to-beginning-of-current-level-expr) + + (if (looking-at "|") + baseline + (+ baseline reason-indent-offset))))) + ;; Point is now at the beginning of the current line + )))))))) + + (when indent + ;; If we're at the beginning of the line (before or at the current + ;; indentation), jump with the indentation change. Otherwise, save the + ;; excursion so that adding the indentations will leave us at the + ;; equivalent position within the line to where we were before. + (if (<= (current-column) (current-indentation)) + (indent-line-to indent) + (save-excursion (indent-line-to indent)))))) + +(provide 'reason-indent) + +;;; reason-indent.el ends here diff --git a/emacs/.emacs.d/vendor/reason-interaction.el b/emacs/.emacs.d/vendor/reason-interaction.el new file mode 100644 index 0000000000..6ceaed1e93 --- /dev/null +++ b/emacs/.emacs.d/vendor/reason-interaction.el @@ -0,0 +1,216 @@ +;;; reason-interaction.el --- Phrase navitagion for rtop -*-lexical-binding: t-*- + +;; Portions Copyright (c) 2015-present, Facebook, Inc. All rights reserved. + +;;; Commentary: + +;; Phrase navigation for utop and maybe other REPLs. + +;; The utop compatibility layer for Reason was mainly taken from: +;; https://github.com/ocaml/tuareg/blob/master/tuareg-light.el (big thanks!) + +;;; Code: + +(defun reason-backward-char (&optional step) + "Go back one char. +Similar to `backward-char` but it does not signal errors +`beginning-of-buffer` and `end-of-buffer`. It optionally takes a +STEP parameter for jumping back more than one character." + (when step (goto-char (- (point) step)) + (goto-char (1- (point))))) + +(defun reason-forward-char (&optional step) + "Go forward one char. +Similar to `forward-char` but it does not signal errors +`beginning-of-buffer` and `end-of-buffer`. It optionally takes a +STEP parameter for jumping back more than one character." + (when step (goto-char (+ (point) step)) + (goto-char (1+ (point))))) + +(defun reason-in-literal-p () + "Return non-nil if point is inside an Reason literal." + (nth 3 (syntax-ppss))) + +(defconst reason-comment-delimiter-regexp "\\*/\\|/\\*" + "Regex for identify either open or close comment delimiters.") + +(defun reason-in-between-comment-chars-p () + "Return non-nil iff point is in between the comment delimiter chars. +It returns non-nil if point is between the chars only (*|/ or /|* +where | is point)." + (and (not (bobp)) (not (eobp)) + (or (and (char-equal ?/ (char-before)) (char-equal ?* (char-after))) + (and (char-equal ?* (char-before)) (char-equal ?/ (char-after)))))) + +(defun reason-looking-at-comment-delimiters-p () + "Return non-nil iff point in between comment delimiters." + (looking-at-p reason-comment-delimiter-regexp)) + +(defun reason-in-between-comment-delimiters-p () + "Return non-nil if inside /* and */." + (nth 4 (syntax-ppss))) + +(defun reason-in-comment-p () + "Return non-nil iff point is inside or right before a comment." + (or (reason-in-between-comment-delimiters-p) + (reason-in-between-comment-chars-p) + (reason-looking-at-comment-delimiters-p))) + +(defun reason-beginning-of-literal-or-comment () + "Skip to the beginning of the current literal or comment (or buffer)." + (interactive) + (goto-char (or (nth 8 (syntax-ppss)) (point)))) + +(defun reason-inside-block-scope-p () + "Skip to the beginning of the current literal or comment (or buffer)." + (and (> (nth 0 (syntax-ppss)) 0) + (let ((delim-start (nth 1 (syntax-ppss)))) + (save-excursion + (goto-char delim-start) + (char-equal ?{ (following-char)))))) + +(defun reason-at-phrase-break-p () + "Is the underlying `;' a phrase break?" + ;; Difference from OCaml, the phrase separator is a single semi-colon + (and (not (eobp)) + (char-equal ?\; (following-char)))) + +(defun reason-skip-to-close-delimiter (&optional limit) + "Skip to the end of a Reason block. +It basically calls `re-search-forward` in order to go to any +closing delimiter, not concerning itself with balancing of any +sort. Client code needs to check that. +LIMIT is passed to `re-search-forward` directly." + (re-search-forward "\\s)" limit 'move)) + +(defun reason-skip-back-to-open-delimiter (&optional limit) + "Skip to the beginning of a Reason block backwards. +It basically calls `re-search-backward` in order to go to any +opening delimiter, not concerning itself with balancing of any +sort. Client code needs to check that. +LIMIT is passed to `re-search-backward` directly." + (re-search-backward "\\s(" limit 'move)) + +(defun reason-find-phrase-end () + "Skip to the end of a phrase." + (while (and (not (eobp)) + (not (reason-at-phrase-break-p))) + (if (re-search-forward ";" nil 'move) + (progn (when (reason-inside-block-scope-p) + (reason-skip-to-close-delimiter)) + (goto-char (1- (point)))) + ;; avoid infinite loop at the end of the buffer + (re-search-forward "[[:space:]\\|\n]+" nil 'move))) + (min (goto-char (1+ (point))) (point-max))) + +(defun reason-skip-blank-and-comments () + "Skip blank spaces and comments." + (cond + ((eobp) (point)) + ((or (reason-in-between-comment-chars-p) + (reason-looking-at-comment-delimiters-p)) (progn + (reason-forward-char 1) + (reason-skip-blank-and-comments))) + ((reason-in-between-comment-delimiters-p) (progn + (search-forward "*/" nil t) + (reason-skip-blank-and-comments))) + ((eolp) (progn + (reason-forward-char 1) + (reason-skip-blank-and-comments))) + (t (progn (skip-syntax-forward " ") + (point))))) + +(defun reason-skip-back-blank-and-comments () + "Skip blank spaces and comments backwards." + (cond + ((bobp) (point)) + ((looking-back reason-comment-delimiter-regexp) (progn + (reason-backward-char 1) + (reason-skip-back-blank-and-comments))) + ((reason-in-between-comment-delimiters-p) (progn + (search-backward "/*" nil t) + (reason-backward-char 1) + (reason-skip-back-blank-and-comments))) + ((or (reason-in-between-comment-chars-p) + (reason-looking-at-comment-delimiters-p)) (progn + (reason-backward-char 1) + (reason-skip-back-blank-and-comments))) + ((bolp) (progn + (reason-backward-char 1) + (reason-skip-back-blank-and-comments))) + (t (progn (skip-syntax-backward " ") + (point))))) + +(defun reason-ro (&rest words) + "Build a regex matching iff at least a word in WORDS is present." + (concat "\\<" (regexp-opt words t) "\\>")) + +(defconst reason-find-phrase-beginning-regexp + (concat (reason-ro "end" "type" "module" "sig" "struct" "class" + "exception" "open" "let") + "\\|^#[ \t]*[a-z][_a-z]*\\>\\|;")) + +(defun reason-at-phrase-start-p () + "Return t if is looking at the beginning of a phrase. +A phrase starts when a toplevel keyword is at the beginning of a line." + (or (looking-at "#") + (looking-at reason-find-phrase-beginning-regexp))) + +(defun reason-find-phrase-beginning-backward () + "Find the beginning of a phrase and return point. +It scans code backwards, therefore the caller can assume that the +beginning of the phrase (if found) is always before the starting +point. No error is signalled and (point-min) is returned when a +phrease cannot be found." + (beginning-of-line) + (while (and (not (bobp)) (not (reason-at-phrase-start-p))) + (if (reason-inside-block-scope-p) + (reason-skip-back-to-open-delimiter) + (re-search-backward reason-find-phrase-beginning-regexp nil 'move))) + (point)) + +(defun reason-discover-phrase () + "Discover a Reason phrase in the buffer." + ;; TODO reason-with-internal-syntax ;; tuareg2 modifies the syntax table (removed for now) + ;; TODO stop-at-and feature for phrase detection (do we need it?) + ;; TODO tuareg2 has some custom logic for module and class (do we need it?) + (save-excursion + (let ((case-fold-search nil)) + (reason-skip-blank-and-comments) + (list (reason-find-phrase-beginning-backward) ;; beginning + (reason-find-phrase-end) ;; end + (save-excursion ;; end-with-comment + (reason-skip-blank-and-comments) + (point)))))) + +(defun reason-discover-phrase-debug () + "Discover a Reason phrase in the buffer (debug mode)." + (let ((triple (reason-discover-phrase))) + (message (concat "Evaluating: \"" (reason-fetch-phrase triple) "\"")) + triple)) + +(defun reason-fetch-phrase (triple) + "Fetch the phrase text given a TRIPLE." + (let* ((start (nth 0 triple)) + (end (nth 1 triple))) ;; we don't need end-with-comment + (buffer-substring-no-properties start end))) + +(defun reason-next-phrase () + "Skip to the beginning of the next phrase." + (cond + ((reason-at-phrase-start-p) (point)) + ((eolp) (progn + (forward-char 1) + (reason-skip-blank-and-comments) + (reason-next-phrase))) + ((reason-inside-block-scope-p) (progn (reason-skip-to-close-delimiter) + (reason-next-phrase))) + ((looking-at ";") (progn + (forward-char 1) + (reason-next-phrase))) + (t (progn (end-of-line) + (reason-next-phrase))))) + +(provide 'reason-interaction) + +;;; reason-interaction.el ends here diff --git a/emacs/.emacs.d/vendor/reason-mode.el b/emacs/.emacs.d/vendor/reason-mode.el new file mode 100644 index 0000000000..789735955d --- /dev/null +++ b/emacs/.emacs.d/vendor/reason-mode.el @@ -0,0 +1,242 @@ +;;; reason-mode.el --- A major mode for editing ReasonML -*-lexical-binding: t-*- +;; Portions Copyright (c) 2015-present, Facebook, Inc. All rights reserved. + +;; Version: 0.4.0 +;; Author: Mozilla +;; Url: https://github.com/reasonml-editor/reason-mode +;; Keywords: languages, ocaml +;; Package-Requires: ((emacs "24.3")) + +;; This file is NOT part of GNU Emacs. + +;; This file is distributed under the terms of both the MIT license and the +;; Apache License (version 2.0). + +;;; Commentary: +;; This project provides useful functions and helpers for developing code +;; using the Reason programming language (https://facebook.github.io/reason). +;; +;; Reason is an umbrella project that provides a curated layer for OCaml. +;; +;; It offers: +;; - A new, familiar syntax for the battle-tested language that is OCaml. +;; - A workflow for compiling to JavaScript and native code. +;; - A set of friendly documentations, libraries and utilities. +;; +;; See the README.md for more details. + +;;; Code: + +(require 'reason-indent) +(require 'refmt) +(require 'reason-interaction) + +(eval-when-compile (require 'rx) + (require 'compile) + (require 'url-vars)) + +;; Syntax definitions and helpers +(defvar reason-mode-syntax-table + (let ((table (make-syntax-table))) + + ;; Operators + (dolist (i '(?+ ?- ?* ?/ ?& ?| ?^ ?! ?< ?> ?~ ?@)) + (modify-syntax-entry i "." table)) + + ;; Strings + (modify-syntax-entry ?\" "\"" table) + (modify-syntax-entry ?\\ "\\" table) + (modify-syntax-entry ?\' "_" table) + + ;; Comments + (modify-syntax-entry ?/ ". 124b" table) + (modify-syntax-entry ?* ". 23n" table) + (modify-syntax-entry ?\n "> b" table) + (modify-syntax-entry ?\^m "> b" table) + + table)) + +(defgroup reason nil + "Support for Reason code." + :link '(url-link "http://facebook.github.io/reason/") + :group 'languages) + +(defcustom reason-mode-hook nil + "Hook called by `reason-mode'." + :type 'hook + :group 'reason) + +;; Font-locking definitions and helpers +(defconst reason-mode-keywords + '("and" "as" + "else" "external" + "fun" "for" + "if" "impl" "in" "include" + "let" + "module" "match" "mod" "move" "mutable" + "open" + "priv" "pub" + "rec" "ref" "return" + "self" "static" "switch" "struct" "super" + "trait" "type" + "use" + "virtual" + "where" "when" "while")) + +(defconst reason-mode-consts + '("true" "false")) + +(defconst reason-special-types + '("int" "float" "string" "char" + "bool" "unit" "list" "array" "exn" + "option" "ref")) + +(defconst reason-camel-case + (rx symbol-start + (group upper (0+ (any word nonascii digit "_"))) + symbol-end)) + +(eval-and-compile + (defconst reason--char-literal-rx + (rx (seq (group "'") + (or (seq "\\" anything) + (not (any "'\\"))) + (group "'"))))) + +(defun reason-re-word (inner) + "Build a word regexp given INNER." + (concat "\\<" inner "\\>")) + +(defun reason-re-grab (inner) + "Build a grab regexp given INNER." + (concat "\\(" inner "\\)")) + +(defun reason-regexp-opt-symbols (words) + "Like `(regexp-opt words 'symbols)`, but will work on Emacs 23. +See rust-mode PR #42. +Argument WORDS argument to pass to `regexp-opt`." + (concat "\\_<" (regexp-opt words t) "\\_>")) + +;;; Syntax highlighting for Reason +(defvar reason-font-lock-keywords + `((,(reason-regexp-opt-symbols reason-mode-keywords) . font-lock-keyword-face) + (,(reason-regexp-opt-symbols reason-special-types) . font-lock-builtin-face) + (,(reason-regexp-opt-symbols reason-mode-consts) . font-lock-constant-face) + + (,reason-camel-case 1 font-lock-type-face) + + ;; Field names like `foo:`, highlight excluding the : + (,(concat (reason-re-grab reason-re-ident) ":[^:]") 1 font-lock-variable-name-face) + ;; Module names like `foo::`, highlight including the :: + (,(reason-re-grab (concat reason-re-ident "::")) 1 font-lock-type-face) + ;; Name punned labeled args like ::foo + (,(concat "[[:space:]]+" (reason-re-grab (concat "::" reason-re-ident))) 1 font-lock-type-face) + + ;; TODO jsx attribs? + (, + (concat "<[/]?" (reason-re-grab reason-re-ident) "[^>]*" ">") + 1 font-lock-type-face))) + +(defun reason-mode-try-find-alternate-file (mod-name extension) + "Switch to the file given by MOD-NAME and EXTENSION." + (let* ((filename (concat mod-name extension)) + (buffer (get-file-buffer filename))) + (if buffer (switch-to-buffer buffer) + (find-file filename)))) + +(defun reason-mode-find-alternate-file () + "Switch to implementation/interface file." + (interactive) + (let ((name buffer-file-name)) + (when (string-match "\\`\\(.*\\)\\.re\\([il]\\)?\\'" name) + (let ((mod-name (match-string 1 name)) + (e (match-string 2 name))) + (cond + ((string= e "i") + (reason-mode-try-find-alternate-file mod-name ".re")) + (t + (reason-mode-try-find-alternate-file mod-name ".rei"))))))) + +(defun reason--syntax-propertize-multiline-string (end) + "Propertize Reason multiline string. +Argument END marks the end of the string." + (let ((ppss (syntax-ppss))) + (when (eq t (nth 3 ppss)) + (let ((key (save-excursion + (goto-char (nth 8 ppss)) + (and (looking-at "{\\([a-z]*\\)|") + (match-string 1))))) + (when (search-forward (format "|%s}" key) end 'move) + (put-text-property (1- (match-end 0)) (match-end 0) + 'syntax-table (string-to-syntax "|"))))))) + +(defun reason-syntax-propertize-function (start end) + "Propertize Reason function. +Argument START marks the beginning of the function. +Argument END marks the end of the function." + (goto-char start) + (reason--syntax-propertize-multiline-string end) + (funcall + (syntax-propertize-rules + (reason--char-literal-rx (1 "\"") (2 "\"")) + ;; multi line strings + ("\\({\\)[a-z]*|" + (1 (prog1 "|" + (goto-char (match-end 0)) + (reason--syntax-propertize-multiline-string end))))) + (point) end)) + +(defvar reason-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-c\C-a" #'reason-mode-find-alternate-file) + (define-key map "\C-c\C-r" #'refmt-region-ocaml-to-reason) + (define-key map "\C-c\C-o" #'refmt-region-reason-to-ocaml) + map)) + +;;;###autoload +(define-derived-mode reason-mode prog-mode "Reason" + "Major mode for Reason code. + +\\{reason-mode-map}" + :group 'reason + :syntax-table reason-mode-syntax-table + :keymap reason-mode-map + + ;; Syntax + (setq-local syntax-propertize-function #'reason-syntax-propertize-function) + ;; Indentation + (setq-local indent-line-function 'reason-mode-indent-line) + ;; Fonts + (setq-local font-lock-defaults '(reason-font-lock-keywords)) + ;; Misc + (setq-local comment-start "/*") + (setq-local comment-end "*/") + (setq-local indent-tabs-mode nil) + ;; Allow paragraph fills for comments + (setq-local comment-start-skip "/\\*+[ \t]*") + (setq-local paragraph-start + (concat "^[ \t]*$\\|\\*)$\\|" page-delimiter)) + (setq-local paragraph-separate paragraph-start) + (setq-local require-final-newline t) + (setq-local normal-auto-fill-function nil) + (setq-local comment-multi-line t) + + (setq-local beginning-of-defun-function 'reason-beginning-of-defun) + (setq-local end-of-defun-function 'reason-end-of-defun) + (setq-local parse-sexp-lookup-properties t)) + +;;;###autoload +(add-to-list 'auto-mode-alist '("\\.rei?\\'" . reason-mode)) + +(defun reason-mode-reload () + "Reload Reason mode." + (interactive) + (unload-feature 'reason-mode) + (unload-feature 'reason-indent) + (unload-feature 'reason-interaction) + (require 'reason-mode) + (reason-mode)) + +(provide 'reason-mode) + +;;; reason-mode.el ends here diff --git a/emacs/.emacs.d/vendor/refmt.el b/emacs/.emacs.d/vendor/refmt.el new file mode 100644 index 0000000000..b9ea2b43f0 --- /dev/null +++ b/emacs/.emacs.d/vendor/refmt.el @@ -0,0 +1,231 @@ +;;; refmt.el --- utility functions to format reason code + +;; Copyright (c) 2014 The go-mode Authors. All rights reserved. +;; Portions Copyright (c) 2015-present, Facebook, Inc. All rights reserved. + +;; Redistribution and use in source and binary forms, with or without +;; modification, are permitted provided that the following conditions are +;; met: + +;; * Redistributions of source code must retain the above copyright +;; notice, this list of conditions and the following disclaimer. +;; * Redistributions in binary form must reproduce the above +;; copyright notice, this list of conditions and the following disclaimer +;; in the documentation and/or other materials provided with the +;; distribution. +;; * Neither the name of the copyright holder nor the names of its +;; contributors may be used to endorse or promote products derived from +;; this software without specific prior written permission. + +;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.) + +;;; Commentary: +;; + +;;; Code: + +(require 'cl-lib) + +(defcustom refmt-command "refmt" + "The 'refmt' command." + :type 'string + :group 're-fmt) + +(defcustom refmt-show-errors 'buffer + "Where to display refmt error output. +It can either be displayed in its own buffer, in the echo area, or not at all. +Please note that Emacs outputs to the echo area when writing +files and will overwrite refmt's echo output if used from inside +a `before-save-hook'." + :type '(choice + (const :tag "Own buffer" buffer) + (const :tag "Echo area" echo) + (const :tag "None" nil)) + :group 're-fmt) + +(defcustom refmt-width-mode nil + "Specify width when formatting buffer contents." + :type '(choice + (const :tag "Window width" window) + (const :tag "Fill column" fill) + (const :tag "None" nil)) + :group 're-fmt) + +;;;###autoload +(defun refmt-before-save () + "Add this to .emacs to run refmt on the current buffer when saving: + (add-hook 'before-save-hook 'refmt-before-save)." + (interactive) + (when (eq major-mode 'reason-mode) (refmt))) + +(defun reason--goto-line (line) + (goto-char (point-min)) + (forward-line (1- line))) + +(defun reason--delete-whole-line (&optional arg) + "Delete the current line without putting it in the `kill-ring'. +Derived from function `kill-whole-line'. ARG is defined as for that +function." + (setq arg (or arg 1)) + (if (and (> arg 0) + (eobp) + (save-excursion (forward-visible-line 0) (eobp))) + (signal 'end-of-buffer nil)) + (if (and (< arg 0) + (bobp) + (save-excursion (end-of-visible-line) (bobp))) + (signal 'beginning-of-buffer nil)) + (cond ((zerop arg) + (delete-region (progn (forward-visible-line 0) (point)) + (progn (end-of-visible-line) (point)))) + ((< arg 0) + (delete-region (progn (end-of-visible-line) (point)) + (progn (forward-visible-line (1+ arg)) + (unless (bobp) + (backward-char)) + (point)))) + (t + (delete-region (progn (forward-visible-line 0) (point)) + (progn (forward-visible-line arg) (point)))))) + +(defun reason--apply-rcs-patch (patch-buffer &optional start-pos) + "Apply an RCS-formatted diff from PATCH-BUFFER to the current buffer." + (setq start-pos (or start-pos (point-min))) + (let ((first-line (line-number-at-pos start-pos)) + (target-buffer (current-buffer)) + ;; Relative offset between buffer line numbers and line numbers + ;; in patch. + ;; + ;; Line numbers in the patch are based on the source file, so + ;; we have to keep an offset when making changes to the + ;; buffer. + ;; + ;; Appending lines decrements the offset (possibly making it + ;; negative), deleting lines increments it. This order + ;; simplifies the forward-line invocations. + (line-offset 0)) + (save-excursion + (with-current-buffer patch-buffer + (goto-char (point-min)) + (while (not (eobp)) + (unless (looking-at "^\\([ad]\\)\\([0-9]+\\) \\([0-9]+\\)") + (error "invalid rcs patch or internal error in reason--apply-rcs-patch")) + (forward-line) + (let ((action (match-string 1)) + (from (string-to-number (match-string 2))) + (len (string-to-number (match-string 3)))) + (cond + ((equal action "a") + (let ((start (point))) + (forward-line len) + (let ((text (buffer-substring start (point)))) + (with-current-buffer target-buffer + (cl-decf line-offset len) + (goto-char start-pos) + (forward-line (- from len line-offset)) + (insert text))))) + ((equal action "d") + (with-current-buffer target-buffer + (reason--goto-line (- (1- (+ first-line from)) line-offset)) + (cl-incf line-offset len) + (reason--delete-whole-line len))) + (t + (error "invalid rcs patch or internal error in reason--apply-rcs-patch"))))))))) + +(defun refmt--process-errors (filename tmpfile errorfile errbuf) + (with-current-buffer errbuf + (if (eq refmt-show-errors 'echo) + (progn + (message "%s" (buffer-string)) + (refmt--kill-error-buffer errbuf)) + (insert-file-contents errorfile nil nil nil) + ;; Convert the refmt stderr to something understood by the compilation mode. + (goto-char (point-min)) + (insert "refmt errors:\n") + (while (search-forward-regexp (regexp-quote tmpfile) nil t) + (replace-match (file-name-nondirectory filename))) + (compilation-mode) + (display-buffer errbuf)))) + +(defun refmt--kill-error-buffer (errbuf) + (let ((win (get-buffer-window errbuf))) + (if win + (quit-window t win) + (with-current-buffer errbuf + (erase-buffer)) + (kill-buffer errbuf)))) + +(defun apply-refmt (&optional start end from to) + (setq start (or start (point-min)) + end (or end (point-max)) + from (or from "re") + to (or to "re")) + (let* ((ext (file-name-extension buffer-file-name t)) + (bufferfile (make-temp-file "refmt" nil ext)) + (outputfile (make-temp-file "refmt" nil ext)) + (errorfile (make-temp-file "refmt" nil ext)) + (errbuf (if refmt-show-errors (get-buffer-create "*Refmt Errors*"))) + (patchbuf (get-buffer-create "*Refmt patch*")) + (coding-system-for-read 'utf-8) + (coding-system-for-write 'utf-8) + (width-args + (cond + ((equal refmt-width-mode 'window) + (list "--print-width" (number-to-string (window-body-width)))) + ((equal refmt-width-mode 'fill) + (list "--print-width" (number-to-string fill-column))) + (t + '())))) + (unwind-protect + (save-restriction + (widen) + (write-region start end bufferfile) + (if errbuf + (with-current-buffer errbuf + (setq buffer-read-only nil) + (erase-buffer))) + (with-current-buffer patchbuf + (erase-buffer)) + (if (zerop (apply 'call-process + refmt-command nil (list (list :file outputfile) errorfile) + nil (append width-args (list "--parse" from "--print" to bufferfile)))) + (progn + (call-process-region start end "diff" nil patchbuf nil "-n" "-" + outputfile) + (reason--apply-rcs-patch patchbuf start) + (message "Applied refmt") + (if errbuf (refmt--kill-error-buffer errbuf))) + (message "Could not apply refmt") + (if errbuf + (refmt--process-errors (buffer-file-name) bufferfile errorfile errbuf))))) + (kill-buffer patchbuf) + (delete-file errorfile) + (delete-file bufferfile) + (delete-file outputfile))) + +(defun refmt () + "Format the current buffer according to the refmt tool." + (interactive) + (apply-refmt)) + +(defun refmt-region-ocaml-to-reason (start end) + (interactive "r") + (apply-refmt start end "ml")) + +(defun refmt-region-reason-to-ocaml (start end) + (interactive "r") + (apply-refmt start end "re" "ml")) + +(provide 'refmt) + +;;; refmt.el ends here diff --git a/emacs/.emacs.d/vendor/slack-snippets.el b/emacs/.emacs.d/vendor/slack-snippets.el new file mode 100644 index 0000000000..6bf933cfb8 --- /dev/null +++ b/emacs/.emacs.d/vendor/slack-snippets.el @@ -0,0 +1,228 @@ +;;; private/grfn/slack-snippets.el -*- lexical-binding: t; -*- + +(require 's) +(require 'json) +(require 'dash) +(require 'dash-functional) +(require 'request) +(require 'subr-x) + +;;; +;;; Configuration +;;; + +(defvar slack/token nil + "Legacy (https://api.slack.com/custom-integrations/legacy-tokens) access token") + +(defvar slack/include-public-channels 't + "Whether or not to inclue public channels in the list of conversations") + +(defvar slack/include-private-channels 't + "Whether or not to inclue public channels in the list of conversations") + +(defvar slack/include-im 't + "Whether or not to inclue IMs (private messages) in the list of conversations") + +(defvar slack/include-mpim nil + "Whether or not to inclue multi-person IMs (multi-person private messages) in + the list of conversations") + +;;; +;;; Utilities +;;; + +(defmacro comment (&rest _body) + "Comment out one or more s-expressions" + nil) + +(defun ->list (vec) (append vec nil)) + +(defun json-truthy? (x) (and x (not (equal :json-false x)))) + +;;; +;;; Generic API integration +;;; + +(defvar slack/base-url "https://slack.com/api") + +(defun slack/get (path params &optional callback) + "params is an alist of query parameters" + (let* ((params-callback (if (functionp params) `(() . ,params) (cons params callback))) + (params (car params-callback)) (callback (cdr params-callback)) + (params (append `(("token" . ,slack/token)) params)) + (url (concat (file-name-as-directory slack/base-url) path))) + (request url + :type "GET" + :params params + :parser 'json-read + :success (cl-function + (lambda (&key data &allow-other-keys) + (funcall callback data)))))) + +(defun slack/post (path params &optional callback) + (let* ((params-callback (if (functionp params) `(() . ,params) (cons params callback))) + (params (car params-callback)) (callback (cdr params-callback)) + (url (concat (file-name-as-directory slack/base-url) path))) + (request url + :type "POST" + :data (json-encode params) + :headers `(("Content-Type" . "application/json") + ("Authorization" . ,(format "Bearer %s" slack/token))) + :success (cl-function + (lambda (&key data &allow-other-keys) + (funcall callback data)))))) + + +;;; +;;; Specific API endpoints +;;; + +;; Users + +(defun slack/users (cb) + "Returns users as (id . name) pairs" + (slack/get + "users.list" + (lambda (data) + (->> data + (assoc-default 'members) + ->list + (-map (lambda (user) + (cons (assoc-default 'id user) + (assoc-default 'real_name user)))) + (-filter #'cdr) + (funcall cb))))) + +(comment + (slack/get + "users.list" + (lambda (data) (setq response-data data))) + + (slack/users (lambda (data) (setq --users data))) + + ) + +;; Conversations + +(defun slack/conversation-types () + (->> + (list (when slack/include-public-channels "public_channel") + (when slack/include-private-channels "private_channel") + (when slack/include-im "im") + (when slack/include-mpim "mpim")) + (-filter #'identity) + (s-join ","))) + +(defun channel-label (chan users-alist) + (cond + ((json-truthy? (assoc-default 'is_channel chan)) + (format "#%s" (assoc-default 'name chan))) + ((json-truthy? (assoc-default 'is_im chan)) + (let ((user-id (assoc-default 'user chan))) + (format "Private message with %s" (assoc-default user-id users-alist)))) + ((json-truthy? (assoc-default 'is_mpim chan)) + (->> chan + (assoc-default 'purpose) + (assoc-default 'value))))) + +(defun slack/conversations (cb) + "Calls `cb' with (id . '((label . \"label\") '(topic . \"topic\") '(purpose . \"purpose\"))) pairs" + (slack/get + "conversations.list" + `(("types" . ,(slack/conversation-types)) + ("exclude-archived" . "true")) + (lambda (data) + (setq --data data) + (slack/users + (lambda (users) + (->> data + (assoc-default 'channels) + ->list + (-filter + (lambda (chan) (channel-label chan users))) + (-map + (lambda (chan) + (cons (assoc-default 'id chan) + `((label . ,(channel-label chan users)) + (topic . ,(->> chan + (assoc-default 'topic) + (assoc-default 'value))) + (purpose . ,(->> chan + (assoc-default 'purpose) + (assoc-default 'value))))))) + (funcall cb))))))) + +(comment + (slack/get + "conversations.list" + '(("types" . "public_channel,private_channel,im,mpim")) + (lambda (data) (setq response-data data))) + + (slack/get + "conversations.list" + '(("types" . "im")) + (lambda (data) (setq response-data data))) + + (slack/conversations + (lambda (convos) (setq --conversations convos))) + + ) + +;; Messages + +(cl-defun slack/post-message + (&key text channel-id (on-success #'identity)) + (slack/post "chat.postMessage" + `((text . ,text) + (channel . ,channel-id) + (as_user . t)) + on-success)) + +(comment + + (slack/post-message + :text "hi slackbot" + :channel-id slackbot-channel-id + :on-success (lambda (data) (setq resp data))) + + (-map (lambda (chan) (let ((label (assoc-default 'label (cdr chan))) + (id (car chan))) + (propertize label 'channel-id id))) + --conversations) + + ) + +;;; +;;; Posting code snippets to slack +;;; + +(defun prompt-for-channel (cb) + (slack/conversations + (lambda (conversations) + (setq testing (-map (lambda (chan) (let ((label (assoc-default 'label (cdr chan))) + (id (car chan))) + (propertize label 'channel-id id))) + conversations)) + (ivy-read + "Select channel: " + ;; TODO want to potentially use purpose / topic stuff here + (-map (lambda (chan) (let ((label (assoc-default 'label (cdr chan))) + (id (car chan))) + (propertize label 'channel-id id))) + conversations) + :history 'slack/channel-history + :action (lambda (selected) + (let ((channel-id (get-text-property 0 'channel-id selected))) + (funcall cb channel-id) + (message "Sent message to %s" selected)))))) + nil) + +(defun slack-send-code-snippet (&optional snippet-text) + (interactive) + (when-let ((snippet-text (or snippet-text + (buffer-substring-no-properties (mark) (point))))) + (prompt-for-channel + (lambda (channel-id) + (slack/post-message + :text (format "```\n%s```" snippet-text) + :channel-id channel-id))))) diff --git a/emacs/.emacs.d/vendor/wpgtk-theme.el b/emacs/.emacs.d/vendor/wpgtk-theme.el new file mode 100644 index 0000000000..702048baf8 --- /dev/null +++ b/emacs/.emacs.d/vendor/wpgtk-theme.el @@ -0,0 +1,536 @@ +;;; wpgtk-theme.el --- Dynamic color theme, specially made for wpgtk + +;; based on: +;; +;; Version: 0.1 +;; Keywords: color, theme +;; Package-Requires: ((emacs "24")) + +;; Initially with the help of emacs-theme-generator, . +;; Modified directly from Nasser Alshammari's spacemacs theme + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is not part of Emacs. + +;; TODO: Is it possible to generate a *complete* Emacs theme from only 16 bit +;; colors? If so, replace all of this nonsense with just that. + +;;; Code: + +(defgroup wpgtk-theme nil + "Xres-theme options." + :group 'faces) + +(defcustom wpgtk-theme-comment-bg nil + "Use a background for comment lines." + :type 'boolean + :group 'wpgtk-theme) + +(defcustom wpgtk-theme-org-height t + "Use varying text heights for org headings." + :type 'boolean + :group 'wpgtk-theme) + +(defconst wpgtk/font "Source Code Pro 10" + "Font read from the wpg.conf template.") + +(macros/comment + (fonts/set wpgtk/font)) + +(defun get-hex-or-term (n) + "Gets N hex or a term color depending on whether we're using an GUI or not." + ;; Since I start emacs with `emacs --daemon`, `(display-graphic-p)` is `nil` + ;; and therefore "black", "brightblue", etc. will be set, which is + ;; undesirable. + (list/get n '("#01022E" + "#434AA6" + "#0278C6" + "#9B6DB0" + "#018CD5" + "#07AAE9" + "#3FA4E0" + "#a7dff4" + "#749caa" + "#434AA6" + "#0278C6" + "#9B6DB0" + "#018CD5" + "#07AAE9" + "#3FA4E0" + "#a7dff4"))) + +(defun create-wpgtk-theme (variant theme-name) + (let ((class '((class color) (min-colors 16))) + (base (get-hex-or-term 15)) + (white (get-hex-or-term 7)) + (cursor (get-hex-or-term 7)) + (bg1 (get-hex-or-term 0)) + (bg2 (get-hex-or-term 8)) + (bg3 (get-hex-or-term 8)) + (bg4 (get-hex-or-term 8)) + (key1 (get-hex-or-term 14)) + (key2 (get-hex-or-term 14)) + (builtin (get-hex-or-term 13)) + (keyword (get-hex-or-term 12)) + (const (get-hex-or-term 11)) + (comment (get-hex-or-term 2)) + (comment-bg (get-hex-or-term 0)) + (func (get-hex-or-term 13)) + (str (get-hex-or-term 11)) + (type (get-hex-or-term 14)) + (comp (get-hex-or-term 13)) + (var (get-hex-or-term 10)) + (err (get-hex-or-term 9)) + (war (get-hex-or-term 11)) + (inf (get-hex-or-term 11)) + (suc (get-hex-or-term 10)) + (green (get-hex-or-term 10)) + (yellow (get-hex-or-term 11)) + (cyan (get-hex-or-term 14)) + (violet (get-hex-or-term 13)) + (red (get-hex-or-term 9)) + (active1 (get-hex-or-term 14)) + (active2 (get-hex-or-term 6)) + (inactive (get-hex-or-term 8)) + (m-line-brdr (get-hex-or-term 8)) + (org-block-bg (get-hex-or-term 8)) + (org-h1-bg (get-hex-or-term 8)) + (org-h2-bg (get-hex-or-term 0)) + (org-h3-bg (get-hex-or-term 0)) + (org-h4-bg (get-hex-or-term 0)) + (highlight (get-hex-or-term 14))) + + (custom-theme-set-faces + theme-name + +;;;;; basics + `(cursor ((,class (:background ,cursor)))) + `(default ((,class (:background ,bg1 :foreground ,base)))) + `(default-italic ((,class (:italic t)))) + `(error ((,class (:foreground ,err)))) + `(eval-sexp-fu-flash ((,class (:background ,suc :foreground ,bg1)))) + `(eval-sexp-fu-flash-error ((,class (:background ,err :foreground ,bg1)))) + `(font-lock-builtin-face ((,class (:foreground ,builtin)))) + `(font-lock-comment-face ((,class (:foreground ,comment :background ,(when wpgtk-theme-comment-bg comment-bg))))) + `(font-lock-constant-face ((,class (:foreground ,const)))) + `(font-lock-doc-face ((,class (:foreground ,comment)))) + `(font-lock-function-name-face ((,class (:foreground ,func :bold t)))) + `(font-lock-keyword-face ((,class (:bold ,class :foreground ,keyword)))) + `(font-lock-negation-char-face ((,class (:foreground ,const)))) + `(font-lock-preprocessor-face ((,class (:foreground ,func)))) + `(font-lock-reference-face ((,class (:foreground ,const)))) + `(font-lock-string-face ((,class (:foreground ,str)))) + `(font-lock-type-face ((,class (:foreground ,type :bold t)))) + `(font-lock-variable-name-face ((,class (:foreground ,var)))) + `(font-lock-warning-face ((,class (:foreground ,war :background ,bg1)))) + `(fringe ((,class (:background ,bg1 :foreground ,base)))) + `(highlight ((,class (:foreground ,base :background ,bg3)))) + `(hl-line ((,class (:background ,bg2)))) + `(isearch ((,class (:bold t :foreground ,bg1 :background ,inf)))) + `(lazy-highlight ((,class (:foreground ,bg1 :background ,inf :weight normal)))) + `(link ((,class (:foreground ,comment :underline t)))) + `(link-visited ((,class (:foreground ,comp :underline t)))) + `(match ((,class (:background ,bg1 :foreground ,inf :weight bold)))) + `(minibuffer-prompt ((,class (:bold t :foreground ,keyword)))) + `(page-break-lines ((,class (:foreground ,active2)))) + `(region ((,class (:background ,highlight :foreground ,bg1)))) + `(secondary-selection ((,class (:background ,bg3)))) + `(show-paren-match-face ((,class (:background ,suc)))) + `(success ((,class (:foreground ,suc)))) + `(vertical-border ((,class (:foreground ,white :background, bg2)))) + `(warning ((,class (:foreground ,war )))) + +;;;;; anzu-mode + `(anzu-mode-line ((,class (:foreground ,yellow :weight bold)))) + +;;;;; company + `(company-echo-common ((,class (:background ,base :foreground ,bg1)))) + `(company-preview ((,class (:background ,bg1 :foreground ,key1)))) + `(company-preview-common ((,class (:background ,bg2 :foreground ,keyword)))) + `(company-preview-search ((,class (:background ,bg2 :foreground ,green)))) + `(company-scrollbar-bg ((,class (:background ,bg2)))) + `(company-scrollbar-fg ((,class (:background ,comp)))) + `(company-template-field ((,class (:inherit region)))) + `(company-tooltip ((,class (:background ,bg2 :foreground ,base)))) + `(company-tooltip-annotation ((,class (:background ,bg2 :foreground ,active1)))) + `(company-tooltip-common ((,class (:background ,active2 :foreground ,bg1)))) + `(company-tooltip-common-selection ((,class (:foreground ,bg1)))) + `(company-tooltip-mouse ((,class (:inherit highlight)))) + `(company-tooltip-search ((,class (:inherit match)))) + `(company-tooltip-selection ((,class (:background ,active1 :foreground, bg1)))) + +;;;;; diff + `(diff-added ((,class :background nil :foreground ,green))) + `(diff-changed ((,class :background nil :foreground ,inf))) + `(diff-indicator-added ((,class :background nil :foreground ,green))) + `(diff-indicator-changed ((,class :background nil :foreground ,inf))) + `(diff-indicator-removed ((,class :background nil :foreground ,red))) + `(diff-refine-added ((,class :background ,green :foreground ,bg4))) + `(diff-refine-changed ((,class :background ,inf :foreground ,bg4))) + `(diff-refine-removed ((,class :background ,red :foreground ,bg4))) + `(diff-removed ((,class :background nil :foreground ,red))) + +;;;;; dired + `(dired-directory ((,class (:foreground ,key1 :background ,bg1 :weight bold)))) + `(dired-flagged ((,class (:foreground ,red)))) + `(dired-header ((,class (:foreground ,comp :weight bold)))) + `(dired-ignored ((,class (:inherit shadow)))) + `(dired-mark ((,class (:foreground ,comp :weight bold)))) + `(dired-marked ((,class (:foreground ,violet :weight bold)))) + `(dired-perm-write ((,class (:foreground ,base :underline t)))) + `(dired-symlink ((,class (:foreground ,cyan :background ,bg1 :weight bold)))) + `(dired-warning ((,class (:foreground ,war)))) + +;;;;; ediff + `(ediff-current-diff-A ((,class(:background ,org-h1-bg :foreground ,inf)))) + `(ediff-current-diff-Ancestor ((,class(:background ,org-h2-bg :foreground ,str)))) + `(ediff-current-diff-B ((,class(:background ,org-h4-bg :foreground ,yellow)))) + `(ediff-current-diff-C ((,class(:background ,org-h3-bg :foreground ,green)))) + `(ediff-even-diff-A ((,class(:background ,bg3)))) + `(ediff-even-diff-Ancestor ((,class(:background ,bg3)))) + `(ediff-even-diff-B ((,class(:background ,bg3)))) + `(ediff-even-diff-C ((,class(:background ,bg3)))) + `(ediff-fine-diff-A ((,class(:background nil :bold t :underline t)))) + `(ediff-fine-diff-Ancestor ((,class(:background nil :bold t :underline t)))) + `(ediff-fine-diff-B ((,class(:background nil :bold t :underline t)))) + `(ediff-fine-diff-C ((,class(:background nil :bold t :underline t)))) + `(ediff-odd-diff-A ((,class(:background ,bg4)))) + `(ediff-odd-diff-Ancestor ((,class(:background ,bg4)))) + `(ediff-odd-diff-B ((,class(:background ,bg4)))) + `(ediff-odd-diff-C ((,class(:background ,bg4)))) + +;;;;; ein + `(ein:cell-input-area((,class (:background ,bg2)))) + `(ein:cell-input-prompt ((,class (:foreground ,(if (eq variant 'dark) suc green))))) + `(ein:cell-output-prompt ((,class (:foreground ,err)))) + `(ein:notification-tab-normal ((,class (:foreground ,builtin)))) + `(ein:notification-tab-selected ((,class (:foreground ,(if (eq variant 'dark) suc green) :bold t)))) + +;;;;; eldoc + `(eldoc-highlight-function-argument ((,class (:foreground ,(if (eq variant 'dark) suc red) :bold t)))) + +;;;;; erc + `(erc-input-face ((,class (:foreground ,func)))) + `(erc-my-nick-face ((,class (:foreground ,key1)))) + `(erc-nick-default-face ((,class (:foreground ,inf)))) + `(erc-nick-prefix-face ((,class (:foreground ,yellow)))) + `(erc-notice-face ((,class (:foreground ,str)))) + `(erc-prompt-face ((,class (:foreground ,(if (eq variant 'dark) suc green) :bold t)))) + `(erc-timestamp-face ((,class (:foreground ,builtin)))) + +;;;;; eshell + `(eshell-ls-archive ((,class (:foreground ,red :weight bold)))) + `(eshell-ls-backup ((,class (:inherit font-lock-comment-face)))) + `(eshell-ls-clutter ((,class (:inherit font-lock-comment-face)))) + `(eshell-ls-directory ((,class (:foreground ,inf :weight bold)))) + `(eshell-ls-executable ((,class (:foreground ,suc :weight bold)))) + `(eshell-ls-missing ((,class (:inherit font-lock-warning-face)))) + `(eshell-ls-product ((,class (:inherit font-lock-doc-face)))) + `(eshell-ls-special ((,class (:foreground ,yellow :weight bold)))) + `(eshell-ls-symlink ((,class (:foreground ,cyan :weight bold)))) + `(eshell-ls-unreadable ((,class (:foreground ,base)))) + `(eshell-prompt ((,class (:foreground ,keyword :weight bold)))) + +;;;;; flycheck + `(flycheck-error ((,class (:foreground ,bg1 :background ,err)))) + `(flycheck-error-list-checker-name ((,class (:foreground ,keyword)))) + `(flycheck-fringe-error ((,class (:foreground ,err :weight bold)))) + `(flycheck-fringe-info ((,class (:foreground ,inf :weight bold)))) + `(flycheck-fringe-warning ((,class (:foreground ,war :weight bold)))) + `(flycheck-info + ((,(append '((supports :underline (:style line))) class) + (:underline (:style line :color ,inf))) + (,class (:foreground ,base :background ,inf :weight bold :underline t)))) + `(flycheck-warning ((,class (:foreground ,bg1 :background ,violet)))) + +;;;;; git-gutter-fr + `(git-gutter-fr:added ((,class (:foreground ,green :weight bold)))) + `(git-gutter-fr:deleted ((,class (:foreground ,war :weight bold)))) + `(git-gutter-fr:modified ((,class (:foreground ,inf :weight bold)))) + +;;;;; git-timemachine + `(git-timemachine-minibuffer-detail-face ((,class (:foreground ,inf :bold t :background ,org-h1-bg)))) + +;;;;; gnus + `(gnus-emphasis-highlight-words ((,class (:background ,(if (eq variant 'dark) err suc) :foreground ,(when (eq variant 'light) bg1))))) + `(gnus-header-content ((,class (:foreground ,keyword)))) + `(gnus-header-from ((,class (:foreground ,var)))) + `(gnus-header-name ((,class (:foreground ,comp)))) + `(gnus-header-subject ((,class (:foreground ,func :bold t)))) + `(gnus-summary-cancelled ((,class (:background ,(if (eq variant 'dark) err suc) :foreground ,bg1)))) + +;;;;; guide-key + `(guide-key/highlight-command-face ((,class (:foreground ,base)))) + `(guide-key/key-face ((,class (:foreground ,key1)))) + `(guide-key/prefix-command-face ((,class (:foreground ,key2 :weight bold)))) + +;;;;; helm + `(helm-bookmark-directory ((,class (:inherit helm-ff-directory)))) + `(helm-bookmark-file ((,class (:foreground ,base)))) + `(helm-bookmark-gnus ((,class (:foreground ,comp)))) + `(helm-bookmark-info ((,class (:foreground ,comp)))) + `(helm-bookmark-man ((,class (:foreground ,comp)))) + `(helm-bookmark-w3m ((,class (:foreground ,comp)))) + `(helm-buffer-directory ((,class (:foreground ,base :background ,bg1)))) + `(helm-buffer-file ((,class (:foreground ,base :background ,bg1)))) + `(helm-buffer-not-saved ((,class (:foreground ,comp :background ,bg1)))) + `(helm-buffer-process ((,class (:foreground ,builtin :background ,bg1)))) + `(helm-buffer-saved-out ((,class (:foreground ,base :background ,bg1)))) + `(helm-buffer-size ((,class (:foreground ,base :background ,bg1)))) + `(helm-candidate-number ((,class (:background ,bg1 :foreground ,inf :bold t)))) + `(helm-ff-directory ((,class (:foreground ,key1 :background ,bg1 :weight bold)))) + `(helm-ff-dotted-directory ((,class (:foreground ,key1 :background ,bg1 :weight bold)))) + `(helm-ff-executable ((,class (:foreground ,suc :background ,bg1 :weight normal)))) + `(helm-ff-file ((,class (:foreground ,base :background ,bg1 :weight normal)))) + `(helm-ff-invalid-symlink ((,class (:foreground ,red :background ,bg1 :weight bold)))) + `(helm-ff-prefix ((,class (:foreground ,bg1 :background ,keyword :weight normal)))) + `(helm-ff-symlink ((,class (:foreground ,cyan :background ,bg1 :weight bold)))) + `(helm-grep-cmd-line ((,class (:foreground ,base :background ,bg1)))) + `(helm-grep-file ((,class (:foreground ,base :background ,bg1)))) + `(helm-grep-finish ((,class (:foreground ,base :background ,bg1)))) + `(helm-grep-lineno ((,class (:foreground ,base :background ,bg1)))) + `(helm-grep-match ((,class (:foreground nil :background nil :inherit helm-match)))) + `(helm-grep-running ((,class (:foreground ,func :background ,bg1)))) + `(helm-header ((,class (:foreground ,base :background ,bg1 :underline nil :box nil)))) + `(helm-header-line-left-margin ((,class (:foreground ,inf :background ,nil)))) + `(helm-match ((,class (:inherit match)))) + `(helm-match-item ((,class (:inherit match)))) + `(helm-moccur-buffer ((,class (:foreground ,func :background ,bg1)))) + `(helm-selection ((,class (:background ,highlight :foreground, bg1)))) + `(helm-selection-line ((,class (:background ,bg2)))) + `(helm-separator ((,class (:foreground ,comp :background ,bg1)))) + `(helm-source-header ((,class (:background ,comp :foreground ,bg1 :bold t)))) + `(helm-time-zone-current ((,class (:foreground ,builtin :background ,bg1)))) + `(helm-time-zone-home ((,class (:foreground ,comp :background ,bg1)))) + `(helm-visible-mark ((,class (:foreground ,bg1 :background ,bg3)))) + +;;;;; helm-swoop + `(helm-swoop-target-line-block-face ((,class (:foreground ,base :background ,highlight)))) + `(helm-swoop-target-line-face ((,class (:foreground ,base :background ,highlight)))) + `(helm-swoop-target-word-face ((,class (:foreground ,bg1 :background ,suc)))) + +;;;;; ido + `(ido-first-match ((,class (:foreground ,comp :bold t)))) + `(ido-only-match ((,class (:foreground ,(if (eq variant 'dark) suc red) :bold t)))) + `(ido-subdir ((,class (:foreground ,key1)))) + `(ido-vertical-match-face ((,class (:foreground ,comp :underline nil)))) + +;;;;; info + `(info-header-xref ((,class (:foreground ,func :underline t)))) + `(info-menu ((,class (:foreground ,suc)))) + `(info-node ((,class (:foreground ,func :bold t)))) + `(info-quoted-name ((,class (:foreground ,builtin)))) + `(info-reference-item ((,class (:background nil :underline t :bold t)))) + `(info-string ((,class (:foreground ,str)))) + `(info-title-1 ((,class (:height 1.4 :bold t)))) + `(info-title-2 ((,class (:height 1.3 :bold t)))) + `(info-title-3 ((,class (:height 1.3)))) + `(info-title-4 ((,class (:height 1.2)))) + +;;;;; linum-mode + `(linum ((,class (:foreground ,base :background ,bg2)))) + `(nlinum ((,class (:foreground ,base :background ,bg2)))) + `(line-number ((,class (:foreground ,base :background ,bg2)))) + +;;;;; magit + `(magit-tag ((,class :background nil :foreground ,yellow))) + `(magit-blame-culprit ((,class :background ,org-h4-bg :foreground ,yellow))) + `(magit-blame-header ((,class :background ,org-h4-bg :foreground ,green))) + `(magit-blame-sha1 ((,class :background ,org-h4-bg :foreground ,func))) + `(magit-blame-subject ((,class :background ,org-h4-bg :foreground ,yellow))) + `(magit-blame-time ((,class :background ,org-h4-bg :foreground ,green))) + `(magit-blame-name ((,class :background ,org-h4-bg :foreground ,yellow))) + `(magit-blame-heading ((,class :background ,org-h4-bg :foreground ,green))) + `(magit-blame-hash ((,class :background ,org-h4-bg :foreground ,func))) + `(magit-blame-summary ((,class :background ,org-h4-bg :foreground ,yellow))) + `(magit-blame-date ((,class :background ,org-h4-bg :foreground ,green))) + `(magit-branch-local ((,class :background nil :foreground , func))) + `(magit-branch-remote ((,class :background nil :foreground ,green))) + `(magit-branch ((,class (:foreground ,const :weight bold)))) + `(magit-diff-context-highlight ((,class (:background ,bg3 :foreground ,base)))) + `(magit-diff-file-header ((,class (:background nil :foreground ,str)))) + `(magit-diff-hunk-header ((,class (:background nil :foreground ,builtin)))) + `(magit-hash ((,class (:foreground ,base)))) + `(magit-hunk-heading ((,class (:background ,bg3)))) + `(magit-hunk-heading-highlight ((,class (:background ,bg3)))) + `(magit-item-highlight ((,class :background ,bg2))) + `(magit-log-author ((,class (:foreground ,base)))) + `(magit-log-head-label-head ((,class (:background ,yellow :foreground ,bg1 :bold t)))) + `(magit-log-head-label-local ((,class (:background ,inf :foreground ,bg1 :bold t)))) + `(magit-log-head-label-remote ((,class (:background ,suc :foreground ,bg1 :bold t)))) + `(magit-log-head-label-tags ((,class (:background ,violet :foreground ,bg1 :bold t)))) + `(magit-log-head-label-wip ((,class (:background ,cyan :foreground ,bg1 :bold t)))) + `(magit-log-sha1 ((,class (:foreground ,str)))) + `(magit-process-ng ((,class (:foreground ,war :weight bold)))) + `(magit-process-ok ((,class (:foreground ,func :weight bold)))) + `(magit-section-heading ((,class (:foreground ,keyword :weight bold)))) + `(magit-section-highlight ((,class (:background ,bg2)))) + `(magit-section-title ((,class (:background ,bg1 :foreground ,builtin :weight bold)))) + +;;;;; mode-line + `(mode-line ((,class (:foreground ,bg1 :background ,active1 :box (:color ,m-line-brdr :line-width 0))))) + `(mode-line-inactive ((,class (:foreground ,white :background ,bg2 :box (:color ,m-line-brdr :line-width 0))))) + `(mode-line-buffer-id ((,class (:bold f :foreground ,bg1)))) + +;;;;; mode-line + `(sml/modified ((,class (:foreground ,bg1 :background ,red)))) + +;;;;; neotree + `(neo-dir-link-face ((,class (:foreground ,inf :weight bold)))) + `(neo-expand-btn-face ((,class (:foreground ,base)))) + `(neo-file-link-face ((,class (:foreground ,base)))) + `(neo-root-dir-face ((,class (:foreground ,func :weight bold)))) + +;;;;; org + `(org-agenda-clocking ((,class (:foreground ,comp)))) + `(org-agenda-date ((,class (:foreground ,var :height 1.1)))) + `(org-agenda-date-today ((,class (:weight bold :foreground ,keyword :height 1.3)))) + `(org-agenda-date-weekend ((,class (:weight normal :foreground ,base)))) + `(org-agenda-done ((,class (:foreground ,(if (eq variant 'dark) suc green) :bold t)))) + `(org-agenda-structure ((,class (:weight bold :foreground ,comp)))) + `(org-block ((,class (:foreground ,base)))) + `(org-block-background ((,class (:background ,org-block-bg)))) + `(org-clock-overlay ((,class (:foreground ,comp)))) + `(org-code ((,class (:foreground ,cyan)))) + `(org-column ((,class (:background ,highlight)))) + `(org-column-title ((,class (:background ,highlight)))) + `(org-date ((,class (:underline t :foreground ,var) ))) + `(org-date-selected ((,class (:background ,func :foreground ,bg1) ))) + `(org-document-info-keyword ((,class (:foreground ,str)))) + `(org-document-title ((,class (:foreground ,func :weight bold :height ,(if wpgtk-theme-org-height 1.4 1.0) :underline t)))) + `(org-done ((,class (:foreground ,(if (eq variant 'dark) suc green) :bold t :overline t :background ,org-h3-bg)))) + `(org-ellipsis ((,class (:foreground ,builtin)))) + `(org-footnote ((,class (:underline t :foreground ,base)))) + `(org-hide ((,class (:foreground ,base)))) + `(org-level-1 ((,class (:bold t :foreground ,inf :height ,(if wpgtk-theme-org-height 1.3 1.0) :background ,org-h1-bg)))) + `(org-level-2 ((,class (:bold t :foreground ,str :height ,(if wpgtk-theme-org-height 1.2 1.0) :background ,org-h2-bg)))) + `(org-level-3 ((,class (:bold nil :foreground ,green :height ,(if wpgtk-theme-org-height 1.1 1.0) :background ,org-h3-bg)))) + `(org-level-4 ((,class (:bold nil :foreground ,yellow :background ,org-h4-bg)))) + `(org-level-5 ((,class (:bold nil :foreground ,inf)))) + `(org-level-6 ((,class (:bold nil :foreground ,str)))) + `(org-level-7 ((,class (:bold nil :foreground ,green)))) + `(org-level-8 ((,class (:bold nil :foreground ,yellow)))) + `(org-link ((,class (:underline t :foreground ,comment)))) + `(org-mode-line-clock-overrun ((,class (:foreground ,err)))) + `(org-priority ((,class (:foreground ,war :bold t)))) + `(org-quote ((,class (:inherit org-block :slant italic)))) + `(org-scheduled ((,class (:foreground ,comp)))) + `(org-scheduled-today ((,class (:foreground ,func :weight bold :height 1.2)))) + `(org-sexp-date ((,class (:foreground ,base)))) + `(org-special-keyword ((,class (:foreground ,func)))) + `(org-table ((,class (:foreground ,yellow :background ,org-h4-bg)))) + `(org-todo ((,class (:foreground ,war :bold t :overline t :background ,org-h4-bg)))) + `(org-verbatim ((,class (:foreground ,inf)))) + `(org-verse ((,class (:inherit org-block :slant italic)))) + `(org-warning ((,class (:foreground ,err)))) + +;;;;; powerline + `(powerline-active1 ((,class (:background ,active2 :foreground ,base)))) + `(powerline-active2 ((,class (:background ,active2 :foreground ,base)))) + `(powerline-inactive1 ((,class (:background ,bg2 :foreground ,base)))) + `(powerline-inactive2 ((,class (:background ,bg2 :foreground ,base)))) + +;;;;; rainbow-delimiters + `(rainbow-delimiters-depth-1-face ((,class :foreground ,inf))) + `(rainbow-delimiters-depth-2-face ((,class :foreground ,func))) + `(rainbow-delimiters-depth-3-face ((,class :foreground ,str))) + `(rainbow-delimiters-depth-4-face ((,class :foreground ,green))) + `(rainbow-delimiters-depth-5-face ((,class :foreground ,yellow))) + `(rainbow-delimiters-depth-6-face ((,class :foreground ,inf))) + `(rainbow-delimiters-depth-7-face ((,class :foreground ,func))) + `(rainbow-delimiters-depth-8-face ((,class :foreground ,str))) + `(rainbow-delimiters-unmatched-face ((,class :foreground ,war))) + +;;;;; smartparens + `(sp-pair-overlay-face ((,class (:background ,highlight :foreground nil)))) + `(sp-show-pair-match-face ((,class (:foreground ,(if (eq variant 'dark) suc red) :weight bold :underline t)))) + +;;;;; term + `(term ((,class (:foreground ,base :background ,bg1)))) + `(term-color-black ((,class (:foreground ,bg4)))) + `(term-color-blue ((,class (:foreground ,inf)))) + `(term-color-cyan ((,class (:foreground ,cyan)))) + `(term-color-green ((,class (:foreground ,green)))) + `(term-color-magenta ((,class (:foreground ,builtin)))) + `(term-color-red ((,class (:foreground ,red)))) + `(term-color-white ((,class (:foreground ,base)))) + `(term-color-yellow ((,class (:foreground ,yellow)))) + +;;;;; which-key + `(which-key-command-description-face ((,class (:foreground ,base)))) + `(which-key-group-description-face ((,class (:foreground ,key2)))) + `(which-key-key-face ((,class (:foreground ,func :bold t)))) + `(which-key-separator-face ((,class (:background nil :foreground ,str)))) + `(which-key-special-key-face ((,class (:background ,func :foreground ,bg1)))) + +;;;;; other, need more work + `(ac-completion-face ((,class (:underline t :foreground ,keyword)))) + `(elixir-atom-face ((,class (:foreground ,func)))) + `(ffap ((,class (:foreground ,base)))) + `(flx-highlight-face ((,class (:foreground ,comp :underline nil)))) + `(font-latex-bold-face ((,class (:foreground ,comp)))) + `(font-latex-italic-face ((,class (:foreground ,key2 :italic t)))) + `(font-latex-match-reference-keywords ((,class (:foreground ,const)))) + `(font-latex-match-variable-keywords ((,class (:foreground ,var)))) + `(font-latex-string-face ((,class (:foreground ,str)))) + `(icompletep-determined ((,class :foreground ,builtin))) + `(js2-external-variable ((,class (:foreground ,comp )))) + `(js2-function-param ((,class (:foreground ,const)))) + `(js2-function-call ((,class (:inherit ,font-lock-function-name-face)))) + `(js2-jsdoc-html-tag-delimiter ((,class (:foreground ,str)))) + `(js2-jsdoc-html-tag-name ((,class (:foreground ,key1)))) + `(js2-jsdoc-value ((,class (:foreground ,str)))) + `(js2-private-function-call ((,class (:foreground ,const)))) + `(js2-private-member ((,class (:foreground ,base)))) + `(js3-error-face ((,class (:underline ,war)))) + `(js3-external-variable-face ((,class (:foreground ,var)))) + `(js3-function-param-face ((,class (:foreground ,key2)))) + `(js3-instance-member-face ((,class (:foreground ,const)))) + `(js3-jsdoc-tag-face ((,class (:foreground ,keyword)))) + `(js3-warning-face ((,class (:underline ,keyword)))) + `(mu4e-cited-1-face ((,class (:foreground ,base)))) + `(mu4e-cited-7-face ((,class (:foreground ,base)))) + `(mu4e-header-marks-face ((,class (:foreground ,comp)))) + `(mu4e-view-url-number-face ((,class (:foreground ,comp)))) + `(py-variable-name-face ((,class (:foreground ,var)))) + `(slime-repl-inputed-output-face ((,class (:foreground ,comp)))) + `(sh-quoted-text ((,class (:foreground ,func)))) + `(trailing-whitespace ((,class :foreground nil :background ,err))) + `(undo-tree-visualizer-current-face ((,class :foreground ,builtin))) + `(undo-tree-visualizer-default-face ((,class :foreground ,base))) + `(undo-tree-visualizer-register-face ((,class :foreground ,comp))) + `(undo-tree-visualizer-unmodified-face ((,class :foreground ,var))) + `(web-mode-builtin-face ((,class (:inherit ,font-lock-builtin-face)))) + `(web-mode-comment-face ((,class (:inherit ,font-lock-comment-face)))) + `(web-mode-constant-face ((,class (:inherit ,font-lock-constant-face)))) + `(web-mode-doctype-face ((,class (:inherit ,font-lock-comment-face)))) + `(web-mode-function-name-face ((,class (:inherit ,font-lock-function-name-face)))) + `(web-mode-html-attr-name-face ((,class (:foreground ,func)))) + `(web-mode-html-attr-value-face ((,class (:foreground ,keyword)))) + `(web-mode-html-tag-face ((,class (:foreground ,builtin)))) + `(web-mode-keyword-face ((,class (:foreground ,keyword)))) + `(web-mode-string-face ((,class (:foreground ,str)))) + `(web-mode-type-face ((,class (:inherit ,font-lock-type-face)))) + `(web-mode-warning-face ((,class (:inherit ,font-lock-warning-face))))))) + +(deftheme wpgtk "Theme for wpgtk template system") +(create-wpgtk-theme 'dark 'wpgtk) +(provide-theme 'wpgtk) + +;; Local Variables: +;; no-byte-compile: t +;; End: + +;;; wpgtk-theme.el ends here diff --git a/emacs/.emacs.d/wpc/alist.el b/emacs/.emacs.d/wpc/alist.el new file mode 100644 index 0000000000..f23109ce6a --- /dev/null +++ b/emacs/.emacs.d/wpc/alist.el @@ -0,0 +1,277 @@ +;;; alist.el --- Interface for working with associative lists -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Firstly, a rant: +;; In most cases, I find Elisp's APIs to be confusing. There's a mixture of +;; overloaded functions that leak the implementation details (TODO: provide an +;; example of this.) of the abstract data type, which I find privileges those +;; "insiders" who spend disproportionately large amounts of time in Elisp land, +;; and other functions with little-to-no pattern about the order in which +;; arguments should be applied. In theory, however, most of these APIs could +;; and should be much simpler. This module represents a step in that direction. +;; +;; I'm modelling these APIs after Elixir's APIs. +;; +;; On my wishlist is to create protocols that will allow generic interfaces like +;; Enum protocols, etc. Would be nice to abstract over... +;; - associative lists (i.e. alists) +;; - property lists (i.e. plists) +;; - hash tables +;; ...with some dictionary or map-like interface. This will probably end up +;; being quite similar to the kv.el project but with differences at the API +;; layer. +;; +;; Similar libraries: +;; - map.el: Comes bundled with recent versions of Emacs. +;; - asoc.el: Helpers for working with alists. asoc.el is similar to alist.el +;; because it uses the "!" convention for signalling that a function mutates +;; the underlying data structure. +;; - ht.el: Hash table library. +;; - kv.el: Library for dealing with key-value collections. Note that map.el +;; has a similar typeclass because it works with lists, hash-tables, or +;; arrays. +;; - a.el: Clojure-inspired way of working with key-value data structures in +;; Elisp. Works with alists, hash-tables, and sometimes vectors. +;; +;; Some API design principles: +;; - The "noun" (i.e. alist) of the "verb" (i.e. function) comes last to improve +;; composability with the threading macro (i.e. `->>') and to improve consumers' +;; intuition with the APIs. Learn this once, know it always. +;; +;; - Every function avoids mutating the alist unless it ends with !. +;; +;; - CRUD operations will be named according to the following table: +;; - "create" *and* "set" +;; - "read" *and* "get" +;; - "update" +;; - "delete" *and* "remove" +;; +;; For better or worse, all of this code expects alists in the form of: +;; ((first-name . "William") (last-name . "Carroll")) +;; +;; Special thanks to github.com/alphapapa/emacs-package-dev-handbook for some of +;; the idiomatic ways to update alists. +;; +;; TODO: Include a section that compares alist.el to a.el from +;; github.com/plexus/a.el. + +;; Dependencies: + +;; TODO: Consider dropping explicit dependency white-listing since all of these +;; should be available in my Emacs. The problem arises when this library needs +;; to be published, in which case, something like Nix and a build process could +;; possible insert the necessary require statements herein. Not sure how I feel +;; about this though. +(require 'maybe) +(require 'macros) +(require 'dash) +(require 'tuple) +(require 'maybe) + +;;; Code: + +;; TODO: Support function aliases for: +;; - create/set +;; - read/get +;; - update +;; - delete/remove + +;; Support mutative variants of functions with an ! appendage to their name. + +;; Ensure that the same message about only updating the first occurrence of a +;; key is consistent throughout documentation using string interpolation or some +;; other mechanism. + +;; TODO: Consider wrapping all of this with `(cl-defstruct alist xs)'. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Constants +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst alist/enable-tests? t + "When t, run the test suite.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; TODO: Support a variadic version of this to easily construct alists. +(defun alist/new () + "Return a new, empty alist." + '()) + +;; Create +;; TODO: See if this mutates. +(defun alist/set (k v xs) + "Set K to V in XS." + (if (alist/has-key? k xs) + (progn + (setf (alist-get k xs) v) + xs) + (list/cons `(,k . ,v) xs))) + +(defun alist/set! (k v xs) + "Set K to V in XS mutatively. +Note that this doesn't append to the alist in the way that most alists handle + writing. If the k already exists in XS, it is overwritten." + (map-delete xs k) + (map-put xs k v)) + +;; Read +(defun alist/get (k xs) + "Return the value at K in XS; otherwise, return nil. +Returns the first occurrence of K in XS since alists support multiple entries." + (cdr (assoc k xs))) + +(defun alist/get-entry (k xs) + "Return the first key-value pair at K in XS." + (assoc k xs)) + +;; Update +;; TODO: Add warning about only the first occurrence being updated in the +;; documentation. +(defun alist/update (k f xs) + "Apply F to the value stored at K in XS. +If `K' is not in `XS', this function errors. Use `alist/upsert' if you're +interested in inserting a value when a key doesn't already exist." + (if (maybe/nil? (alist/get k xs)) + (error "Refusing to update: key does not exist in alist") + (alist/set k (funcall f (alist/get k xs)) xs))) + +(defun alist/update! (k f xs) + "Call F on the entry at K in XS. +Mutative variant of `alist/update'." + (alist/set! k (funcall f (alist/get k xs))xs)) + +;; TODO: Support this. +(defun alist/upsert (k v f xs) + "If K exists in `XS' call `F' on the value otherwise insert `V'." + (if (alist/get k xs) + (alist/update k f xs) + (alist/set k v xs))) + +;; Delete +;; TODO: Make sure `delete' and `remove' behave as advertised in the Elisp docs. +(defun alist/delete (k xs) + "Deletes the entry of K from XS. +This only removes the first occurrence of K, since alists support multiple + key-value entries. See `alist/delete-all' and `alist/dedupe'." + (remove (assoc k xs) xs)) + +(defun alist/delete! (k xs) + "Delete the entry of K from XS. +Mutative variant of `alist/delete'." + (delete (assoc k xs) xs)) + +;; Additions to the CRUD API +;; TODO: Implement this function. +(defun alist/dedupe-keys (xs) + "Remove the entries in XS where the keys are `equal'.") + +(defun alist/dedupe-entries (xs) + "Remove the entries in XS where the key-value pair are `equal'." + (delete-dups xs)) + +(defun alist/keys (xs) + "Return a list of the keys in XS." + (mapcar 'car xs)) + +(defun alist/values (xs) + "Return a list of the values in XS." + (mapcar 'cdr xs)) + +(defun alist/has-key? (k xs) + "Return t if XS has a key `equal' to K." + (maybe/some? (assoc k xs))) + +(defun alist/has-value? (v xs) + "Return t if XS has a value of V." + (maybe/some? (rassoc v xs))) + +(defun alist/count (xs) + "Return the number of entries in XS." + (length xs)) + +;; TODO: Should I support `alist/find-key' and `alist/find-value' variants? +(defun alist/find (p xs) + "Apply a predicate fn, P, to each key and value in XS and return the key of + the first element that returns t." + (let ((result (list/find (lambda (x) (funcall p (car x) (cdr x))) xs))) + (if result + (car result) + nil))) + +(defun alist/map-keys (f xs) + "Call F on the values in XS, returning a new alist." + (list/map (lambda (x) + `(,(funcall f (car x)) . ,(cdr x))) + xs)) + +(defun alist/map-values (f xs) + "Call F on the values in XS, returning a new alist." + (list/map (lambda (x) + `(,(car x) . ,(funcall f (cdr x)))) + xs)) + +(defun alist/reduce (acc f xs) + "Return a new alist by calling F on k v and ACC from XS. +F should return a tuple. See tuple.el for more information." + (->> (alist/keys xs) + (list/reduce acc + (lambda (k acc) + (funcall f k (alist/get k xs) acc))))) + +(defun alist/merge (a b) + "Return a new alist with a merge of alists, A and B. +In this case, the last writer wins, which is B." + (alist/reduce a #'alist/set b)) + +;; TODO: Support `-all' variants like: +;; - get-all +;; - delete-all +;; - update-all + +;; Scratch-pad +(macros/comment + (progn + (setq person '((first-name . "William") + (first-name . "William") + (last-name . "Carroll") + (last-name . "Another"))) + (alist/set 'last-name "Van Gogh" person) + (alist/get 'last-name person) + (alist/update 'last-name (lambda (x) "whoops") person) + (alist/delete 'first-name person) + (alist/keys person) + (alist/values person) + (alist/count person) + (alist/has-key? 'first-name person) + (alist/has-value? "William" person) + ;; (alist/dedupe-keys person) + (alist/dedupe-entries person) + (alist/count person))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(when alist/enable-tests? + (prelude/assert + (equal '((2 . one) + (3 . two)) + (alist/map-keys #'1+ + '((1 . one) + (2 . two))))) + (prelude/assert + (equal '((one . 2) + (two . 3)) + (alist/map-values #'1+ + '((one . 1) + (two . 2)))))) + + +;; TODO: Support test cases for the entire API. + +(provide 'alist) +;;; alist.el ends here diff --git a/emacs/.emacs.d/wpc/bag.el b/emacs/.emacs.d/wpc/bag.el new file mode 100644 index 0000000000..c9511b18e7 --- /dev/null +++ b/emacs/.emacs.d/wpc/bag.el @@ -0,0 +1,66 @@ +;;; bag.el --- Working with bags (aka multi-sets) -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; What is a bag? A bag should be thought of as a frequency table. It's a way +;; to convert a list of something into a set that allows duplicates. Isn't +;; allowing duplicates the whole thing with Sets? Kind of. But the interface +;; of Sets is something that bags resemble, so multi-set isn't as bag of a name +;; as it may first seem. +;; +;; If you've used Python's collections.Counter, the concept of a bag should be +;; familiar already. +;; +;; Interface: +;; - add :: x -> Bag(x) -> Bag(x) +;; - remove :: x -> Bag(x) -> Bag(x) +;; - union :: Bag(x) -> Bag(x) -> Bag(x) +;; - difference :: Bag(x) -> Bag(x) -> Bag(x) + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'number) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(cl-defstruct bag xs) + +(defun bag/update (f xs) + "Call F on alist in XS." + (let ((ys (bag-xs xs))) + (setf (bag-xs xs) (funcall f ys)))) + +(defun bag/new () + "Create an empty bag." + (make-bag :xs (alist/new))) + +(defun bag/contains? (x xs) + "Return t if XS has X." + (alist/has-key? x (bag-xs xs))) + +;; TODO: Tabling this for now since working with structs seems to be +;; disappointingly difficult. Where is `struct/update'? +;; (defun bag/add (x xs) +;; "Add X to XS.") + +;; TODO: What do we name delete vs. remove? +;; (defun bag/remove (x xs) +;; "Remove X from XS. +;; This is a no-op is X doesn't exist in XS.") + +(defun bag/from-list (xs) + "Map a list of `XS' into a bag." + (->> xs + (list/reduce + (bag/new) + (lambda (x acc) + (bag/add x 1 #'number/inc acc))))) + +(provide 'bag) +;;; bag.el ends here diff --git a/emacs/.emacs.d/wpc/bills.el b/emacs/.emacs.d/wpc/bills.el new file mode 100644 index 0000000000..fbdeb9d0f8 --- /dev/null +++ b/emacs/.emacs.d/wpc/bills.el @@ -0,0 +1,26 @@ +;;; bills.el --- Helping me manage my bills -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; For personal use only. + +;;; Code: + +(defconst bills/whitelist '(("Council Tax" . "rbkc.gov.uk/onlinepayments/counciltaxpayments/") + ("Internet". "plus.net/member-centre/login")) + "Maps searchable labels to URLs to pay these bills.") + +(defun bills/url () + "Copies the URL to pay a bill onto the clipboard." + (ivy-read + "Bill: " + bills/whitelist + :action (lambda (entry) + (kill-new (cdr entry)) + (alert "Copied to clipboard!")))) + +(macros/comment + (bills/url)) + +(provide 'bills) +;;; bills.el ends here diff --git a/emacs/.emacs.d/wpc/bookmark.el b/emacs/.emacs.d/wpc/bookmark.el new file mode 100644 index 0000000000..734ddaa13a --- /dev/null +++ b/emacs/.emacs.d/wpc/bookmark.el @@ -0,0 +1,145 @@ +;;; bookmark.el --- Saved files and directories on my filesystem -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; After enjoying and relying on Emacs's builtin `jump-to-register' command, I'd +;; like to recreate this functionality with a few extensions. +;; +;; Everything herein will mimmick my previous KBDs for `jump-to-register', which +;; were -j-. If the `bookmark-path' is a file, Emacs will +;; open a buffer with that file. If the `bookmark-path' is a directory, Emacs +;; will open an ivy window searching that directory. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'f) +(require 'buffer) +(require 'list) +(require 'string) +(require 'set) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Constants +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(cl-defstruct bookmark label path kbd) + +(defconst bookmark/install-kbds? t + "When t, install keybindings.") + +;; TODO: Consider hosting this function somewhere other than here, since it +;; feels useful above of the context of bookmarks. +;; TODO: Assess whether it'd be better to use the existing function: +;; `counsel-projectile-switch-project-action'. See the noise I made on GH for +;; more context: https://github.com/ericdanan/counsel-projectile/issues/137 + +(defun bookmark/handle-directory-dwim (path) + "Open PATH as either a project directory or a regular directory. +If PATH is `projectile-project-p', open with `counsel-projectile-find-file'. +Otherwise, open with `counsel-find-file'." + (if (projectile-project-p path) + (with-temp-buffer + (cd (projectile-project-p path)) + (call-interactively #'counsel-projectile-find-file)) + (let ((ivy-extra-directories nil)) + (counsel-find-file path)))) + +(defconst bookmark/handle-directory #'bookmark/handle-directory-dwim + "Function to call when a bookmark points to a directory.") + +(defconst bookmark/handle-file #'counsel-find-file-action + "Function to call when a bookmark points to a file.") + +(defconst bookmark/whitelist + (list + (make-bookmark :label "depot" + :path "~/depot" + :kbd "t") + (make-bookmark :label "org" + :path "~/Dropbox/org" + :kbd "o") + (make-bookmark :label "universe" + :path "~/universe" + :kbd "m") + (make-bookmark :label "dotfiles" + :path "~/dotfiles" + :kbd "d") + (make-bookmark :label "current project" + :path constants/current-project + :kbd "p")) + "List of registered bookmarks.") + +(defun bookmark/from-label (label) + "Return the bookmark with LABEL or nil." + (->> bookmark/whitelist + (list/find (lambda (b) (equal label (bookmark-label b)))))) + +(defun bookmark/magit-status () + "Use ivy to select a bookmark and jump to its `magit-status' buffer." + (interactive) + (let ((labels (set/new "dotfiles" "universe" "depot")) + (all-labels (->> bookmark/whitelist + (list/map (>> bookmark-label)) + set/from-list))) + (prelude/assert (set/subset? labels all-labels)) + (ivy-read "Repository: " + (set/to-list labels) + :require-match t + :action (lambda (label) + (->> label + bookmark/from-label + bookmark-path + magit-status))))) + +;; TODO: Consider `ivy-read' extension that takes a list of structs, +;; `struct-to-label' and `label-struct' functions. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; API +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun bookmark/open (b) + "Open bookmark, B, in a new buffer or an ivy minibuffer." + (let ((path (bookmark-path b))) + (cond + ((f-directory? path) + (funcall bookmark/handle-directory path)) + ((f-file? path) + (funcall bookmark/handle-file path))))) + +(defun bookmark/ivy-open () + "Use ivy to filter available bookmarks." + (interactive) + (ivy-read "Bookmark: " + (->> bookmark/whitelist + (list/map #'bookmark-label)) + :require-match t + :action (lambda (label) + (bookmark/open (bookmark/from-label label))))) + +(when bookmark/install-kbds? + (general-define-key + :prefix "" + :states '(normal) + "jj" #'bookmark/ivy-open) + (->> bookmark/whitelist + (list/map + (lambda (b) + (general-define-key + :prefix "" + :states '(normal) + (string/concat "j" (bookmark-kbd b)) + ;; TODO: Consider `cl-labels' so `which-key' minibuffer is more + ;; helpful. + (lambda () (interactive) (bookmark/open b)))))) + (general-define-key + :states '(normal) + :prefix "" + "gS" #'bookmark/magit-status)) + +(provide 'bookmark) +;;; bookmark.el ends here diff --git a/emacs/.emacs.d/wpc/buffer.el b/emacs/.emacs.d/wpc/buffer.el new file mode 100644 index 0000000000..d388818e58 --- /dev/null +++ b/emacs/.emacs.d/wpc/buffer.el @@ -0,0 +1,198 @@ +;;; buffer.el --- Working with Emacs buffers -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Utilities for CRUDing buffers in Emacs. +;; +;; Many of these functions may seem unnecessary especially when you consider +;; there implementations. In general I believe that Elisp suffers from a +;; library disorganization problem. Providing simple wrapper functions that +;; rename functions or reorder parameters is worth the effort in my opinion if +;; it improves discoverability (via intuition) and improve composability. +;; +;; I support three ways for switching between what I'm calling "source code +;; buffers": +;; 1. Toggling previous: +;; 2. Using `ivy-read': b +;; TODO: These obscure evil KBDs. Maybe a hydra definition would be best? +;; 3. Cycling (forwards/backwards): C-f, C-b + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'prelude) +(require 'maybe) +(require 'set) +(require 'cycle) +(require 'struct) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst buffer/enable-tests? t + "When t, run the test suite.") + +(defconst buffer/install-kbds? t + "When t, install the keybindings defined herein.") + +(defconst buffer/source-code-blacklist + (set/new 'dired-mode + 'erc-mode + 'magit-status-mode + 'magit-process-mode + 'magit-log-mode + 'org-mode + 'fundamental-mode) + "A blacklist of major-modes to ignore for listing source code buffers.") + +(defconst buffer/source-code-timeout 2 + "Number of seconds to wait before invalidating the cycle.") + +(cl-defstruct source-code-cycle cycle last-called) + +(defun buffer/emacs-generated? (name) + "Return t if buffer, NAME, is an Emacs-generated buffer. +Some buffers are Emacs-generated but are surrounded by whitespace." + (let ((trimmed (s-trim name))) + (and (s-starts-with? "*" trimmed)))) + +(defun buffer/find (buffer-or-name) + "Find a buffer by its BUFFER-OR-NAME." + (get-buffer buffer-or-name)) + +(defun buffer/major-mode (name) + "Return the active `major-mode' in buffer, NAME." + (with-current-buffer (buffer/find name) + major-mode)) + +(defun buffer/source-code-buffers () + "Return a list of source code buffers. +This will ignore Emacs-generated buffers, like *Messages*. It will also ignore + any buffer whose major mode is defined in `buffer/source-code-blacklist'." + (->> (buffer-list) + (list/map #'buffer-name) + (list/reject #'buffer/emacs-generated?) + (list/reject (lambda (name) + (set/contains? (buffer/major-mode name) + buffer/source-code-blacklist))))) + +(defvar buffer/source-code-cycle-state + (make-source-code-cycle + :cycle (cycle/from-list (buffer/source-code-buffers)) + :last-called (ts-now)) + "State used to manage cycling between source code buffers.") + +(defun buffer/exists? (name) + "Return t if buffer, NAME, exists." + (maybe/some? (buffer/find name))) + +(defun buffer/new (name) + "Return a newly created buffer NAME." + (generate-new-buffer name)) + +(defun buffer/find-or-create (name) + "Find or create buffer, NAME. +Return a reference to that buffer." + (let ((x (buffer/find name))) + (if (maybe/some? x) + x + (buffer/new name)))) + +;; TODO: Should this consume: `display-buffer' or `switch-to-buffer'? +(defun buffer/show (buffer-or-name) + "Display the BUFFER-OR-NAME, which is either a buffer reference or its name." + (display-buffer buffer-or-name)) + +;; TODO: Move this and `buffer/cycle-prev' into a separate module that +;; encapsulates all of this behavior. + +(defun buffer/cycle (cycle-fn) + "Cycle forwards or backwards through `buffer/source-code-buffers'." + (let ((last-called (source-code-cycle-last-called + buffer/source-code-cycle-state)) + (cycle (source-code-cycle-cycle + buffer/source-code-cycle-state))) + (if (> (ts-diff (ts-now) last-called) + buffer/source-code-timeout) + (progn + (struct/set! source-code-cycle + cycle + (cycle/from-list (buffer/source-code-buffers)) + buffer/source-code-cycle-state) + (let ((cycle (source-code-cycle-cycle + buffer/source-code-cycle-state))) + (funcall cycle-fn cycle) + (switch-to-buffer (cycle/current cycle))) + (struct/set! source-code-cycle + last-called + (ts-now) + buffer/source-code-cycle-state)) + (progn + (funcall cycle-fn cycle) + (switch-to-buffer (cycle/current cycle)))))) + +(defun buffer/cycle-next () + "Cycle forward through the `buffer/source-code-buffers'." + (interactive) + (buffer/cycle #'cycle/next)) + +(defun buffer/cycle-prev () + "Cycle backward through the `buffer/source-code-buffers'." + (interactive) + (buffer/cycle #'cycle/prev)) + +(defun buffer/ivy-source-code () + "Use `ivy-read' to choose among all open source code buffers." + (interactive) + (ivy-read "Source code buffer: " + (-drop 1 (buffer/source-code-buffers)) + :sort nil + :action #'switch-to-buffer)) + +(defun buffer/show-previous () + "Call `switch-to-buffer' on the previously visited buffer. +This function ignores Emacs-generated buffers, i.e. the ones that look like + this: *Buffer*. It also ignores buffers that are `dired-mode' or `erc-mode'. + This blacklist can easily be changed." + (interactive) + (let* ((xs (buffer/source-code-buffers)) + (candidate (list/get 1 xs))) + (prelude/assert (maybe/some? candidate)) + (switch-to-buffer candidate))) + +(when buffer/install-kbds? + (general-define-key + :states '(normal) + "C-f" #'buffer/cycle-next + "C-b" #'buffer/cycle-prev) + (general-define-key + :prefix "" + :states '(normal) + "b" #'buffer/ivy-source-code + "" #'buffer/show-previous + "k" #'kill-buffer)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(when buffer/enable-tests? + (prelude/assert + (list/all? #'buffer/emacs-generated? + '("*scratch*" + "*Messages*" + "*shell*" + "*Shell Command Output*" + "*Occur*" + "*Warnings*" + "*Help*" + "*Completions*" + "*Apropos*" + "*info*")))) + +(provide 'buffer) +;;; buffer.el ends here diff --git a/emacs/.emacs.d/wpc/bytes.el b/emacs/.emacs.d/wpc/bytes.el new file mode 100644 index 0000000000..d8bd2e2886 --- /dev/null +++ b/emacs/.emacs.d/wpc/bytes.el @@ -0,0 +1,109 @@ +;;; bytes.el --- Working with byte values -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Functions to help with human-readable representations of byte values. +;; +;; Usage: +;; See the test cases for example usage. Or better yet, I should use a type of +;; structured documentation that would allow me to expose a view into the test +;; suite here. Is this currently possible in Elisp? +;; +;; API: +;; - serialize :: Integer -> String +;; +;; Wish list: +;; - Rounding: e.g. (bytes (* 1024 1.7)) => "2KB" + +;;; Code: + +;; TODO: Support -ibabyte variants like Gibibyte (GiB). + +;; Ranges: +;; B: [ 0, 1e3) +;; KB: [ 1e3, 1e6) +;; MB: [ 1e6, 1e6) +;; GB: [ 1e9, 1e12) +;; TB: [1e12, 1e15) +;; PB: [1e15, 1e18) +;; +;; Note: I'm currently not support exabytes because that causes the integer to +;; overflow. I imagine a larger integer type may exist, but for now, I'll +;; treat this as a YAGNI. + +(require 'prelude) +(require 'tuple) +(require 'math) +(require 'number) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Constants +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst bytes/kb (math/exp 2 10) + "Number of bytes in a kilobyte.") + +(defconst bytes/mb (math/exp 2 20) + "Number of bytes in a megabytes.") + +(defconst bytes/gb (math/exp 2 30) + "Number of bytes in a gigabyte.") + +(defconst bytes/tb (math/exp 2 40) + "Number of bytes in a terabyte.") + +(defconst bytes/pb (math/exp 2 50) + "Number of bytes in a petabyte.") + +(defconst bytes/eb (math/exp 2 60) + "Number of bytes in an exabyte.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun bytes/classify (x) + "Return unit that closest fits byte count, X." + (prelude/assert (number/whole? x)) + (cond + ((and (>= x 0) (< x bytes/kb)) 'byte) + ((and (>= x bytes/kb) (< x bytes/mb)) 'kilobyte) + ((and (>= x bytes/mb) (< x bytes/gb)) 'megabyte) + ((and (>= x bytes/gb) (< x bytes/tb)) 'gigabyte) + ((and (>= x bytes/tb) (< x bytes/pb)) 'terabyte) + ((and (>= x bytes/pb) (< x bytes/eb)) 'petabyte))) + +(defun bytes/to-string (x) + "Convert integer X into a human-readable string." + (let ((base-and-unit + (pcase (bytes/classify x) + ('byte (tuple/from 1 "B")) + ('kilobyte (tuple/from bytes/kb "KB")) + ('megabyte (tuple/from bytes/mb "MB")) + ('gigabyte (tuple/from bytes/gb "GB")) + ('terabyte (tuple/from bytes/tb "TB")) + ('petabyte (tuple/from bytes/pb "PB"))))) + (string/format "%d%s" + (round x (tuple/first base-and-unit)) + (tuple/second base-and-unit)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(progn + (prelude/assert + (equal "1000B" (bytes/to-string 1000))) + (prelude/assert + (equal "2KB" (bytes/to-string (* 2 bytes/kb)))) + (prelude/assert + (equal "17MB" (bytes/to-string (* 17 bytes/mb)))) + (prelude/assert + (equal "419GB" (bytes/to-string (* 419 bytes/gb)))) + (prelude/assert + (equal "999TB" (bytes/to-string (* 999 bytes/tb)))) + (prelude/assert + (equal "2PB" (bytes/to-string (* 2 bytes/pb))))) + +(provide 'bytes) +;;; bytes.el ends here diff --git a/emacs/.emacs.d/wpc/cache.el b/emacs/.emacs.d/wpc/cache.el new file mode 100644 index 0000000000..7b7e1aa2a3 --- /dev/null +++ b/emacs/.emacs.d/wpc/cache.el @@ -0,0 +1,80 @@ +;;; cache.el --- Caching things -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; An immutable cache data structure. +;; +;; This is like a sideways stack, that you can pull values out from and re-push +;; to the top. It'd be like a stack supporting push, pop, pull. +;; +;; This isn't a key-value data-structure like you might expect from a +;; traditional cache. The name is subject to change, but the underlying idea of +;; a cache remains the same. +;; +;; Think about prescient.el, which uses essentially an LRU cache integrated into +;; counsel to help create a "clairovoyant", self-organizing list. +;; +;; Use-cases: +;; - Keeps an cache of workspaces sorted as MRU with an LRU eviction strategy. + +;;; Code: + +(require 'prelude) +(require 'struct) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(cl-defstruct cache xs) + +;; TODO: Prefer another KBD for yasnippet form completion than company-mode's +;; current KBD. + +(defun cache/from-list (xs) + "Turn list, XS, into a cache." + (make-cache :xs xs)) + +(defun cache/contains? (x xs) + "Return t if X in XS." + (->> xs + cache-xs + (list/contains? x))) + +(defun cache/touch (x xs) + "Ensure value X in cache, XS, is front of the list. +If X isn't in XS (using `equal'), insert it at the front." + (struct/update + cache + xs + (>> (list/reject (lambda (y) (equal x y))) + (list/cons x)) + xs)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(progn + (let ((cache (cache/from-list '("chicken" "nugget")))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; contains?/2 + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (prelude/refute + (cache/contains? "turkey" cache)) + (prelude/assert + (cache/contains? "chicken" cache)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; touch/2 + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (prelude/assert + (equal + (cache/touch "nugget" cache) + (cache/from-list '("nugget" "chicken")))) + (prelude/assert + (equal + (cache/touch "spicy" cache) + (cache/from-list '("spicy" "chicken" "nugget")))))) + +(provide 'cache) +;;; cache.el ends here diff --git a/emacs/.emacs.d/wpc/chrome.el b/emacs/.emacs.d/wpc/chrome.el new file mode 100644 index 0000000000..133c7af355 --- /dev/null +++ b/emacs/.emacs.d/wpc/chrome.el @@ -0,0 +1,82 @@ +;;; chrome.el --- Helpers for Google Chrome -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Some helper functions for working with Google Chrome. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'macros) +(require 'alist) +(require 'list) +(require 'general) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar chrome/install-kbds? t + "If t, install keybinding.") + +;; TODO: Consider modelling this as a rose-tree that can nest itself +;; arbitrarily. +;; TODO: Consider exporting existing chrome bookmarks. +(defconst chrome/label->url + '(("Google" . "www.google.com") + ("Hacker News" . "news.ycombinator.com") + ("Gmail" . "www.gmail.com") + ("WhatsApp" . "web.whatsapp.com") + ("Google Chat" . "chat/") + ("Google Calendar" . "calendar/") + ("Teknql" . "teknql.slack.com/messages") + ("Twitter" . "twitter.com")) + "Mapping labels to urls for my bookmarks.") + +(defconst chrome/splash-pages + '("Google Calendar" + "Gmail" + "Google Chat" + "WhatsApp" + "Teknql") + "The pages that should open when I open Chrome.") + +;; TODO: Add defensive check to start chrome if it isn't already open. + +;; TODO: Support option to create new session even if one already exists. + +(defun chrome/open-splash-pages () + "Opens Chrome with my preferred splash pages." + (interactive) + (->> chrome/splash-pages + (-map (lambda (x) (alist/get x chrome/label->url))) + chrome/open-urls)) + +;; TODO: Support optional kwargs. +(cl-defun chrome/open-url (url &key new-window?) + "Opens `URL' in google-chrome. +Will open without toolbars if APP-MODE? is t." + (shell-command (s-concat + "google-chrome " + (if new-window? "--new-window " "") + url))) + +(defun chrome/open-urls (urls) + "Open multiple `URLS' in chrome." + (chrome/open-url + (list/join " " urls))) + +(defun chrome/browse () + "Display a counsel window for browsing URLs." + (interactive) + (ivy-read + "URL: " + chrome/label->url + :action (lambda (entry) + (chrome/open-url (cdr entry))))) + +(provide 'chrome) +;;; chrome.el ends here diff --git a/emacs/.emacs.d/wpc/clipboard.el b/emacs/.emacs.d/wpc/clipboard.el new file mode 100644 index 0000000000..0688c9d87f --- /dev/null +++ b/emacs/.emacs.d/wpc/clipboard.el @@ -0,0 +1,44 @@ +;;; clipboard.el --- Working with X11's pasteboard -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Simple functions for copying and pasting. +;; +;; Integrate with bburns/clipmon so that System Clipboard can integrate with +;; Emacs's kill-ring. +;; +;; Wish list: +;; - Create an Emacs integration with github.com/cdown/clipmenud. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'prelude) +(require 'ivy-clipmenu) + +(prelude/assert (prelude/executable-exists? "clipmenu")) +(prelude/assert (prelude/executable-exists? "clipmenud")) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(cl-defun clipboard/copy (x &key (message "[clipboard.el] Copied!")) + "Copy string, X, to X11's clipboard." + (kill-new x) + (message message)) + +(cl-defun clipboard/paste (&key (message "[clipboard.el] Pasted!")) + "Paste contents of X11 clipboard." + (yank) + (message message)) + +(defun clipboard/contents () + "Return the contents of the clipboard as a string." + (substring-no-properties (current-kill 0))) + +(provide 'clipboard) +;;; clipboard.el ends here diff --git a/emacs/.emacs.d/wpc/colorscheme.el b/emacs/.emacs.d/wpc/colorscheme.el new file mode 100644 index 0000000000..830fc5ac3e --- /dev/null +++ b/emacs/.emacs.d/wpc/colorscheme.el @@ -0,0 +1,96 @@ +;;; colorscheme.el --- Syntax highlight and friends -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; +;; TODO: Clarify this. +;; Since I have my own definition of "theme", which couples wallpaper, font, +;; with Emacs's traditional notion of the word "theme", I'm choosing to use +;; "colorscheme" to refer to *just* the notion of syntax highlight etc. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'cycle) +(require 'general) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Constants +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defcustom colorscheme/install-kbds? t + "If non-nil, enable the keybindings.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defcustom colorscheme/whitelist + (cycle/from-list + (->> (custom-available-themes) + (list/map #'symbol-name) + (list/filter (>> (s-starts-with? "doom-"))) + (list/map #'intern))) + "The whitelist of colorschemes through which to cycle.") + +(defun colorscheme/current () + "Return the currently enabled colorscheme." + (cycle/current colorscheme/whitelist)) + +(defun colorscheme/disable-all () + "Disable all currently enabled colorschemes." + (interactive) + (->> custom-enabled-themes + (list/map #'disable-theme))) + +(defun colorscheme/set (theme) + "Call `load-theme' with `THEME', ensuring that the line numbers are bright. +There is no hook that I'm aware of to handle this more elegantly." + (load-theme theme t) + (prelude/set-line-number-color "#da5468")) + +(defun colorscheme/whitelist-set (colorscheme) + "Focus the COLORSCHEME in the `colorscheme/whitelist' cycle." + (cycle/focus (lambda (x) (equal x colorscheme)) colorscheme/whitelist) + (colorscheme/set (colorscheme/current))) + +(defun colorscheme/ivy-select () + "Load a colorscheme using ivy." + (interactive) + (let ((theme (ivy-read "Theme: " (cycle/to-list colorscheme/whitelist)))) + (colorscheme/disable-all) + (colorscheme/set (intern theme)))) + +(cl-defun colorscheme/cycle (&key forward?) + "Cycle next if `FORWARD?' is non-nil. +Cycle prev otherwise." + (disable-theme (cycle/current colorscheme/whitelist)) + (let ((theme (if forward? + (cycle/next colorscheme/whitelist) + (cycle/prev colorscheme/whitelist)))) + (colorscheme/set theme) + (message (s-concat "Active theme: " (symbol/to-string theme))))) + +(defun colorscheme/next () + "Disable the currently active theme and load the next theme." + (interactive) + (colorscheme/cycle :forward? t)) + +(defun colorscheme/prev () + "Disable the currently active theme and load the previous theme." + (interactive) + (colorscheme/cycle :forward? nil)) + +;; Keybindings +(when colorscheme/install-kbds? + (general-define-key + :prefix "" + :states '(normal) + "Ft" #'colorscheme/next + "Pt" #'colorscheme/prev)) + +(provide 'colorscheme) +;;; colorscheme.el ends here diff --git a/emacs/.emacs.d/wpc/constants.el b/emacs/.emacs.d/wpc/constants.el new file mode 100644 index 0000000000..5bfedf5553 --- /dev/null +++ b/emacs/.emacs.d/wpc/constants.el @@ -0,0 +1,41 @@ +;;; constants.el --- Constants for organizing my Emacs -*- lexical-binding: t -*- +;; Authpr: William Carroll + +;;; Commentary: +;; This file contains constants that are shared across my configuration. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'prelude) +(require 'f) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Configuration +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; TODO: Consider merging `ui.el' and `misc.el' because those are the only +;; current consumers of these constants, and I'm unsure if the indirection that +;; globally defined constants introduces is worth it. + +(defconst constants/current-project "~/universe" + "Variable holding the directory for my currently active project.") + +(prelude/assert (f-directory? constants/current-project)) + +(defconst constants/mouse-kbds + '([mouse-1] [down-mouse-1] [drag-mouse-1] [double-mouse-1] [triple-mouse-1] + [mouse-2] [down-mouse-2] [drag-mouse-2] [double-mouse-2] [triple-mouse-2] + [mouse-3] [down-mouse-3] [drag-mouse-3] [double-mouse-3] [triple-mouse-3] + [mouse-4] [down-mouse-4] [drag-mouse-4] [double-mouse-4] [triple-mouse-4] + [mouse-5] [down-mouse-5] [drag-mouse-5] [double-mouse-5] [triple-mouse-5]) + "All of the mouse-related keybindings that Emacs recognizes.") + +(defconst constants/fill-column 80 + "Variable used to set the defaults for wrapping, highlighting, etc.") + +(provide 'constants) +;;; constants.el ends here diff --git a/emacs/.emacs.d/wpc/cycle.el b/emacs/.emacs.d/wpc/cycle.el new file mode 100644 index 0000000000..9475ddd996 --- /dev/null +++ b/emacs/.emacs.d/wpc/cycle.el @@ -0,0 +1,155 @@ +;;; cycle.el --- Simple module for working with cycles. -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Something like this may already exist, but I'm having trouble finding it, and +;; I think writing my own is a nice exercise for learning more Elisp. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'prelude) +(require 'math) +(require 'maybe) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Wish list +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; - TODO: Provide immutable variant. +;; - TODO: Replace mutable consumption with immutable variant. +;; - TODO: Replace indexing with (math/mod current cycle). + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; `current-index' tracks the current index +;; `xs' is the original list +(cl-defstruct cycle current-index previous-index xs) + +(defconst cycle/enable-tests? t + "When t, run the tests defined herein.") + +(defun cycle/new (&rest xs) + "Create an empty cycle." + (make-cycle :current-index 0 + :previous-index nil + :xs xs)) + +(defun cycle/from-list (xs) + "Create a cycle from a list of `XS'." + (make-cycle :current-index 0 + :previous-index nil + :xs xs)) + +(defun cycle/to-list (xs) + "Return the list representation of a cycle, XS." + (cycle-xs xs)) + +(defun next-index<- (lo hi x) + "Return the next index in a cycle when moving downwards. +- `LO' is the lower bound. +- `HI' is the upper bound. +- `X' is the current index." + (if (< (- x 1) lo) + (- hi 1) + (- x 1))) + +(defun next-index-> (lo hi x) + "Return the next index in a cycle when moving upwards. +- `LO' is the lower bound. +- `HI' is the upper bound. +- `X' is the current index." + (if (>= (+ 1 x) hi) + lo + (+ 1 x))) + +(defun cycle/previous-focus (cycle) + "Return the previously focused entry in CYCLE." + (let ((i (cycle-previous-index cycle))) + (if (maybe/some? i) + (nth i (cycle-xs cycle)) + nil))) + +;; TODO: Consider adding "!" to the function name herein since many of them +;; mutate the collection, and the APIs are beginning to confuse me. +(defun cycle/focus-previous! (xs) + "Jump to the item in XS that was most recently focused; return the cycle. +This will error when previous-index is nil. This function mutates the +underlying struct." + (let ((i (cycle-previous-index xs))) + (if (maybe/some? i) + (progn + (cycle/jump i xs) + (cycle/current xs)) + (error "Cannot focus the previous element since cycle-previous-index is nil")))) + +(defun cycle/next (xs) + "Return the next value in `XS' and update `current-index'." + (let* ((current-index (cycle-current-index xs)) + (next-index (next-index-> 0 (cycle/count xs) current-index))) + (struct/set! cycle previous-index current-index xs) + (struct/set! cycle current-index next-index xs) + (nth next-index (cycle-xs xs)))) + +(defun cycle/prev (xs) + "Return the previous value in `XS' and update `current-index'." + (let* ((current-index (cycle-current-index xs)) + (next-index (next-index<- 0 (cycle/count xs) current-index))) + (struct/set! cycle previous-index current-index xs) + (struct/set! cycle current-index next-index xs) + (nth next-index (cycle-xs xs)))) + +(defun cycle/current (cycle) + "Return the current value in `CYCLE'." + (nth (cycle-current-index cycle) (cycle-xs cycle))) + +(defun cycle/count (cycle) + "Return the length of `xs' in `CYCLE'." + (length (cycle-xs cycle))) + +(defun cycle/jump (i xs) + "Jump to the I index of XS." + (let ((current-index (cycle-current-index xs)) + (next-index (math/mod i (cycle/count xs)))) + (struct/set! cycle previous-index current-index xs) + (struct/set! cycle current-index next-index xs)) + xs) + +(defun cycle/focus (p cycle) + "Focus the element in CYCLE for which predicate, P, is t." + (let ((i (->> cycle + cycle-xs + (-find-index p)))) + (if i + (cycle/jump i cycle) + (error "No element in cycle matches predicate")))) + +(defun cycle/contains? (x xs) + "Return t if cycle, XS, has member X." + (->> xs + cycle-xs + (list/contains? x))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(when cycle/enable-tests? + (let ((xs (cycle/new 1 2 3))) + (prelude/assert (maybe/nil? (cycle/previous-focus xs))) + (prelude/assert (= 1 (cycle/current xs))) + (prelude/assert (= 2 (cycle/next xs))) + (prelude/assert (= 1 (cycle/previous-focus xs))) + (prelude/assert (= 1 (->> xs (cycle/jump 0) cycle/current))) + (prelude/assert (= 2 (->> xs (cycle/jump 1) cycle/current))) + (prelude/assert (= 3 (->> xs (cycle/jump 2) cycle/current))) + (prelude/assert (= 2 (cycle/previous-focus xs))) + (prelude/assert (= 2 (cycle/focus-previous! xs))))) + +(provide 'cycle) +;;; cycle.el ends here diff --git a/emacs/.emacs.d/wpc/device.el b/emacs/.emacs.d/wpc/device.el new file mode 100644 index 0000000000..03eb55beb7 --- /dev/null +++ b/emacs/.emacs.d/wpc/device.el @@ -0,0 +1,38 @@ +;;; device.el --- Physical device information -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Functions for querying device information. + +;;; Code: + +(require 'dash) +(require 'alist) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst device/hostname->device + '(("zeno.lon.corp.google.com" . work-desktop) + ("seneca" . work-laptop)) + "Mapping hostname to a device symbol.") + +;; TODO: Should I generate these predicates? + +(defun device/classify () + "Return the device symbol for the current host or nil if not supported." + (alist/get system-name device/hostname->device)) + +(defun device/work-laptop? () + "Return t if current device is work laptop." + (equal 'work-laptop + (device/classify))) + +(defun device/work-desktop? () + "Return t if current device is work desktop." + (equal 'work-desktop + (device/classify))) + +(provide 'device) +;;; device.el ends here diff --git a/emacs/.emacs.d/wpc/display.el b/emacs/.emacs.d/wpc/display.el new file mode 100644 index 0000000000..8e5b890303 --- /dev/null +++ b/emacs/.emacs.d/wpc/display.el @@ -0,0 +1,98 @@ +;;; display.el --- Working with single or multiple displays -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Mostly wrappers around xrandr. +;; +;; TODO: Look into autorandr to see if it could be useful. +;; +;; Troubleshooting: +;; The following commands help me when I (infrequently) interact with xrandr. +;; - xrandr --listmonitors +;; - xrandr --query + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'prelude) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Constants +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst display/install-kbds? t + "When t, install the keybindings defined in this module.") + +;; TODO: Consider if this logic should be conditioned by `device/work-laptop?'. +(defconst display/laptop-monitor "eDP1" + "The xrandr identifier for my primary screen (on work laptop).") + +;; TODO: Why is HDMI-1, eDP-1 sometimes and HDMI1, eDP1 other times. +(defconst display/4k-monitor "HDMI1" + "The xrandr identifer for my 4K monitor.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; TODO: Debug why something this scales to 4k appropriately and other times it +;; doesn't. +(defun display/enable-4k () + "Attempt to connect to my 4K monitor." + (interactive) + (prelude/start-process + :name "display/enable-4k" + :command (string/format + "xrandr --output %s --above %s --primary --auto --dpi 144" + display/4k-monitor + display/laptop-monitor))) + +(defun display/disable-4k () + "Disconnect from the 4K monitor." + (interactive) + (prelude/start-process + :name "display/disable-4k" + :command (string/format "xrandr --output %s --off" + display/4k-monitor))) + +(defun display/enable-laptop () + "Turn the laptop monitor off. +Sometimes this is useful when I'm sharing my screen in a Google Hangout and I + only want to present one of my monitors." + (interactive) + (prelude/start-process + :name "display/disable-laptop" + :command (string/format "xrandr --output %s --auto" + display/laptop-monitor))) + +(defun display/disable-laptop () + "Turn the laptop monitor off. +Sometimes this is useful when I'm sharing my screen in a Google Hangout and I + only want to present one of my monitors." + (interactive) + (prelude/start-process + :name "display/disable-laptop" + :command (string/format "xrandr --output %s --off" + display/laptop-monitor))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Keybindings +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(when display/install-kbds? + (general-define-key + :prefix "" + :states '(normal) + "d0" #'display/disable-laptop + "d1" #'display/enable-laptop) + (general-define-key + :prefix "" + :states '(normal) + "D0" #'display/disable-4k + "D1" #'display/enable-4k)) + +(provide 'display) +;;; display.el ends here diff --git a/emacs/.emacs.d/wpc/do.el b/emacs/.emacs.d/wpc/do.el new file mode 100644 index 0000000000..7dc2b260fd --- /dev/null +++ b/emacs/.emacs.d/wpc/do.el @@ -0,0 +1,54 @@ +;;; do.el --- Small assertion library for Elisp -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Assertion library inspired by Elixir's core testing library. +;; +;; The goal here is to create this module without relying on other non-core +;; Elisp libraries. I will attempt to do this as long as I'm not sacrificing +;; the readability of this code nor the ease at which it can be written. +;; +;; A note on testing: +;; Another goal with this library is to blur the line between testing code and +;; runtime code. Developers should ideally be using `do/assert' and `do/refute' +;; in their library code. Because of this, I'm avoiding referring +;; to the notion of testing in the names of these functions. +;; +;; Hypothesis: +;; The lower the friction is for writing tests, the more likely people will +;; write tests. + +;; TODO: Support better error messages, which might include information about +;; line numbers in source code where the assertion failed. + +;; TODO: Consider offering the ability to have some of these functions compile +;; to nothing at runtime if developers want to use them while developing without +;; incurring the costs at runtime. + +;; TODO: Consider using this module instead of prelude.el. Right now, I'm +;; having troubling preferring one to the other. The benefit of this module is +;; that it's independent of prelude, but that might also be a downside, since +;; the messaging that asserting should be a critical part of any core library +;; like prelude. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defmacro do/assert (x) + "Errors unless X is t. +These are strict assertions and purposely do not rely on truthiness." + (let ((as-string (format "%s" x))) + `(unless (equal t ,x) + (error (concat "Assertion failed: " ,as-string))))) + +(defmacro do/refute (x) + "Errors unless X is nil." + (let ((as-string (format "%s" x))) + `(unless (eq nil ,x) + (error (concat "Refutation failed: " ,as-string))))) + +(provide 'do) +;;; do.el ends here diff --git a/emacs/.emacs.d/wpc/dotfiles.el b/emacs/.emacs.d/wpc/dotfiles.el new file mode 100644 index 0000000000..2e78cf2137 --- /dev/null +++ b/emacs/.emacs.d/wpc/dotfiles.el @@ -0,0 +1,53 @@ +;;; dotfiles.el --- Elisp to make dotfile management -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Quickly edit commonly used files. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'macros) +(require 'f) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; API +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst dotfiles/install-kbds? t + "When t, install the keybindings.") + +(defconst dotfiles/whitelist + '(("compton" . "~/.config/compton.conf") + ("dotfiles" . "~/dotfiles/") + ("functions" . "~/functions.zsh") + ("aliases" . "~/aliases.zsh") + ("variables" . "~/variables.zsh") + ("Xresources" . "~/.Xresources.shared") + ("xsession" . "~/.xsessionrc.shared") + ("tmux" . "~/.tmux.conf") + ("zshrc" . "~/.zshrc") + ("config.fish" . "~/.config/fish/config.fish") + ("configuration.nix" . "~/Dropbox/programming/nixify/configuration.nix") + ("init.el" . "~/.emacs.d/init.el") + ("init.vim" . "~/.config/nvim/init.vim")) + "Dotfiles that I commonly edit.") + +(defun dotfiles/edit () + "Select a dotfile from ivy and edit it in an Emacs buffer." + (interactive) + (ivy-read + "Dotfile: " + dotfiles/whitelist + :action (>> cdr find-file))) + +(defun dotfiles/find-emacs-file (name) + "Call `find-file' on NAME located in dotfiles's emacs.d directory." + (find-file + (f-join "~/dotfiles/configs/shared/.emacs.d" name))) + +(provide 'dotfiles) +;;; dotfiles.el ends here diff --git a/emacs/.emacs.d/wpc/dotted.el b/emacs/.emacs.d/wpc/dotted.el new file mode 100644 index 0000000000..90ef39f92e --- /dev/null +++ b/emacs/.emacs.d/wpc/dotted.el @@ -0,0 +1,49 @@ +;;; dotted.el --- Working with dotted pairs in Elisp -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Part of my primitives library extensions in Elisp. Contrast my primitives +;; with the wrapper extensions that I provide, which expose immutable variants +;; of data structures like an list, alist, tuple, as well as quasi-typeclasses +;; like sequence, etc. + +;;; Code: + +(require 'prelude) +(require 'macros) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(cl-defun dotted/new (&optional a b) + "Create a new dotted pair (i.e. cons cell)." + (cons a b)) + +(defun dotted/instance? (x) + "Return t if X is a dotted pair." + (let ((b (cdr x))) + (and b (atom b)))) + +(defun dotted/first (x) + "Return the first element of X." + (car x)) + +(defun dotted/second (x) + "Return the second element of X." + (cdr x)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(progn + (prelude/assert + (equal '(fname . "Bob") (dotted/new 'fname "Bob"))) + (prelude/assert + (dotted/instance? '(one . two))) + (prelude/refute + (dotted/instance? '(1 2 3)))) + +(provide 'dotted) +;;; dotted.el ends here diff --git a/emacs/.emacs.d/wpc/email.el b/emacs/.emacs.d/wpc/email.el new file mode 100644 index 0000000000..6a266a717c --- /dev/null +++ b/emacs/.emacs.d/wpc/email.el @@ -0,0 +1,11 @@ +;;; email.el --- My Emacs email settings -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Attempting to configure to `notmuch' for my personal use. + +;;; Code: +(message "Not implemented.") + +(provide 'email) +;;; email.el ends here diff --git a/emacs/.emacs.d/wpc/entr.el b/emacs/.emacs.d/wpc/entr.el new file mode 100644 index 0000000000..ac2a5812c3 --- /dev/null +++ b/emacs/.emacs.d/wpc/entr.el @@ -0,0 +1,115 @@ +;;; entr.el --- Working with terminals and entr -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Help make watch commands easier. +;; +;; This should be entirely temporary because in reality we should be able to use +;; Emacs's buffer watching abilities to run commands. +;; TODO: Explore Emacs integration that obviates `entr`. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'f) +(require 'buffer) +(require 'prelude) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; TODO: Support a generic file-watcher for commonly used languages. +(defconst entr/major-mode->save-handler + '((python-mode . entr/handle-python3)) + "Mapping of language to the `after-save-hook' function it should register.") + +(defun entr/shell-command-to-buffer (cmd name) + "Run CMD in a shell and output to the buffer NAME. +The buffer is a find-or-create operation. +The buffer is erased between runs with `erase-buffer'." + (let ((b (buffer/find-or-create name))) + (with-current-buffer b (erase-buffer)) + (shell-command cmd b) + (buffer/show b))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Python +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; TODO: This should be a top-level function. +(defconst entr/handle-python3 + (lambda () + (entr/shell-command-to-buffer + (format "python3 %s" (buffer-file-name)) + "*python3*")) + "Function that is registered as the `after-save-hook' for python3.") + +(defun entr/register-python3 () + "Register a buffer-local `after-save-hook' for calling python3 with filename." + (interactive) + (add-hook 'after-save-hook entr/handle-python3 nil t)) + +(defun entr/deregister-python3 () + "Remove the buffer-local `after-save-hook' for python3." + (interactive) + (remove-hook 'after-save-hook entr/handle-python3 t)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Protobuf +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun entr/format-protobuf () + "Formats a protobuf buffer." + (call-interactively #'clang-format)) + +;; TODO: Run this automatically with .proto file extensions. Do this after +;; verifying that `clang-format' complies with Google's style guide. +(defun entr/register-protobuf () + "Register a buffer-local `before-save-hook' for formatting protobuf buffers." + (interactive) + (add-hook + 'before-save-hook + #'entr/format-protobuf + nil + t)) + +;; TODO: Is there an interactive way to remove hooks in Emacs? +(defun entr/deregister-protobuf () + "Remove the buffer-local `before-save-hook' for protobuf." + (interactive) + (remove-hook + 'before-save-hook + #'entr/format-protobuf + t)) + +;; TODO: Support this. Currently the `intern' call is the problem. +;; (defun entr/ivy-remove-hook (hook) +;; "Use Counsel to remove a handler from HOOK." +;; (interactive) +;; (ivy-read +;; "Remove hook: " +;; (intern (prelude/prompt "Hook name: ")) +;; :action (lambda (x) (message x)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Miscellaneous +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun entr/command (command) + "Create a terminal instance with entr running COMMAND. +COMMAND is a function that is called with the current filename." + ;; Algorithm: + ;; - Get buffer's filename. + ;; - Open terminator running: `echo entr | entr `. + (interactive) + (with-current-buffer (current-buffer) + (let ((filename (buffer-file-name))) + (prelude/inspect + (format "echo %s | entr %s" filename (funcall command filename)))))) + +(provide 'entr) +;;; entr.el ends here diff --git a/emacs/.emacs.d/wpc/enum.el b/emacs/.emacs.d/wpc/enum.el new file mode 100644 index 0000000000..078e797209 --- /dev/null +++ b/emacs/.emacs.d/wpc/enum.el @@ -0,0 +1,98 @@ +;;; enum.el --- Enumerable protocol for Elisp -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Heavily influenced by Elixir. + +;; I will not be implement every function in the Enum library, since I don't +;; need every function. Some of the streaming functionality may prove difficult +;; to write in Elisp. We shall see. + +;; TODO: Implement the following functions: +;; - all?/2 +;; - any?/2 +;; - at/3 +;; - chunk_by/2 +;; - chunk_every/{2,3,4} +;; - chunk_while/4 +;; - concat/1 +;; - concat/2 +;; - count/{1,2} +;; - dedup/1 # prefer calling this function dedupe +;; - dedup_by/2 # same as above +;; - drop/2 +;; - drop_every/2 +;; - drop_while/2 +;; - each/2 +;; - empty?/1 +;; - fetch/2 +;; - fetch!/2 +;; - filter/2 +;; - find/3 +;; - find_index/2 +;; - find_value/3 +;; - flat_map/2 +;; - flat_map_reduce/3 +;; - group_by/3 +;; - intersperse/2 +;; - into/{2,3} +;; - join/2 +;; - map/2 +;; - map_every/3 +;; - map_join/3 +;; - map_reduce/3 +;; - max/2 +;; - max_by/3 +;; - member?/2 # consider calling this contains? +;; - min/2 +;; - min_by/2 +;; - min_max/2 # This is a great function because of O(n) time. +;; - min_max_by/3 +;; - random/1 # Consider just sample with num=1 +;; - reduce/{2,3} +;; - reduce_while/3 +;; - reject/2 +;; - reverse/{1,2} +;; - reverse_slice/3 +;; - scan/{2,3} +;; - shuffle/1 +;; - slice/{2,3} +;; - sort/{1,2} +;; - sort/2 +;; - sort_by/3 +;; - split/2 +;; - split_while/2 +;; - split_with/2 +;; - sum/1 +;; - take/2 +;; - take_every/2 +;; - take_random/2 # prefer calling this function sample +;; - take_while/2 +;; - to_list/1 +;; - uniq/1 # prefer calling this unique +;; - uniq_by/2 # prefer calling this unique-by +;; - unzip/1 +;; - with_index/2 +;; - zip/{1,2} + +;; TODO: Consider how to handle dispatching by type. + +;; TODO: Which types should be supported herein? +;; - linked-lists +;; - associative-lists +;; - cycles + +;; Warning: This module is a total work-in-progress, and it's quite possible +;; that I may never even finish it. + +;;; Code: + +(defun enum/count (xs) + "Return the number of elements in `XS'." + (cond + ((alist/instance? xs) (alist/count xs)) + ((list/instance? xs) (list/length xs))) + ) + +(provide 'enum) +;;; enum.el ends here diff --git a/emacs/.emacs.d/wpc/finance.el b/emacs/.emacs.d/wpc/finance.el new file mode 100644 index 0000000000..b124061ccb --- /dev/null +++ b/emacs/.emacs.d/wpc/finance.el @@ -0,0 +1,119 @@ +;;; finance.el --- Functions to help me organize my finances -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Using functions to organize my financial thinking. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'prelude) +(require 'math) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar finance/enable-tests? t + "When t, run the tests defined herein.") + +;; TODO: Support printing an org-table of these amount in a similar format to: +;; https://keisan.casio.com/exec/system/1234231998 +(cl-defun finance/future-value (amt + &key + num-years + (frequency 'monthly) + (interest-rate 0.06) + (payment-due-at 'beg) + (present-value 0)) + "Compute the Future Value of AMT. + +This function assumes that the interest rate is applied annually and not +monthly. + +This function will attempt to provide the following defaults: +- frequency: 'monthly +- interest-rate: 6% +- payment-due-at: 'beg +- present-value: 0.00" + (prelude/assert (set/contains? payment-due-at (set/new 'beg 'end))) + (prelude/assert (set/contains? frequency (set/new 'annually + 'semiannually + 'quarterly + 'monthly))) + (let ((pmt amt) + (k (alist/get frequency '((annually . 1) + (semiannually . 2) + (quarterly . 4) + (monthly . 12)))) + (r interest-rate) + (n num-years) + (pv present-value)) + (if (= 0 r) + (+ pv (* pmt n k)) + (if (equal 'beg payment-due-at) + (+ (* pv (math/exp (+ 1 (/ r k)) (* n k))) + (* pmt + (/ (- (math/exp (+ 1 (/ r k)) (* n k)) 1) + (/ r k)) + (+ 1 (/ r k)))) + (+ (* pv (math/exp (+ 1 (/ r k)) (* n k))) + (* pmt + (/ (- (math/exp (+ 1 (/ r k)) (* n k)) 1) + (/ r k)))))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(when finance/enable-tests? + (prelude/assert + (equal "1551.27" + (string/format "%0.2f" + (finance/future-value + 9.99 + :interest-rate 0.05 + :num-years 10 + :frequency 'monthly + :payment-due-at 'end + :present-value 0)))) + (prelude/assert + (equal "14318.34" + (string/format "%0.2f" + (finance/future-value 10.0 :num-years 35)))) + (prelude/assert + (equal "4200.00" + (string/format "%0.2f" + (finance/future-value + 10.0 + :interest-rate 0.0 + :num-years 35 + :frequency 'monthly + :payment-due-at 'beg + :present-value 0)))) + (prelude/assert + (equal "14318.34" + (string/format "%0.2f" + (finance/future-value + 10.0 + :interest-rate 0.06 + :num-years 35 + :frequency 'monthly + :payment-due-at 'beg + :present-value 0)))) + (prelude/assert + (equal "38282.77" + (string/format "%0.2f" + (finance/future-value + 10.0 + :interest-rate 0.1 + :num-years 35 + :frequency 'monthly + :payment-due-at 'beg + :present-value 0))))) + +(provide 'finance) +;;; finance.el ends here diff --git a/emacs/.emacs.d/wpc/fonts.el b/emacs/.emacs.d/wpc/fonts.el new file mode 100644 index 0000000000..3c6fe6bfeb --- /dev/null +++ b/emacs/.emacs.d/wpc/fonts.el @@ -0,0 +1,153 @@ +;;; fonts.el --- Font preferences -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Control my font preferences with ELisp. + +;;; Code: + +;; TODO: `defcustom' font-size. +;; TODO: `defcustom' fonts. +;; TODO: Remove wpc/ namespace. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'prelude) +(require 'cycle) +(require 'device) +(require 'maybe) +(require 'general) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Constants +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; TODO: Troubleshoot why "8" appears so large on my desktop. + +;; TODO: Consider having a different font size when I'm using my 4K monitor. + +(defconst fonts/size + (pcase (device/classify) + ('work-laptop "9") + ('work-desktop "8")) + "My preferred default font-size, which is device specific.") + +(defconst fonts/keybindings? t + "Install the keybindings when non-nil.") + +(defconst fonts/size-step 10 + "The amount (%) by which to increase or decrease a font.") + +(defconst fonts/hacker-news-recommendations + '("APL385 Unicode" + "Go Mono" + "Sudo" + "Monoid" + "Input Mono Medium" ;; NOTE: Also "Input Mono Thin" is nice. + ) + "List of fonts optimized for programming I found in a HN article.") + +(defconst fonts/whitelist + (cycle/from-list + (list/concat + fonts/hacker-news-recommendations + '("JetBrainsMono" + "Mononoki Medium" + "Monospace" + "Operator Mono Light" + "Courier" + "Andale Mono" + "Source Code Pro" + "Terminus"))) + "This is a list of my preferred fonts.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; TODO: fonts and fonts/whitelist make it difficult to name functions like +;; fonts/set as a generic Emacs function vs choosing a font from the whitelist. + +(cl-defun fonts/cycle (&key forward?) + "Cycle forwards when `FORWARD?' non-nil." + (let ((font (if forward? + (cycle/next fonts/whitelist) + (cycle/prev fonts/whitelist)))) + (message (s-concat "Active font: " font)) + (fonts/set font))) + +(defun fonts/next () + "Quickly cycle through preferred fonts." + (interactive) + (fonts/cycle :forward? t)) + +(defun fonts/prev () + "Quickly cycle through preferred fonts." + (interactive) + (fonts/cycle :forward? nil)) + +(defun fonts/set (font &optional size) + "Change the font to `FONT' with option integer, SIZE, in pixels." + (if (maybe/some? size) + (set-frame-font (string/format "%s %s" font size) nil t) + (set-frame-font font nil t))) + +(defun fonts/whitelist-set (font) + "Focuses the FONT in the `fonts/whitelist' cycle. +The size of the font is determined by `fonts/size'." + (prelude/assert (cycle/contains? font fonts/whitelist)) + (cycle/focus (lambda (x) (equal x font)) fonts/whitelist) + (fonts/set (fonts/current) fonts/size)) + +(defun fonts/ivy-select () + "Select a font from an ivy prompt." + (interactive) + (fonts/whitelist-set + (ivy-read "Font: " (cycle/to-list fonts/whitelist)))) + +(defun fonts/print-current () + "Message the currently enabled font." + (interactive) + (message + (string/format "[fonts] Current font: \"%s\"" + (fonts/current)))) + +(defun fonts/current () + "Return the currently enabled font." + (cycle/current fonts/whitelist)) + +(defun fonts/increase-size () + "Increase font size." + (interactive) + (->> (face-attribute 'default :height) + (+ fonts/size-step) + (set-face-attribute 'default (selected-frame) :height))) + +(defun fonts/decrease-size () + "Decrease font size." + (interactive) + (->> (face-attribute 'default :height) + (+ (- fonts/size-step)) + (set-face-attribute 'default (selected-frame) :height))) + +(defun fonts/reset-size () + "Restore font size to its default value." + (interactive) + (fonts/whitelist-set (fonts/current))) + +(when fonts/keybindings? + (progn + (general-define-key + :prefix "" + :states '(normal) + "Ff" #'fonts/next + "Pf" #'fonts/prev) + (general-define-key "s-9" #'fonts/ivy-select) + (general-define-key "s-0" #'fonts/reset-size) + (general-define-key "s-j" #'fonts/decrease-size) + (general-define-key "s-k" #'fonts/increase-size))) + +(provide 'fonts) +;;; fonts.el ends here diff --git a/emacs/.emacs.d/wpc/fs.el b/emacs/.emacs.d/wpc/fs.el new file mode 100644 index 0000000000..b1a79e280a --- /dev/null +++ b/emacs/.emacs.d/wpc/fs.el @@ -0,0 +1,65 @@ +;;; fs.el --- Make working with the filesystem easier -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Ergonomic alternatives for working with the filesystem. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'f) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun fs/ensure-file (path) + "Ensure that a file and its directories in `PATH' exist. +Will error for inputs with a trailing slash." + (when (s-ends-with? "/" path) + (error (format "Input path has trailing slash: %s" path))) + (->> path + f-dirname + fs/ensure-dir) + (f-touch path)) + +(f-dirname "/tmp/a/b/file.txt") + +(defun fs/ensure-dir (path) + "Ensure that a directory and its ancestor directories in `PATH' exist." + (->> path + f-split + (apply #'f-mkdir))) + +(defun fs/ls (dir &optional full-path?) + "List the files in `DIR' one-level deep. +Should behave similarly in spirit to the Unix command, ls. +If `FULL-PATH?' is set, return the full-path of the files." + (-drop 2 (directory-files dir full-path?))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; TODO: Support `refute' function / macro. +(ert-deftest fs/test/ensure-file () + (let ((file "/tmp/file/a/b/c/file.txt")) + ;; Ensure this file doesn't exist first to prevent false-positives. + (f-delete file t) + (fs/ensure-file file) + (should (and (f-exists? file) + (f-file? file))))) + +(ert-deftest fs/test/ensure-dir () + (let ((dir "/tmp/dir/a/b/c")) + ;; Ensure the directory doesn't exist. + (f-delete dir t) + (fs/ensure-dir dir) + (should (and (f-exists? dir) + (f-dir? dir))))) + +(provide 'fs) +;;; fs.el ends here diff --git a/emacs/.emacs.d/wpc/functions.el b/emacs/.emacs.d/wpc/functions.el new file mode 100644 index 0000000000..2ef82d54bb --- /dev/null +++ b/emacs/.emacs.d/wpc/functions.el @@ -0,0 +1,133 @@ +;; functions.el --- Helper functions for my Emacs development -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; This file hopefully contains friendly APIs that making ELisp development more +;; enjoyable. + +;; TODO: Break these out into separate modules. + +;;; Code: +(defun wpc/evil-window-vsplit-right () + (interactive) + (evil-window-vsplit) + (windmove-right)) + +(defun wpc/evil-window-split-down () + (interactive) + (evil-window-split) + (windmove-down)) + +(defun wpc/reindent-defun-and-align-clojure-map () + (interactive) + (call-interactively #'paredit-reindent-defun) + (call-interactively #'clojure-align)) + +(defun wpc/find-file () + "Prefer project-based file-finding if inside of project; otherwise gracefully fallback." + (interactive) + (with-current-buffer (current-buffer) + (if (projectile-project-p) + (call-interactively #'counsel-projectile-find-file) + (call-interactively #'find-file)))) + +(defun wpc/find-file-split (filename) + "Creates a window split and then edits `filename'." + (interactive) + (evil-window-vsplit) + (find-file filename)) + +(defun wpc/find-or-create-js-test () + (->> buffer-file-name + (s-chop-suffix ".js") + (s-append ".test.js") + (find-file))) + +(defun wpc/find-or-create-js-module () + (->> buffer-file-name + (s-chop-suffix ".test.js") + (s-append ".js") + (find-file))) + +(defun wpc/find-or-create-js-store () + (->> buffer-file-name + (s-replace "index.js" "store.js") + (find-file))) + +(defun wpc/find-or-create-js-component () + (->> buffer-file-name + (s-replace "store.js" "index.js") + (find-file))) + +(defun wpc/toggle-between-js-test-and-module () + "Toggle between a Javascript test or module." + (interactive) + (if (s-ends-with? ".test.js" buffer-file-name) + (wpc/find-or-create-js-module) + (if (s-ends-with? ".js" buffer-file-name) + (wpc/find-or-create-js-test) + (message "Not in a Javascript file. Exiting...")))) + +(defun wpc/toggle-between-js-component-and-store () + "Toggle between a React component and its Redux store." + (interactive) + (if (s-ends-with? "index.js" buffer-file-name) + (wpc/find-or-create-js-store) + (if (or (s-ends-with? "store.js" buffer-file-name) + (s-ends-with? "store.test.js" buffer-file-name)) + (wpc/find-or-create-js-component) + (message "Not in a React/Redux file. Exiting...")))) + +(defun wpc/read-file-as-string (filename) + (with-temp-buffer + (insert-file-contents filename) + (s-trim (buffer-string)))) + +(defun wpc/create-snippet () + "Creates a window split and then opens the Yasnippet editor." + (interactive) + (evil-window-vsplit) + (call-interactively #'yas-new-snippet)) + +(defun wpc/jump-to-parent-file () + "Jumps to a React store or component's parent file. Useful for store or index file." + (interactive) + (-> buffer-file-name + f-dirname + (f-join "..") + (f-join (f-filename buffer-file-name)) + find-file)) + +(defun wpc/add-earmuffs (x) + "Returns X surrounded by asterisks." + (format "*%s*" x)) + +(defun wpc/put-file-name-on-clipboard () + "Put the current file name on the clipboard" + (interactive) + (let ((filename (if (equal major-mode 'dired-mode) + default-directory + (buffer-file-name)))) + (when filename + (with-temp-buffer + (insert filename) + (clipboard-kill-region (point-min) (point-max))) + (message filename)))) + +(s-replace "/" "x" "a/b/c") + +(defun wpc/evil-replace-under-point () + "Faster than typing %s//thing/g." + (interactive) + (let ((term (s-replace "/" "\\/" (symbol/to-string (symbol-at-point))))) + (save-excursion + (evil-ex (concat "%s/\\b" term "\\b/"))))) + +(defun buffer-dirname () + "Return the directory name of the current buffer as a string." + (->> buffer-file-name + f-dirname + f-filename)) + +(provide 'functions) +;;; functions.el ends here diff --git a/emacs/.emacs.d/wpc/graph.el b/emacs/.emacs.d/wpc/graph.el new file mode 100644 index 0000000000..c68c308590 --- /dev/null +++ b/emacs/.emacs.d/wpc/graph.el @@ -0,0 +1,91 @@ +;;; graph.el --- Working with in-memory graphs -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; +;; Remember that there are optimal three ways to model a graph: +;; 1. Edge List +;; 2. Vertex Table (a.k.a. Neighbors Table) +;; 3. Adjacency Matrix +;; +;; I may call these "Edges", "Neighbors", "Adjacencies" to avoid verbose naming. +;; For now, I'm avoiding dealing with Adjacency Matrices as I don't have an +;; immediate use-case for them. This is subject to change. +;; +;; There are also hybrid representations of graphs that combine the three +;; aforementioned models. I believe Erlang's digraph module models graphs in +;; Erlang Term Storage (i.e. ETS) this way. +;; TODO: Verify this claim. +;; +;; Graphs can be weighted or unweighted. They can also be directed or +;; undirected. +;; TODO: Create a table explaining all graph variants. +;; +;; TODO: Figure out the relationship of this module and tree.el, which should in +;; principle overlap. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'prelude) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; For now, I'll support storing *either* neighbors or edges in the graph struct +;; as long as both aren't set, since that introduces consistency issues. I may +;; want to handle that use-case in the future, but not now. +(cl-defstruct graph neighbors edges) + +;; TODO: How do you find the starting point for a topo sort? +(defun graph/sort (xs) + "Return a topological sort of XS.") + +(defun graph/from-edges (xs) + "Create a graph struct from the Edge List, XS. +The user must pass in a valid Edge List since asserting on the shape of XS might + be expensive." + (make-graph :edges xs)) + +(defun graph/from-neighbors (xs) + "Create a graph struct from a Neighbors Table, XS. +The user must pass in a valid Neighbors Table since asserting on the shape of + XS might be expensive." + (make-graph :neighbors xs)) + +(defun graph/instance? (xs) + "Return t if XS is a graph struct." + (graph-p xs)) + +;; TODO: Model each of the mapping functions into an isomorphism. +(defun graph/edges->neighbors (xs) + "Map Edge List, XS, into a Neighbors Table." + (prelude/assert (graph/instance? xs))) + +(defun graph/neighbors->edges (xs) + "Map Neighbors Table, XS, into an Edge List." + (prelude/assert (graph/instance? xs))) + +;; Below are three different models of the same unweighted, directed graph. + +(defvar graph/edges + '((a . b) (a . c) (a . e) + (b . c) (b . d) + (c . e) + (d . f) + (e . d) (e . f))) + +(defvar graph/neighbors + ((a b c e) + (b c d) + (c e) + (d f) + (e d g) + (f))) + +(provide 'graph) +;;; graph.el ends here diff --git a/emacs/.emacs.d/wpc/imdb.el b/emacs/.emacs.d/wpc/imdb.el new file mode 100644 index 0000000000..2969da1409 --- /dev/null +++ b/emacs/.emacs.d/wpc/imdb.el @@ -0,0 +1,128 @@ +;;; imdb.el --- Internet Movie Database -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Some Elisp to help me pick movies more quickly. + +;;; Code: + +(require 'f) +(require 'macros) +(require 'pcre2el) +(require 'random) +(require 'maybe) + +;; TODO: How do you support types herein? +(cl-defstruct movie + name + year + director + watched?) + +;; TODO: Support famous directors like: +;; - Wes Anderson +;; - Woody Allen +;; - Tarantino +;; - Coen Brothers +;; - Alfonso Cauron +;; - Alejandro González Iñárritu +;; - Alfred Hitchcock +;; - Stanley Kubrick + +;; TODO: Dump this into SQL. + +(defconst imdb/kubrick-films + (->> '((:watched? nil :year 1951 :name "Flying Padre") + (:watched? nil :year 1953 :name "Fear and Desire") + (:watched? nil :year 1953 :name "The Seafarers") + (:watched? nil :year 1955 :name "Killer's Kiss") + (:watched? nil :year 1956 :name "The Killing") + (:watched? nil :year 1957 :name "Paths of Glory") + (:watched? nil :year 1960 :name "Spartacus") + (:watched? nil :year 1962 :name "Lolita") + (:watched? nil :year 1964 :name "Dr. Strangelove") + (:watched? nil :year 1968 :name "2001: A Space Odyssey") + (:watched? t :year 1971 :name "A Clockwork Orange") + (:watched? nil :year 1975 :name "Barry Lyndon") + (:watched? nil :year 1980 :name "The Shining") + (:watched? t :year 1987 :name "Full Metal Jacket") + (:watched? nil :year 1999 :name "Eyes Wide Shut")) + (list/map (lambda (x) + (make-movie :name (plist-get :name x) + :year (plist-get :year x) + :director "Stanley Kubrick" + :watched? (plist-get :watched? x)))))) + +(defconst imdb/non-top-250 + (->> '("Doctor Zhivago" + ) + (list/map #'imdb/new-movie))) + +(defun imdb/new-movie (name) + "Create a new movie with NAME." + (make-movie :name name + :year nil + :director nil + :watched? nil)) + +(defun imdb/org->movie (line) + "Parse an org LINE into a movie struct." + (let ((match (s-match + (pcre-to-elisp "^\*\*\s(TODO|DONE)\s(.+)$") + line))) + (if (maybe/some? match) + (make-movie :name (list/get 2 match) + :year nil + :director nil + :watched? (equal "DONE" (list/get 1 match))) + (error (s-concat "Parsing error: " line))))) + +;; TODO: Store these in a database or define them herein. +(defun imdb/org->movies () + "Parse entire IMDB org file into movie structs." + (->> "~/Dropbox/org/imdb_top_250.org" + f-read + (s-split "\n") + (-drop 1) + (list/filter (>> (s-starts-with? "** "))) + (list/map #'imdb/org->movie))) + +(defun imdb/watched? (movie) + "Return t if MOVIE has been watched." + (movie-watched? movie)) + +(defconst imdb/movies (imdb/org->movies) + "Structs of all watched movies.") + +(defun imdb/unwatched () + "Return list of unwatched movies." + (->> imdb/movies + (list/filter (lambda (x) (not (imdb/watched? x)))))) + +(defun imdb/name (movie) + "Return name of MOVIE." + (movie-name movie)) + + +(defun imdb/suggest () + "Randomly select movie from unwatched list." + (->> (imdb/unwatched) + (random/choice) + (imdb/name))) + +(defun imdb/unwatched-list () + "Dump all unwatched movies into a list." + (f-write-text (->> (imdb/unwatched) + (list/map #'imdb/name) + (s-join "\n")) + 'utf-8 + "/tmp/unwatched.txt")) + +(macros/comment + (imdb/org->movies) + (imdb/unwatched-list) + (imdb/suggest) + ) + +(provide 'imdb) +;;; imdb.el ends here diff --git a/emacs/.emacs.d/wpc/irc.el b/emacs/.emacs.d/wpc/irc.el new file mode 100644 index 0000000000..b9a1e31317 --- /dev/null +++ b/emacs/.emacs.d/wpc/irc.el @@ -0,0 +1,177 @@ +;;; irc.el --- Configuration for IRC chat -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Need to decide which client I will use for IRC. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'erc) +(require 'cycle) +(require 'string) +(require 'prelude) +(require 'alist) +(require 'set) +(require 'maybe) +(require 'macros) +(require 'password-store) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Configuration +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst irc/enable-tests? t + "When t, run the tests defined herein.") + +(setq erc-rename-buffers t) + +;; TODO: Find a way to avoid putting "freenode" and "#freenode" as channels +;; here. I'm doing it because when erc first connects, it's `(buffer-name)' is +;; "freenode", so when `irc/next-channel' is called, it 404s on the +;; `cycle/contains?' call in `irc/channel->cycle" unless "freenode" is there. To +;; make matters even uglier, when `erc-join-channel' is called with "freenode" +;; as the value, it connects to the "#freenode" channel, so unless "#freenode" +;; exists in this cycle also, `irc/next-channel' breaks again. This doesn't +;; pass my smell test. +(defconst irc/server->channels + `(("irc.freenode.net" . ,(cycle/new "freenode" "#freenode" "#nixos" "#emacs" "#pass")) + ("irc.corp.google.com" . ,(cycle/new "#omg" "#london" "#panic" "#prod-team"))) + "Mapping of IRC servers to a cycle of my preferred channels.") + +;; TODO: Assert that no two servers have a channel with the same name. We need +;; this because that's the assumption that underpins the `irc/channel->server' +;; function. This will probably be an O(n^2) operation. +(prelude/assert + (set/distinct? (set/from-list + (cycle/to-list + (alist/get "irc.freenode.net" + irc/server->channels))) + (set/from-list + (cycle/to-list + (alist/get "irc.corp.google.com" + irc/server->channels))))) + +(defun irc/channel->server (server->channels channel) + "Resolve an IRC server from a given CHANNEL." + (let ((result (alist/find (lambda (k v) (cycle/contains? channel v)) + server->channels))) + (prelude/assert (maybe/some? result)) + result)) + +(defun irc/channel->cycle (server->channels channel) + "Resolve an IRC's channels cycle from a given CHANNEL." + (alist/get (irc/channel->server server->channels channel) + server->channels)) + +;; Setting `erc-join-buffer' to 'bury prevents erc from stealing focus of the +;; current buffer when it connects to IRC servers. +(setq erc-join-buffer 'bury) + +;; TODO: Here is another horrible hack that should be revisted. +(setq erc-autojoin-channels-alist + (->> irc/server->channels + (alist/map-values #'cycle/to-list) + (alist/map-keys (>> (s-chop-prefix "irc.") + (s-chop-suffix ".net"))))) + +(defcustom irc/install-kbds? t + "When t, install the keybindings defined herein.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun irc/message (x) + "Print message X in a structured way." + (message (string/format "[irc.el] %s" x))) + +;; TODO: Integrate Google setup with Freenode setup. + +;; TODO: Support function or KBD for switching to an ERC buffer. + +(defun irc/kill-all-erc-processes () + "Kills all ERC buffers and processes." + (interactive) + (->> (erc-buffer-list) + (-map #'kill-buffer))) + +(defun irc/switch-to-erc-buffer () + "Switch to an ERC buffer." + (interactive) + (let ((buffers (erc-buffer-list))) + (if (list/empty? buffers) + (error "[irc.el] No ERC buffers available") + (switch-to-buffer (list/head (erc-buffer-list)))))) + +(defun irc/connect-to-freenode () + "Connect to Freenode IRC." + (interactive) + (erc-ssl :server "irc.freenode.net" + :port 6697 + :nick "wpcarro" + :password (password-store-get "programming/irc/freenode") + :full-name "William Carroll")) + +;; TODO: Handle failed connections. +(defun irc/connect-to-google () + "Connect to Google's Corp IRC using ERC." + (interactive) + (erc-ssl :server "irc.corp.google.com" + :port 6697 + :nick "wpcarro" + :full-name "William Carroll")) + +;; TODO: Prefer defining these with a less homespun solution. There is a +;; function call `erc-buffer-filter' that would be more appropriate for the +;; implementation of `irc/next-channel' and `irc/prev-channel'. +(defun irc/next-channel () + "Join the next channel for the active server." + (interactive) + (with-current-buffer (current-buffer) + (let ((cycle (irc/channel->cycle irc/server->channels (buffer-name)))) + (erc-join-channel + (cycle/next cycle)) + (irc/message + (string/format "Current IRC channel: %s" (cycle/current cycle)))))) + +(defun irc/prev-channel () + "Join the previous channel for the active server." + (interactive) + (with-current-buffer (current-buffer) + (let ((cycle (irc/channel->cycle irc/server->channels (buffer-name)))) + (erc-join-channel + (cycle/prev cycle)) + (irc/message + (string/format "Current IRC channel: %s" (cycle/current cycle)))))) + +(add-hook 'erc-mode-hook (disable auto-fill-mode)) +(add-hook 'erc-mode-hook (disable company-mode)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Keybindings +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(when irc/install-kbds? + (general-define-key + :keymaps 'erc-mode-map + "" #'irc/next-channel + "" #'irc/prev-channel)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(when irc/enable-tests? + (prelude/assert + (equal + (irc/channel->server `(("irc.dairy.com" . ,(cycle/new "#cheese" "#milk")) + ("irc.color.com" . ,(cycle/new "#red" "#blue"))) + "#cheese") + "irc.dairy.com"))) + +(provide 'irc) +;;; irc.el ends here diff --git a/emacs/.emacs.d/wpc/iso.el b/emacs/.emacs.d/wpc/iso.el new file mode 100644 index 0000000000..c9ce4a48fc --- /dev/null +++ b/emacs/.emacs.d/wpc/iso.el @@ -0,0 +1,95 @@ +;;; iso.el --- Isomorphisms in Elisp -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Providing basic isomorphisms to improve code quality. + +;;; Code: + +(require 'dotted) +(require 'tuple) +(require 'symbol) +(require 'string) +(require 'list) +(require 'alist) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(cl-defstruct iso to from x) + +(defconst iso/whitelist + '((dotted . tuple) + (symbol . string)) + "Alist representing supported isomorphisms.") + +(defconst iso/vertices + (list/concat (alist/keys iso/whitelist) + (alist/values iso/whitelist)) + "List of all of the vertices in the iso graph.") + +(defun iso/classify (x) + "Return type of X." + (cond + ((string/instance? x) 'string) + ((symbol/instance? x) 'symbol) + ((dotted/instance? x) 'dotted) + ((tuple/instance? x) 'tuple))) + +(cl-defun iso/exists? (to from) + "Return t if an isomorphism of TO to FROM exists." + ;; TODO: All of this can be improved modelling this with a graph. + (cond + ;; to -> from + ((list/contains? to (alist/keys iso/whitelist)) + (list/contains? from (alist/values iso/whitelist))) + ;; from -> to + ((list/contains? from (alist/keys iso/whitelist)) + (list/contains? to (alist/values iso/whitelist))) + ;; doesn't exist + (t nil))) + +(progn + (prelude/assert + (iso/exists? 'symbol 'string)) + (prelude/assert + (iso/exists? 'dotted 'tuple)) + (prelude/refute + (iso/exists? 'dotted 'symbol)) + (prelude/refute + (iso/exists? 'symbol 'list))) + +;; TODO: Model this as a graph. +(defconst iso/morphisms + '((string . + '(symbol #') + )) + (list (:from 'string :to 'symbol :fn #'intern) + (:from 'symbol :to 'string :fn #'symbol-name) + ) + "") + +(defun iso/to (f x) + "Apply F to X's to." + (->> x + iso-to)) + +(->> (iso/new "william" :to 'symbol) + (iso/as-to #'symbol-name) + ) + +(cl-defun iso/new (x &key to) + "Create a new isomorphism of X mapping to TO." + (let ((from (iso/classify x))) + (prelude/assert (iso/exists? to from)) + (make-iso :from from + :to to + :x x))) + +(macros/comment + (iso/new "william" :to 'symbol) + (iso/new '(one . two) :to 'tuple)) + +(provide 'iso) +;;; iso.el ends here diff --git a/emacs/.emacs.d/wpc/ivy-clipmenu.el b/emacs/.emacs.d/wpc/ivy-clipmenu.el new file mode 100644 index 0000000000..f3896137bd --- /dev/null +++ b/emacs/.emacs.d/wpc/ivy-clipmenu.el @@ -0,0 +1,134 @@ +;;; ivy-clipmenu.el --- Emacs client for clipmenu -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Ivy integration with the clipboard manager, clipmenu. Essentially, clipmenu +;; turns your system clipboard into a list. +;; +;; To use this module, you must first install clipmenu and ensure that the +;; clipmenud daemon is running. Refer to the installation instructions at +;; github.com/cdown/clipmenu for those details. +;; +;; This module intentionally does not define any keybindings since I'd prefer +;; not to presume my users' preferences. Personally, I use EXWM as my window +;; manager, so I call `exwm-input-set-key' and map it to `ivy-clipmenu/copy'. +;; +;; Usually clipmenu integrates with rofi or dmenu. This Emacs module integrates +;; with ivy. Launch this when you want to select a clip. +;; +;; Clipmenu itself supports a variety of environment variables that allow you to +;; customize its behavior. These variables are respected herein. If you'd +;; prefer to customize clipmenu's behavior from within Emacs, refer to the +;; variables defined in this module. +;; +;; For more information: +;; - See `clipmenu --help`. +;; - Visit github.com/cdown/clipmenu. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'f) +(require 's) +(require 'dash) +(require 'ivy) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Variables +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defgroup ivy-clipmenu nil + "Ivy integration for clipmenu." + :group 'ivy) + +(defcustom ivy-clipmenu/directory + (or (getenv "XDG_RUNTIME_DIR") + (getenv "TMPDIR") + "/tmp") + "Base directory for clipmenu's data." + :type 'string + :group 'ivy-clipmenu) + +(defconst ivy-clipmenu/executable-version 5 + "The major version number for the clipmenu executable.") + +(defconst ivy-clipmenu/cache-directory + (f-join ivy-clipmenu/directory + (format "clipmenu.%s.%s" + ivy-clipmenu/executable-version + (getenv "USER"))) + "Directory where the clips are stored.") + +(defconst ivy-clipmenu/cache-file-pattern + (f-join ivy-clipmenu/cache-directory "line_cache_*") + "Glob pattern matching the locations on disk for clipmenu's labels.") + +(defcustom ivy-clipmenu/history-length + (or (getenv "CM_HISTLENGTH") 25) + "Limit the number of clips in the history. +This value defaults to 25.") + +(defvar ivy-clipmenu/history nil + "History for `ivy-clipmenu/copy'.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun ivy-clipmenu/parse-content (x) + "Parse the label from the entry in clipmenu's line-cache." + (->> (s-split " " x) + (-drop 1) + (s-join " "))) + +(defun ivy-clipmenu/list-clips () + "Return a list of the content of all of the clips." + (->> ivy-clipmenu/cache-file-pattern + f-glob + (-map (lambda (path) + (s-split "\n" (f-read path) t))) + -flatten + (-reject #'s-blank?) + (-sort #'string>) + (-map #'ivy-clipmenu/parse-content) + delete-dups + (-take ivy-clipmenu/history-length))) + +(defun ivy-clipmenu/checksum (content) + "Return the CRC checksum of CONTENT." + (s-trim-right + (with-temp-buffer + (call-process "/bin/bash" nil (current-buffer) nil "-c" + (format "cksum <<<'%s'" content)) + (buffer-string)))) + +(defun ivy-clipmenu/line-to-content (line) + "Map the chosen LINE from the line cache its content from disk." + (->> line + ivy-clipmenu/checksum + (f-join ivy-clipmenu/cache-directory) + f-read)) + +(defun ivy-clipmenu/do-copy (x) + "Copy string, X, to the system clipboard." + (kill-new x) + (message "[ivy-clipmenu.el] Copied!")) + +(defun ivy-clipmenu/copy () + "Use `ivy-read' to select and copy a clip. +It's recommended to bind this function to a globally available keymap." + (interactive) + (let ((ivy-sort-functions-alist nil)) + (ivy-read "Clipmenu: " + (ivy-clipmenu/list-clips) + :history 'ivy-clipmenu/history + :action (lambda (line) + (->> line + ivy-clipmenu/line-to-content + ivy-clipmenu/do-copy))))) + +(provide 'ivy-clipmenu) +;;; ivy-clipmenu.el ends here diff --git a/emacs/.emacs.d/wpc/ivy-helpers.el b/emacs/.emacs.d/wpc/ivy-helpers.el new file mode 100644 index 0000000000..c71a907a20 --- /dev/null +++ b/emacs/.emacs.d/wpc/ivy-helpers.el @@ -0,0 +1,31 @@ +;;; ivy-helpers.el --- More interfaces to ivy -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Hopefully to improve my workflows. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'alist) +(require 'tuple) +(require 'string) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(cl-defun ivy-helpers/kv (prompt kv f) + "PROMPT users with the keys in KV and return its corresponding value. Calls F +with the key and value from KV." + (ivy-read + prompt + kv + :require-match t + :action (lambda (entry) + (funcall f (car entry) (cdr entry))))) + +;;; Code: +(provide 'ivy-helpers) +;;; ivy-helpers.el ends here diff --git a/emacs/.emacs.d/wpc/kaomoji.el b/emacs/.emacs.d/wpc/kaomoji.el new file mode 100644 index 0000000000..d6d509c146 --- /dev/null +++ b/emacs/.emacs.d/wpc/kaomoji.el @@ -0,0 +1,45 @@ +;;; kaomoji.el --- Supporting kaomoji usage -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Simple keyboards like this make life a bit better. + +;;; Code: + +(defvar kaomoji/install-kbds? + nil + "Set to t if you'd like the keybindings to be installed.") + +(defconst kaomoji/symbols '(("Joy" . "(⌒‿⌒)") + ("Love" . "(ღ˘⌣˘ღ)") + ("Sympathy" . "ヽ(~_~(・_・ )ゝ") + ("Dissatisfaction" . "(＞﹏＜)") + ("Anger" . "ヽ(‵﹏´)ノ") + ("Hugging" . "(づ￣ ³￣)づ") + ("Hiding" . "┬┴┬┴┤( ͡° ͜ʖ├┬┴┬┴") + ("Sleeping" . "(－_－) zzZ") + ("Embarrassed" . "(×﹏×)") + ("Shrug" . "ヽ(ー_ー )ノ")) + "Alist of human-readable emotions to the kaomoji.") + +;; TODO: Consider supporting a hydra for these. + +(defun kaomoji/select () + "Interactively select a kaomoji and copy it to the clipboard." + (interactive) + (ivy-read + "Select a kaomoji: " + kaomoji/symbols + :action (lambda (entry) + (kill-new (cdr entry)) + (alert "Copied to clipboard!")))) + +;; TODO: Define Hydra for all custom keyboards. +;; TODO: Define a better keybinding in a different keymap. +(when kaomoji/install-kbds? + (general-define-key + :keymaps 'global + "M-k" #'kaomoji/select)) + +(provide 'kaomoji) +;;; kaomoji.el ends here diff --git a/emacs/.emacs.d/wpc/kbd.el b/emacs/.emacs.d/wpc/kbd.el new file mode 100644 index 0000000000..49b346bc6e --- /dev/null +++ b/emacs/.emacs.d/wpc/kbd.el @@ -0,0 +1,90 @@ +;;; kbd.el --- Elisp keybinding -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; In order to stay organized, I'm attempting to dedicate KBD prefixes to +;; specific functions. I'm hoping I can be more deliberate with my keybinding +;; choices this way. +;; +;; Terminology: +;; For a more thorough overview of the terminology refer to `keybindings.md' +;; file. Here's a brief overview: +;; - workspace: Anything concerning EXWM workspaces. +;; - x11: Anything concerning X11 applications. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'prelude) +(require 'alist) +(require 'set) +(require 'string) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Constants +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst kbd/install-kbds? t + "When t, install keybindings defined herein.") + +(defconst kbd/prefixes + '((workspace . "s") + (x11 . "C-s")) + "Mapping of functions to designated keybinding prefixes to stay organized.") + +;; Assert that no keybindings are colliding. +(prelude/assert + (= (alist/count kbd/prefixes) + (->> kbd/prefixes + alist/values + set/from-list + set/count))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun kbd/raw (f x) + "Return the string keybinding for function F and appendage X. +Values for F include: +- workspace +- x11" + (prelude/assert (alist/has-key? f kbd/prefixes)) + (string/format + "%s-%s" + (alist/get f kbd/prefixes) + x)) + +(defun kbd/for (f x) + "Return the `kbd' for function F and appendage X. +Values for F include: +- workspace +- x11" + (kbd (kbd/raw f x))) + +;; TODO: Prefer copying human-readable versions to the clipboard. Right now +;; this isn't too useful. +(defun kbd/copy-keycode () + "Copy the pressed key to the system clipboard." + (interactive) + (message "[kbd] Awaiting keypress...") + (let ((key (read-key))) + (clipboard/copy (string/format "%s" key)) + (message (string/format "[kbd] \"%s\" copied!" key)))) + +(defun kbd/print-keycode () + "Prints the pressed keybinding." + (interactive) + (message "[kbd] Awaiting keypress...") + (message (string/format "[kbd] keycode: %s" (read-key)))) + +;; (when kbd/install-kbds? +;; (general-define-key +;; :prefix "" +;; "hr" #'kbd/print-keycode)) + +(provide 'kbd) +;;; kbd.el ends here diff --git a/emacs/.emacs.d/wpc/keybindings.el b/emacs/.emacs.d/wpc/keybindings.el new file mode 100644 index 0000000000..755311483d --- /dev/null +++ b/emacs/.emacs.d/wpc/keybindings.el @@ -0,0 +1,46 @@ +;;; keybindings.el --- Centralizing my keybindings -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Attempting to centralize my keybindings to simplify my configuration. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'clipboard) +(require 'screen-brightness) +(require 'chrome) +(require 'scrot) +(require 'ivy-clipmenu) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Configuration +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defmacro keybinding/exwm (c fn) + "Bind C to FN using `exwm-input-set-key' with `kbd' applied to C." + `(exwm-input-set-key (kbd ,c) ,fn)) + +(keybinding/exwm "C-M-v" #'ivy-clipmenu/copy) + +(keybinding/exwm "" #'screen-brightness/increase) +(keybinding/exwm "" #'screen-brightness/decrease) + +(keybinding/exwm "" #'pulse-audio/toggle-mute) +(keybinding/exwm "" #'pulse-audio/decrease-volume) +(keybinding/exwm "" #'pulse-audio/increase-volume) +(keybinding/exwm "" #'pulse-audio/toggle-microphone) + +(keybinding/exwm "C-M-c" #'chrome/browse) + +(keybinding/exwm (kbd/raw 'x11 "s") #'scrot/select) + +;; TODO: I need this because my Ergodox EZ sends super+shift instead of just +;; super. Remove this once I fix my Ergodox. +(keybinding/exwm "C-S-s-s" #'scrot/select) + +(provide 'keybindings) +;;; keybindings.el ends here diff --git a/emacs/.emacs.d/wpc/keyboard.el b/emacs/.emacs.d/wpc/keyboard.el new file mode 100644 index 0000000000..ec50cabd27 --- /dev/null +++ b/emacs/.emacs.d/wpc/keyboard.el @@ -0,0 +1,152 @@ +;;; keyboard.el --- Managing keyboard preferences with Elisp -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Setting key repeat and other values. +;; +;; Be wary of suspiciously round numbers. Especially those divisible by ten! + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'string) +(require 'number) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Constants +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; TODO: Support clamping functions for repeat-{rate,delay} to ensure only valid +;; values are sent to xset. +(defcustom keyboard/repeat-rate 80 + "The number of key repeat signals sent per second.") + +(defcustom keyboard/repeat-delay 170 + "The number of milliseconds before autorepeat starts.") + +(defconst keyboard/repeat-rate-copy keyboard/repeat-rate + "Copy of `keyboard/repeat-rate' to support `keyboard/reset-key-repeat'.") + +(defconst keyboard/repeat-delay-copy keyboard/repeat-delay + "Copy of `keyboard/repeat-delay' to support `keyboard/reset-key-repeat'.") + +(defcustom keyboard/install-preferences? t + "When t, install keyboard preferences.") + +(defcustom keyboard/install-kbds? nil + "When t, install keybindings.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun keyboard/message (x) + "Message X in a structured way." + (message (string/format "[keyboard.el] %s" x))) + +(cl-defun keyboard/set-key-repeat (&key + (rate keyboard/repeat-rate) + (delay keyboard/repeat-delay)) + "Use xset to set the key-repeat RATE and DELAY." + (prelude/start-process + :name "keyboard/set-key-repeat" + :command (string/format "xset r rate %s %s" delay rate))) + +;; NOTE: Settings like this are machine-dependent. For instance I only need to +;; do this on my laptop and other devices where I don't have access to my split +;; keyboard. +;; NOTE: Running keysym Caps_Lock is not idempotent. If this is called more +;; than once, xmodmap will start to error about non-existent Caps_Lock symbol. +;; For more information see here: +;; https://unix.stackexchange.com/questions/108207/how-to-map-caps-lock-as-the-compose-key-using-xmodmap-portably-and-idempotently +(defun keyboard/swap-caps-lock-and-escape () + "Swaps the caps lock and escape keys using xmodmap." + (interactive) + ;; TODO: Ensure these work once the tokenizing in prelude/start-process works + ;; as expected. + (start-process "keyboard/swap-caps-lock-and-escape" nil "/usr/bin/xmodmap" "-e" + "remove Lock = Caps_Lock") + (start-process "keyboard/swap-caps-lock-and-escape" nil "/usr/bin/xmodmap" "-e" + "keysym Caps_Lock = Escape")) + +(defun keyboard/inc-repeat-rate () + "Increment `keyboard/repeat-rate'." + (interactive) + (setq keyboard/repeat-rate (number/inc keyboard/repeat-rate)) + (keyboard/set-key-repeat :rate keyboard/repeat-rate) + (keyboard/message + (string/format "Rate: %s" keyboard/repeat-rate))) + +(defun keyboard/dec-repeat-rate () + "Decrement `keyboard/repeat-rate'." + (interactive) + (setq keyboard/repeat-rate (number/dec keyboard/repeat-rate)) + (keyboard/set-key-repeat :rate keyboard/repeat-rate) + (keyboard/message + (string/format "Rate: %s" keyboard/repeat-rate))) + +(defun keyboard/inc-repeat-delay () + "Increment `keyboard/repeat-delay'." + (interactive) + (setq keyboard/repeat-delay (number/inc keyboard/repeat-delay)) + (keyboard/set-key-repeat :delay keyboard/repeat-delay) + (keyboard/message + (string/format "Delay: %s" keyboard/repeat-delay))) + +(defun keyboard/dec-repeat-delay () + "Decrement `keyboard/repeat-delay'." + (interactive) + (setq keyboard/repeat-delay (number/dec keyboard/repeat-delay)) + (keyboard/set-key-repeat :delay keyboard/repeat-delay) + (keyboard/message + (string/format "Delay: %s" keyboard/repeat-delay))) + +(defun keyboard/print-key-repeat () + "Print the currently set values for key repeat." + (interactive) + (keyboard/message + (string/format "Rate: %s. Delay: %s" + keyboard/repeat-rate + keyboard/repeat-delay))) + +(defun keyboard/set-preferences () + "Reset the keyboard preferences to their default values. +NOTE: This function exists because occasionally I unplug and re-plug in a + keyboard and all of the preferences that I set using xset disappear." + (interactive) + (keyboard/swap-caps-lock-and-escape) + (keyboard/set-key-repeat :rate keyboard/repeat-rate + :delay keyboard/repeat-delay) + ;; TODO: Implement this message function as a macro that pulls the current + ;; file name. + (keyboard/message "Keyboard preferences set!")) + +(defun keyboard/reset-key-repeat () + "Set key repeat rate and delay to original values." + (interactive) + (keyboard/set-key-repeat :rate keyboard/repeat-rate-copy + :delay keyboard/repeat-delay-copy) + (keyboard/message "Key repeat preferences reset.")) + +(when keyboard/install-preferences? + (keyboard/set-preferences)) + +;; TODO: Define minor-mode for this. +(when keyboard/install-kbds? + (general-unbind 'motion "C-i" "C-y") + (general-define-key + ;; TODO: Choose better KBDs for these that don't interfere with useful evil + ;; ones. + ;; Use C-y when you accidentally send the key-repeat too high or too low to + ;; be meaningful. + "C-y" #'keyboard/reset-key-repeat + "C-i" #'keyboard/inc-repeat-rate + "C-u" #'keyboard/dec-repeat-rate + "C-S-i" #'keyboard/inc-repeat-delay + "C-S-u" #'keyboard/dec-repeat-delay)) + +(provide 'keyboard) +;;; keyboard.el ends here diff --git a/emacs/.emacs.d/wpc/keymap.el b/emacs/.emacs.d/wpc/keymap.el new file mode 100644 index 0000000000..87d340fcdb --- /dev/null +++ b/emacs/.emacs.d/wpc/keymap.el @@ -0,0 +1,25 @@ +;;; keymap.el --- Working with Elisp keymaps -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Very much a work-in-progress. + +;;; Code: + +(require 'macros) +(require 'symbol) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun keymap/pretty-print (x) + "Pretty prints `X'." + ;; TODO: Work-in-progress + (s-concat "\\{" (symbol/to-string x) "}")) + +(macros/comment + (keymap/pretty-print lispyville-mode-map)) + +(provide 'keymap) +;;; keymap.el ends here diff --git a/emacs/.emacs.d/wpc/laptop-battery.el b/emacs/.emacs.d/wpc/laptop-battery.el new file mode 100644 index 0000000000..3ec03553d2 --- /dev/null +++ b/emacs/.emacs.d/wpc/laptop-battery.el @@ -0,0 +1,60 @@ +;;; laptop-battery.el --- Display laptop battery information -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Some wrappers to obtain battery information. +;; +;; To troubleshoot battery consumpton look into the CLI `powertop`. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Roadmap +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; TODO: Support functions that work with reporting battery stats. +;; TODO: low-battery-reporting-threshold +;; TODO: charged-battery-reporting-threshold +;; TODO: Format modeline battery information. +;; TODO: Provide better time information in the modeline. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'battery) +(require 'alist) +(require 'maybe) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun laptop-battery/available? () + "Return t if battery information is available." + (maybe/some? battery-status-function)) + +(defun laptop-battery/percentage () + "Return the current percentage of the battery." + (->> battery-status-function + funcall + (alist/get 112))) + +(defun laptop-battery/print-percentage () + "Return the current percentage of the battery." + (interactive) + (->> (laptop-battery/percentage) + message)) + +(defun laptop-battery/display () + "Display laptop battery percentage in the modeline." + (interactive) + (display-battery-mode 1)) + +(defun laptop-battery/hide () + "Hide laptop battery percentage in the modeline." + (interactive) + (display-battery-mode -1)) + +(provide 'laptop-battery) +;;; laptop-battery.el ends here diff --git a/emacs/.emacs.d/wpc/list.el b/emacs/.emacs.d/wpc/list.el new file mode 100644 index 0000000000..5a63c8bd94 --- /dev/null +++ b/emacs/.emacs.d/wpc/list.el @@ -0,0 +1,235 @@ +;;; list.el --- Functions for working with lists. -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Since I prefer having the `list/' namespace, I wrote this module to wrap many +;; of the functions that are defined in the the global namespace in ELisp. I +;; sometimes forget the names of these functions, so it's nice for them to be +;; organized like this. +;; +;; Motivation: +;; Here are some examples of function names that I cannot tolerate: +;; - `car': Return the first element (i.e. "head") of a linked list +;; - `cdr': Return the tail of a linked list + +;; As are most APIs for standard libraries that I write, this is heavily +;; influenced by Elixir's standard library. +;; +;; Elixir's List library: +;; - ++/2 +;; - --/2 +;; - hd/1 +;; - tl/1 +;; - in/2 +;; - length/1 +;; +;; Similar libraries: +;; - dash.el: Functional library that mimmicks Clojure. It is consumed herein. +;; - list-utils.el: Utility library that covers things that dash.el may not +;; cover. +;; stream.el: Elisp implementation of streams, "implemented as delayed +;; evaluation of cons cells." + +;; TODO: Consider naming this file linked-list.el. + +;; TODO: Support module-like macro that auto-namespaces functions. + +;; TODO: Consider wrapping most data structures like linked-lists, +;; associative-lists, etc in a `cl-defstruct', so that the dispatching by type +;; can be nominal instead of duck-typing. I'm not sure if this is a good idea +;; or not. If I do this, I should provide isomorphisms to map between idiomatic +;; ways of working with Elisp data structures and my wrapped variants. + +;; TODO: Are function aliases/synonyms even a good idea? Or do they just +;; bloat the API unnecessarily? + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; TODO: Move `prelude/assert' elsewhere so that I can require it without +;; introducing the circular dependency of list.el -> prelude.el -> list.el. +;;(require 'prelude) +(require 'dash) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Constants +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst list/tests? t + "When t, run the test suite.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun list/new () + "Return a new, empty list." + '()) + +(defun list/concat (&rest lists) + "Joins `LISTS' into on list." + (apply #'-concat lists)) + +(defun list/join (joint xs) + "Join a list of strings, XS, with JOINT." + (if (list/empty? xs) + "" + (list/reduce (list/first xs) + (lambda (x acc) + (string/concat acc joint x)) + (list/tail xs)))) + +(defun list/length (xs) + "Return the number of elements in `XS'." + (length xs)) + +(defun list/get (i xs) + "Return the value in `XS' at `I', or nil." + (nth i xs)) + +(defun list/head (xs) + "Return the head of `XS'." + (car xs)) + +;; TODO: Learn how to write proper function aliases. +(defun list/first (xs) + "Alias for `list/head' for `XS'." + (list/head xs)) + +(defun list/tail (xs) + "Return the tail of `XS'." + (cdr xs)) + +(defun list/reverse (xs) + "Reverses `XS'." + (reverse xs)) + +(defun list/cons (x xs) + "Add `X' to the head of `XS'." + (cons x xs)) + +;; map, filter, reduce + +;; TODO: Create function adapters like swap. +;; (defun adapter/swap (f) +;; "Return a new function that wraps `F' and swaps the arguments." +;; (lambda (a b) +;; (funcall f b a))) + +;; TODO: Make this function work. +(defun list/reduce (acc f xs) + "Return over `XS' calling `F' on an element in `XS'and `ACC'." + (-reduce-from (lambda (acc x) (funcall f x acc)) acc xs)) + +;; TODO: Support this. It seems like `alist/set' is not working as I expected it +;; to. Perhaps we should add some tests to confirm the expected behavior. +;; (cl-defun list/index (f xs &key (transform (lambda (x) x))) +;; "Return a mapping of F applied to each x in XS to TRANSFORM applied to x. +;; The TRANSFORM function defaults to the identity function." +;; (->> xs +;; (list/reduce (alist/new) +;; (lambda (x acc) +;; (let ((k (funcall f x)) +;; (v (funcall transform x))) +;; (if (alist/has-key? k acc) +;; (setf (alist-get k acc) (list v)) +;; (setf (alist-get k acc) (list v)))))))) +;; (prelude/assert +;; (equal '(("John" . ("Cleese" "Malkovich")) +;; ("Thomas" . ("Aquinas"))) +;; (list/index (lambda (x) (plist-get x :first-name)) +;; '((:first-name "John" :last-name "Cleese") +;; (:first-name "John" :last-name "Malkovich") +;; (:first-name "Thomas" :last-name "Aquinas")) +;; :transform (lambda (x) (plist-get x :last-name))))) + +(defun list/map (f xs) + "Call `F' on each element of `XS'." + (-map f xs)) + +(defun list/map-indexed (f xs) + "Call `F' on each element of `XS' along with its index." + (-map-indexed (lambda (i x) (funcall f x i)) xs)) + +(defun list/filter (p xs) + "Return a subset of XS where predicate P returned t." + (list/reverse + (list/reduce + '() + (lambda (x acc) + (if (funcall p x) + (list/cons x acc) + acc)) + xs))) + +(defun list/reject (p xs) + "Return a subset of XS where predicate of P return nil." + (list/filter (lambda (x) (not (funcall p x))) xs)) + +(defun list/find (p xs) + "Return the first x in XS that passes P or nil." + (-find p xs)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Predicates +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun list/instance? (xs) + "Return t if `XS' is a list. +Be leery of using this with things like alists. Many data structures in Elisp + are implemented using linked lists." + (listp xs)) + +(defun list/empty? (xs) + "Return t if XS are empty." + (= 0 (list/length xs))) + +(defun list/all? (p xs) + "Return t if all `XS' pass the predicate, `P'." + (-all? p xs)) + +(defun list/any? (p xs) + "Return t if any `XS' pass the predicate, `P'." + (-any? p xs)) + +(defun list/contains? (x xs) + "Return t if X is in XS using `equal'." + (-contains? xs x)) + +;; TODO: Support dedupe. +;; TODO: Should we call this unique? Or distinct? + +;; TODO: Add tests. +(defun list/dedupe-adjacent (xs) + "Return XS without adjacent duplicates." + (prelude/assert (not (list/empty? xs))) + (list/reduce (list (list/first xs)) + (lambda (x acc) + (if (equal x (list/first acc)) + acc + (list/cons x acc))) + xs)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; (when list/tests? +;; (prelude/assert +;; (= 0 +;; (list/length '()))) +;; (prelude/assert +;; (= 5 +;; (list/length '(1 2 3 4 5)))) +;; (prelude/assert +;; (= 16 +;; (list/reduce 1 (lambda (x acc) (+ x acc)) '(1 2 3 4 5)))) +;; (prelude/assert +;; (equal '(2 4 6 8 10) +;; (list/map (lambda (x) (* x 2)) '(1 2 3 4 5))))) + +(provide 'list) +;;; list.el ends here diff --git a/emacs/.emacs.d/wpc/list.nix b/emacs/.emacs.d/wpc/list.nix new file mode 100644 index 0000000000..e664ba6fd4 --- /dev/null +++ b/emacs/.emacs.d/wpc/list.nix @@ -0,0 +1,8 @@ +{ pkgs ? import (builtins.fetchTarball + "https://github.com/tazjin/depot/archive/master.tar.gz") {} }: + +pkgs.writeElispBin { + name = "list"; + deps = epkgs: [ epkgs.dash ./prelude.nix ]; + src = ./list.el; +} diff --git a/emacs/.emacs.d/wpc/macros.el b/emacs/.emacs.d/wpc/macros.el new file mode 100644 index 0000000000..5f7c93902e --- /dev/null +++ b/emacs/.emacs.d/wpc/macros.el @@ -0,0 +1,95 @@ +;;; macros.el --- Helpful variables for making my ELisp life more enjoyable -*- lexical-binding: t -*- +;; Authpr: William Carroll + +;;; Commentary: +;; This file contains helpful variables that I use in my ELisp development. + +;; TODO: Consider a macro solution for mimmicking OCaml's auto resolution of +;; dependencies using `load-path' and friends. + +;;; Code: + +(require 'f) +(require 'string) +(require 'symbol) + +;; TODO: Support `xi' lambda shorthand macro. + +(defmacro enable (mode) + "Helper for enabling `MODE'. +Useful in `add-hook' calls. Some modes, like `linum-mode' need to be called as +`(linum-mode 1)', so `(add-hook mode #'linum-mode)' won't work." + `#'(lambda nil (,mode 1))) + +(defmacro disable (mode) + "Helper for disabling `MODE'. +Useful in `add-hook' calls." + `#'(lambda nil (,mode -1))) + +(defmacro add-hooks (modes callback) + "Add multiple `MODES' for the `CALLBACK'. +Usage: (add-hooks '(one-mode-hook 'two-mode-hook) #'fn)" + `(dolist (mode ,modes) + (add-hook mode ,callback))) + +(defmacro add-hook-before-save (mode f) + "Register a hook, `F', for a mode, `MODE' more conveniently. +Usage: (add-hook-before-save 'reason-mode-hook #'refmt-before-save)" + `(add-hook ,mode + (lambda () + (add-hook 'before-save-hook ,f)))) + +;; TODO: Debug. +(defmacro macros/ilambda (&rest body) + "Surrounds `BODY' with an interactive lambda function." + `(lambda () + (interactive) + ,@body)) + +;; TODO: Privatize? +(defun namespace () + "Return the namespace for a function based on the filename." + (->> (buffer-file-name) + f-filename + f-base)) + +(defmacro macros/comment (&rest _) + "Empty comment s-expresion where `BODY' is ignored." + `nil) + +;; NOTE: Not prepending the "macros" to this macro, since brevity is its goal. +(defmacro >> (&rest forms) + "Compose a new, point-free function by composing FORMS together." + (let ((sym (gensym))) + `(lambda (,sym) + (->> ,sym ,@forms)))) + +;; TOOD: Support this. +(cl-defmacro macros/test + (&key function + test + args + expect + equality) + (let* ((namespace (namespace)) + (test-name (string/->symbol + (s-concat namespace + "/" + "test" + "/" + (s-chop-prefix + (s-concat namespace "/") + (symbol/to-string function)))))) + `(ert-deftest ,test-name () + ,test + (should (,equality (apply ,function ,args) + ,expect))))) + +(defmacro macros/support-file-extension (ext mode) + "Register MODE to automatically load with files ending with EXT extension. +Usage: (macros/support-file-extension \"pb\" protobuf-mode)" + (let ((extension (string/format "\\.%s\\'" ext))) + `(add-to-list 'auto-mode-alist '(,extension . ,mode)))) + +(provide 'macros) +;;; macros.el ends here diff --git a/emacs/.emacs.d/wpc/math.el b/emacs/.emacs.d/wpc/math.el new file mode 100644 index 0000000000..3176d906b4 --- /dev/null +++ b/emacs/.emacs.d/wpc/math.el @@ -0,0 +1,59 @@ +;;; math.el --- Math stuffs -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Containing some useful mathematical functions. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'maybe) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Constants +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst math/pi pi + "The number pi.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; TODO: Support all three arguments. +;; Int -> Int -> Int -> Boolean +(cl-defun math/triangle-of-power (&key base power result) + ;; TODO: Assert two of three are set. + (cond + ((maybe/somes? base power result) + (error "All three arguments should not be set")) + ((maybe/somes? power result) + (message "power and result")) + ((maybe/somes? base result) + (log result base)) + ((maybe/somes? base power) + (expt base power)) + (t + (error "Two of the three arguments must be set")))) + +(defun math/mod (x y) + "Return X mod Y." + (mod x y)) + +(defun math/exp (x y) + "Return X raised to the Y." + (expt x y)) + +(defun math/round (x) + "Round X to nearest ones digit." + (round x)) + +(defun math/floor (x) + "Floor value X." + (floor x)) + +(provide 'math) +;;; math.el ends here diff --git a/emacs/.emacs.d/wpc/maybe.el b/emacs/.emacs.d/wpc/maybe.el new file mode 100644 index 0000000000..0973b1ed65 --- /dev/null +++ b/emacs/.emacs.d/wpc/maybe.el @@ -0,0 +1,102 @@ +;;; maybe.el --- Library for dealing with nil values -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Inspired by Elm's Maybe library. +;; +;; For now, a Nothing value will be defined exclusively as a nil value. I'm +;; uninterested in supported falsiness in this module even at risk of going +;; against the LISP grain. +;; +;; I'm avoiding introducing a struct to handle the creation of Just and Nothing +;; variants of Maybe. Perhaps this is a mistake in which case this file would +;; be more aptly named nil.el. I may change that. Because of this limitation, +;; functions in Elm's Maybe library like andThen, which is the monadic bind for +;; the Maybe type, doesn't have a home here since we cannot compose multiple +;; Nothing or Just values without a struct or some other construct. +;; +;; Possible names for the variants of a Maybe. +;; None | Some +;; Nothing | Something +;; None | Just +;; Nil | Set +;; +;; NOTE: In Elisp, values like '() (i.e. the empty list) are aliases for nil. +;; What else in Elisp is an alias in this way? +;; Examples: +;; TODO: Provide examples of other nil types in Elisp. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'prelude) +(require 'list) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Constants +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar maybe/test? t + "When t, run the test suite defined herein.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun maybe/nil? (x) + "Return t if X is nil." + (eq nil x)) + +(defun maybe/some? (x) + "Return t when X is non-nil." + (not (maybe/nil? x))) + +(defun maybe/nils? (&rest xs) + "Return t if all XS are nil." + (list/all? #'maybe/nil? xs)) + +(defun maybe/somes? (&rest xs) + "Return t if all XS are non-nil." + (list/all? #'maybe/some? xs)) + +(defun maybe/default (default x) + "Return DEFAULT when X is nil." + (if (maybe/nil? x) default x)) + +(defun maybe/map (f x) + "Apply F to X if X is not nil." + (if (maybe/some? x) + (funcall f x) + x)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(when maybe/test? + ;; nil? + (prelude/assert (maybe/nil? nil)) + (prelude/refute (maybe/nil? t)) + ;; some? + (prelude/assert (maybe/some? 10)) + (prelude/refute (maybe/some? nil)) + ;; nils? + (prelude/assert (maybe/nils? nil nil nil nil)) + (prelude/refute (maybe/nils? nil t nil t)) + ;; somes? + (prelude/assert (maybe/somes? t 10 '(1 2 3) "some")) + (prelude/refute (maybe/somes? t nil '(1 2 3) "some")) + ;; default + (prelude/assert + (and (= 0 (maybe/default 5 0)) + (= 5 (maybe/default 5 nil)))) + ;; map + (prelude/assert + (and (= 2 (maybe/map #'1+ 1)) + (eq nil (maybe/map #'1+ nil))))) + +(provide 'maybe) +;;; maybe.el ends here diff --git a/emacs/.emacs.d/wpc/me-seconds.el b/emacs/.emacs.d/wpc/me-seconds.el new file mode 100644 index 0000000000..f03e5d07d7 --- /dev/null +++ b/emacs/.emacs.d/wpc/me-seconds.el @@ -0,0 +1,245 @@ +;;; me-seconds.el --- How valuable is my time? -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Inspired by Google's concept of SWE-seconds, I decided to try and compute how +;; value my personal time is. +;; +;; This library should integrate with another library that handles currency +;; conversions using locally cached data for historial values and network +;; requests for current values. +;; +;; Context sensitivity: +;; Many of the values herein are based on my values that are a function of the +;; year, my current salary, my current company holiday policy, and my current +;; country holiday policy. As such, many of these constants need to be updated +;; whenever changes occur in order for these functions to be useful. +;; +;; Units of time: +;; - seconds +;; - minutes +;; - hours +;; - days +;; - weeks +;; - months +;; - years +;; +;; Wish list: +;; - I should create a money.el struct to work with herein. This module would +;; expose basic algebra for working with money structs, which would be handy. +;; - I should create a time.el struct for working with hours in the day. I'd +;; like to be able to do (+ 9:15 17:45) cleanly. +;; +;; Terminology: +;; SWE hours give an order of magnitude approximation to the cost of resources +;; in dollars per hour at 2115 hours per year. +;; - SWE hour (SWEh) +;; - SWE year (SWEy) +;; - SWE nominal +;; - SWE opportunity +;; +;; Other isomorphisms include: +;; - Borg GCU +;; - Borg RAM +;; - Tape (library) +;; - Tape (vault) +;; - Spindles (low latency) +;; - Spindles (throughput) +;; - Spindles (throughput) +;; - Tape (throughput) +;; - SWE (nominal) +;; - SWE (opportunity) + + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'macros) +(require 'string) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Constants +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun me-seconds/salary (amt) + "Return the yearly rate of AMT of money in GBP. +f :: Integer -> Rate" + (make-rate :money (make-money :whole amt :fractional 0 :currency 'GBP) + :unit 'year)) + +(defconst me-seconds/salary (me-seconds/salary 80000) + "My salary in GBP.") + +;; TODO: Consider changing these into units of time. +(defconst me-seconds/months-per-year 12 + "Number of months in a year.") + +(defconst me-seconds/days-per-year 365 + "Number of days in a year.") + +(defconst me-seconds/hours-per-year (* 24 me-seconds/days-per-year) + "Number of hours in a year.") + +(defconst me-seconds/minutes-per-year (* 60 me-seconds/hours-per-year) + "Number of minutes in a year.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Vacation +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst me-seconds/bank-holidays-per-year 8 + "Number of bank holidays in the UK each year.") + +(defconst me-seconds/pto-days-vacation-per-year 25 + "Number of days of paid-time-off I receive each year in the UK.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Sleeping +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst me-seconds/sleeping-hours-per-day 8 + "An approximation of the number of hours I sleep each night on average.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Waking +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst me-seconds/waking-hours-per-day + (- 24 me-seconds/sleeping-hours-per-night) + "An approximation of the number of hours I sleep each night on average.") + +;; TODO: Adjust this for vacation time. +(defconst me-seconds/waking-hours-per-year + (* me-seconds/waking-hours-per-day me-seconds/days-per-year) + "The number of hours that I work each year.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Working +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst me-seconds/working-hours-per-day + (- 17 9) + "An approximation of the number of hours I work each weekday on average. +Note that this differs from the assumed SWE hours per day calculation, which + assumes 9 working hours. See the discussion about this of go/rules-of-thumb.") + +(defconst me-seconds/working-hours-per-year 2115 + "This number is borrowed from go/rules-of-thumb.") + +;; Keep in mind that the following classifications of time: +;; - 9:00-17:00 M-F. Is this more expensive than time sleeping? +;; - Weekend +;; - Weekday +;; - Working hours +;; - Waking hours +;; - Sleeping hours +;; - Vacation hours +;; +;; TODO: Consider tax implications (i.e. after-tax amounts and pre-tax amounts). +;; +;; Should these all be treated the same since they all pull from the same pot of +;; time? Or perhaps there are multiples involved? Much to think about. How does +;; Google handle this? + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Supported currencies: +;; - GBP +;; NOTE: Amount is an integer. +(cl-defstruct money whole fractional currency) +(cl-defstruct rate money unit) + +;; TODO: Add to money.el. +(defun money/to-string (x) + "Return the string representation of X. +f :: Money -> String" + (let ((currency (money-currency x)) + (whole (int-to-string (money-whole x))) + (fract (int-to-string (money-fractional x)))) + (pcase currency + ('GBP (string/concat "£" whole "." fract)) + ('USD (string/concat "$" whole "." fract)) + (_ (error (string/concat + "Currency: \"" + (symbol-name currency) + "\" not supported")))))) + +(macros/comment + (money/to-string + (make-money :whole 100 :fractional 99 :currency 'GBP))) + +;; TODO: Add to rate.el. +(defun rate/to-string (x) + "Message X as a rate. +f :: Rate -> String" + (string/concat + (money/to-string (rate-money x)) + " / " + (pcase (rate-unit x) + ('second "sec") + ('minute "min") + ('hour "hr") + ('day "day") + ('week "week") + ('month "month") + ('year "year")))) + +(macros/comment + (rate/to-string + (make-rate + :money (make-money :whole 10 :fractional 10 :currency 'GBP) + :unit 'day))) + +;; TODO: Move this to math.el? +(defun ensure-float (x) + "Ensures X is treated as a float." + (+ 0.0 x)) + +;; TODO: Move these to basic time mapping module. +;; TODO: Consider making this an isomorphism. +(defun minutes/to-hours (x) + "Convert X minutes to n hours." + (/ x 60.0)) + +(defun hours/to-minutes (x) + "Convert X hours to n minutes." + (* x 60)) + +(defun days/to-minutes (x) + "Convert X days to n minutes." + (* x 24 60)) + +(defun weeks/to-minutes (x) + "Convert X weeks to n minutes." + (* x 7 24 60)) + +(defun months/to-minutes (x) + "Convert X months to n minutes. +This approximates the number of days in a month to 30." + (* x 30 24 60)) + +;; TODO: Support algebraic functions with money structs. +;; TODO: Support isomorphisms for rates to other units of time. That would +;; subsume most of this module's use. +(defun me-seconds/value-per-minute (salary) + "Computes my value per minute based on my current SALARY. +Signature: f :: Rate -> Rate +This is assuming that all of my time is equally valuable. See the above + discussion about the various classifications of my time.") + +;; TODO: See note above about isomorphisms between various rates. +(defun me-seconds/value (salary x) + "Compute the value of X minutes of my time at my current SALARY. +f :: Rate -> Integer -> Money") + +(macros/comment + (rate/to-string me-seconds/salary) + ) + +(provide 'me-seconds) +;;; me-seconds.el ends here diff --git a/emacs/.emacs.d/wpc/monoid.el b/emacs/.emacs.d/wpc/monoid.el new file mode 100644 index 0000000000..401d63c417 --- /dev/null +++ b/emacs/.emacs.d/wpc/monoid.el @@ -0,0 +1,30 @@ +;;; monoid.el --- Working with Monoids in Elisp -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; The day has finally arrived where I'm using Monoids in Elisp. +;; +;; The monoid typeclass is as follows: +;; - empty :: a +;; - concat :: (list a) -> a + +;;; Code: + +;; TODO: Consider a prelude version that works for all Elisp types. +(defun monoid/classify (xs) + "Return the type of `XS'." + (cond + ((listp xs) 'list) + ((vectorp xs) 'vector) + ((stringp xs) 'string))) + + +(defun monoid/empty (xs) + "Return the empty monoid for the type `XS'." + (pcase (monoid/classify xs) + ('list '()) + ('vector []) + ('string ""))) + +(provide 'monoid) +;;; monoid.el ends here diff --git a/emacs/.emacs.d/wpc/number.el b/emacs/.emacs.d/wpc/number.el new file mode 100644 index 0000000000..f496349050 --- /dev/null +++ b/emacs/.emacs.d/wpc/number.el @@ -0,0 +1,153 @@ +;;; number.el --- Functions for working with numbers -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; +;; Classifications of numbers: +;; - Natural: (a.k.a positive integers, counting numbers); {1, 2, 3, ... } +;; +;; - Whole: Natural Numbers, plus zero; {0, 1, 2, 3, ...} +;; +;; - Integers: Whole numbers plus all the negatives of the natural numbers; +;; {... , -2, -1, 0, 1, 2, ...} +;; +;; - Rational numbers: (a.k.a. fractions) where the top and bottom numbers are +;; integers; e.g., 1/2, 3/4, 7/2, ⁻4/3, 4/1. Note: The denominator cannot be +;; 0, but the numerator can be. +;; +;; - Real numbers: All numbers that can be written as a decimal. This includes +;; fractions written in decimal form e.g., 0.5, 0.75 2.35, ⁻0.073, 0.3333, or +;; 2.142857. It also includes all the irrational numbers such as π, √2 etc. +;; Every real number corresponds to a point on the number line. +;; +;; The functions defined herein attempt to capture the mathematical definitions +;; of numbers and their classifications as defined above. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'prelude) +(require 'dash) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst number/test? t + "When t, run the test suite defined herein.") + +;; TODO: What about int.el? + +;; TODO: How do we handle a number typeclass? + +(defun number/positive? (x) + "Return t if `X' is a positive number." + (> x 0)) + +(defun number/negative? (x) + "Return t if `X' is a positive number." + (< x 0)) + +;; TODO: Don't rely on this. Need to have 10.0 and 10 behave similarly. +(defun number/float? (x) + "Return t if `X' is a floating point number." + (floatp x)) + +(defun number/natural? (x) + "Return t if `X' is a natural number." + (and (number/positive? x) + (not (number/float? x)))) + +(defun number/whole? (x) + "Return t if `X' is a whole number." + (or (= 0 x) + (number/natural? x))) + +(defun number/integer? (x) + "Return t if `X' is an integer." + (or (number/whole? x) + (number/natural? (- x)))) + +;; TODO: How defensive should these guards be? Should we assert that the inputs +;; are integers before checking evenness or oddness? + +;; TODO: Look up Runar (from Unison) definition of handling zero as even or odd. + +;; TODO: How should rational numbers be handled? Lisp is supposedly famous for +;; its handling of rational numbers. +;; TODO: `calc-mode' supports rational numbers as "1:2" meaning "1/2" +;; (defun number/rational? (x)) + +;; TODO: Can or should I support real numbers? +;; (defun number/real? (x)) + +(defun number/even? (x) + "Return t if `X' is an even number." + (or (= 0 x) + (= 0 (mod x 2)))) + +(defun number/odd? (x) + "Return t if `X' is an odd number." + (not (number/even? x))) + +(defun number/dec (x) + "Subtract one from `X'. +While this function is undeniably trivial, I have unintentionally done (- 1 x) + when in fact I meant to do (- x 1) that I figure it's better for this function + to exist, and for me to train myself to reach for it and its inc counterpart." + (- x 1)) + +(defun number/inc (x) + "Add one to `X'." + (+ x 1)) + +;; TODO: Does this belong in a math module? Is math too vague? Or is number +;; too vague? +;; TODO: Resolve the circular dependency that this introduces with series.el, +;; and then re-enable this function and its tests below. +;; (defun number/factorial (x) +;; "Return factorial of `X'." +;; (cond +;; ((number/negative? x) (error "Will not take factorial of negative numbers")) +;; ((= 0 x) 1) +;; ;; NOTE: Using `series/range' introduces a circular dependency because: +;; ;; series -> number -> series. Conceptually, however, this should be +;; ;; perfectly acceptable. +;; (t (->> (series/range 1 x) +;; (list/reduce 1 #'*))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(when number/test? + (prelude/assert + (number/positive? 10)) + (prelude/assert + (number/natural? 10)) + (prelude/assert + (number/whole? 10)) + (prelude/assert + (number/whole? 0)) + (prelude/assert + (number/integer? 10)) + ;; (prelude/assert + ;; (= 120 (number/factorial 5))) + (prelude/assert + (number/even? 6)) + (prelude/refute + (number/odd? 6)) + (prelude/refute + (number/positive? -10)) + (prelude/refute + (number/natural? 10.0)) + (prelude/refute + (number/natural? -10)) + (prelude/refute + (number/natural? -10.0))) + +(provide 'number) +;;; number.el ends here diff --git a/emacs/.emacs.d/wpc/org-helpers.el b/emacs/.emacs.d/wpc/org-helpers.el new file mode 100644 index 0000000000..ef99b18ee0 --- /dev/null +++ b/emacs/.emacs.d/wpc/org-helpers.el @@ -0,0 +1,29 @@ +;;; org-helpers.el --- Utility functions for working with my Org setup -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Some small utility functions intended to make me more likely to use Org mode +;; more often. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'f) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst org-helpers/directory "~/Dropbox/org" + "The directory where I store most of my Org files.") + +(defun org-helpers/find-file (name) + "Call `find-file' on NAME in my org directory" + (find-file + (f-join org-helpers/directory name))) + +(provide 'org-helpers) +;;; org-helpers.el ends here diff --git a/emacs/.emacs.d/wpc/playback.el b/emacs/.emacs.d/wpc/playback.el new file mode 100644 index 0000000000..e7ad4b2481 --- /dev/null +++ b/emacs/.emacs.d/wpc/playback.el @@ -0,0 +1,41 @@ +;;; playback.el --- Control playback with Elisp -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; As you know, my whole universe is turning Elisp, so this should too! + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'prelude) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun playback/prev () + "Move to the previous song." + (interactive) + (prelude/start-process + :name "playback/prev" + :command "playerctl previous")) + +(defun playback/next () + "Move to the next song." + (interactive) + (prelude/start-process + :name "playback/next" + :command "playerctl next")) + +(defun playback/play-pause () + "Play or pause the current song." + (interactive) + (prelude/start-process + :name "playback/play-pause" + :command "playerctl play-pause")) + +(provide 'playback) +;;; playback.el ends here diff --git a/emacs/.emacs.d/wpc/polymorphism.el b/emacs/.emacs.d/wpc/polymorphism.el new file mode 100644 index 0000000000..09045f7fb2 --- /dev/null +++ b/emacs/.emacs.d/wpc/polymorphism.el @@ -0,0 +1,37 @@ +;;; polymorphism.el --- Sketching my ideas for polymorphism in Elisp -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Once again: modelled after Elixir. + +;;; Code: + +;; More sketches of Elisp polymorphism initiative. +;; +;; Two macros: +;; - `defprotocol' +;; - `definstance' +;; +;; Is it just a coincidence that these two macros have the same number of +;;characters or is that fate? I say fate. +;; +;; (defprotocol monoid +;; :functions (empty concat)) +;; +;; (definstance monoid vector +;; :empty +;; (lambda () []) +;; :concat +;; #'vector/concat) +;; +;; More sketching... +;; (defun monoid/empty () +;; "Sketch." +;; (funcall #'(,(monoid/classify)/empty))) +;; (defun monoid/concat (xs) +;; "Sketch." +;; (apply #'(,(monoid/classify)/concat) args)) + + +(provide 'polymorphism) +;;; polymorphism.el ends here diff --git a/emacs/.emacs.d/wpc/prelude.el b/emacs/.emacs.d/wpc/prelude.el new file mode 100644 index 0000000000..6ef9e3ba7a --- /dev/null +++ b/emacs/.emacs.d/wpc/prelude.el @@ -0,0 +1,149 @@ +;;; prelude.el --- My attempt at augmenting Elisp stdlib -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Some of these ideas are scattered across other modules like `fs', +;; `string-functions', etc. I'd like to keep everything modular. I still don't +;; have an answer for which items belond in `misc'; I don't want that to become +;; a dumping grounds. Ideally this file will `require' all other modules and +;; define just a handful of functions. + +;; TODO: Consider removing all dependencies from prelude.el. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Third-party libraries +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 's) +(require 'dash) +(require 'f) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Libraries +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; TODO: Maybe don't globally import everything here. Disable these and attepmt +;; to reload Emacs to assess damage. +(require 'string) +(require 'list) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Utilities +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun prelude/to-string (x) + "Convert X to a string." + (format "%s" x)) + +(defun prelude/inspect (&rest args) + "Message `ARGS' where ARGS are any type." + (->> args + (list/map #'prelude/to-string) + (apply #'string/concat) + message)) + +(defmacro prelude/call-process-to-string (cmd &rest args) + "Return the string output of CMD called with ARGS." + `(with-temp-buffer + (call-process ,cmd nil (current-buffer) nil ,@args) + (buffer-string))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Assertions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; TODO: Should I `throw' instead of `error' here? +(defmacro prelude/assert (x) + "Errors unless X is t. +These are strict assertions and purposely do not rely on truthiness." + (let ((as-string (prelude/to-string x))) + `(unless (equal t ,x) + (error (string/concat "Assertion failed: " ,as-string))))) + +(defmacro prelude/refute (x) + "Errors unless X is nil." + (let ((as-string (prelude/to-string x))) + `(unless (equal nil ,x) + (error (string/concat "Refutation failed: " ,as-string))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Adapter functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun prelude/identity (x) + "Return X unchanged." + x) + +(defun prelude/const (x) + "Return a variadic lambda that will return X." + (lambda (&rest _) x)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Miscellaneous +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; TODO: Consider packaging these into a linum-color.el package. +;; TODO: Generate the color used here from the theme. +(defvar linum/safe? nil + "Flag indicating whether or not it is safe to work with `linum-mode'.") + +(defvar linum/mru-color nil + "Stores the color most recently attempted to be applied.") + +(add-hook 'linum-mode-hook + (lambda () + (setq linum/safe? t) + (when (maybe/some? linum/mru-color) + (set-face-foreground 'linum linum/mru-color)))) + +(defun prelude/set-line-number-color (color) + "Safely set linum color to `COLOR'. + +If this is called before Emacs initializes, the color will be stored in +`linum/mru-color' and applied once initialization completes. + +Why is this safe? +If `(set-face-foreground 'linum)' is called before initialization completes, +Emacs will silently fail. Without this function, it is easy to introduce +difficult to troubleshoot bugs in your init files." + (if linum/safe? + (set-face-foreground 'linum color) + (setq linum/mru-color color))) + +(defun prelude/prompt (prompt) + "Read input from user with PROMPT." + (read-string prompt)) + +(cl-defun prelude/start-process (&key name command) + "Pass command string, COMMAND, and the function name, NAME. +This is a wrapper around `start-process' that has an API that resembles +`shell-command'." + ;; TODO: Fix the bug with tokenizing here, since it will split any whitespace + ;; character, even though it shouldn't in the case of quoted string in shell. + ;; e.g. - "xmodmap -e 'one two three'" => '("xmodmap" "-e" "'one two three'") + (prelude/refute (string/contains? "'" command)) + (let* ((tokens (string/split " " command)) + (program-name (list/head tokens)) + (program-args (list/tail tokens))) + (apply #'start-process + `(,(string/format "*%s<%s>*" program-name name) + ,nil + ,program-name + ,@program-args)))) + +(defun prelude/executable-exists? (name) + "Return t if CLI tool NAME exists according to `exec-path'." + (let ((file (locate-file name exec-path))) + (require 'maybe) + (if (maybe/some? file) + (f-exists? file) + nil))) + +(defmacro prelude/time (x) + "Print the time it takes to evaluate X." + `(benchmark 1 ',x)) + +(provide 'prelude) +;;; prelude.el ends here diff --git a/emacs/.emacs.d/wpc/prelude.nix b/emacs/.emacs.d/wpc/prelude.nix new file mode 100644 index 0000000000..626d4526a2 --- /dev/null +++ b/emacs/.emacs.d/wpc/prelude.nix @@ -0,0 +1,11 @@ +{ pkgs ? import (builtins.fetchTarball + "https://github.com/tazjin/depot/archive/master.tar.gz") {} }: + +# Ciruclar dependency warning: list.nix depends on prelude.nix, which depends on +# list.nix. +pkgs.writeElispBin { + name = "prelude"; + # If this can build with epkgs.ht, remove `(require 'ht)`. + deps = epkgs: [ epkgs.s epkgs.dash epkgs.f ./string.nix ./list.nix ]; + src = ./prelude.el; +} diff --git a/emacs/.emacs.d/wpc/pulse-audio.el b/emacs/.emacs.d/wpc/pulse-audio.el new file mode 100644 index 0000000000..dba4151a9e --- /dev/null +++ b/emacs/.emacs.d/wpc/pulse-audio.el @@ -0,0 +1,66 @@ +;;; pulse-audio.el --- Control audio with Elisp -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Because everything in my configuration is turning into Elisp these days. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'prelude) +(require 'string) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Constants +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst pulse-audio/step-size 5 + "The size by which to increase or decrease the volume.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun pulse-audio/message (x) + "Output X to *Messages*." + (message (string/format "[pulse-audio.el] %s" x))) + +(defun pulse-audio/toggle-mute () + "Mute the default sink." + (interactive) + (prelude/start-process + :name "pulse-audio/toggle-mute" + :command "pactl set-sink-mute @DEFAULT_SINK@ toggle") + (pulse-audio/message "Mute toggled.")) + +(defun pulse-audio/toggle-microphone () + "Mute the default sink." + (interactive) + (prelude/start-process + :name "pulse-audio/toggle-microphone" + :command "pactl set-source-mute @DEFAULT_SOURCE@ toggle") + (pulse-audio/message "Microphone toggled.")) + +(defun pulse-audio/decrease-volume () + "Low the volume output of the default sink." + (interactive) + (prelude/start-process + :name "pulse-audio/decrease-volume" + :command (string/format "pactl set-sink-volume @DEFAULT_SINK@ -%s%%" + pulse-audio/step-size)) + (pulse-audio/message "Volume decreased.")) + +(defun pulse-audio/increase-volume () + "Raise the volume output of the default sink." + (interactive) + (prelude/start-process + :name "pulse-audio/increase-volume" + :command (string/format "pactl set-sink-volume @DEFAULT_SINK@ +%s%%" + pulse-audio/step-size)) + (pulse-audio/message "Volume increased.")) + +(provide 'pulse-audio) +;;; pulse-audio.el ends here diff --git a/emacs/.emacs.d/wpc/pushover.el b/emacs/.emacs.d/wpc/pushover.el new file mode 100644 index 0000000000..fb06656cf4 --- /dev/null +++ b/emacs/.emacs.d/wpc/pushover.el @@ -0,0 +1,75 @@ +;;; pushover.el --- Send generic messages to mobile device -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Pushover.net is a mobile app that accepts JSON. This supports loose +;; integration between things and mobile devices. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'request) +(require 'password-store) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst pushover/app-token + (password-store-get-field "api-keys/pushover.net" "emacs") + "App token for \"emacs\" application.") + +(defconst pushover/user-key + (password-store-get "api-keys/pushover.net") + "Key that identifies me to pushover.") + +(defconst pushover/url + "https://api.pushover.net/1/messages.json" + "URL to POST messages.") + +;; TODO: Rename module "pushover". + +(defun pushover/notify (message) + "Posts MESSAGE to all devices. +Here are the parameters that Pushover accepts: + +Required parameters: + - token - your application's API token + - user - the user/group key (not e-mail address) of your user (or you), + viewable when logged into our dashboard (often referred to as USER_KEY in + our documentation and code examples) + - message - your message + +Additional parameters (optional): + - attachment - an image attachment to send with the message; see attachments + for more information on how to upload files + device - your user's device name to send the message directly to that + device, rather than all of the user's devices (multiple devices may be + separated by a comma) + - title - your message's title, otherwise your app's name is used + - url - a supplementary URL to show with your message + - url_title - a title for your supplementary URL, otherwise just the URL is + shown + - priority - send as -2 to generate no notification/alert, -1 to always send + as a quiet notification, 1 to display as high-priority and bypass the user's + quiet hours, or 2 to also require confirmation from the user + - sound - the name of one of the sounds supported by device clients to + override the user's default sound choice + - timestamp - a Unix timestamp" + (request + pushover/url + :type "POST" + :params `(("token" . ,pushover/app-token) + ("user" . ,pushover/user-key) + ("message" . ,message)) + :data nil + :parser 'json-read + :success (cl-function + (lambda (&key data &allow-other-keys) + (message "Pushover.net notification sent!"))))) + +(provide 'pushover) +;;; pushover.el ends here diff --git a/emacs/.emacs.d/wpc/random.el b/emacs/.emacs.d/wpc/random.el new file mode 100644 index 0000000000..148506c04d --- /dev/null +++ b/emacs/.emacs.d/wpc/random.el @@ -0,0 +1,73 @@ +;;; random.el --- Functions for working with randomness -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Functions for working with randomness. Some of this code is not as +;; functional as I'd like from. + +;;; Code: + +(require 'prelude) +(require 'number) +(require 'math) +(require 'series) +(require 'list) +(require 'set) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun random/int (x) + "Return a random integer from 0 to `X'." + (random x)) + +;; TODO: Make this work with sequences instead of lists. +(defun random/choice (xs) + "Return a random element of `XS'." + (let ((ct (list/length xs))) + (list/get + (random/int ct) + xs))) + +(defun random/boolean? () + "Randonly return t or nil." + (random/choice (list t nil))) + +;; TODO: This may not work if any of these generate numbers like 0, 1, etc. +(defun random/uuid () + "Return a generated UUID string." + (let ((eight (number/dec (math/triangle-of-power :base 16 :power 8))) + (four (number/dec (math/triangle-of-power :base 16 :power 4))) + (twelve (number/dec (math/triangle-of-power :base 16 :power 12)))) + (format "%x-%x-%x-%x-%x" + (random/int eight) + (random/int four) + (random/int four) + (random/int four) + (random/int twelve)))) + +(defun random/token (length) + "Return a randomly generated hexadecimal string of LENGTH." + (->> (series/range 0 (number/dec length)) + (list/map (lambda (_) (format "%x" (random/int 15)))) + (list/join ""))) + +;; TODO: Support random/sample +(defun random/sample (n xs) + "Return a randomly sample of list XS of size N." + (prelude/assert (and (>= n 0) (< n (list/length xs)))) + (cl-labels ((do-sample + (n xs y ys) + (if (= n (set/count ys)) + (->> ys + set/to-list + (list/map (lambda (i) + (list/get i xs)))) + (if (set/contains? y ys) + (do-sample n xs (random/int (list/length xs)) ys) + (do-sample n xs y (set/add y ys)))))) + (do-sample n xs (random/int (list/length xs)) (set/new)))) + +(provide 'random) +;;; random.el ends here diff --git a/emacs/.emacs.d/wpc/region.el b/emacs/.emacs.d/wpc/region.el new file mode 100644 index 0000000000..a2119b4c96 --- /dev/null +++ b/emacs/.emacs.d/wpc/region.el @@ -0,0 +1,20 @@ +;;; region.el --- Functions for working with Emacs's regions -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Sometimes Emacs's function names and argument ordering is great; other times, +;; it isn't. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun region/to-string () + "Returns the string in the active region." + (buffer-substring-no-properties (region-beginning) + (region-end))) + +(provide 'region) +;;; region.el ends here diff --git a/emacs/.emacs.d/wpc/scheduler.el b/emacs/.emacs.d/wpc/scheduler.el new file mode 100644 index 0000000000..bae9532289 --- /dev/null +++ b/emacs/.emacs.d/wpc/scheduler.el @@ -0,0 +1,22 @@ +;;; scheduler.el --- Sketches of scheduling -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Attempting to create a FSM for scheduling things in various ways: +;; +;; Scheduling policies: +;; - earliest due date: minimizes total lateness of all tasks in a pool. Put +;; the task with the latest due date last in the list and work backwards to +;; solve the precedence constraint (i.e. dependency issue). +;; - shortest processing time: maximizes number of tasks completed. Prioritize +;; tasks in the order of how long they will take to complete from shortest to +;; longest. This breaks down when precedence constraints are introduced. +;; +;; Tasks should inherit prioritization. + + + +;;; Code: + +(provide 'scheduler) +;;; scheduler.el ends here diff --git a/emacs/.emacs.d/wpc/scope.el b/emacs/.emacs.d/wpc/scope.el new file mode 100644 index 0000000000..48aa85ad0e --- /dev/null +++ b/emacs/.emacs.d/wpc/scope.el @@ -0,0 +1,99 @@ +;;; scope.el --- Work with a scope data structure -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Exposing an API for working with a scope data structure in a non-mutative +;; way. +;; +;; What's a scope? Think of a scope as a stack of key-value bindings. + +;;; Code: + +(require 'alist) +(require 'stack) +(require 'struct) +(require 'macros) + +(cl-defstruct scope scopes) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Create +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun scope/new () + "Return an empty scope." + (make-scope :scopes (->> (stack/new) + (stack/push (alist/new))))) + +(defun scope/flatten (xs) + "Return a flattened representation of the scope, XS. +The newest bindings eclipse the oldest." + (->> xs + scope-scopes + stack/to-list + (list/reduce (alist/new) + (lambda (scope acc) + (alist/merge acc scope))))) + +(defun scope/push-new (xs) + "Push a new, empty scope onto XS." + (struct/update scope + scopes + (>> (stack/push (alist/new))) + xs)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Read +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun scope/get (k xs) + "Return K from XS if it's in scope." + (->> xs + scope/flatten + (alist/get k))) + +(defun scope/current (xs) + "Return the newest scope from XS." + (let ((xs-copy (copy-scope xs))) + (->> xs-copy + scope-scopes + stack/peek))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Update +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun scope/set (k v xs) + "Set value, V, at key, K, in XS for the current scope." + (struct/update scope + scopes + (>> (stack/map-top (>> (alist/set k v)))) + xs)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Delete +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun scope/pop (xs) + "Return a new scope without the top element from XS." + (->> xs + scope-scopes + stack/pop)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Predicates +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun scope/defined? (k xs) + "Return t if K is in scope of XS." + (->> xs + scope/flatten + (alist/has-key? k))) + +;; TODO: Find a faster way to write aliases like this. +(defun scope/instance? (xs) + "Return t if XS is a scope struct." + (scope-p xs)) + +(provide 'scope) +;;; scope.el ends here diff --git a/emacs/.emacs.d/wpc/screen-brightness.el b/emacs/.emacs.d/wpc/screen-brightness.el new file mode 100644 index 0000000000..ad51e7578c --- /dev/null +++ b/emacs/.emacs.d/wpc/screen-brightness.el @@ -0,0 +1,45 @@ +;;; screen-brightness.el --- Control laptop screen brightness -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Mainly just Elisp wrappers around `xbacklight`. + +;;; Code: + +;; TODO: Define some isomorphisms. E.g. int->string, string->int. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'prelude) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Constants +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst screen-brightness/step-size 15 + "The size of the increment or decrement step for the screen's brightness.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun screen-brightness/increase () + "Increase the screen brightness." + (interactive) + (prelude/start-process + :name "screen-brightness/increase" + :command (string/format "xbacklight -inc %s" screen-brightness/step-size)) + (message "[screen-brightness.el] Increased screen brightness.")) + +(defun screen-brightness/decrease () + "Decrease the screen brightness." + (interactive) + (prelude/start-process + :name "screen-brightness/decrease" + :command (string/format "xbacklight -dec %s" screen-brightness/step-size)) + (message "[screen-brightness.el] Decreased screen brightness.")) + +(provide 'screen-brightness) +;;; screen-brightness.el ends here diff --git a/emacs/.emacs.d/wpc/scrot.el b/emacs/.emacs.d/wpc/scrot.el new file mode 100644 index 0000000000..eeb12b3731 --- /dev/null +++ b/emacs/.emacs.d/wpc/scrot.el @@ -0,0 +1,64 @@ +;; Author: William Carroll + +;;; Commentary: +;; scrot is a Linux utility for taking screenshots. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'f) +(require 'string) +(require 'ts) +(require 'clipboard) +(require 'kbd) + +(prelude/assert + (prelude/executable-exists? "scrot")) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst scrot/screenshot-directory "~/Downloads" + "The default directory for screenshot outputs.") + +(defconst scrot/path-to-executable "/usr/bin/scrot" + "Path to the scrot executable.") + +(defconst scrot/output-format "screenshot_%H:%M:%S_%Y-%m-%d.png" + "The format string for the output screenshot file. +See scrot's man page for more information.") + +(defun scrot/copy-image (path) + "Use xclip to copy the image at PATH to the clipboard. +This currently only works for PNG files because that's what I'm outputting" + (call-process "xclip" nil nil nil + "-selection" "clipboard" "-t" "image/png" path) + (message (string/format "[scrot.el] Image copied to clipboard!"))) + +(defmacro scrot/call (&rest args) + "Call scrot with ARGS." + `(call-process ,scrot/path-to-executable nil nil nil ,@args)) + +(defun scrot/fullscreen () + "Screenshot the entire screen." + (interactive) + (let ((screenshot-path (f-join scrot/screenshot-directory + (ts-format scrot/output-format (ts-now))))) + (scrot/call screenshot-path) + (scrot/copy-image screenshot-path))) + +(defun scrot/select () + "Click-and-drag to screenshot a region. +The output path is copied to the user's clipboard." + (interactive) + (let ((screenshot-path (f-join scrot/screenshot-directory + (ts-format scrot/output-format (ts-now))))) + (scrot/call "--select" screenshot-path) + (scrot/copy-image screenshot-path))) + +(provide 'scrot) +;;; scrot.el ends here diff --git a/emacs/.emacs.d/wpc/sequence.el b/emacs/.emacs.d/wpc/sequence.el new file mode 100644 index 0000000000..a5428ef044 --- /dev/null +++ b/emacs/.emacs.d/wpc/sequence.el @@ -0,0 +1,105 @@ +;;; sequence.el --- Working with the "sequence" types -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Elisp supports a typeclass none as "sequence" which covers the following +;; types: +;; - list: '(1 2 3 4 5) +;; - vector: ["John" 27 :blue] +;; - string: "To be or not to be..." + +;; TODO: Document the difference between a "reduce" and a "fold". I.e. - reduce +;; has an initial value whereas fold uses the first element in the sequence as +;; the initial value. +;; +;; Note: This should be an approximation of Elixir's Enum protocol albeit +;; without streams. +;; +;; Elisp has done a lot of this work already and these are mostly wrapper +;; functions. +;; See the following list for reference: +;; - sequencep +;; - elt +;; - copy-sequence +;; - reverse +;; - nreverse +;; - sort +;; - seq-elt +;; - seq-length +;; - seqp +;; - seq-drop +;; - seq-take +;; - seq-take-while +;; - seq-drop-while +;; - seq-do +;; - seq-map +;; - seq-mapn +;; - seq-filter +;; - seq-remove +;; - seq-reduce +;; - seq-some +;; - seq-find +;; - seq-every-p +;; - seq-empty-p +;; - seq-count +;; - seq-sort +;; - seq-contains +;; - seq-position +;; - seq-uniq +;; - seq-subseq +;; - seq-concatenate +;; - seq-mapcat +;; - seq-partition +;; - seq-intersection +;; - seq-difference +;; - seq-group-by +;; - seq-into +;; - seq-min +;; - seq-max +;; - seq-doseq +;; - seq-let + +;;; Code: + +;; Perhaps we can provide default implementations for `filter' and `map' derived +;; from the `reduce' implementation. +;; (defprotocol sequence +;; :functions (reduce)) +;; (definstance sequence list +;; :reduce #'list/reduce +;; :filter #'list/filter +;; :map #'list/map) +;; (definstance sequence vector +;; :reduce #'vector/reduce) +;; (definstance sequence string +;; :reduce #'string) + +(defun sequence/classify (xs) + "Return the type of `XS'." + (cond + ((listp xs) 'list) + ((vectorp xs) 'vector) + ((stringp xs) 'string))) + +(defun sequence/reduce (acc f xs) + "Reduce of `XS' calling `F' on x and `ACC'." + (seq-reduce + (lambda (acc x) + (funcall f x acc)) + xs + acc)) + +;; Elixir also turned everything into a list for efficiecy reasons. + +(defun sequence/filter (p xs) + "Filter `XS' with predicate, `P'. +Returns a list regardless of the type of `XS'." + (seq-filter p xs)) + +(defun sequence/map (f xs) + "Maps `XS' calling `F' on each element. +Returns a list regardless of the type of `XS'." + (seq-map f xs)) + +(provide 'sequence) +;;; sequence.el ends here diff --git a/emacs/.emacs.d/wpc/series.el b/emacs/.emacs.d/wpc/series.el new file mode 100644 index 0000000000..55e97f2789 --- /dev/null +++ b/emacs/.emacs.d/wpc/series.el @@ -0,0 +1,89 @@ +;;; series.el --- Hosting common series of numbers -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Encoding number series as I learn about them. +;; +;; These are the following series I'm interested in supporting: +;; - Fibonacci +;; - Catalan numbers +;; - Figurate number series +;; - Triangular +;; - Square +;; - Pentagonal +;; - Hexagonal +;; - Lazy-caterer +;; - Magic square +;; - Look-and-say + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'number) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun series/range (beg end) + "Create a list of numbers from `BEG' to `END'. +This is an inclusive number range." + (if (< end beg) + (list/reverse + (number-sequence end beg)) + (number-sequence beg end))) + +(defun series/fibonacci-number (i) + "Return the number in the fibonacci series at `I'." + (cond + ((= 0 i) 0) + ((= 1 i) 1) + (t (+ (series/fibonacci-number (- i 1)) + (series/fibonacci-number (- i 2)))))) + +(defun series/fibonacci (n) + "Return the first `N' numbers of the fibonaccci series starting at zero." + (if (= 0 n) + '() + (list/reverse + (list/cons (series/fibonacci-number (number/dec n)) + (list/reverse + (series/fibonacci (number/dec n))))))) + +;; TODO: Consider memoization. +(defun series/triangular-number (i) + "Return the number in the triangular series at `I'." + (if (= 0 i) + 0 + (+ i (series/triangular-number (number/dec i))))) + +;; TODO: Improve performance. +;; TODO: Consider creating a stream protocol with `stream/next' and implement +;; this using that. +(defun series/triangular (n) + "Return the first `N' numbers of a triangular series starting at 0." + (if (= 0 n) + '() + (list/reverse + (list/cons (series/triangular-number (number/dec n)) + (list/reverse + (series/triangular (number/dec n))))))) + +(defun series/catalan-number (i) + "Return the catalan number in the series at `I'." + (if (= 0 i) + 1 + (/ (number/factorial (* 2 i)) + (* (number/factorial (number/inc i)) + (number/factorial i))))) + +(defun series/catalan (n) + "Return the first `N' numbers in a catalan series." + (->> (series/range 0 (number/dec n)) + (list/map #'series/catalan-number))) + +(provide 'series) +;;; series.el ends here diff --git a/emacs/.emacs.d/wpc/set.el b/emacs/.emacs.d/wpc/set.el new file mode 100644 index 0000000000..ff2db75d94 --- /dev/null +++ b/emacs/.emacs.d/wpc/set.el @@ -0,0 +1,171 @@ +;;; set.el --- Working with mathematical sets -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; The set data structure is a collection that deduplicates its elements. + +;;; Code: + +(require 'ht) ;; friendlier API for hash-tables +(require 'dotted) +(require 'struct) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Wish List +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; - TODO: Support enum protocol for set. +;; - TODO: Prefer a different hash-table library that doesn't rely on mutative +;; code. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(cl-defstruct set xs) + +(defconst set/enable-testing? t + "Run tests when t.") + +(defun set/from-list (xs) + "Create a new set from the list XS." + (make-set :xs (->> xs + (list/map #'dotted/new) + ht-from-alist))) + +(defun set/new (&rest args) + "Create a new set from ARGS." + (set/from-list args)) + +(defun set/to-list (xs) + "Map set XS into a list." + (->> xs + set-xs + ht-keys)) + +(defun set/add (x xs) + "Add X to set XS." + (struct/update set + xs + (lambda (table) + (let ((table-copy (ht-copy table))) + (ht-set table-copy x nil) + table-copy)) + xs)) + +;; TODO: Ensure all `*/reduce' functions share the same API. +(defun set/reduce (acc f xs) + "Return a new set by calling F on each element of XS and ACC." + (->> xs + set/to-list + (list/reduce acc f))) + +(defun set/intersection (a b) + "Return the set intersection between sets A and B." + (set/reduce (set/new) + (lambda (x acc) + (if (set/contains? x b) + (set/add x acc) + acc)) + a)) + +(defun set/count (xs) + "Return the number of elements in XS." + (->> xs + set-xs + ht-size)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Predicates +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun set/empty? (xs) + "Return t if XS has no elements in it." + (= 0 (set/count xs))) + +(defun set/contains? (x xs) + "Return t if set XS has X." + (ht-contains? (set-xs xs) x)) + +;; TODO: Prefer using `ht.el' functions for this. +(defun set/equal? (a b) + "Return t if A and B share the name members." + (ht-equal? (set-xs a) + (set-xs b))) + +(defun set/distinct? (a b) + "Return t if sets A and B have no shared members." + (set/empty? (set/intersection a b))) + +(defun set/superset? (a b) + "Return t if set A contains all of the members of set B." + (->> b + set/to-list + (list/all? (lambda (x) (set/contains? x a))))) + +(defun set/subset? (a b) + "Return t if each member of set A is present in set B." + (set/superset? b a)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(when set/enable-testing? + ;; set/distinct? + (prelude/assert + (set/distinct? (set/new 'one 'two 'three) + (set/new 'a 'b 'c))) + (prelude/refute + (set/distinct? (set/new 1 2 3) + (set/new 3 4 5))) + (prelude/refute + (set/distinct? (set/new 1 2 3) + (set/new 1 2 3))) + ;; set/equal? + (prelude/refute + (set/equal? (set/new 'a 'b 'c) + (set/new 'x 'y 'z))) + (prelude/refute + (set/equal? (set/new 'a 'b 'c) + (set/new 'a 'b))) + (prelude/assert + (set/equal? (set/new 'a 'b 'c) + (set/new 'a 'b 'c))) + ;; set/intersection + (prelude/assert + (set/equal? (set/new 2 3) + (set/intersection (set/new 1 2 3) + (set/new 2 3 4)))) + ;; set/{from,to}-list + (prelude/assert (equal '(1 2 3) + (->> '(1 1 2 2 3 3) + set/from-list + set/to-list))) + (let ((primary-colors (set/new "red" "green" "blue"))) + ;; set/subset? + (prelude/refute + (set/subset? (set/new "black" "grey") + primary-colors)) + (prelude/assert + (set/subset? (set/new "red") + primary-colors)) + ;; set/superset? + (prelude/refute + (set/superset? primary-colors + (set/new "black" "grey"))) + (prelude/assert + (set/superset? primary-colors + (set/new "red" "green" "blue"))) + (prelude/assert + (set/superset? primary-colors + (set/new "red" "blue")))) + ;; set/empty? + (prelude/assert (set/empty? (set/new))) + (prelude/refute (set/empty? (set/new 1 2 3))) + ;; set/count + (prelude/assert (= 0 (set/count (set/new)))) + (prelude/assert (= 2 (set/count (set/new 1 1 2 2))))) + +(provide 'set) +;;; set.el ends here diff --git a/emacs/.emacs.d/wpc/ssh.el b/emacs/.emacs.d/wpc/ssh.el new file mode 100644 index 0000000000..d703937573 --- /dev/null +++ b/emacs/.emacs.d/wpc/ssh.el @@ -0,0 +1,31 @@ +;;; ssh.el --- When working remotely -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Configuration to make remote work easier. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'tramp) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; TODO: Is "ssh" preferable to "scp"? +(setq tramp-default-method "ssh") + +;; Taken from: https://superuser.com/questions/179313/tramp-waiting-for-prompts-from-remote-shell +(setq tramp-shell-prompt-pattern "^[^$>\n]*[#$%>] *\\(\[[0-9;]*[a-zA-Z] *\\)*") + +;; TODO: Re-enable this in case "dumb" isn't the default. +;; (setq tramp-terminal-type "dumb") + +(setq tramp-verbose 10) + +(provide 'ssh) +;;; ssh.el ends here diff --git a/emacs/.emacs.d/wpc/stack.el b/emacs/.emacs.d/wpc/stack.el new file mode 100644 index 0000000000..052ed881d2 --- /dev/null +++ b/emacs/.emacs.d/wpc/stack.el @@ -0,0 +1,93 @@ +;;; stack.el --- Working with stacks in Elisp -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; A stack is a LIFO queue. +;; The design goal here is to expose an intuitive API for working with stacks in +;; non-mutative way. +;; +;; TODO: Consider naming a Functor instance "Mappable." +;; TODO: Consider naming a Foldable instance "Reduceable." +;; +;; TODO: Consider implementing an instance for Mappable. +;; TODO: Consider implementing an instance for Reduceable. + +;;; Code: + +(require 'list) + +(cl-defstruct stack xs) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Create +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun stack/new () + "Create an empty stack." + (make-stack :xs '())) + +(defun stack/from-list (xs) + "Create a new stack from the list, `XS'." + (list/reduce (stack/new) #'stack/push xs)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Read +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun stack/peek (xs) + "Look at the top element of `XS' without popping it off." + (->> xs + stack-xs + list/head)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Update +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun stack/push (x xs) + "Push `X' on `XS'." + (struct/update stack + xs + (>> (list/cons x)) + xs)) + +;; TODO: How to return something like {(list/head xs), (list/tail xs)} in Elixir +;; TODO: How to handle popping from empty stacks? +(defun stack/pop (xs) + "Return the stack, `XS', without the top element. +Since I cannot figure out a nice way of return tuples in Elisp, if you want to +look at the first element, use `stack/peek' before running `stack/pop'." + (struct/update stack + xs + (>> list/tail) + xs)) + +(defun stack/map-top (f xs) + "Apply F to the top element of XS." + (->> xs + stack/pop + (stack/push (funcall f (stack/peek xs))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Miscellaneous +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun stack/to-list (xs) + "Return XS as a list. +The round-trip property of `stack/from-list' and `stack/to-list' should hold." + (->> xs + stack-xs + list/reverse)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Predicates +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; TODO: Create a macro that wraps `cl-defstruct' that automatically creates +;; things like `new', `instance?'. +(defun stack/instance? (xs) + "Return t if XS is a stack." + (stack-p xs)) + +(provide 'stack) +;;; stack.el ends here diff --git a/emacs/.emacs.d/wpc/string.el b/emacs/.emacs.d/wpc/string.el new file mode 100644 index 0000000000..f8694d5f18 --- /dev/null +++ b/emacs/.emacs.d/wpc/string.el @@ -0,0 +1,128 @@ +;; string.el --- Library for working with strings -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Library for working with string. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 's) +(require 'dash) +;; TODO: Resolve the circular dependency that this introduces. +;; (require 'prelude) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst string/test? t + "When t, run the tests.") + +(defun string/contains? (c x) + "Return t if X is in C." + (s-contains? c x)) + +(defun string/hookify (x) + "Append \"-hook\" to X." + (s-append "-hook" x)) + +(defun string/split (y x) + "Map string X into a list of strings that were separated by Y." + (s-split y x)) + +(defun string/ensure-hookified (x) + "Ensure that X has \"-hook\" appended to it." + (if (s-ends-with? "-hook" x) + x + (string/hookify x))) + +(defun string/format (x &rest args) + "Format template string X with ARGS." + (apply #'format (cons x args))) + +(defun string/concat (&rest strings) + "Joins `STRINGS' into onto string." + (apply #'s-concat strings)) + +(defun string/->symbol (string) + "Maps `STRING' to a symbol." + (intern string)) + +(defun string/<-symbol (symbol) + "Maps `SYMBOL' into a string." + (symbol-name symbol)) + +(defun string/prepend (prefix x) + "Prepend `PREFIX' onto `X'." + (s-concat prefix x)) + +(defun string/append (postfix x) + "Appen `POSTFIX' onto `X'." + (s-concat x postfix)) + +(defun string/surround (s x) + "Surrounds `X' one each side with `S'." + (->> x + (string/prepend s) + (string/append s))) + +;; TODO: Define a macro for defining a function and a test. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Casing +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun string/caps->kebab (x) + "Change the casing of `X' from CAP_CASE to kebab-case." + (->> x + s-downcase + (s-replace "_" "-"))) + +(defun string/kebab->caps (x) + "Change the casing of X from CAP_CASE to kebab-case." + (->> x + s-upcase + (s-replace "-" "_"))) + +(defun string/lower->caps (x) + "Change the casing of X from lowercase to CAPS_CASE." + (->> x + s-upcase + (s-replace " " "_"))) + +(defun string/lower->kebab (x) + "Change the casing of `X' from lowercase to kebab-case." + (s-replace " " "-" x)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Predicates +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun string/instance? (x) + "Return t if X is a string." + (stringp x)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; (when string/test? +;; (prelude/assert +;; (string= +;; (string/surround "-*-" "surround") +;; "-*-surround-*-")) +;; (prelude/assert +;; (string= +;; (string/caps->kebab "CAPS_CASE_STRING") +;; "caps-case-string")) +;; (prelude/assert +;; (string= +;; (string/kebab->caps "kebab-case-string") +;; "KEBAB_CASE_STRING"))) + +(provide 'string) +;;; string.el ends here diff --git a/emacs/.emacs.d/wpc/string.nix b/emacs/.emacs.d/wpc/string.nix new file mode 100644 index 0000000000..1f815b26bb --- /dev/null +++ b/emacs/.emacs.d/wpc/string.nix @@ -0,0 +1,8 @@ +{ pkgs ? import (builtins.fetchTarball + "https://github.com/tazjin/depot/archive/master.tar.gz") {} }: + +pkgs.writeElispBin { + name = "string"; + deps = epkgs: [ epkgs.dash epkgs.s ./prelude.nix ]; + src = ./string.el; +} diff --git a/emacs/.emacs.d/wpc/struct.el b/emacs/.emacs.d/wpc/struct.el new file mode 100644 index 0000000000..7d237d3259 --- /dev/null +++ b/emacs/.emacs.d/wpc/struct.el @@ -0,0 +1,88 @@ +;;; struct.el --- Helpers for working with structs -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Provides new macros for working with structs. Also provides adapter +;; interfaces to existing struct macros, that should have more intuitive +;; interfaces. +;; +;; Sometimes `setf' just isn't enough. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Wish list +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; - TODO: Replace `symbol-name' and `intern' calls with isomorphism. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'string) +(require 'dash) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar struct/enable-tests? t + "When t, run the test suite defined herein.") + +(defmacro struct/update (type field f xs) + "Apply F to FIELD in XS, which is a struct of TYPE. +This is immutable." + (let ((copier (->> type + symbol-name + (string/prepend "copy-") + intern)) + (accessor (->> field + symbol-name + (string/prepend (string/concat (symbol-name type) "-")) + intern))) + `(let ((copy (,copier ,xs))) + (setf (,accessor copy) (funcall ,f (,accessor copy))) + copy))) + +(defmacro struct/set (type field x xs) + "Immutably set FIELD in XS (struct TYPE) to X." + (let ((copier (->> type + symbol-name + (string/prepend "copy-") + intern)) + (accessor (->> field + symbol-name + (string/prepend (string/concat (symbol-name type) "-")) + intern))) + `(let ((copy (,copier ,xs))) + (setf (,accessor copy) ,x) + copy))) + +(defmacro struct/set! (type field x xs) + "Set FIELD in XS (struct TYPE) to X mutably. +This is an adapter interface to `setf'." + (let ((accessor (->> field + symbol-name + (string/prepend (string/concat (symbol-name type) "-")) + intern))) + `(progn + (setf (,accessor ,xs) ,x) + ,xs))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(when struct/enable-tests? + (cl-defstruct dummy name age) + (defvar test-dummy (make-dummy :name "Roofus" :age 19)) + (struct/set! dummy name "Doofus" test-dummy) + (prelude/assert (string= "Doofus" (dummy-name test-dummy))) + (let ((result (struct/set dummy name "Shoofus" test-dummy))) + ;; Test the immutability of `struct/set' + (prelude/assert (string= "Doofus" (dummy-name test-dummy))) + (prelude/assert (string= "Shoofus" (dummy-name result))))) + +(provide 'struct) +;;; struct.el ends here diff --git a/emacs/.emacs.d/wpc/symbol.el b/emacs/.emacs.d/wpc/symbol.el new file mode 100644 index 0000000000..9119b29470 --- /dev/null +++ b/emacs/.emacs.d/wpc/symbol.el @@ -0,0 +1,43 @@ +;; symbol.el --- Library for working with symbols. -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Library for working with symbols. + +;;; Code: + +;; TODO: Why is ivy mode map everywhere? + +(require 'string) + +;; Symbols +(defun symbol/as-string (callback x) + "Treat the symbol, X, as a string while applying CALLBACK to it. +Coerce back to a symbol on the way out." + (->> x + #'symbol-name + callback + #'intern)) + +(defun symbol/to-string (x) + "Map `X' into a string." + (string/<-symbol x)) + +(defun symbol/hookify (x) + "Append \"-hook\" to X when X is a symbol." + (symbol/as-string #'string/hookify x)) + +(defun symbol/ensure-hookified (x) + "Ensure that X has \"-hook\" appended to it when X is a symbol." + (symbol/as-string #'string/ensure-hookified x)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Predicates +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun symbol/instance? (x) + "Return t if X is a symbol." + (symbolp x)) + +(provide 'symbol) +;;; symbol.el ends here diff --git a/emacs/.emacs.d/wpc/terminator-themes.json b/emacs/.emacs.d/wpc/terminator-themes.json new file mode 100644 index 0000000000..e021ef1293 --- /dev/null +++ b/emacs/.emacs.d/wpc/terminator-themes.json @@ -0,0 +1,1794 @@ +{ + "themes": [ + { + "name": "3024 Day", + "palette": "#090300:#db2d20:#01a252:#fded02:#01a0e4:#a16a94:#b5e4f4:#a5a2a2:#5c5855:#e8bbd0:#3a3432:#4a4543:#807d7c:#d6d5d4:#cdab53:#f7f7f7", + "background_color": "#f7f7f7", + "cursor_color": "#4a4543", + "foreground_color": "#4a4543", + "background_image": "None", + "type": "light" + }, + { + "name": "3024 Night", + "palette": "#090300:#db2d20:#01a252:#fded02:#01a0e4:#a16a94:#b5e4f4:#a5a2a2:#5c5855:#e8bbd0:#3a3432:#4a4543:#807d7c:#d6d5d4:#cdab53:#f7f7f7", + "background_color": "#090300", + "cursor_color": "#a5a2a2", + "foreground_color": "#a5a2a2", + "background_image": "None", + "type": "dark" + }, + { + "name": "Aci", + "background_color": "#0d1926", + "background_image": "None", + "cursor_color": "#c4e9ff", + "foreground_color": "#b4e1fd", + "palette": "#363636:#ff0883:#83ff08:#ff8308:#0883ff:#8308ff:#08ff83:#b6b6b6:#363636:#ff0883:#83ff08:#ff8308:#0883ff:#8308ff:#08ff83:#b6b6b6", + "type": "dark" + }, + { + "name": "Aco", + "background_color": "#1f1305", + "background_image": "None", + "cursor_color": "#bae2fb", + "foreground_color": "#b4e1fd", + "palette": "#3f3f3f:#ff0883:#83ff08:#ff8308:#0883ff:#8308ff:#08ff83:#bebebe:#474747:#ff1e8e:#8eff1e:#ff8e1e:#0883ff:#8e1eff:#1eff8e:#c4c4c4", + "type": "dark" + }, + { + "name": "AdventureTime", + "palette": "#050404:#bd0013:#4ab118:#e7741e:#0f4ac6:#665993:#70a598:#f8dcc0:#4e7cbf:#fc5f5a:#9eff6e:#efc11a:#1997c6:#9b5953:#c8faf4:#f6f5fb", + "background_color": "#1f1d45", + "cursor_color": "#efbf38", + "foreground_color": "#f8dcc0", + "background_image": "None", + "type": "dark" + }, + { + "name": "After Dark", + "background_color": "#10111b", + "cursor_color": "#aaaaaa", + "palette": "#2e3436:#ef4a9e:#00d2bc:#e7ca7a:#9399fa:#ca5bcc:#86d079:#d3d7cf:#555753:#ef4a9e:#00d2bc:#e7ca7a:#9399fa:#ca5bcc:#86d079:#eeeeec", + "type": "dark" + }, + { + "name": "Afterglow", + "palette": "#151515:#ac4142:#7e8e50:#e5b567:#6c99bb:#9f4e85:#7dd6cf:#d0d0d0:#505050:#ac4142:#7e8e50:#e5b567:#6c99bb:#9f4e85:#7dd6cf:#f5f5f5", + "background_color": "#212121", + "cursor_color": "#d0d0d0", + "foreground_color": "#d0d0d0", + "background_image": "None", + "type": "dark" + }, + { + "name": "AlienBlood", + "palette": "#112616:#7f2b27:#2f7e25:#717f24:#2f6a7f:#47587f:#327f77:#647d75:#3c4812:#e08009:#18e000:#bde000:#00aae0:#0058e0:#00e0c4:#73fa91", + "background_color": "#0f1610", + "cursor_color": "#73fa91", + "foreground_color": "#637d75", + "background_image": "None", + "type": "dark" + }, + { + "name": "Argonaut", + "palette": "#232323:#ff000f:#8ce10b:#ffb900:#008df8:#6d43a6:#00d8eb:#ffffff:#444444:#ff2740:#abe15b:#ffd242:#0092ff:#9a5feb:#67fff0:#ffffff", + "background_color": "#0e1019", + "cursor_color": "#ff0018", + "foreground_color": "#fffaf4", + "background_image": "None", + "type": "dark" + }, + { + "name": "Arthur", + "palette": "#3d352a:#cd5c5c:#86af80:#e8ae5b:#6495ed:#deb887:#b0c4de:#bbaa99:#554444:#cc5533:#88aa22:#ffa75d:#87ceeb:#996600:#b0c4de:#ddccbb", + "background_color": "#1c1c1c", + "cursor_color": "#e2bbef", + "foreground_color": "#ddeedd", + "background_image": "None", + "type": "dark" + }, + { + "name": "AtelierSulphurpool", + "palette": "#202746:#c94922:#ac9739:#c08b30:#3d8fd1:#6679cc:#22a2c9:#979db4:#6b7394:#c76b29:#293256:#5e6687:#898ea4:#dfe2f1:#9c637a:#f5f7ff", + "background_color": "#202746", + "cursor_color": "#979db4", + "foreground_color": "#979db4", + "background_image": "None", + "type": "dark" + }, + { + "name": "Atom", + "palette": "#000000:#fd5ff1:#87c38a:#ffd7b1:#85befd:#b9b6fc:#85befd:#e0e0e0:#000000:#fd5ff1:#94fa36:#f5ffa8:#96cbfe:#b9b6fc:#85befd:#e0e0e0", + "background_color": "#161719", + "cursor_color": "#d0d0d0", + "foreground_color": "#c5c8c6", + "background_image": "None", + "type": "dark" + }, + { + "name": "AtomOneLight", + "palette": "#000000:#de3e35:#3f953a:#d2b67c:#2f5af3:#950095:#3f953a:#bbbbbb:#000000:#de3e35:#3f953a:#d2b67c:#2f5af3:#a00095:#3f953a:#ffffff", + "background_color": "#f9f9f9", + "cursor_color": "#bbbbbb", + "foreground_color": "#2a2c33", + "background_image": "None", + "type": "light" + }, + { + "name": "ayu", + "palette": "#000000:#ff3333:#b8cc52:#e7c547:#36a3d9:#f07178:#95e6cb:#ffffff:#323232:#ff6565:#eafe84:#fff779:#68d5ff:#ffa3aa:#c7fffd:#ffffff", + "background_color": "#0f1419", + "cursor_color": "#f29718", + "foreground_color": "#e6e1cf", + "background_image": "None", + "type": "dark" + }, + { + "name": "Ayu mirage", + "background_color": "#212733", + "background_image": "None", + "cursor_color": "#FFD580", + "foreground_color": "#d9d7ce", + "palette": "#212733:#ff3333:#bae67e:#ffd580:#5ccfe6:#d4bfff:#5ccfe6:#3d4752:#3e4b59:#ff3333:#bae67e:#ffd580:#5ccfe6:#d4bfff:#5ccfe6:#eeeeec", + "type": "dark" + }, + { + "name": "ayu_light", + "palette": "#000000:#ff3333:#86b300:#f29718:#41a6d9:#f07178:#4dbf99:#ffffff:#323232:#ff6565:#b8e532:#ffc94a:#73d8ff:#ffa3aa:#7ff1cb:#ffffff", + "background_color": "#fafafa", + "cursor_color": "#ff6a00", + "foreground_color": "#5c6773", + "background_image": "None", + "type": "light" + }, + { + "name": "Azu", + "background_color": "#09111a", + "background_image": "None", + "cursor_color": "#d2e8fc", + "foreground_color": "#d9e6f2", + "palette": "#000000:#ac6d74:#74ac6d:#aca46d:#6d74ac:#a46dac:#6daca4:#e6e6e6:#262626:#d6b8bc:#bcd6b8:#d6d3b8:#b8bcd6:#d3b8d6:#b8d6d3:#ffffff", + "type": "dark" + }, + { + "name": "Batman", + "palette": "#1b1d1e:#e6dc44:#c8be46:#f4fd22:#737174:#747271:#62605f:#c6c5bf:#505354:#fff78e:#fff27d:#feed6c:#919495:#9a9a9d:#a3a3a6:#dadbd6", + "background_color": "#1b1d1e", + "cursor_color": "#fcef0c", + "foreground_color": "#6f6f6f", + "background_image": "None", + "type": "dark" + }, + { + "name": "Belafonte Day", + "palette": "#20111b:#be100e:#858162:#eaa549:#426a79:#97522c:#989a9c:#968c83:#5e5252:#be100e:#858162:#eaa549:#426a79:#97522c:#989a9c:#d5ccba", + "background_color": "#d5ccba", + "cursor_color": "#45373c", + "foreground_color": "#45373c", + "background_image": "None", + "type": "light" + }, + { + "name": "Belafonte Night", + "palette": "#20111b:#be100e:#858162:#eaa549:#426a79:#97522c:#989a9c:#968c83:#5e5252:#be100e:#858162:#eaa549:#426a79:#97522c:#989a9c:#d5ccba", + "background_color": "#20111b", + "cursor_color": "#968c83", + "foreground_color": "#968c83", + "background_image": "None", + "type": "dark" + }, + { + "name": "Bim", + "background_color": "#012849", + "background_image": "None", + "cursor_color": "#c4d0de", + "foreground_color": "#a9bed8", + "palette": "#2c2423:#f557a0:#a9ee55:#f5a255:#5ea2ec:#a957ec:#5eeea0:#918988:#918988:#f579b2:#bbee78:#f5b378:#81b3ec:#bb79ec:#81eeb2:#f5eeec", + "type": "dark" + }, + { + "name": "BirdsOfParadise", + "palette": "#573d26:#be2d26:#6ba18a:#e99d2a:#5a86ad:#ac80a6:#74a6ad:#e0dbb7:#9b6c4a:#e84627:#95d8ba:#d0d150:#b8d3ed:#d19ecb:#93cfd7:#fff9d5", + "background_color": "#2a1f1d", + "cursor_color": "#573d26", + "foreground_color": "#e0dbb7", + "background_image": "None", + "type": "dark" + }, + { + "name": "Blazer", + "palette": "#000000:#b87a7a:#7ab87a:#b8b87a:#7a7ab8:#b87ab8:#7ab8b8:#d9d9d9:#262626:#dbbdbd:#bddbbd:#dbdbbd:#bdbddb:#dbbddb:#bddbdb:#ffffff", + "background_color": "#0d1926", + "cursor_color": "#d9e6f2", + "foreground_color": "#d9e6f2", + "background_image": "None", + "type": "dark" + }, + { + "name": "Blitz", + "background_color": "#16141e", + "cursor_color": "#00ecc8", + "foreground_color": "#00ecc8", + "palette": "#2e3436:#f70047:#00ff7d:#fcdd42:#26b3d2:#b055f4:#ff8db4:#d3d7cf:#555753:#ff5555:#55ff55:#ffff55:#729fcf:#ff55ff:#34e2e2:#eeeeec", + "type": "dark" + }, + { + "name": "Bloody", + "background_color": "#1e1f29", + "background_image": "None", + "cursor_color": "#f9dc5c", + "foreground_color": "#aaaaaa", + "palette": "#2e3436:#ff512f:#b2ffa9:#fffd82:#3185fc:#dd2476:#66d7d1:#f2efea:#555753:#ff512f:#b2ffa9:#fffd82:#3185fc:#dd2476:#66d7d1:#f2efea", + "type": "dark" + }, + { + "name": "Borland", + "palette": "#4f4f4f:#ff6c60:#a8ff60:#ffffb6:#96cbfe:#ff73fd:#c6c5fe:#eeeeee:#7c7c7c:#ffb6b0:#ceffac:#ffffcc:#b5dcff:#ff9cfe:#dfdffe:#ffffff", + "background_color": "#0000a4", + "cursor_color": "#ffa560", + "foreground_color": "#ffff4e", + "background_image": "None", + "type": "dark" + }, + { + "name": "Bright Lights", + "palette": "#191919:#ff355b:#b7e876:#ffc251:#76d4ff:#ba76e7:#6cbfb5:#c2c8d7:#191919:#ff355b:#b7e876:#ffc251:#76d5ff:#ba76e7:#6cbfb5:#c2c8d7", + "background_color": "#191919", + "cursor_color": "#f34b00", + "foreground_color": "#b3c9d7", + "background_image": "None", + "type": "dark" + }, + { + "name": "Broadcast", + "palette": "#000000:#da4939:#519f50:#ffd24a:#6d9cbe:#d0d0ff:#6e9cbe:#ffffff:#323232:#ff7b6b:#83d182:#ffff7c:#9fcef0:#ffffff:#a0cef0:#ffffff", + "background_color": "#2b2b2b", + "cursor_color": "#ffffff", + "foreground_color": "#e6e1dc", + "background_image": "None", + "type": "dark" + }, + { + "name": "Brogrammer", + "palette": "#1f1f1f:#f81118:#2dc55e:#ecba0f:#2a84d2:#4e5ab7:#1081d6:#d6dbe5:#d6dbe5:#de352e:#1dd361:#f3bd09:#1081d6:#5350b9:#0f7ddb:#ffffff", + "background_color": "#131313", + "cursor_color": "#b9b9b9", + "foreground_color": "#d6dbe5", + "background_image": "None", + "type": "dark" + }, + { + "name": "C64", + "palette": "#090300:#883932:#55a049:#bfce72:#40318d:#8b3f96:#67b6bd:#ffffff:#000000:#883932:#55a049:#bfce72:#40318d:#8b3f96:#67b6bd:#f7f7f7", + "background_color": "#40318d", + "cursor_color": "#7869c4", + "foreground_color": "#7869c4", + "background_image": "None", + "type": "dark" + }, + { + "name": "Cai", + "background_color": "#09111a", + "background_image": "None", + "cursor_color": "#e3eef9", + "foreground_color": "#d9e6f2", + "palette": "#000000:#ca274d:#4dca27:#caa427:#274dca:#a427ca:#27caa4:#808080:#808080:#e98da3:#a3e98d:#e9d48d:#8da3e9:#d48de9:#8de9d4:#ffffff", + "type": "dark" + }, + { + "name": "Candy", + "background_color": "#000000", + "foreground_color": "#AAAAAA", + "cursor_color": "#aaaaaa", + "palette": "#2e3436:#fa2573:#a6e32d:#fc951e:#c48dff:#fa2573:#67d9f0:#f2f2f2:#555753:#fa2573:#8ae234:#fce94f:#729fcf:#fa2573:#34e2e2:#eeeeec", + "type": "dark" + }, + { + "name": "Chalk", + "palette": "#7d8b8f:#b23a52:#789b6a:#b9ac4a:#2a7fac:#bd4f5a:#44a799:#d2d8d9:#888888:#f24840:#80c470:#ffeb62:#4196ff:#fc5275:#53cdbd:#d2d8d9", + "background_color": "#2b2d2e", + "cursor_color": "#708284", + "foreground_color": "#d2d8d9", + "background_image": "None", + "type": "dark" + }, + { + "name": "Chalkboard", + "palette": "#000000:#c37372:#72c373:#c2c372:#7372c3:#c372c2:#72c2c3:#d9d9d9:#323232:#dbaaaa:#aadbaa:#dadbaa:#aaaadb:#dbaada:#aadadb:#ffffff", + "background_color": "#29262f", + "cursor_color": "#d9e6f2", + "foreground_color": "#d9e6f2", + "background_image": "None", + "type": "dark" + }, + { + "name": "Chalkby", + "background_color": "#1f2d2d", + "cursor_color": "#ffffff", + "cursor_color_fg": "False", + "foreground_color": "#ffffff", + "palette": "#2e3436:#ffb0b0:#c8ff9b:#fffca4:#6f9ceb:#9395d3:#bdeaff:#d3d7cf:#555753:#ffb0b0:#c8ff9b:#fffca4:#6f9ceb:#9395d3:#bdeaff:#eeeeec", + "type": "dark" + }, + { + "name": "Chesterish", + "background_color": "#293340", + "background_image": "None", + "cursor_color": "#2c85f7", + "foreground_color": "#cdd2e9", + "palette": "#293340:#e17e85:#61ba86:#ffec8e:#4cb2ff:#be86e3:#2dced0:#cdd2e9:#546386:#e17e85:#61ba86:#ffec8e:#4cb2ff:#be86e3:#2dced0:#cdd2e9", + "type": "dark" + }, + { + "name": "Ciapre", + "palette": "#181818:#810009:#48513b:#cc8b3f:#576d8c:#724d7c:#5c4f4b:#aea47f:#555555:#ac3835:#a6a75d:#dcdf7c:#3097c6:#d33061:#f3dbb2:#f4f4f4", + "background_color": "#191c27", + "cursor_color": "#92805b", + "foreground_color": "#aea47a", + "background_image": "None", + "type": "dark" + }, + { + "name": "CLRS", + "palette": "#000000:#f8282a:#328a5d:#fa701d:#135cd0:#9f00bd:#33c3c1:#b3b3b3:#555753:#fb0416:#2cc631:#fdd727:#1670ff:#e900b0:#3ad5ce:#eeeeec", + "background_color": "#ffffff", + "cursor_color": "#6fd3fc", + "foreground_color": "#262626", + "background_image": "None", + "type": "light" + }, + { + "name": "Cobalt Neon", + "palette": "#142631:#ff2320:#3ba5ff:#e9e75c:#8ff586:#781aa0:#8ff586:#ba46b2:#fff688:#d4312e:#8ff586:#e9f06d:#3c7dd2:#8230a7:#6cbc67:#8ff586", + "background_color": "#142838", + "cursor_color": "#c4206f", + "foreground_color": "#8ff586", + "background_image": "None", + "type": "dark" + }, + { + "name": "Cobalt2", + "palette": "#000000:#ff0000:#38de21:#ffe50a:#1460d2:#ff005d:#00bbbb:#bbbbbb:#555555:#f40e17:#3bd01d:#edc809:#5555ff:#ff55ff:#6ae3fa:#ffffff", + "background_color": "#132738", + "cursor_color": "#f0cc09", + "foreground_color": "#ffffff", + "background_image": "None", + "type": "dark" + }, + { + "name": "CrayonPonyFish", + "palette": "#2b1b1d:#91002b:#579524:#ab311b:#8c87b0:#692f50:#e8a866:#68525a:#3d2b2e:#c5255d:#8dff57:#c8381d:#cfc9ff:#fc6cba:#ffceaf:#b0949d", + "background_color": "#150707", + "cursor_color": "#68525a", + "foreground_color": "#68525a", + "background_image": "None", + "type": "dark" + }, + { + "name": "Dark Pastel", + "palette": "#000000:#ff5555:#55ff55:#ffff55:#5555ff:#ff55ff:#55ffff:#bbbbbb:#555555:#ff5555:#55ff55:#ffff55:#5555ff:#ff55ff:#55ffff:#ffffff", + "background_color": "#000000", + "cursor_color": "#bbbbbb", + "foreground_color": "#ffffff", + "background_image": "None", + "type": "dark" + }, + { + "name": "Darkside", + "palette": "#000000:#e8341c:#68c256:#f2d42c:#1c98e8:#8e69c9:#1c98e8:#bababa:#000000:#e05a4f:#77b869:#efd64b:#387cd3:#957bbe:#3d97e2:#bababa", + "background_color": "#222324", + "cursor_color": "#bbbbbb", + "foreground_color": "#bababa", + "background_image": "None", + "type": "dark" + }, + { + "name": "deep", + "palette": "#000000:#d70005:#1cd915:#d9bd26:#5665ff:#b052da:#50d2da:#e0e0e0:#535353:#fb0007:#22ff18:#fedc2b:#9fa9ff:#e09aff:#8df9ff:#ffffff", + "background_color": "#090909", + "cursor_color": "#d0d0d0", + "foreground_color": "#cdcdcd", + "background_image": "None", + "type": "dark" + }, + { + "name": "Desert", + "palette": "#4d4d4d:#ff2b2b:#98fb98:#f0e68c:#cd853f:#ffdead:#ffa0a0:#f5deb3:#555555:#ff5555:#55ff55:#ffff55:#87ceff:#ff55ff:#ffd700:#ffffff", + "background_color": "#333333", + "cursor_color": "#00ff00", + "foreground_color": "#ffffff", + "background_image": "None", + "type": "dark" + }, + { + "name": "DimmedMonokai", + "palette": "#3a3d43:#be3f48:#879a3b:#c5a635:#4f76a1:#855c8d:#578fa4:#b9bcba:#888987:#fb001f:#0f722f:#c47033:#186de3:#fb0067:#2e706d:#fdffb9", + "background_color": "#1f1f1f", + "cursor_color": "#f83e19", + "foreground_color": "#b9bcba", + "background_image": "None", + "type": "dark" + }, + { + "name": "DotGov", + "palette": "#191919:#bf091d:#3d9751:#f6bb34:#17b2e0:#7830b0:#8bd2ed:#ffffff:#191919:#bf091d:#3d9751:#f6bb34:#17b2e0:#7830b0:#8bd2ed:#ffffff", + "background_color": "#262c35", + "cursor_color": "#d9002f", + "foreground_color": "#ebebeb", + "background_image": "None", + "type": "dark" + }, + { + "name": "Dracula", + "background_color": "#1e1f29", + "background_image": "None", + "cursor_color": "#aaaaaa", + "foreground_color": "#f8f8f2", + "palette": "#44475a:#ff5555:#50fa7b:#f1fa8c:#8be9fd:#bd93f9:#ff79c6:#94a3a5:#000000:#ff5555:#50fa7b:#f1fa8c:#8be9fd:#bd93f9:#ff79c6:#ffffff", + "type": "dark" + }, + { + "name": "Duotone Dark", + "palette": "#1f1d27:#d9393e:#2dcd73:#d9b76e:#ffc284:#de8d40:#2488ff:#b7a1ff:#353147:#d9393e:#2dcd73:#d9b76e:#ffc284:#de8d40:#2488ff:#eae5ff", + "background_color": "#1f1d27", + "cursor_color": "#ff9839", + "foreground_color": "#b7a1ff", + "background_image": "None", + "type": "dark" + }, + { + "name": "Earthsong", + "palette": "#121418:#c94234:#85c54c:#f5ae2e:#1398b9:#d0633d:#509552:#e5c6aa:#675f54:#ff645a:#98e036:#e0d561:#5fdaff:#ff9269:#84f088:#f6f7ec", + "background_color": "#292520", + "cursor_color": "#f6f7ec", + "foreground_color": "#e5c7a9", + "background_image": "None", + "type": "dark" + }, + { + "name": "Elemental", + "palette": "#3c3c30:#98290f:#479a43:#7f7111:#497f7d:#7f4e2f:#387f58:#807974:#555445:#e0502a:#61e070:#d69927:#79d9d9:#cd7c54:#59d599:#fff1e9", + "background_color": "#22211d", + "cursor_color": "#facb80", + "foreground_color": "#807a74", + "background_image": "None", + "type": "dark" + }, + { + "name": "Elementary", + "palette": "#242424:#d71c15:#5aa513:#fdb40c:#063b8c:#e40038:#2595e1:#efefef:#4b4b4b:#fc1c18:#6bc219:#fec80e:#0955ff:#fb0050:#3ea8fc:#8c00ec", + "background_color": "#181818", + "cursor_color": "#bbbbbb", + "foreground_color": "#efefef", + "background_image": "None", + "type": "dark" + }, + { + "name": "Elio", + "background_color": "#041a3b", + "background_image": "None", + "cursor_color": "#fbfbfb", + "foreground_color": "#f2f2f2", + "palette": "#303030:#e1321a:#6ab017:#ffc005:#729FCF:#ec0048:#2aa7e7:#f2f2f2:#5d5d5d:#ff361e:#7bc91f:#ffd00a:#0071ff:#ff1d62:#4bb8fd:#a020f0", + "type": "dark" + }, + { + "name": "ENCOM", + "palette": "#000000:#9f0000:#008b00:#ffd000:#0081ff:#bc00ca:#008b8b:#bbbbbb:#555555:#ff0000:#00ee00:#ffff00:#0000ff:#ff00ff:#00cdcd:#ffffff", + "background_color": "#000000", + "cursor_color": "#bbbbbb", + "foreground_color": "#00a595", + "background_image": "None", + "type": "dark" + }, + { + "name": "Espresso", + "palette": "#353535:#d25252:#a5c261:#ffc66d:#6c99bb:#d197d9:#bed6ff:#eeeeec:#535353:#f00c0c:#c2e075:#e1e48b:#8ab7d9:#efb5f7:#dcf4ff:#ffffff", + "background_color": "#323232", + "cursor_color": "#d6d6d6", + "foreground_color": "#ffffff", + "background_image": "None", + "type": "dark" + }, + { + "name": "Espresso Libre", + "palette": "#000000:#cc0000:#1a921c:#f0e53a:#0066ff:#c5656b:#06989a:#d3d7cf:#555753:#ef2929:#9aff87:#fffb5c:#43a8ed:#ff818a:#34e2e2:#eeeeec", + "background_color": "#2a211c", + "cursor_color": "#ffffff", + "foreground_color": "#b8a898", + "background_image": "None", + "type": "dark" + }, + { + "name": "Fideloper", + "palette": "#292f33:#cb1e2d:#edb8ac:#b7ab9b:#2e78c2:#c0236f:#309186:#eae3ce:#092028:#d4605a:#d4605a:#a86671:#7c85c4:#5c5db2:#819090:#fcf4df", + "background_color": "#292f33", + "cursor_color": "#d4605a", + "foreground_color": "#dbdae0", + "background_image": "None", + "type": "dark" + }, + { + "name": "FirefoxDev", + "palette": "#002831:#e63853:#5eb83c:#a57706:#359ddf:#d75cff:#4b73a2:#dcdcdc:#001e27:#e1003f:#1d9000:#cd9409:#006fc0:#a200da:#005794:#e2e2e2", + "background_color": "#0e1011", + "cursor_color": "#708284", + "foreground_color": "#7c8fa4", + "background_image": "None", + "type": "dark" + }, + { + "name": "Firewatch", + "palette": "#585f6d:#d95360:#5ab977:#dfb563:#4d89c4:#d55119:#44a8b6:#e6e5ff:#585f6d:#d95360:#5ab977:#dfb563:#4c89c5:#d55119:#44a8b6:#e6e5ff", + "background_color": "#1e2027", + "cursor_color": "#f6f7ec", + "foreground_color": "#9ba2b2", + "background_image": "None", + "type": "dark" + }, + { + "name": "FishTank", + "palette": "#03073c:#c6004a:#acf157:#fecd5e:#525fb8:#986f82:#968763:#ecf0fc:#6c5b30:#da4b8a:#dbffa9:#fee6a9:#b2befa:#fda5cd:#a5bd86:#f6ffec", + "background_color": "#232537", + "cursor_color": "#fecd5e", + "foreground_color": "#ecf0fe", + "background_image": "None", + "type": "dark" + }, + { + "name": "Flat", + "palette": "#222d3f:#a82320:#32a548:#e58d11:#3167ac:#781aa0:#2c9370:#b0b6ba:#212c3c:#d4312e:#2d9440:#e5be0c:#3c7dd2:#8230a7:#35b387:#e7eced", + "background_color": "#002240", + "cursor_color": "#e5be0c", + "foreground_color": "#2cc55d", + "background_image": "None", + "type": "dark" + }, + { + "name": "Flatland", + "palette": "#1d1d19:#f18339:#9fd364:#f4ef6d:#5096be:#695abc:#d63865:#ffffff:#1d1d19:#d22a24:#a7d42c:#ff8949:#61b9d0:#695abc:#d63865:#ffffff", + "background_color": "#1d1f21", + "cursor_color": "#708284", + "foreground_color": "#b8dbef", + "background_image": "None", + "type": "dark" + }, + { + "name": "Floraverse", + "palette": "#08002e:#64002c:#5d731a:#cd751c:#1d6da1:#b7077e:#42a38c:#f3e0b8:#331e4d:#d02063:#b4ce59:#fac357:#40a4cf:#f12aae:#62caa8:#fff5db", + "background_color": "#0e0d15", + "cursor_color": "#bbbbbb", + "foreground_color": "#dbd1b9", + "background_image": "None", + "type": "dark" + }, + { + "name": "ForestBlue", + "palette": "#333333:#f8818e:#92d3a2:#1a8e63:#8ed0ce:#5e468c:#31658c:#e2d8cd:#3d3d3d:#fb3d66:#6bb48d:#30c85a:#39a7a2:#7e62b3:#6096bf:#e2d8cd", + "background_color": "#051519", + "cursor_color": "#9e9ecb", + "foreground_color": "#e2d8cd", + "background_image": "None", + "type": "dark" + }, + { + "name": "Freya", + "background_color": "#252e32", + "background_image": "None", + "cursor_color": "#839496", + "foreground_color": "#94a3a5", + "palette": "#073642:#dc322f:#859900:#b58900:#268bd2:#ec0048:#2aa198:#94a3a5:#586e75:#cb4b16:#859900:#b58900:#268bd2:#d33682:#2aa198:#6c71c4", + "type": "dark" + }, + { + "name": "FrontEndDelight", + "palette": "#242526:#f8511b:#565747:#fa771d:#2c70b7:#f02e4f:#3ca1a6:#adadad:#5fac6d:#f74319:#74ec4c:#fdc325:#3393ca:#e75e4f:#4fbce6:#8c735b", + "background_color": "#1b1c1d", + "cursor_color": "#cdcdcd", + "foreground_color": "#adadad", + "background_image": "None", + "type": "dark" + }, + { + "name": "FunForrest", + "palette": "#000000:#d6262b:#919c00:#be8a13:#4699a3:#8d4331:#da8213:#ddc265:#7f6a55:#e55a1c:#bfc65a:#ffcb1b:#7cc9cf:#d26349:#e6a96b:#ffeaa3", + "background_color": "#251200", + "cursor_color": "#e5591c", + "foreground_color": "#dec165", + "background_image": "None", + "type": "dark" + }, + { + "name": "Galaxy", + "palette": "#000000:#f9555f:#21b089:#fef02a:#589df6:#944d95:#1f9ee7:#bbbbbb:#555555:#fa8c8f:#35bb9a:#ffff55:#589df6:#e75699:#3979bc:#ffffff", + "background_color": "#1d2837", + "cursor_color": "#bbbbbb", + "foreground_color": "#ffffff", + "background_image": "None", + "type": "dark" + }, + { + "name": "Github", + "palette": "#3e3e3e:#970b16:#07962a:#f8eec7:#003e8a:#e94691:#89d1ec:#ffffff:#666666:#de0000:#87d5a2:#f1d007:#2e6cba:#ffa29f:#1cfafe:#ffffff", + "background_color": "#f4f4f4", + "cursor_color": "#3f3f3f", + "foreground_color": "#3e3e3e", + "background_image": "None", + "type": "light" + }, + { + "name": "Glacier", + "palette": "#2e343c:#bd0f2f:#35a770:#fb9435:#1f5872:#bd2523:#778397:#ffffff:#404a55:#bd0f2f:#49e998:#fddf6e:#2a8bc1:#ea4727:#a0b6d3:#ffffff", + "background_color": "#0c1115", + "cursor_color": "#6c6c6c", + "foreground_color": "#ffffff", + "background_image": "None", + "type": "dark" + }, + { + "name": "Grape", + "palette": "#2d283f:#ed2261:#1fa91b:#8ddc20:#487df4:#8d35c9:#3bdeed:#9e9ea0:#59516a:#f0729a:#53aa5e:#b2dc87:#a9bcec:#ad81c2:#9de3eb:#a288f7", + "background_color": "#171423", + "cursor_color": "#a288f7", + "foreground_color": "#9f9fa1", + "background_image": "None", + "type": "dark" + }, + { + "name": "Grass", + "palette": "#000000:#bb0000:#00bb00:#e7b000:#0000a3:#950062:#00bbbb:#bbbbbb:#555555:#bb0000:#00bb00:#e7b000:#0000bb:#ff55ff:#55ffff:#ffffff", + "background_color": "#13773d", + "cursor_color": "#8c2800", + "foreground_color": "#fff0a5", + "background_image": "None", + "type": "dark" + }, + { + "name": "Gruvbox Dark", + "palette": "#161819:#f73028:#aab01e:#f7b125:#719586:#c77089:#7db669:#faefbb:#7f7061:#be0f17:#868715:#cc881a:#377375:#a04b73:#578e57:#e6d4a3", + "background_color": "#1e1e1e", + "cursor_color": "#bbbbbb", + "foreground_color": "#e6d4a3", + "background_image": "None", + "type": "dark" + }, + { + "name": "Hardcore", + "palette": "#1b1d1e:#f92672:#a6e22e:#fd971f:#66d9ef:#9e6ffe:#5e7175:#ccccc6:#505354:#ff669d:#beed5f:#e6db74:#66d9ef:#9e6ffe:#a3babf:#f8f8f2", + "background_color": "#121212", + "cursor_color": "#bbbbbb", + "foreground_color": "#a0a0a0", + "background_image": "None", + "type": "dark" + }, + { + "name": "Harper", + "palette": "#010101:#f8b63f:#7fb5e1:#d6da25:#489e48:#b296c6:#f5bfd7:#a8a49d:#726e6a:#f8b63f:#7fb5e1:#d6da25:#489e48:#b296c6:#f5bfd7:#fefbea", + "background_color": "#010101", + "cursor_color": "#a8a49d", + "foreground_color": "#a8a49d", + "background_image": "None", + "type": "dark" + }, + { + "name": "Hemisu dark", + "background_image": "None", + "cursor_color": "#BAFFAA", + "foreground_color": "#FFFFFF", + "palette": "#444444:#FF0054:#B1D630:#9D895E:#67BEE3:#B576BC:#569A9F:#EDEDED:#777777:#D65E75:#BAFFAA:#ECE1C8:#9FD3E5:#DEB3DF:#B6E0E5:#FFFFFF", + "type": "dark" + }, + { + "name": "Hemisu light", + "background_color": "#EFEFEF", + "background_image": "None", + "cursor_color": "#FF0054", + "foreground_color": "#444444", + "palette": "#777777:#FF0055:#739100:#503D15:#538091:#5B345E:#538091:#999999:#999999:#D65E76:#9CC700:#947555:#9DB3CD:#A184A4:#85B2AA:#BABABA", + "type": "light" + }, + { + "name": "Highway", + "palette": "#000000:#d00e18:#138034:#ffcb3e:#006bb3:#6b2775:#384564:#ededed:#5d504a:#f07e18:#b1d130:#fff120:#4fc2fd:#de0071:#5d504a:#ffffff", + "background_color": "#222225", + "cursor_color": "#e0d9b9", + "foreground_color": "#ededed", + "background_image": "None", + "type": "dark" + }, + { + "name": "Hipster Green", + "palette": "#000000:#b6214a:#00a600:#bfbf00:#246eb2:#b200b2:#00a6b2:#bfbfbf:#666666:#e50000:#86a93e:#e5e500:#0000ff:#e500e5:#00e5e5:#e5e5e5", + "background_color": "#100b05", + "cursor_color": "#23ff18", + "foreground_color": "#84c138", + "background_image": "None", + "type": "dark" + }, + { + "name": "Homebrew", + "palette": "#000000:#990000:#00a600:#999900:#0000b2:#b200b2:#00a6b2:#bfbfbf:#666666:#e50000:#00d900:#e5e500:#0000ff:#e500e5:#00e5e5:#e5e5e5", + "background_color": "#000000", + "cursor_color": "#23ff18", + "foreground_color": "#00ff00", + "background_image": "None", + "type": "dark" + }, + { + "name": "Hurtado", + "palette": "#575757:#ff1b00:#a5e055:#fbe74a:#496487:#fd5ff1:#86e9fe:#cbcccb:#262626:#d51d00:#a5df55:#fbe84a:#89beff:#c001c1:#86eafe:#dbdbdb", + "background_color": "#000000", + "cursor_color": "#bbbbbb", + "foreground_color": "#dbdbdb", + "background_image": "None", + "type": "dark" + }, + { + "name": "Hybrid", + "palette": "#2a2e33:#b84d51:#b3bf5a:#e4b55e:#6e90b0:#a17eac:#7fbfb4:#b5b9b6:#1d1f22:#8d2e32:#798431:#e58a50:#4b6b88:#6e5079:#4d7b74:#5a626a", + "background_color": "#161719", + "cursor_color": "#b7bcba", + "foreground_color": "#b7bcba", + "background_image": "None", + "type": "dark" + }, + { + "name": "IC_Green_PPL", + "palette": "#1f1f1f:#fb002a:#339c24:#659b25:#149b45:#53b82c:#2cb868:#e0ffef:#032710:#a7ff3f:#9fff6d:#d2ff6d:#72ffb5:#50ff3e:#22ff71:#daefd0", + "background_color": "#3a3d3f", + "cursor_color": "#42ff58", + "foreground_color": "#d9efd3", + "background_image": "None", + "type": "dark" + }, + { + "name": "IC_Orange_PPL", + "palette": "#000000:#c13900:#a4a900:#caaf00:#bd6d00:#fc5e00:#f79500:#ffc88a:#6a4f2a:#ff8c68:#f6ff40:#ffe36e:#ffbe55:#fc874f:#c69752:#fafaff", + "background_color": "#262626", + "cursor_color": "#fc531d", + "foreground_color": "#ffcb83", + "background_image": "None", + "type": "dark" + }, + { + "name": "idleToes", + "palette": "#323232:#d25252:#7fe173:#ffc66d:#4099ff:#f680ff:#bed6ff:#eeeeec:#535353:#f07070:#9dff91:#ffe48b:#5eb7f7:#ff9dff:#dcf4ff:#ffffff", + "background_color": "#323232", + "cursor_color": "#d6d6d6", + "foreground_color": "#ffffff", + "background_image": "None", + "type": "dark" + }, + { + "name": "IR_Black", + "palette": "#4f4f4f:#fa6c60:#a8ff60:#fffeb7:#96cafe:#fa73fd:#c6c5fe:#efedef:#7b7b7b:#fcb6b0:#cfffab:#ffffcc:#b5dcff:#fb9cfe:#e0e0fe:#ffffff", + "background_color": "#000000", + "cursor_color": "#808080", + "foreground_color": "#f1f1f1", + "background_image": "None", + "type": "dark" + }, + { + "name": "Jackie Brown", + "palette": "#2c1d16:#ef5734:#2baf2b:#bebf00:#246eb2:#d05ec1:#00acee:#bfbfbf:#666666:#e50000:#86a93e:#e5e500:#0000ff:#e500e5:#00e5e5:#e5e5e5", + "background_color": "#2c1d16", + "cursor_color": "#23ff18", + "foreground_color": "#ffcc2f", + "background_image": "None", + "type": "dark" + }, + { + "name": "Japanesque", + "palette": "#343935:#cf3f61:#7bb75b:#e9b32a:#4c9ad4:#a57fc4:#389aad:#fafaf6:#595b59:#d18fa6:#767f2c:#78592f:#135979:#604291:#76bbca:#b2b5ae", + "background_color": "#1e1e1e", + "cursor_color": "#edcf4f", + "foreground_color": "#f7f6ec", + "background_image": "None", + "type": "dark" + }, + { + "name": "Jellybeans", + "palette": "#929292:#e27373:#94b979:#ffba7b:#97bedc:#e1c0fa:#00988e:#dedede:#bdbdbd:#ffa1a1:#bddeab:#ffdca0:#b1d8f6:#fbdaff:#1ab2a8:#ffffff", + "background_color": "#121212", + "cursor_color": "#ffa560", + "foreground_color": "#dedede", + "background_image": "None", + "type": "dark" + }, + { + "name": "JetBrains Darcula", + "palette": "#000000:#fa5355:#126e00:#c2c300:#4581eb:#fa54ff:#33c2c1:#adadad:#555555:#fb7172:#67ff4f:#ffff00:#6d9df1:#fb82ff:#60d3d1:#eeeeee", + "background_color": "#202020", + "cursor_color": "#ffffff", + "foreground_color": "#adadad", + "background_image": "None", + "type": "dark" + }, + { + "name": "Juicy", + "background_color": "#212121", + "cursor_color": "#fcfcfc", + "foreground_color": "#fcfcfc", + "palette": "#2e3436:#ff0945:#1aff81:#fff64a:#2bf1ff:#7b68ee:#98f4ff:#d3d7cf:#555753:#ff0945:#1aff81:#fff64a:#2bf1ff:#7b68ee:#98f4ff:#eeeeec", + "background_image": "None", + "type": "dark" + }, + { + "name": "Kibble", + "palette": "#4d4d4d:#c70031:#29cf13:#d8e30e:#3449d1:#8400ff:#0798ab:#e2d1e3:#5a5a5a:#f01578:#6ce05c:#f3f79e:#97a4f7:#c495f0:#68f2e0:#ffffff", + "background_color": "#0e100a", + "cursor_color": "#9fda9c", + "foreground_color": "#f7f7f7", + "background_image": "None", + "type": "dark" + }, + { + "name": "Later This Evening", + "palette": "#2b2b2b:#d45a60:#afba67:#e5d289:#a0bad6:#c092d6:#91bfb7:#3c3d3d:#454747:#d3232f:#aabb39:#e5be39:#6699d6:#ab53d6:#5fc0ae:#c1c2c2", + "background_color": "#222222", + "cursor_color": "#424242", + "foreground_color": "#959595", + "background_image": "None", + "type": "dark" + }, + { + "name": "Lavandula", + "palette": "#230046:#7d1625:#337e6f:#7f6f49:#4f4a7f:#5a3f7f:#58777f:#736e7d:#372d46:#e05167:#52e0c4:#e0c386:#8e87e0:#a776e0:#9ad4e0:#8c91fa", + "background_color": "#050014", + "cursor_color": "#8c91fa", + "foreground_color": "#736e7d", + "background_image": "None", + "type": "dark" + }, + { + "name": "LiquidCarbon", + "palette": "#000000:#ff3030:#559a70:#ccac00:#0099cc:#cc69c8:#7ac4cc:#bccccc:#000000:#ff3030:#559a70:#ccac00:#0099cc:#cc69c8:#7ac4cc:#bccccc", + "background_color": "#303030", + "cursor_color": "#ffffff", + "foreground_color": "#afc2c2", + "background_image": "None", + "type": "dark" + }, + { + "name": "LiquidCarbonTransparent", + "palette": "#000000:#ff3030:#559a70:#ccac00:#0099cc:#cc69c8:#7ac4cc:#bccccc:#000000:#ff3030:#559a70:#ccac00:#0099cc:#cc69c8:#7ac4cc:#bccccc", + "background_color": "#000000", + "cursor_color": "#ffffff", + "foreground_color": "#afc2c2", + "background_image": "None", + "type": "dark" + }, + { + "name": "LiquidCarbonTransparentInverse", + "palette": "#bccccd:#ff3030:#559a70:#ccac00:#0099cc:#cc69c8:#7ac4cc:#000000:#ffffff:#ff3030:#559a70:#ccac00:#0099cc:#cc69c8:#7ac4cc:#000000", + "background_color": "#000000", + "cursor_color": "#ffffff", + "foreground_color": "#afc2c2", + "background_image": "None", + "type": "dark" + }, + { + "name": "Lucy", + "background_color": "#1a1b23", + "cursor_color": "#af98e6", + "foreground_color": "#96979b", + "palette": "#2e3436:#fb7da7:#76c5a4:#e8d56d:#3465a4:#af98e6:#56c9db:#d3d7cf:#555753:#fb7da7:#76c5a4:#e8d56d:#729fcf:#af98e6:#56c9db:#eeeeec", + "type": "dark" + }, + { + "name": "Man Page", + "palette": "#000000:#cc0000:#00a600:#999900:#0000b2:#b200b2:#00a6b2:#cccccc:#666666:#e50000:#00d900:#e5e500:#0000ff:#e500e5:#00e5e5:#e5e5e5", + "background_color": "#fef49c", + "cursor_color": "#7f7f7f", + "foreground_color": "#000000", + "background_image": "None", + "type": "light" + }, + { + "name": "Mar", + "background_color": "#ffffff", + "background_image": "None", + "cursor_color": "#23476a", + "foreground_color": "#23476a", + "palette": "#000000:#b5407b:#7bb540:#b57b40:#407bb5:#7b40b5:#40b57b:#f8f8f8:#737373:#cd73a0:#a0cd73:#cda073:#73a0cd:#a073cd:#73cda0:#ffffff", + "type": "light" + }, + { + "name": "Material", + "palette": "#212121:#b7141f:#457b24:#f6981e:#134eb2:#560088:#0e717c:#efefef:#424242:#e83b3f:#7aba3a:#ffea2e:#54a4f3:#aa4dbc:#26bbd1:#d9d9d9", + "background_color": "#eaeaea", + "cursor_color": "#16afca", + "foreground_color": "#232322", + "background_image": "None", + "type": "light" + }, + { + "name": "Material colors", + "background_color": "#1E282C", + "background_image": "None", + "cursor_color": "#657B83", + "foreground_color": "#C3C7D1", + "palette": "#073641:#EB606B:#C3E88D:#F7EB95:#80CBC3:#FF2490:#AEDDFF:#FFFFFF:#002B36:#EB606B:#C3E88D:#F7EB95:#7DC6BF:#6C71C3:#34434D:#FFFFFF", + "type": "dark" + }, + { + "name": "Material-Ocean", + "background_color": "#0f111a", + "cursor_color": "#ffcc00", + "cursor_color_fg": "False", + "foreground_color": "#8f93a2", + "palette": "#2e3436:#ff5370:#c3e88d:#ffcb6b:#82aaff:#c792ea:#89ddff:#d3d7cf:#555753:#f07178:#c3e88d:#f78c6c:#729fcf:#bb80b3:#89ddff:#eeeeec", + "type": "dark" + }, + { + "name": "Material-Palenight", + "background_color": "#292d3e", + "cursor_color": "#ffcc00", + "cursor_color_fg": "False", + "foreground_color": "#a6accd", + "palette": "#2e3436:#ff5370:#c3e88d:#ffcb6b:#82aaff:#c792ea:#89ddff:#d3d7cf:#555753:#f07178:#c3e88d:#f78c6c:#729fcf:#bb80b3:#89ddff:#eeeeec", + "type": "dark" + }, + { + "name": "MaterialDark", + "palette": "#212121:#b7141f:#457b24:#f6981e:#134eb2:#560088:#0e717c:#efefef:#424242:#e83b3f:#7aba3a:#ffea2e:#54a4f3:#aa4dbc:#26bbd1:#d9d9d9", + "background_color": "#232322", + "cursor_color": "#16afca", + "foreground_color": "#e5e5e5", + "background_image": "None", + "type": "dark" + }, + { + "name": "Mathias", + "palette": "#000000:#e52222:#a6e32d:#fc951e:#c48dff:#fa2573:#67d9f0:#f2f2f2:#555555:#ff5555:#55ff55:#ffff55:#5555ff:#ff55ff:#55ffff:#ffffff", + "background_color": "#000000", + "cursor_color": "#bbbbbb", + "foreground_color": "#bbbbbb", + "background_image": "None", + "type": "dark" + }, + { + "name": "Medallion", + "palette": "#000000:#b64c00:#7c8b16:#d3bd26:#616bb0:#8c5a90:#916c25:#cac29a:#5e5219:#ff9149:#b2ca3b:#ffe54a:#acb8ff:#ffa0ff:#ffbc51:#fed698", + "background_color": "#1d1908", + "cursor_color": "#d3ba30", + "foreground_color": "#cac296", + "background_image": "None", + "type": "dark" + }, + { + "name": "Misterioso", + "palette": "#000000:#ff4242:#74af68:#ffad29:#338f86:#9414e6:#23d7d7:#e1e1e0:#555555:#ff3242:#74cd68:#ffb929:#23d7d7:#ff37ff:#00ede1:#ffffff", + "background_color": "#2d3743", + "cursor_color": "#000000", + "foreground_color": "#e1e1e0", + "background_image": "None", + "type": "dark" + }, + { + "name": "Miu", + "background_color": "#0d1926", + "background_image": "None", + "cursor_color": "#d7dee4", + "foreground_color": "#d9e6f2", + "palette": "#000000:#b87a7a:#7ab87a:#b8b87a:#7a7ab8:#b87ab8:#7ab8b8:#d9d9d9:#262626:#dbbdbd:#bddbbd:#dbdbbd:#bdbddb:#dbbddb:#bddbdb:#ffffff", + "type": "dark" + }, + { + "name": "Molokai", + "palette": "#121212:#fa2573:#98e123:#dfd460:#1080d0:#8700ff:#43a8d0:#bbbbbb:#555555:#f6669d:#b1e05f:#fff26d:#00afff:#af87ff:#51ceff:#ffffff", + "background_color": "#121212", + "cursor_color": "#bbbbbb", + "foreground_color": "#bbbbbb", + "background_image": "None", + "type": "dark" + }, + { + "name": "MonaLisa", + "palette": "#351b0e:#9b291c:#636232:#c36e28:#515c5d:#9b1d29:#588056:#f7d75c:#874228:#ff4331:#b4b264:#ff9566:#9eb2b4:#ff5b6a:#8acd8f:#ffe598", + "background_color": "#120b0d", + "cursor_color": "#c46c32", + "foreground_color": "#f7d66a", + "background_image": "None", + "type": "dark" + }, + { + "name": "Monokai dark", + "background_color": "#272822", + "background_image": "None", + "cursor_color": "#ffffff", + "foreground_color": "#f8f8f2", + "palette": "#75715e:#f92672:#a6e22e:#f4bf75:#66d9ef:#ae81ff:#2aa198:#f9f8f5:#272822:#f92672:#a6e22e:#f4bf75:#66d9ef:#ae81ff:#2aa198:#f9f8f5", + "type": "dark" + }, + { + "name": "Monokai Soda", + "palette": "#1a1a1a:#f4005f:#98e024:#fa8419:#9d65ff:#f4005f:#58d1eb:#c4c5b5:#625e4c:#f4005f:#98e024:#e0d561:#9d65ff:#f4005f:#58d1eb:#f6f6ef", + "background_color": "#1a1a1a", + "cursor_color": "#f6f7ec", + "foreground_color": "#c4c5b5", + "background_image": "None", + "type": "dark" + }, + { + "name": "Monokai Vivid", + "palette": "#121212:#fa2934:#98e123:#fff30a:#0443ff:#f800f8:#01b6ed:#ffffff:#838383:#f6669d:#b1e05f:#fff26d:#0443ff:#f200f6:#51ceff:#ffffff", + "background_color": "#121212", + "cursor_color": "#fb0007", + "foreground_color": "#f9f9f9", + "background_image": "None", + "type": "dark" + }, + { + "name": "N0tch2k", + "palette": "#383838:#a95551:#666666:#a98051:#657d3e:#767676:#c9c9c9:#d0b8a3:#474747:#a97775:#8c8c8c:#a99175:#98bd5e:#a3a3a3:#dcdcdc:#d8c8bb", + "background_color": "#222222", + "cursor_color": "#aa9175", + "foreground_color": "#a0a0a0", + "background_image": "None", + "type": "dark" + }, + { + "name": "Nebula", + "background_color": "#23262e", + "cursor_color": "#00e8c6", + "foreground_color": "#ffffff", + "palette": "#2e3436:#ff007a:#84ff39:#f3d56e:#7cb7ff:#c74ded:#00e8c6:#d3d7cf:#555753:#ff007a:#84ff39:#f3d56e:#7cb7ff:#c74ded:#00e8c6:#eeeeec", + "type": "dark" + }, + { + "name": "Neopolitan", + "palette": "#000000:#800000:#61ce3c:#fbde2d:#253b76:#ff0080:#8da6ce:#f8f8f8:#000000:#800000:#61ce3c:#fbde2d:#253b76:#ff0080:#8da6ce:#f8f8f8", + "background_color": "#271f19", + "cursor_color": "#ffffff", + "foreground_color": "#ffffff", + "background_image": "None", + "type": "dark" + }, + { + "name": "Neutron", + "palette": "#23252b:#b54036:#5ab977:#deb566:#6a7c93:#a4799d:#3f94a8:#e6e8ef:#23252b:#b54036:#5ab977:#deb566:#6a7c93:#a4799d:#3f94a8:#ebedf2", + "background_color": "#1c1e22", + "cursor_color": "#f6f7ec", + "foreground_color": "#e6e8ef", + "background_image": "None", + "type": "dark" + }, + { + "name": "Night Owl", + "background_color": "#011627", + "cursor_color": "#80a4c2", + "cursor_color_fg": "False", + "foreground_color": "#d6deeb", + "palette": "#2e3436:#ef5350:#80cbc4:#ffeb95:#82aaff:#c792ea:#addb67:#d3d7cf:#555753:#ef5350:#80cbc4:#ffeb95:#82aaff:#c792ea:#addb67:#eeeeec", + "type": "dark" + }, + { + "name": "NightLion v1", + "palette": "#4c4c4c:#bb0000:#5fde8f:#f3f167:#276bd8:#bb00bb:#00dadf:#bbbbbb:#555555:#ff5555:#55ff55:#ffff55:#5555ff:#ff55ff:#55ffff:#ffffff", + "background_color": "#000000", + "cursor_color": "#bbbbbb", + "foreground_color": "#bbbbbb", + "background_image": "None", + "type": "dark" + }, + { + "name": "NightLion v2", + "palette": "#4c4c4c:#bb0000:#04f623:#f3f167:#64d0f0:#ce6fdb:#00dadf:#bbbbbb:#555555:#ff5555:#7df71d:#ffff55:#62cbe8:#ff9bf5:#00ccd8:#ffffff", + "background_color": "#171717", + "cursor_color": "#bbbbbb", + "foreground_color": "#bbbbbb", + "background_image": "None", + "type": "dark" + }, + { + "name": "Nord", + "background_color": "#2E3440", + "cursor_color": "#D8DEE9", + "foreground_color": "#D8DEE9", + "palette": "#3B4252:#BF616A:#A3BE8C:#EBCB8B:#81A1C1:#B48EAD:#88C0D0:#E5E9F0:#4C566A:#BF616A:#A3BE8C:#EBCB8B:#81A1C1:#B48EAD:#8FBCBB:#ECEFF4", + "type": "dark" + }, + { + "name": "Novel", + "palette": "#000000:#cc0000:#009600:#d06b00:#0000cc:#cc00cc:#0087cc:#cccccc:#808080:#cc0000:#009600:#d06b00:#0000cc:#cc00cc:#0087cc:#ffffff", + "background_color": "#dfdbc3", + "cursor_color": "#73635a", + "foreground_color": "#3b2322", + "background_image": "None", + "type": "light" + }, + { + "name": "Obsidian", + "palette": "#000000:#a60001:#00bb00:#fecd22:#3a9bdb:#bb00bb:#00bbbb:#bbbbbb:#555555:#ff0003:#93c863:#fef874:#a1d7ff:#ff55ff:#55ffff:#ffffff", + "background_color": "#283033", + "cursor_color": "#c0cad0", + "foreground_color": "#cdcdcd", + "background_image": "None", + "type": "dark" + }, + { + "name": "Ocean", + "palette": "#000000:#990000:#00a600:#999900:#0000b2:#b200b2:#00a6b2:#bfbfbf:#666666:#e50000:#00d900:#e5e500:#0000ff:#e500e5:#00e5e5:#e5e5e5", + "background_color": "#224fbc", + "cursor_color": "#7f7f7f", + "foreground_color": "#ffffff", + "background_image": "None", + "type": "dark" + }, + { + "name": "Ocean dark", + "background_color": "#1c1f27", + "background_image": "None", + "cursor_color": "#a0a4b2", + "foreground_color": "#979cac", + "palette": "#4F4F4F:#AF4B57:#AFD383:#E5C079:#7D90A4:#A4799D:#85A6A5:#EEEDEE:#7B7B7B:#AF4B57:#CEFFAB:#FFFECC:#B5DCFE:#FB9BFE:#DFDFFD:#FEFFFE", + "type": "dark" + }, + { + "name": "OceanicMaterial", + "palette": "#000000:#ee2b2a:#40a33f:#ffea2e:#1e80f0:#8800a0:#16afca:#a4a4a4:#777777:#dc5c60:#70be71:#fff163:#54a4f3:#aa4dbc:#42c7da:#ffffff", + "background_color": "#1c262b", + "cursor_color": "#b3b8c3", + "foreground_color": "#c2c8d7", + "background_image": "None", + "type": "dark" + }, + { + "name": "Ollie", + "palette": "#000000:#ac2e31:#31ac61:#ac4300:#2d57ac:#b08528:#1fa6ac:#8a8eac:#5b3725:#ff3d48:#3bff99:#ff5e1e:#4488ff:#ffc21d:#1ffaff:#5b6ea7", + "background_color": "#222125", + "cursor_color": "#5b6ea7", + "foreground_color": "#8a8dae", + "background_image": "None", + "type": "dark" + }, + { + "name": "One dark", + "background_color": "#1e2127", + "background_image": "None", + "cursor_color": "#676c76", + "foreground_color": "#5c6370", + "palette": "#000000:#e06c75:#98c379:#d19a66:#61afef:#c678dd:#56b6c2:#abb2bf:#5c6370:#e06c75:#98c379:#d19a66:#61afef:#c678dd:#56b6c2:#fffefe", + "type": "dark" + }, + { + "name": "OneHalfDark", + "palette": "#282c34:#e06c75:#98c379:#e5c07b:#61afef:#c678dd:#56b6c2:#dcdfe4:#282c34:#e06c75:#98c379:#e5c07b:#61afef:#c678dd:#56b6c2:#dcdfe4", + "background_color": "#282c34", + "cursor_color": "#a3b3cc", + "foreground_color": "#dcdfe4", + "background_image": "None", + "type": "dark" + }, + { + "name": "OneHalfLight", + "palette": "#383a42:#e45649:#50a14f:#c18401:#0184bc:#a626a4:#0997b3:#fafafa:#4f525e:#e06c75:#98c379:#e5c07b:#61afef:#c678dd:#56b6c2:#ffffff", + "background_color": "#fafafa", + "cursor_color": "#bfceff", + "foreground_color": "#383a42", + "background_image": "None", + "type": "light" + }, + { + "name": "Pali", + "background_color": "#232e37", + "background_image": "None", + "cursor_color": "#e3ecf5", + "foreground_color": "#d9e6f2", + "palette": "#0a0a0a:#ab8f74:#74ab8f:#8fab74:#8f74ab:#ab748f:#748fab:#f2f2f2:#5d5d5d:#ff1d62:#9cc3af:#ffd00a:#af9cc3:#ff1d62:#4bb8fd:#a020f0", + "type": "dark" + }, + { + "name": "Panda", + "background_color": "#292a2b", + "cursor_color": "#f0eeee", + "foreground_color": "#e6e6e6", + "palette": "#676b79:#ff2c6d:#19f9d8:#ffb86c:#45a9f9:#b084eb:#6fc1ff:#d3d7cf:#676b79:#ff9ac1:#19f9d8:#ffcc95:#45a9f9:#b084eb:#6fc1ff:#eeeeec", + "background_image": "None", + "type": "dark" + }, + { + "name": "Pandora", + "palette": "#000000:#ff4242:#74af68:#ffad29:#338f86:#9414e6:#23d7d7:#e2e2e2:#3f5648:#ff3242:#74cd68:#ffb929:#23d7d7:#ff37ff:#00ede1:#ffffff", + "background_color": "#141e43", + "cursor_color": "#43d58e", + "foreground_color": "#e1e1e1", + "background_image": "None", + "type": "dark" + }, + { + "name": "Paraiso Dark", + "palette": "#2f1e2e:#ef6155:#48b685:#fec418:#06b6ef:#815ba4:#5bc4bf:#a39e9b:#776e71:#ef6155:#48b685:#fec418:#06b6ef:#815ba4:#5bc4bf:#e7e9db", + "background_color": "#2f1e2e", + "cursor_color": "#a39e9b", + "foreground_color": "#a39e9b", + "background_image": "None", + "type": "dark" + }, + { + "name": "Parasio Dark", + "palette": "#2f1e2e:#ef6155:#48b685:#fec418:#06b6ef:#815ba4:#5bc4bf:#a39e9b:#776e71:#ef6155:#48b685:#fec418:#06b6ef:#815ba4:#5bc4bf:#e7e9db", + "background_color": "#2f1e2e", + "cursor_color": "#a39e9b", + "foreground_color": "#a39e9b", + "background_image": "None", + "type": "dark" + }, + { + "name": "PaulMillr", + "palette": "#2a2a2a:#ff0000:#79ff0f:#e7bf00:#396bd7:#b449be:#66ccff:#bbbbbb:#666666:#ff0080:#66ff66:#f3d64e:#709aed:#db67e6:#7adff2:#ffffff", + "background_color": "#000000", + "cursor_color": "#4d4d4d", + "foreground_color": "#f2f2f2", + "background_image": "None", + "type": "dark" + }, + { + "name": "PencilDark", + "palette": "#212121:#c30771:#10a778:#a89c14:#008ec4:#523c79:#20a5ba:#d9d9d9:#424242:#fb007a:#5fd7af:#f3e430:#20bbfc:#6855de:#4fb8cc:#f1f1f1", + "background_color": "#212121", + "cursor_color": "#20bbfc", + "foreground_color": "#f1f1f1", + "background_image": "None", + "type": "dark" + }, + { + "name": "PencilLight", + "palette": "#212121:#c30771:#10a778:#a89c14:#008ec4:#523c79:#20a5ba:#d9d9d9:#424242:#fb007a:#5fd7af:#f3e430:#20bbfc:#6855de:#4fb8cc:#f1f1f1", + "background_color": "#f1f1f1", + "cursor_color": "#20bbfc", + "foreground_color": "#424242", + "background_image": "None", + "type": "light" + }, + { + "name": "Peppermint", + "background_image": "None", + "cursor_color": "#BBBBBB", + "foreground_color": "#c7c7c7", + "palette": "#353535:#E64569:#89D287:#DAB752:#439ECF:#D961DC:#64AAAF:#B3B3B3:#535353:#E4859A:#A2CCA1:#E1E387:#6FBBE2:#E586E7:#96DCDA:#DEDEDE", + "type": "dark" + }, + { + "name": "Piatto Light", + "palette": "#414141:#b23771:#66781e:#cd6f34:#3c5ea8:#a454b2:#66781e:#ffffff:#3f3f3f:#db3365:#829429:#cd6f34:#3c5ea8:#a454b2:#829429:#f2f2f2", + "background_color": "#ffffff", + "cursor_color": "#5e77c8", + "foreground_color": "#414141", + "background_image": "None", + "type": "light" + }, + { + "name": "Pnevma", + "palette": "#2f2e2d:#a36666:#90a57d:#d7af87:#7fa5bd:#c79ec4:#8adbb4:#d0d0d0:#4a4845:#d78787:#afbea2:#e4c9af:#a1bdce:#d7beda:#b1e7dd:#efefef", + "background_color": "#1c1c1c", + "cursor_color": "#e4c9af", + "foreground_color": "#d0d0d0", + "background_image": "None", + "type": "dark" + }, + { + "name": "Pro", + "palette": "#000000:#990000:#00a600:#999900:#2009db:#b200b2:#00a6b2:#bfbfbf:#666666:#e50000:#00d900:#e5e500:#0000ff:#e500e5:#00e5e5:#e5e5e5", + "background_color": "#000000", + "cursor_color": "#4d4d4d", + "foreground_color": "#f2f2f2", + "background_image": "None", + "type": "dark" + }, + { + "name": "Red Alert", + "palette": "#000000:#d62e4e:#71be6b:#beb86b:#489bee:#e979d7:#6bbeb8:#d6d6d6:#262626:#e02553:#aff08c:#dfddb7:#65aaf1:#ddb7df:#b7dfdd:#ffffff", + "background_color": "#762423", + "cursor_color": "#ffffff", + "foreground_color": "#ffffff", + "background_image": "None", + "type": "dark" + }, + { + "name": "Red Planet", + "palette": "#202020:#8c3432:#728271:#e8bf6a:#69819e:#896492:#5b8390:#b9aa99:#676767:#b55242:#869985:#ebeb91:#60827e:#de4974:#38add8:#d6bfb8", + "background_color": "#222222", + "cursor_color": "#c2b790", + "foreground_color": "#c2b790", + "background_image": "None", + "type": "dark" + }, + { + "name": "Red Sands", + "palette": "#000000:#ff3f00:#00bb00:#e7b000:#0072ff:#bb00bb:#00bbbb:#bbbbbb:#555555:#bb0000:#00bb00:#e7b000:#0072ae:#ff55ff:#55ffff:#ffffff", + "background_color": "#7a251e", + "cursor_color": "#ffffff", + "foreground_color": "#d7c9a7", + "background_image": "None", + "type": "dark" + }, + { + "name": "Relaxed", + "palette": "#151515:#bc5653:#909d63:#ebc17a:#6a8799:#b06698:#c9dfff:#d9d9d9:#636363:#bc5653:#a0ac77:#ebc17a:#7eaac7:#b06698:#acbbd0:#f7f7f7", + "background_color": "#353a44", + "cursor_color": "#d9d9d9", + "foreground_color": "#d9d9d9", + "background_image": "None", + "type": "dark" + }, + { + "name": "Rippedcasts", + "palette": "#000000:#cdaf95:#a8ff60:#bfbb1f:#75a5b0:#ff73fd:#5a647e:#bfbfbf:#666666:#eecbad:#bcee68:#e5e500:#86bdc9:#e500e5:#8c9bc4:#e5e5e5", + "background_color": "#2b2b2b", + "cursor_color": "#7f7f7f", + "foreground_color": "#ffffff", + "background_image": "None", + "type": "dark" + }, + { + "name": "Royal", + "palette": "#241f2b:#91284c:#23801c:#b49d27:#6580b0:#674d96:#8aaabe:#524966:#312d3d:#d5356c:#2cd946:#fde83b:#90baf9:#a479e3:#acd4eb:#9e8cbd", + "background_color": "#100815", + "cursor_color": "#524966", + "foreground_color": "#514968", + "background_image": "None", + "type": "dark" + }, + { + "name": "Ryuuko", + "palette": "#2c3941:#865f5b:#66907d:#b1a990:#6a8e95:#b18a73:#88b2ac:#ececec:#5d7079:#865f5b:#66907d:#b1a990:#6a8e95:#b18a73:#88b2ac:#ececec", + "background_color": "#2c3941", + "cursor_color": "#ececec", + "foreground_color": "#ececec", + "background_image": "None", + "type": "dark" + }, + { + "name": "Seafoam Pastel", + "palette": "#757575:#825d4d:#728c62:#ada16d:#4d7b82:#8a7267:#729494:#e0e0e0:#8a8a8a:#cf937a:#98d9aa:#fae79d:#7ac3cf:#d6b2a1:#ade0e0:#e0e0e0", + "background_color": "#243435", + "cursor_color": "#57647a", + "foreground_color": "#d4e7d4", + "background_image": "None", + "type": "dark" + }, + { + "name": "SeaShells", + "palette": "#17384c:#d15123:#027c9b:#fca02f:#1e4950:#68d4f1:#50a3b5:#deb88d:#434b53:#d48678:#628d98:#fdd39f:#1bbcdd:#bbe3ee:#87acb4:#fee4ce", + "background_color": "#09141b", + "cursor_color": "#fca02f", + "foreground_color": "#deb88d", + "background_image": "None", + "type": "dark" + }, + { + "name": "Seti", + "palette": "#323232:#c22832:#8ec43d:#e0c64f:#43a5d5:#8b57b5:#8ec43d:#eeeeee:#323232:#c22832:#8ec43d:#e0c64f:#43a5d5:#8b57b5:#8ec43d:#ffffff", + "background_color": "#111213", + "cursor_color": "#e3bf21", + "foreground_color": "#cacecd", + "background_image": "None", + "type": "dark" + }, + { + "name": "Shaman", + "palette": "#012026:#b2302d:#00a941:#5e8baa:#449a86:#00599d:#5d7e19:#405555:#384451:#ff4242:#2aea5e:#8ed4fd:#61d5ba:#1298ff:#98d028:#58fbd6", + "background_color": "#001015", + "cursor_color": "#4afcd6", + "foreground_color": "#405555", + "background_image": "None", + "type": "dark" + }, + { + "name": "Shel", + "background_color": "#2a201f", + "background_image": "None", + "cursor_color": "#6192d2", + "foreground_color": "#4882cd", + "palette": "#2c2423:#ab2463:#6ca323:#ab6423:#2c64a2:#6c24a2:#2ca363:#918988:#918988:#f588b9:#c2ee86:#f5ba86:#8fbaec:#c288ec:#8feeb9:#f5eeec", + "type": "dark" + }, + { + "name": "Slate", + "palette": "#222222:#e2a8bf:#81d778:#c4c9c0:#264b49:#a481d3:#15ab9c:#02c5e0:#ffffff:#ffcdd9:#beffa8:#d0ccca:#7ab0d2:#c5a7d9:#8cdfe0:#e0e0e0", + "background_color": "#222222", + "cursor_color": "#87d3c4", + "foreground_color": "#35b1d2", + "background_image": "None", + "type": "dark" + }, + { + "name": "Smyck", + "palette": "#000000:#b84131:#7da900:#c4a500:#62a3c4:#ba8acc:#207383:#a1a1a1:#7a7a7a:#d6837c:#c4f137:#fee14d:#8dcff0:#f79aff:#6ad9cf:#f7f7f7", + "background_color": "#1b1b1b", + "cursor_color": "#bbbbbb", + "foreground_color": "#f7f7f7", + "background_image": "None", + "type": "dark" + }, + { + "name": "Snazzy", + "background_color": "#242424", + "background_image": "None", + "cursor_color": "#97979b", + "foreground_color": "#eff0eb", + "palette": "#282a36:#ff5c57:#5af78e:#f3f99d:#57c7ff:#ff6ac1:#9aedfe:#f1f1f0:#686868:#ff5c57:#5af78e:#f3f99d:#57c7ff:#ff6ac1:#9aedfe:#eff0eb", + "type": "dark" + }, + { + "name": "SoftServer", + "palette": "#000000:#a2686a:#9aa56a:#a3906a:#6b8fa3:#6a71a3:#6ba58f:#99a3a2:#666c6c:#dd5c60:#bfdf55:#deb360:#62b1df:#606edf:#64e39c:#d2e0de", + "background_color": "#242626", + "cursor_color": "#d2e0de", + "foreground_color": "#99a3a2", + "background_image": "None", + "type": "dark" + }, + { + "name": "Solarized Darcula", + "palette": "#25292a:#f24840:#629655:#b68800:#2075c7:#797fd4:#15968d:#d2d8d9:#25292a:#f24840:#629655:#b68800:#2075c7:#797fd4:#15968d:#d2d8d9", + "background_color": "#3d3f41", + "cursor_color": "#708284", + "foreground_color": "#d2d8d9", + "background_image": "None", + "type": "dark" + }, + { + "name": "Solarized Dark", + "palette": "#002831:#d11c24:#738a05:#a57706:#2176c7:#c61c6f:#259286:#eae3cb:#001e27:#bd3613:#475b62:#536870:#708284:#5956ba:#819090:#fcf4dc", + "background_color": "#001e27", + "cursor_color": "#708284", + "foreground_color": "#708284", + "background_image": "None", + "type": "dark" + }, + { + "name": "Solarized Dark - Patched", + "palette": "#002831:#d11c24:#738a05:#a57706:#2176c7:#c61c6f:#259286:#eae3cb:#475b62:#bd3613:#475b62:#536870:#708284:#5956ba:#819090:#fcf4dc", + "background_color": "#001e27", + "cursor_color": "#708284", + "foreground_color": "#708284", + "background_image": "None", + "type": "dark" + }, + { + "name": "Solarized Dark Higher Contrast", + "palette": "#002831:#d11c24:#6cbe6c:#a57706:#2176c7:#c61c6f:#259286:#eae3cb:#006488:#f5163b:#51ef84:#b27e28:#178ec8:#e24d8e:#00b39e:#fcf4dc", + "background_color": "#001e27", + "cursor_color": "#f34b00", + "foreground_color": "#9cc2c3", + "background_image": "None", + "type": "dark" + }, + { + "name": "Solarized Light", + "palette": "#002831:#d11c24:#738a05:#a57706:#2176c7:#c61c6f:#259286:#eae3cb:#001e27:#bd3613:#475b62:#536870:#708284:#5956ba:#819090:#fcf4dc", + "background_color": "#fcf4dc", + "cursor_color": "#536870", + "foreground_color": "#536870", + "background_image": "None", + "type": "light" + }, + { + "name": "Spacedust", + "palette": "#6e5346:#e35b00:#5cab96:#e3cd7b:#0f548b:#e35b00:#06afc7:#f0f1ce:#684c31:#ff8a3a:#aecab8:#ffc878:#67a0ce:#ff8a3a:#83a7b4:#fefff1", + "background_color": "#0a1e24", + "cursor_color": "#708284", + "foreground_color": "#ecf0c1", + "background_image": "None", + "type": "dark" + }, + { + "name": "SpaceGray", + "palette": "#000000:#b04b57:#87b379:#e5c179:#7d8fa4:#a47996:#85a7a5:#b3b8c3:#000000:#b04b57:#87b379:#e5c179:#7d8fa4:#a47996:#85a7a5:#ffffff", + "background_color": "#20242d", + "cursor_color": "#b3b8c3", + "foreground_color": "#b3b8c3", + "background_image": "None", + "type": "dark" + }, + { + "name": "SpaceGray Eighties", + "palette": "#15171c:#ec5f67:#81a764:#fec254:#5486c0:#bf83c1:#57c2c1:#efece7:#555555:#ff6973:#93d493:#ffd256:#4d84d1:#ff55ff:#83e9e4:#ffffff", + "background_color": "#222222", + "cursor_color": "#bbbbbb", + "foreground_color": "#bdbaae", + "background_image": "None", + "type": "dark" + }, + { + "name": "SpaceGray Eighties Dull", + "palette": "#15171c:#b24a56:#92b477:#c6735a:#7c8fa5:#a5789e:#80cdcb:#b3b8c3:#555555:#ec5f67:#89e986:#fec254:#5486c0:#bf83c1:#58c2c1:#ffffff", + "background_color": "#222222", + "cursor_color": "#bbbbbb", + "foreground_color": "#c9c6bc", + "background_image": "None", + "type": "dark" + }, + { + "name": "Spiderman", + "palette": "#1b1d1e:#e60813:#e22928:#e24756:#2c3fff:#2435db:#3256ff:#fffef6:#505354:#ff0325:#ff3338:#fe3a35:#1d50ff:#747cff:#6184ff:#fffff9", + "background_color": "#1b1d1e", + "cursor_color": "#2c3fff", + "foreground_color": "#e3e3e3", + "background_image": "None", + "type": "dark" + }, + { + "name": "Spring", + "palette": "#000000:#ff4d83:#1f8c3b:#1fc95b:#1dd3ee:#8959a8:#3e999f:#ffffff:#000000:#ff0021:#1fc231:#d5b807:#15a9fd:#8959a8:#3e999f:#ffffff", + "background_color": "#ffffff", + "cursor_color": "#4d4d4c", + "foreground_color": "#4d4d4c", + "background_image": "None", + "type": "light" + }, + { + "name": "Square", + "palette": "#050505:#e9897c:#b6377d:#ecebbe:#a9cdeb:#75507b:#c9caec:#f2f2f2:#141414:#f99286:#c3f786:#fcfbcc:#b6defb:#ad7fa8:#d7d9fc:#e2e2e2", + "background_color": "#1a1a1a", + "cursor_color": "#fcfbcc", + "foreground_color": "#acacab", + "background_image": "None", + "type": "dark" + }, + { + "name": "Sundried", + "palette": "#302b2a:#a7463d:#587744:#9d602a:#485b98:#864651:#9c814f:#c9c9c9:#4d4e48:#aa000c:#128c21:#fc6a21:#7999f7:#fd8aa1:#fad484:#ffffff", + "background_color": "#1a1818", + "cursor_color": "#ffffff", + "foreground_color": "#c9c9c9", + "background_image": "None", + "type": "dark" + }, + { + "name": "Symfonic", + "palette": "#000000:#dc322f:#56db3a:#ff8400:#0084d4:#b729d9:#ccccff:#ffffff:#1b1d21:#dc322f:#56db3a:#ff8400:#0084d4:#b729d9:#ccccff:#ffffff", + "background_color": "#000000", + "cursor_color": "#dc322f", + "foreground_color": "#ffffff", + "background_image": "None", + "type": "dark" + }, + { + "name": "Teerb", + "palette": "#1c1c1c:#d68686:#aed686:#d7af87:#86aed6:#d6aed6:#8adbb4:#d0d0d0:#1c1c1c:#d68686:#aed686:#e4c9af:#86aed6:#d6aed6:#b1e7dd:#efefef", + "background_color": "#262626", + "cursor_color": "#e4c9af", + "foreground_color": "#d0d0d0", + "background_image": "None", + "type": "dark" + }, + { + "name": "Terminal Basic", + "palette": "#000000:#990000:#00a600:#999900:#0000b2:#b200b2:#00a6b2:#bfbfbf:#666666:#e50000:#00d900:#e5e500:#0000ff:#e500e5:#00e5e5:#e5e5e5", + "background_color": "#ffffff", + "cursor_color": "#7f7f7f", + "foreground_color": "#000000", + "background_image": "None", + "type": "light" + }, + { + "name": "Thayer Bright", + "palette": "#1b1d1e:#f92672:#4df840:#f4fd22:#2757d6:#8c54fe:#38c8b5:#ccccc6:#505354:#ff5995:#b6e354:#feed6c:#3f78ff:#9e6ffe:#23cfd5:#f8f8f2", + "background_color": "#1b1d1e", + "cursor_color": "#fc971f", + "foreground_color": "#f8f8f8", + "background_image": "None", + "type": "dark" + }, + { + "name": "The Hulk", + "palette": "#1b1d1e:#269d1b:#13ce30:#63e457:#2525f5:#641f74:#378ca9:#d9d8d1:#505354:#8dff2a:#48ff77:#3afe16:#506b95:#72589d:#4085a6:#e5e6e1", + "background_color": "#1b1d1e", + "cursor_color": "#16b61b", + "foreground_color": "#b5b5b5", + "background_image": "None", + "type": "dark" + }, + { + "name": "Tomorrow", + "palette": "#000000:#c82829:#718c00:#eab700:#4271ae:#8959a8:#3e999f:#ffffff:#000000:#c82829:#718c00:#eab700:#4271ae:#8959a8:#3e999f:#ffffff", + "background_color": "#ffffff", + "cursor_color": "#4d4d4c", + "foreground_color": "#4d4d4c", + "background_image": "None", + "type": "light" + }, + { + "name": "Tomorrow Night", + "palette": "#000000:#cc6666:#b5bd68:#f0c674:#81a2be:#b294bb:#8abeb7:#ffffff:#000000:#cc6666:#b5bd68:#f0c674:#81a2be:#b294bb:#8abeb7:#ffffff", + "background_color": "#1d1f21", + "cursor_color": "#c5c8c6", + "foreground_color": "#c5c8c6", + "background_image": "None", + "type": "dark" + }, + { + "name": "Tomorrow Night Blue", + "palette": "#000000:#ff9da4:#d1f1a9:#ffeead:#bbdaff:#ebbbff:#99ffff:#ffffff:#000000:#ff9da4:#d1f1a9:#ffeead:#bbdaff:#ebbbff:#99ffff:#ffffff", + "background_color": "#002451", + "cursor_color": "#ffffff", + "foreground_color": "#ffffff", + "background_image": "None", + "type": "dark" + }, + { + "name": "Tomorrow Night Bright", + "palette": "#000000:#d54e53:#b9ca4a:#e7c547:#7aa6da:#c397d8:#70c0b1:#ffffff:#000000:#d54e53:#b9ca4a:#e7c547:#7aa6da:#c397d8:#70c0b1:#ffffff", + "background_color": "#000000", + "cursor_color": "#eaeaea", + "foreground_color": "#eaeaea", + "background_image": "None", + "type": "dark" + }, + { + "name": "Tomorrow Night Eighties", + "palette": "#000000:#f2777a:#99cc99:#ffcc66:#6699cc:#cc99cc:#66cccc:#ffffff:#000000:#f2777a:#99cc99:#ffcc66:#6699cc:#cc99cc:#66cccc:#ffffff", + "background_color": "#2d2d2d", + "cursor_color": "#cccccc", + "foreground_color": "#cccccc", + "background_image": "None", + "type": "dark" + }, + { + "name": "ToyChest", + "palette": "#2c3f58:#be2d26:#1a9172:#db8e27:#325d96:#8a5edc:#35a08f:#23d183:#336889:#dd5944:#31d07b:#e7d84b:#34a6da:#ae6bdc:#42c3ae:#d5d5d5", + "background_color": "#24364b", + "cursor_color": "#d5d5d5", + "foreground_color": "#31d07b", + "background_image": "None", + "type": "dark" + }, + { + "name": "Treehouse", + "palette": "#321300:#b2270e:#44a900:#aa820c:#58859a:#97363d:#b25a1e:#786b53:#433626:#ed5d20:#55f238:#f2b732:#85cfed:#e14c5a:#f07d14:#ffc800", + "background_color": "#191919", + "cursor_color": "#fac814", + "foreground_color": "#786b53", + "background_image": "None", + "type": "dark" + }, + { + "name": "Twilight", + "palette": "#141414:#c06d44:#afb97a:#c2a86c:#44474a:#b4be7c:#778385:#ffffd4:#262626:#de7c4c:#ccd88c:#e2c47e:#5a5e62:#d0dc8e:#8a989b:#ffffd4", + "background_color": "#141414", + "cursor_color": "#ffffff", + "foreground_color": "#ffffd4", + "background_image": "None", + "type": "dark" + }, + { + "name": "Ubuntu", + "palette": "#2e3436:#cc0000:#4e9a06:#c4a000:#3465a4:#75507b:#06989a:#d3d7cf:#555753:#ef2929:#8ae234:#fce94f:#729fcf:#ad7fa8:#34e2e2:#eeeeec", + "background_color": "#300a24", + "cursor_color": "#bbbbbb", + "foreground_color": "#eeeeec", + "background_image": "None", + "type": "dark" + }, + { + "name": "UnderTheSea", + "palette": "#022026:#b2302d:#00a941:#59819c:#459a86:#00599d:#5d7e19:#405555:#384451:#ff4242:#2aea5e:#8ed4fd:#61d5ba:#1298ff:#98d028:#58fbd6", + "background_color": "#011116", + "cursor_color": "#4afcd6", + "foreground_color": "#ffffff", + "background_image": "None", + "type": "dark" + }, + { + "name": "Urple", + "palette": "#000000:#b0425b:#37a415:#ad5c42:#564d9b:#6c3ca1:#808080:#87799c:#5d3225:#ff6388:#29e620:#f08161:#867aed:#a05eee:#eaeaea:#bfa3ff", + "background_color": "#1b1b23", + "cursor_color": "#a063eb", + "foreground_color": "#877a9b", + "background_image": "None", + "type": "dark" + }, + { + "name": "Vag", + "background_color": "#191f1d", + "background_image": "None", + "cursor_color": "#e5f0fa", + "foreground_color": "#d9e6f2", + "palette": "#303030:#a87139:#39a871:#71a839:#7139a8:#a83971:#3971a8:#8a8a8a:#494949:#b0763b:#3bb076:#76b03b:#763bb0:#b03b76:#3b76b0:#cfcfcf", + "type": "dark" + }, + { + "name": "Vaughn", + "palette": "#25234f:#705050:#60b48a:#dfaf8f:#5555ff:#f08cc3:#8cd0d3:#709080:#709080:#dca3a3:#60b48a:#f0dfaf:#5555ff:#ec93d3:#93e0e3:#ffffff", + "background_color": "#25234f", + "cursor_color": "#ff5555", + "foreground_color": "#dcdccc", + "background_image": "None", + "type": "dark" + }, + { + "name": "Venom", + "background_color": "#060d14", + "cursor_color": "#9ecfa2", + "foreground_color": "#668198", + "palette": "#2e3436:#e94759:#9ecfa2:#f3efa9:#00898d:#9c21b0:#06989a:#d3d7cf:#555753:#ef2929:#8ae234:#fce94f:#729fcf:#ad7fa8:#34e2e2:#eeeeec", + "type": "dark" + }, + { + "name": "VibrantInk", + "palette": "#878787:#ff6600:#ccff04:#ffcc00:#44b4cc:#9933cc:#44b4cc:#f5f5f5:#555555:#ff0000:#00ff00:#ffff00:#0000ff:#ff00ff:#00ffff:#e5e5e5", + "background_color": "#000000", + "cursor_color": "#ffffff", + "foreground_color": "#ffffff", + "background_image": "None", + "type": "dark" + }, + { + "name": "Violet Dark", + "palette": "#56595c:#c94c22:#85981c:#b4881d:#2e8bce:#d13a82:#32a198:#c9c6bd:#45484b:#bd3613:#738a04:#a57705:#2176c7:#c61c6f:#259286:#c9c6bd", + "background_color": "#1c1d1f", + "cursor_color": "#708284", + "foreground_color": "#708284", + "background_image": "None", + "type": "dark" + }, + { + "name": "Violet Light", + "palette": "#56595c:#c94c22:#85981c:#b4881d:#2e8bce:#d13a82:#32a198:#d3d0c9:#45484b:#bd3613:#738a04:#a57705:#2176c7:#c61c6f:#259286:#c9c6bd", + "background_color": "#fcf4dc", + "cursor_color": "#536870", + "foreground_color": "#536870", + "background_image": "None", + "type": "light" + }, + { + "name": "WarmNeon", + "palette": "#000000:#e24346:#39b13a:#dae145:#4261c5:#f920fb:#2abbd4:#d0b8a3:#fefcfc:#e97071:#9cc090:#ddda7a:#7b91d6:#f674ba:#5ed1e5:#d8c8bb", + "background_color": "#404040", + "cursor_color": "#30ff24", + "foreground_color": "#afdab6", + "background_image": "None", + "type": "dark" + }, + { + "name": "Wez", + "palette": "#000000:#cc5555:#55cc55:#cdcd55:#5555cc:#cc55cc:#7acaca:#cccccc:#555555:#ff5555:#55ff55:#ffff55:#5555ff:#ff55ff:#55ffff:#ffffff", + "background_color": "#000000", + "cursor_color": "#53ae71", + "foreground_color": "#b3b3b3", + "background_image": "None", + "type": "dark" + }, + { + "name": "WildCherry", + "palette": "#000507:#d94085:#2ab250:#ffd16f:#883cdc:#ececec:#c1b8b7:#fff8de:#009cc9:#da6bac:#f4dca5:#eac066:#308cba:#ae636b:#ff919d:#e4838d", + "background_color": "#1f1726", + "cursor_color": "#dd00ff", + "foreground_color": "#dafaff", + "background_image": "None", + "type": "dark" + }, + { + "name": "Wombat", + "palette": "#000000:#ff615a:#b1e969:#ebd99c:#5da9f6:#e86aff:#82fff7:#dedacf:#313131:#f58c80:#ddf88f:#eee5b2:#a5c7ff:#ddaaff:#b7fff9:#ffffff", + "background_color": "#171717", + "cursor_color": "#bbbbbb", + "foreground_color": "#dedacf", + "background_image": "None", + "type": "dark" + }, + { + "name": "Wryan", + "palette": "#333333:#8c4665:#287373:#7c7c99:#395573:#5e468c:#31658c:#899ca1:#3d3d3d:#bf4d80:#53a6a6:#9e9ecb:#477ab3:#7e62b3:#6096bf:#c0c0c0", + "background_color": "#101010", + "cursor_color": "#9e9ecb", + "foreground_color": "#999993", + "background_image": "None", + "type": "dark" + }, + { + "name": "Zenburn", + "palette": "#4d4d4d:#705050:#60b48a:#f0dfaf:#506070:#dc8cc3:#8cd0d3:#dcdccc:#709080:#dca3a3:#c3bf9f:#e0cf9f:#94bff3:#ec93d3:#93e0e3:#ffffff", + "background_color": "#3f3f3f", + "cursor_color": "#73635a", + "foreground_color": "#dcdccc", + "background_image": "None", + "type": "dark" + } + ] +} \ No newline at end of file diff --git a/emacs/.emacs.d/wpc/terminator.el b/emacs/.emacs.d/wpc/terminator.el new file mode 100644 index 0000000000..4794ce2d90 --- /dev/null +++ b/emacs/.emacs.d/wpc/terminator.el @@ -0,0 +1,94 @@ +;;; terminator.el --- Experimenting with theming Terminator -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; I think most of this module is me getting carried away with the idea of +;; theming Terminator. Terminator themes are defined in a themes.json file. As +;; far as I know, Terminator does not support specifying these themes by name on +;; the command line, which would greatly simplify things. Terminator does +;; support passing a --profile flag, however, which can be used to specify the +;; themes. The idea, albeit quite awkward and over-engineered, was to create +;; these profile files on the fly and pass them to terminator. After around 45 +;; minutes of tinkering with this, the idea is starting to disenchant me. +;; +;; Alternative solutions include: +;; 1. Further investigating what other options Terminator supports. +;; 2. Using a different terminal emulator. +;; 3. Just right clicking Terminator and changing the themes manually. + +;;; Code: +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'prelude) +(require 'alist) +(require 'string) +(require 'json) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(cl-defstruct terminator/theme + foreground-color + background-color + cursor-color + palette) + +(defvar terminator/palettes + '((solarized-light . "#002831:#d11c24:#738a05:#a57706:#2176c7:#c61c6f:#259286:#eae3cb:#001e27:#bd3613:#475b62:#536870:#708284:#5956ba:#819090:#fcf4dc")) + "Mapping of theme names to the color palette that terminator expects.") + +(defconst terminator/profile-template "[global_config] + enabled_plugins = LaunchpadBugURLHandler, LaunchpadCodeURLHandler, APTURLHandler, TerminatorThemes +[keybindings] +[profiles] + [[default]] + background_color = \"%s\" + cursor_shape = ibeam + cursor_color = \"%s\" + font = Input Mono Medium 12 + foreground_color = \"%s\" + show_titlebar = False + scrollbar_position = hidden + palette = \"%s\" + use_system_font = False +[layouts] + [[default]] + [[[child1]]] + parent = window0 + type = Terminal + profile = Molokai + [[[window0]]] + parent = \"\" + type = Window +[plugins]" + "Template string of a terminator profile file.") + +(cl-defun terminator/render-profile (&key foreground-color + background-color + cursor-color + palette) + "Create a terminator profile with THEME as the palette." + (string/format terminator/profile-template + background-color + cursor-color + foreground-color + palette)) + +(defun terminator/as-heredoc (x) + "Return an EOF-terminator heredoc of X." + (string/format "<> 'solarized-light + terminator/render-profile + terminator/as-heredoc))) +(string/format terminator/profile-template + (alist/get 'solarized-light terminator/palettes)) + +(provide 'terminator) +;;; terminator.el ends here diff --git a/emacs/.emacs.d/wpc/themes.el b/emacs/.emacs.d/wpc/themes.el new file mode 100644 index 0000000000..ee81d3beed --- /dev/null +++ b/emacs/.emacs.d/wpc/themes.el @@ -0,0 +1,204 @@ +;;; themes.el --- Functions for working with my themes. -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: + + +;; Because I couldn't get cycle-themes to work, I'm writing my own version. +;; +;; Terminology: +;; - colorscheme: determines the colors used by syntax highlighting and other +;; Emacs UI elements. +;; - theme: Structural representation of a "theme" that includes colorscheme +;; (see above), font, wallpaper. "theme" is a superset of "colorscheme". +;; +;; Wishlist: +;; - TODO: Find a way to update the terminal (e.g. terminator) theme. +;; - TODO: Ensure terminal font is updated when Emacs font changes. +;; - TODO: Support a light theme. +;; - TODO: Support Rick & Morty theme. +;; - TODO: Support retro/arcade/80s theme. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'prelude) +(require 'alist) +(require 'symbol) +(require 'f) +(require 'wallpaper) +(require 'fonts) +(require 'cycle) +(require 'symbol) +(require 'random) +(require 'colorscheme) +(require 'dotted) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; The theme struct couples a font, a wallpaper, and a colorschemes. +(cl-defstruct theme + font + wallpaper + colorscheme) + +(defvar themes/current nil + "Store the name of the currently enabled theme.") + +(defconst themes/themes + (list (dotted/new + "Forest" + (make-theme + :font "Operator Mono Light" + :wallpaper "forest_8k.jpg" + :colorscheme 'doom-peacock)) + (dotted/new + "Geometry" + (make-theme + :font "Input Mono Medium" + :wallpaper "geometric_4k.jpg" + :colorscheme 'doom-molokai)) + (dotted/new + "Ice" + (make-theme + :font "Go Mono" + :wallpaper "construction_paper_iceberg_4k.jpg" + :colorscheme 'doom-dracula)) + (dotted/new + "Lego Manhattan" + (make-theme + :font "Input Mono Medium" + :wallpaper "lego_manhattan.jpg" + :colorscheme 'base16-atelier-sulphurpool)) + (dotted/new + "Shapely Patterns" + (make-theme + :font "Operator Mono Light" + :wallpaper "geometric_dark_4k.jpg" + :colorscheme 'doom-vibrant)) + ;; TODO: Support setting backgrounds as solid colors. + (dotted/new + "Gruvbox" + (make-theme + :font "JetBrainsMono" + :wallpaper "geometric_dark_4k.jpg" + :colorscheme 'doom-gruvbox)) + (dotted/new + "Solarized Light" + (make-theme + :font "JetBrainsMono" + :wallpaper "solarized_light_thinkpad.jpg" + :colorscheme 'doom-solarized-light)) + (dotted/new + "Lightness" + (make-theme + :font "Input Mono Medium" + :wallpaper "construction_paper_iceberg_4k.jpg" + :colorscheme 'doom-one-light)) + (dotted/new + "Edison Lightbulb" + (make-theme + :font "Mononoki Medium" + :wallpaper "lightbulb_4k.jpg" + :colorscheme 'base16-atelier-cave)) + (dotted/new + "Wall-E" + (make-theme + :font "Input Mono Medium" + :wallpaper "walle_4k.jpg" + :colorscheme 'doom-material)) + (dotted/new + "Galaxy" + (make-theme + :font "Source Code Pro" + :wallpaper "galaxy_4k.jpg" + :colorscheme 'doom-moonlight)) + (dotted/new + "Underwater" + (make-theme + :font "Go Mono" + ;; TODO: Change this wallpaper to an oceanic scene. + :wallpaper "galaxy_4k.jpg" + :colorscheme 'doom-solarized-dark)) + (dotted/new + "Fantasy Tree" + (make-theme + :font "Go Mono" + :wallpaper "fantasy_tree_4k.jpg" + :colorscheme 'doom-outrun-electric))) + "Predefined themes to suit my whims.") + +;; TODO: Choose between plural and singular names for Elisp modules. For +;; example, why have themes.el and colorscheme.el. I think singular is +;; preferable. +;; TODO: Decide between "message", "show", "print", "inspect" for naming +;; commands that output human-readable information to the "*Messages*" buffer. +;; TODO: Is there a idiomatic CL/Elisp way to print struct information? +(defun themes/print (name) + "Print a human-readable description of theme named NAME." + (let* ((theme (alist/get name themes/themes)) + (f (theme-font theme)) + (w (theme-wallpaper theme)) + (c (theme-colorscheme theme))) + (message (string/format + "[themes] Name: %s. Font: %s. Wallpaper: %s. Colorscheme: %s" + name f w c)))) + +;; TODO: Make this into a proper test. +(defun themes/debug () + "Print a human-readable description of theme named NAME." + (interactive) + (let ((theme (alist/get themes/current themes/themes))) + (prelude/assert (equal (theme-font theme) + (fonts/current))) + (prelude/assert (equal (theme-wallpaper theme) + (f-filename (wallpaper/current)))) + (prelude/assert (equal (theme-colorscheme theme) + (colorscheme/current))) + (message "[themes] Debug couldn't find any inconsistencies. All good!"))) + +;; TODO: Assert that all of the dependencies exist before attempting to load +;; theme. +;; TODO: Provide a friendlier way to define themes. +(defun themes/ivy-select () + "Use ivy to interactively load a theme." + (interactive) + (let* ((name (ivy-read "Theme: " (alist/keys themes/themes)))) + (message (string/format "name: %s" name)) + (themes/set name))) + +(defun themes/load (theme) + "Load the struct, THEME." + (colorscheme/disable-all) + (let* ((font (theme-font theme)) + (wallpaper (theme-wallpaper theme)) + (colorscheme (theme-colorscheme theme))) + (fonts/whitelist-set font) + (wallpaper/whitelist-set (f-join wallpaper/path-to-dir wallpaper)) + (colorscheme/whitelist-set colorscheme))) + +(defun themes/set (name) + "Set the currently enabled theme to the theme named NAME. +NAME needs to a key defined in `themes/themes'." + (prelude/assert (alist/has-key? name themes/themes)) + (themes/load (alist/get name themes/themes)) + (setq themes/current name)) + +(defun themes/print-current () + "Print the currently enabled theme." + (interactive) + (themes/print themes/current)) + +(defun themes/random () + "Return the name of a randomly selected theme in `themes/themes'." + (->> themes/themes + alist/keys + random/choice)) + +(provide 'themes) +;;; themes.el ends here diff --git a/emacs/.emacs.d/wpc/todo.el b/emacs/.emacs.d/wpc/todo.el new file mode 100644 index 0000000000..236912c086 --- /dev/null +++ b/emacs/.emacs.d/wpc/todo.el @@ -0,0 +1,293 @@ +;;; todo.el --- Bespoke task management system -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Marriage of my personal task-management system, which I've been using for 18 +;; months and is a mixture of handwritten notes, iOS notes, and org-mode files, +;; with Emacs's famous `org-mode'. +;; +;; For me, I'd like a live, reactive state management system. I'd like +;; `org-mode' to be a nice way of rendering my TODOs, but I think the +;; relationship with `org-mode' ends there. +;; +;; Intended to supplement my org-mode workflow. +;; +;; Wish-list: +;; - Daily emails for standups +;; - Templates for commonly occurring tasks + +;; Dependencies +(require 'dash) +(require 'f) +(require 'macros) + +;;; Code: + +;; TODO: Classify habits as 'daily, 'weekly, 'monthly, 'yearly, 'event-driven + +;; TODO: Consider serving these values up to a React webpage in Chrome. + +;; TODO: Classify meetings as either 'recurrent or 'ad-hoc. + +;; TODO: Support sorting by `type'. + +;; TODO: Support work-queue idea for "Tomorrow's todos." + +;; TODO: Support macro to generate all possible predicates for todo types. + +;; TODO: Support export to org-mode file + +;; TODO: Support generic way to quickly render a list + +(defcustom todo/install-kbds? t + "When t, install the keybindings.") + +;; TODO: Add documentation. +(cl-defstruct todo type label) + +;; TODO: Consider keeping this in Dropbox. +;; TODO: Support whether or not the todo is done. +(defconst todo/org-file-path "~/Dropbox/org/today.org") + +;; TODO: Support remaining function for each type. +;; TODO: Support completed function for each type. + +(defun todo/completed? (x) + "Return t is `X' is marked complete." + (todo-complete x)) + +;; TODO: Prefer `new-{task,habit,meeting}'. + +(defun todo/completed (xs) + "Return the todo items in `XS' that are marked complete." + (->> xs + (-filter #'todo/completed?))) + +(defun todo/remaining (xs) + "Return the todo items in `XS' that are not marked complete." + (->> xs + (-reject #'todo/completed?))) + +(defun todo/task (label) + "Convenience function for creating a task todo with `LABEL'." + (make-todo + :type 'task + :label label)) + +(defun todo/meeting (label) + "Convenience function for creating a meeting todo with `LABEL'." + (make-todo + :type 'meeting + :label label)) + +(defun todo/habit (label) + "Convenience function for creating a habit todo with `LABEL'." + (make-todo + :type 'habit + :label label)) + +(defun todo/task? (x) + "Return t if `X' is a task." + (equal 'task (todo-type x))) + +(defun todo/habit? (x) + "Return t if `X' is a habit." + (equal 'habit (todo-type x))) + +(defun todo/meeting? (x) + "Return t if `X' is a meeting." + (equal 'meeting (todo-type x))) + +(defun todo/label (x) + "Return the label of `X'." + (todo-label x)) + +;; TODO: Support moving todos between todo/{today,tomorrow}. +;; TODO: Consider modelling todo/{today,tomorrow} as queues instead of lists so that I can +;; append cheaply. + +;; TODO: Find an Elisp date library. + +;; TODO: type-driven development of this habit tree. +;; TODO: Create this tree on a whiteboard first. +;; (defconst todo/habits +;; '(:beginning-of-month +;; '("Create habit template for current month" +;; "Post mortem of previous month") +;; :monday '("Jiu Jitsu") +;; :tuesday '("Jiu Jitsu") +;; :wednesday '("Jiu Jitsu") +;; :thursday '("Salsa class") +;; :friday '("Jiu Jitsu") +;; :saturday '("Borough market") +;; :sunday '("Shave") +;; :weekday '(:arrive-at-work +;; '("Breakfast" +;; "Coffee" +;; "Placeholder") +;; :before-lunch +;; '("Lock laptop" +;; "Placeholder") +;; :home->work +;; '("Michel Thomas Italian lessons")) +;; :daily '(:morning +;; '("Meditate" +;; "Stretch") +;; :))) + +;; overlay weekday with specific weekdays (e.g. BJJ is only on M,T,W) + +;; TODO: Extend the record type to support duration estimations for AFK, K +;; calculations. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Habits +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; TODO: Should I be writing this in ReasonML and Haskell? + +(defconst todo/monthly-habit-challenge + "InterviewCake.com" + "The monthly habit challenge I do for fifteen minutes each day.") + +(defconst todo/daily-habits + (->> (list "Meditate" + todo/monthly-habit-challenge) + (-map #'todo/habit))) + +(defconst todo/first-of-the-month-stack + '("Create habit template for current month" + "Reserve two dinners in London for dates" + "Post mortem of previous month" + "Create monthly financial budget in Google Sheets") + "A stack of habits that I do at the beginning of each month.") + +(defconst todo/adhoc-habits + (->> (list/concat + todo/first-of-the-month-stack) + (-map #'todo/habit)) + "Habits that I have no classification for at the moment.") + +;; TODO: Model this as a function. +(defconst todo/habits + (list/concat todo/daily-habits + todo/adhoc-habits) + "My habits for today.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Meetings +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; TODO: Define "meeting". + +(defconst todo/daily-meetings + (->> '("Standup" + "Lunch") + (-map #'todo/meeting)) + "Daily, recurrent meetings.") + + +(defconst todo/day-of-week-meetings + '(:Monday '("Lunch") + :Tuesday '("Lunch") + :Wednesday '("Team Lunch") + :Thursday '("Lunch") + :Friday '("Lunch") + :Satuday '() + :Sunday '()) + "Meetings that occur depending on the current day of the week.") + +(parse-time-string "today") + +;; TODO: Support recurrent, non-daily meetings. + +(defconst todo/adhoc-meetings + (->> '("WSE Weekly Standup" + "Team Lunch" + "Karisa Explains It All") + (-map #'todo/meeting)) + "Non-recurrent meetings.") + +(defconst todo/meetings + (list/concat todo/daily-meetings + todo/adhoc-meetings) + "My meetings for today.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tasks +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst todo/tasks + (->> '("GetEmailCase" + "Async node workflow" + "Support C-c in EXWM" + "Post-its for bathroom mirror" + "Visit AtomicHabit.com/scorecard" + "Visit AtomicHabit.com/habitstacking" + "Create GraphViz for Carpe Diem cirriculum" + "Create CitC client for local browsing of CE codebase" + "Respond to SRE emails") + (-map #'todo/task))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Work queues (today, tomorrow, someday) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; TODO: Generate standup documents from DONE items in the state. + +;; TODO: Learn how to create a gen-server style of live, reactive state. +;; TODO: This should probably be `defconst' and a reference to the live state. +(defconst todo/today + (list/concat + todo/habits + todo/meetings + todo/tasks)) + +(defconst todo/tomorrow + '()) + +(defconst todo/someday + '()) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; View functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun todo/to-org (xs) + "Map `XS' into a string with `org-mode' syntax." + ;; TODO: Create function to DRY this code up. + (let ((meetings (->> xs + (-filter #'todo/meeting?) + (-map (lambda (x) + (s-concat "** TODO " (todo/label x)))) + (s-join "\n"))) + (tasks (->> xs + (-filter #'todo/task?) + (-map (lambda (x) + (s-concat "** TODO " (todo/label x)))) + (s-join "\n"))) + (habits (->> xs + (-filter #'todo/habit?) + (-map (lambda (x) + (s-concat "** TODO " (todo/label x)))) + (s-join "\n")))) + (s-join "\n" (list + (s-concat "* Meetings\n" meetings) + (s-concat "* Tasks\n" tasks) + (s-concat "* Habits\n" habits))))) + +(defun todo/export-to-org (xs) + "Export `XS' to `todo/org-file-path'." + (f-write-text (->> xs + todo/to-org) + 'utf-8 + todo/org-file-path)) + +(defun todo/orgify-today () + "Exports today's todos to an org file." + (interactive) + (todo/export-to-org todo/today) + (alert (string/concat "Exported today's TODOs to: " todo/org-file-path))) + +(provide 'todo) +;;; todo.el ends here diff --git a/emacs/.emacs.d/wpc/tree.el b/emacs/.emacs.d/wpc/tree.el new file mode 100644 index 0000000000..43df4dc500 --- /dev/null +++ b/emacs/.emacs.d/wpc/tree.el @@ -0,0 +1,193 @@ +;;; tree.el --- Working with Trees -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Some friendly functions that hopefully will make working with trees cheaper +;; and therefore more appealing! +;; +;; Tree terminology: +;; - leaf: node with zero children. +;; - root: node with zero parents. +;; - depth: measures a node's distance from the root node. This implies the +;; root node has a depth of zero. +;; - height: measures the longest traversal from a node to a leaf. This implies +;; that a leaf node has a height of zero. +;; - balanced? +;; +;; Tree variants: +;; - binary: the maximum number of children is two. +;; - binary search: the maximum number of children is two and left sub-trees are +;; lower in value than right sub-trees. +;; - rose: the number of children is variable. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'prelude) +(require 'list) +(require 'set) +(require 'tuple) +(require 'series) +(require 'random) +(require 'maybe) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(cl-defstruct tree xs) + +(cl-defstruct node value children) + +(cl-defun tree/node (value &optional children) + "Create a node struct of VALUE with CHILDREN." + (make-node :value value + :children children)) + +(defun tree/reduce-breadth (acc f xs) + "Reduce over XS breadth-first applying F to each x and ACC (in that order). +Breadth-first traversals guarantee to find the shortest path in a graph. + They're typically more difficult to implement than DFTs and may also incur + higher memory costs on average than their depth-first counterparts.") + +;; TODO: Support :order as 'pre | 'in | 'post. +;; TODO: Troubleshoot why I need defensive (nil? node) check. +(defun tree/reduce-depth (acc f node) + "Reduce over NODE depth-first applying F to each NODE and ACC. +F is called with each NODE, ACC, and the current depth. +Depth-first traversals have the advantage of typically consuming less memory + than their breadth-first equivalents would have. They're also typically + easier to implement using recursion. This comes at the cost of not + guaranteeing to be able to find the shortest path in a graph." + (cl-labels ((do-reduce-depth + (acc f node depth) + (let ((acc-new (funcall f node acc depth))) + (if (or (maybe/nil? node) + (tree/leaf? node)) + acc-new + (list/reduce + acc-new + (lambda (node acc) + (tree/do-reduce-depth + acc + f + node + (number/inc depth))) + (node-children node)))))) + (do-reduce-depth acc f node 0))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Helpers +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun tree/height (xs) + "Return the height of tree XS.") + +;; TODO: Troubleshoot why need for (nil? node). Similar misgiving +;; above. +(defun tree/leaf-depths (xs) + "Return a list of all of the depths of the leaf nodes in XS." + (list/reverse + (tree/reduce-depth + '() + (lambda (node acc depth) + (if (or (maybe/nil? node) + (tree/leaf? node)) + (list/cons depth acc) + acc)) + xs))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Generators +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; TODO: Consider parameterizing height, forced min-max branching, random +;; distributions, etc. + +;; TODO: Bail out before stack overflowing by consider branching, current-depth. + +(cl-defun tree/random (&optional (value-fn (lambda (_) nil)) + (branching-factor 2)) + "Randomly generate a tree with BRANCHING-FACTOR using VALUE-FN to compute the +node values. VALUE-FN is called with the current-depth of the node. Useful for +generating test data. Warning this function can overflow the stack." + (cl-labels ((do-random + (d vf bf) + (make-node + :value (funcall vf d) + :children (->> (series/range 0 (number/dec bf)) + (list/map + (lambda (_) + (when (random/boolean?) + (do-random d vf bf)))))))) + (do-random 0 value-fn branching-factor))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Predicates +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun tree/instance? (tree) + "Return t if TREE is a tree struct." + (node-p tree)) + +(defun tree/leaf? (node) + "Return t if NODE has no children." + (maybe/nil? (node-children node))) + +(defun tree/balanced? (n xs) + "Return t if the tree, XS, is balanced. +A tree is balanced if none of the differences between any two depths of two leaf + nodes in XS is greater than N." + (> n (->> xs + tree/leaf-depths + set/from-list + set/count + number/dec))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst tree/enable-testing? t + "When t, test suite runs.") + +;; TODO: Create set of macros for a proper test suite including: +;; - describe (arbitrarily nestable) +;; - it (arbitrarily nestable) +;; - line numbers for errors +;; - accumulated output for synopsis +;; - do we want describe *and* it? Why not a generic label that works for both? +(when tree/enable-testing? + (let ((tree-a (tree/node 1 + (list (tree/node 2 + (list (tree/node 5) + (tree/node 6))) + (tree/node 3 + (list (tree/node 7) + (tree/node 8))) + (tree/node 4 + (list (tree/node 9) + (tree/node 10)))))) + (tree-b (tree/node 1 + (list (tree/node 2 + (list (tree/node 5) + (tree/node 6))) + (tree/node 3) + (tree/node 4 + (list (tree/node 9) + (tree/node 10))))))) + ;; instance? + (prelude/assert (tree/instance? tree-a)) + (prelude/assert (tree/instance? tree-b)) + (prelude/refute (tree/instance? '(1 2 3))) + (prelude/refute (tree/instance? "oak")) + ;; balanced? + (prelude/assert (tree/balanced? 1 tree-a)) + (prelude/refute (tree/balanced? 1 tree-b)) + (message "Tests pass!"))) + +(provide 'tree) +;;; tree.el ends here diff --git a/emacs/.emacs.d/wpc/tuple.el b/emacs/.emacs.d/wpc/tuple.el new file mode 100644 index 0000000000..ccebf7299a --- /dev/null +++ b/emacs/.emacs.d/wpc/tuple.el @@ -0,0 +1,86 @@ +;;; tuple.el --- Tuple API for Elisp -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Work with cons cells with two elements with a familiar API for those who have +;; worked with tuples before. + +;;; Code: + +(cl-defstruct tuple first second) + +;; Create +(defun tuple/new () + "Return an empty tuple." + (make-tuple :first nil + :second nil)) + +(defun tuple/from (a b) + "Return a new tuple from A and B." + (make-tuple :first a + :second b)) + +(defun tuple/from-dotted (dp) + "Convert dotted pair, DP, into a tuple." + (tuple/from (car dp) (cdr dp))) + +;; Read +(defun tuple/first (pair) + "Return the first element of PAIR." + (tuple-first pair)) + +(defun tuple/second (pair) + "Return the second element of PAIR." + (tuple-second pair)) + +;; Update +(defun tuple/map-each (f g pair) + "Apply F to first, G to second in PAIR." + (->> pair + (tuple/map-first f) + (tuple/map-second g))) + +(defun tuple/map (f pair) + "Apply F to PAIR." + (let ((pair-copy (copy-tuple pair))) + (funcall f pair-copy))) + +(defun tuple/map-first (f pair) + "Apply function F to the first element of PAIR." + (let ((pair-copy (copy-tuple pair))) + (setf (tuple-first pair-copy) (funcall f (tuple/first pair-copy))) + pair-copy)) + +(defun tuple/map-second (f pair) + "Apply function F to the second element of PAIR." + (let ((pair-copy (copy-tuple pair))) + (setf (tuple-second pair-copy) (funcall f (tuple/second pair-copy))) + pair-copy)) + +(defun tuple/set-first (a pair) + "Return a new tuple with the first element set as A in PAIR." + (tuple/map-first (lambda (_) a) pair)) + +(defun tuple/set-second (b pair) + "Return a new tuple with the second element set as B in PAIR." + (tuple/map-second (lambda (_) b) pair)) + +;; Delete +(defun tuple/delete-first (pair) + "Return PAIR with the first element set to nil." + (tuple/set-first nil pair)) + +(defun tuple/delete-second (pair) + "Return PAIR with the second element set to nil." + (tuple/set-second nil pair)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Predicates +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun tuple/instance? (x) + "Return t if X is a tuple." + (tuple-p x)) + +(provide 'tuple) +;;; tuple.el ends here diff --git a/emacs/.emacs.d/wpc/vector.el b/emacs/.emacs.d/wpc/vector.el new file mode 100644 index 0000000000..6d2fe20d12 --- /dev/null +++ b/emacs/.emacs.d/wpc/vector.el @@ -0,0 +1,81 @@ +;;; vector.el --- Working with Elisp's Vector data type -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; It might be best to think of Elisp vectors as tuples in languages like +;; Haskell or Erlang. +;; +;; Not surprisingly, this API is modelled after Elixir's Tuple API. +;; +;; Some Elisp trivia: +;; - "Array": Usually means vector or string. +;; - "Sequence": Usually means list or "array" (see above). +;; +;; It might be a good idea to think of Array and Sequence as typeclasses in +;; Elisp. This is perhaps more similar to Elixir's notion of the Enum protocol. +;; +;; Intentionally not supporting a to-list function, because tuples can contain +;; heterogenous types whereas lists should contain homogenous types. + +;;; Code: + +;; TODO: Consider supporting an alias named tuple for vector. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst vector/enable-tests? t + "When t, run the tests defined herein.") + +;; TODO: Consider labelling variadic functions like `vector/concat*' +;; vs. `vector/concat'. +(defun vector/concat (&rest args) + "Return a new vector composed of all vectors in `ARGS'." + (apply #'vconcat args)) + +;; TODO: Here's a sketch of a protocol macro being consumed. +;; (definstance monoid vector +;; :empty (lambda () [])) + +(defun vector/prepend (x xs) + "Add `X' to the beginning of `XS'." + (vector/concat `[,x] xs)) + +(defun vector/append (x xs) + "Add `X' to the end of `XS'." + (vector/concat xs `[,x])) + +(defun vector/get (i xs) + "Return the value in `XS' at index, `I'." + (aref xs i)) + +(defun vector/set (i v xs) + "Set index `I' to value `V' in `XS'. +Returns a copy of `XS' with the updates." + (let ((copy (vconcat [] xs))) + (aset copy i v) + copy)) + +(defun vector/set! (i v xs) + "Set index `I' to value `V' in `XS'. +This function mutates XS." + (aset xs i v)) + +(when vector/enable-tests? + (let ((xs [1 2 3]) + (ys [1 2 3])) + (prelude/assert (= 1 (vector/get 0 ys))) + (vector/set 0 4 ys) + (prelude/assert (= 1 (vector/get 0 ys))) + (prelude/assert (= 1 (vector/get 0 xs))) + (vector/set! 0 4 xs) + (prelude/assert (= 4 (vector/get 0 xs))))) + +;; TODO: Decide between "remove" and "delete" as the appropriate verbs. +;; TODO: Implement this. +;; (defun vector/delete (i xs) +;; "Remove the element at `I' in `XS'.") + +(provide 'vector) +;;; vector.el ends here diff --git a/emacs/.emacs.d/wpc/wallpaper.el b/emacs/.emacs.d/wpc/wallpaper.el new file mode 100644 index 0000000000..9aa41cd364 --- /dev/null +++ b/emacs/.emacs.d/wpc/wallpaper.el @@ -0,0 +1,92 @@ +;;; wallpaper.el --- Control Linux desktop wallpaper -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Functions for setting desktop wallpaper. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'prelude) +(require 'fs) +(require 'cycle) +(require 'string) +(require 'general) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defcustom wallpaper/keybindings? t + "If non-nil, install the keybindings.") + +(defcustom wallpaper/path-to-dir + (f-expand "~/.local/share/wallpaper") + "Path to the images that will be used as the wallpaper.") + +(defconst wallpaper/whitelist + (cycle/from-list + (fs/ls wallpaper/path-to-dir t)) + "My preferred computer wallpapers.") + +(defun wallpaper/set (path) + "Set computer wallpaper to image at `PATH' using `feh` under-the-hood. +`PATH' can be absolute or relative since `f-expand' is called in the function + body to ensure feh can resolve the path." + (prelude/start-process + :name "wallpaper/set" + :command (string/format "feh --bg-scale --no-feh-bg %s" (f-expand path)))) + +(defun wallpaper/whitelist-set (wallpaper) + "Focuses the WALLPAPER in the `wallpaper/whitelist' cycle." + (cycle/focus (lambda (x) (equal x wallpaper)) wallpaper/whitelist) + (wallpaper/set (wallpaper/current))) + +(defun wallpaper/next () + "Cycles to the next wallpaper." + (interactive) + (let ((wallpaper (cycle/next wallpaper/whitelist))) + (wallpaper/set wallpaper) + (message (string/format "Active wallpaper: %s" (f-filename wallpaper))))) + +(defun wallpaper/prev () + "Cycles to the previous wallpaper." + (interactive) + (let ((wallpaper (cycle/prev wallpaper/whitelist))) + (wallpaper/set wallpaper) + (message (string/format "Active wallpaper: %s" (f-filename wallpaper))))) + +;; TODO: Define a macro that handles, next, prev, select, current for working +;; with cycles, since this is a common pattern. + +(defun wallpaper/print-current () + "Message the currently enabled wallpaper." + (interactive) + (message + (cycle/current wallpaper/whitelist))) + +(defun wallpaper/current () + "Return the currently enabled wallpaper." + (cycle/current wallpaper/whitelist)) + +(defun wallpaper/ivy-select () + "Use `counsel' to select and set a wallpaper from the `wallpaper/whitelist'." + (interactive) + (wallpaper/whitelist-set + (ivy-read "Select wallpaper: " (cycle/to-list wallpaper/whitelist)))) + +;; TODO: Create macro-based module system that will auto-namespace functions, +;; constants, etc. with the filename like `wallpaper'. + +(when wallpaper/keybindings? + (general-define-key + :prefix "" + :states '(normal) + "Fw" #'wallpaper/next + "Pw" #'wallpaper/prev)) + +(provide 'wallpaper) +;;; wallpaper.el ends here diff --git a/emacs/.emacs.d/wpc/window-manager.el b/emacs/.emacs.d/wpc/window-manager.el new file mode 100644 index 0000000000..cf7f1efeb7 --- /dev/null +++ b/emacs/.emacs.d/wpc/window-manager.el @@ -0,0 +1,647 @@ +;;; window-manager.el --- Functions augmenting my usage of EXWM. -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; I switched to EXWM from i3, and I haven't looked back. One day I may write a +;; poem declaring my love for Emacs and EXWM. For now, I haven't the time. + +;; Wish list: +;; - TODO: Support different startup commands and layouts depending on laptop or +;; desktop. +;; - TODO: Support a Music named-workspace. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'alert) +(require 'prelude) +(require 'string) +(require 'cycle) +(require 'set) +(require 'kbd) +(require 'ivy-helpers) +(require 'display) +(require 'dotfiles) +(require 'org-helpers) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; TODO: Move this function to another module. +(defun pkill (name) + "Call the pkill executable using NAME as its argument." + (interactive "sProcess name: ") + (call-process "pkill" nil nil nil name)) + +;; TODO: Associate `window-purpose' window-layouts with each of these named +;; workspaces. + +;; TODO: Associate KBDs for each of these named-layouts. + +;; TODO: Decide between window-manager, exwm, or some other namespace. + +;; TODO: Support (cycle/from-list '(current previous)) to toggle back and forth +;; between most recent workspace. + +;; TODO: Support ad hoc cycle for loading a few workspaces that can be cycled +;; between. (cycle/from-list '("Project" "Workspace")) + +;; TODO: Consider supporting a workspace for Racket, Clojure, Common Lisp, +;; Haskell, Elixir, and a few other languages. These could behave very similarly +;; to repl.it, which I've wanted to have locally for awhile now. + +;; TODO: Support MRU cache of workspaces for easily switching back-and-forth +;; between workspaces. + +(cl-defstruct exwm/named-workspace + label + index + kbd) + +(defconst exwm/install-workspace-kbds? t + "When t, install the keybindings to switch between named-workspaces.") + +;; TODO: Consume `cache/touch' after changing workspaces. Use this to enable +;; cycling through workspaces. + +(defconst exwm/named-workspaces + (list (make-exwm/named-workspace + :label "Web surfing" + :index 0 + :kbd "c") + (make-exwm/named-workspace + :label "Project" + :index 1 + :kbd "p") + (make-exwm/named-workspace + :label "Dotfiles" + :index 2 + :kbd "d") + (make-exwm/named-workspace + :label "Scratch" + :index 3 + :kbd "s") + (make-exwm/named-workspace + :label "Terminal" + :index 4 + :kbd "t") + (make-exwm/named-workspace + :label "Todos" + :index 5 + :kbd "o") + (make-exwm/named-workspace + :label "Chatter" + :index 6 + :kbd "h") + (make-exwm/named-workspace + :label "IRC" + :index 7 + :kbd "i") + (make-exwm/named-workspace + :label "Work" + :index 8 + :kbd "w")) + "List of `exwm/named-workspace' structs.") + +;; Assert that no two workspaces share KBDs. +(prelude/assert (= (list/length exwm/named-workspaces) + (->> exwm/named-workspaces + (list/map #'exwm/named-workspace-kbd) + set/from-list + set/count))) + +(defun window-manager/alert (x) + "Message X with a structured format." + (alert (string/concat "[exwm] " x))) + +;; Use Emacs as my primary window manager. +(use-package exwm + :config + (require 'exwm-config) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Multiple Displays + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (require 'exwm-randr) + (exwm-randr-enable) + ;; TODO: Consider generating this plist. + ;; TODO: Replace integer index values with their named workspace equivalents. + (setq exwm-randr-workspace-monitor-plist + (list 0 display/4k-monitor + 1 display/laptop-monitor)) + + (evil-set-initial-state 'exwm-mode 'emacs) + (ido-mode 1) + (exwm-config-ido) + (setq exwm-workspace-number + (list/length exwm/named-workspaces)) + ;; EXWM supports "line-mode" and "char-mode". + ;; + ;; Note: It appears that calling `exwm-input-set-key' works if it's called + ;; during startup. Once a session has started, it seems like this function is + ;; significantly less useful. Is this a bug? + ;; + ;; Glossary: + ;; - char-mode: All keystrokes except `exwm' global ones are passed to the + ;; application. + ;; - line-mode: + ;; + ;; `exwm-input-global-keys' = {line,char}-mode; can also call `exwm-input-set-key' + ;; `exwm-mode-map' = line-mode + ;; `???' = char-mode. Is there a mode-map for this? + ;; + ;; TODO: What is `exwm-input-prefix-keys'? + ;; TODO: Once I get `exwm-input-global-keys' functions, drop support for + ;; `wpc/kbds'. + (let ((kbds `( + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Window sizing + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (:key "C-M-=" :fn balance-windows) + ;; TODO: Make sure these don't interfere with LISP KBDs. + (:key "C-M-j" :fn shrink-window) + (:key "C-M-k" :fn enlarge-window) + (:key "C-M-h" :fn shrink-window-horizontally) + (:key "C-M-l" :fn enlarge-window-horizontally) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Window traversing + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (:key "M-h" :fn windmove-left) + (:key "M-j" :fn windmove-down) + (:key "M-k" :fn windmove-up) + (:key "M-l" :fn windmove-right) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Window splitting + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (:key "M-\\" :fn evil-window-vsplit) + (:key "M--" :fn evil-window-split) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Window deletion + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (:key "M-q" :fn delete-window) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Miscellaneous + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (:key "M-:" :fn eval-expression) + (:key "M-SPC" :fn window-manager/apps) + (:key "M-x" :fn counsel-M-x) + (:key "" :fn exwm/next-workspace) + (:key "" :fn exwm/prev-workspace) + (:key "" :fn exwm/prev-workspace) + ;; doesn't work in X11 windows. + (:key "" :fn exwm/ivy-switch) + (:key "C-M-\\" :fn ivy-pass) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; REPLs + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (:key ,(kbd/raw 'x11 "r") :fn exwm/ivy-find-or-create-repl) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Workspaces + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + ;; NOTE: Here I need to generate lowercase and uppercase + ;; variants of each because my Ergodox is sending capitalized + ;; variants of the keycodes to EXWM. + (:key ,(kbd/raw 'workspace "l") :fn window-manager/logout) + (:key ,(kbd/raw 'workspace "L") :fn window-manager/logout) + (:key ,(kbd/raw 'workspace "i") :fn exwm/toggle-mode) + (:key ,(kbd/raw 'workspace "I") :fn exwm/toggle-mode)))) + (setq exwm-input-global-keys + (->> kbds + (-map (lambda (plist) + `(,(kbd (plist-get plist :key)) . ,(plist-get plist :fn))))))) + (setq exwm-input-simulation-keys + ;; TODO: Consider supporting M-d and other readline style KBDs. + '(([?\C-b] . [left]) + ([?\M-b] . [C-left]) + ([?\C-f] . [right]) + ([?\M-f] . [C-right]) + ([?\C-p] . [up]) + ([?\C-n] . [down]) + ([?\C-a] . [home]) + ([?\C-e] . [end]) + ([?\C-d] . [delete]) + ;; TODO: Assess whether or not this is a good idea. + ;; TODO: Ensure C-c copies. + ([?\C-c] . [C-c]))) + (exwm-enable)) + +;; TODO: Package workspace management in another module. + +;; Here is the code required to allow EXWM to cycle workspaces. +(defconst exwm/workspaces + (->> exwm/named-workspaces + cycle/from-list) + "Cycle of the my EXWM workspaces.") + +(prelude/assert + (= exwm-workspace-number + (list/length exwm/named-workspaces))) + +(defun exwm/next-workspace () + "Cycle forwards to the next workspace." + (interactive) + (exwm/change-workspace (cycle/next exwm/workspaces))) + +(defun exwm/prev-workspace () + "Cycle backwards to the previous workspace." + (interactive) + (exwm/change-workspace (cycle/prev exwm/workspaces))) + +;; TODO: Create friendlier API for working with EXWM. + +;; Here is the code required to toggle EXWM's modes. +(defun exwm/line-mode () + "Switch exwm to line-mode." + (call-interactively #'exwm-input-grab-keyboard) + (window-manager/alert "Switched to line-mode")) + +(defun exwm/char-mode () + "Switch exwm to char-mode." + (call-interactively #'exwm-input-release-keyboard) + (window-manager/alert "Switched to char-mode")) + +(defconst exwm/modes + (cycle/from-list (list #'exwm/char-mode + #'exwm/line-mode)) + "Functions to switch exwm modes.") + +(defun exwm/toggle-mode () + "Switch between line- and char- mode." + (interactive) + (with-current-buffer (window-buffer) + (when (eq major-mode 'exwm-mode) + (funcall (cycle/next exwm/modes))))) + +;; Ensure exwm apps open in char-mode. +(add-hook + 'exwm-manage-finish-hook + #'exwm/char-mode) + +;; Interface to the Linux password manager +;; TODO: Consider writing a better client for this. +(use-package ivy-pass) + +;; TODO: Prefer a more idiomatic Emacs way like `with-output-to-temp-buffer'. + +;; TODO: Create a mode similar to `help-mode' that also kills the buffer when +;; "q" is pressed since this is sensitive information that we probably don't +;; want persisting. + +;; TODO: Have this interactively show all of the listings in ~/.password-store +;; in an ivy list. +(defun password-store/show (key) + "Show the contents of KEY from the password-store in a buffer." + (interactive) + (let ((b (buffer/find-or-create (string/format "*password-store<%s>*" key)))) + (with-current-buffer b + (insert (password-store-get key)) + (help-mode)) + (buffer/show b))) + +;; TODO: I'm having difficulties with the Nix-built terminator. The one at +;; /usr/bin/terminator (i.e. built w/o Nix) works just fine. Using this, +;; however, cheapens my Nix setup. +(defconst exwm/preferred-terminal "terminator" + "My preferred terminal.") + +;; TODO: How do I handle this dependency? +(defconst exwm/preferred-browser "google-chrome" + "My preferred web browser.") + +(defun exwm/browser-open (&optional url) + "Opens the URL in `exwm/preferred-browser'." + (exwm/open + (string/format "%s %s" exwm/preferred-browser url) + :buffer-name (string/format "*%s*<%s>" exwm/preferred-browser url) + :process-name url)) + +;; TODO: Consider storing local state of all processes started with this command +;; for some nice ways to cycle through existing terminals, etc. +(defun exwm/terminal-open (cmd) + "Call CMD using `exwm/preferred-terminal'." + (exwm/open (string/format + "%s --command '%s'" + exwm/preferred-terminal + cmd) + :buffer-name (string/format "*%s*<%s>" exwm/preferred-terminal cmd) + :process-name cmd)) + +;; TODO: Create a KBD that calls the `C-x b' I call often. +;; TODO: Consider auto-generating KBDs for spawning these using the first +;; character in their name. Also assert that none of the generated keybindings +;; will clash with one another. +(defconst exwm/repls + '(("python" . (lambda () (exwm/terminal-open "python3"))) + ("zsh" . (lambda () (exwm/terminal-open "zsh"))) + ("fish" . (lambda () (exwm/terminal-open "fish"))) + ("nix" . (lambda () (exwm/terminal-open "nix repl"))) + ("racket" . racket-repl) + ;; NOTE: `ielm' as-is is a find-or-create operation. + ("elisp" . ielm)) + "Mapping of REPL labels to the commands needed to initialize those REPLs.") + +;; NOTE: Some of these commands split the window already. Some of these +;; commands find-or-create already. +;; +;; Find-or-create: +;; +---+---+ +;; | Y | N | +;; +---+---+ +;; python | | x | +;; zsh | | x | +;; racket | x | | +;; elisp | x | | +;; +---+---+ +;; +;; Split: +;; +---+---+ +;; | Y | N | +;; +---+---+ +;; python | | x | +;; zsh | | x | +;; racket | x | | +;; elisp | | x | +;; +---+---+ + +;; - Split: +;; - racket +(defun exwm/ivy-find-or-create-repl () + "Select a type of REPL using `ivy' and then find-or-create it." + (interactive) + (ivy-helpers/kv "REPLs: " + exwm/repls + (lambda (_ v) + (funcall v)))) + +;; KBDs to quickly open X11 applications. +(general-define-key + ;; TODO: Eventually switch this to a find-or-create operation. In general, I + ;; shouldn't need multiple instances of `python3` REPLs. + ;; TODO: Consider coupling these KBDs with the `exwm/ivy-find-or-create-repl' + ;; functionality defined above. + (kbd/raw 'x11 "n") (lambda () + (interactive) + (exwm/terminal-open "nix repl")) + (kbd/raw 'x11 "p") (lambda () + (interactive) + (exwm/terminal-open "python3")) + (kbd/raw 'x11 "t") (lambda () + (interactive) + (exwm/open exwm/preferred-terminal)) + (kbd/raw 'x11 "c") (lambda () + (interactive) + (exwm/open exwm/preferred-browser))) + +;; TODO: Support searching all "launchable" applications like OSX's Spotlight. +;; TODO: Model this as key-value pairs. +(defconst window-manager/applications + (list "google-chrome --new-window --app=https://chat.google.com" + "google-chrome --new-window --app=https://calendar.google.com" + "google-chrome --new-window --app=https://gmail.com" + "telegram-desktop" + "google-chrome --new-window --app=https://teknql.slack.com" + "google-chrome --new-window --app=https://web.whatsapp.com" + "google-chrome --new-window --app=https://irccloud.com" + exwm/preferred-browser + exwm/preferred-terminal) + "Applications that I commonly use. +These are the types of items that would usually appear in dmenu.") + +;; TODO: Consider replacing the `ivy-read' call with something like `hydra' that +;; can provide a small mode for accepting user-input. +;; TODO: Put this somewhere more diliberate. + +;; TODO: Configure the environment variables for xsecurelock so that the font is +;; smaller, different, and the glinux wallpaper doesn't show. +;; - XSECURELOCK_FONT="InputMono-Black 10" +;; - XSECURE_SAVER="" +;; - XSECURE_LOGO_IMAGE="" +;; Maybe just create a ~/.xsecurelockrc +;; TODO: Is there a shell-command API that accepts an alist and serializes it +;; into variables to pass to the shell command? +(defconst window-manager/xsecurelock + "/usr/share/goobuntu-desktop-files/xsecurelock.sh" + "Path to the proper xsecurelock executable. +The other path to xsecurelock is /usr/bin/xsecurelock, which works fine, but it +is not optimized for Goobuntu devices. Goobuntu attempts to check a user's +password using the network. When there is no network connection available, the +login attempts fail with an \"unknown error\", which isn't very helpful. To +avoid this, prefer the goobuntu wrapper around xsecurelock when on a goobuntu +device. This all relates to PAM (i.e. pluggable authentication modules).") + +(defun window-manager/logout () + "Prompt the user for options for logging out, shutting down, etc. + +The following options are supported: +- Lock +- Logout +- Suspend +- Hibernate +- Reboot +- Shutdown + +Ivy is used to capture the user's input." + (interactive) + (let* ((name->cmd `(("Lock" . ,window-manager/xsecurelock) + ("Logout" . "sudo systemctl stop lightdm") + ("Suspend" . ,(string/concat + window-manager/xsecurelock + " && systemctl suspend")) + ("Hibernate" . ,(string/concat + window-manager/xsecurelock + " && systemctl hibernate")) + ("Reboot" . "systemctl reboot") + ("Shutdown" . "systemctl poweroff")))) + (funcall + (lambda () + (shell-command + (alist/get (ivy-read "System: " (alist/keys name->cmd)) + name->cmd)))))) + +(cl-defun exwm/open (command &key + (process-name command) + (buffer-name command)) + "Open COMMAND, which should be an X11 window." + (start-process-shell-command process-name buffer-name command)) + +(cl-defun window-manager/execute-from-counsel (&key prompt list) + "Display a counsel menu of `LIST' with `PROMPT' and pipe the output through +`start-process-shell-command'." + (let ((x (ivy-read prompt list))) + (exwm/open + x + :buffer-name (string/format "*exwm/open*<%s>" x) + :process-name x))) + +(defun window-manager/apps () + "Open commonly used applications from counsel." + (interactive) + (window-manager/execute-from-counsel + :prompt "Application: " + :list window-manager/applications)) + +(defun exwm/label->index (label workspaces) + "Return the index of the workspace in WORKSPACES named LABEL." + (let ((workspace (->> workspaces + (list/find + (lambda (x) + (equal label + (exwm/named-workspace-label x))))))) + (if (prelude/set? workspace) + (exwm/named-workspace-index workspace) + (error (string/concat "No workspace found for label: " label))))) + +(defun exwm/register-kbd (workspace) + "Registers a keybinding for WORKSPACE struct. +Currently using super- as the prefix for switching workspaces." + (let ((handler (lambda () + (interactive) + (exwm/switch (exwm/named-workspace-label workspace)))) + (key (exwm/named-workspace-kbd workspace))) + (exwm-input-set-key + (kbd/for 'workspace key) + handler) + ;; Note: We need to capitalize the KBD here because of the signals that my + ;; Ergodox is sending Emacs on my desktop. + (exwm-input-set-key + (kbd/for 'workspace (s-capitalize key)) + handler))) + +(defun exwm/change-workspace (workspace) + "Switch EXWM workspaces to the WORKSPACE struct." + (exwm-workspace-switch (exwm/named-workspace-index workspace)) + (window-manager/alert + (string/format "Switched to: %s" (exwm/named-workspace-label workspace)))) + +(defun exwm/switch (label) + "Switch to a named workspaces using LABEL." + (cycle/focus (lambda (x) + (equal label + (exwm/named-workspace-label x))) + exwm/workspaces) + (exwm/change-workspace (cycle/current exwm/workspaces))) + +;; TODO: Assign an easy-to-remember keybinding to this. +(exwm-input-set-key (kbd "C-S-f") #'exwm/toggle-previous) +(defun exwm/toggle-previous () + "Focus the previously active EXWM workspace." + (interactive) + (exwm/change-workspace (cycle/focus-previous! exwm/workspaces))) + +(defun exwm/ivy-switch () + "Use ivy to switched between named workspaces." + (interactive) + (ivy-read + "Workspace: " + (->> exwm/named-workspaces + (list/map #'exwm/named-workspace-label)) + :action #'exwm/switch)) + +(when exwm/install-workspace-kbds? + (progn + (->> exwm/named-workspaces + (list/map #'exwm/register-kbd)) + (window-manager/alert "Registered workspace KBDs!"))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Startup Applications in `exwm/named-workspaces' +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(add-hook + 'exwm-init-hook + (lambda () + ;; TODO: Refactor this into a bigger solution where the named-workspaces are + ;; coupled to their startup commands. Expedience wins this time. + (progn + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Chrome + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (progn + (exwm/switch "Web surfing") + ;; make sure this blocks. + ;; TODO: Support shell-cmd.el that has `shell-cmd/{sync,async}'. + ;; (call-process-shell-command "google-chrome") + ) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Project + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (progn + (exwm/switch "Project") + (find-file constants/current-project)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Scratch + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (progn + (exwm/switch "Scratch") + (switch-to-buffer "*scratch*")) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Terminal + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (progn + (exwm/switch "Terminal") + ;; TODO: Why does "gnome-terminal" work but not "terminator"? + ;; (call-process-shell-command "gnome-terminal") + ) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Todos + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (progn + (exwm/switch "Todos") + (org-helpers/find-file "today-expected.org") + (wpc/evil-window-vsplit-right) + (org-helpers/find-file "today-actual.org")) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Dotfiles + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (progn + (exwm/switch "Dotfiles") + (dotfiles/find-emacs-file "init.el") + (wpc/evil-window-vsplit-right) + (dotfiles/find-emacs-file "wpc/window-manager.el")) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Chatter + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (progn + (exwm/switch "Chatter") + ;; TODO: Support the following chat applications: + ;; - Slack teknql + ;; - irccloud.net + ;; - web.whatsapp.com + ;; - Telegram + ;; NOTE: Perhaps all of these should be borderless. + ;; (call-process-shell-command "terminator") + ) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Work + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (progn + (exwm/switch "Work") + ;; TODO: Support opening the following in chrome: + ;; - calendar + ;; - gmail + ;; - chat (in a horizontal split) + ) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Reset to default + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (exwm/switch "Dotfiles")))) + +(provide 'window-manager) +;;; window-manager.el ends here diff --git a/emacs/.emacs.d/wpc/window.el b/emacs/.emacs.d/wpc/window.el new file mode 100644 index 0000000000..132156bc44 --- /dev/null +++ b/emacs/.emacs.d/wpc/window.el @@ -0,0 +1,37 @@ +;;; window.el --- Working with Emacs windows -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Utilities to make CRUDing windows in Emacs easier. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'prelude) +(require 'macros) +(require 'maybe) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun window/find (name) + "Find a window by the NAME of the buffer it's hosting." + (let ((buffer (get-buffer name))) + (if (maybe/some? buffer) + (get-buffer-window buffer) + nil))) + +;; TODO: Find a way to incorporate these into function documentation. +(macros/comment + (window/find "*scratch*")) + +(defun window/delete (window) + "Delete the WINDOW reference." + (delete-window window)) + +(provide 'window) +;;; window.el ends here diff --git a/emacs/.emacs.d/wpc/wpc-clojure.el b/emacs/.emacs.d/wpc/wpc-clojure.el new file mode 100644 index 0000000000..d9262cdda8 --- /dev/null +++ b/emacs/.emacs.d/wpc/wpc-clojure.el @@ -0,0 +1,85 @@ +;;; clojure.el --- My Clojure preferences -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Hosting my Clojure tooling preferences + +;;; Code: + +;; Helper functions + +;; (defun wpc/buffer-name-for-clojure-mode (mode) +;; (let* ((project-name (projectile-project-name)) +;; (cljs-name (concat "*cider-repl CLJS " project-name "*")) +;; (clj-name (concat "*cider-repl " project-name "*"))) +;; (cond ((eq mode 'clojurescript-mode) cljs-name) +;; ((eq mode 'clojure-mode) clj-name) +;; ((eq mode 'clojurec-mode) cljs-name)))) + +;; (defun wpc/repl-function-for-clojure-mode (mode) +;; (let ((project-name (projectile-project-name)) +;; (cljs-fn #'cider-jack-in-clojurescript) +;; (clj-fn #'cider-jack-in)) +;; (cond ((eq mode 'clojurescript-mode) cljs-fn) +;; ((eq mode 'clojure-mode) clj-fn) +;; ((eq mode 'clojurec-mode) cljs-fn)))) + +;; (defun wpc/find-or-create-clojure-or-clojurescript-repl () +;; (interactive) +;; (with-current-buffer (current-buffer) +;; (let ((buffer-name (wpc/buffer-name-for-clojure-mode major-mode)) +;; (repl-function (wpc/repl-function-for-clojure-mode major-mode))) +;; (if (get-buffer buffer-name) +;; (switch-to-buffer buffer-name) +;; (funcall repl-function))))) + +(use-package clojure-mode + :config + ;; from Ryan Schmukler: + (setq cljr-magic-require-namespaces + '(("io" . "clojure.java.io") + ("sh" . "clojure.java.shell") + ("jdbc" . "clojure.java.jdbc") + ("set" . "clojure.set") + ("time" . "java-time") + ("str" . "cuerdas.core") + ("path" . "pathetic.core") + ("walk" . "clojure.walk") + ("zip" . "clojure.zip") + ("async" . "clojure.core.async") + ("component" . "com.stuartsierra.component") + ("http" . "clj-http.client") + ("url" . "cemerick.url") + ("sql" . "honeysql.core") + ("csv" . "clojure.data.csv") + ("json" . "cheshire.core") + ("s" . "clojure.spec.alpha") + ("fs" . "me.raynes.fs") + ("ig" . "integrant.core") + ("cp" . "com.climate.claypoole") + ("re-frame" . "re-frame.core") + ("rf" . "re-frame.core") + ("re" . "reagent.core") + ("reagent" . "reagent.core") + ("u.core" . "utopia.core") + ("gen" . "clojure.spec.gen.alpha")))) + +(use-package cider + :config + (general-define-key + :keymaps 'cider-repl-mode-map + "C-l" #'cider-repl-clear-buffer + "C-u" #'kill-whole-line + "" #'cider-repl-previous-input + "" #'cider-repl-next-input + ;; "C-c 'j" #'wpc/find-or-create-clojure-or-clojurescript-repl + ) + ;; (setq cider-cljs-lein-repl + ;; "(do (require 'figwheel-sidecar.repl-api) + ;; (figwheel-sidecar.repl-api/start-figwheel!) + ;; (figwheel-sidecar.repl-api/cljs-repl))" + ;; cider-prompt-for-symbol nil) + ) + +(provide 'wpc-clojure) +;;; wpc-clojure.el ends here diff --git a/emacs/.emacs.d/wpc/wpc-company.el b/emacs/.emacs.d/wpc/wpc-company.el new file mode 100644 index 0000000000..1152f496c2 --- /dev/null +++ b/emacs/.emacs.d/wpc/wpc-company.el @@ -0,0 +1,28 @@ +;;; company.el --- Autocompletion package, company, preferences -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Hosts my company mode preferences + +;;; Code: + +;; autocompletion client +(use-package company + :config + (general-define-key + :keymaps 'company-active-map + "C-j" #'company-select-next + "C-n" #'company-select-next + "C-k" #'company-select-previous + "C-p" #'company-select-previous + "C-d" #'company-show-doc-buffer) + (setq company-tooltip-align-annotations t) + (setq company-idle-delay 0) + (setq company-show-numbers t) + (setq company-minimum-prefix-length 2) + (setq company-dabbrev-downcase nil + company-dabbrev-ignore-case t) + (global-company-mode)) + +(provide 'wpc-company) +;;; wpc-company.el ends here diff --git a/emacs/.emacs.d/wpc/wpc-dired.el b/emacs/.emacs.d/wpc/wpc-dired.el new file mode 100644 index 0000000000..bc3915914b --- /dev/null +++ b/emacs/.emacs.d/wpc/wpc-dired.el @@ -0,0 +1,41 @@ +;;; dired.el --- My dired preferences -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; File management in Emacs, if learned and configured properly, should be +;; capable to reduce my dependency on the terminal. + +;;; Code: + +;; TODO: Ensure sorting in dired is by type. + +;; TODO: Rename wpc-dired.el to file-management.el + +(progn + (require 'dired) + (setq dired-recursive-copies 'always + dired-recursive-deletes 'top + dired-dwim-target t) + (general-define-key + :keymaps 'dired-mode-map + :states '(normal) + ;; Overriding some KBDs defined in the evil-collection module. + "o" #'dired-find-file-other-window + "" nil ;; This unblocks some of my leader-prefixed KBDs. + "s" nil ;; This unblocks my window-splitting KBDs. + "c" #'find-file + "f" #'wpc/find-file + "-" (lambda () (interactive) (find-alternate-file ".."))) + (general-add-hook 'dired-mode-hook + (list (enable dired-hide-details-mode) + #'auto-revert-mode))) + +(progn + (require 'locate) + (general-define-key + :keymaps 'locate-mode-map + :states 'normal + "o" #'dired-find-file-other-window)) + +(provide 'wpc-dired) +;;; wpc-dired.el ends here diff --git a/emacs/.emacs.d/wpc/wpc-docker.el b/emacs/.emacs.d/wpc/wpc-docker.el new file mode 100644 index 0000000000..270eaec6fe --- /dev/null +++ b/emacs/.emacs.d/wpc/wpc-docker.el @@ -0,0 +1,16 @@ +;;; docker.el --- Docker preferences -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; My Docker preferences and configuration + +;;; Code: + +(use-package docker + :config + (setenv "DOCKER_TLS_VERIFY" "1") + (setenv "DOCKER_HOST" "tcp://10.11.12.13:2376") + (setenv "DOCKER_MACHINE_NAME" "name")) + +(provide 'wpc-docker) +;;; wpc-docker.el ends here diff --git a/emacs/.emacs.d/wpc/wpc-elixir.el b/emacs/.emacs.d/wpc/wpc-elixir.el new file mode 100644 index 0000000000..e64abe70fc --- /dev/null +++ b/emacs/.emacs.d/wpc/wpc-elixir.el @@ -0,0 +1,13 @@ +;;; wpc-elixir.el --- Elixir / Erland configuration -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; My preferences for working with Elixir / Erlang projects + +;;; Code: +(use-package elixir-mode + :config + (add-hook-before-save 'elixir-mode-hook #'elixir-format)) + +(provide 'wpc-elixir) +;;; wpc-elixir.el ends here diff --git a/emacs/.emacs.d/wpc/wpc-flycheck.el b/emacs/.emacs.d/wpc/wpc-flycheck.el new file mode 100644 index 0000000000..d7bb834a62 --- /dev/null +++ b/emacs/.emacs.d/wpc/wpc-flycheck.el @@ -0,0 +1,14 @@ +;;; flycheck.el --- My flycheck configuration -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Hosts my Flycheck preferences + +;;; Code: + +(use-package flycheck + :config + (global-flycheck-mode)) + +(provide 'wpc-flycheck) +;;; wpc-flycheck.el ends here diff --git a/emacs/.emacs.d/wpc/wpc-haskell.el b/emacs/.emacs.d/wpc/wpc-haskell.el new file mode 100644 index 0000000000..e8ab16e585 --- /dev/null +++ b/emacs/.emacs.d/wpc/wpc-haskell.el @@ -0,0 +1,56 @@ +;;; haskell.el --- My Haskell preferences -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Hosts my Haskell development preferences + +;;; Code: + +;; Haskell support + +;; font-locking, glyph support, etc +(use-package haskell-mode + :config + (let ((m-symbols + '(("`mappend`" . "⊕") + ("<>" . "⊕")))) + (dolist (item m-symbols) (add-to-list 'haskell-font-lock-symbols-alist item))) + (setq haskell-font-lock-symbols t) + (add-hook-before-save 'haskell-mode #'haskell-align-imports)) + +;; LSP support +(use-package lsp-haskell + :after (haskell-mode) + :config + (setq lsp-haskell-process-path-hie "hie-wrapper") + (add-hook 'haskell-mode-hook #'lsp-haskell-enable) + (add-hook 'haskell-mode-hook #'flycheck-mode)) + +;; Test toggling +(defun haskell/module->test () + "Jump from a module to a test." + (let ((filename (->> buffer-file-name + (s-replace "/src/" "/test/") + (s-replace ".hs" "Test.hs") + find-file))) + (make-directory (f-dirname filename) t) + (find-file filename))) + +(defun haskell/test->module () + "Jump from a test to a module." + (let ((filename (->> buffer-file-name + (s-replace "/test/" "/src/") + (s-replace "Test.hs" ".hs") + ))) + (make-directory (f-dirname filename) t) + (find-file filename))) + +(defun haskell/test<->module () + "Toggle between test and module in Haskell." + (interactive) + (if (s-contains? "/src/" buffer-file-name) + (haskell/module->test) + (haskell/test->module))) + +(provide 'wpc-haskell) +;;; wpc-haskell.el ends here diff --git a/emacs/.emacs.d/wpc/wpc-java.el b/emacs/.emacs.d/wpc/wpc-java.el new file mode 100644 index 0000000000..4f33ba962e --- /dev/null +++ b/emacs/.emacs.d/wpc/wpc-java.el @@ -0,0 +1,42 @@ +;;; wpc-java.el --- Java configuration -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; When life gets you down, and you find yourself writing Java, remember: at +;; least you're using Emacs. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'prelude) +(require 'macros) + +(prelude/assert + (prelude/executable-exists? "google-java-format")) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Configuration +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; TODO: Troubleshoot why this isn't running. +(add-hook-before-save + 'java-mode-hook + (lambda () + (call-interactively + #'google-java-format))) + +(add-hook 'java-mode-hook + (lambda () + (setq c-basic-offset 2 + tab-width 2))) + +;; TODO: Figure out whether I should use this or google-emacs. +;; (use-package lsp-java +;; :config +;; (add-hook 'java-mode-hook #'lsp)) + +(provide 'wpc-java) +;;; wpc-java.el ends here diff --git a/emacs/.emacs.d/wpc/wpc-javascript.el b/emacs/.emacs.d/wpc/wpc-javascript.el new file mode 100644 index 0000000000..3de9fff3aa --- /dev/null +++ b/emacs/.emacs.d/wpc/wpc-javascript.el @@ -0,0 +1,83 @@ +;; wpc-javascript.el --- My Javascript preferences -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; This module hosts my Javascript tooling preferences. This also includes +;; tooling for TypeScript and other frontend tooling. Perhaps this module will +;; change names to more accurately reflect that. +;; +;; Depends +;; - yarn global add prettier + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Configuration +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Constants +(defconst wpc/js-hooks + '(js-mode-hook web-mode-hook typescript-mode-hook js2-mode-hook rjsx-mode-hook) + "All of the commonly used hooks for Javascript buffers.") + +(defconst wpc/frontend-hooks + (-insert-at 0 'css-mode-hook wpc/js-hooks) + "All of the commonly user hooks for frontend development.") + + +;; frontend indentation settings +(setq typescript-indent-level 2 + js-indent-level 2 + css-indent-offset 2) + +;; Flow for Javascript +(use-package add-node-modules-path + :config + (general-add-hook wpc/js-hooks #'add-node-modules-path)) + +(use-package web-mode + :mode "\\.html\\'" + :config + (setq web-mode-css-indent-offset 2) + (setq web-mode-code-indent-offset 2) + (setq web-mode-markup-indent-offset 2)) + +;; JSX highlighting +(use-package rjsx-mode + :mode "\\.js\\'" + :config + (general-unbind rjsx-mode-map "<" ">" "C-d") + (general-nmap + :keymaps 'rjsx-mode-map + "K" #'flow-minor-type-at-pos) + (setq js2-mode-show-parse-errors nil + js2-mode-show-strict-warnings nil)) + +(progn + (defun tide/setup () + (interactive) + (tide-setup) + (flycheck-mode 1) + (setq flycheck-check-syntax-automatically '(save mode-enabled)) + (eldoc-mode 1) + (tide-hl-identifier-mode 1) + (company-mode 1)) + (use-package tide + :config + (add-hook 'typescript-mode-hook #'tide/setup)) + (require 'web-mode) + (add-to-list 'auto-mode-alist '("\\.tsx\\'" . web-mode)) + (add-hook 'web-mode-hook + (lambda () + (when (string-equal "tsx" (f-ext buffer-file-name)) + (tide/setup)))) + (flycheck-add-mode 'typescript-tslint 'web-mode)) + +;; JS autoformatting +(use-package prettier-js + :after (rjsx-mode) + :config + (general-add-hook wpc/frontend-hooks #'prettier-js-mode)) + +(provide 'wpc-javascript) +;;; wpc-javascript.el ends here diff --git a/emacs/.emacs.d/wpc/wpc-keybindings.el b/emacs/.emacs.d/wpc/wpc-keybindings.el new file mode 100644 index 0000000000..2ff4fe3758 --- /dev/null +++ b/emacs/.emacs.d/wpc/wpc-keybindings.el @@ -0,0 +1,229 @@ +;;; keybindings.el --- My Evil preferences -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; This module hosts my Evil preferences +;; +;; Wish List: +;; - restore support for concise (n ) instead of `general-mmap' +;; - restore support for `general-unbind' + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'general) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Packages +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; This may be contraversial, but I never use the prefix key, and I'd prefer to +;; have to bound to the readline function that deletes the entire line. +(general-unbind "C-u") + +(use-package evil + :init + ;; Should remove the warning messages on init. + (setq evil-want-integration t) + ;; TODO: Troubleshoot why this binding causes the following warning: + ;; "Warning (evil-collection): `evil-want-keybinding' was set to nil but not + ;; before loading evil." + (setq evil-want-keybinding nil) + (general-evil-setup) + :config + ;; Ensure that evil's command mode behaves with readline bindings. + (general-define-key + :keymaps 'evil-ex-completion-map + "C-a" #'move-beginning-of-line + "C-e" #'move-end-of-line + "C-k" #'kill-line + "C-u" #'evil-delete-whole-line + "C-v" #'evil-paste-after + "C-d" #'delete-char + "C-f" #'forward-char + "M-b" #'backward-word + "M-f" #'forward-word + "M-d" #'kill-word + "M-DEL" #'backward-kill-word + "C-b" #'backward-char) + ;; TODO: Ensure all of my custom keybindings end up in a single map that is + ;; easy to enable or disable. + (general-mmap + :keymaps 'override + "RET" #'evil-goto-line + "H" #'evil-first-non-blank + "L" #'evil-end-of-line + "_" #'ranger + "-" #'dired-jump + "sl" #'wpc/evil-window-vsplit-right + "sh" #'evil-window-vsplit + "sk" #'evil-window-split + "sj" #'wpc/evil-window-split-down) + (general-nmap + :keymaps 'override + "gd" #'xref-find-definitions + ;; Wrapping `xref-find-references' in the `let' binding to prevent xref from + ;; prompting. There are other ways to handle this variable, such as setting + ;; it globally with `setq' or buffer-locally with `setq-local'. For now, I + ;; prefer setting it with `let', which should bind it in the dynamic scope + ;; for the duration of the `xref-find-references' function call. + "gx" (lambda () + (interactive) + (let ((xref-prompt-for-identifier nil)) + (call-interactively #'xref-find-references)))) + (general-unbind 'motion "M-." "C-p") + (general-unbind 'normal "s" "M-." "C-p" "C-n") + (general-unbind 'insert "C-v" "C-d" "C-a" "C-e" "C-n" "C-p" "C-k") + (setq evil-symbol-word-search t) + (evil-mode 1)) + +;; TODO: Write `evil-collection' KBDs for `refine'. +;; evil keybindings +(use-package evil-collection + :after (evil) + :config + (evil-collection-init)) + +;; `evil-collection' does not support `magit', and the preferred way to get evil +;; kbds for magit is with `evil-magit'. +(use-package evil-magit) + +;; TODO: Consider moving this to another module. +(general-define-key + :prefix "" + :states '(normal) + "i" #'counsel-semantic-or-imenu + "I" #'ibuffer + "hk" #'helpful-callable + "hf" #'helpful-function + "hm" #'helpful-macro + "hc" #'helpful-command + "hk" #'helpful-key + "hv" #'helpful-variable + "hp" #'helpful-at-point + "s" #'flyspell-mode + "S" #'sort-lines + "a" #'wpc-terminal/toggle + "=" #'align + "p" #'flycheck-previous-error + "f" #'wpc/find-file + "n" #'flycheck-next-error + "N" #'smerge-next + "W" #'balance-windows + "gs" #'magit-status + "E" #'refine + "es" #'wpc/create-snippet + ;; TODO: Replace with `macros/ilambda' when that is working again. + "ev" (lambda () (interactive) (wpc/find-file-split "~/.config/nvim/init.vim")) + "ee" (lambda () (interactive) (wpc/find-file-split "~/.emacs.d/init.el")) + "ez" (lambda () (interactive) (wpc/find-file-split "~/.zshrc")) + "ea" (lambda () (interactive) (wpc/find-file-split "~/aliases.zsh")) + "ef" (lambda () (interactive) (wpc/find-file-split "~/functions.zsh")) + "el" (lambda () (interactive) (wpc/find-file-split "~/variables.zsh")) + "ex" (lambda () (interactive) (wpc/find-file-split "~/.Xresources")) + "em" (lambda () (interactive) (wpc/find-file-split "~/.tmux.conf")) + "l" #'locate + "L" #'list-packages + "B" #'magit-blame + "w" #'save-buffer + "r" #'wpc/evil-replace-under-point + "R" #'deadgrep) + +;; create comments easily +(use-package evil-commentary + :after (evil) + :config + (evil-commentary-mode)) + +;; evil surround +(use-package evil-surround + :after (evil) + :config + (global-evil-surround-mode 1)) + +;; I expect in insert mode: +;; C-a: beginning-of-line +;; C-e: end-of-line +;; C-b: backwards-char +;; C-f: forwards-char + +;; TODO: Move these KBD constants to kbd.el. + +(defconst wpc/up-kbds + '("C-p" "C-k" "" "") + "The keybindings that I expect to work for moving upwards in lists.") + +(defconst wpc/down-kbds + '("C-n" "C-j" "" "") + "The keybindings that I expect to work for moving downwards in lists.") + +(defconst wpc/left-kbds + '("C-b" "") + "The keybindings that I expect to move leftwards in insert-like modes.") + +(defconst wpc/right-kbds + '("C-f" "") + "The keybindings that I expect to move rightwards in insert-like modes.") + +(defun wpc/ensure-kbds (_ignore) + "Try to ensure that my keybindings retain priority over other minor modes." + (unless (eq (caar minor-mode-map-alist) 'wpc/kbds-minor-mode) + (let ((mykbds (assq 'wpc/kbds-minor-mode minor-mode-map-alist))) + (assq-delete-all 'wpc/kbds-minor-mode minor-mode-map-alist) + (add-to-list 'minor-mode-map-alist mykbds)))) + +;; Custom minor mode that ensures that my kbds are available no matter which +;; major or minor modes are active. +(add-hook 'after-load-functions #'wpc/ensure-kbds) + +;; TODO: Prefer using general and 'override maps to implement this. +(defvar wpc/kbds + (let ((map (make-sparse-keymap))) + (bind-keys :map map + ("M-q" . delete-window) + ("" . toggle-frame-fullscreen) + ("M-h" . windmove-left) + ("M-l" . windmove-right) + ("M-k" . windmove-up) + ("M-j" . windmove-down) + ("M-q" . delete-window)) + map) + "William Carroll's keybindings that should have the highest precedence.") + +;; Support pasting in M-:. +(general-define-key + :keymaps 'read-expression-map + "C-v" #'clipboard-yank + "C-S-v" #'clipboard-yank) + +(define-minor-mode wpc/kbds-minor-mode + "A minor mode so that my key settings override annoying major modes." + :init-value t + :lighter " wpc/kbds" + :keymap wpc/kbds) + +;; allow jk to escape +(use-package key-chord + :after (evil) + :config + (key-chord-mode 1) + (key-chord-define evil-insert-state-map "jk" 'evil-normal-state)) + +;; Ensure the Evil search results get centered vertically. +;; TODO: Consider packaging this up for others. +(progn + (defadvice isearch-update + (before advice-for-isearch-update activate) + (evil-scroll-line-to-center (line-number-at-pos))) + (defadvice evil-search-next + (after advice-for-evil-search-next activate) + (evil-scroll-line-to-center (line-number-at-pos))) + (defadvice evil-search-previous + (after advice-for-evil-search-previous activate) + (evil-scroll-line-to-center (line-number-at-pos)))) + +(provide 'wpc-keybindings) +;;; wpc-keybindings.el ends here diff --git a/emacs/.emacs.d/wpc/wpc-lisp.el b/emacs/.emacs.d/wpc/wpc-lisp.el new file mode 100644 index 0000000000..1eeb8550a2 --- /dev/null +++ b/emacs/.emacs.d/wpc/wpc-lisp.el @@ -0,0 +1,111 @@ +;;; lisp.el --- Generic LISP preferences -*- lexical-binding: t -*- +;; Author: William Carroll + +;; parent (up) +;; child (down) +;; prev-sibling (left) +;; next-sibling (right) + +;;; Code: + +;; TODO: Consider having a separate module for each LISP dialect. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'general) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Configuration +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst wpc/lisp-mode-hooks + '(lisp-mode-hook + emacs-lisp-mode-hook + clojure-mode-hook + clojurescript-mode-hook + racket-mode-hook) + "List of LISP modes.") + +(use-package sly + :config + (setq inferior-lisp-program "sbcl") + (general-define-key + :keymaps 'sly-mode-map + :states '(normal) + :prefix "" + "x" #'sly-eval-defun + "X" #'sly-eval-buffer + "d" #'sly-describe-symbol)) + +(use-package rainbow-delimiters + :config + (general-add-hook wpc/lisp-mode-hooks #'rainbow-delimiters-mode)) + +(use-package racket-mode + :config + (general-define-key + :keymaps 'racket-mode-map + :states 'normal + :prefix "" + "x" #'racket-send-definition + "X" #'racket-run + "d" #'racket-describe) + (setq racket-program "~/.nix-profile/bin/racket")) + +(use-package lispyville + :init + (defconst lispyville-key-themes + '(c-w + operators + text-objects + prettify + commentary + slurp/barf-cp + wrap + additional + additional-insert + additional-wrap + escape) + "All available key-themes in Lispyville.") + :config + (general-add-hook wpc/lisp-mode-hooks #'lispyville-mode) + (lispyville-set-key-theme lispyville-key-themes) + (progn + (general-define-key + :keymaps 'lispyville-mode-map + :states 'motion + ;; first unbind + "M-h" nil + "M-l" nil) + (general-define-key + :keymaps 'lispyville-mode-map + :states 'normal + ;; first unbind + "M-j" nil + "M-k" nil + ;; second rebind + "C-s-h" #'lispyville-drag-backward + "C-s-l" #'lispyville-drag-forward + "C-s-e" #'lispyville-end-of-defun + "C-s-a" #'lispyville-beginning-of-defun))) + +;; Elisp +(use-package elisp-slime-nav + :config + (general-add-hook 'emacs-lisp-mode #'ielm-mode)) + +(general-define-key + :keymaps 'emacs-lisp-mode-map + :prefix "" + :states 'normal + "x" #'eval-defun + "X" #'eval-buffer + "d" (lambda () + (interactive) + (with-current-buffer (current-buffer) + (helpful-function (symbol-at-point))))) + +(provide 'wpc-lisp) +;;; wpc-lisp.el ends here diff --git a/emacs/.emacs.d/wpc/wpc-misc.el b/emacs/.emacs.d/wpc/wpc-misc.el new file mode 100644 index 0000000000..167c4b88ab --- /dev/null +++ b/emacs/.emacs.d/wpc/wpc-misc.el @@ -0,0 +1,248 @@ +;;; misc.el --- Hosting miscellaneous configuration -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; This is the home of any configuration that couldn't find a better home. + +;;; Code: + +;; Display time in the modeline +;; TODO: Save preferred date format strings and cycle through them since I waver +;; about which is my favorite. +(setq display-time-format "%R %a %d %b [%U of 52 weeks]") +(display-time-mode 1) + +;; disable custom variable entries from being written to ~/.emacs.d/init.el +(setq custom-file "~/.emacs.d/custom.el") +(load custom-file 'noerror) + +;; integrate Emacs with X11 clipboard +(setq select-enable-primary t) +(setq select-enable-clipboard t) +(general-def 'insert + "s-v" #'clipboard-yank + "C-S-v" #'clipboard-yank) + +;; transparently edit compressed files +(auto-compression-mode t) + +;; autowrap when over the fill-column +(setq-default auto-fill-function #'do-auto-fill) + +;; link to Emacs source code +;; TODO: Update this link. +(setq find-function-C-source-directory + "~/Dropbox/programming/emacs/src") + +;; change emacs prompts from "yes or no" -> "y or n" +(fset 'yes-or-no-p 'y-or-n-p) + +;; open photos in Emacs +(auto-image-file-mode 1) + +;; disable line-wrapping +(setq-default truncate-lines 1) + +;; shell file indentation +(setq sh-basic-offset 2) +(setq sh-indentation 2) + +;; Emacs library that interfaces with my Linux password manager. +(use-package password-store) + +;; Use en Emacs buffer as a REST client. +;; For more information: http://emacsrocks.com/e15.html +(use-package restclient) + +;; Run `package-lint' before publishing to MELPA. +(use-package package-lint) + +;; Parser combinators in Elisp. +(use-package parsec) + +;; disable company mode when editing markdown +;; TODO: move this out of wpc-misc.el and into a later file to call +;; `(disable company-mode)' +(use-package markdown-mode + :config + ;; TODO: Add assertion that pandoc is installed and it is accessible from + ;; Emacs. + (setq markdown-command "pandoc") + (setq markdown-split-window-direction 'right) + ;; (add-hook 'markdown-mode-hook #'markdown-live-preview-mode) + ) + +(use-package alert) + +(use-package refine) + +;; Required by some google-emacs package commands. +(use-package deferred) + +;; git integration +(use-package magit + :config + (setq magit-display-buffer-function + #'magit-display-buffer-fullframe-status-v1)) + +(use-package magit-popup) + +;; http +(use-package request) + +;; perl-compatible regular expressions +(use-package pcre2el) + +;; alternative to help +(use-package helpful) + +;; Emacs integration with direnv +(use-package direnv + :config + (direnv-mode)) + +;; Superior Elisp library for working with dates and times. +;; TODO: Put this where my other installations for dash.el, s.el, a.el, and +;; other utility Elisp libraries are located. +(use-package ts) + +;; persist history etc b/w Emacs sessions +(setq desktop-save 'if-exists) +(desktop-save-mode 1) +(setq desktop-globals-to-save + (append '((extended-command-history . 30) + (file-name-history . 100) + (grep-history . 30) + (compile-history . 30) + (minibuffer-history . 50) + (query-replace-history . 60) + (read-expression-history . 60) + (regexp-history . 60) + (regexp-search-ring . 20) + (search-ring . 20) + (shell-command-history . 50) + tags-file-name + register-alist))) + +;; config Emacs to use $PATH values +(use-package exec-path-from-shell + :if (memq window-system '(mac ns)) + :config + (exec-path-from-shell-initialize)) + +;; Emacs autosave, backup, interlocking files +(setq auto-save-default nil + make-backup-files nil + create-lockfiles nil) + +;; ensure code wraps at 80 characters by default +(setq-default fill-column constants/fill-column) + +(put 'narrow-to-region 'disabled nil) + +;; trim whitespace on save +(add-hook 'before-save-hook #'delete-trailing-whitespace) + +;; use tabs instead of spaces +(setq-default indent-tabs-mode nil) + +;; automatically follow symlinks +(setq vc-follow-symlinks t) + +;; fullscreen settings +(defvar ns-use-native-fullscreen nil) + +;; auto-close parens, brackets, quotes +(electric-pair-mode 1) + +(use-package yasnippet + :config + (setq yas-snippet-dirs '("~/.emacs.d/snippets/")) + (yas-global-mode 1)) + +(use-package projectile + :config + (projectile-mode t)) + +(use-package deadgrep + :config + (general-define-key + :keymaps 'deadgrep-mode-map + :states 'normal + "o" #'deadgrep-visit-result-other-window) + (setq-default deadgrep--context '(0 . 3)) + (defun deadgrep/region () + "Run a ripgrep search on the active region." + (interactive) + (deadgrep (region/to-string))) + (defun deadgrep/dwim () + "If a region is active, use that as the search, otherwise don't." + (interactive) + (with-current-buffer (current-buffer) + (if (region-active-p) + (setq deadgrep--additional-flags '("--multiline")) + (deadgrep/region) + (call-interactively #'deadgrep)))) + (advice-add + 'deadgrep--format-command + :filter-return + (lambda (cmd) + (replace-regexp-in-string + "^rg " "rg --hidden " cmd)))) + +;; TODO: Do I need this when I have swiper? +(use-package counsel) + +(use-package counsel-projectile) + +;; search Google, Stackoverflow from within Emacs +(use-package engine-mode + :config + (defengine google + "http://www.google.com/search?ie=utf-8&oe=utf-8&q=%s" + :keybinding "g") + (defengine stack-overflow + "https://stackoverflow.com/search?q=%s" + :keybinding "s")) + +;; EGlot (another LSP client) +(use-package eglot) + +;; Microsoft's Debug Adapter Protocol (DAP) +(use-package dap-mode + :after lsp-mode + :config + (dap-mode 1) + (dap-ui-mode 1)) + +;; Microsoft's Language Server Protocol (LSP) +(use-package lsp-ui + :config + (add-hook 'lsp-mode-hook #'lsp-ui-mode)) + +(use-package company-lsp + :config + (push 'company-lsp company-backends)) + +;; Wilfred/suggest.el - Tool for discovering functions basesd on declaring your +;; desired inputs and outputs. +(use-package suggest) + +;; Malabarba/paradox - Enhances the `list-packages' view. +(use-package paradox + :config + (paradox-enable)) + +;; TODO: Consider supporting a wpc-elisp.el package for Elisp tooling. +;; The following functions are quite useful for Elisp development: +;; - `emr-el-find-unused-definitions' +(use-package emr + :config + (define-key prog-mode-map (kbd "M-RET") #'emr-show-refactor-menu)) + +(defun wpc/frame-name () + "Return the name of the current frame." + (frame-parameter nil 'name)) + +(provide 'wpc-misc) +;;; wpc-misc.el ends here diff --git a/emacs/.emacs.d/wpc/wpc-nix.el b/emacs/.emacs.d/wpc/wpc-nix.el new file mode 100644 index 0000000000..68d542e011 --- /dev/null +++ b/emacs/.emacs.d/wpc/wpc-nix.el @@ -0,0 +1,56 @@ +;;; wpc-nix.el --- Nix support -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Configuration to support working with Nix. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(prelude/assert (f-exists? "~/universe")) +(prelude/assert (f-exists? "~/depot")) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Code: +(use-package nix-mode + :mode "\\.nix\\'") + +(defun nix/sly-from-universe (attribute) + "Start a Sly REPL configured with a Lisp matching a derivation + from my monorepo. + +This function was taken from @tazjin's depot and adapted for my monorepo. + + The derivation invokes nix.buildLisp.sbclWith and is built + asynchronously. The build output is included in the error + thrown on build failures." + (interactive "sAttribute: ") + (lexical-let* ((outbuf (get-buffer-create (format "*universe-out/%s*" attribute))) + (errbuf (get-buffer-create (format "*universe-errors/%s*" attribute))) + (expression (format "let depot = import {}; universe = import {}; in depot.nix.buildLisp.sbclWith [ universe.%s ]" attribute)) + (command (list "nix-build" "-E" expression))) + (message "Acquiring Lisp for .%s" attribute) + (make-process :name (format "depot-nix-build/%s" attribute) + :buffer outbuf + :stderr errbuf + :command command + :sentinel + (lambda (process event) + (unwind-protect + (pcase event + ("finished\n" + (let* ((outpath (s-trim (with-current-buffer outbuf (buffer-string)))) + (lisp-path (s-concat outpath "/bin/sbcl"))) + (message "Acquired Lisp for .%s at %s" attribute lisp-path) + (sly lisp-path))) + (_ (with-current-buffer errbuf + (error "Failed to build '%s':\n%s" attribute (buffer-string))))) + (kill-buffer outbuf) + (kill-buffer errbuf)))))) + +(provide 'wpc-nix) +;;; wpc-nix.el ends here diff --git a/emacs/.emacs.d/wpc/wpc-ocaml.el b/emacs/.emacs.d/wpc/wpc-ocaml.el new file mode 100644 index 0000000000..26add2d6f9 --- /dev/null +++ b/emacs/.emacs.d/wpc/wpc-ocaml.el @@ -0,0 +1,43 @@ +;;; wpc-ocaml.el --- My OCaml preferences -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Tooling support for OCaml development. +;; +;; Dependencies: +;; - `opam install tuareg` +;; - `opam install merlin` +;; - `opam install user-setup && opam user-setup install` +;; - `opam install ocamlformat` + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'prelude) +(require 'f) + +(prelude/assert + (prelude/executable-exists? "opam")) + +(defvar opam-user-setup "~/.emacs.d/opam-user-setup.el" + "File for the OPAM Emacs integration.") + +(prelude/assert (f-file? opam-user-setup)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Configuration +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(use-package tuareg + :config + (add-hook-before-save 'tuareg-mode-hook #'ocamlformat-before-save)) + +;; ocamlformat +(require 'opam-user-setup "~/.emacs.d/opam-user-setup.el") +(require 'ocamlformat) + +(provide 'wpc-ocaml) +;;; wpc-ocaml.el ends here diff --git a/emacs/.emacs.d/wpc/wpc-org.el b/emacs/.emacs.d/wpc/wpc-org.el new file mode 100644 index 0000000000..3263fb5038 --- /dev/null +++ b/emacs/.emacs.d/wpc/wpc-org.el @@ -0,0 +1,70 @@ +;;; org.el --- My org preferences -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Hosts my org mode preferences + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'f) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Configuration +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(setq org-directory "~/Dropbox/org") + +;; TODO: figure out how to nest this in (use-package org ...) +(setq org-capture-templates + `(("w" "work" entry (file+headline + ,(f-join org-directory "work.org") + "Tasks") + "* TODO %?") + ("p" "personal" entry (file+headline + ,(f-join org-directory "personal.org") + "Tasks") + "* TODO %? ") + ("i" "ideas" entry (file+headline + ,(f-join org-directory "ideas.org") + "Tasks") + "* %? ") + ("s" "shopping list" entry (file+headline + ,(f-join org-directory "shopping.org") + "Items") + "* TODO %? "))) + +(evil-set-initial-state 'org-mode 'normal) + +(use-package org + :config + (general-add-hook 'org-mode-hook + ;; TODO: consider supporting `(disable (list linum-mode company-mode))' + (list (disable linum-mode) + (disable company-mode))) + (general-define-key :prefix "C-c" + "l" #'org-store-link + "a" #'org-agenda + "c" #'org-capture) + (setq org-startup-folded nil) + (setq org-todo-keywords + '((sequence "TODO" "BLOCKED" "DONE"))) + (setq org-default-notes-file (f-join org-directory "notes.org")) + (setq org-agenda-files (list (f-join org-directory "work.org") + (f-join org-directory "personal.org"))) + ;; TODO: troubleshoot why `wpc/kbds-minor-mode', `wpc/ensure-kbds' aren't + ;; enough to override the following KBDs. See this discussion for more context + ;; on where the idea came from: + ;; https://stackoverflow.com/questions/683425/globally-override-key-binding-in-emacs + (general-unbind 'normal org-mode-map "M-h" "M-j" "M-k" "M-l")) + +(use-package org-bullets + :after (org) + :config + (general-add-hook 'org-mode-hook (enable org-bullets-mode))) + +(provide 'wpc-org) +;;; wpc-org.el ends here diff --git a/emacs/.emacs.d/wpc/wpc-package.el b/emacs/.emacs.d/wpc/wpc-package.el new file mode 100644 index 0000000000..5fd7a89982 --- /dev/null +++ b/emacs/.emacs.d/wpc/wpc-package.el @@ -0,0 +1,27 @@ +;;; package.el --- My package configuration -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; This module hosts all of the settings required to work with ELPA, +;; MELPA, QUELPA, and co. + +;;; Code: + +(require 'package) + +;; Even though we're packaging our Emacs with Nix, having MELPA registered is +;; helpful to ad-hoc test out packages before declaratively adding them to +;; emacs/default.nix. +(add-to-list 'package-archives '("melpa" . "http://melpa.org/packages/")) +(package-initialize) + +(unless (package-installed-p 'use-package) + ;; TODO: Consider removing this to improve initialization speed. + (package-refresh-contents) + (package-install 'use-package)) +(eval-when-compile + (require 'use-package)) +(use-package general) + +(provide 'wpc-package) +;;; wpc-package.el ends here diff --git a/emacs/.emacs.d/wpc/wpc-prolog.el b/emacs/.emacs.d/wpc/wpc-prolog.el new file mode 100644 index 0000000000..94e705b1b1 --- /dev/null +++ b/emacs/.emacs.d/wpc/wpc-prolog.el @@ -0,0 +1,16 @@ +;;; wpc-prolog.el --- For Prologging things -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Code configuring my Prolog work. + +;;; Code: + +(require 'macros) + +;; TODO: Notice that the .pl extension conflicts with Perl files. This may +;; become a problem should I start working with Perl. +(macros/support-file-extension "pl" prolog-mode) + +(provide 'wpc-prolog) +;;; wpc-prolog.el ends here diff --git a/emacs/.emacs.d/wpc/wpc-python.el b/emacs/.emacs.d/wpc/wpc-python.el new file mode 100644 index 0000000000..25f1a4816a --- /dev/null +++ b/emacs/.emacs.d/wpc/wpc-python.el @@ -0,0 +1,21 @@ +;;; wpc-python.el --- Python configuration -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; My Python configuration settings +;; +;; Depends +;; - `apti yapf` + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Configuration +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(use-package py-yapf + :config + (add-hook 'python-mode-hook #'py-yapf-enable-on-save)) + +(provide 'wpc-python) +;;; wpc-python.el ends here diff --git a/emacs/.emacs.d/wpc/wpc-reasonml.el b/emacs/.emacs.d/wpc/wpc-reasonml.el new file mode 100644 index 0000000000..909c33d121 --- /dev/null +++ b/emacs/.emacs.d/wpc/wpc-reasonml.el @@ -0,0 +1,29 @@ +;;; wpc-reasonml.el --- My ReasonML preferences -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Tooling support for ReasonML development. +;; +;; Dependencies: +;; - `opam install tuareg` +;; - `opam install merlin` +;; - `opam install user-setup` +;; - `opam install ocamlformat` + +;;; Code: + +;; ReasonML configuration +(use-package reason-mode + :config + (add-hook-before-save 'reason-mode-hook #'refmt-before-save)) + +;; ReasonML LSP configuration +(lsp-register-client + (make-lsp-client :new-connection (lsp-stdio-connection (f-full "~/programming/dependencies/reason-language-server")) + :major-modes '(reason-mode) + :notification-handlers (ht ("client/registerCapability" 'ignore)) + :priority 1 + :server-id 'reason-ls)) + +(provide 'wpc-reasonml) +;;; wpc-reasonml.el ends here diff --git a/emacs/.emacs.d/wpc/wpc-rust.el b/emacs/.emacs.d/wpc/wpc-rust.el new file mode 100644 index 0000000000..fafa27d18c --- /dev/null +++ b/emacs/.emacs.d/wpc/wpc-rust.el @@ -0,0 +1,34 @@ +;;; wpc-rust.el --- Support Rust language -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Supports my Rust work. +;; +;; Dependencies: +;; - `rustup` +;; - `rustup component add rust-src` +;; - `rustup toolchain add nightly && cargo +nightly install racer` + + +;;; Code: +(use-package racer + :config + (setq rust-sysroot (->> "~/.cargo/bin/rustc --print sysroot" + shell-command-to-string + s-trim-right)) + (setq racer-rust-src-path (f-join rust-sysroot "lib/rustlib/src/rust/src")) + (add-hook 'racer-mode-hook #'eldoc-mode)) + +(use-package rust-mode + :config + (add-hook 'rust-mode-hook #'racer-mode) + (add-hook-before-save 'rust-mode-hook #'rust-format-buffer) + (define-key rust-mode-map + (kbd "TAB") + #'company-indent-or-complete-common) + (define-key rust-mode-map + (kbd "M-d") + #'racer-describe)) + +(provide 'wpc-rust) +;;; wpc-rust.el ends here diff --git a/emacs/.emacs.d/wpc/wpc-shell.el b/emacs/.emacs.d/wpc/wpc-shell.el new file mode 100644 index 0000000000..803a3232ef --- /dev/null +++ b/emacs/.emacs.d/wpc/wpc-shell.el @@ -0,0 +1,17 @@ +;;; wpc-shell.el --- POSIX Shell scripting support -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Helpers for my shell scripting. Includes bash, zsh, etc. + +;;; Code: + +(use-package flymake-shellcheck + :commands flymake-shellcheck-load + :init + (add-hook 'sh-mode-hook #'flymake-shellcheck-load)) + +(use-package fish-mode) + +(provide 'wpc-shell) +;;; wpc-shell.el ends here diff --git a/emacs/.emacs.d/wpc/wpc-terminal.el b/emacs/.emacs.d/wpc/wpc-terminal.el new file mode 100644 index 0000000000..c232bb85a7 --- /dev/null +++ b/emacs/.emacs.d/wpc/wpc-terminal.el @@ -0,0 +1,70 @@ +;;; terminal.el --- My cobbled together terminal -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; My attempts at creating a sane Emacs terminal. Most of this work was created +;; before I discovered and fully adopted EXWM. Prior to this, the appeal of +;; having terminals inside of Emacs was appealing. So appealing in fact that I +;; was willing to work with inferior alternatives to non-Emacs terminals +;; (e.g. `ansi-term') instead of GUI alternatives like `alacritty` because the +;; productivity gains of having a terminal inside of Emacs might outweigh the +;; shortcomings of that particular terminal. +;; +;; All of this changed, however, after discovering EXWM, since I can embed X11 +;; GUI windows inside of Emacs. Therefore, most of this module is maintained +;; for historical purposes. +;; +;; Benefits of `ansi-term': +;; - Color scheme remains consistent between Emacs and terminal. +;; - Same applies to my fonts. +;; +;; Downsides of `ansi-term': +;; - Paging feels sluggish with programs like `cat` and `less`. +;; - KBDs don't provide 100% coverage of what I expect from a terminal since +;; they were created to cooperate with Emacs. + +;;; Code: + +(require 'window) +(require 'buffer) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; TODO: Model all open terminals within a dictionary. + +(defconst wpc-terminal/name + "wpc/terminal" + "The name of my terminal buffers.") + +(defun wpc-terminal/find-window () + "Return a reference to an existing terminal window or nil." + (->> wpc-terminal/name + wpc/add-earmuffs + window/find)) + +(defun wpc-terminal/find-buffer () + "Return a reference to an existing terminal buffer." + (->> wpc-terminal/name + wpc/add-earmuffs + buffer/find)) + +(defun wpc-terminal/find-or-create () + "Find or create a terminal window." + (let ((buffer (wpc-terminal/find-buffer))) + (if buffer + (buffer/show buffer) + (ansi-term "/usr/bin/zsh" wpc-terminal/name)))) + +;; TODO: Focus terminal after toggling it. +(defun wpc-terminal/toggle () + "Toggle a custom terminal session in Emacs." + (interactive) + (let ((window (wpc-terminal/find-window))) + (if window + (window/delete window) + (wpc-terminal/find-or-create)))) + +(provide 'wpc-terminal) +;;; wpc-terminal.el ends here diff --git a/emacs/.emacs.d/wpc/wpc-ui.el b/emacs/.emacs.d/wpc/wpc-ui.el new file mode 100644 index 0000000000..6ac587c465 --- /dev/null +++ b/emacs/.emacs.d/wpc/wpc-ui.el @@ -0,0 +1,179 @@ +;;; wpc-ui.el --- Any related to the UI/UX goes here -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; Hosts font settings, scrolling, color schemes. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'prelude) +(require 'alist) +(require 'themes) +(require 'device) +(require 'laptop-battery) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Configuration +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; increase line height +(setq-default line-spacing 4) + +;; Ensure that buffers update when their contents change on disk. +(global-auto-revert-mode t) + +;; smooth scrolling settings +(setq scroll-step 1 + scroll-conservatively 10000) + +;; clean up modeline +(use-package diminish + :config + (diminish 'emacs-lisp-mode "elisp") + (diminish 'evil-commentary-mode) + (diminish 'flycheck-mode) + (diminish 'auto-revert-mode) + (diminish 'which-key-mode) + (diminish 'yas-minor-mode) + (diminish 'lispyville-mode) + (diminish 'undo-tree-mode) + (diminish 'company-mode) + (diminish 'projectile-mode) + (diminish 'eldoc-mode) + ;; This is how to diminish `auto-fill-mode'. + (diminish 'auto-fill-function) + (diminish 'counsel-mode) + (diminish 'ivy-mode)) + +;; TODO: Further customize `mode-line-format' variable. +(delete 'mode-line-modes mode-line-format) +(delete '(vc-mode vc-mode) mode-line-format) + +;; disable startup screen +(setq inhibit-startup-screen t) + +;; disable toolbar +(tool-bar-mode -1) + +;; TODO: Re-enable `linum-mode' when I figure out why the theming is so ugly. +;; enable line numbers +;; (general-add-hook '(prog-mode-hook +;; text-mode-hook +;; conf-mode-hook) +;; (enable linum-mode)) + +;; set default buffer for Emacs +(setq initial-buffer-choice constants/current-project) + +;; TODO: Re-enable this when base16-wpgtk are looking better. +;; integration with wpgtk (in vendor directory) +;; (require 'wpgtk-theme) + +;; base-16 themes to integrate with wpgtk +;; (use-package base16-theme +;; :config +;; (require 'wpgtk) +;; (colorscheme/set 'base16-wpgtk)) + +;; premium Emacs themes +(use-package doom-themes + :config + (setq doom-themes-enable-bold t + doom-themes-enable-italic t) + (doom-themes-visual-bell-config) + (doom-themes-org-config)) + +;; file browsing +(use-package neotree + :config + (global-set-key [f8] #'neotree-toggle)) + +;; kbd discovery +(use-package which-key + :config + (setq which-key-idle-delay 0.25) + (which-key-mode)) + +;; completion framework +(use-package ivy + :config + (counsel-mode t) + (ivy-mode t) + (alist/set! #'counsel-M-x "" ivy-initial-inputs-alist) + ;; prefer using `helpful' variants + (progn + (setq counsel-describe-function-function #'helpful-callable) + (setq counsel-describe-variable-function #'helpful-variable)) + (general-define-key + :keymaps 'ivy-minibuffer-map + ;; prev + "C-k" #'ivy-previous-line + "" #'ivy-previous-line + ;; next + "C-j" #'ivy-next-line + "" #'ivy-next-line)) + +(use-package ivy-prescient + :config + (ivy-prescient-mode 1) + (prescient-persist-mode 1)) + +;; all-the-icons +(use-package all-the-icons + :config + (unless (f-exists? "~/.local/share/fonts/all-the-icons.ttf") + (all-the-icons-install-fonts))) + +;; icons for Ivy +(use-package all-the-icons-ivy + :after (ivy all-the-icons) + :config + (all-the-icons-ivy-setup)) + +;; disable menubar +(menu-bar-mode -1) + +;; reduce noisiness of auto-revert-mode +(setq auto-revert-verbose nil) + +;; highlight lines that are over `constants/fill-column' characters long +(use-package whitespace + :config + ;; TODO: This should change depending on the language and project. For + ;; example, Google Java projects prefer 100 character width instead of 80 + ;; character width. + (setq whitespace-line-column constants/fill-column) + (setq whitespace-style '(face lines-tail)) + (add-hook 'prog-mode-hook #'whitespace-mode)) + +;; dirname/filename instead of filename +(setq uniquify-buffer-name-style 'forward) + +;; highlight matching parens, brackets, etc +(show-paren-mode 1) + +;; hide the scroll-bars in the GUI +(scroll-bar-mode -1) + +;; TODO: Learn how to properly integrate this with dunst or another system-level +;; notification program. +;; GUI alerts in emacs +(use-package alert + :commands (alert) + :config + (setq alert-default-style 'notifier)) + +;; TODO: Should `device/work-laptop?' be a function or a constant that gets set +;; during initialization? +(when (device/work-laptop?) + (laptop-battery/display)) + +;; Load a theme +(themes/set "Solarized Light") + +(provide 'wpc-ui) +;;; wpc-ui.el ends here diff --git a/emacs/.emacs.d/wpc/wpgtk.el b/emacs/.emacs.d/wpc/wpgtk.el new file mode 100644 index 0000000000..432d828843 --- /dev/null +++ b/emacs/.emacs.d/wpc/wpgtk.el @@ -0,0 +1,45 @@ +;; wpgtk.el -- A base16 colorscheme template for wpgtk. + +;;; Commentary: + +;;; Authors: +;; Template: William Carroll + +;;; Code: + +(require 'base16-theme) +(require 'colorscheme) + +(defvar base16-wpgtk-colors + '(:base00 "#31213f" + :base01 "#E29B61" + :base02 "#E8C35F" + :base03 "#565B87" + :base04 "#A56785" + :base05 "#20A89E" + :base06 "#3CC2B5" + :base07 "#8de0e1" + :base08 "#629c9d" + :base09 "#E29B61" + :base0A "#E8C35F" + :base0B "#565B87" + :base0C "#A56785" + :base0D "#20A89E" + :base0E "#3CC2B5" + :base0F "#8de0e1") + "All colors for Base16 wpgtk are defined here.") + +;; Define the theme +(deftheme base16-wpgtk) + +;; Add all the faces to the theme +(base16-theme-define 'base16-wpgtk base16-wpgtk-colors) + +;; Mark the theme as provided +(provide-theme 'base16-wpgtk) + +(macros/comment + (colorscheme/set 'base16-wpgtk)) + +(provide 'wpgtk) +;;; wpgtk.el ends here diff --git a/emacs/.emacs.d/wpc/ynab.el b/emacs/.emacs.d/wpc/ynab.el new file mode 100644 index 0000000000..7e132e20c2 --- /dev/null +++ b/emacs/.emacs.d/wpc/ynab.el @@ -0,0 +1,56 @@ +;;; ynab.el --- Functions for YNAB's API -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; I'm not sure what the outcome of this project is. I'm just writing some +;; Elisp at the moment to document some of my cursory interactions with YNAB's +;; API. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'json) +(require 'a) +(require 'request) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar ynab/api-url "https://api.youneedabudget.com/v1/" + "The URL of the YNAB API.") + +(defun ynab/get-secret (name) + "Fetch and decrypt the secret for YNAB at NAME in the password store." + (password-store-get (format "%s/%s" "finance/youneedabudget.com" name))) + +(defvar ynab/personal-access-token + (ynab/get-secret "personal-access-token") + "My personal access token to YNAB's API.") + +(defvar ynab/budget-id + (ynab/get-secret "budget-id") + "The ID of my current budget on YNAB.") + +(defvar ynab/account-id + (ynab/get-secret "account-id") + "The ID of my current budget on YNAB.") + +(defun ynab/url-for-endpoint (endpoint) + "Return the URL for the YNAB ENDPOINT. +This will resolve any variables in the form of {variable_name} using a prefined +scope object." + (format "%s%s" ynab/api-url endpoint)) + +(macros/comment + ;; TODO: Use these this map to resolve variables in an endpoint URL like + ;; '/budgets/{budget_id}/'. + '((budget_id . (ynab/get-secret "budget-id")) + (account_id . (ynab/get-secret "account-id"))) + (request (ynab/url-for-endpoint "/budgets/{budget_id}/transactions"))) + +(provide 'ynab) +;;; ynab.el ends here diff --git a/emacs/.emacs.d/wpc/zle.el b/emacs/.emacs.d/wpc/zle.el new file mode 100644 index 0000000000..1b01da9384 --- /dev/null +++ b/emacs/.emacs.d/wpc/zle.el @@ -0,0 +1,90 @@ +;;; zle.el --- Functions to mimmick my ZLE KBDs -*- lexical-binding: t -*- +;; Author: William Carroll + +;;; Commentary: +;; This is primarily for personal use. The keybindings that I choose are those +;; that feel slightly mnemonic while also not shadowing important bindings. +;; It's quite possible that our tastes will differ here. +;; +;; All of these keybindings are intended to shave off milliseconds off your +;; typing. I don't expect these numbers to sum up to a meaningful amount. The +;; primary reason that I wrote this, is that it introduces a small amount of +;; structural editing to my workflow. I've been using these exact keybindings +;; on the command line, and I find them subtely delightful to use. So much so +;; that I decided to bring them to my Emacs configuration. +;; +;; ZLE is the Z-shell line editor. I have some KBDs and functions that I often +;; want in Emacs. +;; +;; Usage: +;; Consider running `(zle-minor-mode)' to run this globally. Depending on your +;; configuration, it could be non-disruptive, disruptive, or extremely +;; disruptive. +;; +;; TODO: Consider adding (general-unbind 'insert "C-v") herein. + +;;; Code: + +;; subshell (C-j) +(defun zle/subshell () + "Insert the characters necessary to create a subshell." + (interactive) + (insert-char ?$) + (insert-char ?\() + (save-excursion + (insert-char ?\)))) + +;; variable (C-v) +(defun zle/variable () + "Insert the characters to reference a variable." + (interactive) + (insert-char ?$) + (insert-char ?{) + (save-excursion + (insert-char ?}))) + +;; 2x dash (C-M--) +(defun zle/dash-dash () + "Insert the characters for flags with 2x dashes." + (interactive) + (insert-char ? ) + (insert-char ?-) + (insert-char ?-)) + +;; 1x quotes (M-') +(defun zle/single-quote () + "Insert the characters to quickly create single quotes." + (interactive) + (insert-char ? ) + (insert-char ?') + (save-excursion + (insert-char ?'))) + +;; 2x quotes (M-") +(defun zle/double-quote () + "Insert the characters to quickly create double quotes." + (interactive) + (insert-char ? ) + (insert-char ?\") + (save-excursion + (insert-char ?\"))) + +(defvar zle/kbds + (let ((map (make-sparse-keymap))) + (bind-keys :map map + ("C-j" . zle/subshell) + ("C-v" . zle/variable) + ("C-M--" . zle/dash-dash) + ("M-'" . zle/single-quote) + ("M-\"" . zle/double-quote)) + map) + "Keybindings shaving milliseconds off of typing.") + +(define-minor-mode zle-minor-mode + "A minor mode mirroring my ZLE keybindings." + :init-value nil + :lighter " zle" + :keymap zle/kbds) + +(provide 'zle) +;;; zle.el ends here diff --git a/emacs/default.nix b/emacs/default.nix new file mode 100644 index 0000000000..9ff5c1f2df --- /dev/null +++ b/emacs/default.nix @@ -0,0 +1,140 @@ +{ + pkgs ? import {}, + depot ? import {}, + ... +}: + +let + utils = import ~/briefcase/utils; + emacsBinPath = pkgs.lib.strings.makeBinPath [ pkgs.terminator ]; + emacsWithPackages = (pkgs.emacsPackagesNgGen pkgs.emacs26).emacsWithPackages; + wpcarrosEmacs = emacsWithPackages (epkgs: + (with epkgs.elpaPackages; [ + exwm + ]) ++ + + (with epkgs.melpaPackages; [ + base16-theme + ivy-pass + clipmon # TODO: Prefer an Emacs client for clipmenud. + protobuf-mode # TODO: Determine if this is coming from google-emacs. + # docker + evil + evil-collection + evil-magit + evil-commentary + evil-surround + key-chord + add-node-modules-path # TODO: Assess whether or not I need this with Nix. + web-mode + rjsx-mode + tide + prettier-js + flycheck + diminish + doom-themes + neotree # TODO: Remove this dependency from my config. + which-key + ivy + ivy-prescient + all-the-icons + all-the-icons-ivy + alert + nix-mode + racer + rust-mode + rainbow-delimiters + racket-mode + lispyville + elisp-slime-nav + py-yapf + reason-mode + elixir-mode + company + markdown-mode + refine + deferred + magit + request + pcre2el + helpful + exec-path-from-shell # TODO: Determine if Nix solves this problem. + yasnippet + projectile + deadgrep + counsel + counsel-projectile + engine-mode # TODO: Learn what this is. + eglot + dap-mode + lsp-ui + company-lsp + suggest + paradox + # emr + flymake-shellcheck + fish-mode + tuareg + haskell-mode + lsp-haskell + use-package + general + clojure-mode + cider + f + dash + company + counsel + flycheck + ivy + magit + ]) ++ + + (with depot.tools.emacs-pkgs; [ + dottime + term-switcher + ])); + +# TODO: Do I need `pkgs.lib.fix`? +in pkgs.lib.fix(self: l: f: pkgs.writeShellScriptBin "wpcarros-emacs" '' + # TODO: Is this the best way to handle environment variables using Nix? + export BRIEFCASE=$HOME/briefcase + export DEPOT=$HOME/depot + + export PATH="${emacsBinPath}:$PATH" + exec ${wpcarrosEmacs}/bin/emacs \ + --debug-init \ + --no-site-file \ + --no-site-lisp \ + --directory ${ ./.emacs.d/vendor } \ + --directory ${ ./.emacs.d/wpc } \ + --load ${ ./.emacs.d/wpc/wpc-package.el } \ + --load ${ ./.emacs.d/init.el } \ + --no-init-file $@ +'' // { + # TODO: Ascertain whether I need this. + overrideEmacs = f': self l f'; + + # Call with a local.el file containing local system configuration. + withLocalConfig = confDir: self confDir f; + + # This accepts the path to an Emacs binary outside of /nix/store. On gLinux, + # this will ensure that X and GL linkage behaves as expected. + withLocalEmacs = emacsBin: pkgs.writeShellScriptBin "wpcarros-emacs" '' + # TODO: Is this the best way to handle environment variables using Nix? + export BRIEFCASE=$HOME/briefcase + export DEPOT=$HOME/depot + + export PATH="${emacsBinPath}:$PATH" + export EMACSLOADPATH="${wpcarrosEmacs.deps}/share/emacs/site-lisp:" + exec ${emacsBin} \ + --debug-init \ + --no-site-file \ + --no-site-lisp \ + --directory ${ ./.emacs.d/vendor } \ + --directory ${ ./.emacs.d/wpc } \ + --load ${ ./.emacs.d/wpc/wpc-package.el } \ + --load ${ ./.emacs.d/init.el } \ + --no-init-file $@ + ''; +}) null utils.identity diff --git a/utils.nix b/utils.nix new file mode 100644 index 0000000000..1e1c5c2435 --- /dev/null +++ b/utils.nix @@ -0,0 +1,5 @@ +# Using this as a library to define some common utility functions that I often +# reach for. +{ + identity = x: x; +} -- cgit 1.4.1