Avoid slow remote file name completion annotations

* lisp/files.el (file-name-attributes-completion-annotation)
(file-name-completion-annotation): New function.
* lisp/minibuffer.el (completion-file-name-affixation): Use it.

* lisp/net/tramp-sudoedit.el (tramp-sudoedit-file-name-handler-alist)
* lisp/net/tramp-sh.el (tramp-sh-file-name-handler-alist): Register
handler function for 'file-name-completion-annotation'.
(tramp-sh-handle-file-name-completion-annotation)
* lisp/net/tramp.el (tramp-file-name-for-operation): Handle it.

* doc/lispref/files.texi (File Attributes)
(Magic File Names): Document 'file-name-completion-annotation'.

* etc/NEWS: Announce it.

diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index 9e7aeeecec8e050a6f6e0a5e09f0c2cc844dc85c..e8769b56bfc7eb40bfa2ecc6b9a38647d0ee2cde 100644 (file)
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -1522,6 +1522,18 @@ $ ls -l foo*
 @end example
 @end defun
 
+@defun file-name-completion-annotation filename
+This function returns an annotation string for @var{filename}, that is
+a string with details about @var{filename} that is formatted for
+display in the @file{*Completions*} buffer when @var{filename} appears
+as a completion candidate.  These details include the file modes, size
+and last modified time of @var{filename}.  If this information is not
+available, or if @var{filename} is a remote file name,
+@code{file-name-completion-annotation} returns @code{nil} instead.
+@code{read-file-name} calls this function to obtain annotation strings
+for file name completion candidates.  @xref{Reading File Names}.
+@end defun
+
 @node Extended Attributes
 @subsection Extended File Attributes
 @cindex extended file attributes
@@ -3404,7 +3416,7 @@ first, before handlers for jobs such as remote file access.
 @code{file-modes}, @code{file-name-all-completions},
 @code{file-name-as-directory},
 @code{file-name-case-insensitive-p},
-@code{file-name-completion},
+@code{file-name-completion}, @code{file-name-completion-annotation},
 @code{file-name-directory},
 @code{file-name-nondirectory},
 @code{file-name-sans-versions}, @code{file-newer-than-file-p},
@@ -3466,7 +3478,7 @@ first, before handlers for jobs such as remote file access.
 @code{file-modes}, @code{file-name-all-completions},
 @code{file-name-as-directory},
 @code{file-name-case-insensitive-p},
-@code{file-name-completion},
+@code{file-name-completion}, @code{file-name-completion-annotation},
 @code{file-name-directory},
 @code{file-name-nondirec@discretionary{}{}{}tory},
 @code{file-name-sans-versions}, @code{file-newer-than-file-p},

diff --git a/etc/NEWS b/etc/NEWS
index f0d11bb9c2031937325106296ea913157912f193..ffee287b23096e379d3e1ec430ad74ac36d0fbe3 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1850,6 +1850,13 @@ These functions are like 'user-uid' and 'group-gid', respectively, but
 are aware of file name handlers, so they will return the remote UID or
 GID for remote files (or -1 if the connection has no associated user).
 
++++
+** New function 'file-name-completion-annotation'.
+This function takes a file name and returns a string with details
+about that file, which 'read-file-name' uses as completion annotations
+for completion candidates.  File name handlers can modify the behavior
+of this function.
+
 +++
 ** 'fset', 'defalias' and 'defvaralias' now signal an error for cyclic aliases.
 Previously, 'fset', 'defalias' and 'defvaralias' could be made to

diff --git a/lisp/files.el b/lisp/files.el
index 9c8914bfc50b53e26255bd9fa7ed205b1de777e8..6cd784d0421fa823c2d531ea0fb24bbfd3986134 100644 (file)
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -5324,6 +5324,33 @@ to `default-directory', and the result will also be relative."
      (t
       parent))))
 
+(defun file-name-attributes-completion-annotation (filename)
+  "Format file attributes of FILENAME as a completion annotation."
+  (when-let ((attrs (ignore-errors (file-attributes filename 'string))))
+    (concat (file-attribute-modes attrs)
+            " "
+            (format "%8s" (file-size-human-readable
+                           (file-attribute-size attrs)))
+            "   "
+            (format-time-string
+             "%Y-%m-%d %T" (file-attribute-modification-time
+                            attrs))
+            "   "
+            (file-attribute-user-id attrs)
+            ":"
+            (file-attribute-group-id attrs))))
+
+(defun file-name-completion-annotation (filename)
+  "Return a completion annotation for FILENAME.
+
+`read-file-name' displays the completion annotation next to
+FILENAME in the *Completions* buffer when user option
+`completions-detailed' is non-nil."
+  (if-let ((handler (find-file-name-handler
+                     filename 'file-name-completion-annotation)))
+      (funcall handler 'file-name-completion-annotation filename)
+    (file-name-attributes-completion-annotation filename)))
+
 (defcustom make-backup-file-name-function
   #'make-backup-file-name--default-function
   "A function that `make-backup-file-name' uses to create backup file names.

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 31e70014d2d729e0653c3a94e52fb90f315354db..7c0276290463788819748fe7d2c0d52520dfbc4d 100644 (file)
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -3634,31 +3634,16 @@ same as `substitute-in-file-name'."
   (let ((max-file (seq-max (mapcar #'string-width files))))
     (mapcar
      (lambda (file)
-       (list
-        file
-        ""                              ; empty prefix
-        (if-let ((attrs
-                  (ignore-errors
-                    (file-attributes
-                     (substitute-in-file-name
-                      (concat minibuffer-completion-base file))
-                     'string))))
-            (propertize
-             (concat (propertize " " 'display
-                                 `(space :align-to ,(+ max-file 2)))
-                     (file-attribute-modes attrs)
-                     " "
-                     (format "%8s" (file-size-human-readable
-                                    (file-attribute-size attrs)))
-                     "   "
-                     (format-time-string
-                      "%Y-%m-%d %T" (file-attribute-modification-time attrs))
-                     "   "
-                     (file-attribute-user-id attrs)
-                     ":"
-                     (file-attribute-group-id attrs))
-             'face 'completions-annotations)
-          "")))
+       (let ((full (substitute-in-file-name
+                    (concat minibuffer-completion-base file))))
+         (list file ""
+               (if-let ((ann (file-name-completion-annotation full)))
+                   (propertize
+                    (concat (propertize " " 'display
+                                        `(space :align-to ,(+ max-file 2)))
+                            ann)
+                    'face 'completions-annotations)
+                 ""))))
      files)))
 
 (defun completion-file-name-table (string pred action)

diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 8ec9467ab45fdd96c69b5c2bbfc33b7c86d887bb..9b4a2f20b15c1997d23bd236a2f02108cda0d3b3 100644 (file)
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -1140,6 +1140,8 @@ percent characters need to be doubled.")
     (file-name-as-directory . tramp-handle-file-name-as-directory)
     (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p)
     (file-name-completion . tramp-handle-file-name-completion)
+    (file-name-completion-annotation
+     . tramp-sh-handle-file-name-completion-annotation)
     (file-name-directory . tramp-handle-file-name-directory)
     (file-name-nondirectory . tramp-handle-file-name-nondirectory)
     ;; `file-name-sans-versions' performed by default handler.
@@ -1903,6 +1905,13 @@ ID-FORMAT valid values are `string' and `integer'."
                        (buffer-substring (point) (line-end-position)) result)))
                   result))))))))))
 
+(defun tramp-sh-handle-file-name-completion-annotation (filename)
+  "Like `file-name-completion-annotation' for Tramp files."
+  (with-parsed-tramp-file-name filename nil
+    (when (string-match-p
+           (rx bos (or "sudo" "su" "sg" "doas" "ksu") eos) method)
+      (file-name-attributes-completion-annotation filename))))
+
 ;; cp, mv and ln
 
 (defun tramp-sh-handle-add-name-to-file

diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index 0c717c4a5aa5f278207d46acf288ea3dc826b8b7..953e2ac0413b71244d79546123382cfa00027221 100644 (file)
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -100,6 +100,8 @@ See `tramp-actions-before-shell' for more info.")
     (file-name-as-directory . tramp-handle-file-name-as-directory)
     (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p)
     (file-name-completion . tramp-handle-file-name-completion)
+    (file-name-completion-annotation
+     . file-name-attributes-completion-annotation)
     (file-name-directory . tramp-handle-file-name-directory)
     (file-name-nondirectory . tramp-handle-file-name-nondirectory)
     ;; `file-name-sans-versions' performed by default handler.

diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index f943bd81a519a057069aca6b457572328c2ea160..479a5c6c44f063ab13e3bbefaa0f6f78f6e2766d 100644 (file)
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -2298,6 +2298,7 @@ Must be handled by the callers."
            '(add-name-to-file copy-directory copy-file
              file-equal-p file-in-directory-p
              file-name-all-completions file-name-completion
+              file-name-completion-annotation
              file-newer-than-file-p rename-file))
     (cond
      ((tramp-tramp-file-p (nth 0 args)) (nth 0 args))