summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEli Zaretskii <eliz@gnu.org>2010-11-06 12:08:33 +0200
committerEli Zaretskii <eliz@gnu.org>2010-11-06 12:08:33 +0200
commit169759a0d412e5f1eb9aea1663bbffb59002452c (patch)
tree26e7e48ff5053a8d5bb95c31a36f4e55cd8313e6
parent21620882d7956ac84de26371f9fb504b6c558192 (diff)
downloademacs-169759a0d412e5f1eb9aea1663bbffb59002452c.tar.gz
Back-port from trunk the fix for bug #6294.
ls-lisp.el (ls-lisp-classify-file): New function. (ls-lisp-insert-directory): Call it if switches include -F. (ls-lisp-classify): Call ls-lisp-classify-file. (insert-directory): Remove blanks from switches.
-rw-r--r--lisp/ChangeLog4
-rw-r--r--lisp/ls-lisp.el59
2 files changed, 41 insertions, 22 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 83915ca448d..135e1ea750f 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,6 +1,10 @@
2010-11-06 Eli Zaretskii <eliz@gnu.org>
* ls-lisp.el (insert-directory): Doc fix. (bug#7285)
+ (ls-lisp-classify-file): New function.
+ (ls-lisp-insert-directory): Call it if switches include -F (bug#6294).
+ (ls-lisp-classify): Call ls-lisp-classify-file.
+ (insert-directory): Remove blanks from switches.
2010-11-07 Wilson Snyder <wsnyder@wsnyder.org>
diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el
index 28311f81e6c..b01ad6f9510 100644
--- a/lisp/ls-lisp.el
+++ b/lisp/ls-lisp.el
@@ -236,7 +236,7 @@ is assumed to be always present and cannot be turned off."
(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.
@@ -406,7 +406,11 @@ not contain `d', so that a full listing is expected."
(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!
@@ -523,29 +527,40 @@ SWITCHES is a list of characters. Default sorting is alphabetic."
(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 (propertize file-name 'dired-filename t)
- (if (eq type t) "/" "@"))
- (cdr filedata)))
- ((string-match "x" (nth 9 filedata))
- (cons
- (concat (propertize file-name 'dired-filename t) "*")
- (cdr filedata)))
- (t
- (cons
- (propertize file-name 'dired-filename t)
- (cdr 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)