X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/606dcd9ebc3b896bef9f63d7bbc606a19eed9d87..88312cfc5990060c2d5d54002774ef07e354dd12:/lisp/ls-lisp.el diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index 5f76c1bab7..ae6fcb0599 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -1,7 +1,6 @@ ;;; ls-lisp.el --- emulate insert-directory completely in Emacs Lisp -;; Copyright (C) 1992, 1994, 2000, 2001, 2002, 2003, 2004, 2005, 2006, -;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1992, 1994, 2000-2013 Free Software Foundation, Inc. ;; Author: Sebastian Kremer ;; Modified by: Francis J. Wright @@ -28,11 +27,9 @@ ;; OVERVIEW ========================================================== -;; This file redefines the function `insert-directory' to implement it -;; directly from Emacs lisp, without running ls in a subprocess. It -;; is useful if you cannot afford to fork Emacs on a real memory UNIX, -;; or other non-UNIX platforms if you don't have the ls -;; program, or if you want a different format from what ls offers. +;; This file advises the function `insert-directory' to implement it +;; directly from Emacs lisp, without running ls in a subprocess. +;; This is useful if you don't have ls installed (ie, on MS Windows). ;; This function can use regexps instead of shell wildcards. If you ;; enter regexps remember to double each $ sign. For example, to @@ -63,8 +60,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) - (defgroup ls-lisp nil "Emulate the ls program completely in Emacs Lisp." :version "21.1" @@ -103,10 +98,16 @@ update the dependent variables." (ls-lisp-set-options))) :group 'ls-lisp) +;; Only made an obsolete alias in 23.3. Before that, the initial +;; value was set according to: +;; (or (memq ls-lisp-emulation '(MS-Windows MacOS)) +;; (and (boundp 'ls-lisp-dired-ignore-case) ls-lisp-dired-ignore-case)) +;; Which isn't the right thing to do. +(define-obsolete-variable-alias 'ls-lisp-dired-ignore-case + 'ls-lisp-ignore-case "21.1") + (defcustom ls-lisp-ignore-case - ;; Name change for consistency with other option names. - (or (memq ls-lisp-emulation '(MS-Windows MacOS)) - (and (boundp 'ls-lisp-dired-ignore-case) ls-lisp-dired-ignore-case)) + (memq ls-lisp-emulation '(MS-Windows MacOS)) "Non-nil causes ls-lisp alphabetic sorting to ignore case." :set-after '(ls-lisp-emulation) :type 'boolean @@ -195,9 +196,6 @@ to fail to line up, e.g. if month names are not all of the same length." :type 'boolean :group 'ls-lisp) -(defvar original-insert-directory nil - "This holds the original function definition of `insert-directory'.") - (defvar ls-lisp-uid-d-fmt "-%d" "Format to display integer UIDs.") (defvar ls-lisp-uid-s-fmt "-%s" @@ -210,15 +208,12 @@ to fail to line up, e.g. if month names are not all of the same length." "Format to display integer file sizes.") (defvar ls-lisp-filesize-f-fmt "%.0f" "Format to display float file sizes.") - -;; Remember the original insert-directory function -(or (featurep 'ls-lisp) ; FJW: unless this file is being reloaded! - (setq original-insert-directory (symbol-function 'insert-directory))) - +(defvar ls-lisp-filesize-b-fmt "%.0f" + "Format to display file sizes in blocks (for the -s switch).") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun insert-directory (file switches &optional wildcard full-directory-p) +(defun ls-lisp--insert-directory (orig-fun file switches &optional wildcard full-directory-p) "Insert directory listing for FILE, formatted according to SWITCHES. Leaves point after the inserted text. SWITCHES may be a string of options, or a list of strings. @@ -228,12 +223,10 @@ switches do not contain `d', so that a full listing is expected. This version of the function comes from `ls-lisp.el'. If the value of `ls-lisp-use-insert-directory-program' is non-nil then -it works exactly like the version from `files.el' and runs a directory -listing program whose name is in the variable -`insert-directory-program'; if also WILDCARD is non-nil then it runs -the shell specified by `shell-file-name'. If the value of -`ls-lisp-use-insert-directory-program' is nil then it runs a Lisp -emulation. +this advice just delegates the work to ORIG-FUN (the normal `insert-directory' +function from `files.el'). +But if the value of `ls-lisp-use-insert-directory-program' is nil +then it runs a Lisp emulation. The Lisp emulation does not run any external programs or shells. It supports ordinary shell wildcards if `ls-lisp-support-shell-wildcards' @@ -242,7 +235,7 @@ to match file names. It does not support all `ls' switches -- those that work are: A a B C c F G g h i n R r S s t U u X. The l switch is assumed to be always present and cannot be turned off." (if ls-lisp-use-insert-directory-program - (funcall original-insert-directory + (funcall orig-fun file switches wildcard full-directory-p) ;; We need the directory in order to find the right handler. (let ((handler (find-file-name-handler (expand-file-name file) @@ -302,6 +295,7 @@ is assumed to be always present and cannot be turned off." (replace-match "total used in directory") (end-of-line) (insert " available " available))))))))) +(advice-add 'insert-directory :around #'ls-lisp--insert-directory) (defun ls-lisp-insert-directory (file switches time-index wildcard-regexp full-directory-p) @@ -326,8 +320,9 @@ not contain `d', so that a full listing is expected." (max-gid-len 0) (max-file-size 0) ;; do all bindings here for speed - total-line files elt short file-size fil attr + total-line files elt short file-size attr fuid fgid uid-len gid-len) + (setq file-alist (ls-lisp-sanitize file-alist)) (cond ((memq ?A switches) (setq file-alist (ls-lisp-delete-matching "^\\.\\.?$" file-alist))) @@ -363,17 +358,15 @@ not contain `d', so that a full listing is expected." (setq ls-lisp-gid-d-fmt (format " %%-%dd" max-gid-len)) (setq ls-lisp-gid-s-fmt (format " %%-%ds" max-gid-len)) (setq ls-lisp-filesize-d-fmt - (format " %%%dd" - (if (memq ?s switches) - (length (format "%.0f" - (fceiling (/ max-file-size 1024.0)))) - (length (format "%.0f" max-file-size))))) + (format " %%%dd" (length (format "%.0f" max-file-size)))) (setq ls-lisp-filesize-f-fmt - (format " %%%d.0f" - (if (memq ?s switches) + (format " %%%d.0f" (length (format "%.0f" max-file-size)))) + (if (memq ?s switches) + (setq ls-lisp-filesize-b-fmt + (format "%%%d.0f " (length (format "%.0f" - (fceiling (/ max-file-size 1024.0)))) - (length (format "%.0f" max-file-size))))) + (fceiling + (/ max-file-size 1024.0))))))) (setq files file-alist) (while files ; long (-l) format (setq elt (car files) @@ -400,6 +393,13 @@ not contain `d', so that a full listing is expected." ;; the wildcard; let's say something similar. (insert "(No match)\n")) (insert (format "total %.0f\n" (fceiling (/ sum 1024.0)))))) + ;; dired-insert-directory expects to find point after the + ;; text. But if the listing is empty, as e.g. in empty + ;; directories with -a removed from switches, point will be + ;; before the inserted text, and dired-insert-directory will + ;; not indent the listing correctly. Going to the end of the + ;; buffer fixes that. + (unless files (goto-char (point-max))) (if (memq ?R switches) ;; List the contents of all directories recursively. ;; cadr of each element of `file-alist' is t for @@ -434,6 +434,22 @@ not contain `d', so that a full listing is expected." (message "%s: doesn't exist or is inaccessible" file) (ding) (sit-for 2))))) ; to show user the message! +(defun ls-lisp-sanitize (file-alist) + "Sanitize the elements in FILE-ALIST. +Fixes any elements in the alist for directory entries whose file +attributes are nil (meaning that `file-attributes' failed for +them). This is known to happen for some network shares, in +particular for the \"..\" directory entry. + +If the \"..\" directory entry has nil attributes, the attributes +are copied from the \".\" entry, if they are non-nil. Otherwise, +the offending element is removed from the list, as are any +elements for other directory entries with nil attributes." + (if (and (null (cdr (assoc ".." file-alist))) + (cdr (assoc "." file-alist))) + (setcdr (assoc ".." file-alist) (cdr (assoc "." file-alist)))) + (rassq-delete-all nil file-alist)) + (defun ls-lisp-column-format (file-alist) "Insert the file names (only) in FILE-ALIST into the current buffer. Format in columns, sorted vertically, following GNU ls -C. @@ -637,9 +653,20 @@ SWITCHES and TIME-INDEX give the full switch list and time data." (cdr inode)))) (format " %18d " inode)))) ;; nil is treated like "" in concat - (if (memq ?s switches) ; size in K - (format ls-lisp-filesize-f-fmt - (fceiling (/ file-size 1024.0)))) + (if (memq ?s switches) ; size in K, rounded up + ;; In GNU ls, -h affects the size in blocks, displayed + ;; by -s, as well. + (if (memq ?h switches) + (format "%6s " + (file-size-human-readable + ;; We use 1K as "block size", although + ;; most Windows volumes use 4KB to 8KB + ;; clusters, and exFAT will usually have + ;; clusters of 32KB or even 128KB. See + ;; KB article 140365 for the details. + (* 1024.0 (fceiling (/ file-size 1024.0))))) + (format ls-lisp-filesize-b-fmt + (fceiling (/ file-size 1024.0))))) drwxrwxrwx ; attribute string (if (memq 'links ls-lisp-verbosity) (format "%3d" (nth 1 file-attr))) ; link count @@ -721,13 +748,7 @@ All ls time options, namely c, t and u, are handled." ls-lisp-filesize-f-fmt ls-lisp-filesize-d-fmt) file-size) - (if (< file-size 1024) - (format " %4d" file-size) - (do ((file-size (/ file-size 1024.0) (/ file-size 1024.0)) - ;; kilo, mega, giga, tera, peta, exa - (post-fixes (list "k" "M" "G" "T" "P" "E") (cdr post-fixes))) - ((< file-size 1024) - (format " %3.0f%s" file-size (car post-fixes))))))) + (format " %6s" (file-size-human-readable file-size)))) (provide 'ls-lisp)