diff options
| author | Stefan Monnier | 2013-09-19 16:51:33 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2013-09-19 16:51:33 -0400 |
| commit | c39cc7d149d28060c40bc206eb8a63f7a0636301 (patch) | |
| tree | 2eb70ddcce85f322b812c4ddab3452af73f4eb0a /lisp/eshell | |
| parent | a2c501b84eae05b1c7cb820537c12f201379648c (diff) | |
| download | emacs-c39cc7d149d28060c40bc206eb8a63f7a0636301.tar.gz emacs-c39cc7d149d28060c40bc206eb8a63f7a0636301.zip | |
* lisp/eshell/em-ls.el: Use advice. Remove redundant :group keywords.
(eshell-ls-orig-insert-directory): Remove.
(eshell-ls-unload-hook): Not a defcustom any more. Use advice-remove.
(eshell-ls-use-in-dired): Use advice-add/remove.
(eshell-ls--insert-directory): Rename from eshell-ls-insert-directory.
Add `orig-fun' arg for use in :around advice.
Make it check (redundantly) eshell-ls-use-in-dired.
Diffstat (limited to 'lisp/eshell')
| -rw-r--r-- | lisp/eshell/em-ls.el | 150 |
1 files changed, 60 insertions, 90 deletions
diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el index c2334d7bd74..16cc6a22008 100644 --- a/lisp/eshell/em-ls.el +++ b/lisp/eshell/em-ls.el | |||
| @@ -44,125 +44,102 @@ properties to colorize its output based on the setting of | |||
| 44 | 44 | ||
| 45 | ;;; User Variables: | 45 | ;;; User Variables: |
| 46 | 46 | ||
| 47 | (defvar eshell-ls-orig-insert-directory | ||
| 48 | (symbol-function 'insert-directory) | ||
| 49 | "Preserve the original definition of `insert-directory'.") | ||
| 50 | |||
| 51 | (defcustom eshell-ls-unload-hook | ||
| 52 | (list | ||
| 53 | (lambda () (fset 'insert-directory eshell-ls-orig-insert-directory))) | ||
| 54 | "When unloading `eshell-ls', restore the definition of `insert-directory'." | ||
| 55 | :type 'hook | ||
| 56 | :group 'eshell-ls) | ||
| 57 | |||
| 58 | (defcustom eshell-ls-date-format "%Y-%m-%d" | 47 | (defcustom eshell-ls-date-format "%Y-%m-%d" |
| 59 | "How to display time information in `eshell-ls-file'. | 48 | "How to display time information in `eshell-ls-file'. |
| 60 | This is passed to `format-time-string' as a format string. | 49 | This is passed to `format-time-string' as a format string. |
| 61 | To display the date using the current locale, use \"%b \%e\"." | 50 | To display the date using the current locale, use \"%b \%e\"." |
| 62 | :version "24.1" | 51 | :version "24.1" |
| 63 | :type 'string | 52 | :type 'string) |
| 64 | :group 'eshell-ls) | ||
| 65 | 53 | ||
| 66 | (defcustom eshell-ls-initial-args nil | 54 | (defcustom eshell-ls-initial-args nil |
| 67 | "If non-nil, this list of args is included before any call to `ls'. | 55 | "If non-nil, this list of args is included before any call to `ls'. |
| 68 | This is useful for enabling human-readable format (-h), for example." | 56 | This is useful for enabling human-readable format (-h), for example." |
| 69 | :type '(repeat :tag "Arguments" string) | 57 | :type '(repeat :tag "Arguments" string)) |
| 70 | :group 'eshell-ls) | ||
| 71 | 58 | ||
| 72 | (defcustom eshell-ls-dired-initial-args nil | 59 | (defcustom eshell-ls-dired-initial-args nil |
| 73 | "If non-nil, args is included before any call to `ls' in Dired. | 60 | "If non-nil, args is included before any call to `ls' in Dired. |
| 74 | This is useful for enabling human-readable format (-h), for example." | 61 | This is useful for enabling human-readable format (-h), for example." |
| 75 | :type '(repeat :tag "Arguments" string) | 62 | :type '(repeat :tag "Arguments" string)) |
| 76 | :group 'eshell-ls) | ||
| 77 | 63 | ||
| 78 | ;; FIXME should use advice, like ls-lisp.el does now. | ||
| 79 | (defcustom eshell-ls-use-in-dired nil | 64 | (defcustom eshell-ls-use-in-dired nil |
| 80 | "If non-nil, use `eshell-ls' to read directories in Dired. | 65 | "If non-nil, use `eshell-ls' to read directories in Dired. |
| 81 | Changing this without using customize has no effect." | 66 | Changing this without using customize has no effect." |
| 82 | :set (lambda (symbol value) | 67 | :set (lambda (symbol value) |
| 83 | (if value | 68 | (if value |
| 84 | (or (bound-and-true-p eshell-ls-use-in-dired) | 69 | (advice-add 'insert-directory :around |
| 85 | (fset 'insert-directory 'eshell-ls-insert-directory)) | 70 | #'eshell-ls--insert-directory) |
| 86 | (and (fboundp 'eshell-ls-insert-directory) eshell-ls-use-in-dired | 71 | (advice-remove 'insert-directory |
| 87 | (fset 'insert-directory eshell-ls-orig-insert-directory))) | 72 | #'eshell-ls--insert-directory)) |
| 88 | (set symbol value)) | 73 | (set symbol value)) |
| 89 | :type 'boolean | 74 | :type 'boolean |
| 90 | :require 'em-ls | 75 | :require 'em-ls) |
| 91 | :group 'eshell-ls) | 76 | (add-hook 'eshell-ls-unload-hook |
| 77 | (lambda () (advice-remove 'insert-directory | ||
| 78 | #'eshell-ls--insert-directory))) | ||
| 79 | |||
| 92 | 80 | ||
| 93 | (defcustom eshell-ls-default-blocksize 1024 | 81 | (defcustom eshell-ls-default-blocksize 1024 |
| 94 | "The default blocksize to use when display file sizes with -s." | 82 | "The default blocksize to use when display file sizes with -s." |
| 95 | :type 'integer | 83 | :type 'integer) |
| 96 | :group 'eshell-ls) | ||
| 97 | 84 | ||
| 98 | (defcustom eshell-ls-exclude-regexp nil | 85 | (defcustom eshell-ls-exclude-regexp nil |
| 99 | "Unless -a is specified, files matching this regexp will not be shown." | 86 | "Unless -a is specified, files matching this regexp will not be shown." |
| 100 | :type '(choice regexp (const nil)) | 87 | :type '(choice regexp (const nil))) |
| 101 | :group 'eshell-ls) | ||
| 102 | 88 | ||
| 103 | (defcustom eshell-ls-exclude-hidden t | 89 | (defcustom eshell-ls-exclude-hidden t |
| 104 | "Unless -a is specified, files beginning with . will not be shown. | 90 | "Unless -a is specified, files beginning with . will not be shown. |
| 105 | Using this boolean, instead of `eshell-ls-exclude-regexp', is both | 91 | Using this boolean, instead of `eshell-ls-exclude-regexp', is both |
| 106 | faster and conserves more memory." | 92 | faster and conserves more memory." |
| 107 | :type 'boolean | 93 | :type 'boolean) |
| 108 | :group 'eshell-ls) | ||
| 109 | 94 | ||
| 110 | (defcustom eshell-ls-use-colors t | 95 | (defcustom eshell-ls-use-colors t |
| 111 | "If non-nil, use colors in file listings." | 96 | "If non-nil, use colors in file listings." |
| 112 | :type 'boolean | 97 | :type 'boolean) |
| 113 | :group 'eshell-ls) | ||
| 114 | 98 | ||
| 115 | (defface eshell-ls-directory | 99 | (defface eshell-ls-directory |
| 116 | '((((class color) (background light)) (:foreground "Blue" :weight bold)) | 100 | '((((class color) (background light)) (:foreground "Blue" :weight bold)) |
| 117 | (((class color) (background dark)) (:foreground "SkyBlue" :weight bold)) | 101 | (((class color) (background dark)) (:foreground "SkyBlue" :weight bold)) |
| 118 | (t (:weight bold))) | 102 | (t (:weight bold))) |
| 119 | "The face used for highlight directories." | 103 | "The face used for highlight directories.") |
| 120 | :group 'eshell-ls) | ||
| 121 | (define-obsolete-face-alias 'eshell-ls-directory-face | 104 | (define-obsolete-face-alias 'eshell-ls-directory-face |
| 122 | 'eshell-ls-directory "22.1") | 105 | 'eshell-ls-directory "22.1") |
| 123 | 106 | ||
| 124 | (defface eshell-ls-symlink | 107 | (defface eshell-ls-symlink |
| 125 | '((((class color) (background light)) (:foreground "Dark Cyan" :weight bold)) | 108 | '((((class color) (background light)) (:foreground "Dark Cyan" :weight bold)) |
| 126 | (((class color) (background dark)) (:foreground "Cyan" :weight bold))) | 109 | (((class color) (background dark)) (:foreground "Cyan" :weight bold))) |
| 127 | "The face used for highlight symbolic links." | 110 | "The face used for highlight symbolic links.") |
| 128 | :group 'eshell-ls) | ||
| 129 | (define-obsolete-face-alias 'eshell-ls-symlink-face 'eshell-ls-symlink "22.1") | 111 | (define-obsolete-face-alias 'eshell-ls-symlink-face 'eshell-ls-symlink "22.1") |
| 130 | 112 | ||
| 131 | (defface eshell-ls-executable | 113 | (defface eshell-ls-executable |
| 132 | '((((class color) (background light)) (:foreground "ForestGreen" :weight bold)) | 114 | '((((class color) (background light)) (:foreground "ForestGreen" :weight bold)) |
| 133 | (((class color) (background dark)) (:foreground "Green" :weight bold))) | 115 | (((class color) (background dark)) (:foreground "Green" :weight bold))) |
| 134 | "The face used for highlighting executables (not directories, though)." | 116 | "The face used for highlighting executables (not directories, though).") |
| 135 | :group 'eshell-ls) | ||
| 136 | (define-obsolete-face-alias 'eshell-ls-executable-face | 117 | (define-obsolete-face-alias 'eshell-ls-executable-face |
| 137 | 'eshell-ls-executable "22.1") | 118 | 'eshell-ls-executable "22.1") |
| 138 | 119 | ||
| 139 | (defface eshell-ls-readonly | 120 | (defface eshell-ls-readonly |
| 140 | '((((class color) (background light)) (:foreground "Brown")) | 121 | '((((class color) (background light)) (:foreground "Brown")) |
| 141 | (((class color) (background dark)) (:foreground "Pink"))) | 122 | (((class color) (background dark)) (:foreground "Pink"))) |
| 142 | "The face used for highlighting read-only files." | 123 | "The face used for highlighting read-only files.") |
| 143 | :group 'eshell-ls) | ||
| 144 | (define-obsolete-face-alias 'eshell-ls-readonly-face 'eshell-ls-readonly "22.1") | 124 | (define-obsolete-face-alias 'eshell-ls-readonly-face 'eshell-ls-readonly "22.1") |
| 145 | 125 | ||
| 146 | (defface eshell-ls-unreadable | 126 | (defface eshell-ls-unreadable |
| 147 | '((((class color) (background light)) (:foreground "Grey30")) | 127 | '((((class color) (background light)) (:foreground "Grey30")) |
| 148 | (((class color) (background dark)) (:foreground "DarkGrey"))) | 128 | (((class color) (background dark)) (:foreground "DarkGrey"))) |
| 149 | "The face used for highlighting unreadable files." | 129 | "The face used for highlighting unreadable files.") |
| 150 | :group 'eshell-ls) | ||
| 151 | (define-obsolete-face-alias 'eshell-ls-unreadable-face | 130 | (define-obsolete-face-alias 'eshell-ls-unreadable-face |
| 152 | 'eshell-ls-unreadable "22.1") | 131 | 'eshell-ls-unreadable "22.1") |
| 153 | 132 | ||
| 154 | (defface eshell-ls-special | 133 | (defface eshell-ls-special |
| 155 | '((((class color) (background light)) (:foreground "Magenta" :weight bold)) | 134 | '((((class color) (background light)) (:foreground "Magenta" :weight bold)) |
| 156 | (((class color) (background dark)) (:foreground "Magenta" :weight bold))) | 135 | (((class color) (background dark)) (:foreground "Magenta" :weight bold))) |
| 157 | "The face used for highlighting non-regular files." | 136 | "The face used for highlighting non-regular files.") |
| 158 | :group 'eshell-ls) | ||
| 159 | (define-obsolete-face-alias 'eshell-ls-special-face 'eshell-ls-special "22.1") | 137 | (define-obsolete-face-alias 'eshell-ls-special-face 'eshell-ls-special "22.1") |
| 160 | 138 | ||
| 161 | (defface eshell-ls-missing | 139 | (defface eshell-ls-missing |
| 162 | '((((class color) (background light)) (:foreground "Red" :weight bold)) | 140 | '((((class color) (background light)) (:foreground "Red" :weight bold)) |
| 163 | (((class color) (background dark)) (:foreground "Red" :weight bold))) | 141 | (((class color) (background dark)) (:foreground "Red" :weight bold))) |
| 164 | "The face used for highlighting non-existent file names." | 142 | "The face used for highlighting non-existent file names.") |
| 165 | :group 'eshell-ls) | ||
| 166 | (define-obsolete-face-alias 'eshell-ls-missing-face 'eshell-ls-missing "22.1") | 143 | (define-obsolete-face-alias 'eshell-ls-missing-face 'eshell-ls-missing "22.1") |
| 167 | 144 | ||
| 168 | (defcustom eshell-ls-archive-regexp | 145 | (defcustom eshell-ls-archive-regexp |
| @@ -172,27 +149,23 @@ faster and conserves more memory." | |||
| 172 | This typically includes both traditional archives and compressed | 149 | This typically includes both traditional archives and compressed |
| 173 | files." | 150 | files." |
| 174 | :version "24.1" ; added xz | 151 | :version "24.1" ; added xz |
| 175 | :type 'regexp | 152 | :type 'regexp) |
| 176 | :group 'eshell-ls) | ||
| 177 | 153 | ||
| 178 | (defface eshell-ls-archive | 154 | (defface eshell-ls-archive |
| 179 | '((((class color) (background light)) (:foreground "Orchid" :weight bold)) | 155 | '((((class color) (background light)) (:foreground "Orchid" :weight bold)) |
| 180 | (((class color) (background dark)) (:foreground "Orchid" :weight bold))) | 156 | (((class color) (background dark)) (:foreground "Orchid" :weight bold))) |
| 181 | "The face used for highlighting archived and compressed file names." | 157 | "The face used for highlighting archived and compressed file names.") |
| 182 | :group 'eshell-ls) | ||
| 183 | (define-obsolete-face-alias 'eshell-ls-archive-face 'eshell-ls-archive "22.1") | 158 | (define-obsolete-face-alias 'eshell-ls-archive-face 'eshell-ls-archive "22.1") |
| 184 | 159 | ||
| 185 | (defcustom eshell-ls-backup-regexp | 160 | (defcustom eshell-ls-backup-regexp |
| 186 | "\\(\\`\\.?#\\|\\(\\.bak\\|~\\)\\'\\)" | 161 | "\\(\\`\\.?#\\|\\(\\.bak\\|~\\)\\'\\)" |
| 187 | "A regular expression that matches names of backup files." | 162 | "A regular expression that matches names of backup files." |
| 188 | :type 'regexp | 163 | :type 'regexp) |
| 189 | :group 'eshell-ls) | ||
| 190 | 164 | ||
| 191 | (defface eshell-ls-backup | 165 | (defface eshell-ls-backup |
| 192 | '((((class color) (background light)) (:foreground "OrangeRed")) | 166 | '((((class color) (background light)) (:foreground "OrangeRed")) |
| 193 | (((class color) (background dark)) (:foreground "LightSalmon"))) | 167 | (((class color) (background dark)) (:foreground "LightSalmon"))) |
| 194 | "The face used for highlighting backup file names." | 168 | "The face used for highlighting backup file names.") |
| 195 | :group 'eshell-ls) | ||
| 196 | (define-obsolete-face-alias 'eshell-ls-backup-face 'eshell-ls-backup "22.1") | 169 | (define-obsolete-face-alias 'eshell-ls-backup-face 'eshell-ls-backup "22.1") |
| 197 | 170 | ||
| 198 | (defcustom eshell-ls-product-regexp | 171 | (defcustom eshell-ls-product-regexp |
| @@ -200,14 +173,12 @@ files." | |||
| 200 | "A regular expression that matches names of product files. | 173 | "A regular expression that matches names of product files. |
| 201 | Products are files that get generated from a source file, and hence | 174 | Products are files that get generated from a source file, and hence |
| 202 | ought to be recreatable if they are deleted." | 175 | ought to be recreatable if they are deleted." |
| 203 | :type 'regexp | 176 | :type 'regexp) |
| 204 | :group 'eshell-ls) | ||
| 205 | 177 | ||
| 206 | (defface eshell-ls-product | 178 | (defface eshell-ls-product |
| 207 | '((((class color) (background light)) (:foreground "OrangeRed")) | 179 | '((((class color) (background light)) (:foreground "OrangeRed")) |
| 208 | (((class color) (background dark)) (:foreground "LightSalmon"))) | 180 | (((class color) (background dark)) (:foreground "LightSalmon"))) |
| 209 | "The face used for highlighting files that are build products." | 181 | "The face used for highlighting files that are build products.") |
| 210 | :group 'eshell-ls) | ||
| 211 | (define-obsolete-face-alias 'eshell-ls-product-face 'eshell-ls-product "22.1") | 182 | (define-obsolete-face-alias 'eshell-ls-product-face 'eshell-ls-product "22.1") |
| 212 | 183 | ||
| 213 | (defcustom eshell-ls-clutter-regexp | 184 | (defcustom eshell-ls-clutter-regexp |
| @@ -215,14 +186,12 @@ ought to be recreatable if they are deleted." | |||
| 215 | "A regular expression that matches names of junk files. | 186 | "A regular expression that matches names of junk files. |
| 216 | These are mainly files that get created for various reasons, but don't | 187 | These are mainly files that get created for various reasons, but don't |
| 217 | really need to stick around for very long." | 188 | really need to stick around for very long." |
| 218 | :type 'regexp | 189 | :type 'regexp) |
| 219 | :group 'eshell-ls) | ||
| 220 | 190 | ||
| 221 | (defface eshell-ls-clutter | 191 | (defface eshell-ls-clutter |
| 222 | '((((class color) (background light)) (:foreground "OrangeRed" :weight bold)) | 192 | '((((class color) (background light)) (:foreground "OrangeRed" :weight bold)) |
| 223 | (((class color) (background dark)) (:foreground "OrangeRed" :weight bold))) | 193 | (((class color) (background dark)) (:foreground "OrangeRed" :weight bold))) |
| 224 | "The face used for highlighting junk file names." | 194 | "The face used for highlighting junk file names.") |
| 225 | :group 'eshell-ls) | ||
| 226 | (define-obsolete-face-alias 'eshell-ls-clutter-face 'eshell-ls-clutter "22.1") | 195 | (define-obsolete-face-alias 'eshell-ls-clutter-face 'eshell-ls-clutter "22.1") |
| 227 | 196 | ||
| 228 | (defsubst eshell-ls-filetype-p (attrs type) | 197 | (defsubst eshell-ls-filetype-p (attrs type) |
| @@ -263,8 +232,7 @@ The format of the members of this alist is | |||
| 263 | If TEST-SEXP evals to non-nil, that face will be used to highlight the | 232 | If TEST-SEXP evals to non-nil, that face will be used to highlight the |
| 264 | name of the file. The first match wins. `file' and `attrs' are in | 233 | name of the file. The first match wins. `file' and `attrs' are in |
| 265 | scope during the evaluation of TEST-SEXP." | 234 | scope during the evaluation of TEST-SEXP." |
| 266 | :type '(repeat (cons function face)) | 235 | :type '(repeat (cons function face))) |
| 267 | :group 'eshell-ls) | ||
| 268 | 236 | ||
| 269 | (defvar block-size) | 237 | (defvar block-size) |
| 270 | (defvar dereference-links) | 238 | (defvar dereference-links) |
| @@ -287,8 +255,8 @@ scope during the evaluation of TEST-SEXP." | |||
| 287 | 255 | ||
| 288 | ;;; Functions: | 256 | ;;; Functions: |
| 289 | 257 | ||
| 290 | (defun eshell-ls-insert-directory | 258 | (defun eshell-ls--insert-directory |
| 291 | (file switches &optional wildcard full-directory-p) | 259 | (orig-fun file switches &optional wildcard full-directory-p) |
| 292 | "Insert directory listing for FILE, formatted according to SWITCHES. | 260 | "Insert directory listing for FILE, formatted according to SWITCHES. |
| 293 | Leaves point after the inserted text. | 261 | Leaves point after the inserted text. |
| 294 | SWITCHES may be a string of options, or a list of strings. | 262 | SWITCHES may be a string of options, or a list of strings. |
| @@ -299,29 +267,31 @@ switches do not contain `d', so that a full listing is expected. | |||
| 299 | This version of the function uses `eshell/ls'. If any of the switches | 267 | This version of the function uses `eshell/ls'. If any of the switches |
| 300 | passed are not recognized, the operating system's version will be used | 268 | passed are not recognized, the operating system's version will be used |
| 301 | instead." | 269 | instead." |
| 302 | (let ((handler (find-file-name-handler file 'insert-directory))) | 270 | (if (not eshell-ls-use-in-dired) |
| 303 | (if handler | 271 | (funcall orig-fun file switches wildcard full-directory-p) |
| 304 | (funcall handler 'insert-directory file switches | 272 | (let ((handler (find-file-name-handler file 'insert-directory))) |
| 305 | wildcard full-directory-p) | 273 | (if handler |
| 306 | (if (stringp switches) | 274 | (funcall handler 'insert-directory file switches |
| 307 | (setq switches (split-string switches))) | 275 | wildcard full-directory-p) |
| 308 | (let (eshell-current-handles | 276 | (if (stringp switches) |
| 309 | eshell-current-subjob-p | 277 | (setq switches (split-string switches))) |
| 310 | font-lock-mode) | 278 | (let (eshell-current-handles |
| 311 | ;; use the fancy highlighting in `eshell-ls' rather than font-lock | 279 | eshell-current-subjob-p |
| 312 | (when (and eshell-ls-use-colors | 280 | font-lock-mode) |
| 313 | (featurep 'font-lock)) | 281 | ;; use the fancy highlighting in `eshell-ls' rather than font-lock |
| 314 | (font-lock-mode -1) | 282 | (when (and eshell-ls-use-colors |
| 315 | (setq font-lock-defaults nil) | 283 | (featurep 'font-lock)) |
| 316 | (if (boundp 'font-lock-buffers) | 284 | (font-lock-mode -1) |
| 317 | (set 'font-lock-buffers | 285 | (setq font-lock-defaults nil) |
| 318 | (delq (current-buffer) | 286 | (if (boundp 'font-lock-buffers) |
| 319 | (symbol-value 'font-lock-buffers))))) | 287 | (set 'font-lock-buffers |
| 320 | (let ((insert-func 'insert) | 288 | (delq (current-buffer) |
| 321 | (error-func 'insert) | 289 | (symbol-value 'font-lock-buffers))))) |
| 322 | (flush-func 'ignore) | 290 | (let ((insert-func 'insert) |
| 323 | eshell-ls-dired-initial-args) | 291 | (error-func 'insert) |
| 324 | (eshell-do-ls (append switches (list file)))))))) | 292 | (flush-func 'ignore) |
| 293 | eshell-ls-dired-initial-args) | ||
| 294 | (eshell-do-ls (append switches (list file))))))))) | ||
| 325 | 295 | ||
| 326 | (defsubst eshell/ls (&rest args) | 296 | (defsubst eshell/ls (&rest args) |
| 327 | "An alias version of `eshell-do-ls'." | 297 | "An alias version of `eshell-do-ls'." |