[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
emacs-29 7b0e07c41ae 1/2: Make Tramp aware of completion-regexp-list (do
|
From: |
Michael Albinus |
|
Subject: |
emacs-29 7b0e07c41ae 1/2: Make Tramp aware of completion-regexp-list (don't merge) |
|
Date: |
Fri, 17 Nov 2023 12:17:45 -0500 (EST) |
branch: emacs-29
commit 7b0e07c41ae92d4cb139b1c47ce9debc37cfffcb
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>
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.
---
lisp/net/tramp-adb.el | 21 +++---
lisp/net/tramp-crypt.el | 2 +-
lisp/net/tramp-fuse.el | 27 ++++----
lisp/net/tramp-gvfs.el | 4 +-
lisp/net/tramp-sh.el | 81 ++++++++++++-----------
lisp/net/tramp-smb.el | 17 +++--
lisp/net/tramp-sudoedit.el | 14 ++--
lisp/net/tramp.el | 161 +++++++++++++++++++++++++--------------------
8 files changed, 168 insertions(+), 159 deletions(-)
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index f16c97a235c..27645e143af 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -449,7 +449,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."
- (tramp-compat-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
@@ -464,17 +464,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 62cd3f0a3b2..1cc4e96bc99 100644
--- a/lisp/net/tramp-crypt.el
+++ b/lisp/net/tramp-crypt.el
@@ -735,7 +735,7 @@ absolute file names."
(defun tramp-crypt-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
- (tramp-compat-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 e4610b069ad..1446d31a869 100644
--- a/lisp/net/tramp-fuse.el
+++ b/lisp/net/tramp-fuse.el
@@ -104,22 +104,21 @@
(defun tramp-fuse-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
- (tramp-fuse-remove-hidden-files
- (tramp-compat-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 07390b50df2..9a94a2f4c9b 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -1434,8 +1434,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)
- (tramp-compat-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 74b1638f120..7dc75cb337a 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -1831,46 +1831,47 @@ 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)
- (tramp-compat-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
- (when (tramp-send-command-and-check
- v
- (if (tramp-get-remote-perl v)
- (progn
- (tramp-maybe-send-script
- v tramp-perl-file-name-all-completions
- "tramp_perl_file_name_all_completions")
- (format "tramp_perl_file_name_all_completions %s"
- (tramp-shell-quote-argument localname)))
-
- (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
+ (when (tramp-send-command-and-check
+ v
+ (if (tramp-get-remote-perl v)
+ (progn
+ (tramp-maybe-send-script
+ v tramp-perl-file-name-all-completions
+ "tramp_perl_file_name_all_completions")
+ (format "tramp_perl_file_name_all_completions %s"
+ (tramp-shell-quote-argument localname)))
+
+ (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 0ba24352a3d..5c385641cf8 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -987,20 +987,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."
- (tramp-compat-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 9939d93ba35..092a414f3de 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -467,7 +467,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."
- (tramp-compat-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
@@ -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)))
(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 29f5ffd68f0..8b1a49edbae 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -3069,85 +3069,100 @@ 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))
+ `(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.
;; `tramp-completion-dissect-file-name' returns a list of
;; `tramp-file-name' structures. For all of them we return possible
;; 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)))
- ;; 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
- hop result result1)
-
- ;; Suppress hop from completion.
- (when (string-match
- (tramp-compat-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)))
-
- ;; 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)))))))
-
- ;; Unify list, add hop, remove nil elements.
- (dolist (elt result)
- (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)))))))
+ (tramp-skeleton-file-name-all-completions filename directory
+ (let ((fullname
+ (tramp-drop-volume-letter (expand-file-name filename directory)))
+ ;; 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
+ hop result result1)
+
+ ;; Suppress hop from completion.
+ (when (string-match
+ (tramp-compat-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)))
+
+ ;; 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)))))))
+
+ ;; Add hop.
+ (dolist (elt result)
+ (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.
+ (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