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