master 48fdfd8: Font-lock symlinks in dired buffers better

[Lars Ingebrigtsen]

branch: master
commit 48fdfd8b939654e5bde0ef5448e17e4336cdb229
Author: Lars Ingebrigtsen <address@hidden>
Commit: Lars Ingebrigtsen <address@hidden>

    Font-lock symlinks in dired buffers better
    
    * lisp/dired.el (dired-font-lock-keywords): Font-lock symlinks
    differently based on whether they point at a directory or not
    (bug#17064).  Based on code from Michael Heerdegen.
---
 lisp/dired.el | 26 ++++++++++++++++++++++++--
 1 file changed, 24 insertions(+), 2 deletions(-)

diff --git a/lisp/dired.el b/lisp/dired.el
index d1ec3f3..05789a3 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -517,9 +517,31 @@ Subexpression 2 must end right before the \\n.")
    (list dired-re-dir
         '(".+" (dired-move-to-filename) nil (0 dired-directory-face)))
    ;;
-   ;; Symbolic links.
+   ;; Symbolic link to a directory.
    (list dired-re-sym
-        '(".+" (dired-move-to-filename) nil (0 dired-symlink-face)))
+         (list (lambda (end)
+                 (when-let* ((file (dired-file-name-at-point))
+                             (truename (ignore-errors (file-truename file))))
+                   (and (file-directory-p truename)
+                       (search-forward-regexp "\\(.+-> ?\\)\\(.+\\)" end t))))
+               '(dired-move-to-filename)
+               nil
+               '(1 dired-symlink-face)
+               '(2 dired-directory-face)))
+   ;;
+   ;; Symbolic link to a non-directory.
+   (list dired-re-sym
+         (list (lambda (end)
+                 (when-let ((file (dired-file-name-at-point)))
+                   (let ((truename (ignore-errors (file-truename file))))
+                     (and (or (not truename)
+                             (not (file-directory-p truename)))
+                         (search-forward-regexp "\\(.+-> ?\\)\\(.+\\)"
+                                                 end t)))))
+               '(dired-move-to-filename)
+               nil
+               '(1 dired-symlink-face)
+               '(2 'default)))
    ;;
    ;; Sockets, pipes, block devices, char devices.
    (list dired-re-special