aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/eshell
diff options
context:
space:
mode:
authorStefan Monnier2013-09-19 16:51:33 -0400
committerStefan Monnier2013-09-19 16:51:33 -0400
commitc39cc7d149d28060c40bc206eb8a63f7a0636301 (patch)
tree2eb70ddcce85f322b812c4ddab3452af73f4eb0a /lisp/eshell
parenta2c501b84eae05b1c7cb820537c12f201379648c (diff)
downloademacs-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.el150
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'.
60This is passed to `format-time-string' as a format string. 49This is passed to `format-time-string' as a format string.
61To display the date using the current locale, use \"%b \%e\"." 50To 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'.
68This is useful for enabling human-readable format (-h), for example." 56This 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.
74This is useful for enabling human-readable format (-h), for example." 61This 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.
81Changing this without using customize has no effect." 66Changing 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.
105Using this boolean, instead of `eshell-ls-exclude-regexp', is both 91Using this boolean, instead of `eshell-ls-exclude-regexp', is both
106faster and conserves more memory." 92faster 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."
172This typically includes both traditional archives and compressed 149This typically includes both traditional archives and compressed
173files." 150files."
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.
201Products are files that get generated from a source file, and hence 174Products are files that get generated from a source file, and hence
202ought to be recreatable if they are deleted." 175ought 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.
216These are mainly files that get created for various reasons, but don't 187These are mainly files that get created for various reasons, but don't
217really need to stick around for very long." 188really 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
263If TEST-SEXP evals to non-nil, that face will be used to highlight the 232If TEST-SEXP evals to non-nil, that face will be used to highlight the
264name of the file. The first match wins. `file' and `attrs' are in 233name of the file. The first match wins. `file' and `attrs' are in
265scope during the evaluation of TEST-SEXP." 234scope 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.
293Leaves point after the inserted text. 261Leaves point after the inserted text.
294SWITCHES may be a string of options, or a list of strings. 262SWITCHES 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.
299This version of the function uses `eshell/ls'. If any of the switches 267This version of the function uses `eshell/ls'. If any of the switches
300passed are not recognized, the operating system's version will be used 268passed are not recognized, the operating system's version will be used
301instead." 269instead."
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'."