Subject: bug#39145: closed (Re: bug#39145: 28.0.50; dired: Show broken/circular links in different font)

From: [email-masked] (GNU bug Tracking System)
Date: Thu, 27 Aug 2020 09:59:02 +0000

Your bug report

#39145: 28.0.50; dired: Show broken/circular links in different font

which was filed against the emacs package, has been closed.

The explanation is attached below, along with your original report.
If you require more details, please reply to [email-masked].

-- 
39145: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=39145
GNU Bug Tracking System
Contact [email-masked] with problems

Subject: Re: bug#39145: 28.0.50; dired: Show broken/circular links in different font
From: Tino Calancha <[email-masked]>
To: [email-masked]
Date: Thu, 27 Aug 2020 11:58:46 +0200
List-Id: <debbugs-submit.debbugs.gnu.org>

Stefan Kangas <[email-masked]> writes:

> Tino Calancha <[email-masked]> writes:
>
>> +(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")
>
> Bonus points if you could also add reasonable defaults for this face to
> the various themes shipped with Emacs.
Thank you.  I wish, but I am fraid I am a quite colorblind person; I am
glad if someone here can find a better color choice.

Pushed into master branch as commit
'dired: Show broken/circular links w/ different face'
(bdc1f193470633adcd860db4b05a9fe951bd375b)

Subject: 28.0.50; dired: Show broken/circular links in different font
From: Tino Calancha <[email-masked]>
To: [email-masked]
Date: Wed, 15 Jan 2020 22:06:50 +0100
List-Id: <debbugs-submit.debbugs.gnu.org>

X-Debbugs-Cc: Drew Adams <[email-masked]>
Severity: wishlist

Showing a broken/circular link w/ a special font might help users
to promptly identify a possible issue.

--8<-----------------------------cut here---------------start------------->8---
commit ecc6180be1afd795b5a998c7cbeb92dd1286a54b
Author: Tino Calancha <[email-masked]>
Date:   Wed Jan 15 21:51:17 2020 +0100

    dired: Show broken/circular links w/ different font
    
    * lisp/dired.el (dired-broken-symlink): New face.
    (dired-broken-symlink-face): Add variable for the new face.
    (dired-font-lock-keywords) Use the new face for broken/circular links.
    
    * etc/NEWS (Changes in Specialized Modes and Packages in Emacs 28.1):
    Announce this change.
    
    * test/lisp/dired-tests.el (dired-test-dired-broken-symlink-face):
    Add test.

diff --git a/etc/NEWS b/etc/NEWS
index 0e43c321d8..c3b183acf1 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -44,6 +44,9 @@ It was declared obsolete in Emacs 27.1.
 
 * Changes in Specialized Modes and Packages in Emacs 28.1
 
++++
+** Dired shows in a different color broken or circular links.
+
 
 * New Modes and Packages in Emacs 28.1
 
diff --git a/lisp/dired.el b/lisp/dired.el
index 689ad1fbfa..56edae4e1d 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -475,6 +475,17 @@ dired-symlink
 (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")
+
+(defvar dired-broken-symlink-face 'dired-broken-symlink
+  "Face name used for broken symbolic links.")
+
 (defface dired-special
   '((t (:inherit font-lock-variable-name-face)))
   "Face used for sockets, pipes, block devices and char devices."
@@ -538,6 +549,18 @@ dired-font-lock-keywords
    (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 links to unexistent files or circular links
+                   (and (not (and truename (file-exists-p truename)))
+	                (search-forward-regexp ".+-> ?.+" end t))))
+               '(dired-move-to-filename)
+               nil
+               '(0 dired-broken-symlink-face)))
+   ;;
    ;; Symbolic link to a directory.
    (list dired-re-sym
          (list (lambda (end)
diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el
index 5c6649cba4..47f8809727 100644
--- a/test/lisp/dired-tests.el
+++ b/test/lisp/dired-tests.el
@@ -440,6 +440,31 @@ dired-test-with-temp-dirs
        (should (= 6 (length (dired-get-marked-files)))) ; All empty dirs but zeta-empty-dir deleted.
      (advice-remove 'read-answer 'dired-test-bug27940-advice))))
 
+(ert-deftest dired-test-dired-broken-symlink-face ()
+  "Test Dired fontifies correctly broken/circular links."
+  (let* ((dir (make-temp-file "test-symlink" 'dir))
+         (file (make-temp-file (expand-file-name "test-file" dir)))
+         (circular-link (expand-file-name "circular-link" dir))
+         (broken-link (expand-file-name "unexistent" dir))
+         (ok-link (expand-file-name file "ok-link")))
+    (unwind-protect
+        (with-current-buffer (dired dir)
+          (make-symbolic-link circular-link "circular-link")
+          (make-symbolic-link file "ok-link")
+          (make-symbolic-link broken-link "broken-link")
+          (dired-revert)
+          (sit-for 1)
+          ;; A circular link
+          (dired-goto-file circular-link)
+          (should (eq 'dired-broken-symlink (get-text-property (point) 'face)))
+          ;; A broken link
+          (dired-goto-file broken-link)
+          (should (eq 'dired-broken-symlink (get-text-property (point) 'face)))
+          ;; A valid link
+          (dired-goto-file ok-link)
+          (should-not (eq 'dired-broken-symlink (get-text-property (point) 'face))))
+      (delete-directory dir 'recursive))))
+
 
 (provide 'dired-tests)
 ;; dired-tests.el ends here

--8<-----------------------------cut here---------------end--------------->8---

In GNU Emacs 28.0.50 (build 7, x86_64-pc-linux-gnu, GTK+ Version 3.24.5, cairo version 1.16.0)
 of 2020-01-15 built on calancha-pc.dy.bbexcite.jp
Repository revision: 576dfc8aa260957f4d0dc0c68cdcb8232a536f42
Repository branch: master
Windowing system distributor 'The X.Org Foundation', version 11.0.12004000
System Description: Debian GNU/Linux 10 (buster)