*** empty log message ***
[bpt/emacs.git] / lisp / ls-lisp.el
CommitLineData
76550a57
ER
1;;; ls-lisp.el --- emulate insert-directory completely in Emacs Lisp
2
c90f2757 3;; Copyright (C) 1992, 1994, 2000, 2001, 2002, 2003, 2004,
d7a0267c 4;; 2005, 2006, 2007 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.
ea88e775
EZ
154These specs are used ONLY if a valid locale can not be determined.
155
156If `ls-lisp-use-localized-time-format' is non-nil, these specs are used
157regardless of whether the locale can be determined.
2686cdc0
RS
158
159Syntax: (EARLY-TIME-FORMAT OLD-TIME-FORMAT)
160
161The EARLY-TIME-FORMAT is used if file has been modified within the
162current year. The OLD-TIME-FORMAT is used for older files. To use ISO
1638601 dates, you could set:
164
165\(setq ls-lisp-format-time-list
166 '(\"%Y-%m-%d %H:%M\"
167 \"%Y-%m-%d \"))"
401c1968
MR
168 :type '(list (string :tag "Early time format")
169 (string :tag "Old time format"))
2686cdc0
RS
170 :group 'ls-lisp)
171
ea88e775
EZ
172(defcustom ls-lisp-use-localized-time-format nil
173 "*Non-nil causes ls-lisp to use `ls-lisp-format-time-list' even if
174a valid locale is specified.
175
176WARNING: Using localized date/time format might cause Dired columns
177to fail to lign up, e.g. if month names are not all of the same length."
178 :type 'boolean
179 :group 'ls-lisp)
180
44a9ca8b
RS
181(defvar original-insert-directory nil
182 "This holds the original function definition of `insert-directory'.")
183
3f51f5a9
EZ
184;; Remember the original insert-directory function
185(or (featurep 'ls-lisp) ; FJW: unless this file is being reloaded!
44a9ca8b 186 (setq original-insert-directory (symbol-function 'insert-directory)))
3f51f5a9 187
3f51f5a9
EZ
188\f
189;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
0cb0ba6c
GV
190
191(defun insert-directory (file switches &optional wildcard full-directory-p)
192 "Insert directory listing for FILE, formatted according to SWITCHES.
193Leaves point after the inserted text.
194SWITCHES may be a string of options, or a list of strings.
195Optional third arg WILDCARD means treat FILE as shell wildcard.
196Optional fourth arg FULL-DIRECTORY-P means file is a directory and
197switches do not contain `d', so that a full listing is expected.
198
3f51f5a9
EZ
199This version of the function comes from `ls-lisp.el'.
200If the value of `ls-lisp-use-insert-directory-program' is non-nil then
201it works exactly like the version from `files.el' and runs a directory
202listing program whose name is in the variable
203`insert-directory-program'; if also WILDCARD is non-nil then it runs
204the shell specified by `shell-file-name'. If the value of
205`ls-lisp-use-insert-directory-program' is nil then it runs a Lisp
206emulation.
207
208The Lisp emulation does not run any external programs or shells. It
209supports ordinary shell wildcards if `ls-lisp-support-shell-wildcards'
210is non-nil; otherwise, it interprets wildcards as regular expressions
211to match file names. It does not support all `ls' switches -- those
212that work are: A a c i r S s t u U X g G B C R and F partly."
0cb0ba6c 213 (if ls-lisp-use-insert-directory-program
44a9ca8b
RS
214 (funcall original-insert-directory
215 file switches wildcard full-directory-p)
3f51f5a9
EZ
216 ;; We need the directory in order to find the right handler.
217 (let ((handler (find-file-name-handler (expand-file-name file)
94e72368
RS
218 'insert-directory))
219 wildcard-regexp)
3f51f5a9
EZ
220 (if handler
221 (funcall handler 'insert-directory file switches
222 wildcard full-directory-p)
d4939c66
JPW
223 ;; Remove --dired switch
224 (if (string-match "--dired " switches)
225 (setq switches (replace-match "" nil nil switches)))
3f51f5a9
EZ
226 ;; Convert SWITCHES to a list of characters.
227 (setq switches (delete ?- (append switches nil)))
94e72368
RS
228 ;; Sometimes we get ".../foo*/" as FILE. While the shell and
229 ;; `ls' don't mind, we certainly do, because it makes us think
230 ;; there is no wildcard, only a directory name.
231 (if (and ls-lisp-support-shell-wildcards
232 (string-match "[[?*]" file))
233 (progn
234 (or (not (eq (aref file (1- (length file))) ?/))
235 (setq file (substring file 0 (1- (length file)))))
236 (setq wildcard t)))
3f51f5a9 237 (if wildcard
94e72368 238 (setq wildcard-regexp
3f51f5a9
EZ
239 (if ls-lisp-support-shell-wildcards
240 (wildcard-to-regexp (file-name-nondirectory file))
241 (file-name-nondirectory file))
242 file (file-name-directory file))
94e72368 243 (if (memq ?B switches) (setq wildcard-regexp "[^~]\\'")))
3f51f5a9
EZ
244 (ls-lisp-insert-directory
245 file switches (ls-lisp-time-index switches)
94e72368 246 wildcard-regexp full-directory-p)
7f1b5edc
EZ
247 ;; Try to insert the amount of free space.
248 (save-excursion
249 (goto-char (point-min))
250 ;; First find the line to put it on.
251 (when (re-search-forward "^total" nil t)
252 (let ((available (get-free-disk-space ".")))
253 (when available
7ad0c1c3
EZ
254 ;; Replace "total" with "total used", to avoid confusion.
255 (replace-match "total used in directory")
7f1b5edc
EZ
256 (end-of-line)
257 (insert " available " available)))))))))
3f51f5a9
EZ
258
259(defun ls-lisp-insert-directory
94e72368 260 (file switches time-index wildcard-regexp full-directory-p)
3045b163 261 "Insert directory listing for FILE, formatted according to SWITCHES.
3f51f5a9
EZ
262Leaves point after the inserted text. This is an internal function
263optionally called by the `ls-lisp.el' version of `insert-directory'.
264It is called recursively if the -R switch is used.
265SWITCHES is a *list* of characters. TIME-INDEX is the time index into
94e72368 266file-attributes according to SWITCHES. WILDCARD-REGEXP is nil or an *Emacs
3f51f5a9
EZ
267regexp*. FULL-DIRECTORY-P means file is a directory and SWITCHES does
268not contain `d', so that a full listing is expected."
94e72368 269 (if (or wildcard-regexp full-directory-p)
3f51f5a9
EZ
270 (let* ((dir (file-name-as-directory file))
271 (default-directory dir) ; so that file-attributes works
272 (file-alist
80ca5799 273 (directory-files-and-attributes dir nil wildcard-regexp t 'string))
3f51f5a9
EZ
274 (now (current-time))
275 (sum 0)
276 ;; do all bindings here for speed
277 total-line files elt short file-size fil attr)
278 (cond ((memq ?A switches)
279 (setq file-alist
280 (ls-lisp-delete-matching "^\\.\\.?$" file-alist)))
281 ((not (memq ?a switches))
282 ;; if neither -A nor -a, flush . files
283 (setq file-alist
284 (ls-lisp-delete-matching "^\\." file-alist))))
285 (setq file-alist
286 (ls-lisp-handle-switches file-alist switches))
287 (if (memq ?C switches) ; column (-C) format
288 (ls-lisp-column-format file-alist)
289 (setq total-line (cons (point) (car-safe file-alist)))
290 (setq files file-alist)
291 (while files ; long (-l) format
292 (setq elt (car files)
293 files (cdr files)
294 short (car elt)
295 attr (cdr elt)
296 file-size (nth 7 attr))
297 (and attr
298 (setq sum (+ file-size
299 ;; Even if neither SUM nor file's size
300 ;; overflow, their sum could.
301 (if (or (< sum (- 134217727 file-size))
302 (floatp sum)
303 (floatp file-size))
304 sum
305 (float sum))))
306 (insert (ls-lisp-format short attr file-size
307 switches time-index now))))
308 ;; Insert total size of all files:
309 (save-excursion
310 (goto-char (car total-line))
311 (or (cdr total-line)
312 ;; Shell says ``No match'' if no files match
313 ;; the wildcard; let's say something similar.
314 (insert "(No match)\n"))
315 (insert (format "total %.0f\n" (fceiling (/ sum 1024.0))))))
316 (if (memq ?R switches)
317 ;; List the contents of all directories recursively.
318 ;; cadr of each element of `file-alist' is t for
319 ;; directory, string (name linked to) for symbolic
320 ;; link, or nil.
9dce08b6
RS
321 (while file-alist
322 (setq elt (car file-alist)
3f51f5a9
EZ
323 file-alist (cdr file-alist))
324 (when (and (eq (cadr elt) t) ; directory
325 (not (string-match "\\`\\.\\.?\\'" (car elt))))
326 (setq elt (expand-file-name (car elt) dir))
327 (insert "\n" elt ":\n")
328 (ls-lisp-insert-directory
94e72368 329 elt switches time-index wildcard-regexp full-directory-p)))))
3f51f5a9
EZ
330 ;; If not full-directory-p, FILE *must not* end in /, as
331 ;; file-attributes will not recognize a symlink to a directory,
332 ;; so must make it a relative filename as ls does:
333 (if (eq (aref file (1- (length file))) ?/)
334 (setq file (substring file 0 -1)))
80ca5799 335 (let ((fattr (file-attributes file 'string)))
3f51f5a9
EZ
336 (if fattr
337 (insert (ls-lisp-format file fattr (nth 7 fattr)
338 switches time-index (current-time)))
339 (message "%s: doesn't exist or is inaccessible" file)
340 (ding) (sit-for 2))))) ; to show user the message!
341
342(defun ls-lisp-column-format (file-alist)
343 "Insert the file names (only) in FILE-ALIST into the current buffer.
344Format in columns, sorted vertically, following GNU ls -C.
345Responds to the window width as ls should but may not!"
346 (let (files fmt ncols collen (nfiles 0) (colwid 0))
347 ;; Count number of files as `nfiles', build list of filenames as
348 ;; `files', and find maximum filename length as `colwid':
349 (let (file len)
350 (while file-alist
351 (setq nfiles (1+ nfiles)
352 file (caar file-alist)
353 files (cons file files)
354 file-alist (cdr file-alist)
355 len (length file))
356 (if (> len colwid) (setq colwid len))))
357 (setq files (nreverse files)
358 colwid (+ 2 colwid) ; 2 character column gap
359 fmt (format "%%-%ds" colwid) ; print format
360 ncols (/ (window-width) colwid) ; no of columns
361 collen (/ nfiles ncols)) ; floor of column length
362 (if (> nfiles (* collen ncols)) (setq collen (1+ collen)))
363 ;; Output the file names in columns, sorted vertically:
364 (let ((i 0) j)
365 (while (< i collen)
366 (setq j i)
367 (while (< j nfiles)
368 (insert (format fmt (nth j files)))
369 (setq j (+ j collen)))
370 ;; FJW: This is completely unnecessary, but I don't like
371 ;; trailing white space...
372 (delete-region (point) (progn (skip-chars-backward " \t") (point)))
373 (insert ?\n)
374 (setq i (1+ i))))))
9dce08b6
RS
375
376(defun ls-lisp-delete-matching (regexp list)
3f51f5a9 377 "Delete all elements matching REGEXP from LIST, return new list."
d6d472d5 378 ;; Should perhaps use setcdr for efficiency.
6467926f
SK
379 (let (result)
380 (while list
3f51f5a9 381 (or (string-match regexp (caar list))
6467926f
SK
382 (setq result (cons (car list) result)))
383 (setq list (cdr list)))
384 result))
385
3f51f5a9
EZ
386(defsubst ls-lisp-string-lessp (s1 s2)
387 "Return t if string S1 is less than string S2 in lexicographic order.
388Case is significant if `ls-lisp-ignore-case' is nil.
389Unibyte strings are converted to multibyte for comparison."
390 (let ((u (compare-strings s1 0 nil s2 0 nil ls-lisp-ignore-case)))
391 (and (numberp u) (< u 0))))
392
9dce08b6 393(defun ls-lisp-handle-switches (file-alist switches)
3f51f5a9
EZ
394 "Return new FILE-ALIST sorted according to SWITCHES.
395SWITCHES is a list of characters. Default sorting is alphabetic."
6467926f 396 ;; FILE-ALIST's elements are (FILE . FILE-ATTRIBUTES).
3f51f5a9
EZ
397 (or (memq ?U switches) ; unsorted
398 ;; Catch and ignore unexpected sorting errors
399 (condition-case err
400 (setq file-alist
401 (let (index)
402 ;; Copy file-alist in case of error
403 (sort (copy-sequence file-alist) ; modifies its argument!
404 (cond ((memq ?S switches)
405 (lambda (x y) ; sorted on size
406 ;; 7th file attribute is file size
407 ;; Make largest file come first
408 (< (nth 7 (cdr y))
409 (nth 7 (cdr x)))))
410 ((setq index (ls-lisp-time-index switches))
411 (lambda (x y) ; sorted on time
412 (ls-lisp-time-lessp (nth index (cdr y))
413 (nth index (cdr x)))))
414 ((memq ?X switches)
415 (lambda (x y) ; sorted on extension
416 (ls-lisp-string-lessp
417 (ls-lisp-extension (car x))
418 (ls-lisp-extension (car y)))))
419 (t
420 (lambda (x y) ; sorted alphabetically
421 (ls-lisp-string-lessp (car x) (car y))))))))
422 (error (message "Unsorted (ls-lisp sorting error) - %s"
423 (error-message-string err))
424 (ding) (sit-for 2)))) ; to show user the message!
425 (if (memq ?F switches) ; classify switch
426 (setq file-alist (mapcar 'ls-lisp-classify file-alist)))
427 (if ls-lisp-dirs-first
428 ;; Re-sort directories first, without otherwise changing the
429 ;; ordering, and reverse whole list. cadr of each element of
430 ;; `file-alist' is t for directory, string (name linked to) for
431 ;; symbolic link, or nil.
432 (let (el dirs files)
433 (while file-alist
5eba3394
LH
434 (if (or (eq (cadr (setq el (car file-alist))) t) ; directory
435 (and (stringp (cadr el))
436 (file-directory-p (cadr el)))) ; symlink to a directory
3f51f5a9
EZ
437 (setq dirs (cons el dirs))
438 (setq files (cons el files)))
439 (setq file-alist (cdr file-alist)))
440 (setq file-alist
441 (if (memq ?U switches) ; unsorted order is reversed
442 (nconc dirs files)
443 (nconc files dirs)
444 ))))
445 ;; Finally reverse file alist if necessary.
446 ;; (eq below MUST compare `(not (memq ...))' to force comparison of
447 ;; `t' or `nil', rather than list tails!)
448 (if (eq (eq (not (memq ?U switches)) ; unsorted order is reversed
449 (not (memq ?r switches))) ; reversed sort order requested
450 ls-lisp-dirs-first) ; already reversed
451 (nreverse file-alist)
452 file-alist))
453
454(defun ls-lisp-classify (filedata)
455 "Append a character to each file name indicating the file type.
456Also, for regular files that are executable, append `*'.
457The file type indicators are `/' for directories, `@' for symbolic
458links, `|' for FIFOs, `=' for sockets, and nothing for regular files.
71bf3033 459\[But FIFOs and sockets are not recognized.]
3f51f5a9
EZ
460FILEDATA has the form (filename . `file-attributes'). Its `cadr' is t
461for directory, string (name linked to) for symbolic link, or nil."
5eba3394
LH
462 (let ((file-name (car filedata))
463 (type (cadr filedata)))
464 (cond (type
3f51f5a9 465 (cons
5eba3394 466 (concat file-name (if (eq type t) "/" "@"))
3f51f5a9
EZ
467 (cdr filedata)))
468 ((string-match "x" (nth 9 filedata))
469 (cons
470 (concat file-name "*")
471 (cdr filedata)))
472 (t filedata))))
473
474(defun ls-lisp-extension (filename)
475 "Return extension of FILENAME (ignoring any version extension)
476FOLLOWED by null and full filename, SOLELY for full alpha sort."
477 ;; Force extension sort order: `no ext' then `null ext' then `ext'
478 ;; to agree with GNU ls.
479 (concat
480 (let* ((i (length filename)) end)
481 (if (= (aref filename (1- i)) ?.) ; null extension
482 "\0"
483 (while (and (>= (setq i (1- i)) 0)
484 (/= (aref filename i) ?.)))
485 (if (< i 0) "\0\0" ; no extension
486 (if (/= (aref filename (1+ i)) ?~)
487 (substring filename (1+ i))
488 ;; version extension found -- ignore it
489 (setq end i)
490 (while (and (>= (setq i (1- i)) 0)
491 (/= (aref filename i) ?.)))
492 (if (< i 0) "\0\0" ; no extension
493 (substring filename (1+ i) end))))
494 )) "\0" filename))
d88c0e93 495
e54241c5 496;; From Roland McGrath. Can use this to sort on time.
9dce08b6 497(defun ls-lisp-time-lessp (time0 time1)
3f51f5a9
EZ
498 "Return t if time TIME0 is earlier than time TIME1."
499 (let ((hi0 (car time0)) (hi1 (car time1)))
e54241c5
SK
500 (or (< hi0 hi1)
501 (and (= hi0 hi1)
3f51f5a9
EZ
502 (< (cadr time0) (cadr time1))))))
503
504(defun ls-lisp-format (file-name file-attr file-size switches time-index now)
505 "Format one line of long ls output for file FILE-NAME.
506FILE-ATTR and FILE-SIZE give the file's attributes and size.
507SWITCHES, TIME-INDEX and NOW give the full switch list and time data."
508 (let ((file-type (nth 0 file-attr))
509 ;; t for directory, string (name linked to)
510 ;; for symbolic link, or nil.
511 (drwxrwxrwx (nth 8 file-attr))) ; attribute string ("drwxrwxrwx")
6467926f 512 (concat (if (memq ?i switches) ; inode number
3f51f5a9 513 (format " %6d" (nth 10 file-attr)))
d6d472d5 514 ;; nil is treated like "" in concat
6467926f 515 (if (memq ?s switches) ; size in K
3f51f5a9
EZ
516 (format " %4.0f" (fceiling (/ file-size 1024.0))))
517 drwxrwxrwx ; attribute string
518 (if (memq 'links ls-lisp-verbosity)
519 (format " %3d" (nth 1 file-attr))) ; link count
520 ;; Numeric uid/gid are more confusing than helpful;
6467926f 521 ;; Emacs should be able to make strings of them.
3f51f5a9
EZ
522 ;; They tend to be bogus on non-UNIX platforms anyway so
523 ;; optionally hide them.
524 (if (memq 'uid ls-lisp-verbosity)
80ca5799 525 ;; uid can be a sting or an integer
3f51f5a9 526 (let ((uid (nth 2 file-attr)))
80ca5799 527 (format (if (stringp uid) " %-8s" " %-8d") uid)))
3f51f5a9
EZ
528 (if (not (memq ?G switches)) ; GNU ls -- shows group by default
529 (if (or (memq ?g switches) ; UNIX ls -- no group by default
530 (memq 'gid ls-lisp-verbosity))
80ca5799
LH
531 (let ((gid (nth 3 file-attr)))
532 (format (if (stringp gid) " %-8s" " %-8d") gid))))
a3723f13 533 (ls-lisp-format-file-size file-size (memq ?h switches))
3f51f5a9
EZ
534 " "
535 (ls-lisp-format-time file-attr time-index now)
738eb4e7 536 " "
b3df990b 537 (propertize file-name 'dired-filename t)
d88c0e93 538 (if (stringp file-type) ; is a symbolic link
3f51f5a9 539 (concat " -> " file-type))
d88c0e93
SK
540 "\n"
541 )))
542
9dce08b6 543(defun ls-lisp-time-index (switches)
3f51f5a9
EZ
544 "Return time index into file-attributes according to ls SWITCHES list.
545Return nil if no time switch found."
546 ;; FJW: Default of nil is IMPORTANT and used in `ls-lisp-handle-switches'!
547 (cond ((memq ?c switches) 6) ; last mode change
548 ((memq ?t switches) 5) ; last modtime
549 ((memq ?u switches) 4))) ; last access
550
d81a647c
PE
551(defun ls-lisp-time-to-seconds (time)
552 "Convert TIME to a floating point number."
553 (+ (* (car time) 65536.0)
554 (cadr time)
555 (/ (or (nth 2 time) 0) 1000000.0)))
556
3f51f5a9
EZ
557(defun ls-lisp-format-time (file-attr time-index now)
558 "Format time for file with attributes FILE-ATTR according to TIME-INDEX.
559Use the same method as ls to decide whether to show time-of-day or year,
560depending on distance between file date and NOW.
561All ls time options, namely c, t and u, are handled."
562 (let* ((time (nth (or time-index 5) file-attr)) ; default is last modtime
d81a647c
PE
563 (diff (- (ls-lisp-time-to-seconds time)
564 (ls-lisp-time-to-seconds now)))
565 ;; Consider a time to be recent if it is within the past six
566 ;; months. A Gregorian year has 365.2425 * 24 * 60 * 60 ==
567 ;; 31556952 seconds on the average, and half of that is 15778476.
568 ;; Write the constant explicitly to avoid roundoff error.
569 (past-cutoff -15778476)) ; half a Gregorian year
f8a10234 570 (condition-case nil
d81a647c
PE
571 ;; Use traditional time format in the C or POSIX locale,
572 ;; ISO-style time format otherwise, so columns line up.
573 (let ((locale system-time-locale))
574 (if (not locale)
575 (let ((vars '("LC_ALL" "LC_TIME" "LANG")))
576 (while (and vars (not (setq locale (getenv (car vars)))))
577 (setq vars (cdr vars)))))
578 (if (member locale '("C" "POSIX"))
579 (setq locale nil))
580 (format-time-string
581 (if (and (<= past-cutoff diff) (<= diff 0))
ea88e775
EZ
582 (if (and locale (not ls-lisp-use-localized-time-format))
583 "%m-%d %H:%M"
584 (nth 0 ls-lisp-format-time-list))
585 (if (and locale (not ls-lisp-use-localized-time-format))
586 "%Y-%m-%d "
587 (nth 1 ls-lisp-format-time-list)))
d81a647c 588 time))
452e47d7 589 (error "Unk 0 0000"))))
738eb4e7 590
a3723f13
JB
591(defun ls-lisp-format-file-size (file-size human-readable)
592 (if (or (not human-readable)
593 (< file-size 1024))
e0d47340 594 (format (if (floatp file-size) " %9.0f" " %9d") file-size)
a3723f13
JB
595 (do ((file-size (/ file-size 1024.0) (/ file-size 1024.0))
596 ;; kilo, mega, giga, tera, peta, exa
597 (post-fixes (list "k" "M" "G" "T" "P" "E") (cdr post-fixes)))
e0d47340 598 ((< file-size 1024) (format " %8.0f%s" file-size (car post-fixes))))))
a3723f13 599
9dce08b6 600(provide 'ls-lisp)
738eb4e7 601
ab5796a9 602;;; arch-tag: e55f399b-05ec-425c-a6d5-f5e349c35ab4
76550a57 603;;; ls-lisp.el ends here