em-ls.el 31.8 KB
Newer Older
1
;;; em-ls.el --- implementation of ls in Lisp
Gerd Moellmann's avatar
Gerd Moellmann committed
2

3
;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
Gerd Moellmann's avatar
Gerd Moellmann committed
4

Gerd Moellmann's avatar
Gerd Moellmann committed
5 6
;; Author: John Wiegley <johnw@gnu.org>

Gerd Moellmann's avatar
Gerd Moellmann committed
7 8
;; This file is part of GNU Emacs.

9
;; GNU Emacs is free software: you can redistribute it and/or modify
Gerd Moellmann's avatar
Gerd Moellmann committed
10
;; it under the terms of the GNU General Public License as published by
11 12
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Gerd Moellmann's avatar
Gerd Moellmann committed
13 14 15 16 17 18 19

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
20
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
Gerd Moellmann's avatar
Gerd Moellmann committed
21

22 23 24 25
;;; Commentary:

;; Most of the command switches recognized by GNU's ls utility are
;; supported ([(fileutils)ls invocation]).
Gerd Moellmann's avatar
Gerd Moellmann committed
26

27 28
;;; Code:

29
(require 'cl-lib)
30 31
(require 'esh-util)
(require 'esh-opt)
Glenn Morris's avatar
Glenn Morris committed
32
(eval-when-compile (require 'eshell))
Gerd Moellmann's avatar
Gerd Moellmann committed
33

34
;;;###autoload
35 36
(progn
(defgroup eshell-ls nil
Gerd Moellmann's avatar
Gerd Moellmann committed
37 38 39 40 41 42
  "This module implements the \"ls\" utility fully in Lisp.  If it is
passed any unrecognized command switches, it will revert to the
operating system's version.  This version of \"ls\" uses text
properties to colorize its output based on the setting of
`eshell-ls-use-colors'."
  :tag "Implementation of `ls' in Lisp"
43
  :group 'eshell-module))
Gerd Moellmann's avatar
Gerd Moellmann committed
44 45 46 47 48 49 50 51 52 53 54 55

;;; User Variables:

(defvar eshell-ls-orig-insert-directory
  (symbol-function 'insert-directory)
  "Preserve the original definition of `insert-directory'.")

(defcustom eshell-ls-unload-hook
  (list
   (function
    (lambda ()
      (fset 'insert-directory eshell-ls-orig-insert-directory))))
Glenn Morris's avatar
Glenn Morris committed
56
  "When unloading `eshell-ls', restore the definition of `insert-directory'."
Gerd Moellmann's avatar
Gerd Moellmann committed
57 58 59
  :type 'hook
  :group 'eshell-ls)

60 61 62 63
(defcustom eshell-ls-date-format "%Y-%m-%d"
  "How to display time information in `eshell-ls-file'.
This is passed to `format-time-string' as a format string.
To display the date using the current locale, use \"%b \%e\"."
64
  :version "24.1"
65 66 67
  :type 'string
  :group 'eshell-ls)

John Wiegley's avatar
John Wiegley committed
68
(defcustom eshell-ls-initial-args nil
Glenn Morris's avatar
Glenn Morris committed
69
  "If non-nil, this list of args is included before any call to `ls'.
John Wiegley's avatar
John Wiegley committed
70 71 72 73
This is useful for enabling human-readable format (-h), for example."
  :type '(repeat :tag "Arguments" string)
  :group 'eshell-ls)

74
(defcustom eshell-ls-dired-initial-args nil
Glenn Morris's avatar
Glenn Morris committed
75
  "If non-nil, args is included before any call to `ls' in Dired.
76 77 78 79
This is useful for enabling human-readable format (-h), for example."
  :type '(repeat :tag "Arguments" string)
  :group 'eshell-ls)

Gerd Moellmann's avatar
Gerd Moellmann committed
80
(defcustom eshell-ls-use-in-dired nil
Glenn Morris's avatar
Glenn Morris committed
81
  "If non-nil, use `eshell-ls' to read directories in Dired."
Gerd Moellmann's avatar
Gerd Moellmann committed
82 83 84 85 86 87 88 89 90 91 92 93 94 95
  :set (lambda (symbol value)
	 (if value
	     (unless (and (boundp 'eshell-ls-use-in-dired)
			  eshell-ls-use-in-dired)
	       (fset 'insert-directory 'eshell-ls-insert-directory))
	   (when (and (boundp 'eshell-ls-insert-directory)
		      eshell-ls-use-in-dired)
	     (fset 'insert-directory eshell-ls-orig-insert-directory)))
	 (setq eshell-ls-use-in-dired value))
  :type 'boolean
  :require 'em-ls
  :group 'eshell-ls)

(defcustom eshell-ls-default-blocksize 1024
Glenn Morris's avatar
Glenn Morris committed
96
  "The default blocksize to use when display file sizes with -s."
Gerd Moellmann's avatar
Gerd Moellmann committed
97 98 99
  :type 'integer
  :group 'eshell-ls)

John Wiegley's avatar
John Wiegley committed
100
(defcustom eshell-ls-exclude-regexp nil
Glenn Morris's avatar
Glenn Morris committed
101
  "Unless -a is specified, files matching this regexp will not be shown."
102
  :type '(choice regexp (const nil))
Gerd Moellmann's avatar
Gerd Moellmann committed
103 104
  :group 'eshell-ls)

John Wiegley's avatar
John Wiegley committed
105
(defcustom eshell-ls-exclude-hidden t
Glenn Morris's avatar
Glenn Morris committed
106
  "Unless -a is specified, files beginning with . will not be shown.
John Wiegley's avatar
John Wiegley committed
107 108 109 110 111
Using this boolean, instead of `eshell-ls-exclude-regexp', is both
faster and conserves more memory."
  :type 'boolean
  :group 'eshell-ls)

Gerd Moellmann's avatar
Gerd Moellmann committed
112
(defcustom eshell-ls-use-colors t
Glenn Morris's avatar
Glenn Morris committed
113
  "If non-nil, use colors in file listings."
Gerd Moellmann's avatar
Gerd Moellmann committed
114 115 116
  :type 'boolean
  :group 'eshell-ls)

117
(defface eshell-ls-directory
118 119 120
  '((((class color) (background light)) (:foreground "Blue" :weight bold))
    (((class color) (background dark)) (:foreground "SkyBlue" :weight bold))
    (t (:weight bold)))
Glenn Morris's avatar
Glenn Morris committed
121
  "The face used for highlight directories."
Gerd Moellmann's avatar
Gerd Moellmann committed
122
  :group 'eshell-ls)
123 124
(define-obsolete-face-alias 'eshell-ls-directory-face
  'eshell-ls-directory "22.1")
Gerd Moellmann's avatar
Gerd Moellmann committed
125

126
(defface eshell-ls-symlink
127 128
  '((((class color) (background light)) (:foreground "Dark Cyan" :weight bold))
    (((class color) (background dark)) (:foreground "Cyan" :weight bold)))
Glenn Morris's avatar
Glenn Morris committed
129
  "The face used for highlight symbolic links."
Gerd Moellmann's avatar
Gerd Moellmann committed
130
  :group 'eshell-ls)
131
(define-obsolete-face-alias 'eshell-ls-symlink-face 'eshell-ls-symlink "22.1")
Gerd Moellmann's avatar
Gerd Moellmann committed
132

133
(defface eshell-ls-executable
134 135
  '((((class color) (background light)) (:foreground "ForestGreen" :weight bold))
    (((class color) (background dark)) (:foreground "Green" :weight bold)))
Glenn Morris's avatar
Glenn Morris committed
136
  "The face used for highlighting executables (not directories, though)."
Gerd Moellmann's avatar
Gerd Moellmann committed
137
  :group 'eshell-ls)
138 139
(define-obsolete-face-alias 'eshell-ls-executable-face
  'eshell-ls-executable "22.1")
Gerd Moellmann's avatar
Gerd Moellmann committed
140

141
(defface eshell-ls-readonly
Gerd Moellmann's avatar
Gerd Moellmann committed
142 143
  '((((class color) (background light)) (:foreground "Brown"))
    (((class color) (background dark)) (:foreground "Pink")))
Glenn Morris's avatar
Glenn Morris committed
144
  "The face used for highlighting read-only files."
Gerd Moellmann's avatar
Gerd Moellmann committed
145
  :group 'eshell-ls)
146
(define-obsolete-face-alias 'eshell-ls-readonly-face 'eshell-ls-readonly "22.1")
Gerd Moellmann's avatar
Gerd Moellmann committed
147

148
(defface eshell-ls-unreadable
Gerd Moellmann's avatar
Gerd Moellmann committed
149 150
  '((((class color) (background light)) (:foreground "Grey30"))
    (((class color) (background dark)) (:foreground "DarkGrey")))
Glenn Morris's avatar
Glenn Morris committed
151
  "The face used for highlighting unreadable files."
Gerd Moellmann's avatar
Gerd Moellmann committed
152
  :group 'eshell-ls)
153 154
(define-obsolete-face-alias 'eshell-ls-unreadable-face
  'eshell-ls-unreadable "22.1")
Gerd Moellmann's avatar
Gerd Moellmann committed
155

156
(defface eshell-ls-special
157 158
  '((((class color) (background light)) (:foreground "Magenta" :weight bold))
    (((class color) (background dark)) (:foreground "Magenta" :weight bold)))
Glenn Morris's avatar
Glenn Morris committed
159
  "The face used for highlighting non-regular files."
Gerd Moellmann's avatar
Gerd Moellmann committed
160
  :group 'eshell-ls)
161
(define-obsolete-face-alias 'eshell-ls-special-face 'eshell-ls-special "22.1")
Gerd Moellmann's avatar
Gerd Moellmann committed
162

163
(defface eshell-ls-missing
164 165
  '((((class color) (background light)) (:foreground "Red" :weight bold))
    (((class color) (background dark)) (:foreground "Red" :weight bold)))
Glenn Morris's avatar
Glenn Morris committed
166
  "The face used for highlighting non-existent file names."
Gerd Moellmann's avatar
Gerd Moellmann committed
167
  :group 'eshell-ls)
168
(define-obsolete-face-alias 'eshell-ls-missing-face 'eshell-ls-missing "22.1")
Gerd Moellmann's avatar
Gerd Moellmann committed
169 170 171

(defcustom eshell-ls-archive-regexp
  (concat "\\.\\(t\\(a[rz]\\|gz\\)\\|arj\\|lzh\\|"
172
	  "zip\\|[zZ]\\|gz\\|bz2\\|xz\\|deb\\|rpm\\)\\'")
Glenn Morris's avatar
Glenn Morris committed
173
  "A regular expression that matches names of file archives.
Gerd Moellmann's avatar
Gerd Moellmann committed
174 175
This typically includes both traditional archives and compressed
files."
176
  :version "24.1"			; added xz
Gerd Moellmann's avatar
Gerd Moellmann committed
177 178 179
  :type 'regexp
  :group 'eshell-ls)

180
(defface eshell-ls-archive
181 182
  '((((class color) (background light)) (:foreground "Orchid" :weight bold))
    (((class color) (background dark)) (:foreground "Orchid" :weight bold)))
Glenn Morris's avatar
Glenn Morris committed
183
  "The face used for highlighting archived and compressed file names."
Gerd Moellmann's avatar
Gerd Moellmann committed
184
  :group 'eshell-ls)
185
(define-obsolete-face-alias 'eshell-ls-archive-face 'eshell-ls-archive "22.1")
Gerd Moellmann's avatar
Gerd Moellmann committed
186 187 188

(defcustom eshell-ls-backup-regexp
  "\\(\\`\\.?#\\|\\(\\.bak\\|~\\)\\'\\)"
Glenn Morris's avatar
Glenn Morris committed
189
  "A regular expression that matches names of backup files."
Gerd Moellmann's avatar
Gerd Moellmann committed
190 191 192
  :type 'regexp
  :group 'eshell-ls)

193
(defface eshell-ls-backup
Gerd Moellmann's avatar
Gerd Moellmann committed
194 195
  '((((class color) (background light)) (:foreground "OrangeRed"))
    (((class color) (background dark)) (:foreground "LightSalmon")))
Glenn Morris's avatar
Glenn Morris committed
196
  "The face used for highlighting backup file names."
Gerd Moellmann's avatar
Gerd Moellmann committed
197
  :group 'eshell-ls)
198
(define-obsolete-face-alias 'eshell-ls-backup-face 'eshell-ls-backup "22.1")
Gerd Moellmann's avatar
Gerd Moellmann committed
199 200

(defcustom eshell-ls-product-regexp
201
  "\\.\\(elc\\|o\\(bj\\)?\\|a\\|lib\\|res\\)\\'"
Glenn Morris's avatar
Glenn Morris committed
202
  "A regular expression that matches names of product files.
Gerd Moellmann's avatar
Gerd Moellmann committed
203 204 205 206 207
Products are files that get generated from a source file, and hence
ought to be recreatable if they are deleted."
  :type 'regexp
  :group 'eshell-ls)

208
(defface eshell-ls-product
Gerd Moellmann's avatar
Gerd Moellmann committed
209 210
  '((((class color) (background light)) (:foreground "OrangeRed"))
    (((class color) (background dark)) (:foreground "LightSalmon")))
Glenn Morris's avatar
Glenn Morris committed
211
  "The face used for highlighting files that are build products."
Gerd Moellmann's avatar
Gerd Moellmann committed
212
  :group 'eshell-ls)
213
(define-obsolete-face-alias 'eshell-ls-product-face 'eshell-ls-product "22.1")
Gerd Moellmann's avatar
Gerd Moellmann committed
214 215 216

(defcustom eshell-ls-clutter-regexp
  "\\(^texput\\.log\\|^core\\)\\'"
Glenn Morris's avatar
Glenn Morris committed
217
  "A regular expression that matches names of junk files.
Gerd Moellmann's avatar
Gerd Moellmann committed
218 219 220 221 222
These are mainly files that get created for various reasons, but don't
really need to stick around for very long."
  :type 'regexp
  :group 'eshell-ls)

223
(defface eshell-ls-clutter
224 225
  '((((class color) (background light)) (:foreground "OrangeRed" :weight bold))
    (((class color) (background dark)) (:foreground "OrangeRed" :weight bold)))
Glenn Morris's avatar
Glenn Morris committed
226
  "The face used for highlighting junk file names."
Gerd Moellmann's avatar
Gerd Moellmann committed
227
  :group 'eshell-ls)
228
(define-obsolete-face-alias 'eshell-ls-clutter-face 'eshell-ls-clutter "22.1")
Gerd Moellmann's avatar
Gerd Moellmann committed
229 230 231 232 233 234 235

(defsubst eshell-ls-filetype-p (attrs type)
  "Test whether ATTRS specifies a directory."
  (if (nth 8 attrs)
      (eq (aref (nth 8 attrs) 0) type)))

(defmacro eshell-ls-applicable (attrs index func file)
236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257
  "Test whether, for ATTRS, the user can do what corresponds to INDEX.
ATTRS is a string of file modes.  See `file-attributes'.
If we cannot determine the answer using ATTRS (e.g., if we need
to know what group the user is in), compute the return value by
calling FUNC with FILE as an argument."
  `(let ((owner (nth 2 ,attrs))
	 (modes (nth 8 ,attrs)))
     (cond ((cond ((numberp owner)
		   (= owner (user-uid)))
		  ((stringp owner)
		   (or (string-equal owner (user-login-name))
		       (member owner (eshell-current-ange-uids)))))
	    ;; The user owns this file.
	    (not (eq (aref modes ,index) ?-)))
	   ((eq (aref modes (+ ,index 3))
		(aref modes (+ ,index 6)))
	    ;; If the "group" and "other" fields give identical
	    ;; results, use that.
	    (not (eq (aref modes (+ ,index 3)) ?-)))
	   (t
	    ;; Otherwise call FUNC.
	    (,(eval func) ,file)))))
Gerd Moellmann's avatar
Gerd Moellmann committed
258 259

(defcustom eshell-ls-highlight-alist nil
Glenn Morris's avatar
Glenn Morris committed
260
  "This alist correlates test functions to color.
Gerd Moellmann's avatar
Gerd Moellmann committed
261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291
The format of the members of this alist is

  (TEST-SEXP . FACE)

If TEST-SEXP evals to non-nil, that face will be used to highlight the
name of the file.  The first match wins.  `file' and `attrs' are in
scope during the evaluation of TEST-SEXP."
  :type '(repeat (cons function face))
  :group 'eshell-ls)

;;; Functions:

(defun eshell-ls-insert-directory
  (file switches &optional wildcard full-directory-p)
  "Insert directory listing for FILE, formatted according to SWITCHES.
Leaves point after the inserted text.
SWITCHES may be a string of options, or a list of strings.
Optional third arg WILDCARD means treat FILE as shell wildcard.
Optional fourth arg FULL-DIRECTORY-P means file is a directory and
switches do not contain `d', so that a full listing is expected.

This version of the function uses `eshell/ls'.  If any of the switches
passed are not recognized, the operating system's version will be used
instead."
  (let ((handler (find-file-name-handler file 'insert-directory)))
    (if handler
	(funcall handler 'insert-directory file switches
		 wildcard full-directory-p)
      (if (stringp switches)
	  (setq switches (split-string switches)))
      (let (eshell-current-handles
292 293
	    eshell-current-subjob-p
	    font-lock-mode)
Gerd Moellmann's avatar
Gerd Moellmann committed
294 295 296 297
	;; use the fancy highlighting in `eshell-ls' rather than font-lock
	(when (and eshell-ls-use-colors
		   (featurep 'font-lock))
	  (font-lock-mode -1)
298
	  (setq font-lock-defaults nil)
Gerd Moellmann's avatar
Gerd Moellmann committed
299 300 301 302 303 304
	  (if (boundp 'font-lock-buffers)
	      (set 'font-lock-buffers
		   (delq (current-buffer)
			 (symbol-value 'font-lock-buffers)))))
	(let ((insert-func 'insert)
	      (error-func 'insert)
John Wiegley's avatar
John Wiegley committed
305
	      (flush-func 'ignore)
306
	      eshell-ls-dired-initial-args)
Gerd Moellmann's avatar
Gerd Moellmann committed
307 308 309 310 311 312 313
	  (eshell-do-ls (append switches (list file))))))))

(defsubst eshell/ls (&rest args)
  "An alias version of `eshell-do-ls'."
  (let ((insert-func 'eshell-buffered-print)
	(error-func 'eshell-error)
	(flush-func 'eshell-flush))
314
    (apply 'eshell-do-ls args)))
Gerd Moellmann's avatar
Gerd Moellmann committed
315

316 317
(put 'eshell/ls 'eshell-no-numeric-conversions t)

318 319 320 321 322 323 324 325 326 327 328 329
(defvar block-size)
(defvar dereference-links)
(defvar dir-literal)
(defvar error-func)
(defvar flush-func)
(defvar human-readable)
(defvar ignore-pattern)
(defvar insert-func)
(defvar listing-style)
(defvar numeric-uid-gid)
(defvar reverse-list)
(defvar show-all)
Aidan Gauland's avatar
Aidan Gauland committed
330
(defvar show-almost-all)
331 332 333 334 335
(defvar show-recursive)
(defvar show-size)
(defvar sort-method)
(defvar ange-cache)
(defvar dired-flag)
Gerd Moellmann's avatar
Gerd Moellmann committed
336

Glenn Morris's avatar
Glenn Morris committed
337 338
(declare-function eshell-glob-regexp "em-glob" (pattern))

Gerd Moellmann's avatar
Gerd Moellmann committed
339 340 341
(defun eshell-do-ls (&rest args)
  "Implementation of \"ls\" in Lisp, passing ARGS."
  (funcall flush-func -1)
Aidan Gauland's avatar
Aidan Gauland committed
342
  ;; Process the command arguments, and begin listing files.
Gerd Moellmann's avatar
Gerd Moellmann committed
343
  (eshell-eval-using-options
John Wiegley's avatar
John Wiegley committed
344 345 346
   "ls" (if eshell-ls-initial-args
	    (list eshell-ls-initial-args args)
	  args)
347
   `((?a "all" nil show-all
Aidan Gauland's avatar
Aidan Gauland committed
348 349 350
	 "do not ignore entries starting with .")
     (?A "almost-all" nil show-almost-all
	 "do not list implied . and ..")
Gerd Moellmann's avatar
Gerd Moellmann committed
351
     (?c nil by-ctime sort-method
352
	 "sort by last status change time")
Gerd Moellmann's avatar
Gerd Moellmann committed
353 354 355
     (?d "directory" nil dir-literal
	 "list directory entries instead of contents")
     (?k "kilobytes" 1024 block-size
356
	 "using 1024 as the block size")
Gerd Moellmann's avatar
Gerd Moellmann committed
357 358
     (?h "human-readable" 1024 human-readable
	 "print sizes in human readable format")
359 360
     (?H "si" 1000 human-readable
	 "likewise, but use powers of 1000 not 1024")
Gerd Moellmann's avatar
Gerd Moellmann committed
361 362 363 364 365 366 367 368 369 370 371 372 373 374
     (?I "ignore" t ignore-pattern
	 "do not list implied entries matching pattern")
     (?l nil long-listing listing-style
	 "use a long listing format")
     (?n "numeric-uid-gid" nil numeric-uid-gid
	 "list numeric UIDs and GIDs instead of names")
     (?r "reverse" nil reverse-list
	 "reverse order while sorting")
     (?s "size" nil show-size
	 "print size of each file, in blocks")
     (?t nil by-mtime sort-method
	 "sort by modification time")
     (?u nil by-atime sort-method
	 "sort by last access time")
375 376
     (?x nil by-lines listing-style
	 "list entries by lines instead of by columns")
377 378
     (?C nil by-columns listing-style
	 "list entries by columns")
379
     (?L "dereference" nil dereference-links
380 381 382 383 384 385 386
	 "list entries pointed to by symbolic links")
     (?R "recursive" nil show-recursive
	 "list subdirectories recursively")
     (?S nil by-size sort-method
	 "sort by file size")
     (?U nil unsorted sort-method
	 "do not sort; list entries in directory order")
Gerd Moellmann's avatar
Gerd Moellmann committed
387 388 389 390
     (?X nil by-extension sort-method
	 "sort alphabetically by entry extension")
     (?1 nil single-column listing-style
	 "list one file per line")
391 392
     (nil "dired" nil dired-flag
	  "Here for compatibility with GNU ls.")
Gerd Moellmann's avatar
Gerd Moellmann committed
393
     (nil "help" nil nil
394
	  "show this usage display")
Gerd Moellmann's avatar
Gerd Moellmann committed
395 396 397
     :external "ls"
     :usage "[OPTION]... [FILE]...
List information about the FILEs (the current directory by default).
398
Sort entries alphabetically across.")
Gerd Moellmann's avatar
Gerd Moellmann committed
399 400 401 402 403 404 405
   ;; setup some defaults, based on what the user selected
   (unless block-size
     (setq block-size eshell-ls-default-blocksize))
   (unless listing-style
     (setq listing-style 'by-columns))
   (unless args
     (setq args (list ".")))
406
   (let ((eshell-ls-exclude-regexp eshell-ls-exclude-regexp) ange-cache)
407
     (when ignore-pattern
Gerd Moellmann's avatar
Gerd Moellmann committed
408 409 410 411
       (unless (eshell-using-module 'eshell-glob)
	 (error (concat "-I option requires that `eshell-glob'"
			" be a member of `eshell-modules-list'")))
       (set-text-properties 0 (length ignore-pattern) nil ignore-pattern)
John Wiegley's avatar
John Wiegley committed
412 413
       (setq eshell-ls-exclude-regexp
	     (if eshell-ls-exclude-regexp
Gerd Moellmann's avatar
Gerd Moellmann committed
414
		 (concat "\\(" eshell-ls-exclude-regexp "\\|"
John Wiegley's avatar
John Wiegley committed
415 416
			 (eshell-glob-regexp ignore-pattern) "\\)")
	       (eshell-glob-regexp ignore-pattern))))
Gerd Moellmann's avatar
Gerd Moellmann committed
417 418
     ;; list the files!
     (eshell-ls-entries
419 420 421 422 423 424 425
      (mapcar (lambda (arg)
		(cons (if (and (eshell-under-windows-p)
			       (file-name-absolute-p arg))
			  (expand-file-name arg)
			arg)
		      (eshell-file-attributes
		       arg (if numeric-uid-gid 'integer 'string))))
John Wiegley's avatar
John Wiegley committed
426
	      args)
Gerd Moellmann's avatar
Gerd Moellmann committed
427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457
      t (expand-file-name default-directory)))
   (funcall flush-func)))

(defsubst eshell-ls-printable-size (filesize &optional by-blocksize)
  "Return a printable FILESIZE."
  (eshell-printable-size filesize human-readable
			 (and by-blocksize block-size)
			 eshell-ls-use-colors))

(defsubst eshell-ls-size-string (attrs size-width)
  "Return the size string for ATTRS length, using SIZE-WIDTH."
  (let* ((str (eshell-ls-printable-size (nth 7 attrs) t))
	 (len (length str)))
    (if (< len size-width)
	(concat (make-string (- size-width len) ? ) str)
      str)))

(defun eshell-ls-annotate (fileinfo)
  "Given a FILEINFO object, return a resolved, decorated FILEINFO.
This means resolving any symbolic links, determining what face the
name should be displayed as, etc.  Think of it as cooking a FILEINFO."
  (if (not (and (stringp (cadr fileinfo))
		(or dereference-links
		    (eq listing-style 'long-listing))))
      (setcar fileinfo (eshell-ls-decorated-name fileinfo))
    (let (dir attr)
      (unless (file-name-absolute-p (cadr fileinfo))
	(setq dir (file-truename
		   (file-name-directory
		    (expand-file-name (car fileinfo))))))
      (setq attr
458
	    (eshell-file-attributes
Gerd Moellmann's avatar
Gerd Moellmann committed
459 460 461 462 463 464 465 466 467 468 469
	     (let ((target (if dir
			       (expand-file-name (cadr fileinfo) dir)
			     (cadr fileinfo))))
	       (if dereference-links
		   (file-truename target)
		 target))))
      (if (or dereference-links
	      (string-match "^\\.\\.?$" (car fileinfo)))
	  (progn
	    (setcdr fileinfo attr)
	    (setcar fileinfo (eshell-ls-decorated-name fileinfo)))
470
	(cl-assert (eq listing-style 'long-listing))
Gerd Moellmann's avatar
Gerd Moellmann committed
471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500
	(setcar fileinfo
		(concat (eshell-ls-decorated-name fileinfo) " -> "
			(eshell-ls-decorated-name
			 (cons (cadr fileinfo) attr)))))))
  fileinfo)

(defun eshell-ls-file (fileinfo &optional size-width copy-fileinfo)
  "Output FILE in long format.
FILE may be a string, or a cons cell whose car is the filename and
whose cdr is the list of file attributes."
  (if (not (cdr fileinfo))
      (funcall error-func (format "%s: No such file or directory\n"
				  (car fileinfo)))
    (setq fileinfo
	  (eshell-ls-annotate (if copy-fileinfo
				  (cons (car fileinfo)
					(cdr fileinfo))
				fileinfo)))
    (let ((file (car fileinfo))
	  (attrs (cdr fileinfo)))
      (if (not (eq listing-style 'long-listing))
	  (if show-size
	      (funcall insert-func (eshell-ls-size-string attrs size-width)
		       " " file "\n")
	    (funcall insert-func file "\n"))
	(let ((line
	       (concat
		(if show-size
		    (concat (eshell-ls-size-string attrs size-width) " "))
		(format
501 502 503
		 (if numeric-uid-gid
		     "%s%4d %-8s %-8s "
		   "%s%4d %-14s %-8s ")
Gerd Moellmann's avatar
Gerd Moellmann committed
504 505
		 (or (nth 8 attrs) "??????????")
		 (or (nth 1 attrs) 0)
506
		 (or (let ((user (nth 2 attrs)))
507 508
		       (and (stringp user)
			    (eshell-substring user 14)))
Gerd Moellmann's avatar
Gerd Moellmann committed
509 510
		     (nth 2 attrs)
		     "")
511
		 (or (let ((group (nth 3 attrs)))
512 513
		       (and (stringp group)
			    (eshell-substring group 8)))
Gerd Moellmann's avatar
Gerd Moellmann committed
514 515 516 517
		     (nth 3 attrs)
		     ""))
		(let* ((str (eshell-ls-printable-size (nth 7 attrs)))
		       (len (length str)))
518 519 520
		  ;; Let file sizes shorter than 9 align neatly.
		  (if (< len (or size-width 8))
		      (concat (make-string (- (or size-width 8) len) ? ) str)
Gerd Moellmann's avatar
Gerd Moellmann committed
521 522
		    str))
		" " (format-time-string
523
		     (concat
524
		      eshell-ls-date-format " "
525 526 527 528 529 530 531 532 533 534 535
		      (if (= (nth 5 (decode-time (current-time)))
			     (nth 5 (decode-time
				     (nth (cond
					   ((eq sort-method 'by-atime) 4)
					   ((eq sort-method 'by-ctime) 6)
					   (t 5)) attrs))))
			  "%H:%M"
			" %Y")) (nth (cond
			((eq sort-method 'by-atime) 4)
			((eq sort-method 'by-ctime) 6)
			(t 5)) attrs)) " ")))
Gerd Moellmann's avatar
Gerd Moellmann committed
536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555
	  (funcall insert-func line file "\n"))))))

(defun eshell-ls-dir (dirinfo &optional insert-name root-dir size-width)
  "Output the entries in DIRINFO.
If INSERT-NAME is non-nil, the name of DIRINFO will be output.  If
ROOT-DIR is also non-nil, and a directory name, DIRINFO will be output
relative to that directory."
  (let ((dir (car dirinfo)))
    (if (not (cdr dirinfo))
	(funcall error-func (format "%s: No such file or directory\n" dir))
      (if dir-literal
	  (eshell-ls-file dirinfo size-width)
	(if insert-name
	    (funcall insert-func
		     (eshell-ls-decorated-name
		      (cons (concat
			     (if root-dir
				 (file-relative-name dir root-dir)
			       (expand-file-name dir)))
			    (cdr dirinfo))) ":\n"))
John Wiegley's avatar
John Wiegley committed
556
	(let ((entries (eshell-directory-files-and-attributes
557
			dir nil (and (not (or show-all show-almost-all))
558
				     eshell-ls-exclude-hidden
559 560 561 562 563 564
				     "\\`[^.]") t
				     ;; Asking for UID and GID as
				     ;; strings saves another syscall
				     ;; later when we are going to
				     ;; display user and group names.
				     (if numeric-uid-gid 'integer 'string))))
Aidan Gauland's avatar
Aidan Gauland committed
565 566 567
          (when (and show-almost-all
                     (not show-all))
            (setq entries
568
                  (cl-remove-if
Aidan Gauland's avatar
Aidan Gauland committed
569
                   (lambda (entry)
570
                     (member (car entry) '("." "..")))
Aidan Gauland's avatar
Aidan Gauland committed
571
                   entries)))
572
	  (when (and (not (or show-all show-almost-all))
Aidan Gauland's avatar
Aidan Gauland committed
573
                     eshell-ls-exclude-regexp)
John Wiegley's avatar
John Wiegley committed
574 575
	    (while (and entries (string-match eshell-ls-exclude-regexp
					      (caar entries)))
Gerd Moellmann's avatar
Gerd Moellmann committed
576 577 578 579 580 581 582 583 584
	      (setq entries (cdr entries)))
	    (let ((e entries))
	      (while (cdr e)
		(if (string-match eshell-ls-exclude-regexp (car (cadr e)))
		    (setcdr e (cddr e))
		  (setq e (cdr e))))))
	  (when (or (eq listing-style 'long-listing) show-size)
	    (let ((total 0.0))
	      (setq size-width 0)
585
	      (dolist (e entries)
Gerd Moellmann's avatar
Gerd Moellmann committed
586 587 588 589 590
		(if (nth 7 (cdr e))
		    (setq total (+ total (nth 7 (cdr e)))
			  size-width
			  (max size-width
			       (length (eshell-ls-printable-size
591 592 593 594 595
					(nth 7 (cdr e))
					(not
					 ;; If we are under -l, count length
					 ;; of sizes in bytes, not in blocks.
					 (eq listing-style 'long-listing))))))))
Gerd Moellmann's avatar
Gerd Moellmann committed
596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634
	      (funcall insert-func "total "
		       (eshell-ls-printable-size total t) "\n")))
	  (let ((default-directory (expand-file-name dir)))
	    (if show-recursive
		(eshell-ls-entries
		 (let ((e entries) (good-entries (list t)))
		   (while e
		     (unless (let ((len (length (caar e))))
			       (and (eq (aref (caar e) 0) ?.)
				    (or (= len 1)
					(and (= len 2)
					     (eq (aref (caar e) 1) ?.)))))
		       (nconc good-entries (list (car e))))
		     (setq e (cdr e)))
		   (cdr good-entries))
		 nil root-dir)
	      (eshell-ls-files (eshell-ls-sort-entries entries)
			       size-width))))))))

(defsubst eshell-ls-compare-entries (l r inx func)
  "Compare the time of two files, L and R, the attribute indexed by INX."
  (let ((lt (nth inx (cdr l)))
	(rt (nth inx (cdr r))))
    (if (equal lt rt)
	(string-lessp (directory-file-name (car l))
		      (directory-file-name (car r)))
      (funcall func rt lt))))

(defun eshell-ls-sort-entries (entries)
  "Sort the given ENTRIES, which may be files, directories or both.
In Eshell's implementation of ls, ENTRIES is always reversed."
  (if (eq sort-method 'unsorted)
      (nreverse entries)
    (sort entries
	  (function
	   (lambda (l r)
	     (let ((result
		    (cond
		     ((eq sort-method 'by-atime)
635
		      (eshell-ls-compare-entries l r 4 'time-less-p))
Gerd Moellmann's avatar
Gerd Moellmann committed
636
		     ((eq sort-method 'by-mtime)
637
		      (eshell-ls-compare-entries l r 5 'time-less-p))
Gerd Moellmann's avatar
Gerd Moellmann committed
638
		     ((eq sort-method 'by-ctime)
639
		      (eshell-ls-compare-entries l r 6 'time-less-p))
640 641
		     ((eq sort-method 'by-size)
		      (eshell-ls-compare-entries l r 7 '<))
Gerd Moellmann's avatar
Gerd Moellmann committed
642 643 644 645 646 647 648 649 650 651 652 653 654 655
		     ((eq sort-method 'by-extension)
		      (let ((lx (file-name-extension
				 (directory-file-name (car l))))
			    (rx (file-name-extension
				 (directory-file-name (car r)))))
			(cond
			 ((or (and (not lx) (not rx))
			      (equal lx rx))
			  (string-lessp (directory-file-name (car l))
					(directory-file-name (car r))))
			 ((not lx) t)
			 ((not rx) nil)
			 (t
			  (string-lessp lx rx)))))
656
		     (t
657 658
		      (string-lessp (directory-file-name (car l))
				    (directory-file-name (car r)))))))
Gerd Moellmann's avatar
Gerd Moellmann committed
659 660 661 662 663 664 665 666
	       (if reverse-list
		   (not result)
		 result)))))))

(defun eshell-ls-files (files &optional size-width copy-fileinfo)
  "Output a list of FILES.
Each member of FILES is either a string or a cons cell of the form
\(FILE .  ATTRS)."
667 668 669 670 671 672 673 674
  ;; Mimic behavior of coreutils ls, which lists a single file per
  ;; line when output is not a tty.  Exceptions: if -x was supplied,
  ;; or if we are the _last_ command in a pipeline.
  ;; FIXME Not really the same since not testing output destination.
  (if (or (and eshell-in-pipeline-p
	       (not (eq eshell-in-pipeline-p 'last))
	       (not (eq listing-style 'by-lines)))
	  (memq listing-style '(long-listing single-column)))
675
      (dolist (file files)
Gerd Moellmann's avatar
Gerd Moellmann committed
676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699
	(if file
	    (eshell-ls-file file size-width copy-fileinfo)))
    (let ((f files)
	  last-f
	  display-files
	  ignore)
      (while f
	(if (cdar f)
	    (setq last-f f
		  f (cdr f))
	  (unless ignore
	    (funcall error-func
		     (format "%s: No such file or directory\n" (caar f))))
	  (if (eq f files)
	      (setq files (cdr files)
		    f files)
	    (if (not (cdr f))
		(progn
		  (setcdr last-f nil)
		  (setq f nil))
	      (setcar f (cadr f))
	      (setcdr f (cddr f))))))
      (if (not show-size)
	  (setq display-files (mapcar 'eshell-ls-annotate files))
700
	(dolist (file files)
Gerd Moellmann's avatar
Gerd Moellmann committed
701 702 703 704 705 706 707 708 709 710 711 712
	  (let* ((str (eshell-ls-printable-size (nth 7 (cdr file)) t))
		 (len (length str)))
	    (if (< len size-width)
		(setq str (concat (make-string (- size-width len) ? ) str)))
	    (setq file (eshell-ls-annotate file)
		  display-files (cons (cons (concat str " " (car file))
					    (cdr file))
				      display-files))))
	(setq display-files (nreverse display-files)))
      (let* ((col-vals
	      (if (eq listing-style 'by-columns)
		  (eshell-ls-find-column-lengths display-files)
713
		(cl-assert (eq listing-style 'by-lines))
Gerd Moellmann's avatar
Gerd Moellmann committed
714 715 716 717 718 719
		(eshell-ls-find-column-widths display-files)))
	     (col-widths (car col-vals))
	     (display-files (cdr col-vals))
	     (columns (length col-widths))
	     (col-index 1)
	     need-return)
720
	(dolist (file display-files)
Gerd Moellmann's avatar
Gerd Moellmann committed
721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743
	  (let ((name
		 (if (car file)
		     (if show-size
			 (concat (substring (car file) 0 size-width)
				 (eshell-ls-decorated-name
				  (cons (substring (car file) size-width)
					(cdr file))))
		       (eshell-ls-decorated-name file))
		   "")))
	    (if (< col-index columns)
		(setq need-return
		      (concat need-return name
			      (make-string
			       (max 0 (- (aref col-widths
					       (1- col-index))
					 (length name))) ? ))
		      col-index (1+ col-index))
	      (funcall insert-func need-return name "\n")
	      (setq col-index 1 need-return nil))))
	(if need-return
	    (funcall insert-func need-return "\n"))))))

(defun eshell-ls-entries (entries &optional separate root-dir)
744
  "Output PATH's directory ENTRIES.
Gerd Moellmann's avatar
Gerd Moellmann committed
745 746 747 748 749 750 751 752 753 754
Each member of ENTRIES may either be a string or a cons cell, the car
of which is the file name, and the cdr of which is the list of
attributes.
If SEPARATE is non-nil, directories name will be entirely separated
from the filenames.  This is the normal behavior, except when doing a
recursive listing.
ROOT-DIR, if non-nil, specifies the root directory of the listing, to
which non-absolute directory names will be made relative if ever they
need to be printed."
  (let (dirs files show-names need-return (size-width 0))
755
    (dolist (entry entries)
Gerd Moellmann's avatar
Gerd Moellmann committed
756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780
      (if (and (not dir-literal)
	       (or (eshell-ls-filetype-p (cdr entry) ?d)
		   (and (eshell-ls-filetype-p (cdr entry) ?l)
			(file-directory-p (car entry)))))
	  (progn
	    (unless separate
	      (setq files (cons entry files)
		    size-width
		    (if show-size
			(max size-width
			     (length (eshell-ls-printable-size
				      (nth 7 (cdr entry)) t))))))
	    (setq dirs (cons entry dirs)))
	(setq files (cons entry files)
	      size-width
	      (if show-size
		  (max size-width
		       (length (eshell-ls-printable-size
				(nth 7 (cdr entry)) t)))))))
    (when files
      (eshell-ls-files (eshell-ls-sort-entries files)
		       size-width show-recursive)
      (setq need-return t))
    (setq show-names (or show-recursive
			 (> (+ (length files) (length dirs)) 1)))
781
    (dolist (dir (eshell-ls-sort-entries dirs))
Gerd Moellmann's avatar
Gerd Moellmann committed
782 783 784
      (if (and need-return (not dir-literal))
	  (funcall insert-func "\n"))
      (eshell-ls-dir dir show-names
John Wiegley's avatar
John Wiegley committed
785 786
		     (unless (file-name-absolute-p (car dir)) root-dir)
		     size-width)
Gerd Moellmann's avatar
Gerd Moellmann committed
787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903
      (setq need-return t))))

(defun eshell-ls-find-column-widths (files)
  "Find the best fitting column widths for FILES.
It will be returned as a vector, whose length is the number of columns
to use, and each member of which is the width of that column
\(including spacing)."
  (let* ((numcols 0)
	 (width 0)
	 (widths
	  (mapcar
	   (function
	    (lambda (file)
	      (+ 2 (length (car file)))))
	   files))
	 ;; must account for the added space...
	 (max-width (+ (window-width) 2))
	 (best-width 0)
	 col-widths)

    ;; determine the largest number of columns in the first row
    (let ((w widths))
      (while (and w (< width max-width))
	(setq width (+ width (car w))
	      numcols (1+ numcols)
	      w (cdr w))))

    ;; refine it based on the following rows
    (while (> numcols 0)
      (let ((i 0)
	    (colw (make-vector numcols 0))
	    (w widths))
	(while w
	  (if (= i numcols)
	      (setq i 0))
	  (aset colw i (max (aref colw i) (car w)))
	  (setq w (cdr w) i (1+ i)))
	(setq i 0 width 0)
	(while (< i numcols)
	  (setq width (+ width (aref colw i))
		i (1+ i)))
	(if (and (< width max-width)
		 (> width best-width))
	    (setq col-widths colw
		  best-width width)))
      (setq numcols (1- numcols)))

    (cons (or col-widths (vector max-width)) files)))

(defun eshell-ls-find-column-lengths (files)
  "Find the best fitting column lengths for FILES.
It will be returned as a vector, whose length is the number of columns
to use, and each member of which is the width of that column
\(including spacing)."
  (let* ((numcols 1)
	 (width 0)
	 (widths
	  (mapcar
	   (function
	    (lambda (file)
	      (+ 2 (length (car file)))))
	   files))
	 (max-width (+ (window-width) 2))
	 col-widths
	 colw)

    ;; refine it based on the following rows
    (while numcols
      (let* ((rows (ceiling (/ (length widths)
			       (float numcols))))
	     (w widths)
	     (len (* rows numcols))
	     (index 0)
	     (i 0))
	(setq width 0)
	(unless (or (= rows 0)
		    (<= (/ (length widths) (float rows))
			(float (1- numcols))))
	  (setq colw (make-vector numcols 0))
	  (while (> len 0)
	    (if (= i numcols)
		(setq i 0 index (1+ index)))
	    (aset colw i
		  (max (aref colw i)
		       (or (nth (+ (* i rows) index) w) 0)))
	    (setq len (1- len) i (1+ i)))
	  (setq i 0)
	  (while (< i numcols)
	    (setq width (+ width (aref colw i))
		  i (1+ i))))
	(if (>= width max-width)
	    (setq numcols nil)
	  (if colw
	      (setq col-widths colw))
	  (if (>= numcols (length widths))
	      (setq numcols nil)
	    (setq numcols (1+ numcols))))))

    (if (not col-widths)
	(cons (vector max-width) files)
      (setq numcols (length col-widths))
      (let* ((rows (ceiling (/ (length widths)
			       (float numcols))))
	     (len (* rows numcols))
	     (newfiles (make-list len nil))
	     (index 0)
	     (i 0)
	     (j 0))
	(while (< j len)
	  (if (= i numcols)
	      (setq i 0 index (1+ index)))
	  (setcar (nthcdr j newfiles)
		  (nth (+ (* i rows) index) files))
	  (setq j (1+ j) i (1+ i)))
	(cons col-widths newfiles)))))

(defun eshell-ls-decorated-name (file)
904
  "Return FILE, possibly decorated."
905 906 907 908
  (if eshell-ls-use-colors
      (let ((face
	     (cond
	      ((not (cdr file))
909
	       'eshell-ls-missing)
910 911

	      ((stringp (cadr file))
912
	       'eshell-ls-symlink)
913 914

	      ((eq (cadr file) t)
915
	       'eshell-ls-directory)
916 917

	      ((not (eshell-ls-filetype-p (cdr file) ?-))
918
	       'eshell-ls-special)
919 920 921 922

	      ((and (/= (user-uid) 0) ; root can execute anything
		    (eshell-ls-applicable (cdr file) 3
					  'file-executable-p (car file)))
923
	       'eshell-ls-executable)
924 925 926

	      ((not (eshell-ls-applicable (cdr file) 1
					  'file-readable-p (car file)))
927
	       'eshell-ls-unreadable)
928 929

	      ((string-match eshell-ls-archive-regexp (car file))
930
	       'eshell-ls-archive)
931 932

	      ((string-match eshell-ls-backup-regexp (car file))
933
	       'eshell-ls-backup)
934 935

	      ((string-match eshell-ls-product-regexp (car file))
936
	       'eshell-ls-product)
937 938

	      ((string-match eshell-ls-clutter-regexp (car file))
939
	       'eshell-ls-clutter)
940 941 942

	      ((not (eshell-ls-applicable (cdr file) 2
					  'file-writable-p (car file)))
943
	       'eshell-ls-readonly)
944 945 946 947 948 949 950 951 952 953 954 955 956
	      (eshell-ls-highlight-alist
	       (let ((tests eshell-ls-highlight-alist)
		     value)
		 (while tests
		   (if (funcall (caar tests) (car file) (cdr file))
		       (setq value (cdar tests) tests nil)
		     (setq tests (cdr tests))))
		 value)))))
	(if face
	    (add-text-properties 0 (length (car file))
				 (list 'face face)
				 (car file)))))
  (car file))
Gerd Moellmann's avatar
Gerd Moellmann committed
957

958
(provide 'em-ls)
Gerd Moellmann's avatar
Gerd Moellmann committed
959

960 961 962 963
;; Local Variables:
;; generated-autoload-file: "esh-groups.el"
;; End:

Gerd Moellmann's avatar
Gerd Moellmann committed
964
;;; em-ls.el ends here