lisp/eshell/em-ls.el

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