;;; em-ls.el --- implementation of ls in Lisp
-;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
-;; 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
;;; Code:
-(eval-when-compile (require 'eshell))
+(eval-when-compile
+ (require 'cl)
+ (require 'eshell))
(require 'esh-util)
(require 'esh-opt)
(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)
: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)
'((((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)
-;; backward-compatibility alias
-(put 'eshell-ls-directory-face 'face-alias 'eshell-ls-directory)
+(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)
-;; backward-compatibility alias
-(put 'eshell-ls-symlink-face 'face-alias 'eshell-ls-symlink)
+(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)
-;; backward-compatibility alias
-(put 'eshell-ls-executable-face 'face-alias 'eshell-ls-executable)
+(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)
-;; backward-compatibility alias
-(put 'eshell-ls-readonly-face 'face-alias 'eshell-ls-readonly)
+(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)
-;; backward-compatibility alias
-(put 'eshell-ls-unreadable-face 'face-alias 'eshell-ls-unreadable)
+(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)
-;; backward-compatibility alias
-(put 'eshell-ls-special-face 'face-alias 'eshell-ls-special)
+(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)
-;; backward-compatibility alias
-(put 'eshell-ls-missing-face 'face-alias 'eshell-ls-missing)
+(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)
-;; backward-compatibility alias
-(put 'eshell-ls-archive-face 'face-alias 'eshell-ls-archive)
+(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)
-;; backward-compatibility alias
-(put 'eshell-ls-backup-face 'face-alias 'eshell-ls-backup)
+(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
(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)
-;; backward-compatibility alias
-(put 'eshell-ls-product-face 'face-alias 'eshell-ls-product)
+(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
(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)
-;; backward-compatibility alias
-(put 'eshell-ls-clutter-face 'face-alias 'eshell-ls-clutter)
+(define-obsolete-face-alias 'eshell-ls-clutter-face 'eshell-ls-clutter "22.1")
(defsubst eshell-ls-filetype-p (attrs type)
"Test whether ATTRS specifies a directory."
(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)
(put 'eshell/ls 'eshell-no-numeric-conversions t)
-(eval-when-compile
- (defvar block-size)
- (defvar dereference-links)
- (defvar dir-literal)
- (defvar error-func)
- (defvar flush-func)
- (defvar human-readable)
- (defvar ignore-pattern)
- (defvar insert-func)
- (defvar listing-style)
- (defvar numeric-uid-gid)
- (defvar reverse-list)
- (defvar show-all)
- (defvar show-recursive)
- (defvar show-size)
- (defvar sort-method)
- (defvar ange-cache)
- (defvar dired-flag))
+(defvar block-size)
+(defvar dereference-links)
+(defvar dir-literal)
+(defvar error-func)
+(defvar flush-func)
+(defvar human-readable)
+(defvar ignore-pattern)
+(defvar insert-func)
+(defvar listing-style)
+(defvar numeric-uid-gid)
+(defvar reverse-list)
+(defvar show-all)
+(defvar show-recursive)
+(defvar show-size)
+(defvar sort-method)
+(defvar ange-cache)
+(defvar dired-flag)
(defun eshell-do-ls (&rest args)
"Implementation of \"ls\" in Lisp, passing ARGS."
"list entries by lines instead of by columns")
(?C nil by-columns listing-style
"list entries by columns")
- (?L "deference" nil dereference-links
+ (?L "dereference" nil dereference-links
"list entries pointed to by symbolic links")
(?R "recursive" nil show-recursive
"list subdirectories recursively")
(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)))
(if show-size
(concat (eshell-ls-size-string attrs size-width) " "))
(format
- "%s%4d %-8s %-8s "
+ (if numeric-uid-gid
+ "%s%4d %-8s %-8s "
+ "%s%4d %-14s %-8s ")
(or (nth 8 attrs) "??????????")
(or (nth 1 attrs) 0)
(or (let ((user (nth 2 attrs)))
- (and (not numeric-uid-gid)
- user
- (eshell-substring
- (if (numberp user)
- (user-login-name user)
- user) 8)))
+ (and (stringp user)
+ (eshell-substring user 14)))
(nth 2 attrs)
"")
(or (let ((group (nth 3 attrs)))
- (and (not numeric-uid-gid)
- group
- (eshell-substring
- (if (numberp group)
- (eshell-group-name group)
- group) 8)))
+ (and (stringp group)
+ (eshell-substring group 8)))
(nth 3 attrs)
""))
(let* ((str (eshell-ls-printable-size (nth 7 attrs)))
(len (length str)))
- (if (< len (or size-width 4))
- (concat (make-string (- (or size-width 4) len) ? ) str)
+ ;; Let file sizes shorter than 9 align neatly.
+ (if (< len (or size-width 8))
+ (concat (make-string (- (or size-width 8) len) ? ) str)
str))
" " (format-time-string
(concat
- "%b %e "
+ eshell-ls-date-format " "
(if (= (nth 5 (decode-time (current-time)))
(nth 5 (decode-time
(nth (cond
(let ((entries (eshell-directory-files-and-attributes
dir nil (and (not show-all)
eshell-ls-exclude-hidden
- "\\`[^.]") t)))
+ "\\`[^.]") t
+ ;; Asking for UID and GID as
+ ;; strings saves another syscall
+ ;; later when we are going to
+ ;; display user and group names.
+ (if numeric-uid-gid 'integer 'string))))
(when (and (not show-all) eshell-ls-exclude-regexp)
(while (and entries (string-match eshell-ls-exclude-regexp
(caar entries)))
(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
(max size-width
(length (eshell-ls-printable-size
- (nth 7 (cdr e)) t))))))
+ (nth 7 (cdr e))
+ (not
+ ;; If we are under -l, count length
+ ;; of sizes in bytes, not in blocks.
+ (eq listing-style 'long-listing))))))))
(funcall insert-func "total "
(eshell-ls-printable-size total t) "\n")))
(let ((default-directory (expand-file-name dir)))
(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)
"Output a list of FILES.
Each member of FILES is either a string or a cons cell of the form
\(FILE . ATTRS)."
- (if (memq listing-style '(long-listing single-column))
- (eshell-for file files
+ ;; Mimic behavior of coreutils ls, which lists a single file per
+ ;; line when output is not a tty. Exceptions: if -x was supplied,
+ ;; or if we are the _last_ command in a pipeline.
+ ;; FIXME Not really the same since not testing output destination.
+ (if (or (and eshell-in-pipeline-p
+ (not (eq eshell-in-pipeline-p 'last))
+ (not (eq listing-style 'by-lines)))
+ (memq listing-style '(long-listing single-column)))
+ (dolist (file files)
(if file
(eshell-ls-file file size-width copy-fileinfo)))
(let ((f files)
(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)
(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
(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.
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)
(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
;; generated-autoload-file: "esh-groups.el"
;; End:
-;; arch-tag: 9295181c-0cb2-499c-999b-89f5359842cb
;;; em-ls.el ends here
HCoop / bpt / emacs.git / blobdiff