;;; ls-lisp.el --- emulate insert-directory completely in Emacs Lisp
;; Copyright (C) 1992, 1994, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; 2005, 2006, 2007, 2008, 2009, 2010 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 3, 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:
;; 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
+;; 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 function can use regexps instead of shell wildcards. If you
:group 'dired)
(defcustom ls-lisp-emulation
- (cond ((eq system-type 'macos) 'MacOS)
- ;; ((eq system-type 'windows-nt) 'MS-Windows)
+ (cond ;; ((eq system-type 'windows-nt) 'MS-Windows)
((memq system-type
- '(hpux usg-unix-v unisoft-unix irix berkeley-unix))
+ '(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.
+ "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
;; 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."
+ "Non-nil causes ls-lisp alphabetic sorting to ignore case."
: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>
:type 'boolean
'(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.
: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
: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
+ "Non-nil causes ls-lisp to use `ls-lisp-format-time-list' even if
a valid locale is specified.
WARNING: Using localized date/time format might cause Dired columns
(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.
(dolist (elt file-alist)
(setq attr (cdr elt)
fuid (nth 2 attr)
- uid-len (length (if (stringp fuid) fuid (format "%d" fuid)))
+ uid-len (if (stringp fuid) (string-width fuid)
+ (length (format "%d" fuid)))
fgid (nth 3 attr)
- gid-len (length (if (stringp fgid) fgid (format "%d" fgid)))
+ 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))
(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)
+ (insert (ls-lisp-format
+ (if (memq ?F switches)
+ (ls-lisp-classify-file file fattr)
+ file)
+ fattr (nth 7 fattr)
switches time-index (current-time)))
(message "%s: doesn't exist or is inaccessible" file)
(ding) (sit-for 2))))) ; to show user the message!
(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)
" "
(ls-lisp-format-time file-attr time-index now)
" "
- (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"