;;; 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, 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 3, 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/>.
;;; Commentary:
;;; Code:
-(eval-when-compile (require 'eshell))
+(eval-when-compile
+ (require 'cl)
+ (require 'eshell))
(require 'esh-util)
(require 'esh-opt)
-(defgroup eshell-ls nil
+;;;###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
(t (:weight bold)))
"*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."
: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)."
: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."
: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."
: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."
: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."
: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\\|"
(((class color) (background dark)) (:foreground "Orchid" :weight bold)))
"*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\\|~\\)\\'\\)"
(((class color) (background dark)) (:foreground "LightSalmon")))
"*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\\)\\'"
(((class color) (background dark)) (:foreground "LightSalmon")))
"*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\\)\\'"
(((class color) (background dark)) (:foreground "OrangeRed" :weight bold)))
"*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.
(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.
(provide 'em-ls)
-;;; arch-tag: 9295181c-0cb2-499c-999b-89f5359842cb
+;; Local Variables:
+;; generated-autoload-file: "esh-groups.el"
+;; End:
+
+;; arch-tag: 9295181c-0cb2-499c-999b-89f5359842cb
;;; em-ls.el ends here