master f2831446582: Allow to disable symbolic links check in Dired

[Michael Albinus]

branch: master
commit f283144658259f209efdef78c576b43832c9c479
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>

    Allow to disable symbolic links check in Dired
    
    * doc/emacs/dired.texi (Misc Dired Features):
    * doc/misc/tramp.texi (Frequently Asked Questions):
    Explain dired-check-symlinks.
    
    * etc/NEWS: Describe dired-check-symlinks.
    Fix typos.
    
    * lisp/dired.el (dired-check-symlinks): New defcustom.
    (dired-font-lock-keywords): Use it.  (Bug#73046)
---
 doc/emacs/dired.texi |  9 +++++++++
 doc/misc/tramp.texi  | 25 +++++++++++++++++++++++++
 etc/NEWS             | 22 +++++++++++++++-------
 lisp/dired.el        | 46 ++++++++++++++++++++++++++++++----------------
 4 files changed, 79 insertions(+), 23 deletions(-)

diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi
index 88638190d7f..246d3e1a4bc 100644
--- a/doc/emacs/dired.texi
+++ b/doc/emacs/dired.texi
@@ -1817,6 +1817,15 @@ the files in the current directory as well as the 
available disk
 space.  If you set this to @code{nil}, the available disk space
 information will not be displayed at all.
 
+@vindex dired-check-symlinks
+  Dired fontifies the items in the Dired buffer.  If the
+@code{default-directory} of that buffer is remote, this might be
+extensive for symbolic links, because their @code{file-truename} is
+evaluated.  Set user option @code{dired-check-symlinks} to @code{nil}
+for remote directories, which suffer from a slow connection.  It can be
+declared as connection-local variable to match how a remote system is
+connectable (@pxref{Connection Variables}).
+
 @kindex + @r{(Dired)}
 @findex dired-create-directory
   The command @kbd{+} (@code{dired-create-directory}) reads a
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 901fce2db39..a0a0a7164fb 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -5292,6 +5292,31 @@ connections, apply the following code.
 @end group
 @end lisp
 
+@vindex dired-check-symlinks
+@item
+Disable check for symbolic link validity in @code{dired} buffers.
+Emacs fontifies symbolic links in @code{dired} buffers using the
+@code{file-truename} operation.  This can be slow.  Since @w{Emacs
+31}, there is a user option which suppresses this.  It can be set
+connection-local.
+@ifinfo
+@xref{Connection Variables, , , emacs}.
+@end ifinfo
+
+@lisp
+@group
+(connection-local-set-profile-variables
+ 'my-dired-profile
+ '((dired-check-symlinks . nil)))
+@end group
+
+@group
+(connection-local-set-profiles
+ '(:application tramp :machine "remotehost")
+ 'my-dired-profile)
+@end group
+@end lisp
+
 @item
 Use direct asynchronous processes if possible.
 
diff --git a/etc/NEWS b/etc/NEWS
index 1bdbe368846..53ca814b9f1 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -111,7 +111,7 @@ This hook allows you to control which tab-bar tabs are 
auto-resized.
 ** Project
 
 ---
-*** New command `project-find-file-in-root`.
+*** New command 'project-find-file-in-root'.
 It is equivalent to running ‘project-any-command’ with ‘find-file’.
 
 
@@ -291,9 +291,9 @@ command attempts to look up and copy the text in-between 
the hunks.
 ** php-ts-mode
 
 ---
-*** 'php-ts-mode-run-php-webserver' can now accept a custom php.ini file.
+*** 'php-ts-mode-run-php-webserver' can now accept a custom "php.ini" file.
 You can use the new optional argument CONFIG when calling
-'php-ts-mode-run-php-webserver' to pass an alternative php.ini file to
+'php-ts-mode-run-php-webserver' to pass an alternative "php.ini" file to
 the built-in Web server.  Interactively, when invoked with a prefix
 argument, 'php-ts-mode-run-php-webserver' prompts for the config file as
 well as for other connection parameters.
@@ -316,6 +316,14 @@ changes when supplied with a universal prefix argument via 
'C-u':
 - 'C-u c a' copies all changes from buffer C to buffer A.
 - 'C-u c b' copies all changes from buffer C to buffer B.
 
+** Dired
+
++++
+*** Dired allows to disable checks for symbolic link validity.
+Dired fontifies symbolic links in Dired buffers using the
+'file-truename' operation.  This can be slow for remote directories.
+Setting user option 'dired-check-symlinks' to nil disables these checks.
+
 
 * New Modes and Packages in Emacs 31.1
 
@@ -364,11 +372,11 @@ If supplied, 'string-pixel-width' will use any face 
remappings from
 BUFFER when computing the string's width.
 
 ---
-*** New macro 'with-work-buffer'.
-This macro is similar to the already existing macro `with-temp-buffer',
+** New macro 'with-work-buffer'.
+This macro is similar to the already existing macro 'with-temp-buffer',
 except that it does not allocate a new temporary buffer on each call,
 but tries to reuse those previously allocated (up to a number defined by
-the new variable `work-buffer-limit', which defaults to 10).
+the new variable 'work-buffer-limit', which defaults to 10).
 
 +++
 ** 'date-to-time' now defaults to local time.
@@ -405,7 +413,7 @@ where a userspace executable loader is required, has been 
optimized on
 systems featuring Linux 3.5.0 and above.
 
 ---
-** NSSpeechRecognitionUsageDescription now included in Info.plist (macOS).
+** 'NSSpeechRecognitionUsageDescription' now included in "Info.plist" (macOS).
 Should Emacs (or any built-in shell) invoke a process using macOS speech
 recognition APIs, the relevant permission dialog is now displayed, thus
 allowing Emacs users access to speech recognition utilities.
diff --git a/lisp/dired.el b/lisp/dired.el
index 0d526dfc376..2bf5a221f4e 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -738,6 +738,13 @@ Subexpression 2 must end right before the \\n.")
 
 ;;; 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 @@ Subexpression 2 must end right before the \\n.")
    ;; 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,24 +838,29 @@ Subexpression 2 must end right before the \\n.")
    ;; 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)
                '(2 `(face ,dired-directory-face dired-symlink-filename t))))
    ;;
-   ;; Symbolic link to a non-directory.
+   ;; Symbolic link to a non-directory.  Or no check at all.
    (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)