Make Tramp aware of completion-regexp-list (don't merge)

* lisp/net/tramp.el (tramp-skeleton-file-name-all-completions):
New defmacro.
(tramp-completion-handle-file-name-all-completions):
* lisp/net/tramp-adb.el (tramp-adb-handle-file-name-all-completions):
* lisp/net/tramp-crypt.el (tramp-crypt-handle-file-name-all-completions):
* lisp/net/tramp-fuse.el (tramp-fuse-handle-file-name-all-completions):
* lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-name-all-completions):
* lisp/net/tramp-sh.el (tramp-sh-handle-file-name-all-completions):
* lisp/net/tramp-smb.el (tramp-smb-handle-file-name-all-completions):
* lisp/net/tramp-sudoedit.el
(tramp-sudoedit-handle-file-name-all-completions): Use it.
This commit is contained in:
Michael Albinus 2023-11-17 18:16:58 +01:00
parent 232a57a3e3
commit 7b0e07c41a
8 changed files with 159 additions and 150 deletions

View file

@ -449,7 +449,7 @@ Emacs dired can't find files."
(defun tramp-adb-handle-file-name-all-completions (filename directory) (defun tramp-adb-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files." "Like `file-name-all-completions' for Tramp files."
(tramp-compat-ignore-error file-missing (tramp-skeleton-file-name-all-completions filename directory
(all-completions (all-completions
filename filename
(with-parsed-tramp-file-name (expand-file-name directory) nil (with-parsed-tramp-file-name (expand-file-name directory) nil
@ -464,17 +464,14 @@ Emacs dired can't find files."
(file-name-as-directory f) (file-name-as-directory f)
f)) f))
(with-current-buffer (tramp-get-buffer v) (with-current-buffer (tramp-get-buffer v)
(delete-dups (append
(append ;; On some file systems like "sdcard", "." and ".." are
;; On some file systems like "sdcard", "." and ".." are ;; not included.
;; not included. We fix this by `delete-dups'. '("." "..")
'("." "..") (mapcar
(delq (lambda (l)
nil (and (not (string-match-p (rx bol (* blank) eol) l)) l))
(mapcar (split-string (buffer-string) "\n" 'omit))))))))))
(lambda (l)
(and (not (string-match-p (rx bol (* blank) eol) l)) l))
(split-string (buffer-string) "\n"))))))))))))
(defun tramp-adb-handle-file-local-copy (filename) (defun tramp-adb-handle-file-local-copy (filename)
"Like `file-local-copy' for Tramp files." "Like `file-local-copy' for Tramp files."

View file

@ -735,7 +735,7 @@ absolute file names."
(defun tramp-crypt-handle-file-name-all-completions (filename directory) (defun tramp-crypt-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files." "Like `file-name-all-completions' for Tramp files."
(tramp-compat-ignore-error file-missing (tramp-skeleton-file-name-all-completions filename directory
(all-completions (all-completions
filename filename
(let* (completion-regexp-list (let* (completion-regexp-list

View file

@ -104,22 +104,21 @@
(defun tramp-fuse-handle-file-name-all-completions (filename directory) (defun tramp-fuse-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files." "Like `file-name-all-completions' for Tramp files."
(tramp-fuse-remove-hidden-files (tramp-skeleton-file-name-all-completions filename directory
(tramp-compat-ignore-error file-missing (tramp-fuse-remove-hidden-files
(all-completions (all-completions
filename filename
(delete-dups (append
(append (file-name-all-completions
(file-name-all-completions filename (tramp-fuse-local-file-name directory))
filename (tramp-fuse-local-file-name directory)) ;; Some storage systems do not return "." and "..".
;; Some storage systems do not return "." and "..". (let (result)
(let (result) (dolist (item '(".." ".") result)
(dolist (item '(".." ".") result) (when (string-prefix-p filename item)
(when (string-prefix-p filename item) (catch 'match
(catch 'match (dolist (elt completion-regexp-list)
(dolist (elt completion-regexp-list) (unless (string-match-p elt item) (throw 'match nil)))
(unless (string-match-p elt item) (throw 'match nil))) (setq result (cons (concat item "/") result)))))))))))
(setq result (cons (concat item "/") result))))))))))))
;; This function isn't used. ;; This function isn't used.
(defun tramp-fuse-handle-insert-directory (defun tramp-fuse-handle-insert-directory

View file

@ -1434,8 +1434,8 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(defun tramp-gvfs-handle-file-name-all-completions (filename directory) (defun tramp-gvfs-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files." "Like `file-name-all-completions' for Tramp files."
(unless (tramp-compat-string-search "/" filename) (tramp-skeleton-file-name-all-completions filename directory
(tramp-compat-ignore-error file-missing (unless (tramp-compat-string-search "/" filename)
(all-completions (all-completions
filename filename
(with-parsed-tramp-file-name (expand-file-name directory) nil (with-parsed-tramp-file-name (expand-file-name directory) nil

View file

@ -1831,46 +1831,47 @@ ID-FORMAT valid values are `string' and `integer'."
;; files. ;; files.
(defun tramp-sh-handle-file-name-all-completions (filename directory) (defun tramp-sh-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files." "Like `file-name-all-completions' for Tramp files."
(with-parsed-tramp-file-name (expand-file-name directory) nil (tramp-skeleton-file-name-all-completions filename directory
(when (and (not (tramp-compat-string-search "/" filename)) (with-parsed-tramp-file-name (expand-file-name directory) nil
(tramp-connectable-p v)) (when (and (not (tramp-compat-string-search "/" filename))
(unless (tramp-compat-string-search "/" filename) (tramp-connectable-p v))
(tramp-compat-ignore-error file-missing (unless (tramp-compat-string-search "/" filename)
(all-completions (all-completions
filename filename
(with-tramp-file-property v localname "file-name-all-completions" (with-tramp-file-property v localname "file-name-all-completions"
(let (result) (let (result)
;; Get a list of directories and files, including ;; Get a list of directories and files, including
;; reliably tagging the directories with a trailing "/". ;; reliably tagging the directories with a trailing "/".
;; Because I rock. --daniel@danann.net ;; Because I rock. --daniel@danann.net
(when (tramp-send-command-and-check (when (tramp-send-command-and-check
v v
(if (tramp-get-remote-perl v) (if (tramp-get-remote-perl v)
(progn (progn
(tramp-maybe-send-script (tramp-maybe-send-script
v tramp-perl-file-name-all-completions v tramp-perl-file-name-all-completions
"tramp_perl_file_name_all_completions") "tramp_perl_file_name_all_completions")
(format "tramp_perl_file_name_all_completions %s" (format "tramp_perl_file_name_all_completions %s"
(tramp-shell-quote-argument localname))) (tramp-shell-quote-argument localname)))
(format (concat (format (concat
"cd %s 2>&1 && %s -a 2>%s" "cd %s 2>&1 && %s -a 2>%s"
" | while IFS= read f; do" " | while IFS= read f; do"
" if %s -d \"$f\" 2>%s;" " if %s -d \"$f\" 2>%s;"
" then \\echo \"$f/\"; else \\echo \"$f\"; fi;" " then \\echo \"$f/\"; else \\echo \"$f\"; fi;"
" done") " done")
(tramp-shell-quote-argument localname) (tramp-shell-quote-argument localname)
(tramp-get-ls-command v) (tramp-get-ls-command v)
(tramp-get-remote-null-device v) (tramp-get-remote-null-device v)
(tramp-get-test-command v) (tramp-get-test-command v)
(tramp-get-remote-null-device v)))) (tramp-get-remote-null-device v))))
;; Now grab the output. ;; Now grab the output.
(with-current-buffer (tramp-get-buffer v) (with-current-buffer (tramp-get-buffer v)
(goto-char (point-max)) (goto-char (point-max))
(while (zerop (forward-line -1)) (while (zerop (forward-line -1))
(push (buffer-substring (point) (line-end-position)) result))) (push
result))))))))) (buffer-substring (point) (line-end-position)) result)))
result)))))))))
;; cp, mv and ln ;; cp, mv and ln

View file

@ -987,20 +987,19 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; files. ;; files.
(defun tramp-smb-handle-file-name-all-completions (filename directory) (defun tramp-smb-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files." "Like `file-name-all-completions' for Tramp files."
(tramp-compat-ignore-error file-missing (tramp-skeleton-file-name-all-completions filename directory
(all-completions (all-completions
filename filename
(when (file-directory-p directory) (when (file-directory-p directory)
(with-parsed-tramp-file-name (expand-file-name directory) nil (with-parsed-tramp-file-name (expand-file-name directory) nil
(with-tramp-file-property v localname "file-name-all-completions" (with-tramp-file-property v localname "file-name-all-completions"
(delete-dups (mapcar
(mapcar (lambda (x)
(lambda (x) (list
(list (if (tramp-compat-string-search "d" (nth 1 x))
(if (tramp-compat-string-search "d" (nth 1 x)) (file-name-as-directory (nth 0 x))
(file-name-as-directory (nth 0 x)) (nth 0 x))))
(nth 0 x)))) (tramp-smb-get-file-entries directory))))))))
(tramp-smb-get-file-entries directory)))))))))
(defun tramp-smb-handle-file-system-info (filename) (defun tramp-smb-handle-file-system-info (filename)
"Like `file-system-info' for Tramp files." "Like `file-system-info' for Tramp files."

View file

@ -467,7 +467,7 @@ the result will be a local, non-Tramp, file name."
(defun tramp-sudoedit-handle-file-name-all-completions (filename directory) (defun tramp-sudoedit-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files." "Like `file-name-all-completions' for Tramp files."
(tramp-compat-ignore-error file-missing (tramp-skeleton-file-name-all-completions filename directory
(all-completions (all-completions
filename filename
(with-parsed-tramp-file-name (expand-file-name directory) nil (with-parsed-tramp-file-name (expand-file-name directory) nil
@ -481,13 +481,11 @@ the result will be a local, non-Tramp, file name."
(if (ignore-errors (file-directory-p (expand-file-name f directory))) (if (ignore-errors (file-directory-p (expand-file-name f directory)))
(file-name-as-directory f) (file-name-as-directory f)
f)) f))
(delq (mapcar
nil (lambda (l) (and (not (string-match-p (rx bol (* blank) eol) l)) l))
(mapcar (split-string
(lambda (l) (and (not (string-match-p (rx bol (* blank) eol) l)) l)) (tramp-get-buffer-string (tramp-get-connection-buffer v))
(split-string "\n" 'omit))))))))
(tramp-get-buffer-string (tramp-get-connection-buffer v))
"\n" 'omit)))))))))
(defun tramp-sudoedit-handle-file-readable-p (filename) (defun tramp-sudoedit-handle-file-readable-p (filename)
"Like `file-readable-p' for Tramp files." "Like `file-readable-p' for Tramp files."

View file

@ -3069,85 +3069,100 @@ not in completion mode."
(tramp-run-real-handler #'file-exists-p (list filename)))) (tramp-run-real-handler #'file-exists-p (list filename))))
(defmacro tramp-skeleton-file-name-all-completions
(_filename _directory &rest body)
"Skeleton for `tramp-*-handle-filename-all-completions'.
BODY is the backend specific code."
(declare (indent 2) (debug t))
`(tramp-compat-ignore-error file-missing
(delete-dups (delq nil
(let* ((case-fold-search read-file-name-completion-ignore-case)
(regexp (mapconcat #'identity completion-regexp-list "\\|"))
(result ,@body))
(if (consp completion-regexp-list)
;; Discriminate over `completion-regexp-list'.
(mapcar
(lambda (x) (and (stringp x) (string-match-p regexp x) x))
result)
result))))))
;; Method, host name and user name completion. ;; Method, host name and user name completion.
;; `tramp-completion-dissect-file-name' returns a list of ;; `tramp-completion-dissect-file-name' returns a list of
;; `tramp-file-name' structures. For all of them we return possible ;; `tramp-file-name' structures. For all of them we return possible
;; completions. ;; completions.
(defun tramp-completion-handle-file-name-all-completions (filename directory) (defun tramp-completion-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for partial Tramp files." "Like `file-name-all-completions' for partial Tramp files."
(let ((fullname (tramp-skeleton-file-name-all-completions filename directory
(tramp-drop-volume-letter (expand-file-name filename directory))) (let ((fullname
;; When `tramp-syntax' is `simplified', we need a default method. (tramp-drop-volume-letter (expand-file-name filename directory)))
(tramp-default-method ;; When `tramp-syntax' is `simplified', we need a default method.
(and (string-empty-p tramp-postfix-method-format) (tramp-default-method
tramp-default-method)) (and (string-empty-p tramp-postfix-method-format)
(tramp-default-method-alist tramp-default-method))
(and (string-empty-p tramp-postfix-method-format) (tramp-default-method-alist
tramp-default-method-alist)) (and (string-empty-p tramp-postfix-method-format)
tramp-default-user tramp-default-user-alist tramp-default-method-alist))
tramp-default-host tramp-default-host-alist tramp-default-user tramp-default-user-alist
hop result result1) tramp-default-host tramp-default-host-alist
hop result result1)
;; Suppress hop from completion. ;; Suppress hop from completion.
(when (string-match (when (string-match
(tramp-compat-rx (tramp-compat-rx
(regexp tramp-prefix-regexp) (regexp tramp-prefix-regexp)
(group (+ (regexp tramp-remote-file-name-spec-regexp) (group (+ (regexp tramp-remote-file-name-spec-regexp)
(regexp tramp-postfix-hop-regexp)))) (regexp tramp-postfix-hop-regexp))))
fullname) fullname)
(setq hop (match-string 1 fullname) (setq hop (match-string 1 fullname)
fullname (replace-match "" nil nil fullname 1))) fullname (replace-match "" nil nil fullname 1)))
;; Possible completion structures. ;; Possible completion structures.
(dolist (elt (tramp-completion-dissect-file-name fullname)) (dolist (elt (tramp-completion-dissect-file-name fullname))
(let* ((method (tramp-file-name-method elt)) (let* ((method (tramp-file-name-method elt))
(user (tramp-file-name-user elt)) (user (tramp-file-name-user elt))
(host (tramp-file-name-host elt)) (host (tramp-file-name-host elt))
(localname (tramp-file-name-localname elt)) (localname (tramp-file-name-localname elt))
(m (tramp-find-method method user host)) (m (tramp-find-method method user host))
all-user-hosts) all-user-hosts)
(unless localname ;; Nothing to complete. (unless localname ;; Nothing to complete.
(if (or user host)
;; Method dependent user / host combinations.
(progn
(mapc
(lambda (x)
(setq all-user-hosts
(append all-user-hosts
(funcall (nth 0 x) (nth 1 x)))))
(tramp-get-completion-function m))
(if (or user host) (setq result
(append result
(mapcar
(lambda (x)
(tramp-get-completion-user-host
method user host (nth 0 x) (nth 1 x)))
(delq nil all-user-hosts)))))
;; Method dependent user / host combinations. ;; Possible methods.
(progn (setq result
(mapc (append result (tramp-get-completion-methods m)))))))
(lambda (x)
(setq all-user-hosts
(append all-user-hosts
(funcall (nth 0 x) (nth 1 x)))))
(tramp-get-completion-function m))
(setq result ;; Add hop.
(append result (dolist (elt result)
(mapcar (when elt
(lambda (x) (string-match tramp-prefix-regexp elt)
(tramp-get-completion-user-host (setq elt (replace-match (concat tramp-prefix-format hop) nil nil elt))
method user host (nth 0 x) (nth 1 x))) (push
(delq nil all-user-hosts))))) (substring elt (length (tramp-drop-volume-letter directory)))
result1)))
;; Possible methods. ;; Complete local parts.
(setq result (append
(append result (tramp-get-completion-methods m))))))) result1
(ignore-errors
;; Unify list, add hop, remove nil elements. (tramp-run-real-handler
(dolist (elt result) #'file-name-all-completions (list filename directory)))))))
(when elt
(string-match tramp-prefix-regexp elt)
(setq elt (replace-match (concat tramp-prefix-format hop) nil nil elt))
(push
(substring elt (length (tramp-drop-volume-letter directory)))
result1)))
;; Complete local parts.
(delete-dups
(append
result1
(ignore-errors
(tramp-run-real-handler
#'file-name-all-completions (list filename directory)))))))
;; Method, host name and user name completion for a file. ;; Method, host name and user name completion for a file.
(defun tramp-completion-handle-file-name-completion (defun tramp-completion-handle-file-name-completion