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)

(cherry picked from commit f283144658259f209efdef78c576b43832c9c479)

diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi
index 88638190d7f5338dcc775d390b9821c0c1e0770c..246d3e1a4bc57bb1b9f8b417bf01da78c836a536 100644 (file)
--- 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 327ddfdbbed6c711a94b67766a3fbe4b6823e5cf..09662835882feef80e30cdc5c60ba82ac5896fd3 100644 (file)
--- 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 6f881651e00b7199c91741052aa70eaa50ed9668..c27797382647dab00746336c7a432a2ef0372ce7 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -84,7 +84,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’.
 
 \f
@@ -245,9 +245,9 @@ any.
 ** 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.
@@ -270,6 +270,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.
+
 \f
 * New Modes and Packages in Emacs 31.1
 
@@ -318,11 +326,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.
@@ -358,6 +366,15 @@ The run-time performance of subprocesses on recent Android releases,
 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).
+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.
+
+Note: Accepting this permission allows the use of system APIs, which may
+send user data to Apple’s speech recognition servers.
+
 \f
 ----------------------------------------------------------------------
 This file is part of GNU Emacs.

diff --git a/lisp/dired.el b/lisp/dired.el
index 589b466c098226d5b9c10c7ad19d40efa42d2850..b33d043790b51b0d7f517ef946dfed0bafc576d7 100644 (file)
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -730,6 +730,13 @@ Subexpression 2 must end right before the \\n.")
 \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
    ;;
@@ -807,11 +814,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)
@@ -821,24 +830,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)