diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/net/tramp-archive.el | 111 | ||||
| -rw-r--r-- | lisp/net/tramp-gvfs.el | 17 |
2 files changed, 66 insertions, 62 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. |