API tools faq
paste
Advertisement
Guest User

Untitled

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