|
2233
|
1 ;;; ls-lisp.el --- emulate insert-directory completely in Emacs Lisp
|
|
|
2
|
|
22154
|
3 ;; Copyright (C) 1992, 1994 Free Software Foundation, Inc.
|
|
14169
|
4
|
|
2233
|
5 ;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
|
|
17977
|
6 ;; Maintainer: FSF
|
|
2233
|
7 ;; Keywords: unix
|
|
183
|
8
|
|
14169
|
9 ;; This file is part of GNU Emacs.
|
|
183
|
10
|
|
14169
|
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
183
|
12 ;; it under the terms of the GNU General Public License as published by
|
|
12244
|
13 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
183
|
14 ;; any later version.
|
|
14169
|
15
|
|
|
16 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
183
|
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.
|
|
14169
|
20
|
|
183
|
21 ;; You should have received a copy of the GNU General Public License
|
|
14169
|
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:
|
|
183
|
27
|
622
1d4abb4dfecb
(dired-lisp-format-time): in Emacs 19 we can format times.
Sebastian Kremer <sk@thp.uni-koeln.de>
diff
changeset
|
28 ;; INSTALLATION =======================================================
|
1d4abb4dfecb
(dired-lisp-format-time): in Emacs 19 we can format times.
Sebastian Kremer <sk@thp.uni-koeln.de>
diff
changeset
|
29 ;;
|
|
1334
|
30 ;; Put this file into your load-path. To use it, load it
|
|
3916
|
31 ;; with (load "ls-lisp").
|
|
623
|
32
|
622
1d4abb4dfecb
(dired-lisp-format-time): in Emacs 19 we can format times.
Sebastian Kremer <sk@thp.uni-koeln.de>
diff
changeset
|
33 ;; OVERVIEW ===========================================================
|
|
183
|
34
|
|
1334
|
35 ;; This file overloads the function insert-directory to implement it
|
|
|
36 ;; directly from Emacs lisp, without running `ls' in a subprocess.
|
622
1d4abb4dfecb
(dired-lisp-format-time): in Emacs 19 we can format times.
Sebastian Kremer <sk@thp.uni-koeln.de>
diff
changeset
|
37
|
|
1334
|
38 ;; It is useful if you cannot afford to fork Emacs on a real memory UNIX,
|
622
1d4abb4dfecb
(dired-lisp-format-time): in Emacs 19 we can format times.
Sebastian Kremer <sk@thp.uni-koeln.de>
diff
changeset
|
39 ;; under VMS, or if you don't have the ls program, or if you want
|
1d4abb4dfecb
(dired-lisp-format-time): in Emacs 19 we can format times.
Sebastian Kremer <sk@thp.uni-koeln.de>
diff
changeset
|
40 ;; different format from what ls offers.
|
|
183
|
41
|
|
1334
|
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$$',
|
622
1d4abb4dfecb
(dired-lisp-format-time): in Emacs 19 we can format times.
Sebastian Kremer <sk@thp.uni-koeln.de>
diff
changeset
|
45 ;; resulting in the regexp `.*\.el$'.
|
1d4abb4dfecb
(dired-lisp-format-time): in Emacs 19 we can format times.
Sebastian Kremer <sk@thp.uni-koeln.de>
diff
changeset
|
46
|
1d4abb4dfecb
(dired-lisp-format-time): in Emacs 19 we can format times.
Sebastian Kremer <sk@thp.uni-koeln.de>
diff
changeset
|
47 ;; RESTRICTIONS =====================================================
|
1d4abb4dfecb
(dired-lisp-format-time): in Emacs 19 we can format times.
Sebastian Kremer <sk@thp.uni-koeln.de>
diff
changeset
|
48
|
|
1334
|
49 ;; * many ls switches are ignored, see docstring of `insert-directory'.
|
|
183
|
50
|
622
1d4abb4dfecb
(dired-lisp-format-time): in Emacs 19 we can format times.
Sebastian Kremer <sk@thp.uni-koeln.de>
diff
changeset
|
51 ;; * Only numeric uid/gid
|
|
183
|
52
|
622
1d4abb4dfecb
(dired-lisp-format-time): in Emacs 19 we can format times.
Sebastian Kremer <sk@thp.uni-koeln.de>
diff
changeset
|
53 ;; TODO ==============================================================
|
1d4abb4dfecb
(dired-lisp-format-time): in Emacs 19 we can format times.
Sebastian Kremer <sk@thp.uni-koeln.de>
diff
changeset
|
54
|
|
623
|
55 ;; Recognize some more ls switches: R F
|
622
1d4abb4dfecb
(dired-lisp-format-time): in Emacs 19 we can format times.
Sebastian Kremer <sk@thp.uni-koeln.de>
diff
changeset
|
56
|
|
2233
|
57 ;;; Code:
|
|
|
58
|
|
14213
|
59 ;;;###autoload
|
|
13883
|
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
|
|
21620
|
66 (defvar ls-lisp-dired-ignore-case nil
|
|
|
67 "Non-nil causes dired buffers to sort alphabetically regardless of case.")
|
|
|
68
|
|
23452
|
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)
|
|
13883
|
95 "Insert directory listing for FILE, formatted according to SWITCHES.
|
|
1334
|
96 Leaves point after the inserted text.
|
|
|
97 Optional third arg WILDCARD means treat FILE as shell wildcard.
|
|
|
98 Optional fourth arg FULL-DIRECTORY-P means file is a directory and
|
|
|
99 switches do not contain `d', so that a full listing is expected.
|
|
416
|
100
|
|
23452
|
101 This version of the function comes from `ls-lisp.el'. It does not
|
|
13883
|
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.
|
|
416
|
106
|
|
13883
|
107 Not all `ls' switches are supported. The switches that work
|
|
|
108 are: A a c i r S s t u"
|
|
26914
|
109 (let ((handler (find-file-name-handler file 'insert-directory))
|
|
|
110 fattr)
|
|
1334
|
111 (if handler
|
|
|
112 (funcall handler 'insert-directory file switches
|
|
|
113 wildcard full-directory-p)
|
|
13883
|
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)))
|
|
3789
|
123 ;; Convert SWITCHES to a list of characters.
|
|
|
124 (setq switches (append switches nil))
|
|
1334
|
125 (if wildcard
|
|
13883
|
126 (setq wildcard
|
|
|
127 (if ls-lisp-support-shell-wildcards
|
|
|
128 (wildcard-to-regexp (file-name-nondirectory file))
|
|
|
129 (file-name-nondirectory file))
|
|
1334
|
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
|
|
25194
|
138 (file-alist (directory-files-and-attributes dir nil wildcard))
|
|
16098
|
139 (now (current-time))
|
|
1334
|
140 ;; do all bindings here for speed
|
|
24435
|
141 file-size
|
|
1334
|
142 fil attr)
|
|
|
143 (cond ((memq ?A switches)
|
|
25194
|
144 (setq file-alist
|
|
|
145 (ls-lisp-delete-matching "^\\.\\.?$" file-alist)))
|
|
1334
|
146 ((not (memq ?a switches))
|
|
|
147 ;; if neither -A nor -a, flush . files
|
|
25194
|
148 (setq file-alist
|
|
|
149 (ls-lisp-delete-matching "^\\." file-alist))))
|
|
13883
|
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"))
|
|
1334
|
156 (setq file-alist
|
|
|
157 (ls-lisp-handle-switches file-alist switches))
|
|
|
158 (while file-alist
|
|
|
159 (setq elt (car file-alist)
|
|
8409
|
160 file-alist (cdr file-alist)
|
|
1334
|
161 short (car elt)
|
|
24435
|
162 attr (cdr elt)
|
|
|
163 file-size (nth 7 attr))
|
|
8409
|
164 (and attr
|
|
24435
|
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 ))
|
|
1334
|
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)
|
|
24329
|
180 (insert (format "%.0f" (fceiling (/ sum 1024.0))))))
|
|
1334
|
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:
|
|
26914
|
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))))))
|
|
416
|
193
|
|
1334
|
194 (defun ls-lisp-delete-matching (regexp list)
|
|
416
|
195 ;; Delete all elements matching REGEXP from LIST, return new list.
|
|
417
|
196 ;; Should perhaps use setcdr for efficiency.
|
|
416
|
197 (let (result)
|
|
|
198 (while list
|
|
25194
|
199 (or (string-match regexp (car (car list)))
|
|
416
|
200 (setq result (cons (car list) result)))
|
|
|
201 (setq list (cdr list)))
|
|
|
202 result))
|
|
|
203
|
|
1334
|
204 (defun ls-lisp-handle-switches (file-alist switches)
|
|
416
|
205 ;; FILE-ALIST's elements are (FILE . FILE-ATTRIBUTES).
|
622
1d4abb4dfecb
(dired-lisp-format-time): in Emacs 19 we can format times.
Sebastian Kremer <sk@thp.uni-koeln.de>
diff
changeset
|
206 ;; Return new alist sorted according to SWITCHES which is a list of
|
1d4abb4dfecb
(dired-lisp-format-time): in Emacs 19 we can format times.
Sebastian Kremer <sk@thp.uni-koeln.de>
diff
changeset
|
207 ;; characters. Default sorting is alphabetically.
|
|
626
|
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
|
|
1334
|
219 (setq index (ls-lisp-time-index switches))
|
|
626
|
220 (function
|
|
|
221 (lambda (x y)
|
|
1334
|
222 (ls-lisp-time-lessp (nth index (cdr y))
|
|
|
223 (nth index (cdr x))))))
|
|
626
|
224 (t ; sorted alphabetically
|
|
21620
|
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))))))))))
|
|
416
|
234 (if (memq ?r switches) ; reverse sort order
|
|
|
235 (setq file-alist (nreverse file-alist)))
|
|
|
236 file-alist)
|
|
183
|
237
|
|
626
|
238 ;; From Roland McGrath. Can use this to sort on time.
|
|
1334
|
239 (defun ls-lisp-time-lessp (time0 time1)
|
|
626
|
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
|
|
24435
|
249 (defun ls-lisp-format (file-name file-attr file-size switches now)
|
|
183
|
250 (let ((file-type (nth 0 file-attr)))
|
|
416
|
251 (concat (if (memq ?i switches) ; inode number
|
|
417
|
252 (format "%6d " (nth 10 file-attr)))
|
|
|
253 ;; nil is treated like "" in concat
|
|
416
|
254 (if (memq ?s switches) ; size in K
|
24436
e5af0407bcd6
(ls-lisp-format): Under -s, print the size in blocks with %4.0f, in case
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
255 (format "%4.0f " (fceiling (/ file-size 1024.0))))
|
|
416
|
256 (nth 8 file-attr) ; permission bits
|
|
183
|
257 ;; numeric uid/gid are more confusing than helpful
|
|
416
|
258 ;; Emacs should be able to make strings of them.
|
|
|
259 ;; user-login-name and user-full-name could take an
|
|
|
260 ;; optional arg.
|
|
24435
|
261 (format (if (floatp file-size)
|
|
|
262 " %3d %-8s %-8s %8.0f "
|
|
|
263 " %3d %-8s %-8s %8d ")
|
|
417
|
264 (nth 1 file-attr) ; no. of links
|
|
3916
|
265 (if (= (user-uid) (nth 2 file-attr))
|
|
|
266 (user-login-name)
|
|
5457
|
267 (int-to-string (nth 2 file-attr))) ; uid
|
|
3916
|
268 (if (eq system-type 'ms-dos)
|
|
|
269 "root" ; everything is root on MSDOS.
|
|
5457
|
270 (int-to-string (nth 3 file-attr))) ; gid
|
|
24435
|
271 file-size
|
|
417
|
272 )
|
|
16098
|
273 (ls-lisp-format-time file-attr switches now)
|
622
1d4abb4dfecb
(dired-lisp-format-time): in Emacs 19 we can format times.
Sebastian Kremer <sk@thp.uni-koeln.de>
diff
changeset
|
274 " "
|
|
183
|
275 file-name
|
|
|
276 (if (stringp file-type) ; is a symbolic link
|
|
|
277 (concat " -> " file-type)
|
|
|
278 "")
|
|
|
279 "\n"
|
|
|
280 )))
|
|
|
281
|
|
1334
|
282 (defun ls-lisp-time-index (switches)
|
|
626
|
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
|
|
16098
|
290 (defun ls-lisp-format-time (file-attr switches now)
|
622
1d4abb4dfecb
(dired-lisp-format-time): in Emacs 19 we can format times.
Sebastian Kremer <sk@thp.uni-koeln.de>
diff
changeset
|
291 ;; Format time string for file with attributes FILE-ATTR according
|
1d4abb4dfecb
(dired-lisp-format-time): in Emacs 19 we can format times.
Sebastian Kremer <sk@thp.uni-koeln.de>
diff
changeset
|
292 ;; to SWITCHES (a list of ls option letters of which c and u are recognized).
|
|
16098
|
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
|
|
24660
|
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)
|
|
24854
|
310 (error "Unk 0 0000"))))
|
622
1d4abb4dfecb
(dired-lisp-format-time): in Emacs 19 we can format times.
Sebastian Kremer <sk@thp.uni-koeln.de>
diff
changeset
|
311
|
|
1334
|
312 (provide 'ls-lisp)
|
622
1d4abb4dfecb
(dired-lisp-format-time): in Emacs 19 we can format times.
Sebastian Kremer <sk@thp.uni-koeln.de>
diff
changeset
|
313
|
|
2233
|
314 ;;; ls-lisp.el ends here
|
