From 7b0e07c41ae92d4cb139b1c47ce9debc37cfffcb Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 17 Nov 2023 18:16:58 +0100 Subject: [PATCH] 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 -- 2.39.2