Support Tramp user name completion

* 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.

diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 36305dda496d49affba9925b121c8f8f318a3495..1cda8fc4c61fd0eb2c909901a3ae6d529b26b3e2 100644 (file)
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -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)

diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 85714e79bc028af425423a6e9d56cb2ddc294832..33afe820c580905ece001db479484b8ae4748a10 100644 (file)
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -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))))
-
-                ;; Complete host name.
-               (unless (or (tramp-string-empty-or-nil-p host)
-                           (tramp--test-gvfs-p method))
+               (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))))))
+
                   (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)))))