]> code.delx.au - gnu-emacs/blobdiff - lisp/ls-lisp.el
Update GPL version for Emacs images.
[gnu-emacs] / lisp / ls-lisp.el
index 5f5a53b0df0d9517fe7490bb7d262a0708b64abf..a016b8369bfd7c2319779548b693dd1ce93d8cca 100644 (file)
@@ -1,7 +1,7 @@
 ;;; ls-lisp.el --- emulate insert-directory completely in Emacs Lisp
 
-;; Copyright (C) 1992, 1994, 2000, 2002, 2003, 2004,
-;;   2005 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 1994, 2000, 2001, 2002, 2003, 2004,
+;;   2005, 2006, 2007 Free Software Foundation, Inc.
 
 ;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
 ;; Modified by: Francis J. Wright <F.J.Wright@maths.qmw.ac.uk>
@@ -12,7 +12,7 @@
 
 ;; 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)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
@@ -45,8 +45,6 @@
 ;; * A few obscure ls switches are still ignored: see the docstring of
 ;; `insert-directory'.
 
-;; * Generally only numeric uid/gid.
-
 ;; TO DO =============================================================
 
 ;; Complete handling of F switch (if/when possible).
@@ -61,8 +59,8 @@
 ;; Revised by Andrew Innes and Geoff Volker (and maybe others).
 
 ;; Modified by Francis J. Wright <F.J.Wright@maths.qmw.ac.uk>, mainly
-;; to support many more ls options, "platform emulation", hooks for
-;; external symbolic link support and more robust sorting.
+;; to support many more ls options, "platform emulation" and more
+;; robust sorting.
 
 ;;; Code:
 
@@ -115,7 +113,7 @@ option will have no effect until you restart Emacs."
        (t '(links uid gid)))           ; GNU ls
   "*A list of optional file attributes that ls-lisp should display.
 It should contain none or more of the symbols: links, uid, gid.
-nil (or an empty list) means display none of them.
+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
@@ -153,7 +151,10 @@ Otherwise they are treated as Emacs regexps (for backward compatibility)."
   '("%b %e %H:%M"
     "%b %e  %Y")
   "*List of `format-time-string' specs to display file time stamps.
-They are used whenever a locale is not specified to use instead.
+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
+regardless of whether the locale can be determined.
 
 Syntax:  (EARLY-TIME-FORMAT OLD-TIME-FORMAT)
 
@@ -168,6 +169,15 @@ current year. The OLD-TIME-FORMAT is used for older files.  To use ISO
               (string :tag "Old time format"))
   :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.
+
+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."
+  :type 'boolean
+  :group 'ls-lisp)
+
 (defvar original-insert-directory nil
   "This holds the original function definition of `insert-directory'.")
 
@@ -175,14 +185,6 @@ current year. The OLD-TIME-FORMAT is used for older files.  To use ISO
 (or (featurep 'ls-lisp)  ; FJW: unless this file is being reloaded!
     (setq original-insert-directory (symbol-function 'insert-directory)))
 
-;; This stub is to allow ls-lisp to parse symbolic links via another
-;; library such as w32-symlinks.el from
-;; http://centaur.maths.qmw.ac.uk/Emacs/:
-(defun ls-lisp-parse-symlink (file-name)
-  "This stub may be redefined to parse FILE-NAME as a symlink.
-It should return nil or the link target as a string."
-  nil)
-
 \f
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -214,6 +216,7 @@ that work are: A a c i r S s t u U X g G B C R and F partly."
     ;; We need the directory in order to find the right handler.
     (let ((handler (find-file-name-handler (expand-file-name file)
                                           'insert-directory))
+         (orig-file file)
          wildcard-regexp)
       (if handler
          (funcall handler 'insert-directory file switches
@@ -227,7 +230,10 @@ that work are: A a c i r S s t u U X g G B C R and F partly."
        ;; `ls' don't mind, we certainly do, because it makes us think
        ;; there is no wildcard, only a directory name.
        (if (and ls-lisp-support-shell-wildcards
-                (string-match "[[?*]" file))
+                (string-match "[[?*]" file)
+                ;; Prefer an existing file to wildcards, like
+                ;; dired-noselect does.
+                (not (file-exists-p file)))
            (progn
              (or (not (eq (aref file (1- (length file))) ?/))
                  (setq file (substring file 0 (1- (length file)))))
@@ -239,9 +245,21 @@ that work are: A a c i r S s t u U X g G B C R and F partly."
                    (file-name-nondirectory file))
                  file (file-name-directory file))
          (if (memq ?B switches) (setq wildcard-regexp "[^~]\\'")))
-       (ls-lisp-insert-directory
-        file switches (ls-lisp-time-index switches)
-        wildcard-regexp full-directory-p)
+       (condition-case err
+           (ls-lisp-insert-directory
+            file switches (ls-lisp-time-index switches)
+            wildcard-regexp full-directory-p)
+         (invalid-regexp
+          ;; Maybe they wanted a literal file that just happens to
+          ;; use characters special to shell wildcards.
+          (if (equal (cadr err) "Unmatched [ or [^")
+              (progn
+                (setq wildcard-regexp (if (memq ?B switches) "[^~]\\'")
+                      file (file-relative-name orig-file))
+                (ls-lisp-insert-directory
+                 file switches (ls-lisp-time-index switches)
+                 nil full-directory-p))
+            (signal (car err) (cdr err)))))
        ;; Try to insert the amount of free space.
        (save-excursion
          (goto-char (point-min))
@@ -429,7 +447,9 @@ SWITCHES is a list of characters.  Default sorting is alphabetic."
   ;; symbolic link, or nil.
       (let (el dirs files)
        (while file-alist
-         (if (eq (cadr (setq el (car file-alist))) t) ; directory
+         (if (or (eq (cadr (setq el (car file-alist))) t) ; directory
+                  (and (stringp (cadr el))
+                       (file-directory-p (cadr el)))) ; symlink to a directory
              (setq dirs (cons el dirs))
            (setq files (cons el files)))
          (setq file-alist (cdr file-alist)))
@@ -455,12 +475,11 @@ 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."
-  (let ((dir (cadr filedata)) (file-name (car filedata)))
-    (cond ((or dir
-              ;; Parsing .lnk files here is perhaps overkill!
-              (setq dir (ls-lisp-parse-symlink file-name)))
+  (let ((file-name (car filedata))
+        (type (cadr filedata)))
+    (cond (type
           (cons
-           (concat file-name (if (eq dir t) "/" "@"))
+           (concat file-name (if (eq type t) "/" "@"))
            (cdr filedata)))
          ((string-match "x" (nth 9 filedata))
           (cons
@@ -506,10 +525,6 @@ SWITCHES, TIME-INDEX and NOW give the full switch list and time data."
        ;; t for directory, string (name linked to)
        ;; for symbolic link, or nil.
        (drwxrwxrwx (nth 8 file-attr))) ; attribute string ("drwxrwxrwx")
-    (and (null file-type)
-        ;; Maybe no kernel support for symlinks, so...
-        (setq file-type (ls-lisp-parse-symlink file-name))
-        (aset drwxrwxrwx 0 ?l)) ; symbolic link - update attribute string
     (concat (if (memq ?i switches)     ; inode number
                (format " %6d" (nth 10 file-attr)))
            ;; nil is treated like "" in concat
@@ -580,8 +595,12 @@ All ls time options, namely c, t and u, are handled."
              (setq locale nil))
          (format-time-string
           (if (and (<= past-cutoff diff) (<= diff 0))
-              (if locale "%m-%d %H:%M" (nth 0 ls-lisp-format-time-list))
-            (if locale "%Y-%m-%d " (nth 1 ls-lisp-format-time-list)))
+              (if (and locale (not ls-lisp-use-localized-time-format))
+                  "%m-%d %H:%M"
+                (nth 0 ls-lisp-format-time-list))
+            (if (and locale (not ls-lisp-use-localized-time-format))
+                "%Y-%m-%d "
+              (nth 1 ls-lisp-format-time-list)))
           time))
       (error "Unk  0  0000"))))