Package: emacs;
Reported by: Tino Calancha <tino.calancha <at> gmail.com>
Date: Wed, 15 Jan 2020 21:07:01 UTC
Severity: wishlist
Found in version 28.0.50
Done: Tino Calancha <tino.calancha <at> gmail.com>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Tino Calancha <tino.calancha <at> gmail.com> To: Glenn Morris <rgm <at> gnu.org> Cc: uyennhi.qm <at> gmail.com, 39145 <at> debbugs.gnu.org Subject: bug#39145: 28.0.50; dired: Show broken/circular links in different font Date: Mon, 24 Aug 2020 20:05:45 +0200
Glenn Morris <rgm <at> gnu.org> writes: > Tino Calancha wrote: > >> +(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.") > > Why have a variable at all, why not just customize the face? > (If it's just for consistency with existing dired stuff, consider > breaking that consistency.) It was for the consistency. OK, I have dropped the variable. Thank you! I've been using this feature with joy since January. Today I have updated the patch to match what my terminals (gnome terminal and xterm) do: instead of using the new font in the whole link line as I did before, that is foo -> bar now I only use dired-broken-symlink at 'foo' and 'bar' keeping '->' with dired-symlink. --8<-----------------------------cut here---------------start------------->8--- commit d250625b8f79a3b9273de6640f4840b5c8e54fe8 Author: Tino Calancha <ccalancha <at> suse.com> Date: Mon Aug 24 19:44:29 2020 +0200 dired: Show broken/circular links w/ different face * lisp/dired.el (dired-broken-symlink): 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 a test. diff --git a/etc/NEWS b/etc/NEWS index a65852fcd0..53124b4253 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -235,6 +235,9 @@ time zones will use a form like "+0100" instead of "CET". ** Dired ++++ +*** Dired shows in a different color broken or circular links. + +++ *** New user option 'dired-maybe-use-globstar'. If set, enables globstar (recursive globbing) in shells that support diff --git a/lisp/dired.el b/lisp/dired.el index 94d3befda8..05f6bb0a68 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -534,6 +534,14 @@ 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") + (defface dired-special '((t (:inherit font-lock-variable-name-face))) "Face used for sockets, pipes, block devices and char devices." @@ -597,6 +605,20 @@ 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 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) 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-bug27940 (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 14, x86_64-pc-linux-gnu, X toolkit, cairo version 1.16.0, Xaw scroll bars) of 2020-08-24 built on localhost.example.com Repository revision: 88795c52ff13203dda5940ed5defc26ce2c20e5e Repository branch: master Windowing system distributor 'The X.Org Foundation', version 11.0.12008000 System Description: openSUSE Tumbleweed
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.