procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Support Tramp user name completion

Browse source 
* lisp/net/tramp.el (tramp-build-completion-file-name-regexp)
(tramp-completion-handle-expand-file-name)
(tramp-completion-handle-file-name-directory): Support user name
completion.

* test/lisp/net/tramp-tests.el
(tramp-test26-interactive-file-name-completion): Fix test.
This commit is contained in:
Michael Albinus 2023-02-11 18:11:56 +01:00
parent 85a2eb2c78
commit 838415525b
2 changed files with 83 additions and 67 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

24
lisp/net/tramp.el
View file

@ -1211,9 +1211,12 @@ The `ftp' syntax does not support methods.")
(? (regexp tramp-completion-method-regexp)
;; Method separator, user name and host name.
(? (regexp tramp-postfix-method-regexp)
;; This is a little bit lax, but it serves.
(? (regexp tramp-host-regexp))))
(? (regexp tramp-user-regexp)
(regexp tramp-postfix-user-regexp))
(? (| (regexp tramp-host-regexp) ;; This includes a user.
(: (regexp tramp-prefix-ipv6-regexp)
(? (regexp tramp-ipv6-regexp)
(? (regexp tramp-postfix-ipv6-regexp))))))))
eos)))
(defvar tramp-completion-file-name-regexp
@ -2958,7 +2961,8 @@ not in completion mode."
(concat dir filename))
((string-match-p
(rx bos (regexp tramp-prefix-regexp)
(? (regexp tramp-method-regexp) (regexp tramp-postfix-method-regexp))
(? (regexp tramp-method-regexp) (regexp tramp-postfix-method-regexp)
(? (regexp tramp-user-regexp) (regexp tramp-postfix-user-regexp)))
eos)
dir)
(concat dir filename))
@ -3250,11 +3254,21 @@ PARTIAL-USER must match USER, PARTIAL-HOST must match HOST."
(rx (group
(regexp tramp-prefix-regexp)
(group (regexp tramp-method-regexp))
(regexp tramp-postfix-method-regexp)))
(regexp tramp-postfix-method-regexp)
(? (regexp tramp-user-regexp)
(regexp tramp-postfix-user-regexp))))
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)

126
test/lisp/net/tramp-tests.el
View file

@ -4643,13 +4643,15 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
"Check interactive completion with different `completion-styles'."
(tramp-cleanup-connection tramp-test-vec nil 'keep-password)
;; Method and host name in completion mode. This kind of completion
;; Method and host name in completion mode. This kind of completion
;; does not work on MS Windows.
(unless (memq system-type '(cygwin windows-nt))
(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))
(orig-syntax tramp-syntax)
(non-essential t))
(non-essential t)
(inhibit-message t))
(when (and (stringp host) (string-match tramp-host-with-port-regexp host))
(setq host (match-string 1 host)))
@ -4689,68 +4691,70 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
tramp-postfix-ipv6-format))
test result completions)
;; Complete method name.
(unless (string-empty-p tramp-method-regexp)
(ignore-errors (kill-buffer "*Completions*"))
(discard-input)
(setq test (concat
tramp-prefix-format
(substring-no-properties method 0 2))
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
"syntax: %s style: %s test: %s result: %s"
syntax style test result)
(should
(string-prefix-p
(concat tramp-prefix-format method-string)
result)))
(with-current-buffer "*Completions*"
;; We must remove leading `default-directory'.
(goto-char (point-min))
(let ((inhibit-read-only t))
(while (re-search-forward "//" nil 'noerror)
(delete-region (line-beginning-position) (point))))
(goto-char (point-min))
(re-search-forward
(rx bol (1+ nonl) "possible completions:" eol))
(forward-line 1)
(setq completions
(split-string
(buffer-substring-no-properties (point) (point-max))
(rx (any "\r\n")) 'omit)))
(tramp--test-message
"syntax: %s style: %s test: %s result: %s completions: %S"
syntax style test result completions)
(should (member method-string completions))))
(dolist
(test-and-result
;; These are triples (TEST-STRING SINGLE-RESULT
;; COMPLETION-RESULT).
(append
;; Complete method name.
(unless (string-empty-p tramp-method-regexp)
`((,(concat
tramp-prefix-format
(substring-no-properties method 0 2))
,(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))
,(concat
tramp-prefix-format method-string
user tramp-postfix-user-format)
,(concat
user tramp-postfix-user-format))))
;; 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))
,(concat
tramp-prefix-format method-string
ipv6-prefix host
ipv6-postfix tramp-postfix-host-format)
,(concat
ipv6-prefix host
ipv6-postfix tramp-postfix-host-format))))
;; Complete user and host name.
(unless (or (tramp-string-empty-or-nil-p user)
(tramp-string-empty-or-nil-p host))
`((,(concat
tramp-prefix-format method-string
user tramp-postfix-user-format
ipv6-prefix (substring-no-properties host 0 2))
,(concat
tramp-prefix-format method-string
user tramp-postfix-user-format
ipv6-prefix host
ipv6-postfix tramp-postfix-host-format)
,(concat
ipv6-prefix host
ipv6-postfix tramp-postfix-host-format))))))
;; Complete host name.
(unless (or (tramp-string-empty-or-nil-p host)
(tramp--test-gvfs-p method))
(ignore-errors (kill-buffer "*Completions*"))
(discard-input)
(setq test (concat
tramp-prefix-format method-string
(substring-no-properties host 0 2))
(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
"syntax: %s style: %s test: %s result: %s"
syntax style test result)
(should
(string-equal
(concat
tramp-prefix-format method-string
ipv6-prefix host ipv6-postfix tramp-postfix-host-format)
result)))
;; (tramp--test-message
;; "syntax: %s style: %s test: %s result: %s"
;; syntax style test result)
(should (string-prefix-p (cadr test-and-result) result)))
(with-current-buffer "*Completions*"
;; We must remove leading `default-directory'.
(goto-char (point-min))
@ -4765,13 +4769,11 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(split-string
(buffer-substring-no-properties (point) (point-max))
(rx (any "\r\n")) 'omit)))
(tramp--test-message
"syntax: %s style: %s test: %s result: %s completions: %S"
syntax style test result completions)
(should
(member
(concat host tramp-postfix-host-format)
completions)))))))
;; (tramp--test-message
;; "syntax: %s style: %s test: %s result: %s completions: %S"
;; syntax style test result completions)
(should (member (caddr test-and-result) completions)))))))
;; Cleanup.
(tramp-change-syntax orig-syntax)))))