Commit | Line | Data |
---|---|---|
9dce08b6 | 1 | ;;;; directory.el - emulate insert-directory completely in Emacs Lisp |
d88c0e93 | 2 | |
738eb4e7 | 3 | ;; Copyright (C) 1992 by Sebastian Kremer <sk@thp.uni-koeln.de> |
d88c0e93 | 4 | |
738eb4e7 | 5 | ;; This program is free software; you can redistribute it and/or modify |
d88c0e93 SK |
6 | ;; it under the terms of the GNU General Public License as published by |
7 | ;; the Free Software Foundation; either version 1, or (at your option) | |
8 | ;; any later version. | |
738eb4e7 SK |
9 | ;; |
10 | ;; This program is distributed in the hope that it will be useful, | |
d88c0e93 SK |
11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
13 | ;; GNU General Public License for more details. | |
738eb4e7 | 14 | ;; |
d88c0e93 | 15 | ;; You should have received a copy of the GNU General Public License |
738eb4e7 SK |
16 | ;; along with this program; if not, write to the Free Software |
17 | ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. | |
18 | ||
738eb4e7 SK |
19 | ;; INSTALLATION ======================================================= |
20 | ;; | |
9dce08b6 RS |
21 | ;; Put this file into your load-path. To use it, load it |
22 | ;; with (load "directory"). | |
d9a0f717 | 23 | |
738eb4e7 SK |
24 | ;; OVERVIEW =========================================================== |
25 | ||
9dce08b6 RS |
26 | ;; This file overloads the function insert-directory to implement it |
27 | ;; directly from Emacs lisp, without running `ls' in a subprocess. | |
738eb4e7 | 28 | |
9dce08b6 | 29 | ;; It is useful if you cannot afford to fork Emacs on a real memory UNIX, |
738eb4e7 SK |
30 | ;; under VMS, or if you don't have the ls program, or if you want |
31 | ;; different format from what ls offers. | |
32 | ||
9dce08b6 RS |
33 | ;; This function uses regexps instead of shell |
34 | ;; wildcards. If you enter regexps remember to double each $ sign. | |
35 | ;; For example, to include files *.el, enter `.*\.el$$', | |
738eb4e7 | 36 | ;; resulting in the regexp `.*\.el$'. |
d88c0e93 | 37 | |
738eb4e7 | 38 | ;; RESTRICTIONS ===================================================== |
d88c0e93 | 39 | |
9dce08b6 | 40 | ;; * many ls switches are ignored, see docstring of `insert-directory'. |
738eb4e7 SK |
41 | |
42 | ;; * Only numeric uid/gid | |
43 | ||
738eb4e7 SK |
44 | ;; TODO ============================================================== |
45 | ||
d9a0f717 | 46 | ;; Recognize some more ls switches: R F |
738eb4e7 | 47 | \f |
9dce08b6 RS |
48 | (defun insert-directory (file &optional switches wildcard full-directory-p) |
49 | "Insert directory listing for of FILE, formatted according to SWITCHES. | |
50 | Leaves point after the inserted text. | |
51 | Optional third arg WILDCARD means treat FILE as shell wildcard. | |
6467926f | 52 | Optional fourth arg FULL-DIRECTORY-P means file is a directory and |
9dce08b6 RS |
53 | switches do not contain `d', so that a full listing is expected. |
54 | ||
55 | This version of the function comes from `directory.el'. | |
56 | It does not support ordinary shell wildcards; instead, it allows | |
57 | regular expressions to match file names. | |
58 | ||
59 | The switches that work are: A a c i r S s t u" | |
60 | (let (handler (handlers file-name-handler-alist)) | |
61 | (save-match-data | |
62 | (while (and (consp handlers) (null handler)) | |
63 | (if (and (consp (car handlers)) | |
64 | (stringp (car (car handlers))) | |
65 | (string-match (car (car handlers)) file)) | |
66 | (setq handler (cdr (car handlers)))) | |
67 | (setq handlers (cdr handlers)))) | |
68 | (if handler | |
69 | (funcall handler 'insert-directory file switches | |
70 | wildcard full-directory-p) | |
71 | (if wildcard | |
72 | (setq wildcard (file-name-nondirectory file) ; actually emacs regexp | |
73 | ;; perhaps convert it from shell to emacs syntax? | |
74 | file (file-name-directory file))) | |
75 | (if (or wildcard | |
76 | full-directory-p) | |
77 | (let* ((dir (file-name-as-directory file)) | |
78 | (default-directory dir);; so that file-attributes works | |
79 | (sum 0) | |
80 | elt | |
81 | short | |
82 | (file-list (directory-files dir nil wildcard)) | |
83 | file-alist | |
84 | ;; do all bindings here for speed | |
85 | fil attr) | |
86 | (cond ((memq ?A switches) | |
87 | (setq file-list | |
88 | (ls-lisp-delete-matching "^\\.\\.?$" file-list))) | |
89 | ((not (memq ?a switches)) | |
90 | ;; if neither -A nor -a, flush . files | |
91 | (setq file-list | |
92 | (ls-lisp-delete-matching "^\\." file-list)))) | |
93 | (setq file-alist | |
94 | (mapcar | |
95 | (function | |
96 | (lambda (x) | |
97 | ;; file-attributes("~bogus") bombs | |
98 | (cons x (file-attributes (expand-file-name x))))) | |
99 | ;; inserting the call to directory-files right here | |
100 | ;; seems to stimulate an Emacs bug | |
101 | ;; ILLEGAL DATATYPE (#o37777777727) or #o67 | |
102 | file-list)) | |
103 | (insert "total \007\n") ; filled in afterwards | |
104 | (setq file-alist | |
105 | (ls-lisp-handle-switches file-alist switches)) | |
106 | (while file-alist | |
107 | (setq elt (car file-alist) | |
108 | short (car elt) | |
109 | attr (cdr elt) | |
110 | file-alist (cdr file-alist) | |
111 | fil (concat dir short) | |
112 | sum (+ sum (nth 7 attr))) | |
113 | (insert (ls-lisp-format short attr switches))) | |
114 | ;; Fill in total size of all files: | |
115 | (save-excursion | |
116 | (search-backward "total \007") | |
117 | (goto-char (match-end 0)) | |
118 | (delete-char -1) | |
119 | (insert (format "%d" (1+ (/ sum 1024)))))) | |
120 | ;; if not full-directory-p, FILE *must not* end in /, as | |
121 | ;; file-attributes will not recognize a symlink to a directory | |
122 | ;; must make it a relative filename as ls does: | |
123 | (setq file (file-name-nondirectory file)) | |
124 | (insert (ls-lisp-format file (file-attributes file) switches)))))) | |
125 | ||
126 | (defun ls-lisp-delete-matching (regexp list) | |
6467926f | 127 | ;; Delete all elements matching REGEXP from LIST, return new list. |
d6d472d5 | 128 | ;; Should perhaps use setcdr for efficiency. |
6467926f SK |
129 | (let (result) |
130 | (while list | |
131 | (or (string-match regexp (car list)) | |
132 | (setq result (cons (car list) result))) | |
133 | (setq list (cdr list))) | |
134 | result)) | |
135 | ||
9dce08b6 | 136 | (defun ls-lisp-handle-switches (file-alist switches) |
6467926f | 137 | ;; FILE-ALIST's elements are (FILE . FILE-ATTRIBUTES). |
738eb4e7 SK |
138 | ;; Return new alist sorted according to SWITCHES which is a list of |
139 | ;; characters. Default sorting is alphabetically. | |
e54241c5 SK |
140 | (let (index) |
141 | (setq file-alist | |
142 | (sort file-alist | |
143 | (cond ((memq ?S switches) ; sorted on size | |
144 | (function | |
145 | (lambda (x y) | |
146 | ;; 7th file attribute is file size | |
147 | ;; Make largest file come first | |
148 | (< (nth 7 (cdr y)) | |
149 | (nth 7 (cdr x)))))) | |
150 | ((memq ?t switches) ; sorted on time | |
9dce08b6 | 151 | (setq index (ls-lisp-time-index switches)) |
e54241c5 SK |
152 | (function |
153 | (lambda (x y) | |
9dce08b6 RS |
154 | (ls-lisp-time-lessp (nth index (cdr y)) |
155 | (nth index (cdr x)))))) | |
e54241c5 SK |
156 | (t ; sorted alphabetically |
157 | (function | |
158 | (lambda (x y) | |
159 | (string-lessp (car x) | |
160 | (car y))))))))) | |
6467926f SK |
161 | (if (memq ?r switches) ; reverse sort order |
162 | (setq file-alist (nreverse file-alist))) | |
163 | file-alist) | |
d88c0e93 | 164 | |
e54241c5 | 165 | ;; From Roland McGrath. Can use this to sort on time. |
9dce08b6 | 166 | (defun ls-lisp-time-lessp (time0 time1) |
e54241c5 SK |
167 | (let ((hi0 (car time0)) |
168 | (hi1 (car time1)) | |
169 | (lo0 (car (cdr time0))) | |
170 | (lo1 (car (cdr time1)))) | |
171 | (or (< hi0 hi1) | |
172 | (and (= hi0 hi1) | |
173 | (< lo0 lo1))))) | |
174 | ||
175 | ||
9dce08b6 | 176 | (defun ls-lisp-format (file-name file-attr &optional switches) |
d88c0e93 | 177 | (let ((file-type (nth 0 file-attr))) |
6467926f | 178 | (concat (if (memq ?i switches) ; inode number |
d6d472d5 SK |
179 | (format "%6d " (nth 10 file-attr))) |
180 | ;; nil is treated like "" in concat | |
6467926f | 181 | (if (memq ?s switches) ; size in K |
d6d472d5 | 182 | (format "%4d " (1+ (/ (nth 7 file-attr) 1024)))) |
6467926f | 183 | (nth 8 file-attr) ; permission bits |
d88c0e93 | 184 | ;; numeric uid/gid are more confusing than helpful |
6467926f SK |
185 | ;; Emacs should be able to make strings of them. |
186 | ;; user-login-name and user-full-name could take an | |
187 | ;; optional arg. | |
d6d472d5 SK |
188 | (format " %3d %-8d %-8d %8d " |
189 | (nth 1 file-attr) ; no. of links | |
190 | (nth 2 file-attr) ; uid | |
191 | (nth 3 file-attr) ; gid | |
192 | (nth 7 file-attr) ; size in bytes | |
193 | ) | |
9dce08b6 | 194 | (ls-lisp-format-time file-attr switches) |
738eb4e7 | 195 | " " |
d88c0e93 SK |
196 | file-name |
197 | (if (stringp file-type) ; is a symbolic link | |
198 | (concat " -> " file-type) | |
199 | "") | |
200 | "\n" | |
201 | ))) | |
202 | ||
9dce08b6 | 203 | (defun ls-lisp-time-index (switches) |
e54241c5 SK |
204 | ;; Return index into file-attributes according to ls SWITCHES. |
205 | (cond | |
206 | ((memq ?c switches) 6) ; last mode change | |
207 | ((memq ?u switches) 4) ; last access | |
208 | ;; default is last modtime | |
209 | (t 5))) | |
210 | ||
9dce08b6 | 211 | (defun ls-lisp-format-time (file-attr switches) |
738eb4e7 SK |
212 | ;; Format time string for file with attributes FILE-ATTR according |
213 | ;; to SWITCHES (a list of ls option letters of which c and u are recognized). | |
214 | ;; file-attributes's time is in a braindead format | |
215 | ;; Emacs 19 can format it using a new optional argument to | |
216 | ;; current-time-string, for Emacs 18 we just return the faked fixed | |
217 | ;; date "Jan 00 00:00 ". | |
218 | (condition-case error-data | |
219 | (let* ((time (current-time-string | |
9dce08b6 | 220 | (nth (ls-lisp-time-index switches) file-attr))) |
738eb4e7 SK |
221 | (date (substring time 4 11)) ; "Apr 30 " |
222 | (clock (substring time 11 16)) ; "11:27" | |
223 | (year (substring time 19 24)) ; " 1992" | |
224 | (same-year (equal year (substring (current-time-string) 19 24)))) | |
225 | (concat date ; has trailing SPC | |
226 | (if same-year | |
227 | ;; this is not exactly the same test used by ls | |
228 | ;; ls tests if the file is older than 6 months | |
229 | ;; but we can't do time differences easily | |
230 | clock | |
231 | year))) | |
232 | (error | |
233 | "Jan 00 00:00"))) | |
234 | ||
9dce08b6 | 235 | (provide 'ls-lisp) |
738eb4e7 SK |
236 | |
237 | ; eof |