Tweak dired-font-lock-keywords.

1 files changed, 38 insertions, 11 deletions

diff --git a/lisp/dired.el b/lisp/dired.el
index 2e1d706a6eb..a0d0bb9f74d 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -120,17 +120,6 @@ The target is used in the prompt for file copy, rename etc.")
   "*If non-nil, Dired preserves the last-modified time in a file copy.
 \(This works on only some systems.)")
 
-(defvar dired-font-lock-keywords
-  '(;; Put directory headers in italics.
-    ("^  \\(/.+\\)" 1 font-lock-type-face)
-    ;; Put symlinks in bold italics.
-    ("\\([^ ]+\\) -> [^ ]+$" . font-lock-function-name-face)
-    ;; Put marks in bold.
-    ("^[^ ]" . font-lock-reference-face)
-    ;; Put files that are subdirectories in bold.
-    ("^..d.* \\([^ ]+\\)$" 1 font-lock-keyword-face))
-  "Additional expressions to highlight in Dired mode.")
-
 ;;; Hook variables
 
 (defvar dired-load-hook nil
@@ -223,6 +212,44 @@ The match starts at the beginning of the line and ends after the end
 of the line (\\n or \\r).
 Subexpression 2 must end right before the \\n or \\r.")
 
+(defvar dired-font-lock-keywords
+  (list
+   ;;
+   ;; Directory headers.
+   (list dired-subdir-regexp '(1 font-lock-type-face))
+   ;;
+   ;; We make heavy use of MATCH-ANCHORED, since the regexps don't identify the
+   ;; file name itself.  We search for Dired defined regexps, and then use the
+   ;; Dired defined function `dired-move-to-filename' before searching for the
+   ;; simple regexp ".+".  It is that regexp which matches the file name.
+   ;;
+   ;; Dired marks.
+   (list dired-re-mark
+	 '(0 font-lock-reference-face)
+	 '(".+" (dired-move-to-filename) nil (0 font-lock-warning-face)))
+   ;;
+   ;; Files that are group or world writable.
+   (list (concat dired-re-maybe-mark dired-re-inode-size
+		 "\\([-d]\\(....w....\\|.......w.\\)\\)")
+	 '(1 font-lock-comment-face)
+	 '(".+" (dired-move-to-filename) nil (0 font-lock-comment-face)))
+   ;;
+   ;; Subdirectories.
+   (list dired-re-dir
+	 '(".+" (dired-move-to-filename) nil (0 font-lock-function-name-face)))
+   ;;
+   ;; Symbolic links.
+   (list dired-re-sym 
+	 '(".+" (dired-move-to-filename) nil (0 font-lock-keyword-face)))
+   ;;
+   ;; Files suffixed with `completion-ignored-extensions'.
+   '(eval .
+     (let ((extensions (mapcar 'regexp-quote completion-ignored-extensions)))
+       ;; It is quicker to first find just an extension, then go back to the
+       ;; start of that file name.  So we do this complex MATCH-ANCHORED form.
+       (list (concat "\\(" (mapconcat 'identity extensions "\\|") "\\|#\\)$")
+	     '(".+" (dired-move-to-filename) nil (0 font-lock-string-face))))))
+  "Additional expressions to highlight in Dired mode.")
 
 ;;; Macros must be defined before they are used, for the byte compiler.