lisp/eshell/em-ls.el

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