From: Eshel Yaron Date: Sat, 13 Jan 2024 17:35:25 +0000 (+0100) Subject: Avoid slow remote file name completion annotations X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=e762c45b1e4045ac782860a61a21dd97d79522f8;p=emacs.git 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 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 f0d11bb9c20..ffee287b230 100644 --- 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 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))