* 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.

lisp/ChangeLog

@@ -1,3 +1,13 @@
+2013-09-19  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	* 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.
+
 2013-09-19  Glenn Morris  <rgm@gnu.org>
 
 	* emacs-lisp/cl-macs.el (cl-defsubst): Remove unused local `pbody'.

lisp/eshell/em-ls.el

@@ -44,125 +44,102 @@ properties to colorize its output based on the setting of
 
 ;;; User Variables:
 
-(defvar eshell-ls-orig-insert-directory
-  (symbol-function 'insert-directory)
-  "Preserve the original definition of `insert-directory'.")
-
-(defcustom eshell-ls-unload-hook
-  (list
-   (lambda () (fset 'insert-directory eshell-ls-orig-insert-directory)))
-  "When unloading `eshell-ls', restore the definition of `insert-directory'."
-  :type 'hook
-  :group 'eshell-ls)
-
 (defcustom eshell-ls-date-format "%Y-%m-%d"
   "How to display time information in `eshell-ls-file'.
 This is passed to `format-time-string' as a format string.
 To display the date using the current locale, use \"%b \%e\"."
   :version "24.1"
-  :type 'string
+  :type 'string)
-  :group 'eshell-ls)
 
 (defcustom eshell-ls-initial-args nil
   "If non-nil, this list of args is included before any call to `ls'.
 This is useful for enabling human-readable format (-h), for example."
-  :type '(repeat :tag "Arguments" string)
+  :type '(repeat :tag "Arguments" string))
-  :group 'eshell-ls)
 
 (defcustom eshell-ls-dired-initial-args nil
   "If non-nil, args is included before any call to `ls' in Dired.
 This is useful for enabling human-readable format (-h), for example."
-  :type '(repeat :tag "Arguments" string)
+  :type '(repeat :tag "Arguments" string))
-  :group 'eshell-ls)
 
-;; FIXME should use advice, like ls-lisp.el does now.
 (defcustom eshell-ls-use-in-dired nil
   "If non-nil, use `eshell-ls' to read directories in Dired.
 Changing this without using customize has no effect."
   :set (lambda (symbol value)
 	 (if value
-	     (or (bound-and-true-p eshell-ls-use-in-dired)
+             (advice-add 'insert-directory :around
-		 (fset 'insert-directory 'eshell-ls-insert-directory))
+                         #'eshell-ls--insert-directory)
-	   (and (fboundp 'eshell-ls-insert-directory) eshell-ls-use-in-dired
+           (advice-remove 'insert-directory
-		(fset 'insert-directory eshell-ls-orig-insert-directory)))
+                          #'eshell-ls--insert-directory))
-	 (set symbol value))
+         (set symbol value))
   :type 'boolean
-  :require 'em-ls
+  :require 'em-ls)
-  :group 'eshell-ls)
+(add-hook 'eshell-ls-unload-hook
+          (lambda () (advice-remove 'insert-directory
+                               #'eshell-ls--insert-directory)))
+
 
 (defcustom eshell-ls-default-blocksize 1024
   "The default blocksize to use when display file sizes with -s."
-  :type 'integer
+  :type 'integer)
-  :group 'eshell-ls)
 
 (defcustom eshell-ls-exclude-regexp nil
   "Unless -a is specified, files matching this regexp will not be shown."
-  :type '(choice regexp (const nil))
+  :type '(choice regexp (const nil)))
-  :group 'eshell-ls)
 
 (defcustom eshell-ls-exclude-hidden t
   "Unless -a is specified, files beginning with . will not be shown.
 Using this boolean, instead of `eshell-ls-exclude-regexp', is both
 faster and conserves more memory."
-  :type 'boolean
+  :type 'boolean)
-  :group 'eshell-ls)
 
 (defcustom eshell-ls-use-colors t
   "If non-nil, use colors in file listings."
-  :type 'boolean
+  :type 'boolean)
-  :group 'eshell-ls)
 
 (defface eshell-ls-directory
   '((((class color) (background light)) (:foreground "Blue" :weight bold))
     (((class color) (background dark)) (:foreground "SkyBlue" :weight bold))
     (t (:weight bold)))
-  "The face used for highlight directories."
+  "The face used for highlight directories.")
-  :group 'eshell-ls)
 (define-obsolete-face-alias 'eshell-ls-directory-face
   'eshell-ls-directory "22.1")
 
 (defface eshell-ls-symlink
   '((((class color) (background light)) (:foreground "Dark Cyan" :weight bold))
     (((class color) (background dark)) (:foreground "Cyan" :weight bold)))
-  "The face used for highlight symbolic links."
+  "The face used for highlight symbolic links.")
-  :group 'eshell-ls)
 (define-obsolete-face-alias 'eshell-ls-symlink-face 'eshell-ls-symlink "22.1")
 
 (defface eshell-ls-executable
   '((((class color) (background light)) (:foreground "ForestGreen" :weight bold))
     (((class color) (background dark)) (:foreground "Green" :weight bold)))
-  "The face used for highlighting executables (not directories, though)."
+  "The face used for highlighting executables (not directories, though).")
-  :group 'eshell-ls)
 (define-obsolete-face-alias 'eshell-ls-executable-face
   'eshell-ls-executable "22.1")
 
 (defface eshell-ls-readonly
   '((((class color) (background light)) (:foreground "Brown"))
     (((class color) (background dark)) (:foreground "Pink")))
-  "The face used for highlighting read-only files."
+  "The face used for highlighting read-only files.")
-  :group 'eshell-ls)
 (define-obsolete-face-alias 'eshell-ls-readonly-face 'eshell-ls-readonly "22.1")
 
 (defface eshell-ls-unreadable
   '((((class color) (background light)) (:foreground "Grey30"))
     (((class color) (background dark)) (:foreground "DarkGrey")))
-  "The face used for highlighting unreadable files."
+  "The face used for highlighting unreadable files.")
-  :group 'eshell-ls)
 (define-obsolete-face-alias 'eshell-ls-unreadable-face
   'eshell-ls-unreadable "22.1")
 
 (defface eshell-ls-special
   '((((class color) (background light)) (:foreground "Magenta" :weight bold))
     (((class color) (background dark)) (:foreground "Magenta" :weight bold)))
-  "The face used for highlighting non-regular files."
+  "The face used for highlighting non-regular files.")
-  :group 'eshell-ls)
 (define-obsolete-face-alias 'eshell-ls-special-face 'eshell-ls-special "22.1")
 
 (defface eshell-ls-missing
   '((((class color) (background light)) (:foreground "Red" :weight bold))
     (((class color) (background dark)) (:foreground "Red" :weight bold)))
-  "The face used for highlighting non-existent file names."
+  "The face used for highlighting non-existent file names.")
-  :group 'eshell-ls)
 (define-obsolete-face-alias 'eshell-ls-missing-face 'eshell-ls-missing "22.1")
 
 (defcustom eshell-ls-archive-regexp
@@ -172,27 +149,23 @@ faster and conserves more memory."
 This typically includes both traditional archives and compressed
 files."
   :version "24.1"			; added xz
-  :type 'regexp
+  :type 'regexp)
-  :group 'eshell-ls)
 
 (defface eshell-ls-archive
   '((((class color) (background light)) (:foreground "Orchid" :weight bold))
     (((class color) (background dark)) (:foreground "Orchid" :weight bold)))
-  "The face used for highlighting archived and compressed file names."
+  "The face used for highlighting archived and compressed file names.")
-  :group 'eshell-ls)
 (define-obsolete-face-alias 'eshell-ls-archive-face 'eshell-ls-archive "22.1")
 
 (defcustom eshell-ls-backup-regexp
   "\\(\\`\\.?#\\|\\(\\.bak\\|~\\)\\'\\)"
   "A regular expression that matches names of backup files."
-  :type 'regexp
+  :type 'regexp)
-  :group 'eshell-ls)
 
 (defface eshell-ls-backup
   '((((class color) (background light)) (:foreground "OrangeRed"))
     (((class color) (background dark)) (:foreground "LightSalmon")))
-  "The face used for highlighting backup file names."
+  "The face used for highlighting backup file names.")
-  :group 'eshell-ls)
 (define-obsolete-face-alias 'eshell-ls-backup-face 'eshell-ls-backup "22.1")
 
 (defcustom eshell-ls-product-regexp
@@ -200,14 +173,12 @@ files."
   "A regular expression that matches names of product files.
 Products are files that get generated from a source file, and hence
 ought to be recreatable if they are deleted."
-  :type 'regexp
+  :type 'regexp)
-  :group 'eshell-ls)
 
 (defface eshell-ls-product
   '((((class color) (background light)) (:foreground "OrangeRed"))
     (((class color) (background dark)) (:foreground "LightSalmon")))
-  "The face used for highlighting files that are build products."
+  "The face used for highlighting files that are build products.")
-  :group 'eshell-ls)
 (define-obsolete-face-alias 'eshell-ls-product-face 'eshell-ls-product "22.1")
 
 (defcustom eshell-ls-clutter-regexp
@@ -215,14 +186,12 @@ ought to be recreatable if they are deleted."
   "A regular expression that matches names of junk files.
 These are mainly files that get created for various reasons, but don't
 really need to stick around for very long."
-  :type 'regexp
+  :type 'regexp)
-  :group 'eshell-ls)
 
 (defface eshell-ls-clutter
   '((((class color) (background light)) (:foreground "OrangeRed" :weight bold))
     (((class color) (background dark)) (:foreground "OrangeRed" :weight bold)))
-  "The face used for highlighting junk file names."
+  "The face used for highlighting junk file names.")
-  :group 'eshell-ls)
 (define-obsolete-face-alias 'eshell-ls-clutter-face 'eshell-ls-clutter "22.1")
 
 (defsubst eshell-ls-filetype-p (attrs type)
@@ -263,8 +232,7 @@ The format of the members of this alist is
 If TEST-SEXP evals to non-nil, that face will be used to highlight the
 name of the file.  The first match wins.  `file' and `attrs' are in
 scope during the evaluation of TEST-SEXP."
-  :type '(repeat (cons function face))
+  :type '(repeat (cons function face)))
-  :group 'eshell-ls)
 
 (defvar block-size)
 (defvar dereference-links)
@@ -287,8 +255,8 @@ scope during the evaluation of TEST-SEXP."
 
 ;;; Functions:
 
-(defun eshell-ls-insert-directory
+(defun eshell-ls--insert-directory
-  (file switches &optional wildcard full-directory-p)
+  (orig-fun file switches &optional wildcard full-directory-p)
   "Insert directory listing for FILE, formatted according to SWITCHES.
 Leaves point after the inserted text.
 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.
 This version of the function uses `eshell/ls'.  If any of the switches
 passed are not recognized, the operating system's version will be used
 instead."
-  (let ((handler (find-file-name-handler file 'insert-directory)))
+  (if (not eshell-ls-use-in-dired)
-    (if handler
+      (funcall orig-fun file switches wildcard full-directory-p)
-	(funcall handler 'insert-directory file switches
+    (let ((handler (find-file-name-handler file 'insert-directory)))
-		 wildcard full-directory-p)
+      (if handler
-      (if (stringp switches)
+          (funcall handler 'insert-directory file switches
-	  (setq switches (split-string switches)))
+                   wildcard full-directory-p)
-      (let (eshell-current-handles
+        (if (stringp switches)
-	    eshell-current-subjob-p
+            (setq switches (split-string switches)))
-	    font-lock-mode)
+        (let (eshell-current-handles
-	;; use the fancy highlighting in `eshell-ls' rather than font-lock
+              eshell-current-subjob-p
-	(when (and eshell-ls-use-colors
+              font-lock-mode)
-		   (featurep 'font-lock))
+          ;; use the fancy highlighting in `eshell-ls' rather than font-lock
-	  (font-lock-mode -1)
+          (when (and eshell-ls-use-colors
-	  (setq font-lock-defaults nil)
+                     (featurep 'font-lock))
-	  (if (boundp 'font-lock-buffers)
+            (font-lock-mode -1)
-	      (set 'font-lock-buffers
+            (setq font-lock-defaults nil)
-		   (delq (current-buffer)
+            (if (boundp 'font-lock-buffers)
-			 (symbol-value 'font-lock-buffers)))))
+                (set 'font-lock-buffers
-	(let ((insert-func 'insert)
+                     (delq (current-buffer)
-	      (error-func 'insert)
+                           (symbol-value 'font-lock-buffers)))))
-	      (flush-func 'ignore)
+          (let ((insert-func 'insert)
-	      eshell-ls-dired-initial-args)
+                (error-func 'insert)
-	  (eshell-do-ls (append switches (list file))))))))
+                (flush-func 'ignore)
+                eshell-ls-dired-initial-args)
+            (eshell-do-ls (append switches (list file)))))))))
 
 (defsubst eshell/ls (&rest args)
   "An alias version of `eshell-do-ls'."