Add 2012 to FSF copyright years for Emacs files
[bpt/emacs.git] / lisp / eshell / em-ls.el
index 3bf0bbd..af60cdc 100644 (file)
@@ -1,7 +1,6 @@
 ;;; em-ls.el --- implementation of ls in Lisp
 
-;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
-;;   2008, 2009  Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012  Free Software Foundation, Inc.
 
 ;; Author: John Wiegley <johnw@gnu.org>
 
@@ -54,24 +53,31 @@ properties to colorize its output based on the setting of
    (function
     (lambda ()
       (fset 'insert-directory eshell-ls-orig-insert-directory))))
-  "*When unloading `eshell-ls', restore the definition of `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\"."
+  :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'.
+  "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)
   :group 'eshell-ls)
 
 (defcustom eshell-ls-dired-initial-args nil
-  "*If non-nil, args is included before any call to `ls' in Dired.
+  "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)
   :group 'eshell-ls)
 
 (defcustom eshell-ls-use-in-dired nil
-  "*If non-nil, use `eshell-ls' to read directories in Dired."
+  "If non-nil, use `eshell-ls' to read directories in Dired."
   :set (lambda (symbol value)
         (if value
             (unless (and (boundp 'eshell-ls-use-in-dired)
@@ -86,24 +92,24 @@ This is useful for enabling human-readable format (-h), for example."
   :group 'eshell-ls)
 
 (defcustom eshell-ls-default-blocksize 1024
-  "*The default blocksize to use when display file sizes with -s."
+  "The default blocksize to use when display file sizes with -s."
   :type 'integer
   :group 'eshell-ls)
 
 (defcustom eshell-ls-exclude-regexp nil
-  "*Unless -a is specified, files matching this regexp will not be shown."
+  "Unless -a is specified, files matching this regexp will not be shown."
   :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.
+  "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
   :group 'eshell-ls)
 
 (defcustom eshell-ls-use-colors t
-  "*If non-nil, use colors in file listings."
+  "If non-nil, use colors in file listings."
   :type 'boolean
   :group 'eshell-ls)
 
@@ -111,7 +117,7 @@ faster and conserves more memory."
   '((((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")
@@ -119,14 +125,14 @@ faster and conserves more memory."
 (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")
@@ -134,14 +140,14 @@ faster and conserves more memory."
 (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")
@@ -149,49 +155,50 @@ faster and conserves more memory."
 (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
   (concat "\\.\\(t\\(a[rz]\\|gz\\)\\|arj\\|lzh\\|"
-         "zip\\|[zZ]\\|gz\\|bz2\\|deb\\|rpm\\)\\'")
-  "*A regular expression that matches names of file archives.
+         "zip\\|[zZ]\\|gz\\|bz2\\|xz\\|deb\\|rpm\\)\\'")
+  "A regular expression that matches names of file archives.
 This typically includes both traditional archives and compressed
 files."
+  :version "24.1"                      ; added xz
   :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."
+  "A regular expression that matches names of backup files."
   :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
   "\\.\\(elc\\|o\\(bj\\)?\\|a\\|lib\\|res\\)\\'"
-  "*A regular expression that matches names of product 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
@@ -200,13 +207,13 @@ ought to be recreatable if they are deleted."
 (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
   "\\(^texput\\.log\\|^core\\)\\'"
-  "*A regular expression that matches names of junk files.
+  "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
@@ -215,7 +222,7 @@ really need to stick around for very long."
 (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")
 
@@ -225,21 +232,31 @@ really need to stick around for very long."
       (eq (aref (nth 8 attrs) 0) type)))
 
 (defmacro eshell-ls-applicable (attrs index func file)
-  "Test whether, for ATTRS, the user UID can do what corresponds to INDEX.
-This is really just for efficiency, to avoid having to stat the file
-yet again."
-  `(if (numberp (nth 2 ,attrs))
-       (if (= (user-uid) (nth 2 ,attrs))
-          (not (eq (aref (nth 8 ,attrs) ,index) ?-))
-        (,(eval func) ,file))
-     (not (eq (aref (nth 8 ,attrs)
-                   (+ ,index (if (member (nth 2 ,attrs)
-                                         (eshell-current-ange-uids))
-                                 0 6)))
-             ?-))))
+  "Test whether, for ATTRS, the user can do what corresponds to INDEX.
+ATTRS is a string of file modes.  See `file-attributes'.
+If we cannot determine the answer using ATTRS (e.g., if we need
+to know what group the user is in), compute the return value by
+calling FUNC with FILE as an argument."
+  `(let ((owner (nth 2 ,attrs))
+        (modes (nth 8 ,attrs)))
+     (cond ((cond ((numberp owner)
+                  (= owner (user-uid)))
+                 ((stringp owner)
+                  (or (string-equal owner (user-login-name))
+                      (member owner (eshell-current-ange-uids)))))
+           ;; The user owns this file.
+           (not (eq (aref modes ,index) ?-)))
+          ((eq (aref modes (+ ,index 3))
+               (aref modes (+ ,index 6)))
+           ;; If the "group" and "other" fields give identical
+           ;; results, use that.
+           (not (eq (aref modes (+ ,index 3)) ?-)))
+          (t
+           ;; Otherwise call FUNC.
+           (,(eval func) ,file)))))
 
 (defcustom eshell-ls-highlight-alist nil
-  "*This alist correlates test functions to color.
+  "This alist correlates test functions to color.
 The format of the members of this alist is
 
   (TEST-SEXP . FACE)
@@ -393,13 +410,13 @@ Sort entries alphabetically across.")
               (eshell-glob-regexp ignore-pattern))))
      ;; list the files!
      (eshell-ls-entries
-      (mapcar (function
-              (lambda (arg)
-                (cons (if (and (eshell-under-windows-p)
-                               (file-name-absolute-p arg))
-                          (expand-file-name arg)
-                        arg)
-                      (eshell-file-attributes arg))))
+      (mapcar (lambda (arg)
+               (cons (if (and (eshell-under-windows-p)
+                              (file-name-absolute-p arg))
+                         (expand-file-name arg)
+                       arg)
+                     (eshell-file-attributes
+                      arg (if numeric-uid-gid 'integer 'string))))
              args)
       t (expand-file-name default-directory)))
    (funcall flush-func)))
@@ -498,7 +515,7 @@ whose cdr is the list of file attributes."
                    str))
                " " (format-time-string
                     (concat
-                     "%b %e "
+                     eshell-ls-date-format " "
                      (if (= (nth 5 (decode-time (current-time)))
                             (nth 5 (decode-time
                                     (nth (cond
@@ -551,7 +568,7 @@ relative to that directory."
          (when (or (eq listing-style 'long-listing) show-size)
            (let ((total 0.0))
              (setq size-width 0)
-             (eshell-for e entries
+             (dolist (e entries)
                (if (nth 7 (cdr e))
                    (setq total (+ total (nth 7 (cdr e)))
                          size-width
@@ -601,11 +618,11 @@ In Eshell's implementation of ls, ENTRIES is always reversed."
             (let ((result
                    (cond
                     ((eq sort-method 'by-atime)
-                     (eshell-ls-compare-entries l r 4 'eshell-time-less-p))
+                     (eshell-ls-compare-entries l r 4 'time-less-p))
                     ((eq sort-method 'by-mtime)
-                     (eshell-ls-compare-entries l r 5 'eshell-time-less-p))
+                     (eshell-ls-compare-entries l r 5 'time-less-p))
                     ((eq sort-method 'by-ctime)
-                     (eshell-ls-compare-entries l r 6 'eshell-time-less-p))
+                     (eshell-ls-compare-entries l r 6 'time-less-p))
                     ((eq sort-method 'by-size)
                      (eshell-ls-compare-entries l r 7 '<))
                     ((eq sort-method 'by-extension)
@@ -641,7 +658,7 @@ Each member of FILES is either a string or a cons cell of the form
               (not (eq eshell-in-pipeline-p 'last))
               (not (eq listing-style 'by-lines)))
          (memq listing-style '(long-listing single-column)))
-      (eshell-for file files
+      (dolist (file files)
        (if file
            (eshell-ls-file file size-width copy-fileinfo)))
     (let ((f files)
@@ -666,7 +683,7 @@ Each member of FILES is either a string or a cons cell of the form
              (setcdr f (cddr f))))))
       (if (not show-size)
          (setq display-files (mapcar 'eshell-ls-annotate files))
-       (eshell-for file files
+       (dolist (file files)
          (let* ((str (eshell-ls-printable-size (nth 7 (cdr file)) t))
                 (len (length str)))
            (if (< len size-width)
@@ -686,7 +703,7 @@ Each member of FILES is either a string or a cons cell of the form
             (columns (length col-widths))
             (col-index 1)
             need-return)
-       (eshell-for file display-files
+       (dolist (file display-files)
          (let ((name
                 (if (car file)
                     (if show-size
@@ -710,7 +727,7 @@ Each member of FILES is either a string or a cons cell of the form
            (funcall insert-func need-return "\n"))))))
 
 (defun eshell-ls-entries (entries &optional separate root-dir)
-  "Output PATH's directory ENTRIES, formatted according to OPTIONS.
+  "Output PATH's directory ENTRIES.
 Each member of ENTRIES may either be a string or a cons cell, the car
 of which is the file name, and the cdr of which is the list of
 attributes.
@@ -721,7 +738,7 @@ ROOT-DIR, if non-nil, specifies the root directory of the listing, to
 which non-absolute directory names will be made relative if ever they
 need to be printed."
   (let (dirs files show-names need-return (size-width 0))
-    (eshell-for entry entries
+    (dolist (entry entries)
       (if (and (not dir-literal)
               (or (eshell-ls-filetype-p (cdr entry) ?d)
                   (and (eshell-ls-filetype-p (cdr entry) ?l)
@@ -747,7 +764,7 @@ need to be printed."
       (setq need-return t))
     (setq show-names (or show-recursive
                         (> (+ (length files) (length dirs)) 1)))
-    (eshell-for dir (eshell-ls-sort-entries dirs)
+    (dolist (dir (eshell-ls-sort-entries dirs))
       (if (and need-return (not dir-literal))
          (funcall insert-func "\n"))
       (eshell-ls-dir dir show-names
@@ -930,5 +947,4 @@ to use, and each member of which is the width of that column
 ;; generated-autoload-file: "esh-groups.el"
 ;; End:
 
-;; arch-tag: 9295181c-0cb2-499c-999b-89f5359842cb
 ;;; em-ls.el ends here