]> git.eshelyaron.com Git - emacs.git/commitdiff
Font-lock symlinks in dired buffers better
authorLars Ingebrigtsen <larsi@gnus.org>
Wed, 30 Oct 2019 23:31:32 +0000 (00:31 +0100)
committerLars Ingebrigtsen <larsi@gnus.org>
Wed, 30 Oct 2019 23:31:32 +0000 (00:31 +0100)
* 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

index d1ec3f36b183c4d15508945770bc9cce94c5b954..05789a351663ef7ff4634d21ee1e380d5d5459cf 100644 (file)
@@ -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