;;; ls-lisp.el --- emulate insert-directory completely in Emacs Lisp
-;; Copyright (C) 1992, 1994, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 1994, 2000-2013 Free Software Foundation, Inc.
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
;; Modified by: Francis J. Wright <F.J.Wright@maths.qmw.ac.uk>
;; Maintainer: FSF
;; Keywords: unix, dired
+;; Package: emacs
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; OVERVIEW ==========================================================
-;; This file redefines the function `insert-directory' to implement it
-;; directly from Emacs lisp, without running ls in a subprocess. It
-;; is useful if you cannot afford to fork Emacs on a real memory UNIX,
-;; under VMS or other non-UNIX platforms if you don't have the ls
-;; program, or if you want a different format from what ls offers.
+;; This file advises the function `insert-directory' to implement it
+;; directly from Emacs lisp, without running ls in a subprocess.
+;; This is useful if you don't have ls installed (ie, on MS Windows).
;; This function can use regexps instead of shell wildcards. If you
;; enter regexps remember to double each $ sign. For example, to
;;; Code:
-(eval-when-compile (require 'cl))
-
(defgroup ls-lisp nil
"Emulate the ls program completely in Emacs Lisp."
:version "21.1"
:group 'dired)
+(defun ls-lisp-set-options ()
+ "Reset the ls-lisp options that depend on `ls-lisp-emulation'."
+ (mapc 'custom-reevaluate-setting
+ '(ls-lisp-ignore-case ls-lisp-dirs-first ls-lisp-verbosity)))
+
(defcustom ls-lisp-emulation
- (cond ((eq system-type 'macos) 'MacOS)
- ;; ((eq system-type 'windows-nt) 'MS-Windows)
- ((memq system-type
- '(hpux dgux usg-unix-v unisoft-unix rtu irix berkeley-unix))
- 'UNIX)) ; very similar to GNU
+ (cond ;; ((eq system-type 'windows-nt) 'MS-Windows)
+ ((memq system-type '(hpux usg-unix-v irix berkeley-unix))
+ 'UNIX)) ; very similar to GNU
;; Anything else defaults to nil, meaning GNU.
- "*Platform to emulate: GNU (default), MacOS, MS-Windows, UNIX.
-Corresponding value is one of the atoms: nil, MacOS, MS-Windows, UNIX.
-Sets default values for: `ls-lisp-ignore-case', `ls-lisp-dirs-first',
-`ls-lisp-verbosity'. Need not match actual platform. Changing this
-option will have no effect until you restart Emacs."
+ "Platform to emulate: GNU (default), MacOS, MS-Windows, UNIX.
+Corresponding value is one of: nil, `MacOS', `MS-Windows', `UNIX'.
+Set this to your preferred value; it need not match the actual platform
+you are using.
+
+This variable does not affect the behavior of ls-lisp directly.
+Rather, it controls the default values for some variables that do:
+`ls-lisp-ignore-case', `ls-lisp-dirs-first', and `ls-lisp-verbosity'.
+
+If you change this variable directly (without using customize)
+after loading `ls-lisp', you should use `ls-lisp-set-options' to
+update the dependent variables."
:type '(choice (const :tag "GNU" nil)
(const MacOS)
(const MS-Windows)
(const UNIX))
+ :initialize 'custom-initialize-default
+ :set (lambda (symbol value)
+ (unless (equal value (eval symbol))
+ (custom-set-default symbol value)
+ (ls-lisp-set-options)))
:group 'ls-lisp)
+;; Only made an obsolete alias in 23.3. Before that, the initial
+;; value was set according to:
+;; (or (memq ls-lisp-emulation '(MS-Windows MacOS))
+;; (and (boundp 'ls-lisp-dired-ignore-case) ls-lisp-dired-ignore-case))
+;; Which isn't the right thing to do.
+(define-obsolete-variable-alias 'ls-lisp-dired-ignore-case
+ 'ls-lisp-ignore-case "21.1")
+
(defcustom ls-lisp-ignore-case
- ;; Name change for consistency with other option names.
- (or (memq ls-lisp-emulation '(MS-Windows MacOS))
- (and (boundp 'ls-lisp-dired-ignore-case) ls-lisp-dired-ignore-case))
- "*Non-nil causes ls-lisp alphabetic sorting to ignore case."
+ (memq ls-lisp-emulation '(MS-Windows MacOS))
+ "Non-nil causes ls-lisp alphabetic sorting to ignore case."
+ :set-after '(ls-lisp-emulation)
:type 'boolean
:group 'ls-lisp)
(defcustom ls-lisp-dirs-first (eq ls-lisp-emulation 'MS-Windows)
- "*Non-nil causes ls-lisp to sort directories first in any ordering.
+ "Non-nil causes ls-lisp to sort directories first in any ordering.
\(Or last if it is reversed.) Follows Microsoft Windows Explorer."
;; Functionality suggested by Chris McMahan <cmcmahan@one.net>
+ :set-after '(ls-lisp-emulation)
:type 'boolean
:group 'ls-lisp)
'(links))) ; distinguish NT/2K from 9x
((eq ls-lisp-emulation 'UNIX) '(links uid)) ; UNIX ls
(t '(links uid gid))) ; GNU ls
- "*A list of optional file attributes that ls-lisp should display.
+ "A list of optional file attributes that ls-lisp should display.
It should contain none or more of the symbols: links, uid, gid.
A value of nil (or an empty list) means display none of them.
Concepts come from UNIX: `links' means count of names associated with
-the file\; `uid' means user (owner) identifier\; `gid' means group
+the file; `uid' means user (owner) identifier; `gid' means group
identifier.
-If emulation is MacOS then default is nil\;
+If emulation is MacOS then default is nil;
if emulation is MS-Windows then default is `(links)' if platform is
-Windows NT/2K, nil otherwise\;
-if emulation is UNIX then default is `(links uid)'\;
+Windows NT/2K, nil otherwise;
+if emulation is UNIX then default is `(links uid)';
if emulation is GNU then default is `(links uid gid)'."
+ :set-after '(ls-lisp-emulation)
;; Functionality suggested by Howard Melman <howard@silverstream.com>
:type '(set (const :tag "Show Link Count" links)
(const :tag "Show User" uid)
:group 'ls-lisp)
(defcustom ls-lisp-use-insert-directory-program
- (not (memq system-type '(macos ms-dos windows-nt)))
- "*Non-nil causes ls-lisp to revert back to using `insert-directory-program'.
+ (not (memq system-type '(ms-dos windows-nt)))
+ "Non-nil causes ls-lisp to revert back to using `insert-directory-program'.
This is useful on platforms where ls-lisp is dumped into Emacs, such as
Microsoft Windows, but you would still like to use a program to list
the contents of a directory."
;;; Autoloaded because it is let-bound in `recover-session', `mail-recover-1'.
;;;###autoload
(defcustom ls-lisp-support-shell-wildcards t
- "*Non-nil means ls-lisp treats file patterns as shell wildcards.
+ "Non-nil means ls-lisp treats file patterns as shell wildcards.
Otherwise they are treated as Emacs regexps (for backward compatibility)."
:type 'boolean
:group 'ls-lisp)
(defcustom ls-lisp-format-time-list
'("%b %e %H:%M"
"%b %e %Y")
- "*List of `format-time-string' specs to display file time stamps.
+ "List of `format-time-string' specs to display file time stamps.
These specs are used ONLY if a valid locale can not be determined.
If `ls-lisp-use-localized-time-format' is non-nil, these specs are used
Syntax: (EARLY-TIME-FORMAT OLD-TIME-FORMAT)
The EARLY-TIME-FORMAT is used if file has been modified within the
-current year. The OLD-TIME-FORMAT is used for older files. To use ISO
+current year. The OLD-TIME-FORMAT is used for older files. To use ISO
8601 dates, you could set:
\(setq ls-lisp-format-time-list
:group 'ls-lisp)
(defcustom ls-lisp-use-localized-time-format nil
- "*Non-nil causes ls-lisp to use `ls-lisp-format-time-list' even if
-a valid locale is specified.
+ "Non-nil means to always use `ls-lisp-format-time-list' for time stamps.
+This applies even if a valid locale is specified.
WARNING: Using localized date/time format might cause Dired columns
-to fail to lign up, e.g. if month names are not all of the same length."
+to fail to line up, e.g. if month names are not all of the same length."
:type 'boolean
:group 'ls-lisp)
-(defvar original-insert-directory nil
- "This holds the original function definition of `insert-directory'.")
-
-;; Remember the original insert-directory function
-(or (featurep 'ls-lisp) ; FJW: unless this file is being reloaded!
- (setq original-insert-directory (symbol-function 'insert-directory)))
-
+(defvar ls-lisp-uid-d-fmt "-%d"
+ "Format to display integer UIDs.")
+(defvar ls-lisp-uid-s-fmt "-%s"
+ "Format to display user names.")
+(defvar ls-lisp-gid-d-fmt "-%d"
+ "Format to display integer GIDs.")
+(defvar ls-lisp-gid-s-fmt "-%s"
+ "Format to display user group names.")
+(defvar ls-lisp-filesize-d-fmt "%d"
+ "Format to display integer file sizes.")
+(defvar ls-lisp-filesize-f-fmt "%.0f"
+ "Format to display float file sizes.")
+(defvar ls-lisp-filesize-b-fmt "%.0f"
+ "Format to display file sizes in blocks (for the -s switch).")
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun insert-directory (file switches &optional wildcard full-directory-p)
+(defun ls-lisp--insert-directory (orig-fun file switches &optional wildcard full-directory-p)
"Insert directory listing for FILE, formatted according to SWITCHES.
Leaves point after the inserted text.
SWITCHES may be a string of options, or a list of strings.
This version of the function comes from `ls-lisp.el'.
If the value of `ls-lisp-use-insert-directory-program' is non-nil then
-it works exactly like the version from `files.el' and runs a directory
-listing program whose name is in the variable
-`insert-directory-program'; if also WILDCARD is non-nil then it runs
-the shell specified by `shell-file-name'. If the value of
-`ls-lisp-use-insert-directory-program' is nil then it runs a Lisp
-emulation.
+this advice just delegates the work to ORIG-FUN (the normal `insert-directory'
+function from `files.el').
+But if the value of `ls-lisp-use-insert-directory-program' is nil
+then it runs a Lisp emulation.
The Lisp emulation does not run any external programs or shells. It
supports ordinary shell wildcards if `ls-lisp-support-shell-wildcards'
is non-nil; otherwise, it interprets wildcards as regular expressions
to match file names. It does not support all `ls' switches -- those
-that work are: A a c i r S s t u U X g G B C R and F partly."
+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
+is assumed to be always present and cannot be turned off."
(if ls-lisp-use-insert-directory-program
- (funcall original-insert-directory
+ (funcall orig-fun
file switches wildcard full-directory-p)
;; We need the directory in order to find the right handler.
(let ((handler (find-file-name-handler (expand-file-name file)
(if (string-match "--dired " switches)
(setq switches (replace-match "" nil nil switches)))
;; Convert SWITCHES to a list of characters.
- (setq switches (delete ?- (append switches nil)))
+ (setq switches (delete ?\ (delete ?- (append switches nil))))
;; Sometimes we get ".../foo*/" as FILE. While the shell and
;; `ls' don't mind, we certainly do, because it makes us think
;; there is no wildcard, only a directory name.
(replace-match "total used in directory")
(end-of-line)
(insert " available " available)))))))))
+(advice-add 'insert-directory :around #'ls-lisp--insert-directory)
(defun ls-lisp-insert-directory
(file switches time-index wildcard-regexp full-directory-p)
(let* ((dir (file-name-as-directory file))
(default-directory dir) ; so that file-attributes works
(file-alist
- (directory-files-and-attributes dir nil wildcard-regexp t 'string))
- (now (current-time))
+ (directory-files-and-attributes dir nil wildcard-regexp t
+ (if (memq ?n switches)
+ 'integer
+ 'string)))
(sum 0)
+ (max-uid-len 0)
+ (max-gid-len 0)
+ (max-file-size 0)
;; do all bindings here for speed
- total-line files elt short file-size fil attr)
+ total-line files elt short file-size attr
+ fuid fgid uid-len gid-len)
+ (setq file-alist (ls-lisp-sanitize file-alist))
(cond ((memq ?A switches)
(setq file-alist
(ls-lisp-delete-matching "^\\.\\.?$" file-alist)))
(if (memq ?C switches) ; column (-C) format
(ls-lisp-column-format file-alist)
(setq total-line (cons (point) (car-safe file-alist)))
+ ;; Find the appropriate format for displaying uid, gid, and
+ ;; file size, by finding the longest strings among all the
+ ;; files we are about to display.
+ (dolist (elt file-alist)
+ (setq attr (cdr elt)
+ fuid (nth 2 attr)
+ uid-len (if (stringp fuid) (string-width fuid)
+ (length (format "%d" fuid)))
+ fgid (nth 3 attr)
+ gid-len (if (stringp fgid) (string-width fgid)
+ (length (format "%d" fgid)))
+ file-size (nth 7 attr))
+ (if (> uid-len max-uid-len)
+ (setq max-uid-len uid-len))
+ (if (> gid-len max-gid-len)
+ (setq max-gid-len gid-len))
+ (if (> file-size max-file-size)
+ (setq max-file-size file-size)))
+ (setq ls-lisp-uid-d-fmt (format " %%-%dd" max-uid-len))
+ (setq ls-lisp-uid-s-fmt (format " %%-%ds" max-uid-len))
+ (setq ls-lisp-gid-d-fmt (format " %%-%dd" max-gid-len))
+ (setq ls-lisp-gid-s-fmt (format " %%-%ds" max-gid-len))
+ (setq ls-lisp-filesize-d-fmt
+ (format " %%%dd" (length (format "%.0f" max-file-size))))
+ (setq ls-lisp-filesize-f-fmt
+ (format " %%%d.0f" (length (format "%.0f" max-file-size))))
+ (if (memq ?s switches)
+ (setq ls-lisp-filesize-b-fmt
+ (format "%%%d.0f "
+ (length (format "%.0f"
+ (fceiling
+ (/ max-file-size 1024.0)))))))
(setq files file-alist)
(while files ; long (-l) format
(setq elt (car files)
sum
(float sum))))
(insert (ls-lisp-format short attr file-size
- switches time-index now))))
+ switches time-index))))
;; Insert total size of all files:
(save-excursion
(goto-char (car total-line))
;; the wildcard; let's say something similar.
(insert "(No match)\n"))
(insert (format "total %.0f\n" (fceiling (/ sum 1024.0))))))
+ ;; dired-insert-directory expects to find point after the
+ ;; text. But if the listing is empty, as e.g. in empty
+ ;; directories with -a removed from switches, point will be
+ ;; before the inserted text, and dired-insert-directory will
+ ;; not indent the listing correctly. Going to the end of the
+ ;; buffer fixes that.
+ (unless files (goto-char (point-max)))
(if (memq ?R switches)
;; List the contents of all directories recursively.
;; cadr of each element of `file-alist' is t for
(setq elt (car file-alist)
file-alist (cdr file-alist))
(when (and (eq (cadr elt) t) ; directory
- (not (string-match "\\`\\.\\.?\\'" (car elt))))
+ ;; Under -F, we have already decorated all
+ ;; directories, including "." and "..", with
+ ;; a /, so allow for that as well.
+ (not (string-match "\\`\\.\\.?/?\\'" (car elt))))
(setq elt (expand-file-name (car elt) dir))
(insert "\n" elt ":\n")
(ls-lisp-insert-directory
;; If not full-directory-p, FILE *must not* end in /, as
;; file-attributes will not recognize a symlink to a directory,
;; so must make it a relative filename as ls does:
+ (if (file-name-absolute-p file) (setq file (expand-file-name file)))
(if (eq (aref file (1- (length file))) ?/)
(setq file (substring file 0 -1)))
(let ((fattr (file-attributes file 'string)))
(if fattr
- (insert (ls-lisp-format file fattr (nth 7 fattr)
- switches time-index (current-time)))
+ (insert (ls-lisp-format
+ (if (memq ?F switches)
+ (ls-lisp-classify-file file fattr)
+ file)
+ fattr (nth 7 fattr)
+ switches time-index))
(message "%s: doesn't exist or is inaccessible" file)
(ding) (sit-for 2))))) ; to show user the message!
+(defun ls-lisp-sanitize (file-alist)
+ "Sanitize the elements in FILE-ALIST.
+Fixes any elements in the alist for directory entries whose file
+attributes are nil (meaning that `file-attributes' failed for
+them). This is known to happen for some network shares, in
+particular for the \"..\" directory entry.
+
+If the \"..\" directory entry has nil attributes, the attributes
+are copied from the \".\" entry, if they are non-nil. Otherwise,
+the offending element is removed from the list, as are any
+elements for other directory entries with nil attributes."
+ (if (and (null (cdr (assoc ".." file-alist)))
+ (cdr (assoc "." file-alist)))
+ (setcdr (assoc ".." file-alist) (cdr (assoc "." file-alist))))
+ (rassq-delete-all nil file-alist))
+
(defun ls-lisp-column-format (file-alist)
"Insert the file names (only) in FILE-ALIST into the current buffer.
Format in columns, sorted vertically, following GNU ls -C.
(nth 7 (cdr x)))))
((setq index (ls-lisp-time-index switches))
(lambda (x y) ; sorted on time
- (ls-lisp-time-lessp (nth index (cdr y))
- (nth index (cdr x)))))
+ (time-less-p (nth index (cdr y))
+ (nth index (cdr x)))))
((memq ?X switches)
(lambda (x y) ; sorted on extension
(ls-lisp-string-lessp
(nreverse file-alist)
file-alist))
+(defun ls-lisp-classify-file (filename fattr)
+ "Append a character to FILENAME indicating the file type.
+
+FATTR is the file attributes returned by `file-attributes' for the file.
+The file type indicators are `/' for directories, `@' for symbolic
+links, `|' for FIFOs, `=' for sockets, `*' for regular files that
+are executable, and nothing for other types of files."
+ (let* ((type (car fattr))
+ (modestr (nth 8 fattr))
+ (typestr (substring modestr 0 1)))
+ (cond
+ (type
+ (concat filename (if (eq type t) "/" "@")))
+ ((string-match "x" modestr)
+ (concat filename "*"))
+ ((string= "p" typestr)
+ (concat filename "|"))
+ ((string= "s" typestr)
+ (concat filename "="))
+ (t filename))))
+
(defun ls-lisp-classify (filedata)
- "Append a character to each file name indicating the file type.
-Also, for regular files that are executable, append `*'.
+ "Append a character to file name in FILEDATA indicating the file type.
+
+FILEDATA has the form (FILENAME . ATTRIBUTES), where ATTRIBUTES is the
+structure returned by `file-attributes' for that file.
+
The file type indicators are `/' for directories, `@' for symbolic
-links, `|' for FIFOs, `=' for sockets, and nothing for regular files.
-\[But FIFOs and sockets are not recognized.]
-FILEDATA has the form (filename . `file-attributes'). Its `cadr' is t
-for directory, string (name linked to) for symbolic link, or nil."
+links, `|' for FIFOs, `=' for sockets, `*' for regular files that
+are executable, and nothing for other types of files."
(let ((file-name (car filedata))
- (type (cadr filedata)))
- (cond (type
- (cons
- (concat file-name (if (eq type t) "/" "@"))
- (cdr filedata)))
- ((string-match "x" (nth 9 filedata))
- (cons
- (concat file-name "*")
- (cdr filedata)))
- (t filedata))))
+ (fattr (cdr filedata)))
+ (setq file-name (propertize file-name 'dired-filename t))
+ (cons (ls-lisp-classify-file file-name fattr) fattr)))
(defun ls-lisp-extension (filename)
"Return extension of FILENAME (ignoring any version extension)
(substring filename (1+ i) end))))
)) "\0" filename))
-;; From Roland McGrath. Can use this to sort on time.
-(defun ls-lisp-time-lessp (time0 time1)
- "Return t if time TIME0 is earlier than time TIME1."
- (let ((hi0 (car time0)) (hi1 (car time1)))
- (or (< hi0 hi1)
- (and (= hi0 hi1)
- (< (cadr time0) (cadr time1))))))
-
-(defun ls-lisp-format (file-name file-attr file-size switches time-index now)
+(defun ls-lisp-format (file-name file-attr file-size switches time-index)
"Format one line of long ls output for file FILE-NAME.
FILE-ATTR and FILE-SIZE give the file's attributes and size.
-SWITCHES, TIME-INDEX and NOW give the full switch list and time data."
+SWITCHES and TIME-INDEX give the full switch list and time data."
(let ((file-type (nth 0 file-attr))
;; t for directory, string (name linked to)
;; for symbolic link, or nil.
(drwxrwxrwx (nth 8 file-attr))) ; attribute string ("drwxrwxrwx")
(concat (if (memq ?i switches) ; inode number
- (format " %6d" (nth 10 file-attr)))
+ (let ((inode (nth 10 file-attr)))
+ (if (consp inode)
+ (if (consp (cdr inode))
+ ;; 2^(24+16) = 1099511627776.0, but
+ ;; multiplying by it and then adding the
+ ;; other members of the cons cell in one go
+ ;; loses precision, since a double does not
+ ;; have enough significant digits to hold a
+ ;; full 64-bit value. So below we split
+ ;; 1099511627776 into high 13 and low 5
+ ;; digits and compute in two parts.
+ (let ((p1 (* (car inode) 10995116.0))
+ (p2 (+ (* (car inode) 27776.0)
+ (* (cadr inode) 65536.0)
+ (cddr inode))))
+ (format " %13.0f%05.0f "
+ ;; Use floor to emulate integer
+ ;; division.
+ (+ p1 (floor p2 100000.0))
+ (mod p2 100000.0)))
+ (format " %18.0f "
+ (+ (* (car inode) 65536.0)
+ (cdr inode))))
+ (format " %18d " inode))))
;; nil is treated like "" in concat
- (if (memq ?s switches) ; size in K
- (format " %4.0f" (fceiling (/ file-size 1024.0))))
+ (if (memq ?s switches) ; size in K, rounded up
+ ;; In GNU ls, -h affects the size in blocks, displayed
+ ;; by -s, as well.
+ (if (memq ?h switches)
+ (format "%6s "
+ (file-size-human-readable
+ ;; We use 1K as "block size", although
+ ;; most Windows volumes use 4KB to 8KB
+ ;; clusters, and exFAT will usually have
+ ;; clusters of 32KB or even 128KB. See
+ ;; KB article 140365 for the details.
+ (* 1024.0 (fceiling (/ file-size 1024.0)))))
+ (format ls-lisp-filesize-b-fmt
+ (fceiling (/ file-size 1024.0)))))
drwxrwxrwx ; attribute string
(if (memq 'links ls-lisp-verbosity)
- (format " %3d" (nth 1 file-attr))) ; link count
+ (format "%3d" (nth 1 file-attr))) ; link count
;; Numeric uid/gid are more confusing than helpful;
;; Emacs should be able to make strings of them.
;; They tend to be bogus on non-UNIX platforms anyway so
;; optionally hide them.
(if (memq 'uid ls-lisp-verbosity)
- ;; uid can be a sting or an integer
+ ;; uid can be a string or an integer
(let ((uid (nth 2 file-attr)))
- (format (if (stringp uid) " %-8s" " %-8d") uid)))
+ (format (if (stringp uid)
+ ls-lisp-uid-s-fmt
+ ls-lisp-uid-d-fmt)
+ uid)))
(if (not (memq ?G switches)) ; GNU ls -- shows group by default
(if (or (memq ?g switches) ; UNIX ls -- no group by default
(memq 'gid ls-lisp-verbosity))
(let ((gid (nth 3 file-attr)))
- (format (if (stringp gid) " %-8s" " %-8d") gid))))
+ (format (if (stringp gid)
+ ls-lisp-gid-s-fmt
+ ls-lisp-gid-d-fmt)
+ gid))))
(ls-lisp-format-file-size file-size (memq ?h switches))
" "
- (ls-lisp-format-time file-attr time-index now)
+ (ls-lisp-format-time file-attr time-index)
" "
- (propertize file-name 'dired-filename t)
+ (if (not (memq ?F switches)) ; ls-lisp-classify already did that
+ (propertize file-name 'dired-filename t)
+ file-name)
(if (stringp file-type) ; is a symbolic link
(concat " -> " file-type))
"\n"
((memq ?t switches) 5) ; last modtime
((memq ?u switches) 4))) ; last access
-(defun ls-lisp-time-to-seconds (time)
- "Convert TIME to a floating point number."
- (+ (* (car time) 65536.0)
- (cadr time)
- (/ (or (nth 2 time) 0) 1000000.0)))
-
-(defun ls-lisp-format-time (file-attr time-index now)
+(defun ls-lisp-format-time (file-attr time-index)
"Format time for file with attributes FILE-ATTR according to TIME-INDEX.
Use the same method as ls to decide whether to show time-of-day or year,
-depending on distance between file date and NOW.
+depending on distance between file date and the current time.
All ls time options, namely c, t and u, are handled."
(let* ((time (nth (or time-index 5) file-attr)) ; default is last modtime
- (diff (- (ls-lisp-time-to-seconds time)
- (ls-lisp-time-to-seconds now)))
+ (diff (- (float-time time) (float-time)))
;; Consider a time to be recent if it is within the past six
;; months. A Gregorian year has 365.2425 * 24 * 60 * 60 ==
;; 31556952 seconds on the average, and half of that is 15778476.
(error "Unk 0 0000"))))
(defun ls-lisp-format-file-size (file-size human-readable)
- (if (or (not human-readable)
- (< file-size 1024))
- (format (if (floatp file-size) " %9.0f" " %9d") file-size)
- (do ((file-size (/ file-size 1024.0) (/ file-size 1024.0))
- ;; kilo, mega, giga, tera, peta, exa
- (post-fixes (list "k" "M" "G" "T" "P" "E") (cdr post-fixes)))
- ((< file-size 1024) (format " %8.0f%s" file-size (car post-fixes))))))
+ (if (not human-readable)
+ (format (if (floatp file-size)
+ ls-lisp-filesize-f-fmt
+ ls-lisp-filesize-d-fmt)
+ file-size)
+ (format " %6s" (file-size-human-readable file-size))))
(provide 'ls-lisp)
-;;; arch-tag: e55f399b-05ec-425c-a6d5-f5e349c35ab4
;;; ls-lisp.el ends here