bug#73046: 29.4; Emacs 100% CPU usage for several seconds when opening dired buffer over TRAMP

[Michael Albinus via "Bug reports for GNU Emacs, the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>]

[-- Attachment #1: Type: text/plain, Size: 918 bytes --]

Suhail Singh <suhailsingh247@gmail.com> writes:

Hi Suhail,

>> There's a new user option `dired-highlight-symlinks'. If non-nil (the
>> default), symlinks are highlighted the same way as now. With a nil
>> value, they aren't.
>
> I propose that the non-default behaviour be that `dired-symlink-face' is
> applied to the entirety of the symlink.  If you agree, it might be
> better to additionally rename `dired-highlight-symlinks' accordingly to
> reflect the updated behaviour.

Good catch, see reworked patch below. The user option has been renamed
to dired-check-symlinks.

> TIL about connection-local variables.  Yes, this would be helpful.
> However, if so desired, I imagine that setting
> `dired-highlight-symlinks' buffer-locally in the `dired-mode-hook' would
> work as well.  Is my understanding correct?

Yes, connection-local variables are implemented as buffer-local
variables.

Best regards, Michael.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 3575 bytes --]

diff --git a/lisp/dired.el b/lisp/dired.el
index 0d526dfc376..bc984c3506d 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -738,6 +738,13 @@ dired-ignored-face
 \f
 ;;; Font-lock

+(defcustom dired-check-symlinks t
+  "Whether symlinks are checked for validity.
+Set it to nil for remote directories, which suffer from a slow connection."
+  :type 'boolean
+  :group 'dired
+  :version "31.1")
+
 (defvar dired-font-lock-keywords
   (list
    ;;
@@ -815,11 +822,13 @@ dired-font-lock-keywords
    ;; 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))))
+                 (when (connection-local-value dired-check-symlinks)
+                   (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)
@@ -829,10 +838,12 @@ dired-font-lock-keywords
    ;; Symbolic link to a directory.
    (list dired-re-sym
          (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))))
+                 (when (connection-local-value dired-check-symlinks)
+                   (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)
@@ -841,12 +852,15 @@ dired-font-lock-keywords
    ;; 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)))))
+                 (if (not (connection-local-value dired-check-symlinks))
+                     (search-forward-regexp
+                      "\\(.+-> ?\\)\\(.+\\)" end t)
+                   (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)