(defvar ls-lisp-support-shell-wildcards t
"*Non-nil means file patterns are treated as shell wildcards.
nil means they are treated as Emacs regexps (for backward compatibility).
This variable is checked by \\[insert-directory] only when `ls-lisp.el'
package is used.")
(defvar ls-lisp-dired-ignore-case nil
"Non-nil causes dired buffers to sort alphabetically regardless of case.")
(defvar ls-lisp-use-insert-directory-program nil
"Non-nil causes ls-lisp to revert back to using `insert-directory-program'.
This is useful on platforms where ls-lisp is dumped into Emacs, such as
Microsoft Windows, but you would still like to use a program to list
the contents of a directory.")
(fset 'original-insert-directory (symbol-function 'insert-directory))
(defun insert-directory (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.
Optional third arg WILDCARD means treat FILE as shell wildcard.
Optional fourth arg FULL-DIRECTORY-P means file is a directory and
switches do not contain `d', so that a full listing is expected.
This version of the function comes from `ls-lisp.el'. Depending upon
the value of `ls-lisp-use-insert-directory-program', it will use an
external program if non-nil or the lisp function `ls-lisp-insert-directory'
otherwise."
(if ls-lisp-use-insert-directory-program
(original-insert-directory file switches wildcard full-directory-p)
(ls-lisp-insert-directory file switches wildcard full-directory-p)))
(defun ls-lisp-insert-directory (file switches &optional wildcard full-directory-p)
"Insert directory listing for FILE, formatted according to SWITCHES.
Leaves point after the inserted text.
Optional third arg WILDCARD means treat FILE as shell wildcard.
Optional fourth arg FULL-DIRECTORY-P means file is a directory and
switches do not contain `d', so that a full listing is expected.
This version of the function comes from `ls-lisp.el'. It does not
run any external programs or shells. It supports ordinary shell
wildcards if `ls-lisp-support-shell-wildcards' variable is non-nil;
otherwise, it interprets wildcards as regular expressions to match
file names.
Not all `ls' switches are supported. The switches that work
are: A a c i r S s t u"
(let ((handler (find-file-name-handler file 'insert-directory)))
(if handler
(funcall handler 'insert-directory file switches
wildcard full-directory-p)
(if (and ls-lisp-support-shell-wildcards
(string-match "[[?*]" file))
(progn
(or (not (eq (aref file (1- (length file))) ?/))
(setq file (substring file 0 (1- (length file)))))
(setq wildcard t)))
(setq switches (append switches nil))
(if wildcard
(setq wildcard
(if ls-lisp-support-shell-wildcards
(wildcard-to-regexp (file-name-nondirectory file))
(file-name-nondirectory file))
file (file-name-directory file)))
(if (or wildcard
full-directory-p)
(let* ((dir (file-name-as-directory file))
(default-directory dir) (sum 0)
elt
short
(file-list (directory-files dir nil wildcard))
file-alist
(now (current-time))
file-size
fil attr)
(cond ((memq ?A switches)
(setq file-list
(ls-lisp-delete-matching "^\\.\\.?$" file-list)))
((not (memq ?a switches))
(setq file-list
(ls-lisp-delete-matching "^\\." file-list))))
(setq file-alist
(mapcar
(function
(lambda (x)
(cons x (file-attributes (expand-file-name x)))))
file-list))
(insert (if (car-safe file-alist)
"total \007\n"
"(No match)\ntotal \007\n"))
(setq file-alist
(ls-lisp-handle-switches file-alist switches))
(while file-alist
(setq elt (car file-alist)
file-alist (cdr file-alist)
short (car elt)
attr (cdr elt)
file-size (nth 7 attr))
(and attr
(setq sum
(if (or (< sum (- 134217727 file-size))
(floatp sum)
(floatp file-size))
(+ sum file-size)
(+ (float sum) file-size)))
(insert (ls-lisp-format short attr file-size switches now))
))
(save-excursion
(search-backward "total \007")
(goto-char (match-end 0))
(delete-char -1)
(insert (format "%.0f" (fceiling (/ sum 1024.0))))))
(setq file (file-name-nondirectory file))
(insert (ls-lisp-format file (file-attributes file)
(nth 7 (file-attributes file)) switches
(current-time)))))))
(defun ls-lisp-delete-matching (regexp list)
(let (result)
(while list
(or (string-match regexp (car list))
(setq result (cons (car list) result)))
(setq list (cdr list)))
result))
(defun ls-lisp-handle-switches (file-alist switches)
(let (index)
(setq file-alist
(sort file-alist
(cond ((memq ?S switches) (function
(lambda (x y)
(< (nth 7 (cdr y))
(nth 7 (cdr x))))))
((memq ?t switches) (setq index (ls-lisp-time-index switches))
(function
(lambda (x y)
(ls-lisp-time-lessp (nth index (cdr y))
(nth index (cdr x))))))
(t (if ls-lisp-dired-ignore-case
(function
(lambda (x y)
(string-lessp (upcase (car x))
(upcase (car y)))))
(function
(lambda (x y)
(string-lessp (car x)
(car y))))))))))
(if (memq ?r switches) (setq file-alist (nreverse file-alist)))
file-alist)
(defun ls-lisp-time-lessp (time0 time1)
(let ((hi0 (car time0))
(hi1 (car time1))
(lo0 (car (cdr time0)))
(lo1 (car (cdr time1))))
(or (< hi0 hi1)
(and (= hi0 hi1)
(< lo0 lo1)))))
(defun ls-lisp-format (file-name file-attr file-size switches now)
(let ((file-type (nth 0 file-attr)))
(concat (if (memq ?i switches) (format "%6d " (nth 10 file-attr)))
(if (memq ?s switches) (format "%4.0f " (fceiling (/ file-size 1024.0))))
(nth 8 file-attr) (format (if (floatp file-size)
" %3d %-8s %-8s %8.0f "
" %3d %-8s %-8s %8d ")
(nth 1 file-attr) (if (= (user-uid) (nth 2 file-attr))
(user-login-name)
(int-to-string (nth 2 file-attr))) (if (eq system-type 'ms-dos)
"root" (int-to-string (nth 3 file-attr))) file-size
)
(ls-lisp-format-time file-attr switches now)
" "
file-name
(if (stringp file-type) (concat " -> " file-type)
"")
"\n"
)))
(defun ls-lisp-time-index (switches)
(cond
((memq ?c switches) 6) ((memq ?u switches) 4) (t 5)))
(defun ls-lisp-format-time (file-attr switches now)
(let* ((time (nth (ls-lisp-time-index switches) file-attr))
(diff16 (- (car time) (car now)))
(diff (+ (ash diff16 16) (- (car (cdr time)) (car (cdr now)))))
(past-cutoff (- (* 6 30 24 60 60))) (future-cutoff (* 60 60))) (condition-case nil
(format-time-string
(if (and
(<= past-cutoff diff) (<= diff future-cutoff)
(<= (1- (ash past-cutoff -16)) diff16)
(<= diff16 (1+ (ash future-cutoff -16))))
"%b %e %H:%M"
"%b %e %Y")
time)
(error "Unk 0 0000"))))
(provide 'ls-lisp)