Commit | Line | Data |
---|---|---|
76550a57 ER |
1 | ;;; ls-lisp.el --- emulate insert-directory completely in Emacs Lisp |
2 | ||
11d86ba0 | 3 | ;; Copyright (C) 1992, 1994 Free Software Foundation, Inc. |
b578f267 | 4 | |
76550a57 | 5 | ;; Author: Sebastian Kremer <sk@thp.uni-koeln.de> |
0acdb863 | 6 | ;; Maintainer: FSF |
76550a57 | 7 | ;; Keywords: unix |
d88c0e93 | 8 | |
b578f267 | 9 | ;; This file is part of GNU Emacs. |
d88c0e93 | 10 | |
b578f267 | 11 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
d88c0e93 | 12 | ;; it under the terms of the GNU General Public License as published by |
7c938215 | 13 | ;; the Free Software Foundation; either version 2, or (at your option) |
d88c0e93 | 14 | ;; any later version. |
b578f267 EN |
15 | |
16 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
d88c0e93 SK |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;; GNU General Public License for more details. | |
b578f267 | 20 | |
d88c0e93 | 21 | ;; You should have received a copy of the GNU General Public License |
b578f267 EN |
22 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
23 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
24 | ;; Boston, MA 02111-1307, USA. | |
25 | ||
26 | ;;; Commentary: | |
738eb4e7 | 27 | |
738eb4e7 SK |
28 | ;; INSTALLATION ======================================================= |
29 | ;; | |
9dce08b6 | 30 | ;; Put this file into your load-path. To use it, load it |
a12ff9f3 | 31 | ;; with (load "ls-lisp"). |
d9a0f717 | 32 | |
738eb4e7 SK |
33 | ;; OVERVIEW =========================================================== |
34 | ||
9dce08b6 RS |
35 | ;; This file overloads the function insert-directory to implement it |
36 | ;; directly from Emacs lisp, without running `ls' in a subprocess. | |
738eb4e7 | 37 | |
9dce08b6 | 38 | ;; It is useful if you cannot afford to fork Emacs on a real memory UNIX, |
738eb4e7 SK |
39 | ;; under VMS, or if you don't have the ls program, or if you want |
40 | ;; different format from what ls offers. | |
41 | ||
9dce08b6 RS |
42 | ;; This function uses regexps instead of shell |
43 | ;; wildcards. If you enter regexps remember to double each $ sign. | |
44 | ;; For example, to include files *.el, enter `.*\.el$$', | |
738eb4e7 | 45 | ;; resulting in the regexp `.*\.el$'. |
d88c0e93 | 46 | |
738eb4e7 | 47 | ;; RESTRICTIONS ===================================================== |
d88c0e93 | 48 | |
9dce08b6 | 49 | ;; * many ls switches are ignored, see docstring of `insert-directory'. |
738eb4e7 SK |
50 | |
51 | ;; * Only numeric uid/gid | |
52 | ||
738eb4e7 SK |
53 | ;; TODO ============================================================== |
54 | ||
d9a0f717 | 55 | ;; Recognize some more ls switches: R F |
738eb4e7 | 56 | \f |
76550a57 ER |
57 | ;;; Code: |
58 | ||
bf686e5f | 59 | ;;;###autoload |
3045b163 RS |
60 | (defvar ls-lisp-support-shell-wildcards t |
61 | "*Non-nil means file patterns are treated as shell wildcards. | |
62 | nil means they are treated as Emacs regexps (for backward compatibility). | |
63 | This variable is checked by \\[insert-directory] only when `ls-lisp.el' | |
64 | package is used.") | |
65 | ||
97b927b3 GV |
66 | (defvar ls-lisp-dired-ignore-case nil |
67 | "Non-nil causes dired buffers to sort alphabetically regardless of case.") | |
68 | ||
0cb0ba6c GV |
69 | (defvar ls-lisp-use-insert-directory-program nil |
70 | "Non-nil causes ls-lisp to revert back to using `insert-directory-program'. | |
71 | This is useful on platforms where ls-lisp is dumped into Emacs, such as | |
72 | Microsoft Windows, but you would still like to use a program to list | |
73 | the contents of a directory.") | |
74 | ||
75 | ;; Remember the original insert-directory function. | |
76 | (fset 'original-insert-directory (symbol-function 'insert-directory)) | |
77 | ||
78 | (defun insert-directory (file switches &optional wildcard full-directory-p) | |
79 | "Insert directory listing for FILE, formatted according to SWITCHES. | |
80 | Leaves point after the inserted text. | |
81 | SWITCHES may be a string of options, or a list of strings. | |
82 | Optional third arg WILDCARD means treat FILE as shell wildcard. | |
83 | Optional fourth arg FULL-DIRECTORY-P means file is a directory and | |
84 | switches do not contain `d', so that a full listing is expected. | |
85 | ||
86 | This version of the function comes from `ls-lisp.el'. Depending upon | |
87 | the value of `ls-lisp-use-insert-directory-program', it will use an | |
88 | external program if non-nil or the lisp function `ls-lisp-insert-directory' | |
89 | otherwise." | |
90 | (if ls-lisp-use-insert-directory-program | |
91 | (original-insert-directory file switches wildcard full-directory-p) | |
92 | (ls-lisp-insert-directory file switches wildcard full-directory-p))) | |
93 | ||
94 | (defun ls-lisp-insert-directory (file switches &optional wildcard full-directory-p) | |
3045b163 | 95 | "Insert directory listing for FILE, formatted according to SWITCHES. |
9dce08b6 RS |
96 | Leaves point after the inserted text. |
97 | Optional third arg WILDCARD means treat FILE as shell wildcard. | |
6467926f | 98 | Optional fourth arg FULL-DIRECTORY-P means file is a directory and |
9dce08b6 RS |
99 | switches do not contain `d', so that a full listing is expected. |
100 | ||
0cb0ba6c | 101 | This version of the function comes from `ls-lisp.el'. It does not |
3045b163 RS |
102 | run any external programs or shells. It supports ordinary shell |
103 | wildcards if `ls-lisp-support-shell-wildcards' variable is non-nil; | |
104 | otherwise, it interprets wildcards as regular expressions to match | |
105 | file names. | |
9dce08b6 | 106 | |
3045b163 RS |
107 | Not all `ls' switches are supported. The switches that work |
108 | are: A a c i r S s t u" | |
a5e0e1a8 EZ |
109 | (let ((handler (find-file-name-handler file 'insert-directory)) |
110 | fattr) | |
9dce08b6 RS |
111 | (if handler |
112 | (funcall handler 'insert-directory file switches | |
113 | wildcard full-directory-p) | |
3045b163 RS |
114 | ;; Sometimes we get ".../foo*/" as FILE. While the shell and |
115 | ;; `ls' don't mind, we certainly do, because it makes us think | |
116 | ;; there is no wildcard, only a directory name. | |
117 | (if (and ls-lisp-support-shell-wildcards | |
118 | (string-match "[[?*]" file)) | |
119 | (progn | |
120 | (or (not (eq (aref file (1- (length file))) ?/)) | |
121 | (setq file (substring file 0 (1- (length file))))) | |
122 | (setq wildcard t))) | |
cc2f3b64 JB |
123 | ;; Convert SWITCHES to a list of characters. |
124 | (setq switches (append switches nil)) | |
9dce08b6 | 125 | (if wildcard |
3045b163 RS |
126 | (setq wildcard |
127 | (if ls-lisp-support-shell-wildcards | |
128 | (wildcard-to-regexp (file-name-nondirectory file)) | |
129 | (file-name-nondirectory file)) | |
9dce08b6 RS |
130 | file (file-name-directory file))) |
131 | (if (or wildcard | |
132 | full-directory-p) | |
133 | (let* ((dir (file-name-as-directory file)) | |
134 | (default-directory dir);; so that file-attributes works | |
135 | (sum 0) | |
136 | elt | |
137 | short | |
261c6055 | 138 | (file-alist (directory-files-and-attributes dir nil wildcard)) |
1fff30af | 139 | (now (current-time)) |
9dce08b6 | 140 | ;; do all bindings here for speed |
df6efcb1 | 141 | file-size |
9dce08b6 RS |
142 | fil attr) |
143 | (cond ((memq ?A switches) | |
261c6055 GV |
144 | (setq file-alist |
145 | (ls-lisp-delete-matching "^\\.\\.?$" file-alist))) | |
9dce08b6 RS |
146 | ((not (memq ?a switches)) |
147 | ;; if neither -A nor -a, flush . files | |
261c6055 GV |
148 | (setq file-alist |
149 | (ls-lisp-delete-matching "^\\." file-alist)))) | |
3045b163 RS |
150 | ;; ``Total'' line (filled in afterwards). |
151 | (insert (if (car-safe file-alist) | |
152 | "total \007\n" | |
153 | ;; Shell says ``No match'' if no files match | |
154 | ;; the wildcard; let's say something similar. | |
155 | "(No match)\ntotal \007\n")) | |
9dce08b6 RS |
156 | (setq file-alist |
157 | (ls-lisp-handle-switches file-alist switches)) | |
158 | (while file-alist | |
159 | (setq elt (car file-alist) | |
9dce08b6 | 160 | file-alist (cdr file-alist) |
3cfb886e | 161 | short (car elt) |
df6efcb1 EZ |
162 | attr (cdr elt) |
163 | file-size (nth 7 attr)) | |
3cfb886e | 164 | (and attr |
df6efcb1 EZ |
165 | (setq sum |
166 | ;; Even if neither SUM nor file's size | |
167 | ;; overflow, their sum could. | |
168 | (if (or (< sum (- 134217727 file-size)) | |
169 | (floatp sum) | |
170 | (floatp file-size)) | |
171 | (+ sum file-size) | |
172 | (+ (float sum) file-size))) | |
173 | (insert (ls-lisp-format short attr file-size switches now)) | |
174 | )) | |
9dce08b6 RS |
175 | ;; Fill in total size of all files: |
176 | (save-excursion | |
177 | (search-backward "total \007") | |
178 | (goto-char (match-end 0)) | |
179 | (delete-char -1) | |
6c18d2f5 | 180 | (insert (format "%.0f" (fceiling (/ sum 1024.0)))))) |
9dce08b6 RS |
181 | ;; if not full-directory-p, FILE *must not* end in /, as |
182 | ;; file-attributes will not recognize a symlink to a directory | |
183 | ;; must make it a relative filename as ls does: | |
a5e0e1a8 EZ |
184 | (if (eq (aref file (1- (length file))) ?/) |
185 | (setq file (substring file 0 (1- (length file))))) | |
186 | (setq fattr (file-attributes file)) | |
187 | (if fattr | |
188 | (insert (ls-lisp-format file fattr (nth 7 fattr) | |
189 | switches (current-time))) | |
190 | (message "%s: doesn't exist or is inaccessible" file) | |
191 | (ding) | |
192 | (sit-for 2)))))) | |
9dce08b6 RS |
193 | |
194 | (defun ls-lisp-delete-matching (regexp list) | |
6467926f | 195 | ;; Delete all elements matching REGEXP from LIST, return new list. |
d6d472d5 | 196 | ;; Should perhaps use setcdr for efficiency. |
6467926f SK |
197 | (let (result) |
198 | (while list | |
261c6055 | 199 | (or (string-match regexp (car (car list))) |
6467926f SK |
200 | (setq result (cons (car list) result))) |
201 | (setq list (cdr list))) | |
202 | result)) | |
203 | ||
9dce08b6 | 204 | (defun ls-lisp-handle-switches (file-alist switches) |
6467926f | 205 | ;; FILE-ALIST's elements are (FILE . FILE-ATTRIBUTES). |
738eb4e7 SK |
206 | ;; Return new alist sorted according to SWITCHES which is a list of |
207 | ;; characters. Default sorting is alphabetically. | |
e54241c5 SK |
208 | (let (index) |
209 | (setq file-alist | |
210 | (sort file-alist | |
211 | (cond ((memq ?S switches) ; sorted on size | |
212 | (function | |
213 | (lambda (x y) | |
214 | ;; 7th file attribute is file size | |
215 | ;; Make largest file come first | |
216 | (< (nth 7 (cdr y)) | |
217 | (nth 7 (cdr x)))))) | |
218 | ((memq ?t switches) ; sorted on time | |
9dce08b6 | 219 | (setq index (ls-lisp-time-index switches)) |
e54241c5 SK |
220 | (function |
221 | (lambda (x y) | |
9dce08b6 RS |
222 | (ls-lisp-time-lessp (nth index (cdr y)) |
223 | (nth index (cdr x)))))) | |
e54241c5 | 224 | (t ; sorted alphabetically |
97b927b3 GV |
225 | (if ls-lisp-dired-ignore-case |
226 | (function | |
227 | (lambda (x y) | |
228 | (string-lessp (upcase (car x)) | |
229 | (upcase (car y))))) | |
230 | (function | |
231 | (lambda (x y) | |
232 | (string-lessp (car x) | |
233 | (car y)))))))))) | |
6467926f SK |
234 | (if (memq ?r switches) ; reverse sort order |
235 | (setq file-alist (nreverse file-alist))) | |
236 | file-alist) | |
d88c0e93 | 237 | |
e54241c5 | 238 | ;; From Roland McGrath. Can use this to sort on time. |
9dce08b6 | 239 | (defun ls-lisp-time-lessp (time0 time1) |
e54241c5 SK |
240 | (let ((hi0 (car time0)) |
241 | (hi1 (car time1)) | |
242 | (lo0 (car (cdr time0))) | |
243 | (lo1 (car (cdr time1)))) | |
244 | (or (< hi0 hi1) | |
245 | (and (= hi0 hi1) | |
246 | (< lo0 lo1))))) | |
247 | ||
248 | ||
df6efcb1 | 249 | (defun ls-lisp-format (file-name file-attr file-size switches now) |
d88c0e93 | 250 | (let ((file-type (nth 0 file-attr))) |
6467926f | 251 | (concat (if (memq ?i switches) ; inode number |
d6d472d5 SK |
252 | (format "%6d " (nth 10 file-attr))) |
253 | ;; nil is treated like "" in concat | |
6467926f | 254 | (if (memq ?s switches) ; size in K |
e4a225a9 | 255 | (format "%4.0f " (fceiling (/ file-size 1024.0)))) |
6467926f | 256 | (nth 8 file-attr) ; permission bits |
d88c0e93 | 257 | ;; numeric uid/gid are more confusing than helpful |
6467926f SK |
258 | ;; Emacs should be able to make strings of them. |
259 | ;; user-login-name and user-full-name could take an | |
260 | ;; optional arg. | |
df6efcb1 EZ |
261 | (format (if (floatp file-size) |
262 | " %3d %-8s %-8s %8.0f " | |
263 | " %3d %-8s %-8s %8d ") | |
d6d472d5 | 264 | (nth 1 file-attr) ; no. of links |
a12ff9f3 RS |
265 | (if (= (user-uid) (nth 2 file-attr)) |
266 | (user-login-name) | |
7b4a3608 | 267 | (int-to-string (nth 2 file-attr))) ; uid |
a12ff9f3 RS |
268 | (if (eq system-type 'ms-dos) |
269 | "root" ; everything is root on MSDOS. | |
7b4a3608 | 270 | (int-to-string (nth 3 file-attr))) ; gid |
df6efcb1 | 271 | file-size |
d6d472d5 | 272 | ) |
1fff30af | 273 | (ls-lisp-format-time file-attr switches now) |
738eb4e7 | 274 | " " |
d88c0e93 SK |
275 | file-name |
276 | (if (stringp file-type) ; is a symbolic link | |
277 | (concat " -> " file-type) | |
278 | "") | |
279 | "\n" | |
280 | ))) | |
281 | ||
9dce08b6 | 282 | (defun ls-lisp-time-index (switches) |
e54241c5 SK |
283 | ;; Return index into file-attributes according to ls SWITCHES. |
284 | (cond | |
285 | ((memq ?c switches) 6) ; last mode change | |
286 | ((memq ?u switches) 4) ; last access | |
287 | ;; default is last modtime | |
288 | (t 5))) | |
289 | ||
1fff30af | 290 | (defun ls-lisp-format-time (file-attr switches now) |
738eb4e7 SK |
291 | ;; Format time string for file with attributes FILE-ATTR according |
292 | ;; to SWITCHES (a list of ls option letters of which c and u are recognized). | |
1fff30af RS |
293 | ;; Use the same method as `ls' to decide whether to show time-of-day or year, |
294 | ;; depending on distance between file date and NOW. | |
295 | (let* ((time (nth (ls-lisp-time-index switches) file-attr)) | |
296 | (diff16 (- (car time) (car now))) | |
297 | (diff (+ (ash diff16 16) (- (car (cdr time)) (car (cdr now))))) | |
298 | (past-cutoff (- (* 6 30 24 60 60))) ; 6 30-day months | |
299 | (future-cutoff (* 60 60))) ; 1 hour | |
f8a10234 AI |
300 | (condition-case nil |
301 | (format-time-string | |
302 | (if (and | |
303 | (<= past-cutoff diff) (<= diff future-cutoff) | |
304 | ;; Sanity check in case `diff' computation overflowed. | |
305 | (<= (1- (ash past-cutoff -16)) diff16) | |
306 | (<= diff16 (1+ (ash future-cutoff -16)))) | |
307 | "%b %e %H:%M" | |
308 | "%b %e %Y") | |
309 | time) | |
452e47d7 | 310 | (error "Unk 0 0000")))) |
738eb4e7 | 311 | |
9dce08b6 | 312 | (provide 'ls-lisp) |
738eb4e7 | 313 | |
76550a57 | 314 | ;;; ls-lisp.el ends here |