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 |
|
|
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\\|" |
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\\|~\\)\\'\\)" |
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\\)\\'" |
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\\)\\'" |
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." |
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) |