lisp/eshell/em-ls.el

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