;;; em-ls.el --- implementation of ls in Lisp
-;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
+;; 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-(provide 'em-ls)
+;;; Commentary:
+
+;; Most of the command switches recognized by GNU's ls utility are
+;; supported ([(fileutils)ls invocation]).
-(eval-when-compile (require 'esh-maint))
+;;; Code:
-(defgroup eshell-ls nil
+(eval-when-compile
+ (require 'cl)
+ (require 'eshell))
+(require 'esh-util)
+(require 'esh-opt)
+
+;;;###autoload
+(eshell-defgroup eshell-ls nil
"This module implements the \"ls\" utility fully in Lisp. If it is
passed any unrecognized command switches, it will revert to the
operating system's version. This version of \"ls\" uses text
:tag "Implementation of `ls' in Lisp"
:group 'eshell-module)
-;;; Commentary:
-
-;; Most of the command switches recognized by GNU's ls utility are
-;; supported ([(fileutils)ls invocation]).
-
-(require 'esh-util)
-(require 'esh-opt)
-
;;; User Variables:
(defvar eshell-ls-orig-insert-directory
(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-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
(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)))
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)))
"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))
+ ;; 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)))
(eshell-for file files
(if file
(eshell-ls-file file size-width copy-fileinfo)))
(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.
(car file)))))
(car file))
-;;; Code:
+(provide 'em-ls)
+
+;; Local Variables:
+;; generated-autoload-file: "esh-groups.el"
+;; End:
-;;; arch-tag: 9295181c-0cb2-499c-999b-89f5359842cb
+;; arch-tag: 9295181c-0cb2-499c-999b-89f5359842cb
;;; em-ls.el ends here