emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

feature/minibuffer-completion-enhancements c00e059c368 30/35: Avoid slow


From: Eshel Yaron
Subject: feature/minibuffer-completion-enhancements c00e059c368 30/35: Avoid slow remote file name completion annotations
Date: Sun, 21 Jan 2024 03:54:32 -0500 (EST)

branch: feature/minibuffer-completion-enhancements
commit c00e059c36856010ec37277f2fadb8d4f9eaabf4
Author: Eshel Yaron <me@eshelyaron.com>
Commit: Eshel Yaron <me@eshelyaron.com>

    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.
---
 doc/lispref/files.texi     | 16 ++++++++++++++--
 etc/NEWS                   |  7 +++++++
 lisp/files.el              | 27 +++++++++++++++++++++++++++
 lisp/minibuffer.el         | 35 ++++++++++-------------------------
 lisp/net/tramp-sh.el       |  9 +++++++++
 lisp/net/tramp-sudoedit.el |  2 ++
 lisp/net/tramp.el          |  1 +
 7 files changed, 70 insertions(+), 27 deletions(-)

diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index 9e7aeeecec8..e8769b56bfc 100644
--- 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 0e04231b282..d586282b7e6 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1862,6 +1862,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 9c8914bfc50..6cd784d0421 100644
--- 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 31e70014d2d..7c027629046 100644
--- 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 8ec9467ab45..9b4a2f20b15 100644
--- 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 0c717c4a5aa..953e2ac0413 100644
--- 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 f943bd81a51..479a5c6c44f 100644
--- 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))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]