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