lisp/eshell/em-ls.el

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