From: Michael Albinus <michael.albinus@gmx.de>
Date: Fri, 17 Nov 2023 17:28:30 +0000 (+0100)
Subject: Make Tramp aware of completion-regexp-list
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=b1b9082b3eab0e83deeee622e61ad3d577646950;p=emacs.git
Make Tramp aware of completion-regexp-list
* 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.
---
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 3de4721ec77..acbf5ec01c6 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -435,7 +435,7 @@ Emacs dired can't find files."
(defun tramp-adb-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
- (ignore-error file-missing
+ (tramp-skeleton-file-name-all-completions filename directory
(all-completions
filename
(with-parsed-tramp-file-name (expand-file-name directory) nil
@@ -450,17 +450,14 @@ Emacs dired can't find files."
(file-name-as-directory f)
f))
(with-current-buffer (tramp-get-buffer v)
- (delete-dups
- (append
- ;; On some file systems like "sdcard", "." and ".." are
- ;; not included. We fix this by `delete-dups'.
- '("." "..")
- (delq
- nil
- (mapcar
- (lambda (l)
- (and (not (string-match-p (rx bol (* blank) eol) l)) l))
- (split-string (buffer-string) "\n"))))))))))))
+ (append
+ ;; On some file systems like "sdcard", "." and ".." are
+ ;; not included.
+ '("." "..")
+ (mapcar
+ (lambda (l)
+ (and (not (string-match-p (rx bol (* blank) eol) l)) l))
+ (split-string (buffer-string) "\n" 'omit))))))))))
(defun tramp-adb-handle-file-local-copy (filename)
"Like `file-local-copy' for Tramp files."
diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el
index 79eafc5c12e..587b9db067a 100644
--- a/lisp/net/tramp-crypt.el
+++ b/lisp/net/tramp-crypt.el
@@ -739,7 +739,7 @@ absolute file names."
(defun tramp-crypt-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
- (ignore-error file-missing
+ (tramp-skeleton-file-name-all-completions filename directory
(all-completions
filename
(let* (completion-regexp-list
diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el
index aadc64666a5..4b04f75ce96 100644
--- a/lisp/net/tramp-fuse.el
+++ b/lisp/net/tramp-fuse.el
@@ -102,22 +102,21 @@
(defun tramp-fuse-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
- (tramp-fuse-remove-hidden-files
- (ignore-error file-missing
+ (tramp-skeleton-file-name-all-completions filename directory
+ (tramp-fuse-remove-hidden-files
(all-completions
filename
- (delete-dups
- (append
- (file-name-all-completions
- filename (tramp-fuse-local-file-name directory))
- ;; Some storage systems do not return "." and "..".
- (let (result)
- (dolist (item '(".." ".") result)
- (when (string-prefix-p filename item)
- (catch 'match
- (dolist (elt completion-regexp-list)
- (unless (string-match-p elt item) (throw 'match nil)))
- (setq result (cons (concat item "/") result))))))))))))
+ (append
+ (file-name-all-completions
+ filename (tramp-fuse-local-file-name directory))
+ ;; Some storage systems do not return "." and "..".
+ (let (result)
+ (dolist (item '(".." ".") result)
+ (when (string-prefix-p filename item)
+ (catch 'match
+ (dolist (elt completion-regexp-list)
+ (unless (string-match-p elt item) (throw 'match nil)))
+ (setq result (cons (concat item "/") result)))))))))))
;; This function isn't used.
(defun tramp-fuse-handle-insert-directory
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 451c033a044..573d89c0c51 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -1463,8 +1463,8 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(defun tramp-gvfs-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
- (unless (tramp-compat-string-search "/" filename)
- (ignore-error file-missing
+ (tramp-skeleton-file-name-all-completions filename directory
+ (unless (tramp-compat-string-search "/" filename)
(all-completions
filename
(with-parsed-tramp-file-name (expand-file-name directory) nil
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 49acf8395c5..186ef12775a 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -1848,60 +1848,60 @@ ID-FORMAT valid values are `string' and `integer'."
;; files.
(defun tramp-sh-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
- (with-parsed-tramp-file-name (expand-file-name directory) nil
- (when (and (not (tramp-compat-string-search "/" filename))
- (tramp-connectable-p v))
- (unless (tramp-compat-string-search "/" filename)
- (ignore-error file-missing
- (all-completions
- filename
- (with-tramp-file-property v localname "file-name-all-completions"
- (let (result)
- ;; Get a list of directories and files, including
- ;; reliably tagging the directories with a trailing "/".
- ;; Because I rock. --daniel@danann.net
- (if (tramp-get-remote-perl v)
- (progn
- (tramp-maybe-send-script
- v tramp-perl-file-name-all-completions
- "tramp_perl_file_name_all_completions")
- (setq result
- (tramp-send-command-and-read
- v (format "tramp_perl_file_name_all_completions %s"
- (tramp-shell-quote-argument localname))
- 'noerror))
- ;; Cached values.
- (dolist (elt result)
- (tramp-set-file-property
- v (cadr elt) "file-directory-p" (nth 2 elt))
- (tramp-set-file-property
- v (cadr elt) "file-exists-p" (nth 3 elt))
- (tramp-set-file-property
- v (cadr elt) "file-readable-p" (nth 4 elt)))
- ;; Result.
- (mapcar #'car result))
-
- ;; Do it with ls.
- (when (tramp-send-command-and-check
- v (format (concat
- "cd %s 2>&1 && %s -a 2>%s"
- " | while IFS= read f; do"
- " if %s -d \"$f\" 2>%s;"
- " then echo \"$f/\"; else echo \"$f\"; fi;"
- " done")
- (tramp-shell-quote-argument localname)
- (tramp-get-ls-command v)
- (tramp-get-remote-null-device v)
- (tramp-get-test-command v)
- (tramp-get-remote-null-device v)))
-
- ;; Now grab the output.
- (with-current-buffer (tramp-get-buffer v)
- (goto-char (point-max))
- (while (zerop (forward-line -1))
- (push
- (buffer-substring (point) (line-end-position)) result)))
- result))))))))))
+ (tramp-skeleton-file-name-all-completions filename directory
+ (with-parsed-tramp-file-name (expand-file-name directory) nil
+ (when (and (not (tramp-compat-string-search "/" filename))
+ (tramp-connectable-p v))
+ (unless (tramp-compat-string-search "/" filename)
+ (all-completions
+ filename
+ (with-tramp-file-property v localname "file-name-all-completions"
+ (let (result)
+ ;; Get a list of directories and files, including
+ ;; reliably tagging the directories with a trailing "/".
+ ;; Because I rock. --daniel@danann.net
+ (if (tramp-get-remote-perl v)
+ (progn
+ (tramp-maybe-send-script
+ v tramp-perl-file-name-all-completions
+ "tramp_perl_file_name_all_completions")
+ (setq result
+ (tramp-send-command-and-read
+ v (format "tramp_perl_file_name_all_completions %s"
+ (tramp-shell-quote-argument localname))
+ 'noerror))
+ ;; Cached values.
+ (dolist (elt result)
+ (tramp-set-file-property
+ v (cadr elt) "file-directory-p" (nth 2 elt))
+ (tramp-set-file-property
+ v (cadr elt) "file-exists-p" (nth 3 elt))
+ (tramp-set-file-property
+ v (cadr elt) "file-readable-p" (nth 4 elt)))
+ ;; Result.
+ (mapcar #'car result))
+
+ ;; Do it with ls.
+ (when (tramp-send-command-and-check
+ v (format (concat
+ "cd %s 2>&1 && %s -a 2>%s"
+ " | while IFS= read f; do"
+ " if %s -d \"$f\" 2>%s;"
+ " then echo \"$f/\"; else echo \"$f\"; fi;"
+ " done")
+ (tramp-shell-quote-argument localname)
+ (tramp-get-ls-command v)
+ (tramp-get-remote-null-device v)
+ (tramp-get-test-command v)
+ (tramp-get-remote-null-device v)))
+
+ ;; Now grab the output.
+ (with-current-buffer (tramp-get-buffer v)
+ (goto-char (point-max))
+ (while (zerop (forward-line -1))
+ (push
+ (buffer-substring (point) (line-end-position)) result)))
+ result))))))))))
;; cp, mv and ln
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index ac1b29f08cd..e0622a26eeb 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -972,20 +972,19 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; files.
(defun tramp-smb-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
- (ignore-error file-missing
+ (tramp-skeleton-file-name-all-completions filename directory
(all-completions
filename
(when (file-directory-p directory)
(with-parsed-tramp-file-name (expand-file-name directory) nil
(with-tramp-file-property v localname "file-name-all-completions"
- (delete-dups
- (mapcar
- (lambda (x)
- (list
- (if (tramp-compat-string-search "d" (nth 1 x))
- (file-name-as-directory (nth 0 x))
- (nth 0 x))))
- (tramp-smb-get-file-entries directory)))))))))
+ (mapcar
+ (lambda (x)
+ (list
+ (if (tramp-compat-string-search "d" (nth 1 x))
+ (file-name-as-directory (nth 0 x))
+ (nth 0 x))))
+ (tramp-smb-get-file-entries directory))))))))
(defun tramp-smb-handle-file-system-info (filename)
"Like `file-system-info' for Tramp files."
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index 40e438435fc..87685c06c1f 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -489,7 +489,7 @@ the result will be a local, non-Tramp, file name."
(defun tramp-sudoedit-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
- (ignore-error file-missing
+ (tramp-skeleton-file-name-all-completions filename directory
(all-completions
filename
(with-parsed-tramp-file-name (expand-file-name directory) nil
@@ -503,13 +503,11 @@ the result will be a local, non-Tramp, file name."
(if (ignore-errors (file-directory-p (expand-file-name f directory)))
(file-name-as-directory f)
f))
- (delq
- nil
- (mapcar
- (lambda (l) (and (not (string-match-p (rx bol (* blank) eol) l)) l))
- (split-string
- (tramp-get-buffer-string (tramp-get-connection-buffer v))
- "\n" 'omit)))))))))
+ (mapcar
+ (lambda (l) (and (not (string-match-p (rx bol (* blank) eol) l)) l))
+ (split-string
+ (tramp-get-buffer-string (tramp-get-connection-buffer v))
+ "\n" 'omit))))))))
(defun tramp-sudoedit-handle-file-readable-p (filename)
"Like `file-readable-p' for Tramp files."
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 9cc319bef67..54f92cae98d 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -2741,6 +2741,23 @@ not in completion mode."
(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))
+ `(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))))))
+
(defvar tramp--last-hop-directory nil
"Tracks the directory from which to run login programs.")
@@ -2750,81 +2767,79 @@ not in completion mode."
;; completions.
(defun tramp-completion-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for partial Tramp files."
- (let ((fullname
- (tramp-drop-volume-letter (expand-file-name filename directory)))
- (directory (tramp-drop-volume-letter directory))
- tramp--last-hop-directory hop result result1)
-
- ;; Suppress hop from completion.
- (when (string-match
- (rx
- (regexp tramp-prefix-regexp)
- (group (+ (regexp tramp-remote-file-name-spec-regexp)
- (regexp tramp-postfix-hop-regexp))))
- fullname)
- (setq hop (match-string 1 fullname)
- fullname (replace-match "" nil nil fullname 1)
- tramp--last-hop-directory
- (tramp-make-tramp-file-name (tramp-dissect-hop-name hop))))
-
- (let (;; When `tramp-syntax' is `simplified', we need a default method.
- (tramp-default-method
- (and (string-empty-p tramp-postfix-method-format)
- tramp-default-method))
- (tramp-default-method-alist
- (and (string-empty-p tramp-postfix-method-format)
- tramp-default-method-alist))
- tramp-default-user tramp-default-user-alist
- tramp-default-host tramp-default-host-alist)
-
- ;; Possible completion structures.
- (dolist (elt (tramp-completion-dissect-file-name fullname))
- (let* ((method (tramp-file-name-method elt))
- (user (tramp-file-name-user elt))
- (host (tramp-file-name-host elt))
- (localname (tramp-file-name-localname elt))
- (m (tramp-find-method method user host))
- all-user-hosts)
-
- (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))
-
- (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)))))
-
- ;; Possible methods.
- (setq result
- (append result (tramp-get-completion-methods m hop)))))))
-
- ;; Unify list, add hop, remove nil elements.
- (dolist (elt result)
- (when elt
- (setq elt (replace-regexp-in-string
- tramp-prefix-regexp (concat tramp-prefix-format hop) elt))
- (push (substring elt (length directory)) result1)))
-
- ;; Complete local parts.
- (delete-dups
- (append
- result1
- (ignore-errors
- (tramp-run-real-handler
- #'file-name-all-completions (list filename directory))))))))
+ (tramp-skeleton-file-name-all-completions filename directory
+ (let ((fullname
+ (tramp-drop-volume-letter (expand-file-name filename directory)))
+ (directory (tramp-drop-volume-letter directory))
+ tramp--last-hop-directory hop result result1)
+
+ ;; Suppress hop from completion.
+ (when (string-match
+ (rx
+ (regexp tramp-prefix-regexp)
+ (group (+ (regexp tramp-remote-file-name-spec-regexp)
+ (regexp tramp-postfix-hop-regexp))))
+ fullname)
+ (setq hop (match-string 1 fullname)
+ fullname (replace-match "" nil nil fullname 1)
+ tramp--last-hop-directory
+ (tramp-make-tramp-file-name (tramp-dissect-hop-name hop))))
+
+ (let (;; When `tramp-syntax' is `simplified', we need a default method.
+ (tramp-default-method
+ (and (string-empty-p tramp-postfix-method-format)
+ tramp-default-method))
+ (tramp-default-method-alist
+ (and (string-empty-p tramp-postfix-method-format)
+ tramp-default-method-alist))
+ tramp-default-user tramp-default-user-alist
+ tramp-default-host tramp-default-host-alist)
+
+ ;; Possible completion structures.
+ (dolist (elt (tramp-completion-dissect-file-name fullname))
+ (let* ((method (tramp-file-name-method elt))
+ (user (tramp-file-name-user elt))
+ (host (tramp-file-name-host elt))
+ (localname (tramp-file-name-localname elt))
+ (m (tramp-find-method method user host))
+ all-user-hosts)
+
+ (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))
+
+ (setq result
+ (append result
+ (mapcar
+ (lambda (x)
+ (tramp-get-completion-user-host
+ method user host (nth 0 x) (nth 1 x)))
+ all-user-hosts))))
+
+ ;; Possible methods.
+ (setq result
+ (append result (tramp-get-completion-methods m hop)))))))
+
+ ;; Add hop.
+ (dolist (elt result)
+ (when elt
+ (setq elt (replace-regexp-in-string
+ tramp-prefix-regexp (concat tramp-prefix-format hop) elt))
+ (push (substring elt (length directory)) result1)))
+
+ ;; Complete local parts.
+ (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.
(defun tramp-completion-handle-file-name-completion