| 1 |
|
|---|
| 2 |
|
|---|
| 3 |
|
|---|
| 4 |
|
|---|
| 5 |
|
|---|
| 6 |
|
|---|
| 7 |
|
|---|
| 8 |
|
|---|
| 9 |
|
|---|
| 10 |
|
|---|
| 11 |
|
|---|
| 12 |
|
|---|
| 13 |
|
|---|
| 14 |
|
|---|
| 15 |
|
|---|
| 16 |
|
|---|
| 17 |
|
|---|
| 18 |
|
|---|
| 19 |
|
|---|
| 20 |
|
|---|
| 21 |
|
|---|
| 22 |
|
|---|
| 23 |
|
|---|
| 24 |
|
|---|
| 25 |
(provide 'em-ls) |
|---|
| 26 |
|
|---|
| 27 |
(eval-when-compile (require 'esh-maint)) |
|---|
| 28 |
|
|---|
| 29 |
(defgroup eshell-ls nil |
|---|
| 30 |
"This module implements the \"ls\" utility fully in Lisp. If it is |
|---|
| 31 |
passed any unrecognized command switches, it will revert to the |
|---|
| 32 |
operating system's version. This version of \"ls\" uses text |
|---|
| 33 |
properties to colorize its output based on the setting of |
|---|
| 34 |
`eshell-ls-use-colors'." |
|---|
| 35 |
:tag "Implementation of `ls' in Lisp" |
|---|
| 36 |
:group 'eshell-module) |
|---|
| 37 |
|
|---|
| 38 |
|
|---|
| 39 |
|
|---|
| 40 |
|
|---|
| 41 |
|
|---|
| 42 |
|
|---|
| 43 |
(require 'esh-util) |
|---|
| 44 |
(require 'esh-opt) |
|---|
| 45 |
|
|---|
| 46 |
|
|---|
| 47 |
|
|---|
| 48 |
(defvar eshell-ls-orig-insert-directory |
|---|
| 49 |
(symbol-function 'insert-directory) |
|---|
| 50 |
"Preserve the original definition of `insert-directory'.") |
|---|
| 51 |
|
|---|
| 52 |
(defcustom eshell-ls-unload-hook |
|---|
| 53 |
(list |
|---|
| 54 |
(function |
|---|
| 55 |
(lambda () |
|---|
| 56 |
(fset 'insert-directory eshell-ls-orig-insert-directory)))) |
|---|
| 57 |
"*When unloading `eshell-ls', restore the definition of `insert-directory'." |
|---|
| 58 |
:type 'hook |
|---|
| 59 |
:group 'eshell-ls) |
|---|
| 60 |
|
|---|
| 61 |
(defcustom eshell-ls-initial-args nil |
|---|
| 62 |
"*If non-nil, this list of args is included before any call to `ls'. |
|---|
| 63 |
This is useful for enabling human-readable format (-h), for example." |
|---|
| 64 |
:type '(repeat :tag "Arguments" string) |
|---|
| 65 |
:group 'eshell-ls) |
|---|
| 66 |
|
|---|
| 67 |
(defcustom eshell-ls-dired-initial-args nil |
|---|
| 68 |
"*If non-nil, args is included before any call to `ls' in Dired. |
|---|
| 69 |
This is useful for enabling human-readable format (-h), for example." |
|---|
| 70 |
:type '(repeat :tag "Arguments" string) |
|---|
| 71 |
:group 'eshell-ls) |
|---|
| 72 |
|
|---|
| 73 |
(defcustom eshell-ls-use-in-dired nil |
|---|
| 74 |
"*If non-nil, use `eshell-ls' to read directories in Dired." |
|---|
| 75 |
:set (lambda (symbol value) |
|---|
| 76 |
(if value |
|---|
| 77 |
(unless (and (boundp 'eshell-ls-use-in-dired) |
|---|
| 78 |
eshell-ls-use-in-dired) |
|---|
| 79 |
(fset 'insert-directory 'eshell-ls-insert-directory)) |
|---|
| 80 |
(when (and (boundp 'eshell-ls-insert-directory) |
|---|
| 81 |
eshell-ls-use-in-dired) |
|---|
| 82 |
(fset 'insert-directory eshell-ls-orig-insert-directory))) |
|---|
| 83 |
(setq eshell-ls-use-in-dired value)) |
|---|
| 84 |
:type 'boolean |
|---|
| 85 |
:require 'em-ls |
|---|
| 86 |
:group 'eshell-ls) |
|---|
| 87 |
|
|---|
| 88 |
(defcustom eshell-ls-default-blocksize 1024 |
|---|
| 89 |
"*The default blocksize to use when display file sizes with -s." |
|---|
| 90 |
:type 'integer |
|---|
| 91 |
:group 'eshell-ls) |
|---|
| 92 |
|
|---|
| 93 |
(defcustom eshell-ls-exclude-regexp nil |
|---|
| 94 |
"*Unless -a is specified, files matching this regexp will not be shown." |
|---|
| 95 |
:type '(choice regexp (const nil)) |
|---|
| 96 |
:group 'eshell-ls) |
|---|
| 97 |
|
|---|
| 98 |
(defcustom eshell-ls-exclude-hidden t |
|---|
| 99 |
"*Unless -a is specified, files beginning with . will not be shown. |
|---|
| 100 |
Using this boolean, instead of `eshell-ls-exclude-regexp', is both |
|---|
| 101 |
faster and conserves more memory." |
|---|
| 102 |
:type 'boolean |
|---|
| 103 |
:group 'eshell-ls) |
|---|
| 104 |
|
|---|
| 105 |
(defcustom eshell-ls-use-colors t |
|---|
| 106 |
"*If non-nil, use colors in file listings." |
|---|
| 107 |
:type 'boolean |
|---|
| 108 |
:group 'eshell-ls) |
|---|
| 109 |
|
|---|
| 110 |
(defface eshell-ls-directory |
|---|
| 111 |
'((((class color) (background light)) (:foreground "Blue" :weight bold)) |
|---|
| 112 |
(((class color) (background dark)) (:foreground "SkyBlue" :weight bold)) |
|---|
| 113 |
(t (:weight bold))) |
|---|
| 114 |
"*The face used for highlight directories." |
|---|
| 115 |
:group 'eshell-ls) |
|---|
| 116 |
|
|---|
| 117 |
(put 'eshell-ls-directory-face 'face-alias 'eshell-ls-directory) |
|---|
| 118 |
|
|---|
| 119 |
(defface eshell-ls-symlink |
|---|
| 120 |
'((((class color) (background light)) (:foreground "Dark Cyan" :weight bold)) |
|---|
| 121 |
(((class color) (background dark)) (:foreground "Cyan" :weight bold))) |
|---|
| 122 |
"*The face used for highlight symbolic links." |
|---|
| 123 |
:group 'eshell-ls) |
|---|
| 124 |
|
|---|
| 125 |
(put 'eshell-ls-symlink-face 'face-alias 'eshell-ls-symlink) |
|---|
| 126 |
|
|---|
| 127 |
(defface eshell-ls-executable |
|---|
| 128 |
'((((class color) (background light)) (:foreground "ForestGreen" :weight bold)) |
|---|
| 129 |
(((class color) (background dark)) (:foreground "Green" :weight bold))) |
|---|
| 130 |
"*The face used for highlighting executables (not directories, though)." |
|---|
| 131 |
:group 'eshell-ls) |
|---|
| 132 |
|
|---|
| 133 |
(put 'eshell-ls-executable-face 'face-alias 'eshell-ls-executable) |
|---|
| 134 |
|
|---|
| 135 |
(defface eshell-ls-readonly |
|---|
| 136 |
'((((class color) (background light)) (:foreground "Brown")) |
|---|
| 137 |
(((class color) (background dark)) (:foreground "Pink"))) |
|---|
| 138 |
"*The face used for highlighting read-only files." |
|---|
| 139 |
:group 'eshell-ls) |
|---|
| 140 |
|
|---|
| 141 |
(put 'eshell-ls-readonly-face 'face-alias 'eshell-ls-readonly) |
|---|
| 142 |
|
|---|
| 143 |
(defface eshell-ls-unreadable |
|---|
| 144 |
'((((class color) (background light)) (:foreground "Grey30")) |
|---|
| 145 |
(((class color) (background dark)) (:foreground "DarkGrey"))) |
|---|
| 146 |
"*The face used for highlighting unreadable files." |
|---|
| 147 |
:group 'eshell-ls) |
|---|
| 148 |
|
|---|
| 149 |
(put 'eshell-ls-unreadable-face 'face-alias 'eshell-ls-unreadable) |
|---|
| 150 |
|
|---|
| 151 |
(defface eshell-ls-special |
|---|
| 152 |
'((((class color) (background light)) (:foreground "Magenta" :weight bold)) |
|---|
| 153 |
(((class color) (background dark)) (:foreground "Magenta" :weight bold))) |
|---|
| 154 |
"*The face used for highlighting non-regular files." |
|---|
| 155 |
:group 'eshell-ls) |
|---|
| 156 |
|
|---|
| 157 |
(put 'eshell-ls-special-face 'face-alias 'eshell-ls-special) |
|---|
| 158 |
|
|---|
| 159 |
(defface eshell-ls-missing |
|---|
| 160 |
'((((class color) (background light)) (:foreground "Red" :weight bold)) |
|---|
| 161 |
(((class color) (background dark)) (:foreground "Red" :weight bold))) |
|---|
| 162 |
"*The face used for highlighting non-existent file names." |
|---|
| 163 |
:group 'eshell-ls) |
|---|
| 164 |
|
|---|
| 165 |
(put 'eshell-ls-missing-face 'face-alias 'eshell-ls-missing) |
|---|
| 166 |
|
|---|
| 167 |
(defcustom eshell-ls-archive-regexp |
|---|
| 168 |
(concat "\\.\\(t\\(a[rz]\\|gz\\)\\|arj\\|lzh\\|" |
|---|
| 169 |
"zip\\|[zZ]\\|gz\\|bz2\\|deb\\|rpm\\)\\'") |
|---|
| 170 |
"*A regular expression that matches names of file archives. |
|---|
| 171 |
This typically includes both traditional archives and compressed |
|---|
| 172 |
files." |
|---|
| 173 |
:type 'regexp |
|---|
| 174 |
:group 'eshell-ls) |
|---|
| 175 |
|
|---|
| 176 |
(defface eshell-ls-archive |
|---|
| 177 |
'((((class color) (background light)) (:foreground "Orchid" :weight bold)) |
|---|
| 178 |
(((class color) (background dark)) (:foreground "Orchid" :weight bold))) |
|---|
| 179 |
"*The face used for highlighting archived and compressed file names." |
|---|
| 180 |
:group 'eshell-ls) |
|---|
| 181 |
|
|---|
| 182 |
(put 'eshell-ls-archive-face 'face-alias 'eshell-ls-archive) |
|---|
| 183 |
|
|---|
| 184 |
(defcustom eshell-ls-backup-regexp |
|---|
| 185 |
"\\(\\`\\.?#\\|\\(\\.bak\\|~\\)\\'\\)" |
|---|
| 186 |
"*A regular expression that matches names of backup files." |
|---|
| 187 |
:type 'regexp |
|---|
| 188 |
:group 'eshell-ls) |
|---|
| 189 |
|
|---|
| 190 |
(defface eshell-ls-backup |
|---|
| 191 |
'((((class color) (background light)) (:foreground "OrangeRed")) |
|---|
| 192 |
(((class color) (background dark)) (:foreground "LightSalmon"))) |
|---|
| 193 |
"*The face used for highlighting backup file names." |
|---|
| 194 |
:group 'eshell-ls) |
|---|
| 195 |
|
|---|
| 196 |
(put 'eshell-ls-backup-face 'face-alias 'eshell-ls-backup) |
|---|
| 197 |
|
|---|
| 198 |
(defcustom eshell-ls-product-regexp |
|---|
| 199 |
"\\.\\(elc\\|o\\(bj\\)?\\|a\\|lib\\|res\\)\\'" |
|---|
| 200 |
"*A regular expression that matches names of product files. |
|---|
| 201 |
Products are files that get generated from a source file, and hence |
|---|
| 202 |
ought to be recreatable if they are deleted." |
|---|
| 203 |
:type 'regexp |
|---|
| 204 |
:group 'eshell-ls) |
|---|
| 205 |
|
|---|
| 206 |
(defface eshell-ls-product |
|---|
| 207 |
'((((class color) (background light)) (:foreground "OrangeRed")) |
|---|
| 208 |
(((class color) (background dark)) (:foreground "LightSalmon"))) |
|---|
| 209 |
"*The face used for highlighting files that are build products." |
|---|
| 210 |
:group 'eshell-ls) |
|---|
| 211 |
|
|---|
| 212 |
(put 'eshell-ls-product-face 'face-alias 'eshell-ls-product) |
|---|
| 213 |
|
|---|
| 214 |
(defcustom eshell-ls-clutter-regexp |
|---|
| 215 |
"\\(^texput\\.log\\|^core\\)\\'" |
|---|
| 216 |
"*A regular expression that matches names of junk files. |
|---|
| 217 |
These are mainly files that get created for various reasons, but don't |
|---|
| 218 |
really need to stick around for very long." |
|---|
| 219 |
:type 'regexp |
|---|
| 220 |
:group 'eshell-ls) |
|---|
| 221 |
|
|---|
| 222 |
(defface eshell-ls-clutter |
|---|
| 223 |
'((((class color) (background light)) (:foreground "OrangeRed" :weight bold)) |
|---|
| 224 |
(((class color) (background dark)) (:foreground "OrangeRed" :weight bold))) |
|---|
| 225 |
"*The face used for highlighting junk file names." |
|---|
| 226 |
:group 'eshell-ls) |
|---|
| 227 |
|
|---|
| 228 |
(put 'eshell-ls-clutter-face 'face-alias 'eshell-ls-clutter) |
|---|
| 229 |
|
|---|
| 230 |
(defsubst eshell-ls-filetype-p (attrs type) |
|---|
| 231 |
"Test whether ATTRS specifies a directory." |
|---|
| 232 |
(if (nth 8 attrs) |
|---|
| 233 |
(eq (aref (nth 8 attrs) 0) type))) |
|---|
| 234 |
|
|---|
| 235 |
(defmacro eshell-ls-applicable (attrs index func file) |
|---|
| 236 |
"Test whether, for ATTRS, the user UID can do what corresponds to INDEX. |
|---|
| 237 |
This is really just for efficiency, to avoid having to stat the file |
|---|
| 238 |
yet again." |
|---|
| 239 |
`(if (numberp (nth 2 ,attrs)) |
|---|
| 240 |
(if (= (user-uid) (nth 2 ,attrs)) |
|---|
| 241 |
(not (eq (aref (nth 8 ,attrs) ,index) ?-)) |
|---|
| 242 |
(,(eval func) ,file)) |
|---|
| 243 |
(not (eq (aref (nth 8 ,attrs) |
|---|
| 244 |
(+ ,index (if (member (nth 2 ,attrs) |
|---|
| 245 |
(eshell-current-ange-uids)) |
|---|
| 246 |
0 6))) |
|---|
| 247 |
?-)))) |
|---|
| 248 |
|
|---|
| 249 |
(defcustom eshell-ls-highlight-alist nil |
|---|
| 250 |
"*This alist correlates test functions to color. |
|---|
| 251 |
The format of the members of this alist is |
|---|
| 252 |
|
|---|
| 253 |
(TEST-SEXP . FACE) |
|---|
| 254 |
|
|---|
| 255 |
If TEST-SEXP evals to non-nil, that face will be used to highlight the |
|---|
| 256 |
name of the file. The first match wins. `file' and `attrs' are in |
|---|
| 257 |
scope during the evaluation of TEST-SEXP." |
|---|
| 258 |
:type '(repeat (cons function face)) |
|---|
| 259 |
:group 'eshell-ls) |
|---|
| 260 |
|
|---|
| 261 |
|
|---|
| 262 |
|
|---|
| 263 |
(defun eshell-ls-insert-directory |
|---|
| 264 |
(file switches &optional wildcard full-directory-p) |
|---|
| 265 |
"Insert directory listing for FILE, formatted according to SWITCHES. |
|---|
| 266 |
Leaves point after the inserted text. |
|---|
| 267 |
SWITCHES may be a string of options, or a list of strings. |
|---|
| 268 |
Optional third arg WILDCARD means treat FILE as shell wildcard. |
|---|
| 269 |
Optional fourth arg FULL-DIRECTORY-P means file is a directory and |
|---|
| 270 |
switches do not contain `d', so that a full listing is expected. |
|---|
| 271 |
|
|---|
| 272 |
This version of the function uses `eshell/ls'. If any of the switches |
|---|
| 273 |
passed are not recognized, the operating system's version will be used |
|---|
| 274 |
instead." |
|---|
| 275 |
(let ((handler (find-file-name-handler file 'insert-directory))) |
|---|
| 276 |
(if handler |
|---|
| 277 |
(funcall handler 'insert-directory file switches |
|---|
| 278 |
wildcard full-directory-p) |
|---|
| 279 |
(if (stringp switches) |
|---|
| 280 |
(setq switches (split-string switches))) |
|---|
| 281 |
(let (eshell-current-handles |
|---|
| 282 |
eshell-current-subjob-p |
|---|
| 283 |
font-lock-mode) |
|---|
| 284 |
|
|---|
| 285 |
(when (and eshell-ls-use-colors |
|---|
| 286 |
(featurep 'font-lock)) |
|---|
| 287 |
(font-lock-mode -1) |
|---|
| 288 |
(setq font-lock-defaults nil) |
|---|
| 289 |
(if (boundp 'font-lock-buffers) |
|---|
| 290 |
(set 'font-lock-buffers |
|---|
| 291 |
(delq (current-buffer) |
|---|
| 292 |
(symbol-value 'font-lock-buffers))))) |
|---|
| 293 |
(let ((insert-func 'insert) |
|---|
| 294 |
(error-func 'insert) |
|---|
| 295 |
(flush-func 'ignore) |
|---|
| 296 |
eshell-ls-dired-initial-args) |
|---|
| 297 |
(eshell-do-ls (append switches (list file)))))))) |
|---|
| 298 |
|
|---|
| 299 |
(defsubst eshell/ls (&rest args) |
|---|
| 300 |
"An alias version of `eshell-do-ls'." |
|---|
| 301 |
(let ((insert-func 'eshell-buffered-print) |
|---|
| 302 |
(error-func 'eshell-error) |
|---|
| 303 |
(flush-func 'eshell-flush)) |
|---|
| 304 |
(eshell-do-ls args))) |
|---|
| 305 |
|
|---|
| 306 |
(put 'eshell/ls 'eshell-no-numeric-conversions t) |
|---|
| 307 |
|
|---|
| 308 |
(eval-when-compile |
|---|
| 309 |
(defvar block-size) |
|---|
| 310 |
(defvar dereference-links) |
|---|
| 311 |
(defvar dir-literal) |
|---|
| 312 |
(defvar error-func) |
|---|
| 313 |
(defvar flush-func) |
|---|
| 314 |
(defvar human-readable) |
|---|
| 315 |
(defvar ignore-pattern) |
|---|
| 316 |
(defvar insert-func) |
|---|
| 317 |
(defvar listing-style) |
|---|
| 318 |
(defvar numeric-uid-gid) |
|---|
| 319 |
(defvar reverse-list) |
|---|
| 320 |
(defvar show-all) |
|---|
| 321 |
(defvar show-recursive) |
|---|
| 322 |
(defvar show-size) |
|---|
| 323 |
(defvar sort-method) |
|---|
| 324 |
(defvar ange-cache) |
|---|
| 325 |
(defvar dired-flag)) |
|---|
| 326 |
|
|---|
| 327 |
(defun eshell-do-ls (&rest args) |
|---|
| 328 |
"Implementation of \"ls\" in Lisp, passing ARGS." |
|---|
| 329 |
(funcall flush-func -1) |
|---|
| 330 |
|
|---|
| 331 |
(eshell-eval-using-options |
|---|
| 332 |
"ls" (if eshell-ls-initial-args |
|---|
| 333 |
(list eshell-ls-initial-args args) |
|---|
| 334 |
args) |
|---|
| 335 |
`((?a "all" nil show-all |
|---|
| 336 |
"show all files in directory") |
|---|
| 337 |
(?c nil by-ctime sort-method |
|---|
| 338 |
"sort by last status change time") |
|---|
| 339 |
(?d "directory" nil dir-literal |
|---|
| 340 |
"list directory entries instead of contents") |
|---|
| 341 |
(?k "kilobytes" 1024 block-size |
|---|
| 342 |
"using 1024 as the block size") |
|---|
| 343 |
(?h "human-readable" 1024 human-readable |
|---|
| 344 |
"print sizes in human readable format") |
|---|
| 345 |
(?H "si" 1000 human-readable |
|---|
| 346 |
"likewise, but use powers of 1000 not 1024") |
|---|
| 347 |
(?I "ignore" t ignore-pattern |
|---|
| 348 |
"do not list implied entries matching pattern") |
|---|
| 349 |
(?l nil long-listing listing-style |
|---|
| 350 |
"use a long listing format") |
|---|
| 351 |
(?n "numeric-uid-gid" nil numeric-uid-gid |
|---|
| 352 |
"list numeric UIDs and GIDs instead of names") |
|---|
| 353 |
(?r "reverse" nil reverse-list |
|---|
| 354 |
"reverse order while sorting") |
|---|
| 355 |
(?s "size" nil show-size |
|---|
| 356 |
"print size of each file, in blocks") |
|---|
| 357 |
(?t nil by-mtime sort-method |
|---|
| 358 |
"sort by modification time") |
|---|
| 359 |
(?u nil by-atime sort-method |
|---|
| 360 |
"sort by last access time") |
|---|
| 361 |
(?x nil by-lines listing-style |
|---|
| 362 |
"list entries by lines instead of by columns") |
|---|
| 363 |
(?C nil by-columns listing-style |
|---|
| 364 |
"list entries by columns") |
|---|
| 365 |
(?L "deference" nil dereference-links |
|---|
| 366 |
"list entries pointed to by symbolic links") |
|---|
| 367 |
(?R "recursive" nil show-recursive |
|---|
| 368 |
"list subdirectories recursively") |
|---|
| 369 |
(?S nil by-size sort-method |
|---|
| 370 |
"sort by file size") |
|---|
| 371 |
(?U nil unsorted sort-method |
|---|
| 372 |
"do not sort; list entries in directory order") |
|---|
| 373 |
(?X nil by-extension sort-method |
|---|
| 374 |
"sort alphabetically by entry extension") |
|---|
| 375 |
(?1 nil single-column listing-style |
|---|
| 376 |
"list one file per line") |
|---|
| 377 |
(nil "dired" nil dired-flag |
|---|
| 378 |
"Here for compatibility with GNU ls.") |
|---|
| 379 |
(nil "help" nil nil |
|---|
| 380 |
"show this usage display") |
|---|
| 381 |
:external "ls" |
|---|
| 382 |
:usage "[OPTION]... [FILE]... |
|---|
| 383 |
List information about the FILEs (the current directory by default). |
|---|
| 384 |
Sort entries alphabetically across.") |
|---|
| 385 |
|
|---|
| 386 |
(unless block-size |
|---|
| 387 |
(setq block-size eshell-ls-default-blocksize)) |
|---|
| 388 |
(unless listing-style |
|---|
| 389 |
(setq listing-style 'by-columns)) |
|---|
| 390 |
(unless args |
|---|
| 391 |
(setq args (list "."))) |
|---|
| 392 |
(let ((eshell-ls-exclude-regexp eshell-ls-exclude-regexp) ange-cache) |
|---|
| 393 |
(when ignore-pattern |
|---|
| 394 |
(unless (eshell-using-module 'eshell-glob) |
|---|
| 395 |
(error (concat "-I option requires that `eshell-glob'" |
|---|
| 396 |
" be a member of `eshell-modules-list'"))) |
|---|
| 397 |
(set-text-properties 0 (length ignore-pattern) nil ignore-pattern) |
|---|
| 398 |
(setq eshell-ls-exclude-regexp |
|---|
| 399 |
(if eshell-ls-exclude-regexp |
|---|
| 400 |
(concat "\\(" eshell-ls-exclude-regexp "\\|" |
|---|
| 401 |
(eshell-glob-regexp ignore-pattern) "\\)") |
|---|
| 402 |
(eshell-glob-regexp ignore-pattern)))) |
|---|
| 403 |
|
|---|
| 404 |
(eshell-ls-entries |
|---|
| 405 |
(mapcar (function |
|---|
| 406 |
(lambda (arg) |
|---|
| 407 |
(cons (if (and (eshell-under-windows-p) |
|---|
| 408 |
(file-name-absolute-p arg)) |
|---|
| 409 |
(expand-file-name arg) |
|---|
| 410 |
arg) |
|---|
| 411 |
(eshell-file-attributes arg)))) |
|---|
| 412 |
args) |
|---|
| 413 |
t (expand-file-name default-directory))) |
|---|
| 414 |
(funcall flush-func))) |
|---|
| 415 |
|
|---|
| 416 |
(defsubst eshell-ls-printable-size (filesize &optional by-blocksize) |
|---|
| 417 |
"Return a printable FILESIZE." |
|---|
| 418 |
(eshell-printable-size filesize human-readable |
|---|
| 419 |
(and by-blocksize block-size) |
|---|
| 420 |
eshell-ls-use-colors)) |
|---|
| 421 |
|
|---|
| 422 |
(defsubst eshell-ls-size-string (attrs size-width) |
|---|
| 423 |
"Return the size string for ATTRS length, using SIZE-WIDTH." |
|---|
| 424 |
(let* ((str (eshell-ls-printable-size (nth 7 attrs) t)) |
|---|
| 425 |
(len (length str))) |
|---|
| 426 |
(if (< len size-width) |
|---|
| 427 |
(concat (make-string (- size-width len) ? ) str) |
|---|
| 428 |
str))) |
|---|
| 429 |
|
|---|
| 430 |
(defun eshell-ls-annotate (fileinfo) |
|---|
| 431 |
"Given a FILEINFO object, return a resolved, decorated FILEINFO. |
|---|
| 432 |
This means resolving any symbolic links, determining what face the |
|---|
| 433 |
name should be displayed as, etc. Think of it as cooking a FILEINFO." |
|---|
| 434 |
(if (not (and (stringp (cadr fileinfo)) |
|---|
| 435 |
(or dereference-links |
|---|
| 436 |
(eq listing-style 'long-listing)))) |
|---|
| 437 |
(setcar fileinfo (eshell-ls-decorated-name fileinfo)) |
|---|
| 438 |
(let (dir attr) |
|---|
| 439 |
(unless (file-name-absolute-p (cadr fileinfo)) |
|---|
| 440 |
(setq dir (file-truename |
|---|
| 441 |
(file-name-directory |
|---|
| 442 |
(expand-file-name (car fileinfo)))))) |
|---|
| 443 |
(setq attr |
|---|
| 444 |
(eshell-file-attributes |
|---|
| 445 |
(let ((target (if dir |
|---|
| 446 |
(expand-file-name (cadr fileinfo) dir) |
|---|
| 447 |
(cadr fileinfo)))) |
|---|
| 448 |
(if dereference-links |
|---|
| 449 |
(file-truename target) |
|---|
| 450 |
target)))) |
|---|
| 451 |
(if (or dereference-links |
|---|
| 452 |
(string-match "^\\.\\.?$" (car fileinfo))) |
|---|
| 453 |
(progn |
|---|
| 454 |
(setcdr fileinfo attr) |
|---|
| 455 |
(setcar fileinfo (eshell-ls-decorated-name fileinfo))) |
|---|
| 456 |
(assert (eq listing-style 'long-listing)) |
|---|
| 457 |
(setcar fileinfo |
|---|
| 458 |
(concat (eshell-ls-decorated-name fileinfo) " -> " |
|---|
| 459 |
(eshell-ls-decorated-name |
|---|
| 460 |
(cons (cadr fileinfo) attr))))))) |
|---|
| 461 |
fileinfo) |
|---|
| 462 |
|
|---|
| 463 |
(defun eshell-ls-file (fileinfo &optional size-width copy-fileinfo) |
|---|
| 464 |
"Output FILE in long format. |
|---|
| 465 |
FILE may be a string, or a cons cell whose car is the filename and |
|---|
| 466 |
whose cdr is the list of file attributes." |
|---|
| 467 |
(if (not (cdr fileinfo)) |
|---|
| 468 |
(funcall error-func (format "%s: No such file or directory\n" |
|---|
| 469 |
(car fileinfo))) |
|---|
| 470 |
(setq fileinfo |
|---|
| 471 |
(eshell-ls-annotate (if copy-fileinfo |
|---|
| 472 |
(cons (car fileinfo) |
|---|
| 473 |
(cdr fileinfo)) |
|---|
| 474 |
fileinfo))) |
|---|
| 475 |
(let ((file (car fileinfo)) |
|---|
| 476 |
(attrs (cdr fileinfo))) |
|---|
| 477 |
(if (not (eq listing-style 'long-listing)) |
|---|
| 478 |
(if show-size |
|---|
| 479 |
(funcall insert-func (eshell-ls-size-string attrs size-width) |
|---|
| 480 |
" " file "\n") |
|---|
| 481 |
(funcall insert-func file "\n")) |
|---|
| 482 |
(let ((line |
|---|
| 483 |
(concat |
|---|
| 484 |
(if show-size |
|---|
| 485 |
(concat (eshell-ls-size-string attrs size-width) " ")) |
|---|
| 486 |
(format |
|---|
| 487 |
"%s%4d %-8s %-8s " |
|---|
| 488 |
(or (nth 8 attrs) "??????????") |
|---|
| 489 |
(or (nth 1 attrs) 0) |
|---|
| 490 |
(or (let ((user (nth 2 attrs))) |
|---|
| 491 |
(and (not numeric-uid-gid) |
|---|
| 492 |
user |
|---|
| 493 |
(eshell-substring |
|---|
| 494 |
(if (numberp user) |
|---|
| 495 |
(user-login-name user) |
|---|
| 496 |
user) 8))) |
|---|
| 497 |
(nth 2 attrs) |
|---|
| 498 |
"") |
|---|
| 499 |
(or (let ((group (nth 3 attrs))) |
|---|
| 500 |
(and (not numeric-uid-gid) |
|---|
| 501 |
group |
|---|
| 502 |
(eshell-substring |
|---|
| 503 |
(if (numberp group) |
|---|
| 504 |
(eshell-group-name group) |
|---|
| 505 |
group) 8))) |
|---|
| 506 |
(nth 3 attrs) |
|---|
| 507 |
"")) |
|---|
| 508 |
(let* ((str (eshell-ls-printable-size (nth 7 attrs))) |
|---|
| 509 |
(len (length str))) |
|---|
| 510 |
(if (< len (or size-width 4)) |
|---|
| 511 |
(concat (make-string (- (or size-width 4) len) ? ) str) |
|---|
| 512 |
str)) |
|---|
| 513 |
" " (format-time-string |
|---|
| 514 |
(concat |
|---|
| 515 |
"%b %e " |
|---|
| 516 |
(if (= (nth 5 (decode-time (current-time))) |
|---|
| 517 |
(nth 5 (decode-time |
|---|
| 518 |
(nth (cond |
|---|
| 519 |
((eq sort-method 'by-atime) 4) |
|---|
| 520 |
((eq sort-method 'by-ctime) 6) |
|---|
| 521 |
(t 5)) attrs)))) |
|---|
| 522 |
"%H:%M" |
|---|
| 523 |
" %Y")) (nth (cond |
|---|
| 524 |
((eq sort-method 'by-atime) 4) |
|---|
| 525 |
((eq sort-method 'by-ctime) 6) |
|---|
| 526 |
(t 5)) attrs)) " "))) |
|---|
| 527 |
(funcall insert-func line file "\n")))))) |
|---|
| 528 |
|
|---|
| 529 |
(defun eshell-ls-dir (dirinfo &optional insert-name root-dir size-width) |
|---|
| 530 |
"Output the entries in DIRINFO. |
|---|
| 531 |
If INSERT-NAME is non-nil, the name of DIRINFO will be output. If |
|---|
| 532 |
ROOT-DIR is also non-nil, and a directory name, DIRINFO will be output |
|---|
| 533 |
relative to that directory." |
|---|
| 534 |
(let ((dir (car dirinfo))) |
|---|
| 535 |
(if (not (cdr dirinfo)) |
|---|
| 536 |
(funcall error-func (format "%s: No such file or directory\n" dir)) |
|---|
| 537 |
(if dir-literal |
|---|
| 538 |
(eshell-ls-file dirinfo size-width) |
|---|
| 539 |
(if insert-name |
|---|
| 540 |
(funcall insert-func |
|---|
| 541 |
(eshell-ls-decorated-name |
|---|
| 542 |
(cons (concat |
|---|
| 543 |
(if root-dir |
|---|
| 544 |
(file-relative-name dir root-dir) |
|---|
| 545 |
(expand-file-name dir))) |
|---|
| 546 |
(cdr dirinfo))) ":\n")) |
|---|
| 547 |
(let ((entries (eshell-directory-files-and-attributes |
|---|
| 548 |
dir nil (and (not show-all) |
|---|
| 549 |
eshell-ls-exclude-hidden |
|---|
| 550 |
"\\`[^.]") t))) |
|---|
| 551 |
(when (and (not show-all) eshell-ls-exclude-regexp) |
|---|
| 552 |
(while (and entries (string-match eshell-ls-exclude-regexp |
|---|
| 553 |
(caar entries))) |
|---|
| 554 |
(setq entries (cdr entries))) |
|---|
| 555 |
(let ((e entries)) |
|---|
| 556 |
(while (cdr e) |
|---|
| 557 |
(if (string-match eshell-ls-exclude-regexp (car (cadr e))) |
|---|
| 558 |
(setcdr e (cddr e)) |
|---|
| 559 |
(setq e (cdr e)))))) |
|---|
| 560 |
(when (or (eq listing-style 'long-listing) show-size) |
|---|
| 561 |
(let ((total 0.0)) |
|---|
| 562 |
(setq size-width 0) |
|---|
| 563 |
(eshell-for e entries |
|---|
| 564 |
(if (nth 7 (cdr e)) |
|---|
| 565 |
(setq total (+ total (nth 7 (cdr e))) |
|---|
| 566 |
size-width |
|---|
| 567 |
(max size-width |
|---|
| 568 |
(length (eshell-ls-printable-size |
|---|
| 569 |
(nth 7 (cdr e)) t)))))) |
|---|
| 570 |
(funcall insert-func "total " |
|---|
| 571 |
(eshell-ls-printable-size total t) "\n"))) |
|---|
| 572 |
(let ((default-directory (expand-file-name dir))) |
|---|
| 573 |
(if show-recursive |
|---|
| 574 |
(eshell-ls-entries |
|---|
| 575 |
(let ((e entries) (good-entries (list t))) |
|---|
| 576 |
(while e |
|---|
| 577 |
(unless (let ((len (length (caar e)))) |
|---|
| 578 |
(and (eq (aref (caar e) 0) ?.) |
|---|
| 579 |
(or (= len 1) |
|---|
| 580 |
(and (= len 2) |
|---|
| 581 |
(eq (aref (caar e) 1) ?.))))) |
|---|
| 582 |
(nconc good-entries (list (car e)))) |
|---|
| 583 |
(setq e (cdr e))) |
|---|
| 584 |
(cdr good-entries)) |
|---|
| 585 |
nil root-dir) |
|---|
| 586 |
(eshell-ls-files (eshell-ls-sort-entries entries) |
|---|
| 587 |
size-width)))))))) |
|---|
| 588 |
|
|---|
| 589 |
(defsubst eshell-ls-compare-entries (l r inx func) |
|---|
| 590 |
"Compare the time of two files, L and R, the attribute indexed by INX." |
|---|
| 591 |
(let ((lt (nth inx (cdr l))) |
|---|
| 592 |
(rt (nth inx (cdr r)))) |
|---|
| 593 |
(if (equal lt rt) |
|---|
| 594 |
(string-lessp (directory-file-name (car l)) |
|---|
| 595 |
(directory-file-name (car r))) |
|---|
| 596 |
(funcall func rt lt)))) |
|---|
| 597 |
|
|---|
| 598 |
(defun eshell-ls-sort-entries (entries) |
|---|
| 599 |
"Sort the given ENTRIES, which may be files, directories or both. |
|---|
| 600 |
In Eshell's implementation of ls, ENTRIES is always reversed." |
|---|
| 601 |
(if (eq sort-method 'unsorted) |
|---|
| 602 |
(nreverse entries) |
|---|
| 603 |
(sort entries |
|---|
| 604 |
(function |
|---|
| 605 |
(lambda (l r) |
|---|
| 606 |
(let ((result |
|---|
| 607 |
(cond |
|---|
| 608 |
((eq sort-method 'by-atime) |
|---|
| 609 |
(eshell-ls-compare-entries l r 4 'eshell-time-less-p)) |
|---|
| 610 |
((eq sort-method 'by-mtime) |
|---|
| 611 |
(eshell-ls-compare-entries l r 5 'eshell-time-less-p)) |
|---|
| 612 |
((eq sort-method 'by-ctime) |
|---|
| 613 |
(eshell-ls-compare-entries l r 6 'eshell-time-less-p)) |
|---|
| 614 |
((eq sort-method 'by-size) |
|---|
| 615 |
(eshell-ls-compare-entries l r 7 '<)) |
|---|
| 616 |
((eq sort-method 'by-extension) |
|---|
| 617 |
(let ((lx (file-name-extension |
|---|
| 618 |
(directory-file-name (car l)))) |
|---|
| 619 |
(rx (file-name-extension |
|---|
| 620 |
(directory-file-name (car r))))) |
|---|
| 621 |
(cond |
|---|
| 622 |
((or (and (not lx) (not rx)) |
|---|
| 623 |
(equal lx rx)) |
|---|
| 624 |
(string-lessp (directory-file-name (car l)) |
|---|
| 625 |
(directory-file-name (car r)))) |
|---|
| 626 |
((not lx) t) |
|---|
| 627 |
((not rx) nil) |
|---|
| 628 |
(t |
|---|
| 629 |
(string-lessp lx rx))))) |
|---|
| 630 |
(t |
|---|
| 631 |
(string-lessp (directory-file-name (car l)) |
|---|
| 632 |
(directory-file-name (car r))))))) |
|---|
| 633 |
(if reverse-list |
|---|
| 634 |
(not result) |
|---|
| 635 |
result))))))) |
|---|
| 636 |
|
|---|
| 637 |
(defun eshell-ls-files (files &optional size-width copy-fileinfo) |
|---|
| 638 |
"Output a list of FILES. |
|---|
| 639 |
Each member of FILES is either a string or a cons cell of the form |
|---|
| 640 |
\(FILE . ATTRS)." |
|---|
| 641 |
(if (memq listing-style '(long-listing single-column)) |
|---|
| 642 |
(eshell-for file files |
|---|
| 643 |
(if file |
|---|
| 644 |
(eshell-ls-file file size-width copy-fileinfo))) |
|---|
| 645 |
(let ((f files) |
|---|
| 646 |
last-f |
|---|
| 647 |
display-files |
|---|
| 648 |
ignore) |
|---|
| 649 |
(while f |
|---|
| 650 |
(if (cdar f) |
|---|
| 651 |
(setq last-f f |
|---|
| 652 |
f (cdr f)) |
|---|
| 653 |
(unless ignore |
|---|
| 654 |
(funcall error-func |
|---|
| 655 |
(format "%s: No such file or directory\n" (caar f)))) |
|---|
| 656 |
(if (eq f files) |
|---|
| 657 |
(setq files (cdr files) |
|---|
| 658 |
f files) |
|---|
| 659 |
(if (not (cdr f)) |
|---|
| 660 |
(progn |
|---|
| 661 |
(setcdr last-f nil) |
|---|
| 662 |
(setq f nil)) |
|---|
| 663 |
(setcar f (cadr f)) |
|---|
| 664 |
(setcdr f (cddr f)))))) |
|---|
| 665 |
(if (not show-size) |
|---|
| 666 |
(setq display-files (mapcar 'eshell-ls-annotate files)) |
|---|
| 667 |
(eshell-for file files |
|---|
| 668 |
(let* ((str (eshell-ls-printable-size (nth 7 (cdr file)) t)) |
|---|
| 669 |
(len (length str))) |
|---|
| 670 |
(if (< len size-width) |
|---|
| 671 |
(setq str (concat (make-string (- size-width len) ? ) str))) |
|---|
| 672 |
(setq file (eshell-ls-annotate file) |
|---|
| 673 |
display-files (cons (cons (concat str " " (car file)) |
|---|
| 674 |
(cdr file)) |
|---|
| 675 |
display-files)))) |
|---|
| 676 |
(setq display-files (nreverse display-files))) |
|---|
| 677 |
(let* ((col-vals |
|---|
| 678 |
(if (eq listing-style 'by-columns) |
|---|
| 679 |
(eshell-ls-find-column-lengths display-files) |
|---|
| 680 |
(assert (eq listing-style 'by-lines)) |
|---|
| 681 |
(eshell-ls-find-column-widths display-files))) |
|---|
| 682 |
(col-widths (car col-vals)) |
|---|
| 683 |
(display-files (cdr col-vals)) |
|---|
| 684 |
(columns (length col-widths)) |
|---|
| 685 |
(col-index 1) |
|---|
| 686 |
need-return) |
|---|
| 687 |
(eshell-for file display-files |
|---|
| 688 |
(let ((name |
|---|
| 689 |
(if (car file) |
|---|
| 690 |
(if show-size |
|---|
| 691 |
(concat (substring (car file) 0 size-width) |
|---|
| 692 |
(eshell-ls-decorated-name |
|---|
| 693 |
(cons (substring (car file) size-width) |
|---|
| 694 |
(cdr file)))) |
|---|
| 695 |
(eshell-ls-decorated-name file)) |
|---|
| 696 |
""))) |
|---|
| 697 |
(if (< col-index columns) |
|---|
| 698 |
(setq need-return |
|---|
| 699 |
(concat need-return name |
|---|
| 700 |
(make-string |
|---|
| 701 |
(max 0 (- (aref col-widths |
|---|
| 702 |
(1- col-index)) |
|---|
| 703 |
(length name))) ? )) |
|---|
| 704 |
col-index (1+ col-index)) |
|---|
| 705 |
(funcall insert-func need-return name "\n") |
|---|
| 706 |
(setq col-index 1 need-return nil)))) |
|---|
| 707 |
(if need-return |
|---|
| 708 |
(funcall insert-func need-return "\n")))))) |
|---|
| 709 |
|
|---|
| 710 |
(defun eshell-ls-entries (entries &optional separate root-dir) |
|---|
| 711 |
"Output PATH's directory ENTRIES, formatted according to OPTIONS. |
|---|
| 712 |
Each member of ENTRIES may either be a string or a cons cell, the car |
|---|
| 713 |
of which is the file name, and the cdr of which is the list of |
|---|
| 714 |
attributes. |
|---|
| 715 |
If SEPARATE is non-nil, directories name will be entirely separated |
|---|
| 716 |
from the filenames. This is the normal behavior, except when doing a |
|---|
| 717 |
recursive listing. |
|---|
| 718 |
ROOT-DIR, if non-nil, specifies the root directory of the listing, to |
|---|
| 719 |
which non-absolute directory names will be made relative if ever they |
|---|
| 720 |
need to be printed." |
|---|
| 721 |
(let (dirs files show-names need-return (size-width 0)) |
|---|
| 722 |
(eshell-for entry entries |
|---|
| 723 |
(if (and (not dir-literal) |
|---|
| 724 |
(or (eshell-ls-filetype-p (cdr entry) ?d) |
|---|
| 725 |
(and (eshell-ls-filetype-p (cdr entry) ?l) |
|---|
| 726 |
(file-directory-p (car entry))))) |
|---|
| 727 |
(progn |
|---|
| 728 |
(unless separate |
|---|
| 729 |
(setq files (cons entry files) |
|---|
| 730 |
size-width |
|---|
| 731 |
(if show-size |
|---|
| 732 |
(max size-width |
|---|
| 733 |
(length (eshell-ls-printable-size |
|---|
| 734 |
(nth 7 (cdr entry)) t)))))) |
|---|
| 735 |
(setq dirs (cons entry dirs))) |
|---|
| 736 |
(setq files (cons entry files) |
|---|
| 737 |
size-width |
|---|
| 738 |
(if show-size |
|---|
| 739 |
(max size-width |
|---|
| 740 |
(length (eshell-ls-printable-size |
|---|
| 741 |
(nth 7 (cdr entry)) t))))))) |
|---|
| 742 |
(when files |
|---|
| 743 |
(eshell-ls-files (eshell-ls-sort-entries files) |
|---|
| 744 |
size-width show-recursive) |
|---|
| 745 |
(setq need-return t)) |
|---|
| 746 |
(setq show-names (or show-recursive |
|---|
| 747 |
(> (+ (length files) (length dirs)) 1))) |
|---|
| 748 |
(eshell-for dir (eshell-ls-sort-entries dirs) |
|---|
| 749 |
(if (and need-return (not dir-literal)) |
|---|
| 750 |
(funcall insert-func "\n")) |
|---|
| 751 |
(eshell-ls-dir dir show-names |
|---|
| 752 |
(unless (file-name-absolute-p (car dir)) root-dir) |
|---|
| 753 |
size-width) |
|---|
| 754 |
(setq need-return t)))) |
|---|
| 755 |
|
|---|
| 756 |
(defun eshell-ls-find-column-widths (files) |
|---|
| 757 |
"Find the best fitting column widths for FILES. |
|---|
| 758 |
It will be returned as a vector, whose length is the number of columns |
|---|
| 759 |
to use, and each member of which is the width of that column |
|---|
| 760 |
\(including spacing)." |
|---|
| 761 |
(let* ((numcols 0) |
|---|
| 762 |
(width 0) |
|---|
| 763 |
(widths |
|---|
| 764 |
(mapcar |
|---|
| 765 |
(function |
|---|
| 766 |
(lambda (file) |
|---|
| 767 |
(+ 2 (length (car file))))) |
|---|
| 768 |
files)) |
|---|
| 769 |
|
|---|
| 770 |
(max-width (+ (window-width) 2)) |
|---|
| 771 |
(best-width 0) |
|---|
| 772 |
col-widths) |
|---|
| 773 |
|
|---|
| 774 |
|
|---|
| 775 |
(let ((w widths)) |
|---|
| 776 |
(while (and w (< width max-width)) |
|---|
| 777 |
(setq width (+ width (car w)) |
|---|
| 778 |
numcols (1+ numcols) |
|---|
| 779 |
w (cdr w)))) |
|---|
| 780 |
|
|---|
| 781 |
|
|---|
| 782 |
(while (> numcols 0) |
|---|
| 783 |
(let ((i 0) |
|---|
| 784 |
(colw (make-vector numcols 0)) |
|---|
| 785 |
(w widths)) |
|---|
| 786 |
(while w |
|---|
| 787 |
(if (= i numcols) |
|---|
| 788 |
(setq i 0)) |
|---|
| 789 |
(aset colw i (max (aref colw i) (car w))) |
|---|
| 790 |
(setq w (cdr w) i (1+ i))) |
|---|
| 791 |
(setq i 0 width 0) |
|---|
| 792 |
(while (< i numcols) |
|---|
| 793 |
(setq width (+ width (aref colw i)) |
|---|
| 794 |
i (1+ i))) |
|---|
| 795 |
(if (and (< width max-width) |
|---|
| 796 |
(> width best-width)) |
|---|
| 797 |
(setq col-widths colw |
|---|
| 798 |
best-width width))) |
|---|
| 799 |
(setq numcols (1- numcols))) |
|---|
| 800 |
|
|---|
| 801 |
(cons (or col-widths (vector max-width)) files))) |
|---|
| 802 |
|
|---|
| 803 |
(defun eshell-ls-find-column-lengths (files) |
|---|
| 804 |
"Find the best fitting column lengths for FILES. |
|---|
| 805 |
It will be returned as a vector, whose length is the number of columns |
|---|
| 806 |
to use, and each member of which is the width of that column |
|---|
| 807 |
\(including spacing)." |
|---|
| 808 |
(let* ((numcols 1) |
|---|
| 809 |
(width 0) |
|---|
| 810 |
(widths |
|---|
| 811 |
(mapcar |
|---|
| 812 |
(function |
|---|
| 813 |
(lambda (file) |
|---|
| 814 |
(+ 2 (length (car file))))) |
|---|
| 815 |
files)) |
|---|
| 816 |
(max-width (+ (window-width) 2)) |
|---|
| 817 |
col-widths |
|---|
| 818 |
colw) |
|---|
| 819 |
|
|---|
| 820 |
|
|---|