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