4 files changed, 84 insertions, 76 deletions

diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el
index 45e3bf0a606..ac8b76b9442 100644
--- a/lisp/net/tramp-archive.el
+++ b/lisp/net/tramp-archive.el
@@ -301,27 +301,42 @@ pass to the OPERATION."
        t))
 
 (defvar tramp-archive-hash (make-hash-table :test 'equal)
-  "Hash table for archive local copies.")
-
-(defun tramp-archive-local-copy (archive)
-  "Return copy of ARCHIVE, usable by GVFS.
-ARCHIVE is the archive component of an archive file name."
-  (setq archive (file-truename archive))
-  (let ((tramp-verbose 0))
-    (with-tramp-connection-property
-        ;; This is just an auxiliary VEC for caching properties.
-        (make-tramp-file-name :method tramp-archive-method :host archive)
-        "archive"
+  "Hash table for archive local copies.
+The hash key is the archive name.  The value is a cons of the
+used `tramp-file-name' structure for tramp-gvfs, and the file
+name of a local copy, if any.")
+
+(defun tramp-archive-dissect-file-name (name)
+  "Return a `tramp-file-name' structure.
+The structure consists of the `tramp-archive-method' method, the
+hexlified archive name as host, and the localname.  The archive
+name is kept in slot `hop'"
+  (save-match-data
+    (unless (tramp-archive-file-name-p name)
+      (tramp-compat-user-error nil "Not an archive file name: \"%s\"" name))
+    ;; The `string-match' happened in `tramp-archive-file-name-p'.
+    (let ((archive (match-string 1 name))
+          (localname (match-string 2 name))
+          (tramp-verbose 0)
+          vec copy)
+
+      (setq archive (file-truename archive))
+
       (cond
+       ;; The value is already in the hash table.
+       ((setq vec (car (gethash archive tramp-archive-hash))))
+
        ;; File archives inside file archives.
        ((tramp-archive-file-name-p archive)
         (let ((archive
                (tramp-make-tramp-file-name
                 (tramp-archive-dissect-file-name archive) nil 'noarchive)))
-          ;; We call `file-attributes' in order to mount the archive.
-          (file-attributes archive)
-          (puthash archive nil tramp-archive-hash)
-          archive))
+          (setq vec
+                (make-tramp-file-name
+                 :method tramp-archive-method :hop archive
+                 :host (url-hexify-string (tramp-gvfs-url-file-name archive)))))
+        (puthash archive (list vec) tramp-archive-hash))
+
        ;; http://...
        ((and url-handler-mode
              tramp-compat-use-url-tramp-p
@@ -332,26 +347,36 @@ ARCHIVE is the archive component of an archive file name."
                  (url-type (url-generic-parse-url archive))
                  url-tramp-protocols))
                (archive (url-tramp-convert-url-to-tramp archive)))
-          (puthash archive nil tramp-archive-hash)
-          archive))
+          (setq vec
+                (make-tramp-file-name
+                 :method tramp-archive-method :hop archive
+                 :host (url-hexify-string (tramp-gvfs-url-file-name archive)))))
+          (puthash archive (list vec) tramp-archive-hash))
+
        ;; GVFS supported schemes.
        ((or (tramp-gvfs-file-name-p archive)
             (not (file-remote-p archive)))
-        (puthash archive nil tramp-archive-hash)
-        archive)
+        (setq vec
+              (make-tramp-file-name
+               :method tramp-archive-method :hop archive
+               :host (url-hexify-string (tramp-gvfs-url-file-name archive))))
+        (puthash archive (list vec) tramp-archive-hash))
+
        ;; Anything else.  Here we call `file-local-copy', which we
        ;; have avoided so far.
        (t (let ((inhibit-file-name-operation 'file-local-copy)
                 (inhibit-file-name-handlers
-                 (cons 'jka-compr-handler inhibit-file-name-handlers))
-                result)
-            (or (and (setq result (gethash archive tramp-archive-hash nil))
-                     (file-readable-p result))
-                (puthash
-                 archive
-                 (setq result (file-local-copy archive))
-                 tramp-archive-hash))
-            result))))))
+                 (cons 'jka-compr-handler inhibit-file-name-handlers)))
+            (setq copy (file-local-copy archive)
+                  vec
+                  (make-tramp-file-name
+                   :method tramp-archive-method :hop archive
+                   :host (url-hexify-string (tramp-gvfs-url-file-name copy)))))
+          (puthash archive (cons vec copy) tramp-archive-hash)))
+
+      ;; So far, `vec' handles just the mount point.  Add `localname'.
+      (setf (tramp-file-name-localname vec) localname)
+      vec)))
 
 ;;;###tramp-autoload
 (defun tramp-archive-cleanup-hash ()
@@ -360,16 +385,10 @@ ARCHIVE is the archive component of an archive file name."
    (lambda (key value)
      ;; Unmount local copy.
      (ignore-errors
-       (let ((tramp-gvfs-methods tramp-archive-all-gvfs-methods)
-             (file-archive (file-name-as-directory key)))
-         (tramp-message
-          (and (tramp-tramp-file-p key) (tramp-dissect-file-name key)) 3
-          "Unmounting %s" file-archive)
-         (tramp-gvfs-unmount
-          (tramp-dissect-file-name
-           (tramp-archive-gvfs-file-name file-archive)))))
+       (tramp-message (car value) 3 "Unmounting %s" (or (cdr value) key))
+       (tramp-gvfs-unmount (car value)))
      ;; Delete local copy.
-     (ignore-errors (when value (delete-file value)))
+     (ignore-errors (delete-file (cdr value)))
      (remhash key tramp-archive-hash))
    tramp-archive-hash)
   (clrhash tramp-archive-hash))
@@ -380,24 +399,6 @@ ARCHIVE is the archive component of an archive file name."
             (remove-hook 'kill-emacs-hook
                          'tramp-archive-cleanup-hash)))
 
-(defun tramp-archive-dissect-file-name (name)
-  "Return a `tramp-file-name' structure.
-The structure consists of the `tramp-archive-method' method, the
-hexlified archive name as host, and the localname.  The archive
-name is kept in slot `hop'"
-  (save-match-data
-    (unless (tramp-archive-file-name-p name)
-      (tramp-compat-user-error nil "Not an archive file name: \"%s\"" name))
-    ;; The `string-match' happened in `tramp-archive-file-name-p'.
-    (let ((archive (match-string 1 name))
-          (localname (match-string 2 name))
-          (tramp-verbose 0))
-      (make-tramp-file-name
-       :method tramp-archive-method :user nil :domain nil :host
-       (url-hexify-string
-        (tramp-gvfs-url-file-name (tramp-archive-local-copy archive)))
-       :port nil :localname localname :hop archive))))
-
 (defsubst tramp-file-name-archive (vec)
   "Extract the archive file name from VEC.
 VEC is expected to be a `tramp-file-name', with the method being
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 6745ae02c7b..70ac077a7c5 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -1778,13 +1778,16 @@ file-notify events."
 
 (defun tramp-gvfs-unmount (vec)
   "Unmount the object identified by VEC."
-  (let ((vec (copy-tramp-file-name vec)))
-    (setf (tramp-file-name-localname vec) "/"
-          (tramp-file-name-hop vec) nil)
-    (when (tramp-gvfs-connection-mounted-p vec)
-      (tramp-gvfs-send-command
-       vec "gvfs-mount" "-u"
-       (tramp-gvfs-url-file-name (tramp-make-tramp-file-name vec))))))
+  (setf (tramp-file-name-localname vec) "/"
+        (tramp-file-name-hop vec) nil)
+  (when (tramp-gvfs-connection-mounted-p vec)
+    (tramp-gvfs-send-command
+     vec "gvfs-mount" "-u"
+     (tramp-gvfs-url-file-name (tramp-make-tramp-file-name vec))))
+  (while (tramp-gvfs-connection-mounted-p vec)
+    (read-event nil nil 0.1))
+  (tramp-flush-connection-properties vec)
+  (tramp-flush-connection-properties (tramp-get-connection-process vec)))
 
 (defun tramp-gvfs-mount-spec-entry (key value)
   "Construct a mount-spec entry to be used in a mount_spec.
diff --git a/test/lisp/net/tramp-archive-resources/foo.tar.gz b/test/lisp/net/tramp-archive-resources/foo.tar.gz
index 68925b147fc..0d2e9878dd7 100644
--- a/test/lisp/net/tramp-archive-resources/foo.tar.gz
+++ b/test/lisp/net/tramp-archive-resources/foo.tar.gz
diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el
index 149ed370432..82dd5de8b9a 100644
--- a/test/lisp/net/tramp-archive-tests.el
+++ b/test/lisp/net/tramp-archive-tests.el
@@ -99,9 +99,9 @@ variables, so we check the Emacs version directly."
    (tramp-archive-file-name-p (concat tramp-archive-test-archive "foo/bar")))
   ;; A file archive inside a file archive.
   (should
-   (tramp-archive-file-name-p (concat tramp-archive-test-archive "foo.tar")))
+   (tramp-archive-file-name-p (concat tramp-archive-test-archive "baz.tar")))
   (should
-   (tramp-archive-file-name-p (concat tramp-archive-test-archive "foo.tar/"))))
+   (tramp-archive-file-name-p (concat tramp-archive-test-archive "baz.tar/"))))
 
 (ert-deftest tramp-archive-test02-file-name-dissect ()
   "Check archive file name components."
@@ -145,13 +145,14 @@ variables, so we check the Emacs version directly."
 
   ;; File archive in file archive.
   (let* ((tramp-archive-test-file-archive
-          (concat tramp-archive-test-archive "bar.tar"))
+          (concat tramp-archive-test-archive "baz.tar"))
          (tramp-archive-test-archive
           (file-name-as-directory tramp-archive-test-file-archive))
          (tramp-methods (cons `(,tramp-archive-method) tramp-methods))
          (tramp-gvfs-methods tramp-archive-all-gvfs-methods))
     (unwind-protect
-        (with-parsed-tramp-archive-file-name tramp-archive-test-archive nil
+        (with-parsed-tramp-archive-file-name
+            (expand-file-name "bar" tramp-archive-test-archive) nil
           (should (string-equal method tramp-archive-method))
           (should-not user)
           (should-not domain)
@@ -184,8 +185,12 @@ variables, so we check the Emacs version directly."
                 nil "/"))
               (file-name-nondirectory tramp-archive-test-file-archive)))))
           (should-not port)
-          (should (string-equal localname "/"))
-          (should (string-equal archive tramp-archive-test-file-archive)))
+          (should (string-equal localname "/bar"))
+          ;; The `archive' component is now already a Tramp file name.
+          (should
+           (string-equal
+            archive
+            (tramp-archive-gvfs-file-name tramp-archive-test-file-archive))))
 
       ;; Cleanup.
       (tramp-archive-cleanup-hash))))
@@ -290,9 +295,8 @@ This checks also `file-name-as-directory', `file-name-directory',
              :type tramp-file-missing))
 
       ;; Cleanup.
-      (ignore-errors
-        (tramp-archive--test-delete tmp-name)
-        (tramp-archive-cleanup-hash)))))
+      (ignore-errors (tramp-archive--test-delete tmp-name))
+      (tramp-archive-cleanup-hash))))
 
 (ert-deftest tramp-archive-test09-insert-file-contents ()
   "Check `insert-file-contents'."
@@ -444,7 +448,7 @@ This checks also `file-name-as-directory', `file-name-directory',
   (skip-unless tramp-gvfs-enabled)
 
   (let ((tmp-name tramp-archive-test-archive)
-        (files '("." ".." "bar" "foo.hrd" "foo.lnk" "foo.txt")))
+        (files '("." ".." "bar"  "baz.tar" "foo.hrd" "foo.lnk" "foo.txt")))
     (unwind-protect
         (progn
           (should (file-directory-p tmp-name))
@@ -656,7 +660,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
           ;; Local files.
           (should (equal (file-name-completion "fo" tmp-name) "foo."))
           (should (equal (file-name-completion "foo.txt" tmp-name) t))
-          (should (equal (file-name-completion "b" tmp-name) "bar/"))
+          (should (equal (file-name-completion "b" tmp-name) "ba"))
           (should-not (file-name-completion "a" tmp-name))
           (should
            (equal
@@ -668,18 +672,18 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
           (should
            (equal
             (sort (file-name-all-completions "b" tmp-name) 'string-lessp)
-            '("bar/")))
+            '("bar/" "baz.tar")))
           (should-not (file-name-all-completions "a" tmp-name))
           ;; `completion-regexp-list' restricts the completion to
           ;; files which match all expressions in this list.
           (let ((completion-regexp-list
                  `(,directory-files-no-dot-files-regexp "b")))
             (should
-             (equal (file-name-completion "" tmp-name) "bar/"))
+             (equal (file-name-completion "" tmp-name) "ba"))
             (should
              (equal
               (sort (file-name-all-completions "" tmp-name) 'string-lessp)
-              '("bar/")))))
+              '("bar/" "baz.tar")))))
 
       ;; Cleanup.
       (tramp-archive-cleanup-hash))))