mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-26 07:33:47 +00:00
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.
This commit is contained in:
Michael Albinus
parent
dde023b63a
commit
e0b60120a1
@ -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)))))
|
||||
|
||||
|
||||
@ -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 ()
|
||||
|
||||
Loading…
Reference in New Issue
Block a user