;;; 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-2014 Free Software Foundation, Inc.
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
;; Modified by: Francis J. Wright <F.J.Wright@maths.qmw.ac.uk>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: unix, dired
;; Package: emacs
;; 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
;;; Code:
-(eval-when-compile (require 'cl))
-
(defgroup ls-lisp nil
"Emulate the ls program completely in Emacs Lisp."
:version "21.1"
: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"
"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).")
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(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.
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'
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)
(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)
(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)))
(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)
;; 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
(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.
(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
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)