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)
This commit is contained in:
Michael Albinus 2024-09-11 17:42:24 +02:00
parent 833158c0b7
commit f283144658
4 changed files with 79 additions and 23 deletions

View file

@ -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

View file

@ -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.

View file

@ -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.

View file

@ -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)