Function: ls-lisp-insert-directory

ls-lisp-insert-directory is a byte-compiled function defined in ls-lisp.el.gz.

Signature

(ls-lisp-insert-directory FILE SWITCHES TIME-INDEX WILDCARD-REGEXP FULL-DIRECTORY-P)

Documentation

Insert directory listing for FILE, formatted according to SWITCHES.

Leaves point after the inserted text. This is an internal function optionally called by the ls-lisp.el version of insert-directory. It is called recursively if the -R switch is used. SWITCHES is a *list* of characters. TIME-INDEX is the time index into file-attributes according to SWITCHES. WILDCARD-REGEXP is nil or an *Emacs regexp*. FULL-DIRECTORY-P means file is a directory and SWITCHES does not contain d, so that a full listing is expected.

Source Code

;; Defined in /usr/src/emacs/lisp/ls-lisp.el.gz
(defun ls-lisp-insert-directory
  (file switches time-index wildcard-regexp full-directory-p)
  "Insert directory listing for FILE, formatted according to SWITCHES.
Leaves point after the inserted text.  This is an internal function
optionally called by the `ls-lisp.el' version of `insert-directory'.
It is called recursively if the -R switch is used.
SWITCHES is a *list* of characters.  TIME-INDEX is the time index into
file-attributes according to SWITCHES.  WILDCARD-REGEXP is nil or an *Emacs
regexp*.  FULL-DIRECTORY-P means file is a directory and SWITCHES does
not contain `d', so that a full listing is expected."
  (if (or (and wildcard-regexp
               (not (string= "[^~]\\'" wildcard-regexp))) ; Switch -B pseudo-wildcard regexp
          full-directory-p)
      (let* ((dir (file-name-as-directory file))
	     (default-directory dir)	; so that file-attributes works
             (id-format (if (memq ?n switches)
                            'integer
                          'string))
	     (file-alist
              (catch 'new-list
                (handler-bind
                    ((error
                      (lambda (error)
                        ;; `directory-files-and-attributes' signals
                        ;; failure on Unix systems if even a single
                        ;; file's attributes cannot be accessed.
                        ;;
                        ;; Detect errors signaled while retrieving file
                        ;; attributes and resolve them by creating the
                        ;; attribute list manually, ignoring the
                        ;; attributes of files that cannot be accessed
                        ;; in this sense.
                        (when (member (cadr error)
                                      '("Getting attributes"
                                        "Reading symbolic link"))
                          (let ((file-list (directory-files dir nil
                                                            wildcard-regexp
                                                            t)))
                            (throw 'new-list
                                   (mapcar (lambda (file)
                                             (cons file
                                                   (or (ignore-errors
                                                         (file-attributes
                                                          file id-format))
                                                       nil)))
                                           file-list)))))))
                  (directory-files-and-attributes
                   dir nil wildcard-regexp t id-format))))
	     (sum 0)
	     (max-uid-len 0)
	     (max-gid-len 0)
	     (max-file-size 0)
	     ;; do all bindings here for speed
	     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)))
	      ((not (memq ?a switches))
	       ;; if neither -A  nor -a, flush . files
	       (setq file-alist
		     (ls-lisp-delete-matching "^\\." file-alist))))
	(setq file-alist
	      (ls-lisp-handle-switches file-alist switches))
	(if (memq ?C switches)		; column (-C) format
	    (ls-lisp-column-format file-alist)
	  (setq total-line (cons (point) (car-safe file-alist)))
	  ;; Find the appropriate format for displaying uid, gid, and
	  ;; file size, by finding the longest strings among all the
	  ;; files we are about to display.
	  (dolist (elt file-alist)
	    (setq attr (cdr elt)
		  fuid (file-attribute-user-id attr)
		  uid-len (if (stringp fuid) (string-width fuid)
			    (length (format "%d" fuid)))
		  fgid (file-attribute-group-id attr)
		  gid-len (if (stringp fgid) (string-width fgid)
			    (length (format "%d" fgid)))
		  file-size (file-attribute-size attr))
	    (if (> uid-len max-uid-len)
		(setq max-uid-len uid-len))
	    (if (> gid-len max-gid-len)
		(setq max-gid-len gid-len))
	    (if (> file-size max-file-size)
		(setq max-file-size file-size)))
	  (setq ls-lisp-uid-d-fmt (format " %%-%dd" max-uid-len))
	  (setq ls-lisp-uid-s-fmt (format " %%-%ds" max-uid-len))
	  (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" (length (format "%.0f" max-file-size))))
	  (setq ls-lisp-filesize-f-fmt
		(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)))))))
	  (setq files file-alist)
	  (while files			; long (-l) format
	    (setq elt (car files)
		  files (cdr files)
		  short (car elt)
		  attr (cdr elt)
		  file-size (file-attribute-size attr))
	    (and attr
		 (setq sum (+ file-size sum))
		 (insert (ls-lisp-format short attr file-size
					 switches time-index))))
	  ;; Insert total size of all files:
	  (save-excursion
	    (goto-char (car total-line))
	    (or (cdr total-line)
		;; Shell says ``No match'' if no files match
		;; 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.  Getting past the
	;; inserted text solves this.
	(unless (cdr total-line) (forward-line 2))
	(if (memq ?R switches)
	    ;; List the contents of all directories recursively.
	    ;; cadr of each element of `file-alist' is t for
	    ;; directory, string (name linked to) for symbolic
	    ;; link, or nil.
	    (while file-alist
	      (setq elt (car file-alist)
		    file-alist (cdr file-alist))
	      (when (and (eq (cadr elt) t) ; directory
			 ;; Under -F, we have already decorated all
			 ;; directories, including "." and "..", with
			 ;; a /, so allow for that as well.
			 (not (string-match "\\`\\.\\.?/?\\'" (car elt))))
		(setq elt (expand-file-name (car elt) dir))
		(insert "\n" elt ":\n")
		(ls-lisp-insert-directory
		 elt switches time-index wildcard-regexp full-directory-p)))))
    ;; If not full-directory-p, FILE *must not* end in /, as
    ;; file-attributes will not recognize a symlink to a directory,
    ;; so must make it a relative filename as ls does:
    (if (file-name-absolute-p file) (setq file (expand-file-name file)))
    (if (eq (aref file (1- (length file))) ?/)
	(setq file (substring file 0 -1)))
    (let ((fattr (file-attributes file 'string)))
      (if fattr
	  (insert (ls-lisp-format
		   (if (memq ?F switches)
		       (ls-lisp-classify-file file fattr)
		     file)
		   fattr (file-attribute-size fattr)
                   switches time-index))
        ;; Emulate what we do on Posix hosts when we call access-file
        ;; in insert-directory.
	(signal 'file-error
                (list "Reading directory"
                      "Directory doesn't exist or is inaccessible"
                      file))))))