lisp/eshell/em-ls.el

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