]> code.delx.au - gnu-emacs/blobdiff - lisp/ls-lisp.el
2009-08-15 Michael Kifer <kifer@cs.stonybrook.edu>
[gnu-emacs] / lisp / ls-lisp.el
index f1a05a6f8c85c0a526fc31e6e31c8cfa599734ac..060e4011a4a83795285564c4448f513b87eb65c1 100644 (file)
@@ -1,7 +1,7 @@
 ;;; 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 Free Software Foundation, Inc.
 
 ;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
 ;; Modified by: Francis J. Wright <F.J.Wright@maths.qmw.ac.uk>
 
 ;; 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
@@ -21,9 +21,7 @@
 ;; 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:
 
@@ -32,7 +30,7 @@
 ;; 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
@@ -78,7 +76,7 @@
               '(hpux usg-unix-v unisoft-unix 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
@@ -93,12 +91,12 @@ option will have no effect until you restart Emacs."
   ;; 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
@@ -111,7 +109,7 @@ option will have no effect until you restart Emacs."
             '(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.
 
@@ -132,7 +130,7 @@ if emulation is GNU then default is `(links uid gid)'."
 
 (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'.
+  "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."
@@ -142,7 +140,7 @@ 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)
@@ -150,7 +148,7 @@ Otherwise they are treated as Emacs regexps (for backward compatibility)."
 (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
@@ -170,7 +168,7 @@ current year. The OLD-TIME-FORMAT is used for older files.  To use ISO
   :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
@@ -329,9 +327,11 @@ not contain `d', so that a full listing is expected."
          (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))
@@ -390,7 +390,10 @@ not contain `d', so that a full listing is expected."
              (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
@@ -531,13 +534,17 @@ for directory, string (name linked to) for symbolic link, or nil."
         (type (cadr filedata)))
     (cond (type
           (cons
-           (concat file-name (if (eq type t) "/" "@"))
+           (concat (propertize file-name 'dired-filename t)
+                   (if (eq type t) "/" "@"))
            (cdr filedata)))
          ((string-match "x" (nth 9 filedata))
           (cons
-           (concat file-name "*")
+           (concat (propertize file-name 'dired-filename t) "*")
            (cdr filedata)))
-         (t filedata))))
+         (t
+          (cons
+           (propertize file-name 'dired-filename t)
+           (cdr filedata))))))
 
 (defun ls-lisp-extension (filename)
   "Return extension of FILENAME (ignoring any version extension)
@@ -632,7 +639,9 @@ SWITCHES, TIME-INDEX and NOW give the full switch list and time data."
            " "
            (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"