lisp/eshell/em-ls.el

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