changeset 108820:988b3f9a342a

Fix bug #6294. lisp/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.
author Eli Zaretskii <eliz@gnu.org>
date Sat, 29 May 2010 10:55:40 +0300
parents 55d24c1aa4ec
children 99cde7115a1a 4c39d84b5d9a
files lisp/ChangeLog lisp/ls-lisp.el
diffstat 2 files changed, 45 insertions(+), 23 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Fri May 28 22:18:47 2010 +0300
+++ b/lisp/ChangeLog	Sat May 29 10:55:40 2010 +0300
@@ -1,3 +1,10 @@
+2010-05-29  Eli Zaretskii  <eliz@gnu.org>
+
+	* ls-lisp.el (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-05-28  Juri Linkov  <juri@jurta.org>
 
 	* image-dired.el (image-dired-dired-toggle-marked-thumbs):
--- a/lisp/ls-lisp.el	Fri May 28 22:18:47 2010 +0300
+++ b/lisp/ls-lisp.el	Sat May 29 10:55:40 2010 +0300
@@ -235,7 +235,7 @@
 	(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.
@@ -405,7 +405,11 @@
 	(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!
@@ -522,29 +526,40 @@
       (nreverse file-alist)
     file-alist))
 
-(defun ls-lisp-classify (filedata)
-  "Append a character to each file name indicating the file type.
-Also, for regular files that are executable, append `*'.
+(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, 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* ((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 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, `*' 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)