Commit | Line | Data |
---|---|---|
76550a57 ER |
1 | ;;; ls-lisp.el --- emulate insert-directory completely in Emacs Lisp |
2 | ||
ba318903 | 3 | ;; Copyright (C) 1992, 1994, 2000-2014 Free Software Foundation, Inc. |
b578f267 | 4 | |
55535639 PJ |
5 | ;; Author: Sebastian Kremer <sk@thp.uni-koeln.de> |
6 | ;; Modified by: Francis J. Wright <F.J.Wright@maths.qmw.ac.uk> | |
34dc21db | 7 | ;; Maintainer: emacs-devel@gnu.org |
55535639 | 8 | ;; Keywords: unix, dired |
bd78fa1d | 9 | ;; Package: emacs |
d88c0e93 | 10 | |
b578f267 | 11 | ;; This file is part of GNU Emacs. |
d88c0e93 | 12 | |
eb3fa2cf | 13 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
d88c0e93 | 14 | ;; it under the terms of the GNU General Public License as published by |
eb3fa2cf GM |
15 | ;; the Free Software Foundation, either version 3 of the License, or |
16 | ;; (at your option) any later version. | |
b578f267 EN |
17 | |
18 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
d88c0e93 SK |
19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
21 | ;; GNU General Public License for more details. | |
b578f267 | 22 | |
d88c0e93 | 23 | ;; You should have received a copy of the GNU General Public License |
eb3fa2cf | 24 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
b578f267 EN |
25 | |
26 | ;;; Commentary: | |
738eb4e7 | 27 | |
3f51f5a9 | 28 | ;; OVERVIEW ========================================================== |
d9a0f717 | 29 | |
16bda969 GM |
30 | ;; This file advises the function `insert-directory' to implement it |
31 | ;; directly from Emacs lisp, without running ls in a subprocess. | |
32 | ;; This is useful if you don't have ls installed (ie, on MS Windows). | |
738eb4e7 | 33 | |
3f51f5a9 EZ |
34 | ;; This function can use regexps instead of shell wildcards. If you |
35 | ;; enter regexps remember to double each $ sign. For example, to | |
36 | ;; include files *.el, enter `.*\.el$$', resulting in the regexp | |
37 | ;; `.*\.el$'. | |
738eb4e7 | 38 | |
3f51f5a9 | 39 | ;; RESTRICTIONS ====================================================== |
738eb4e7 | 40 | |
3f51f5a9 EZ |
41 | ;; * A few obscure ls switches are still ignored: see the docstring of |
42 | ;; `insert-directory'. | |
d88c0e93 | 43 | |
3f51f5a9 | 44 | ;; TO DO ============================================================= |
738eb4e7 | 45 | |
3f51f5a9 | 46 | ;; Complete handling of F switch (if/when possible). |
738eb4e7 | 47 | |
3f51f5a9 EZ |
48 | ;; FJW: May be able to sort much faster by consing the sort key onto |
49 | ;; the front of each list element, sorting and then stripping the key | |
50 | ;; off again! | |
738eb4e7 | 51 | |
3f51f5a9 | 52 | ;;; History: |
76550a57 | 53 | |
3f51f5a9 EZ |
54 | ;; Written originally by Sebastian Kremer <sk@thp.uni-koeln.de> |
55 | ;; Revised by Andrew Innes and Geoff Volker (and maybe others). | |
3045b163 | 56 | |
3f51f5a9 | 57 | ;; Modified by Francis J. Wright <F.J.Wright@maths.qmw.ac.uk>, mainly |
5eba3394 LH |
58 | ;; to support many more ls options, "platform emulation" and more |
59 | ;; robust sorting. | |
3f51f5a9 EZ |
60 | |
61 | ;;; Code: | |
97b927b3 | 62 | |
3f51f5a9 EZ |
63 | (defgroup ls-lisp nil |
64 | "Emulate the ls program completely in Emacs Lisp." | |
eff409ba | 65 | :version "21.1" |
3f51f5a9 EZ |
66 | :group 'dired) |
67 | ||
606dcd9e GM |
68 | (defun ls-lisp-set-options () |
69 | "Reset the ls-lisp options that depend on `ls-lisp-emulation'." | |
70 | (mapc 'custom-reevaluate-setting | |
71 | '(ls-lisp-ignore-case ls-lisp-dirs-first ls-lisp-verbosity))) | |
72 | ||
3f51f5a9 | 73 | (defcustom ls-lisp-emulation |
a3374680 | 74 | (cond ;; ((eq system-type 'windows-nt) 'MS-Windows) |
606dcd9e GM |
75 | ((memq system-type '(hpux usg-unix-v irix berkeley-unix)) |
76 | 'UNIX)) ; very similar to GNU | |
3f51f5a9 | 77 | ;; Anything else defaults to nil, meaning GNU. |
9201cc28 | 78 | "Platform to emulate: GNU (default), MacOS, MS-Windows, UNIX. |
606dcd9e GM |
79 | Corresponding value is one of: nil, `MacOS', `MS-Windows', `UNIX'. |
80 | Set this to your preferred value; it need not match the actual platform | |
81 | you are using. | |
82 | ||
83 | This variable does not affect the behavior of ls-lisp directly. | |
84 | Rather, it controls the default values for some variables that do: | |
85 | `ls-lisp-ignore-case', `ls-lisp-dirs-first', and `ls-lisp-verbosity'. | |
86 | ||
87 | If you change this variable directly (without using customize) | |
88 | after loading `ls-lisp', you should use `ls-lisp-set-options' to | |
89 | update the dependent variables." | |
3f51f5a9 EZ |
90 | :type '(choice (const :tag "GNU" nil) |
91 | (const MacOS) | |
92 | (const MS-Windows) | |
93 | (const UNIX)) | |
606dcd9e GM |
94 | :initialize 'custom-initialize-default |
95 | :set (lambda (symbol value) | |
96 | (unless (equal value (eval symbol)) | |
97 | (custom-set-default symbol value) | |
98 | (ls-lisp-set-options))) | |
3f51f5a9 EZ |
99 | :group 'ls-lisp) |
100 | ||
b010e1ba GM |
101 | ;; Only made an obsolete alias in 23.3. Before that, the initial |
102 | ;; value was set according to: | |
103 | ;; (or (memq ls-lisp-emulation '(MS-Windows MacOS)) | |
104 | ;; (and (boundp 'ls-lisp-dired-ignore-case) ls-lisp-dired-ignore-case)) | |
105 | ;; Which isn't the right thing to do. | |
106 | (define-obsolete-variable-alias 'ls-lisp-dired-ignore-case | |
107 | 'ls-lisp-ignore-case "21.1") | |
108 | ||
3f51f5a9 | 109 | (defcustom ls-lisp-ignore-case |
b010e1ba | 110 | (memq ls-lisp-emulation '(MS-Windows MacOS)) |
9201cc28 | 111 | "Non-nil causes ls-lisp alphabetic sorting to ignore case." |
b3e22bd4 | 112 | :set-after '(ls-lisp-emulation) |
3f51f5a9 EZ |
113 | :type 'boolean |
114 | :group 'ls-lisp) | |
115 | ||
116 | (defcustom ls-lisp-dirs-first (eq ls-lisp-emulation 'MS-Windows) | |
9201cc28 | 117 | "Non-nil causes ls-lisp to sort directories first in any ordering. |
3f51f5a9 EZ |
118 | \(Or last if it is reversed.) Follows Microsoft Windows Explorer." |
119 | ;; Functionality suggested by Chris McMahan <cmcmahan@one.net> | |
b3e22bd4 | 120 | :set-after '(ls-lisp-emulation) |
3f51f5a9 EZ |
121 | :type 'boolean |
122 | :group 'ls-lisp) | |
123 | ||
124 | (defcustom ls-lisp-verbosity | |
125 | (cond ((eq ls-lisp-emulation 'MacOS) nil) | |
126 | ((eq ls-lisp-emulation 'MS-Windows) | |
127 | (if (and (fboundp 'w32-using-nt) (w32-using-nt)) | |
128 | '(links))) ; distinguish NT/2K from 9x | |
129 | ((eq ls-lisp-emulation 'UNIX) '(links uid)) ; UNIX ls | |
130 | (t '(links uid gid))) ; GNU ls | |
9201cc28 | 131 | "A list of optional file attributes that ls-lisp should display. |
3f51f5a9 | 132 | It should contain none or more of the symbols: links, uid, gid. |
3aeb19ad | 133 | A value of nil (or an empty list) means display none of them. |
3f51f5a9 EZ |
134 | |
135 | Concepts come from UNIX: `links' means count of names associated with | |
b3e22bd4 | 136 | the file; `uid' means user (owner) identifier; `gid' means group |
3f51f5a9 EZ |
137 | identifier. |
138 | ||
b3e22bd4 | 139 | If emulation is MacOS then default is nil; |
3f51f5a9 | 140 | if emulation is MS-Windows then default is `(links)' if platform is |
b3e22bd4 GM |
141 | Windows NT/2K, nil otherwise; |
142 | if emulation is UNIX then default is `(links uid)'; | |
3f51f5a9 | 143 | if emulation is GNU then default is `(links uid gid)'." |
b3e22bd4 | 144 | :set-after '(ls-lisp-emulation) |
3f51f5a9 EZ |
145 | ;; Functionality suggested by Howard Melman <howard@silverstream.com> |
146 | :type '(set (const :tag "Show Link Count" links) | |
147 | (const :tag "Show User" uid) | |
148 | (const :tag "Show Group" gid)) | |
149 | :group 'ls-lisp) | |
150 | ||
73916123 | 151 | (defcustom ls-lisp-use-insert-directory-program |
a3374680 | 152 | (not (memq system-type '(ms-dos windows-nt))) |
9201cc28 | 153 | "Non-nil causes ls-lisp to revert back to using `insert-directory-program'. |
0cb0ba6c GV |
154 | This is useful on platforms where ls-lisp is dumped into Emacs, such as |
155 | Microsoft Windows, but you would still like to use a program to list | |
3f51f5a9 EZ |
156 | the contents of a directory." |
157 | :type 'boolean | |
158 | :group 'ls-lisp) | |
159 | ||
73916123 MR |
160 | ;;; Autoloaded because it is let-bound in `recover-session', `mail-recover-1'. |
161 | ;;;###autoload | |
3f51f5a9 | 162 | (defcustom ls-lisp-support-shell-wildcards t |
9201cc28 | 163 | "Non-nil means ls-lisp treats file patterns as shell wildcards. |
3f51f5a9 EZ |
164 | Otherwise they are treated as Emacs regexps (for backward compatibility)." |
165 | :type 'boolean | |
166 | :group 'ls-lisp) | |
167 | ||
2686cdc0 RS |
168 | (defcustom ls-lisp-format-time-list |
169 | '("%b %e %H:%M" | |
170 | "%b %e %Y") | |
9201cc28 | 171 | "List of `format-time-string' specs to display file time stamps. |
ea88e775 EZ |
172 | These specs are used ONLY if a valid locale can not be determined. |
173 | ||
174 | If `ls-lisp-use-localized-time-format' is non-nil, these specs are used | |
175 | regardless of whether the locale can be determined. | |
2686cdc0 RS |
176 | |
177 | Syntax: (EARLY-TIME-FORMAT OLD-TIME-FORMAT) | |
178 | ||
179 | The EARLY-TIME-FORMAT is used if file has been modified within the | |
b3e22bd4 | 180 | current year. The OLD-TIME-FORMAT is used for older files. To use ISO |
2686cdc0 RS |
181 | 8601 dates, you could set: |
182 | ||
183 | \(setq ls-lisp-format-time-list | |
184 | '(\"%Y-%m-%d %H:%M\" | |
185 | \"%Y-%m-%d \"))" | |
401c1968 MR |
186 | :type '(list (string :tag "Early time format") |
187 | (string :tag "Old time format")) | |
2686cdc0 RS |
188 | :group 'ls-lisp) |
189 | ||
ea88e775 | 190 | (defcustom ls-lisp-use-localized-time-format nil |
b3e22bd4 GM |
191 | "Non-nil means to always use `ls-lisp-format-time-list' for time stamps. |
192 | This applies even if a valid locale is specified. | |
ea88e775 EZ |
193 | |
194 | WARNING: Using localized date/time format might cause Dired columns | |
b3e22bd4 | 195 | to fail to line up, e.g. if month names are not all of the same length." |
ea88e775 EZ |
196 | :type 'boolean |
197 | :group 'ls-lisp) | |
198 | ||
df3d23ee EZ |
199 | (defvar ls-lisp-uid-d-fmt "-%d" |
200 | "Format to display integer UIDs.") | |
201 | (defvar ls-lisp-uid-s-fmt "-%s" | |
202 | "Format to display user names.") | |
203 | (defvar ls-lisp-gid-d-fmt "-%d" | |
204 | "Format to display integer GIDs.") | |
205 | (defvar ls-lisp-gid-s-fmt "-%s" | |
206 | "Format to display user group names.") | |
207 | (defvar ls-lisp-filesize-d-fmt "%d" | |
208 | "Format to display integer file sizes.") | |
209 | (defvar ls-lisp-filesize-f-fmt "%.0f" | |
210 | "Format to display float file sizes.") | |
64e4c76e EZ |
211 | (defvar ls-lisp-filesize-b-fmt "%.0f" |
212 | "Format to display file sizes in blocks (for the -s switch).") | |
3f51f5a9 EZ |
213 | \f |
214 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
0cb0ba6c | 215 | |
7830899f | 216 | (defun ls-lisp--insert-directory (orig-fun file switches &optional wildcard full-directory-p) |
0cb0ba6c GV |
217 | "Insert directory listing for FILE, formatted according to SWITCHES. |
218 | Leaves point after the inserted text. | |
219 | SWITCHES may be a string of options, or a list of strings. | |
220 | Optional third arg WILDCARD means treat FILE as shell wildcard. | |
221 | Optional fourth arg FULL-DIRECTORY-P means file is a directory and | |
222 | switches do not contain `d', so that a full listing is expected. | |
223 | ||
3f51f5a9 EZ |
224 | This version of the function comes from `ls-lisp.el'. |
225 | If the value of `ls-lisp-use-insert-directory-program' is non-nil then | |
7830899f SM |
226 | this advice just delegates the work to ORIG-FUN (the normal `insert-directory' |
227 | function from `files.el'). | |
228 | But if the value of `ls-lisp-use-insert-directory-program' is nil | |
229 | then it runs a Lisp emulation. | |
3f51f5a9 EZ |
230 | |
231 | The Lisp emulation does not run any external programs or shells. It | |
232 | supports ordinary shell wildcards if `ls-lisp-support-shell-wildcards' | |
233 | is non-nil; otherwise, it interprets wildcards as regular expressions | |
234 | to match file names. It does not support all `ls' switches -- those | |
21620882 EZ |
235 | that work are: A a B C c F G g h i n R r S s t U u X. The l switch |
236 | is assumed to be always present and cannot be turned off." | |
0cb0ba6c | 237 | (if ls-lisp-use-insert-directory-program |
7830899f | 238 | (funcall orig-fun |
44a9ca8b | 239 | file switches wildcard full-directory-p) |
3f51f5a9 EZ |
240 | ;; We need the directory in order to find the right handler. |
241 | (let ((handler (find-file-name-handler (expand-file-name file) | |
94e72368 | 242 | 'insert-directory)) |
43bed668 | 243 | (orig-file file) |
94e72368 | 244 | wildcard-regexp) |
3f51f5a9 EZ |
245 | (if handler |
246 | (funcall handler 'insert-directory file switches | |
247 | wildcard full-directory-p) | |
d4939c66 JPW |
248 | ;; Remove --dired switch |
249 | (if (string-match "--dired " switches) | |
250 | (setq switches (replace-match "" nil nil switches))) | |
3f51f5a9 | 251 | ;; Convert SWITCHES to a list of characters. |
9b655a0a | 252 | (setq switches (delete ?\ (delete ?- (append switches nil)))) |
94e72368 RS |
253 | ;; Sometimes we get ".../foo*/" as FILE. While the shell and |
254 | ;; `ls' don't mind, we certainly do, because it makes us think | |
255 | ;; there is no wildcard, only a directory name. | |
256 | (if (and ls-lisp-support-shell-wildcards | |
9b40e204 | 257 | (string-match "[[?*]" file) |
43bed668 | 258 | ;; Prefer an existing file to wildcards, like |
9b40e204 | 259 | ;; dired-noselect does. |
43bed668 | 260 | (not (file-exists-p file))) |
94e72368 RS |
261 | (progn |
262 | (or (not (eq (aref file (1- (length file))) ?/)) | |
263 | (setq file (substring file 0 (1- (length file))))) | |
264 | (setq wildcard t))) | |
3f51f5a9 | 265 | (if wildcard |
94e72368 | 266 | (setq wildcard-regexp |
3f51f5a9 EZ |
267 | (if ls-lisp-support-shell-wildcards |
268 | (wildcard-to-regexp (file-name-nondirectory file)) | |
269 | (file-name-nondirectory file)) | |
270 | file (file-name-directory file)) | |
94e72368 | 271 | (if (memq ?B switches) (setq wildcard-regexp "[^~]\\'"))) |
43bed668 EZ |
272 | (condition-case err |
273 | (ls-lisp-insert-directory | |
274 | file switches (ls-lisp-time-index switches) | |
275 | wildcard-regexp full-directory-p) | |
276 | (invalid-regexp | |
277 | ;; Maybe they wanted a literal file that just happens to | |
278 | ;; use characters special to shell wildcards. | |
279 | (if (equal (cadr err) "Unmatched [ or [^") | |
280 | (progn | |
281 | (setq wildcard-regexp (if (memq ?B switches) "[^~]\\'") | |
282 | file (file-relative-name orig-file)) | |
283 | (ls-lisp-insert-directory | |
284 | file switches (ls-lisp-time-index switches) | |
285 | nil full-directory-p)) | |
286 | (signal (car err) (cdr err))))) | |
7f1b5edc EZ |
287 | ;; Try to insert the amount of free space. |
288 | (save-excursion | |
289 | (goto-char (point-min)) | |
290 | ;; First find the line to put it on. | |
291 | (when (re-search-forward "^total" nil t) | |
292 | (let ((available (get-free-disk-space "."))) | |
293 | (when available | |
7ad0c1c3 EZ |
294 | ;; Replace "total" with "total used", to avoid confusion. |
295 | (replace-match "total used in directory") | |
7f1b5edc EZ |
296 | (end-of-line) |
297 | (insert " available " available))))))))) | |
7830899f | 298 | (advice-add 'insert-directory :around #'ls-lisp--insert-directory) |
3f51f5a9 EZ |
299 | |
300 | (defun ls-lisp-insert-directory | |
94e72368 | 301 | (file switches time-index wildcard-regexp full-directory-p) |
3045b163 | 302 | "Insert directory listing for FILE, formatted according to SWITCHES. |
3f51f5a9 EZ |
303 | Leaves point after the inserted text. This is an internal function |
304 | optionally called by the `ls-lisp.el' version of `insert-directory'. | |
305 | It is called recursively if the -R switch is used. | |
306 | SWITCHES is a *list* of characters. TIME-INDEX is the time index into | |
94e72368 | 307 | file-attributes according to SWITCHES. WILDCARD-REGEXP is nil or an *Emacs |
3f51f5a9 EZ |
308 | regexp*. FULL-DIRECTORY-P means file is a directory and SWITCHES does |
309 | not contain `d', so that a full listing is expected." | |
94e72368 | 310 | (if (or wildcard-regexp full-directory-p) |
3f51f5a9 EZ |
311 | (let* ((dir (file-name-as-directory file)) |
312 | (default-directory dir) ; so that file-attributes works | |
313 | (file-alist | |
de4db6f1 EZ |
314 | (directory-files-and-attributes dir nil wildcard-regexp t |
315 | (if (memq ?n switches) | |
316 | 'integer | |
317 | 'string))) | |
3f51f5a9 | 318 | (sum 0) |
df3d23ee EZ |
319 | (max-uid-len 0) |
320 | (max-gid-len 0) | |
321 | (max-file-size 0) | |
3f51f5a9 | 322 | ;; do all bindings here for speed |
06b60517 | 323 | total-line files elt short file-size attr |
df3d23ee | 324 | fuid fgid uid-len gid-len) |
5e0d957f | 325 | (setq file-alist (ls-lisp-sanitize file-alist)) |
3f51f5a9 EZ |
326 | (cond ((memq ?A switches) |
327 | (setq file-alist | |
328 | (ls-lisp-delete-matching "^\\.\\.?$" file-alist))) | |
329 | ((not (memq ?a switches)) | |
330 | ;; if neither -A nor -a, flush . files | |
331 | (setq file-alist | |
332 | (ls-lisp-delete-matching "^\\." file-alist)))) | |
333 | (setq file-alist | |
334 | (ls-lisp-handle-switches file-alist switches)) | |
335 | (if (memq ?C switches) ; column (-C) format | |
336 | (ls-lisp-column-format file-alist) | |
337 | (setq total-line (cons (point) (car-safe file-alist))) | |
df3d23ee EZ |
338 | ;; Find the appropriate format for displaying uid, gid, and |
339 | ;; file size, by finding the longest strings among all the | |
340 | ;; files we are about to display. | |
341 | (dolist (elt file-alist) | |
342 | (setq attr (cdr elt) | |
343 | fuid (nth 2 attr) | |
a43e3054 EZ |
344 | uid-len (if (stringp fuid) (string-width fuid) |
345 | (length (format "%d" fuid))) | |
df3d23ee | 346 | fgid (nth 3 attr) |
a43e3054 EZ |
347 | gid-len (if (stringp fgid) (string-width fgid) |
348 | (length (format "%d" fgid))) | |
df3d23ee EZ |
349 | file-size (nth 7 attr)) |
350 | (if (> uid-len max-uid-len) | |
351 | (setq max-uid-len uid-len)) | |
352 | (if (> gid-len max-gid-len) | |
353 | (setq max-gid-len gid-len)) | |
354 | (if (> file-size max-file-size) | |
355 | (setq max-file-size file-size))) | |
356 | (setq ls-lisp-uid-d-fmt (format " %%-%dd" max-uid-len)) | |
357 | (setq ls-lisp-uid-s-fmt (format " %%-%ds" max-uid-len)) | |
358 | (setq ls-lisp-gid-d-fmt (format " %%-%dd" max-gid-len)) | |
359 | (setq ls-lisp-gid-s-fmt (format " %%-%ds" max-gid-len)) | |
360 | (setq ls-lisp-filesize-d-fmt | |
64e4c76e | 361 | (format " %%%dd" (length (format "%.0f" max-file-size)))) |
df3d23ee | 362 | (setq ls-lisp-filesize-f-fmt |
64e4c76e EZ |
363 | (format " %%%d.0f" (length (format "%.0f" max-file-size)))) |
364 | (if (memq ?s switches) | |
365 | (setq ls-lisp-filesize-b-fmt | |
366 | (format "%%%d.0f " | |
df3d23ee | 367 | (length (format "%.0f" |
64e4c76e EZ |
368 | (fceiling |
369 | (/ max-file-size 1024.0))))))) | |
3f51f5a9 EZ |
370 | (setq files file-alist) |
371 | (while files ; long (-l) format | |
372 | (setq elt (car files) | |
373 | files (cdr files) | |
374 | short (car elt) | |
375 | attr (cdr elt) | |
376 | file-size (nth 7 attr)) | |
377 | (and attr | |
378 | (setq sum (+ file-size | |
379 | ;; Even if neither SUM nor file's size | |
380 | ;; overflow, their sum could. | |
381 | (if (or (< sum (- 134217727 file-size)) | |
382 | (floatp sum) | |
383 | (floatp file-size)) | |
384 | sum | |
385 | (float sum)))) | |
386 | (insert (ls-lisp-format short attr file-size | |
b3e22bd4 | 387 | switches time-index)))) |
3f51f5a9 EZ |
388 | ;; Insert total size of all files: |
389 | (save-excursion | |
390 | (goto-char (car total-line)) | |
391 | (or (cdr total-line) | |
392 | ;; Shell says ``No match'' if no files match | |
393 | ;; the wildcard; let's say something similar. | |
394 | (insert "(No match)\n")) | |
395 | (insert (format "total %.0f\n" (fceiling (/ sum 1024.0)))))) | |
a37d34f3 PE |
396 | ;; dired-insert-directory expects to find point after the |
397 | ;; text. But if the listing is empty, as e.g. in empty | |
a81ee1eb IL |
398 | ;; directories with -a removed from switches, point will be |
399 | ;; before the inserted text, and dired-insert-directory will | |
400 | ;; not indent the listing correctly. Going to the end of the | |
401 | ;; buffer fixes that. | |
402 | (unless files (goto-char (point-max))) | |
3f51f5a9 EZ |
403 | (if (memq ?R switches) |
404 | ;; List the contents of all directories recursively. | |
405 | ;; cadr of each element of `file-alist' is t for | |
406 | ;; directory, string (name linked to) for symbolic | |
407 | ;; link, or nil. | |
9dce08b6 RS |
408 | (while file-alist |
409 | (setq elt (car file-alist) | |
3f51f5a9 EZ |
410 | file-alist (cdr file-alist)) |
411 | (when (and (eq (cadr elt) t) ; directory | |
0c6af6dd EZ |
412 | ;; Under -F, we have already decorated all |
413 | ;; directories, including "." and "..", with | |
414 | ;; a /, so allow for that as well. | |
415 | (not (string-match "\\`\\.\\.?/?\\'" (car elt)))) | |
3f51f5a9 EZ |
416 | (setq elt (expand-file-name (car elt) dir)) |
417 | (insert "\n" elt ":\n") | |
418 | (ls-lisp-insert-directory | |
94e72368 | 419 | elt switches time-index wildcard-regexp full-directory-p))))) |
3f51f5a9 EZ |
420 | ;; If not full-directory-p, FILE *must not* end in /, as |
421 | ;; file-attributes will not recognize a symlink to a directory, | |
422 | ;; so must make it a relative filename as ls does: | |
a8e4290b | 423 | (if (file-name-absolute-p file) (setq file (expand-file-name file))) |
3f51f5a9 EZ |
424 | (if (eq (aref file (1- (length file))) ?/) |
425 | (setq file (substring file 0 -1))) | |
80ca5799 | 426 | (let ((fattr (file-attributes file 'string))) |
3f51f5a9 | 427 | (if fattr |
9b655a0a EZ |
428 | (insert (ls-lisp-format |
429 | (if (memq ?F switches) | |
430 | (ls-lisp-classify-file file fattr) | |
431 | file) | |
432 | fattr (nth 7 fattr) | |
b3e22bd4 | 433 | switches time-index)) |
3f51f5a9 EZ |
434 | (message "%s: doesn't exist or is inaccessible" file) |
435 | (ding) (sit-for 2))))) ; to show user the message! | |
436 | ||
5e0d957f EZ |
437 | (defun ls-lisp-sanitize (file-alist) |
438 | "Sanitize the elements in FILE-ALIST. | |
439 | Fixes any elements in the alist for directory entries whose file | |
440 | attributes are nil (meaning that `file-attributes' failed for | |
441 | them). This is known to happen for some network shares, in | |
442 | particular for the \"..\" directory entry. | |
443 | ||
444 | If the \"..\" directory entry has nil attributes, the attributes | |
445 | are copied from the \".\" entry, if they are non-nil. Otherwise, | |
446 | the offending element is removed from the list, as are any | |
447 | elements for other directory entries with nil attributes." | |
448 | (if (and (null (cdr (assoc ".." file-alist))) | |
449 | (cdr (assoc "." file-alist))) | |
450 | (setcdr (assoc ".." file-alist) (cdr (assoc "." file-alist)))) | |
451 | (rassq-delete-all nil file-alist)) | |
452 | ||
3f51f5a9 EZ |
453 | (defun ls-lisp-column-format (file-alist) |
454 | "Insert the file names (only) in FILE-ALIST into the current buffer. | |
455 | Format in columns, sorted vertically, following GNU ls -C. | |
456 | Responds to the window width as ls should but may not!" | |
457 | (let (files fmt ncols collen (nfiles 0) (colwid 0)) | |
458 | ;; Count number of files as `nfiles', build list of filenames as | |
459 | ;; `files', and find maximum filename length as `colwid': | |
460 | (let (file len) | |
461 | (while file-alist | |
462 | (setq nfiles (1+ nfiles) | |
463 | file (caar file-alist) | |
464 | files (cons file files) | |
465 | file-alist (cdr file-alist) | |
466 | len (length file)) | |
467 | (if (> len colwid) (setq colwid len)))) | |
468 | (setq files (nreverse files) | |
469 | colwid (+ 2 colwid) ; 2 character column gap | |
470 | fmt (format "%%-%ds" colwid) ; print format | |
471 | ncols (/ (window-width) colwid) ; no of columns | |
472 | collen (/ nfiles ncols)) ; floor of column length | |
473 | (if (> nfiles (* collen ncols)) (setq collen (1+ collen))) | |
474 | ;; Output the file names in columns, sorted vertically: | |
475 | (let ((i 0) j) | |
476 | (while (< i collen) | |
477 | (setq j i) | |
478 | (while (< j nfiles) | |
479 | (insert (format fmt (nth j files))) | |
480 | (setq j (+ j collen))) | |
481 | ;; FJW: This is completely unnecessary, but I don't like | |
482 | ;; trailing white space... | |
483 | (delete-region (point) (progn (skip-chars-backward " \t") (point))) | |
484 | (insert ?\n) | |
485 | (setq i (1+ i)))))) | |
9dce08b6 RS |
486 | |
487 | (defun ls-lisp-delete-matching (regexp list) | |
3f51f5a9 | 488 | "Delete all elements matching REGEXP from LIST, return new list." |
d6d472d5 | 489 | ;; Should perhaps use setcdr for efficiency. |
6467926f SK |
490 | (let (result) |
491 | (while list | |
3f51f5a9 | 492 | (or (string-match regexp (caar list)) |
6467926f SK |
493 | (setq result (cons (car list) result))) |
494 | (setq list (cdr list))) | |
495 | result)) | |
496 | ||
3f51f5a9 EZ |
497 | (defsubst ls-lisp-string-lessp (s1 s2) |
498 | "Return t if string S1 is less than string S2 in lexicographic order. | |
499 | Case is significant if `ls-lisp-ignore-case' is nil. | |
500 | Unibyte strings are converted to multibyte for comparison." | |
501 | (let ((u (compare-strings s1 0 nil s2 0 nil ls-lisp-ignore-case))) | |
502 | (and (numberp u) (< u 0)))) | |
503 | ||
9dce08b6 | 504 | (defun ls-lisp-handle-switches (file-alist switches) |
3f51f5a9 EZ |
505 | "Return new FILE-ALIST sorted according to SWITCHES. |
506 | SWITCHES is a list of characters. Default sorting is alphabetic." | |
6467926f | 507 | ;; FILE-ALIST's elements are (FILE . FILE-ATTRIBUTES). |
3f51f5a9 EZ |
508 | (or (memq ?U switches) ; unsorted |
509 | ;; Catch and ignore unexpected sorting errors | |
510 | (condition-case err | |
511 | (setq file-alist | |
512 | (let (index) | |
513 | ;; Copy file-alist in case of error | |
514 | (sort (copy-sequence file-alist) ; modifies its argument! | |
515 | (cond ((memq ?S switches) | |
516 | (lambda (x y) ; sorted on size | |
517 | ;; 7th file attribute is file size | |
518 | ;; Make largest file come first | |
519 | (< (nth 7 (cdr y)) | |
520 | (nth 7 (cdr x))))) | |
521 | ((setq index (ls-lisp-time-index switches)) | |
522 | (lambda (x y) ; sorted on time | |
6e404950 GM |
523 | (time-less-p (nth index (cdr y)) |
524 | (nth index (cdr x))))) | |
3f51f5a9 EZ |
525 | ((memq ?X switches) |
526 | (lambda (x y) ; sorted on extension | |
527 | (ls-lisp-string-lessp | |
528 | (ls-lisp-extension (car x)) | |
529 | (ls-lisp-extension (car y))))) | |
530 | (t | |
531 | (lambda (x y) ; sorted alphabetically | |
532 | (ls-lisp-string-lessp (car x) (car y)))))))) | |
533 | (error (message "Unsorted (ls-lisp sorting error) - %s" | |
534 | (error-message-string err)) | |
535 | (ding) (sit-for 2)))) ; to show user the message! | |
536 | (if (memq ?F switches) ; classify switch | |
537 | (setq file-alist (mapcar 'ls-lisp-classify file-alist))) | |
538 | (if ls-lisp-dirs-first | |
539 | ;; Re-sort directories first, without otherwise changing the | |
540 | ;; ordering, and reverse whole list. cadr of each element of | |
541 | ;; `file-alist' is t for directory, string (name linked to) for | |
542 | ;; symbolic link, or nil. | |
543 | (let (el dirs files) | |
544 | (while file-alist | |
5eba3394 LH |
545 | (if (or (eq (cadr (setq el (car file-alist))) t) ; directory |
546 | (and (stringp (cadr el)) | |
547 | (file-directory-p (cadr el)))) ; symlink to a directory | |
3f51f5a9 EZ |
548 | (setq dirs (cons el dirs)) |
549 | (setq files (cons el files))) | |
550 | (setq file-alist (cdr file-alist))) | |
551 | (setq file-alist | |
552 | (if (memq ?U switches) ; unsorted order is reversed | |
553 | (nconc dirs files) | |
554 | (nconc files dirs) | |
555 | )))) | |
556 | ;; Finally reverse file alist if necessary. | |
557 | ;; (eq below MUST compare `(not (memq ...))' to force comparison of | |
558 | ;; `t' or `nil', rather than list tails!) | |
559 | (if (eq (eq (not (memq ?U switches)) ; unsorted order is reversed | |
560 | (not (memq ?r switches))) ; reversed sort order requested | |
561 | ls-lisp-dirs-first) ; already reversed | |
562 | (nreverse file-alist) | |
563 | file-alist)) | |
564 | ||
9b655a0a EZ |
565 | (defun ls-lisp-classify-file (filename fattr) |
566 | "Append a character to FILENAME indicating the file type. | |
567 | ||
568 | FATTR is the file attributes returned by `file-attributes' for the file. | |
569 | The file type indicators are `/' for directories, `@' for symbolic | |
570 | links, `|' for FIFOs, `=' for sockets, `*' for regular files that | |
571 | are executable, and nothing for other types of files." | |
572 | (let* ((type (car fattr)) | |
573 | (modestr (nth 8 fattr)) | |
574 | (typestr (substring modestr 0 1))) | |
575 | (cond | |
576 | (type | |
577 | (concat filename (if (eq type t) "/" "@"))) | |
578 | ((string-match "x" modestr) | |
579 | (concat filename "*")) | |
580 | ((string= "p" typestr) | |
581 | (concat filename "|")) | |
582 | ((string= "s" typestr) | |
583 | (concat filename "=")) | |
584 | (t filename)))) | |
585 | ||
3f51f5a9 | 586 | (defun ls-lisp-classify (filedata) |
9b655a0a EZ |
587 | "Append a character to file name in FILEDATA indicating the file type. |
588 | ||
589 | FILEDATA has the form (FILENAME . ATTRIBUTES), where ATTRIBUTES is the | |
590 | structure returned by `file-attributes' for that file. | |
591 | ||
3f51f5a9 | 592 | The file type indicators are `/' for directories, `@' for symbolic |
9b655a0a EZ |
593 | links, `|' for FIFOs, `=' for sockets, `*' for regular files that |
594 | are executable, and nothing for other types of files." | |
5eba3394 | 595 | (let ((file-name (car filedata)) |
9b655a0a EZ |
596 | (fattr (cdr filedata))) |
597 | (setq file-name (propertize file-name 'dired-filename t)) | |
598 | (cons (ls-lisp-classify-file file-name fattr) fattr))) | |
3f51f5a9 EZ |
599 | |
600 | (defun ls-lisp-extension (filename) | |
601 | "Return extension of FILENAME (ignoring any version extension) | |
602 | FOLLOWED by null and full filename, SOLELY for full alpha sort." | |
603 | ;; Force extension sort order: `no ext' then `null ext' then `ext' | |
604 | ;; to agree with GNU ls. | |
605 | (concat | |
606 | (let* ((i (length filename)) end) | |
607 | (if (= (aref filename (1- i)) ?.) ; null extension | |
608 | "\0" | |
609 | (while (and (>= (setq i (1- i)) 0) | |
610 | (/= (aref filename i) ?.))) | |
611 | (if (< i 0) "\0\0" ; no extension | |
612 | (if (/= (aref filename (1+ i)) ?~) | |
613 | (substring filename (1+ i)) | |
614 | ;; version extension found -- ignore it | |
615 | (setq end i) | |
616 | (while (and (>= (setq i (1- i)) 0) | |
617 | (/= (aref filename i) ?.))) | |
618 | (if (< i 0) "\0\0" ; no extension | |
619 | (substring filename (1+ i) end)))) | |
620 | )) "\0" filename)) | |
d88c0e93 | 621 | |
b3e22bd4 | 622 | (defun ls-lisp-format (file-name file-attr file-size switches time-index) |
3f51f5a9 EZ |
623 | "Format one line of long ls output for file FILE-NAME. |
624 | FILE-ATTR and FILE-SIZE give the file's attributes and size. | |
b3e22bd4 | 625 | SWITCHES and TIME-INDEX give the full switch list and time data." |
3f51f5a9 EZ |
626 | (let ((file-type (nth 0 file-attr)) |
627 | ;; t for directory, string (name linked to) | |
628 | ;; for symbolic link, or nil. | |
629 | (drwxrwxrwx (nth 8 file-attr))) ; attribute string ("drwxrwxrwx") | |
6467926f | 630 | (concat (if (memq ?i switches) ; inode number |
c902c8a7 EZ |
631 | (let ((inode (nth 10 file-attr))) |
632 | (if (consp inode) | |
633 | (if (consp (cdr inode)) | |
0e5016a6 EZ |
634 | ;; 2^(24+16) = 1099511627776.0, but |
635 | ;; multiplying by it and then adding the | |
636 | ;; other members of the cons cell in one go | |
637 | ;; loses precision, since a double does not | |
638 | ;; have enough significant digits to hold a | |
639 | ;; full 64-bit value. So below we split | |
640 | ;; 1099511627776 into high 13 and low 5 | |
641 | ;; digits and compute in two parts. | |
642 | (let ((p1 (* (car inode) 10995116.0)) | |
643 | (p2 (+ (* (car inode) 27776.0) | |
644 | (* (cadr inode) 65536.0) | |
645 | (cddr inode)))) | |
646 | (format " %13.0f%05.0f " | |
647 | ;; Use floor to emulate integer | |
648 | ;; division. | |
649 | (+ p1 (floor p2 100000.0)) | |
650 | (mod p2 100000.0))) | |
651 | (format " %18.0f " | |
c902c8a7 EZ |
652 | (+ (* (car inode) 65536.0) |
653 | (cdr inode)))) | |
0e5016a6 | 654 | (format " %18d " inode)))) |
d6d472d5 | 655 | ;; nil is treated like "" in concat |
64e4c76e EZ |
656 | (if (memq ?s switches) ; size in K, rounded up |
657 | ;; In GNU ls, -h affects the size in blocks, displayed | |
658 | ;; by -s, as well. | |
659 | (if (memq ?h switches) | |
660 | (format "%6s " | |
661 | (file-size-human-readable | |
662 | ;; We use 1K as "block size", although | |
663 | ;; most Windows volumes use 4KB to 8KB | |
664 | ;; clusters, and exFAT will usually have | |
665 | ;; clusters of 32KB or even 128KB. See | |
666 | ;; KB article 140365 for the details. | |
667 | (* 1024.0 (fceiling (/ file-size 1024.0))))) | |
668 | (format ls-lisp-filesize-b-fmt | |
669 | (fceiling (/ file-size 1024.0))))) | |
3f51f5a9 EZ |
670 | drwxrwxrwx ; attribute string |
671 | (if (memq 'links ls-lisp-verbosity) | |
df3d23ee | 672 | (format "%3d" (nth 1 file-attr))) ; link count |
3f51f5a9 | 673 | ;; Numeric uid/gid are more confusing than helpful; |
6467926f | 674 | ;; Emacs should be able to make strings of them. |
3f51f5a9 EZ |
675 | ;; They tend to be bogus on non-UNIX platforms anyway so |
676 | ;; optionally hide them. | |
677 | (if (memq 'uid ls-lisp-verbosity) | |
c0943d3d | 678 | ;; uid can be a string or an integer |
3f51f5a9 | 679 | (let ((uid (nth 2 file-attr))) |
df3d23ee EZ |
680 | (format (if (stringp uid) |
681 | ls-lisp-uid-s-fmt | |
682 | ls-lisp-uid-d-fmt) | |
683 | uid))) | |
3f51f5a9 EZ |
684 | (if (not (memq ?G switches)) ; GNU ls -- shows group by default |
685 | (if (or (memq ?g switches) ; UNIX ls -- no group by default | |
686 | (memq 'gid ls-lisp-verbosity)) | |
80ca5799 | 687 | (let ((gid (nth 3 file-attr))) |
df3d23ee EZ |
688 | (format (if (stringp gid) |
689 | ls-lisp-gid-s-fmt | |
690 | ls-lisp-gid-d-fmt) | |
691 | gid)))) | |
a3723f13 | 692 | (ls-lisp-format-file-size file-size (memq ?h switches)) |
3f51f5a9 | 693 | " " |
b3e22bd4 | 694 | (ls-lisp-format-time file-attr time-index) |
738eb4e7 | 695 | " " |
40077a52 EZ |
696 | (if (not (memq ?F switches)) ; ls-lisp-classify already did that |
697 | (propertize file-name 'dired-filename t) | |
698 | file-name) | |
d88c0e93 | 699 | (if (stringp file-type) ; is a symbolic link |
3f51f5a9 | 700 | (concat " -> " file-type)) |
d88c0e93 SK |
701 | "\n" |
702 | ))) | |
703 | ||
9dce08b6 | 704 | (defun ls-lisp-time-index (switches) |
3f51f5a9 EZ |
705 | "Return time index into file-attributes according to ls SWITCHES list. |
706 | Return nil if no time switch found." | |
707 | ;; FJW: Default of nil is IMPORTANT and used in `ls-lisp-handle-switches'! | |
708 | (cond ((memq ?c switches) 6) ; last mode change | |
709 | ((memq ?t switches) 5) ; last modtime | |
710 | ((memq ?u switches) 4))) ; last access | |
711 | ||
b3e22bd4 | 712 | (defun ls-lisp-format-time (file-attr time-index) |
3f51f5a9 EZ |
713 | "Format time for file with attributes FILE-ATTR according to TIME-INDEX. |
714 | Use the same method as ls to decide whether to show time-of-day or year, | |
b3e22bd4 | 715 | depending on distance between file date and the current time. |
3f51f5a9 EZ |
716 | All ls time options, namely c, t and u, are handled." |
717 | (let* ((time (nth (or time-index 5) file-attr)) ; default is last modtime | |
b3e22bd4 | 718 | (diff (- (float-time time) (float-time))) |
d81a647c PE |
719 | ;; Consider a time to be recent if it is within the past six |
720 | ;; months. A Gregorian year has 365.2425 * 24 * 60 * 60 == | |
721 | ;; 31556952 seconds on the average, and half of that is 15778476. | |
722 | ;; Write the constant explicitly to avoid roundoff error. | |
723 | (past-cutoff -15778476)) ; half a Gregorian year | |
f8a10234 | 724 | (condition-case nil |
d81a647c PE |
725 | ;; Use traditional time format in the C or POSIX locale, |
726 | ;; ISO-style time format otherwise, so columns line up. | |
727 | (let ((locale system-time-locale)) | |
728 | (if (not locale) | |
729 | (let ((vars '("LC_ALL" "LC_TIME" "LANG"))) | |
730 | (while (and vars (not (setq locale (getenv (car vars))))) | |
731 | (setq vars (cdr vars))))) | |
732 | (if (member locale '("C" "POSIX")) | |
733 | (setq locale nil)) | |
734 | (format-time-string | |
735 | (if (and (<= past-cutoff diff) (<= diff 0)) | |
ea88e775 EZ |
736 | (if (and locale (not ls-lisp-use-localized-time-format)) |
737 | "%m-%d %H:%M" | |
738 | (nth 0 ls-lisp-format-time-list)) | |
739 | (if (and locale (not ls-lisp-use-localized-time-format)) | |
740 | "%Y-%m-%d " | |
741 | (nth 1 ls-lisp-format-time-list))) | |
d81a647c | 742 | time)) |
452e47d7 | 743 | (error "Unk 0 0000")))) |
738eb4e7 | 744 | |
a3723f13 | 745 | (defun ls-lisp-format-file-size (file-size human-readable) |
df3d23ee EZ |
746 | (if (not human-readable) |
747 | (format (if (floatp file-size) | |
748 | ls-lisp-filesize-f-fmt | |
749 | ls-lisp-filesize-d-fmt) | |
750 | file-size) | |
64e4c76e | 751 | (format " %6s" (file-size-human-readable file-size)))) |
a3723f13 | 752 | |
9dce08b6 | 753 | (provide 'ls-lisp) |
738eb4e7 | 754 | |
76550a57 | 755 | ;;; ls-lisp.el ends here |