;;; 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
(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."
(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")
(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)))
(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
HCoop / bpt / emacs.git / blobdiff