/[emacs]/emacs/lisp/eshell/em-ls.el
ViewVC logotype

Diff of /emacs/lisp/eshell/em-ls.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.18 by johnw, Mon Nov 17 00:24:06 2003 UTC revision 1.19 by miles, Fri Jun 17 05:27:55 2005 UTC
# Line 1  Line 1 
1  ;;; em-ls.el --- implementation of ls in Lisp  ;;; em-ls.el --- implementation of ls in Lisp
2    
3  ;; Copyright (C) 1999, 2000 Free Software Foundation  ;; Copyright (C) 1999, 2000, 2005 Free Software Foundation
4    
5  ;; Author: John Wiegley <johnw@gnu.org>  ;; Author: John Wiegley <johnw@gnu.org>
6    
# Line 106  faster and conserves more memory." Line 106  faster and conserves more memory."
106    :type 'boolean    :type 'boolean
107    :group 'eshell-ls)    :group 'eshell-ls)
108    
109  (defface eshell-ls-directory-face  (defface eshell-ls-directory
110    '((((class color) (background light)) (:foreground "Blue" :weight bold))    '((((class color) (background light)) (:foreground "Blue" :weight bold))
111      (((class color) (background dark)) (:foreground "SkyBlue" :weight bold))      (((class color) (background dark)) (:foreground "SkyBlue" :weight bold))
112      (t (:weight bold)))      (t (:weight bold)))
113    "*The face used for highlight directories."    "*The face used for highlight directories."
114    :group 'eshell-ls)    :group 'eshell-ls)
115    ;; backward-compatibility alias
116    (put 'eshell-ls-directory-face 'face-alias 'eshell-ls-directory)
117    
118  (defface eshell-ls-symlink-face  (defface eshell-ls-symlink
119    '((((class color) (background light)) (:foreground "Dark Cyan" :weight bold))    '((((class color) (background light)) (:foreground "Dark Cyan" :weight bold))
120      (((class color) (background dark)) (:foreground "Cyan" :weight bold)))      (((class color) (background dark)) (:foreground "Cyan" :weight bold)))
121    "*The face used for highlight symbolic links."    "*The face used for highlight symbolic links."
122    :group 'eshell-ls)    :group 'eshell-ls)
123    ;; backward-compatibility alias
124    (put 'eshell-ls-symlink-face 'face-alias 'eshell-ls-symlink)
125    
126  (defface eshell-ls-executable-face  (defface eshell-ls-executable
127    '((((class color) (background light)) (:foreground "ForestGreen" :weight bold))    '((((class color) (background light)) (:foreground "ForestGreen" :weight bold))
128      (((class color) (background dark)) (:foreground "Green" :weight bold)))      (((class color) (background dark)) (:foreground "Green" :weight bold)))
129    "*The face used for highlighting executables (not directories, though)."    "*The face used for highlighting executables (not directories, though)."
130    :group 'eshell-ls)    :group 'eshell-ls)
131    ;; backward-compatibility alias
132    (put 'eshell-ls-executable-face 'face-alias 'eshell-ls-executable)
133    
134  (defface eshell-ls-readonly-face  (defface eshell-ls-readonly
135    '((((class color) (background light)) (:foreground "Brown"))    '((((class color) (background light)) (:foreground "Brown"))
136      (((class color) (background dark)) (:foreground "Pink")))      (((class color) (background dark)) (:foreground "Pink")))
137    "*The face used for highlighting read-only files."    "*The face used for highlighting read-only files."
138    :group 'eshell-ls)    :group 'eshell-ls)
139    ;; backward-compatibility alias
140    (put 'eshell-ls-readonly-face 'face-alias 'eshell-ls-readonly)
141    
142  (defface eshell-ls-unreadable-face  (defface eshell-ls-unreadable
143    '((((class color) (background light)) (:foreground "Grey30"))    '((((class color) (background light)) (:foreground "Grey30"))
144      (((class color) (background dark)) (:foreground "DarkGrey")))      (((class color) (background dark)) (:foreground "DarkGrey")))
145    "*The face used for highlighting unreadable files."    "*The face used for highlighting unreadable files."
146    :group 'eshell-ls)    :group 'eshell-ls)
147    ;; backward-compatibility alias
148    (put 'eshell-ls-unreadable-face 'face-alias 'eshell-ls-unreadable)
149    
150  (defface eshell-ls-special-face  (defface eshell-ls-special
151    '((((class color) (background light)) (:foreground "Magenta" :weight bold))    '((((class color) (background light)) (:foreground "Magenta" :weight bold))
152      (((class color) (background dark)) (:foreground "Magenta" :weight bold)))      (((class color) (background dark)) (:foreground "Magenta" :weight bold)))
153    "*The face used for highlighting non-regular files."    "*The face used for highlighting non-regular files."
154    :group 'eshell-ls)    :group 'eshell-ls)
155    ;; backward-compatibility alias
156    (put 'eshell-ls-special-face 'face-alias 'eshell-ls-special)
157    
158  (defface eshell-ls-missing-face  (defface eshell-ls-missing
159    '((((class color) (background light)) (:foreground "Red" :weight bold))    '((((class color) (background light)) (:foreground "Red" :weight bold))
160      (((class color) (background dark)) (:foreground "Red" :weight bold)))      (((class color) (background dark)) (:foreground "Red" :weight bold)))
161    "*The face used for highlighting non-existant file names."    "*The face used for highlighting non-existant file names."
162    :group 'eshell-ls)    :group 'eshell-ls)
163    ;; backward-compatibility alias
164    (put 'eshell-ls-missing-face 'face-alias 'eshell-ls-missing)
165    
166  (defcustom eshell-ls-archive-regexp  (defcustom eshell-ls-archive-regexp
167    (concat "\\.\\(t\\(a[rz]\\|gz\\)\\|arj\\|lzh\\|"    (concat "\\.\\(t\\(a[rz]\\|gz\\)\\|arj\\|lzh\\|"
# Line 158  files." Line 172  files."
172    :type 'regexp    :type 'regexp
173    :group 'eshell-ls)    :group 'eshell-ls)
174    
175  (defface eshell-ls-archive-face  (defface eshell-ls-archive
176    '((((class color) (background light)) (:foreground "Orchid" :weight bold))    '((((class color) (background light)) (:foreground "Orchid" :weight bold))
177      (((class color) (background dark)) (:foreground "Orchid" :weight bold)))      (((class color) (background dark)) (:foreground "Orchid" :weight bold)))
178    "*The face used for highlighting archived and compressed file names."    "*The face used for highlighting archived and compressed file names."
179    :group 'eshell-ls)    :group 'eshell-ls)
180    ;; backward-compatibility alias
181    (put 'eshell-ls-archive-face 'face-alias 'eshell-ls-archive)
182    
183  (defcustom eshell-ls-backup-regexp  (defcustom eshell-ls-backup-regexp
184    "\\(\\`\\.?#\\|\\(\\.bak\\|~\\)\\'\\)"    "\\(\\`\\.?#\\|\\(\\.bak\\|~\\)\\'\\)"
# Line 170  files." Line 186  files."
186    :type 'regexp    :type 'regexp
187    :group 'eshell-ls)    :group 'eshell-ls)
188    
189  (defface eshell-ls-backup-face  (defface eshell-ls-backup
190    '((((class color) (background light)) (:foreground "OrangeRed"))    '((((class color) (background light)) (:foreground "OrangeRed"))
191      (((class color) (background dark)) (:foreground "LightSalmon")))      (((class color) (background dark)) (:foreground "LightSalmon")))
192    "*The face used for highlighting backup file names."    "*The face used for highlighting backup file names."
193    :group 'eshell-ls)    :group 'eshell-ls)
194    ;; backward-compatibility alias
195    (put 'eshell-ls-backup-face 'face-alias 'eshell-ls-backup)
196    
197  (defcustom eshell-ls-product-regexp  (defcustom eshell-ls-product-regexp
198    "\\.\\(elc\\|o\\(bj\\)?\\|a\\|lib\\|res\\)\\'"    "\\.\\(elc\\|o\\(bj\\)?\\|a\\|lib\\|res\\)\\'"
# Line 184  ought to be recreatable if they are dele Line 202  ought to be recreatable if they are dele
202    :type 'regexp    :type 'regexp
203    :group 'eshell-ls)    :group 'eshell-ls)
204    
205  (defface eshell-ls-product-face  (defface eshell-ls-product
206    '((((class color) (background light)) (:foreground "OrangeRed"))    '((((class color) (background light)) (:foreground "OrangeRed"))
207      (((class color) (background dark)) (:foreground "LightSalmon")))      (((class color) (background dark)) (:foreground "LightSalmon")))
208    "*The face used for highlighting files that are build products."    "*The face used for highlighting files that are build products."
209    :group 'eshell-ls)    :group 'eshell-ls)
210    ;; backward-compatibility alias
211    (put 'eshell-ls-product-face 'face-alias 'eshell-ls-product)
212    
213  (defcustom eshell-ls-clutter-regexp  (defcustom eshell-ls-clutter-regexp
214    "\\(^texput\\.log\\|^core\\)\\'"    "\\(^texput\\.log\\|^core\\)\\'"
# Line 198  really need to stick around for very lon Line 218  really need to stick around for very lon
218    :type 'regexp    :type 'regexp
219    :group 'eshell-ls)    :group 'eshell-ls)
220    
221  (defface eshell-ls-clutter-face  (defface eshell-ls-clutter
222    '((((class color) (background light)) (:foreground "OrangeRed" :weight bold))    '((((class color) (background light)) (:foreground "OrangeRed" :weight bold))
223      (((class color) (background dark)) (:foreground "OrangeRed" :weight bold)))      (((class color) (background dark)) (:foreground "OrangeRed" :weight bold)))
224    "*The face used for highlighting junk file names."    "*The face used for highlighting junk file names."
225    :group 'eshell-ls)    :group 'eshell-ls)
226    ;; backward-compatibility alias
227    (put 'eshell-ls-clutter-face 'face-alias 'eshell-ls-clutter)
228    
229  (defsubst eshell-ls-filetype-p (attrs type)  (defsubst eshell-ls-filetype-p (attrs type)
230    "Test whether ATTRS specifies a directory."    "Test whether ATTRS specifies a directory."
# Line 847  Use TRUENAME for predicate tests, if pas Line 869  Use TRUENAME for predicate tests, if pas
869        (let ((face        (let ((face
870               (cond               (cond
871                ((not (cdr file))                ((not (cdr file))
872                 'eshell-ls-missing-face)                 'eshell-ls-missing)
873    
874                ((stringp (cadr file))                ((stringp (cadr file))
875                 'eshell-ls-symlink-face)                 'eshell-ls-symlink)
876    
877                ((eq (cadr file) t)                ((eq (cadr file) t)
878                 'eshell-ls-directory-face)                 'eshell-ls-directory)
879    
880                ((not (eshell-ls-filetype-p (cdr file) ?-))                ((not (eshell-ls-filetype-p (cdr file) ?-))
881                 'eshell-ls-special-face)                 'eshell-ls-special)
882    
883                ((and (/= (user-uid) 0) ; root can execute anything                ((and (/= (user-uid) 0) ; root can execute anything
884                      (eshell-ls-applicable (cdr file) 3                      (eshell-ls-applicable (cdr file) 3
885                                            'file-executable-p (car file)))                                            'file-executable-p (car file)))
886                 'eshell-ls-executable-face)                 'eshell-ls-executable)
887    
888                ((not (eshell-ls-applicable (cdr file) 1                ((not (eshell-ls-applicable (cdr file) 1
889                                            'file-readable-p (car file)))                                            'file-readable-p (car file)))
890                 'eshell-ls-unreadable-face)                 'eshell-ls-unreadable)
891    
892                ((string-match eshell-ls-archive-regexp (car file))                ((string-match eshell-ls-archive-regexp (car file))
893                 'eshell-ls-archive-face)                 'eshell-ls-archive)
894    
895                ((string-match eshell-ls-backup-regexp (car file))                ((string-match eshell-ls-backup-regexp (car file))
896                 'eshell-ls-backup-face)                 'eshell-ls-backup)
897    
898                ((string-match eshell-ls-product-regexp (car file))                ((string-match eshell-ls-product-regexp (car file))
899                 'eshell-ls-product-face)                 'eshell-ls-product)
900    
901                ((string-match eshell-ls-clutter-regexp (car file))                ((string-match eshell-ls-clutter-regexp (car file))
902                 'eshell-ls-clutter-face)                 'eshell-ls-clutter)
903    
904                ((not (eshell-ls-applicable (cdr file) 2                ((not (eshell-ls-applicable (cdr file) 2
905                                            'file-writable-p (car file)))                                            'file-writable-p (car file)))
906                 'eshell-ls-readonly-face)                 'eshell-ls-readonly)
907                (eshell-ls-highlight-alist                (eshell-ls-highlight-alist
908                 (let ((tests eshell-ls-highlight-alist)                 (let ((tests eshell-ls-highlight-alist)
909                       value)                       value)

Legend:
Removed from v.1.18  
changed lines
  Added in v.1.19

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26