dired: Show broken/circular links w/ different face

* lisp/dired.el (dired-broken-symlink): New face.
(dired-font-lock-keywords):
Use it for broken/circular links (Bug#39145).

* etc/NEWS (Changes in Specialized Modes and Packages in Emacs 28.1):
Announce this change.

diff --git a/etc/NEWS b/etc/NEWS
index 6e04a1cf89141e27c197873fc155c2f098d39eb1..8b9bd07a98526329d50227d605a4abbd6d5b047d 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -240,6 +240,10 @@ time zones will use a form like "+0100" instead of "CET".
 
 ** Dired
 
+---
+*** Broken and circular links are shown with the new
+    'dired-broken-symlink' face.
+
 *** '=' ('dired-diff') will now put all backup files into the 'M-n' history.
 When using '=' on a file with backup files, the default file to use
 for diffing is the newest backup file.  You can now use 'M-n' to quickly

diff --git a/lisp/dired.el b/lisp/dired.el
index 08d04688519801607f18ee0e8a52e4c4cabd7c0d..d122869a5e35c740d8adedcd2cb5a66dcf623a66 100644 (file)
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -534,6 +534,14 @@ Subexpression 2 must end right before the \\n.")
 (defvar dired-symlink-face 'dired-symlink
   "Face name used for symbolic links.")
 
+(defface dired-broken-symlink
+  '((((class color))
+     :foreground "yellow1" :background "red1" :weight bold)
+    (t :weight bold :slant italic :underline t))
+  "Face used for broken symbolic links."
+  :group 'dired-faces
+  :version "28.1")
+
 (defface dired-special
   '((t (:inherit font-lock-variable-name-face)))
   "Face used for sockets, pipes, block devices and char devices."
@@ -597,6 +605,20 @@ Subexpression 2 must end right before the \\n.")
    (list dired-re-dir
         '(".+" (dired-move-to-filename) nil (0 dired-directory-face)))
    ;;
+   ;; Broken Symbolic link.
+   (list dired-re-sym
+         (list (lambda (end)
+                 (let* ((file (dired-file-name-at-point))
+                        (truename (ignore-errors (file-truename file))))
+                   ;; either not existent target or circular link
+                   (and (not (and truename (file-exists-p truename)))
+                        (search-forward-regexp "\\(.+\\) \\(->\\) ?\\(.+\\)" end t))))
+               '(dired-move-to-filename)
+               nil
+               '(1 'dired-broken-symlink)
+               '(2 dired-symlink-face)
+               '(3 'dired-broken-symlink)))
+   ;;
    ;; Symbolic link to a directory.
    (list dired-re-sym
          (list (lambda (end)