-;;; em-ls --- implementation of ls in Lisp
+;;; em-ls.el --- implementation of ls in Lisp
-;; Copyright (C) 1999, 2000 Free Sofware Foundation
+;; Copyright (C) 1999, 2000 Free Software Foundation
+
+;; Author: John Wiegley <johnw@gnu.org>
;; This file is part of GNU Emacs.
: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'.
+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.
+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."
:set (lambda (symbol value)
:type 'integer
:group 'eshell-ls)
-(defcustom eshell-ls-exclude-regexp "\\`\\."
+(defcustom eshell-ls-exclude-regexp nil
"*Unless -a is specified, files matching this regexp will not be shown."
- :type 'regexp
+ :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.
+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
:group 'eshell-ls)
(defface eshell-ls-directory-face
- '((((class color) (background light)) (:foreground "Blue" :bold t))
- (((class color) (background dark)) (:foreground "SkyBlue" :bold t))
- (t (:bold t)))
+ '((((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."
:group 'eshell-ls)
(defface eshell-ls-symlink-face
- '((((class color) (background light)) (:foreground "Dark Cyan" :bold t))
- (((class color) (background dark)) (:foreground "Cyan" :bold t)))
+ '((((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)
(defface eshell-ls-executable-face
- '((((class color) (background light)) (:foreground "ForestGreen" :bold t))
- (((class color) (background dark)) (:foreground "Green" :bold t)))
+ '((((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)
:group 'eshell-ls)
(defface eshell-ls-special-face
- '((((class color) (background light)) (:foreground "Magenta" :bold t))
- (((class color) (background dark)) (:foreground "Magenta" :bold t)))
+ '((((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)
(defface eshell-ls-missing-face
- '((((class color) (background light)) (:foreground "Red" :bold t))
- (((class color) (background dark)) (:foreground "Red" :bold t)))
+ '((((class color) (background light)) (:foreground "Red" :weight bold))
+ (((class color) (background dark)) (:foreground "Red" :weight bold)))
"*The face used for highlighting non-existant file names."
:group 'eshell-ls)
:group 'eshell-ls)
(defface eshell-ls-archive-face
- '((((class color) (background light)) (:foreground "Orchid" :bold t))
- (((class color) (background dark)) (:foreground "Orchid" :bold t)))
+ '((((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."
:group 'eshell-ls)
:group 'eshell-ls)
(defface eshell-ls-clutter-face
- '((((class color) (background light)) (:foreground "OrangeRed" :bold t))
- (((class color) (background dark)) (:foreground "OrangeRed" :bold t)))
+ '((((class color) (background light)) (:foreground "OrangeRed" :weight bold))
+ (((class color) (background dark)) (:foreground "OrangeRed" :weight bold)))
"*The face used for highlighting junk file names."
:group 'eshell-ls)
"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 (= (user-uid) (nth 2 ,attrs))
- (not (eq (aref (nth 8 ,attrs) ,index) ?-))
- (,(eval func) ,file)))
+ `(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)))
+ ?-))))
(defcustom eshell-ls-highlight-alist nil
"*This alist correlates test functions to color.
(when (and eshell-ls-use-colors
(featurep 'font-lock))
(font-lock-mode -1)
+ (setq font-lock-defaults nil)
(if (boundp 'font-lock-buffers)
(set 'font-lock-buffers
(delq (current-buffer)
(symbol-value 'font-lock-buffers)))))
(let ((insert-func 'insert)
(error-func 'insert)
- (flush-func 'ignore))
+ (flush-func 'ignore)
+ eshell-ls-dired-initial-args)
(eshell-do-ls (append switches (list file))))))))
(defsubst eshell/ls (&rest args)
(flush-func 'eshell-flush))
(eshell-do-ls args)))
+(put 'eshell/ls 'eshell-no-numeric-conversions t)
+
(eval-when-compile
(defvar block-size)
(defvar dereference-links)
(defvar show-all)
(defvar show-recursive)
(defvar show-size)
- (defvar sort-method))
+ (defvar sort-method)
+ (defvar ange-cache))
(defun eshell-do-ls (&rest args)
"Implementation of \"ls\" in Lisp, passing ARGS."
(funcall flush-func -1)
;; process the command arguments, and begin listing files
(eshell-eval-using-options
- "ls" args
+ "ls" (if eshell-ls-initial-args
+ (list eshell-ls-initial-args args)
+ args)
`((?a "all" nil show-all
"show all files in directory")
(?c nil by-ctime sort-method
(setq listing-style 'by-columns))
(unless args
(setq args (list ".")))
- (let ((eshell-ls-exclude-regexp eshell-ls-exclude-regexp))
+ (let ((eshell-ls-exclude-regexp eshell-ls-exclude-regexp) ange-cache)
(when ignore-pattern
(unless (eshell-using-module 'eshell-glob)
(error (concat "-I option requires that `eshell-glob'"
" be a member of `eshell-modules-list'")))
(set-text-properties 0 (length ignore-pattern) nil ignore-pattern)
- (if eshell-ls-exclude-regexp
- (setq eshell-ls-exclude-regexp
+ (setq eshell-ls-exclude-regexp
+ (if eshell-ls-exclude-regexp
(concat "\\(" eshell-ls-exclude-regexp "\\|"
- (eshell-glob-regexp ignore-pattern) "\\)"))
- (setq eshell-ls-exclude-regexp (eshell-glob-regexp ignore-pattern))))
+ (eshell-glob-regexp ignore-pattern) "\\)")
+ (eshell-glob-regexp ignore-pattern))))
;; list the files!
(eshell-ls-entries
(mapcar (function
(file-name-absolute-p arg))
(expand-file-name arg)
arg)
- (file-attributes arg)))) args)
+ (eshell-file-attributes arg))))
+ args)
t (expand-file-name default-directory)))
(funcall flush-func)))
(file-name-directory
(expand-file-name (car fileinfo))))))
(setq attr
- (file-attributes
+ (eshell-file-attributes
(let ((target (if dir
(expand-file-name (cadr fileinfo) dir)
(cadr fileinfo))))
"%s%4d %-8s %-8s "
(or (nth 8 attrs) "??????????")
(or (nth 1 attrs) 0)
- (or (and (not numeric-uid-gid)
- (nth 2 attrs)
- (eshell-substring
- (user-login-name (nth 2 attrs)) 8))
+ (or (let ((user (nth 2 attrs)))
+ (and (not numeric-uid-gid)
+ user
+ (eshell-substring
+ (if (numberp user)
+ (user-login-name user)
+ user) 8)))
(nth 2 attrs)
"")
- (or (and (not numeric-uid-gid)
- (nth 3 attrs)
- (eshell-substring
- (eshell-group-name (nth 3 attrs)) 8))
+ (or (let ((group (nth 3 attrs)))
+ (and (not numeric-uid-gid)
+ group
+ (eshell-substring
+ (if (numberp group)
+ (eshell-group-name group)
+ group) 8)))
(nth 3 attrs)
""))
(let* ((str (eshell-ls-printable-size (nth 7 attrs)))
(file-relative-name dir root-dir)
(expand-file-name dir)))
(cdr dirinfo))) ":\n"))
- (let ((entries
- (eshell-directory-files-and-attributes dir nil nil t)))
- (unless show-all
- (while (and entries
- (string-match eshell-ls-exclude-regexp
- (caar entries)))
+ (let ((entries (eshell-directory-files-and-attributes
+ dir nil (and (not show-all)
+ eshell-ls-exclude-hidden
+ "\\`[^.]") t)))
+ (when (and (not show-all) eshell-ls-exclude-regexp)
+ (while (and entries (string-match eshell-ls-exclude-regexp
+ (caar entries)))
(setq entries (cdr entries)))
(let ((e entries))
(while (cdr e)
(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 'eshell-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 'eshell-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 'eshell-time-less-p))
((eq sort-method 'by-size)
- (eshell-ls-compare-entries
- l r 7 '<))
+ (eshell-ls-compare-entries l r 7 '<))
((eq sort-method 'by-extension)
(let ((lx (file-name-extension
(directory-file-name (car l))))
(if (and need-return (not dir-literal))
(funcall insert-func "\n"))
(eshell-ls-dir dir show-names
- (unless (file-name-absolute-p (car dir))
- root-dir) size-width)
+ (unless (file-name-absolute-p (car dir)) root-dir)
+ size-width)
(setq need-return t))))
(defun eshell-ls-find-column-widths (files)
((not (eshell-ls-filetype-p (cdr file) ?-))
'eshell-ls-special-face)
- ((and (not (= (user-uid) 0)) ; root can execute anything
+ ((and (/= (user-uid) 0) ; root can execute anything
(eshell-ls-applicable (cdr file) 3
'file-executable-p (car file)))
'eshell-ls-executable-face)
HCoop / bpt / emacs.git / blobdiff