]> code.delx.au - gnu-emacs/blobdiff - lisp/ls-lisp.el
There's no reason not to compile version.el
[gnu-emacs] / lisp / ls-lisp.el
index 3791f6f59786a84edd4ff5b0883c498cdca07556..de48987188706524311a9fb176dd700b379a9e28 100644 (file)
@@ -1,7 +1,6 @@
 ;;; ls-lisp.el --- emulate insert-directory completely in Emacs Lisp
 
-;; Copyright (C) 1992, 1994, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
-;;   2007, 2008, 2009, 2010  Free Software Foundation, Inc.
+;; Copyright (C) 1992, 1994, 2000-2012  Free Software Foundation, Inc.
 
 ;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
 ;; Modified by: Francis J. Wright <F.J.Wright@maths.qmw.ac.uk>
 
 ;;; 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 'windows-nt) 'MS-Windows)
-       ((memq system-type
-              '(hpux usg-unix-v irix berkeley-unix))
-        'UNIX))                        ; very similar to GNU
+       ((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."
+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))
+  (memq ls-lisp-emulation '(MS-Windows MacOS))
   "Non-nil causes ls-lisp alphabetic sorting to ignore case."
   :set-after '(ls-lisp-emulation)
   :type 'boolean
@@ -310,8 +329,9 @@ not contain `d', so that a full listing is expected."
             (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)))
@@ -418,6 +438,22 @@ not contain `d', so that a full listing is expected."
        (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.
@@ -705,13 +741,7 @@ All ls time options, namely c, t and u, are handled."
                  ls-lisp-filesize-f-fmt
                ls-lisp-filesize-d-fmt)
              file-size)
-    (if (< file-size 1024)
-       (format " %4d" 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 " %3.0f%s"  file-size (car post-fixes)))))))
+    (format " %7s" (file-size-human-readable file-size))))
 
 (provide 'ls-lisp)