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: 1337 bytes --]

Suhail Singh <suhailsingh247@gmail.com> writes:

Hi,

> The above observations seem consistent with Michael's comments above
> regd. font-lock checks for "Broken Symbolink link" and "Symbolic link to
> a directory".  As such, if Michael's proposal below is implemented I
> believe it would be an adequate fix to the issue:
>
>>>> I believe it would be helpful to suppress these checks via a user
>>>> option. And no, the checks shouldn't be suppressed for remote
>>>> directories in general, on a fast connection they are valuable.

I gave it a try, see appended patch. 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.

You can switch this option on and off globally. However, it would be
better to do this host-wise. For this, we have connection-local
variables. The following code snippet in your ".emacs" switches the
option off for the remote host "remotehost".

--8<---------------cut here---------------start------------->8---
(connection-local-set-profile-variables
 'my-dired-profile
 '((dired-highlight-symlinks . nil)))

(connection-local-set-profiles
 '(:application tramp :machine "remotehost")
 'my-dired-profile)
--8<---------------cut here---------------end--------------->8---

Comments?

Best regards, Michael.


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

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

+(defcustom dired-highlight-symlinks t
+  "Whether symlinks shall use an own face.
+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-highlight-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-highlight-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,13 @@ 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)))))
+                 (when (connection-local-value dired-highlight-symlinks)
+                   (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)