lisp/eshell/em-ls.el

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