master e0b60120a1: Support Tramp multi-hop completion

[Michael Albinus]

branch: master
commit e0b60120a1c3433fe332bff56b5b7483b0424d5c
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>

    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 1cda8fc4c6..115048d59d 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 33afe820c5..51fc07117c 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 ()