lisp/eshell/em-ls.el

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