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