lisp/eshell/em-ls.el

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