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