Update years in copyright notice; nfc.
[bpt/emacs.git] / lisp / ls-lisp.el
CommitLineData
76550a57
ER
1;;; ls-lisp.el --- emulate insert-directory completely in Emacs Lisp
2
0d30b337 3;; Copyright (C) 1992, 1994, 2000, 2002, 2003, 2004,
aaef169d 4;; 2005, 2006 Free Software Foundation, Inc.
b578f267 5
55535639
PJ
6;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
7;; Modified by: Francis J. Wright <F.J.Wright@maths.qmw.ac.uk>
8;; Maintainer: FSF
9;; Keywords: unix, dired
d88c0e93 10
b578f267 11;; This file is part of GNU Emacs.
d88c0e93 12
b578f267 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
7c938215 15;; the Free Software Foundation; either version 2, or (at your option)
d88c0e93 16;; 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
b578f267 24;; along with GNU Emacs; see the file COPYING. If not, write to the
086add15
LK
25;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
26;; Boston, MA 02110-1301, USA.
b578f267
EN
27
28;;; Commentary:
738eb4e7 29
3f51f5a9 30;; OVERVIEW ==========================================================
d9a0f717 31
3f51f5a9
EZ
32;; This file redefines the function `insert-directory' to implement it
33;; directly from Emacs lisp, without running ls in a subprocess. It
34;; is useful if you cannot afford to fork Emacs on a real memory UNIX,
35;; under VMS or other non-UNIX platforms if you don't have the ls
36;; program, or if you want a different format from what ls offers.
738eb4e7 37
3f51f5a9
EZ
38;; This function can use regexps instead of shell wildcards. If you
39;; enter regexps remember to double each $ sign. For example, to
40;; include files *.el, enter `.*\.el$$', resulting in the regexp
41;; `.*\.el$'.
738eb4e7 42
3f51f5a9 43;; RESTRICTIONS ======================================================
738eb4e7 44
3f51f5a9
EZ
45;; * A few obscure ls switches are still ignored: see the docstring of
46;; `insert-directory'.
d88c0e93 47
3f51f5a9 48;; TO DO =============================================================
738eb4e7 49
3f51f5a9 50;; Complete handling of F switch (if/when possible).
738eb4e7 51
3f51f5a9
EZ
52;; FJW: May be able to sort much faster by consing the sort key onto
53;; the front of each list element, sorting and then stripping the key
54;; off again!
738eb4e7 55
3f51f5a9 56;;; History:
76550a57 57
3f51f5a9
EZ
58;; Written originally by Sebastian Kremer <sk@thp.uni-koeln.de>
59;; Revised by Andrew Innes and Geoff Volker (and maybe others).
3045b163 60
3f51f5a9 61;; Modified by Francis J. Wright <F.J.Wright@maths.qmw.ac.uk>, mainly
5eba3394
LH
62;; to support many more ls options, "platform emulation" and more
63;; robust sorting.
3f51f5a9
EZ
64
65;;; Code:
97b927b3 66
a3723f13
JB
67(eval-when-compile (require 'cl))
68
3f51f5a9
EZ
69(defgroup ls-lisp nil
70 "Emulate the ls program completely in Emacs Lisp."
eff409ba 71 :version "21.1"
3f51f5a9
EZ
72 :group 'dired)
73
74(defcustom ls-lisp-emulation
75 (cond ((eq system-type 'macos) 'MacOS)
76 ;; ((eq system-type 'windows-nt) 'MS-Windows)
77 ((memq system-type
78 '(hpux dgux usg-unix-v unisoft-unix rtu irix berkeley-unix))
79 'UNIX)) ; very similar to GNU
80 ;; Anything else defaults to nil, meaning GNU.
81 "*Platform to emulate: GNU (default), MacOS, MS-Windows, UNIX.
82Corresponding value is one of the atoms: nil, MacOS, MS-Windows, UNIX.
83Sets default values for: `ls-lisp-ignore-case', `ls-lisp-dirs-first',
84`ls-lisp-verbosity'. Need not match actual platform. Changing this
85option will have no effect until you restart Emacs."
86 :type '(choice (const :tag "GNU" nil)
87 (const MacOS)
88 (const MS-Windows)
89 (const UNIX))
90 :group 'ls-lisp)
91
92(defcustom ls-lisp-ignore-case
93 ;; Name change for consistency with other option names.
94 (or (memq ls-lisp-emulation '(MS-Windows MacOS))
95 (and (boundp 'ls-lisp-dired-ignore-case) ls-lisp-dired-ignore-case))
96 "*Non-nil causes ls-lisp alphabetic sorting to ignore case."
97 :type 'boolean
98 :group 'ls-lisp)
99
100(defcustom ls-lisp-dirs-first (eq ls-lisp-emulation 'MS-Windows)
101 "*Non-nil causes ls-lisp to sort directories first in any ordering.
102\(Or last if it is reversed.) Follows Microsoft Windows Explorer."
103 ;; Functionality suggested by Chris McMahan <cmcmahan@one.net>
104 :type 'boolean
105 :group 'ls-lisp)
106
107(defcustom ls-lisp-verbosity
108 (cond ((eq ls-lisp-emulation 'MacOS) nil)
109 ((eq ls-lisp-emulation 'MS-Windows)
110 (if (and (fboundp 'w32-using-nt) (w32-using-nt))
111 '(links))) ; distinguish NT/2K from 9x
112 ((eq ls-lisp-emulation 'UNIX) '(links uid)) ; UNIX ls
113 (t '(links uid gid))) ; GNU ls
114 "*A list of optional file attributes that ls-lisp should display.
115It should contain none or more of the symbols: links, uid, gid.
f0529b5b 116nil (or an empty list) means display none of them.
3f51f5a9
EZ
117
118Concepts come from UNIX: `links' means count of names associated with
119the file\; `uid' means user (owner) identifier\; `gid' means group
120identifier.
121
122If emulation is MacOS then default is nil\;
123if emulation is MS-Windows then default is `(links)' if platform is
124Windows NT/2K, nil otherwise\;
125if emulation is UNIX then default is `(links uid)'\;
126if emulation is GNU then default is `(links uid gid)'."
127 ;; Functionality suggested by Howard Melman <howard@silverstream.com>
128 :type '(set (const :tag "Show Link Count" links)
129 (const :tag "Show User" uid)
130 (const :tag "Show Group" gid))
131 :group 'ls-lisp)
132
73916123
MR
133(defcustom ls-lisp-use-insert-directory-program
134 (not (memq system-type '(macos ms-dos windows-nt)))
3f51f5a9 135 "*Non-nil causes ls-lisp to revert back to using `insert-directory-program'.
0cb0ba6c
GV
136This is useful on platforms where ls-lisp is dumped into Emacs, such as
137Microsoft Windows, but you would still like to use a program to list
3f51f5a9
EZ
138the contents of a directory."
139 :type 'boolean
140 :group 'ls-lisp)
141
73916123
MR
142;;; Autoloaded because it is let-bound in `recover-session', `mail-recover-1'.
143;;;###autoload
3f51f5a9
EZ
144(defcustom ls-lisp-support-shell-wildcards t
145 "*Non-nil means ls-lisp treats file patterns as shell wildcards.
146Otherwise they are treated as Emacs regexps (for backward compatibility)."
147 :type 'boolean
148 :group 'ls-lisp)
149
2686cdc0
RS
150(defcustom ls-lisp-format-time-list
151 '("%b %e %H:%M"
152 "%b %e %Y")
153 "*List of `format-time-string' specs to display file time stamps.
154They are used whenever a locale is not specified to use instead.
155
156Syntax: (EARLY-TIME-FORMAT OLD-TIME-FORMAT)
157
158The EARLY-TIME-FORMAT is used if file has been modified within the
159current year. The OLD-TIME-FORMAT is used for older files. To use ISO
1608601 dates, you could set:
161
162\(setq ls-lisp-format-time-list
163 '(\"%Y-%m-%d %H:%M\"
164 \"%Y-%m-%d \"))"
401c1968
MR
165 :type '(list (string :tag "Early time format")
166 (string :tag "Old time format"))
2686cdc0
RS
167 :group 'ls-lisp)
168
44a9ca8b
RS
169(defvar original-insert-directory nil
170 "This holds the original function definition of `insert-directory'.")
171
3f51f5a9
EZ
172;; Remember the original insert-directory function
173(or (featurep 'ls-lisp) ; FJW: unless this file is being reloaded!
44a9ca8b 174 (setq original-insert-directory (symbol-function 'insert-directory)))
3f51f5a9 175
3f51f5a9
EZ
176\f
177;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
0cb0ba6c
GV
178
179(defun insert-directory (file switches &optional wildcard full-directory-p)
180 "Insert directory listing for FILE, formatted according to SWITCHES.
181Leaves point after the inserted text.
182SWITCHES may be a string of options, or a list of strings.
183Optional third arg WILDCARD means treat FILE as shell wildcard.
184Optional fourth arg FULL-DIRECTORY-P means file is a directory and
185switches do not contain `d', so that a full listing is expected.
186
3f51f5a9
EZ
187This version of the function comes from `ls-lisp.el'.
188If the value of `ls-lisp-use-insert-directory-program' is non-nil then
189it works exactly like the version from `files.el' and runs a directory
190listing program whose name is in the variable
191`insert-directory-program'; if also WILDCARD is non-nil then it runs
192the shell specified by `shell-file-name'. If the value of
193`ls-lisp-use-insert-directory-program' is nil then it runs a Lisp
194emulation.
195
196The Lisp emulation does not run any external programs or shells. It
197supports ordinary shell wildcards if `ls-lisp-support-shell-wildcards'
198is non-nil; otherwise, it interprets wildcards as regular expressions
199to match file names. It does not support all `ls' switches -- those
200that work are: A a c i r S s t u U X g G B C R and F partly."
0cb0ba6c 201 (if ls-lisp-use-insert-directory-program
44a9ca8b
RS
202 (funcall original-insert-directory
203 file switches wildcard full-directory-p)
3f51f5a9
EZ
204 ;; We need the directory in order to find the right handler.
205 (let ((handler (find-file-name-handler (expand-file-name file)
94e72368
RS
206 'insert-directory))
207 wildcard-regexp)
3f51f5a9
EZ
208 (if handler
209 (funcall handler 'insert-directory file switches
210 wildcard full-directory-p)
d4939c66
JPW
211 ;; Remove --dired switch
212 (if (string-match "--dired " switches)
213 (setq switches (replace-match "" nil nil switches)))
3f51f5a9
EZ
214 ;; Convert SWITCHES to a list of characters.
215 (setq switches (delete ?- (append switches nil)))
94e72368
RS
216 ;; Sometimes we get ".../foo*/" as FILE. While the shell and
217 ;; `ls' don't mind, we certainly do, because it makes us think
218 ;; there is no wildcard, only a directory name.
219 (if (and ls-lisp-support-shell-wildcards
220 (string-match "[[?*]" file))
221 (progn
222 (or (not (eq (aref file (1- (length file))) ?/))
223 (setq file (substring file 0 (1- (length file)))))
224 (setq wildcard t)))
3f51f5a9 225 (if wildcard
94e72368 226 (setq wildcard-regexp
3f51f5a9
EZ
227 (if ls-lisp-support-shell-wildcards
228 (wildcard-to-regexp (file-name-nondirectory file))
229 (file-name-nondirectory file))
230 file (file-name-directory file))
94e72368 231 (if (memq ?B switches) (setq wildcard-regexp "[^~]\\'")))
3f51f5a9
EZ
232 (ls-lisp-insert-directory
233 file switches (ls-lisp-time-index switches)
94e72368 234 wildcard-regexp full-directory-p)
7f1b5edc
EZ
235 ;; Try to insert the amount of free space.
236 (save-excursion
237 (goto-char (point-min))
238 ;; First find the line to put it on.
239 (when (re-search-forward "^total" nil t)
240 (let ((available (get-free-disk-space ".")))
241 (when available
7ad0c1c3
EZ
242 ;; Replace "total" with "total used", to avoid confusion.
243 (replace-match "total used in directory")
7f1b5edc
EZ
244 (end-of-line)
245 (insert " available " available)))))))))
3f51f5a9
EZ
246
247(defun ls-lisp-insert-directory
94e72368 248 (file switches time-index wildcard-regexp full-directory-p)
3045b163 249 "Insert directory listing for FILE, formatted according to SWITCHES.
3f51f5a9
EZ
250Leaves point after the inserted text. This is an internal function
251optionally called by the `ls-lisp.el' version of `insert-directory'.
252It is called recursively if the -R switch is used.
253SWITCHES is a *list* of characters. TIME-INDEX is the time index into
94e72368 254file-attributes according to SWITCHES. WILDCARD-REGEXP is nil or an *Emacs
3f51f5a9
EZ
255regexp*. FULL-DIRECTORY-P means file is a directory and SWITCHES does
256not contain `d', so that a full listing is expected."
94e72368 257 (if (or wildcard-regexp full-directory-p)
3f51f5a9
EZ
258 (let* ((dir (file-name-as-directory file))
259 (default-directory dir) ; so that file-attributes works
260 (file-alist
80ca5799 261 (directory-files-and-attributes dir nil wildcard-regexp t 'string))
3f51f5a9
EZ
262 (now (current-time))
263 (sum 0)
264 ;; do all bindings here for speed
265 total-line files elt short file-size fil attr)
266 (cond ((memq ?A switches)
267 (setq file-alist
268 (ls-lisp-delete-matching "^\\.\\.?$" file-alist)))
269 ((not (memq ?a switches))
270 ;; if neither -A nor -a, flush . files
271 (setq file-alist
272 (ls-lisp-delete-matching "^\\." file-alist))))
273 (setq file-alist
274 (ls-lisp-handle-switches file-alist switches))
275 (if (memq ?C switches) ; column (-C) format
276 (ls-lisp-column-format file-alist)
277 (setq total-line (cons (point) (car-safe file-alist)))
278 (setq files file-alist)
279 (while files ; long (-l) format
280 (setq elt (car files)
281 files (cdr files)
282 short (car elt)
283 attr (cdr elt)
284 file-size (nth 7 attr))
285 (and attr
286 (setq sum (+ file-size
287 ;; Even if neither SUM nor file's size
288 ;; overflow, their sum could.
289 (if (or (< sum (- 134217727 file-size))
290 (floatp sum)
291 (floatp file-size))
292 sum
293 (float sum))))
294 (insert (ls-lisp-format short attr file-size
295 switches time-index now))))
296 ;; Insert total size of all files:
297 (save-excursion
298 (goto-char (car total-line))
299 (or (cdr total-line)
300 ;; Shell says ``No match'' if no files match
301 ;; the wildcard; let's say something similar.
302 (insert "(No match)\n"))
303 (insert (format "total %.0f\n" (fceiling (/ sum 1024.0))))))
304 (if (memq ?R switches)
305 ;; List the contents of all directories recursively.
306 ;; cadr of each element of `file-alist' is t for
307 ;; directory, string (name linked to) for symbolic
308 ;; link, or nil.
9dce08b6
RS
309 (while file-alist
310 (setq elt (car file-alist)
3f51f5a9
EZ
311 file-alist (cdr file-alist))
312 (when (and (eq (cadr elt) t) ; directory
313 (not (string-match "\\`\\.\\.?\\'" (car elt))))
314 (setq elt (expand-file-name (car elt) dir))
315 (insert "\n" elt ":\n")
316 (ls-lisp-insert-directory
94e72368 317 elt switches time-index wildcard-regexp full-directory-p)))))
3f51f5a9
EZ
318 ;; If not full-directory-p, FILE *must not* end in /, as
319 ;; file-attributes will not recognize a symlink to a directory,
320 ;; so must make it a relative filename as ls does:
321 (if (eq (aref file (1- (length file))) ?/)
322 (setq file (substring file 0 -1)))
80ca5799 323 (let ((fattr (file-attributes file 'string)))
3f51f5a9
EZ
324 (if fattr
325 (insert (ls-lisp-format file fattr (nth 7 fattr)
326 switches time-index (current-time)))
327 (message "%s: doesn't exist or is inaccessible" file)
328 (ding) (sit-for 2))))) ; to show user the message!
329
330(defun ls-lisp-column-format (file-alist)
331 "Insert the file names (only) in FILE-ALIST into the current buffer.
332Format in columns, sorted vertically, following GNU ls -C.
333Responds to the window width as ls should but may not!"
334 (let (files fmt ncols collen (nfiles 0) (colwid 0))
335 ;; Count number of files as `nfiles', build list of filenames as
336 ;; `files', and find maximum filename length as `colwid':
337 (let (file len)
338 (while file-alist
339 (setq nfiles (1+ nfiles)
340 file (caar file-alist)
341 files (cons file files)
342 file-alist (cdr file-alist)
343 len (length file))
344 (if (> len colwid) (setq colwid len))))
345 (setq files (nreverse files)
346 colwid (+ 2 colwid) ; 2 character column gap
347 fmt (format "%%-%ds" colwid) ; print format
348 ncols (/ (window-width) colwid) ; no of columns
349 collen (/ nfiles ncols)) ; floor of column length
350 (if (> nfiles (* collen ncols)) (setq collen (1+ collen)))
351 ;; Output the file names in columns, sorted vertically:
352 (let ((i 0) j)
353 (while (< i collen)
354 (setq j i)
355 (while (< j nfiles)
356 (insert (format fmt (nth j files)))
357 (setq j (+ j collen)))
358 ;; FJW: This is completely unnecessary, but I don't like
359 ;; trailing white space...
360 (delete-region (point) (progn (skip-chars-backward " \t") (point)))
361 (insert ?\n)
362 (setq i (1+ i))))))
9dce08b6
RS
363
364(defun ls-lisp-delete-matching (regexp list)
3f51f5a9 365 "Delete all elements matching REGEXP from LIST, return new list."
d6d472d5 366 ;; Should perhaps use setcdr for efficiency.
6467926f
SK
367 (let (result)
368 (while list
3f51f5a9 369 (or (string-match regexp (caar list))
6467926f
SK
370 (setq result (cons (car list) result)))
371 (setq list (cdr list)))
372 result))
373
3f51f5a9
EZ
374(defsubst ls-lisp-string-lessp (s1 s2)
375 "Return t if string S1 is less than string S2 in lexicographic order.
376Case is significant if `ls-lisp-ignore-case' is nil.
377Unibyte strings are converted to multibyte for comparison."
378 (let ((u (compare-strings s1 0 nil s2 0 nil ls-lisp-ignore-case)))
379 (and (numberp u) (< u 0))))
380
9dce08b6 381(defun ls-lisp-handle-switches (file-alist switches)
3f51f5a9
EZ
382 "Return new FILE-ALIST sorted according to SWITCHES.
383SWITCHES is a list of characters. Default sorting is alphabetic."
6467926f 384 ;; FILE-ALIST's elements are (FILE . FILE-ATTRIBUTES).
3f51f5a9
EZ
385 (or (memq ?U switches) ; unsorted
386 ;; Catch and ignore unexpected sorting errors
387 (condition-case err
388 (setq file-alist
389 (let (index)
390 ;; Copy file-alist in case of error
391 (sort (copy-sequence file-alist) ; modifies its argument!
392 (cond ((memq ?S switches)
393 (lambda (x y) ; sorted on size
394 ;; 7th file attribute is file size
395 ;; Make largest file come first
396 (< (nth 7 (cdr y))
397 (nth 7 (cdr x)))))
398 ((setq index (ls-lisp-time-index switches))
399 (lambda (x y) ; sorted on time
400 (ls-lisp-time-lessp (nth index (cdr y))
401 (nth index (cdr x)))))
402 ((memq ?X switches)
403 (lambda (x y) ; sorted on extension
404 (ls-lisp-string-lessp
405 (ls-lisp-extension (car x))
406 (ls-lisp-extension (car y)))))
407 (t
408 (lambda (x y) ; sorted alphabetically
409 (ls-lisp-string-lessp (car x) (car y))))))))
410 (error (message "Unsorted (ls-lisp sorting error) - %s"
411 (error-message-string err))
412 (ding) (sit-for 2)))) ; to show user the message!
413 (if (memq ?F switches) ; classify switch
414 (setq file-alist (mapcar 'ls-lisp-classify file-alist)))
415 (if ls-lisp-dirs-first
416 ;; Re-sort directories first, without otherwise changing the
417 ;; ordering, and reverse whole list. cadr of each element of
418 ;; `file-alist' is t for directory, string (name linked to) for
419 ;; symbolic link, or nil.
420 (let (el dirs files)
421 (while file-alist
5eba3394
LH
422 (if (or (eq (cadr (setq el (car file-alist))) t) ; directory
423 (and (stringp (cadr el))
424 (file-directory-p (cadr el)))) ; symlink to a directory
3f51f5a9
EZ
425 (setq dirs (cons el dirs))
426 (setq files (cons el files)))
427 (setq file-alist (cdr file-alist)))
428 (setq file-alist
429 (if (memq ?U switches) ; unsorted order is reversed
430 (nconc dirs files)
431 (nconc files dirs)
432 ))))
433 ;; Finally reverse file alist if necessary.
434 ;; (eq below MUST compare `(not (memq ...))' to force comparison of
435 ;; `t' or `nil', rather than list tails!)
436 (if (eq (eq (not (memq ?U switches)) ; unsorted order is reversed
437 (not (memq ?r switches))) ; reversed sort order requested
438 ls-lisp-dirs-first) ; already reversed
439 (nreverse file-alist)
440 file-alist))
441
442(defun ls-lisp-classify (filedata)
443 "Append a character to each file name indicating the file type.
444Also, for regular files that are executable, append `*'.
445The file type indicators are `/' for directories, `@' for symbolic
446links, `|' for FIFOs, `=' for sockets, and nothing for regular files.
71bf3033 447\[But FIFOs and sockets are not recognized.]
3f51f5a9
EZ
448FILEDATA has the form (filename . `file-attributes'). Its `cadr' is t
449for directory, string (name linked to) for symbolic link, or nil."
5eba3394
LH
450 (let ((file-name (car filedata))
451 (type (cadr filedata)))
452 (cond (type
3f51f5a9 453 (cons
5eba3394 454 (concat file-name (if (eq type t) "/" "@"))
3f51f5a9
EZ
455 (cdr filedata)))
456 ((string-match "x" (nth 9 filedata))
457 (cons
458 (concat file-name "*")
459 (cdr filedata)))
460 (t filedata))))
461
462(defun ls-lisp-extension (filename)
463 "Return extension of FILENAME (ignoring any version extension)
464FOLLOWED by null and full filename, SOLELY for full alpha sort."
465 ;; Force extension sort order: `no ext' then `null ext' then `ext'
466 ;; to agree with GNU ls.
467 (concat
468 (let* ((i (length filename)) end)
469 (if (= (aref filename (1- i)) ?.) ; null extension
470 "\0"
471 (while (and (>= (setq i (1- i)) 0)
472 (/= (aref filename i) ?.)))
473 (if (< i 0) "\0\0" ; no extension
474 (if (/= (aref filename (1+ i)) ?~)
475 (substring filename (1+ i))
476 ;; version extension found -- ignore it
477 (setq end i)
478 (while (and (>= (setq i (1- i)) 0)
479 (/= (aref filename i) ?.)))
480 (if (< i 0) "\0\0" ; no extension
481 (substring filename (1+ i) end))))
482 )) "\0" filename))
d88c0e93 483
e54241c5 484;; From Roland McGrath. Can use this to sort on time.
9dce08b6 485(defun ls-lisp-time-lessp (time0 time1)
3f51f5a9
EZ
486 "Return t if time TIME0 is earlier than time TIME1."
487 (let ((hi0 (car time0)) (hi1 (car time1)))
e54241c5
SK
488 (or (< hi0 hi1)
489 (and (= hi0 hi1)
3f51f5a9
EZ
490 (< (cadr time0) (cadr time1))))))
491
492(defun ls-lisp-format (file-name file-attr file-size switches time-index now)
493 "Format one line of long ls output for file FILE-NAME.
494FILE-ATTR and FILE-SIZE give the file's attributes and size.
495SWITCHES, TIME-INDEX and NOW give the full switch list and time data."
496 (let ((file-type (nth 0 file-attr))
497 ;; t for directory, string (name linked to)
498 ;; for symbolic link, or nil.
499 (drwxrwxrwx (nth 8 file-attr))) ; attribute string ("drwxrwxrwx")
6467926f 500 (concat (if (memq ?i switches) ; inode number
3f51f5a9 501 (format " %6d" (nth 10 file-attr)))
d6d472d5 502 ;; nil is treated like "" in concat
6467926f 503 (if (memq ?s switches) ; size in K
3f51f5a9
EZ
504 (format " %4.0f" (fceiling (/ file-size 1024.0))))
505 drwxrwxrwx ; attribute string
506 (if (memq 'links ls-lisp-verbosity)
507 (format " %3d" (nth 1 file-attr))) ; link count
508 ;; Numeric uid/gid are more confusing than helpful;
6467926f 509 ;; Emacs should be able to make strings of them.
3f51f5a9
EZ
510 ;; They tend to be bogus on non-UNIX platforms anyway so
511 ;; optionally hide them.
512 (if (memq 'uid ls-lisp-verbosity)
80ca5799 513 ;; uid can be a sting or an integer
3f51f5a9 514 (let ((uid (nth 2 file-attr)))
80ca5799 515 (format (if (stringp uid) " %-8s" " %-8d") uid)))
3f51f5a9
EZ
516 (if (not (memq ?G switches)) ; GNU ls -- shows group by default
517 (if (or (memq ?g switches) ; UNIX ls -- no group by default
518 (memq 'gid ls-lisp-verbosity))
80ca5799
LH
519 (let ((gid (nth 3 file-attr)))
520 (format (if (stringp gid) " %-8s" " %-8d") gid))))
a3723f13 521 (ls-lisp-format-file-size file-size (memq ?h switches))
3f51f5a9
EZ
522 " "
523 (ls-lisp-format-time file-attr time-index now)
738eb4e7 524 " "
b3df990b 525 (propertize file-name 'dired-filename t)
d88c0e93 526 (if (stringp file-type) ; is a symbolic link
3f51f5a9 527 (concat " -> " file-type))
d88c0e93
SK
528 "\n"
529 )))
530
9dce08b6 531(defun ls-lisp-time-index (switches)
3f51f5a9
EZ
532 "Return time index into file-attributes according to ls SWITCHES list.
533Return nil if no time switch found."
534 ;; FJW: Default of nil is IMPORTANT and used in `ls-lisp-handle-switches'!
535 (cond ((memq ?c switches) 6) ; last mode change
536 ((memq ?t switches) 5) ; last modtime
537 ((memq ?u switches) 4))) ; last access
538
d81a647c
PE
539(defun ls-lisp-time-to-seconds (time)
540 "Convert TIME to a floating point number."
541 (+ (* (car time) 65536.0)
542 (cadr time)
543 (/ (or (nth 2 time) 0) 1000000.0)))
544
3f51f5a9
EZ
545(defun ls-lisp-format-time (file-attr time-index now)
546 "Format time for file with attributes FILE-ATTR according to TIME-INDEX.
547Use the same method as ls to decide whether to show time-of-day or year,
548depending on distance between file date and NOW.
549All ls time options, namely c, t and u, are handled."
550 (let* ((time (nth (or time-index 5) file-attr)) ; default is last modtime
d81a647c
PE
551 (diff (- (ls-lisp-time-to-seconds time)
552 (ls-lisp-time-to-seconds now)))
553 ;; Consider a time to be recent if it is within the past six
554 ;; months. A Gregorian year has 365.2425 * 24 * 60 * 60 ==
555 ;; 31556952 seconds on the average, and half of that is 15778476.
556 ;; Write the constant explicitly to avoid roundoff error.
557 (past-cutoff -15778476)) ; half a Gregorian year
f8a10234 558 (condition-case nil
d81a647c
PE
559 ;; Use traditional time format in the C or POSIX locale,
560 ;; ISO-style time format otherwise, so columns line up.
561 (let ((locale system-time-locale))
562 (if (not locale)
563 (let ((vars '("LC_ALL" "LC_TIME" "LANG")))
564 (while (and vars (not (setq locale (getenv (car vars)))))
565 (setq vars (cdr vars)))))
566 (if (member locale '("C" "POSIX"))
567 (setq locale nil))
568 (format-time-string
569 (if (and (<= past-cutoff diff) (<= diff 0))
2686cdc0
RS
570 (if locale "%m-%d %H:%M" (nth 0 ls-lisp-format-time-list))
571 (if locale "%Y-%m-%d " (nth 1 ls-lisp-format-time-list)))
d81a647c 572 time))
452e47d7 573 (error "Unk 0 0000"))))
738eb4e7 574
a3723f13
JB
575(defun ls-lisp-format-file-size (file-size human-readable)
576 (if (or (not human-readable)
577 (< file-size 1024))
e0d47340 578 (format (if (floatp file-size) " %9.0f" " %9d") file-size)
a3723f13
JB
579 (do ((file-size (/ file-size 1024.0) (/ file-size 1024.0))
580 ;; kilo, mega, giga, tera, peta, exa
581 (post-fixes (list "k" "M" "G" "T" "P" "E") (cdr post-fixes)))
e0d47340 582 ((< file-size 1024) (format " %8.0f%s" file-size (car post-fixes))))))
a3723f13 583
9dce08b6 584(provide 'ls-lisp)
738eb4e7 585
ab5796a9 586;;; arch-tag: e55f399b-05ec-425c-a6d5-f5e349c35ab4
76550a57 587;;; ls-lisp.el ends here