1 ;;; ls-lisp.el --- emulate insert-directory completely in Emacs Lisp
3 ;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
6 ;; Copyright (C) 1992, 1994 by Sebastian Kremer <sk@thp.uni-koeln.de>
8 ;; This program is free software; you can redistribute it and/or modify
9 ;; it under the terms of the GNU General Public License as published by
10 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; This program is distributed in the hope that it will be useful,
14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 ;; GNU General Public License for more details.
18 ;; You should have received a copy of the GNU General Public License
19 ;; along with this program; if not, write to the Free Software
20 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
22 ;; INSTALLATION =======================================================
24 ;; Put this file into your load-path. To use it, load it
25 ;; with (load "ls-lisp").
27 ;; OVERVIEW ===========================================================
29 ;; This file overloads the function insert-directory to implement it
30 ;; directly from Emacs lisp, without running `ls' in a subprocess.
32 ;; It is useful if you cannot afford to fork Emacs on a real memory UNIX,
33 ;; under VMS, or if you don't have the ls program, or if you want
34 ;; different format from what ls offers.
36 ;; This function uses regexps instead of shell
37 ;; wildcards. If you enter regexps remember to double each $ sign.
38 ;; For example, to include files *.el, enter `.*\.el$$',
39 ;; resulting in the regexp `.*\.el$'.
41 ;; RESTRICTIONS =====================================================
43 ;; * many ls switches are ignored, see docstring of `insert-directory'.
45 ;; * Only numeric uid/gid
47 ;; TODO ==============================================================
49 ;; Recognize some more ls switches: R F
53 (defvar ls-lisp-support-shell-wildcards t
54 "*Non-nil means file patterns are treated as shell wildcards.
55 nil means they are treated as Emacs regexps (for backward compatibility).
56 This variable is checked by \\[insert-directory] only when `ls-lisp.el'
59 (defun insert-directory (file &optional switches wildcard full-directory-p)
60 "Insert directory listing for FILE, formatted according to SWITCHES.
61 Leaves point after the inserted text.
62 Optional third arg WILDCARD means treat FILE as shell wildcard.
63 Optional fourth arg FULL-DIRECTORY-P means file is a directory and
64 switches do not contain `d', so that a full listing is expected.
66 This version of the function comes from `ls-lisp.el'. It doesn not
67 run any external programs or shells. It supports ordinary shell
68 wildcards if `ls-lisp-support-shell-wildcards' variable is non-nil;
69 otherwise, it interprets wildcards as regular expressions to match
72 Not all `ls' switches are supported. The switches that work
73 are: A a c i r S s t u"
74 (let ((handler (find-file-name-handler file 'insert-directory)))
76 (funcall handler 'insert-directory file switches
77 wildcard full-directory-p)
78 ;; Sometimes we get ".../foo*/" as FILE. While the shell and
79 ;; `ls' don't mind, we certainly do, because it makes us think
80 ;; there is no wildcard, only a directory name.
81 (if (and ls-lisp-support-shell-wildcards
82 (string-match "[[?*]" file))
84 (or (not (eq (aref file (1- (length file))) ?/))
85 (setq file (substring file 0 (1- (length file)))))
87 ;; Convert SWITCHES to a list of characters.
88 (setq switches (append switches nil))
91 (if ls-lisp-support-shell-wildcards
92 (wildcard-to-regexp (file-name-nondirectory file))
93 (file-name-nondirectory file))
94 file (file-name-directory file)))
97 (let* ((dir (file-name-as-directory file))
98 (default-directory dir);; so that file-attributes works
102 (file-list (directory-files dir nil wildcard))
104 ;; do all bindings here for speed
106 (cond ((memq ?A switches)
108 (ls-lisp-delete-matching "^\\.\\.?$" file-list)))
109 ((not (memq ?a switches))
110 ;; if neither -A nor -a, flush . files
112 (ls-lisp-delete-matching "^\\." file-list))))
117 ;; file-attributes("~bogus") bombs
118 (cons x (file-attributes (expand-file-name x)))))
119 ;; inserting the call to directory-files right here
120 ;; seems to stimulate an Emacs bug
121 ;; ILLEGAL DATATYPE (#o37777777727) or #o67
123 ;; ``Total'' line (filled in afterwards).
124 (insert (if (car-safe file-alist)
126 ;; Shell says ``No match'' if no files match
127 ;; the wildcard; let's say something similar.
128 "(No match)\ntotal \007\n"))
130 (ls-lisp-handle-switches file-alist switches))
132 (setq elt (car file-alist)
133 file-alist (cdr file-alist)
137 (setq sum (+ sum (nth 7 attr)))
138 (insert (ls-lisp-format short attr switches))))
139 ;; Fill in total size of all files:
141 (search-backward "total \007")
142 (goto-char (match-end 0))
144 (insert (format "%d" (if (zerop sum) 0 (1+ (/ sum 1024)))))))
145 ;; if not full-directory-p, FILE *must not* end in /, as
146 ;; file-attributes will not recognize a symlink to a directory
147 ;; must make it a relative filename as ls does:
148 (setq file (file-name-nondirectory file))
149 (insert (ls-lisp-format file (file-attributes file) switches))))))
151 (defun ls-lisp-delete-matching (regexp list)
152 ;; Delete all elements matching REGEXP from LIST, return new list.
153 ;; Should perhaps use setcdr for efficiency.
156 (or (string-match regexp (car list))
157 (setq result (cons (car list) result)))
158 (setq list (cdr list)))
161 (defun ls-lisp-handle-switches (file-alist switches)
162 ;; FILE-ALIST's elements are (FILE . FILE-ATTRIBUTES).
163 ;; Return new alist sorted according to SWITCHES which is a list of
164 ;; characters. Default sorting is alphabetically.
168 (cond ((memq ?S switches) ; sorted on size
171 ;; 7th file attribute is file size
172 ;; Make largest file come first
175 ((memq ?t switches) ; sorted on time
176 (setq index (ls-lisp-time-index switches))
179 (ls-lisp-time-lessp (nth index (cdr y))
180 (nth index (cdr x))))))
181 (t ; sorted alphabetically
184 (string-lessp (car x)
186 (if (memq ?r switches) ; reverse sort order
187 (setq file-alist (nreverse file-alist)))
190 ;; From Roland McGrath. Can use this to sort on time.
191 (defun ls-lisp-time-lessp (time0 time1)
192 (let ((hi0 (car time0))
194 (lo0 (car (cdr time0)))
195 (lo1 (car (cdr time1))))
201 (defun ls-lisp-format (file-name file-attr &optional switches)
202 (let ((file-type (nth 0 file-attr)))
203 (concat (if (memq ?i switches) ; inode number
204 (format "%6d " (nth 10 file-attr)))
205 ;; nil is treated like "" in concat
206 (if (memq ?s switches) ; size in K
207 (format "%4d " (1+ (/ (nth 7 file-attr) 1024))))
208 (nth 8 file-attr) ; permission bits
209 ;; numeric uid/gid are more confusing than helpful
210 ;; Emacs should be able to make strings of them.
211 ;; user-login-name and user-full-name could take an
213 (format " %3d %-8s %-8s %8d "
214 (nth 1 file-attr) ; no. of links
215 (if (= (user-uid) (nth 2 file-attr))
217 (int-to-string (nth 2 file-attr))) ; uid
218 (if (eq system-type 'ms-dos)
219 "root" ; everything is root on MSDOS.
220 (int-to-string (nth 3 file-attr))) ; gid
221 (nth 7 file-attr) ; size in bytes
223 (ls-lisp-format-time file-attr switches)
226 (if (stringp file-type) ; is a symbolic link
227 (concat " -> " file-type)
232 (defun ls-lisp-time-index (switches)
233 ;; Return index into file-attributes according to ls SWITCHES.
235 ((memq ?c switches) 6) ; last mode change
236 ((memq ?u switches) 4) ; last access
237 ;; default is last modtime
240 (defun ls-lisp-format-time (file-attr switches)
241 ;; Format time string for file with attributes FILE-ATTR according
242 ;; to SWITCHES (a list of ls option letters of which c and u are recognized).
243 ;; file-attributes's time is in a braindead format
244 ;; Emacs 19 can format it using a new optional argument to
245 ;; current-time-string, for Emacs 18 we just return the faked fixed
246 ;; date "Jan 00 00:00 ".
247 (condition-case error-data
248 (let* ((time (current-time-string
249 (nth (ls-lisp-time-index switches) file-attr)))
250 (date (substring time 4 11)) ; "Apr 30 "
251 (clock (substring time 11 16)) ; "11:27"
252 (year (substring time 19 24)) ; " 1992"
253 (same-year (equal year (substring (current-time-string) 19 24))))
254 (concat date ; has trailing SPC
256 ;; this is not exactly the same test used by ls
257 ;; ls tests if the file is older than 6 months
258 ;; but we can't do time differences easily
266 ;;; ls-lisp.el ends here