From e0b60120a1c3433fe332bff56b5b7483b0424d5c Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 12 Feb 2023 20:22:10 +0100 Subject: [PATCH] Support Tramp multi-hop completion * lisp/net/tramp.el (tramp-completion-handle-expand-file-name) (tramp-completion-handle-file-exists-p) (tramp-completion-handle-file-name-directory): Support multi-hop completion. * test/lisp/net/tramp-tests.el (tramp-test26-interactive-file-name-completion): Fix test. --- lisp/net/tramp.el | 41 +++++++++++++++++++++--------------- test/lisp/net/tramp-tests.el | 37 ++++++++++++++++++++++---------- 2 files changed, 50 insertions(+), 28 deletions(-) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 1cda8fc4c61..115048d59db 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2961,6 +2961,8 @@ not in completion mode." (concat dir filename)) ((string-match-p (rx bos (regexp tramp-prefix-regexp) + (* (regexp tramp-remote-file-name-spec-regexp) + (regexp tramp-postfix-hop-regexp)) (? (regexp tramp-method-regexp) (regexp tramp-postfix-method-regexp) (? (regexp tramp-user-regexp) (regexp tramp-postfix-user-regexp))) eos) @@ -2984,6 +2986,8 @@ not in completion mode." (string-match (rx (regexp tramp-prefix-regexp) + (* (regexp tramp-remote-file-name-spec-regexp) + (regexp tramp-postfix-hop-regexp)) (group (regexp tramp-method-regexp)) (? (regexp tramp-postfix-method-regexp)) eos) @@ -2993,6 +2997,8 @@ not in completion mode." ((string-match (rx (regexp tramp-prefix-regexp) + (* (regexp tramp-remote-file-name-spec-regexp) + (regexp tramp-postfix-hop-regexp)) (group (regexp tramp-remote-file-name-spec-regexp)) eos) filename) @@ -3249,30 +3255,31 @@ PARTIAL-USER must match USER, PARTIAL-HOST must match HOST." ;; method. In the `separate' file name syntax, we return "/[" when ;; `filename' is "/[string" w/o a trailing method separator "/". (cond - ((and (not (string-empty-p tramp-method-regexp)) - (string-match + ((string-match + (rx (group (regexp tramp-prefix-regexp) + (* (regexp tramp-remote-file-name-spec-regexp) + (regexp tramp-postfix-hop-regexp))) + (? (regexp tramp-completion-method-regexp)) eos) + filename) + (match-string 1 filename)) + ((and (string-match (rx (group (regexp tramp-prefix-regexp) + (* (regexp tramp-remote-file-name-spec-regexp) + (regexp tramp-postfix-hop-regexp)) (group (regexp tramp-method-regexp)) (regexp tramp-postfix-method-regexp) (? (regexp tramp-user-regexp) - (regexp tramp-postfix-user-regexp)))) + (regexp tramp-postfix-user-regexp))) + (? (| (regexp tramp-host-regexp) + (: (regexp tramp-prefix-ipv6-regexp) + (? (regexp tramp-ipv6-regexp) + (? (regexp tramp-postfix-ipv6-regexp)))))) + eos) filename) ;; Is it a valid method? - (assoc (match-string 2 filename) tramp-methods)) - (match-string 1 filename)) - ((and (string-empty-p tramp-method-regexp) - (string-match - (rx (group - (regexp tramp-prefix-regexp) - (? (regexp tramp-user-regexp) - (regexp tramp-postfix-user-regexp)))) - filename)) - (match-string 1 filename)) - ((string-match - (rx (group (regexp tramp-prefix-regexp)) - (regexp tramp-completion-method-regexp) eos) - filename) + (or (tramp-string-empty-or-nil-p (match-string 2 filename)) + (assoc (match-string 2 filename) tramp-methods))) (match-string 1 filename)) (t (tramp-run-real-handler #'file-name-directory (list filename))))) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 33afe820c58..51fc07117c5 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4638,7 +4638,6 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; This test is inspired by Bug#51386, Bug#52758, Bug#53513, Bug#54042 ;; and Bug#60505. -;; TODO: Add tests for user names and multi-hop file names. (ert-deftest tramp-test26-interactive-file-name-completion () "Check interactive completion with different `completion-styles'." (tramp-cleanup-connection tramp-test-vec nil 'keep-password) @@ -4649,12 +4648,15 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (let ((method (file-remote-p ert-remote-temporary-file-directory 'method)) (user (file-remote-p ert-remote-temporary-file-directory 'user)) (host (file-remote-p ert-remote-temporary-file-directory 'host)) + (hop (file-remote-p ert-remote-temporary-file-directory 'hop)) (orig-syntax tramp-syntax) (non-essential t) (inhibit-message t)) (when (and (stringp host) (string-match tramp-host-with-port-regexp host)) (setq host (match-string 1 host))) + ;; (trace-function #'tramp-completion-file-name-handler) + ;; (trace-function #'completion-file-name-table) (unwind-protect (dolist (syntax (if (tramp--test-expensive-test-p) (tramp-syntax-values) `(,orig-syntax))) @@ -4689,25 +4691,29 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (ipv6-postfix (and (string-match-p tramp-ipv6-regexp host) tramp-postfix-ipv6-format)) + ;; The hop string fits only the initial syntax. + (hop (and (eq tramp-syntax orig-syntax) hop)) test result completions) (dolist (test-and-result - ;; These are triples (TEST-STRING SINGLE-RESULT - ;; COMPLETION-RESULT). + ;; These are triples (TEST-STRING RESULT-CHECK + ;; COMPLETION-CHECK). (append ;; Complete method name. (unless (string-empty-p tramp-method-regexp) `((,(concat - tramp-prefix-format - (substring-no-properties method 0 2)) + tramp-prefix-format hop + (substring-no-properties + method 0 (min 2 (length method)))) ,(concat tramp-prefix-format method-string) ,method-string))) ;; Complete user name. (unless (tramp-string-empty-or-nil-p user) `((,(concat - tramp-prefix-format method-string - (substring-no-properties user 0 2)) + tramp-prefix-format hop method-string + (substring-no-properties + user 0 (min 2 (length user)))) ,(concat tramp-prefix-format method-string user tramp-postfix-user-format) @@ -4716,8 +4722,10 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Complete host name. (unless (tramp-string-empty-or-nil-p host) `((,(concat - tramp-prefix-format method-string - ipv6-prefix (substring-no-properties host 0 2)) + tramp-prefix-format hop method-string + ipv6-prefix + (substring-no-properties + host 0 (min 2 (length host)))) ,(concat tramp-prefix-format method-string ipv6-prefix host @@ -4729,9 +4737,11 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (unless (or (tramp-string-empty-or-nil-p user) (tramp-string-empty-or-nil-p host)) `((,(concat - tramp-prefix-format method-string + tramp-prefix-format hop method-string user tramp-postfix-user-format - ipv6-prefix (substring-no-properties host 0 2)) + ipv6-prefix + (substring-no-properties + host 0 (min 2 (length host)))) ,(concat tramp-prefix-format method-string user tramp-postfix-user-format @@ -4742,12 +4752,14 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ipv6-postfix tramp-postfix-host-format)))))) (ignore-errors (kill-buffer "*Completions*")) + ;; (and (bufferp trace-buffer) (kill-buffer trace-buffer)) (discard-input) (setq test (car test-and-result) unread-command-events (mapcar #'identity (concat test "\t\t\n")) completions nil result (read-file-name "Prompt: ")) + (if (not (get-buffer "*Completions*")) (progn ;; (tramp--test-message @@ -4776,6 +4788,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (member (caddr test-and-result) completions))))))) ;; Cleanup. + ;; (tramp--test-message "%s" (tramp-get-buffer-string trace-buffer)) + ;; (untrace-function #'tramp-completion-file-name-handler) + ;; (untrace-function #'completion-file-name-table) (tramp-change-syntax orig-syntax))))) (ert-deftest tramp-test27-load () -- 2.39.2