aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorMichael Albinus2018-02-04 13:25:10 +0100
committerMichael Albinus2018-02-04 13:25:10 +0100
commitd2630e456923d2bd70fdd59267fe6e3d8eeb69ca (patch)
treeca1fdb4b4048a2a16a4db53e81b7e8cc6af15b71 /lisp
parent327d251f8a857350a78029c31c7ab3f9797cc727 (diff)
downloademacs-d2630e456923d2bd70fdd59267fe6e3d8eeb69ca.tar.gz
emacs-d2630e456923d2bd70fdd59267fe6e3d8eeb69ca.zip
Make tramp-archive fit for older Emacsen
* lisp/net/tramp-archive.el (tramp-archive-enabled) (tramp-archive-file-name-handler-alist) (tramp-archive-file-name-handler): Adapt docstring. (tramp-register-archive-file-name-handler): Remove it from `after-init-hook' when unloading. (tramp-archive-gvfs-host): New defsubst. (tramp-archive-dissect-file-name): Use it. * lisp/net/tramp-cmds.el (tramp-cleanup-all-connections): Check that `tramp-archive-enabled' is bound. * test/lisp/net/tramp-archive-tests.el (tramp-archive-test42-auto-load): Check also that tramp-archive is not loaded when Tramp is loaded. (tramp-archive-test42-delay-load): Adapt test messages.
Diffstat (limited to 'lisp')
-rw-r--r--lisp/net/tramp-archive.el44
-rw-r--r--lisp/net/tramp-cmds.el3
2 files changed, 27 insertions, 20 deletions
diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el
index ac1c4e1448d..5f28756d753 100644
--- a/lisp/net/tramp-archive.el
+++ b/lisp/net/tramp-archive.el
@@ -116,8 +116,9 @@
116;; would load Tramp. So we make a cheaper check. 116;; would load Tramp. So we make a cheaper check.
117;;;###autoload 117;;;###autoload
118(defvar tramp-archive-enabled (featurep 'dbusbind) 118(defvar tramp-archive-enabled (featurep 'dbusbind)
119 "Non-nil when GVFS is available.") 119 "Non-nil when file archive support is available.")
120 120
121;; After loading tramp-gvfs.el, we know it better.
121(setq tramp-archive-enabled tramp-gvfs-enabled) 122(setq tramp-archive-enabled tramp-gvfs-enabled)
122 123
123;; <https://github.com/libarchive/libarchive/wiki/LibarchiveFormats> 124;; <https://github.com/libarchive/libarchive/wiki/LibarchiveFormats>
@@ -175,6 +176,9 @@ It must be supported by libarchive(3).")
175 "\\)" ;; \1 176 "\\)" ;; \1
176 "\\(" "/" ".*" "\\)" "\\'"))) ;; \2 177 "\\(" "/" ".*" "\\)" "\\'"))) ;; \2
177 178
179;; In older Emacsen (prior 27.1), `tramp-archive-autoload-file-name-regexp'
180;; is not autoloaded. So we cannot expect it to be known in
181;; tramp-loaddefs.el. But it exists, when tramp-archive.el is loaded.
178;;;###tramp-autoload 182;;;###tramp-autoload
179(defconst tramp-archive-file-name-regexp 183(defconst tramp-archive-file-name-regexp
180 (ignore-errors (tramp-archive-autoload-file-name-regexp)) 184 (ignore-errors (tramp-archive-autoload-file-name-regexp))
@@ -266,7 +270,7 @@ It must be supported by libarchive(3).")
266 (vc-registered . ignore) 270 (vc-registered . ignore)
267 (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) 271 (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
268 (write-region . tramp-archive-handle-not-implemented)) 272 (write-region . tramp-archive-handle-not-implemented))
269 "Alist of handler functions for GVFS archive method. 273 "Alist of handler functions for file archive method.
270Operations not mentioned here will be handled by the default Emacs primitives.") 274Operations not mentioned here will be handled by the default Emacs primitives.")
271 275
272(defsubst tramp-archive-file-name-for-operation (operation &rest args) 276(defsubst tramp-archive-file-name-for-operation (operation &rest args)
@@ -288,7 +292,7 @@ pass to the OPERATION."
288 292
289;;;###tramp-autoload 293;;;###tramp-autoload
290(defun tramp-archive-file-name-handler (operation &rest args) 294(defun tramp-archive-file-name-handler (operation &rest args)
291 "Invoke the GVFS archive related OPERATION. 295 "Invoke the file archive related OPERATION.
292First arg specifies the OPERATION, second arg is a list of arguments to 296First arg specifies the OPERATION, second arg is a list of arguments to
293pass to the OPERATION." 297pass to the OPERATION."
294 (let* ((filename (apply 'tramp-archive-file-name-for-operation 298 (let* ((filename (apply 'tramp-archive-file-name-for-operation
@@ -323,8 +327,16 @@ pass to the OPERATION."
323 (put 'tramp-archive-file-name-handler 'safe-magic t)))) 327 (put 'tramp-archive-file-name-handler 'safe-magic t))))
324 328
325;;;###autoload 329;;;###autoload
326(add-hook 'after-init-hook 'tramp-register-archive-file-name-handler) 330(progn
327 331 (add-hook 'after-init-hook 'tramp-register-archive-file-name-handler)
332 (add-hook
333 'tramp-archive-unload-hook
334 (lambda ()
335 (remove-hook
336 'after-init-hook 'tramp-register-archive-file-name-handler))))
337
338;; In older Emacsen (prior 27.1), the autoload above does not exist.
339;; So we call it again; it doesn't hurt.
328(tramp-register-archive-file-name-handler) 340(tramp-register-archive-file-name-handler)
329 341
330;; Mark `operations' the handler is responsible for. 342;; Mark `operations' the handler is responsible for.
@@ -343,12 +355,6 @@ pass to the OPERATION."
343 (remove-hook 355 (remove-hook
344 'url-handler-mode-hook 'tramp-register-file-name-handlers))))) 356 'url-handler-mode-hook 'tramp-register-file-name-handlers)))))
345 357
346;; Debug.
347;(trace-function-background 'tramp-archive-file-name-handler)
348;(trace-function-background 'tramp-gvfs-file-name-handler)
349;(trace-function-background 'tramp-file-name-archive)
350;(trace-function-background 'tramp-archive-dissect-file-name)
351
352 358
353;; File name conversions. 359;; File name conversions.
354 360
@@ -374,6 +380,10 @@ The hash key is the archive name. The value is a cons of the
374used `tramp-file-name' structure for tramp-gvfs, and the file 380used `tramp-file-name' structure for tramp-gvfs, and the file
375name of a local copy, if any.") 381name of a local copy, if any.")
376 382
383(defsubst tramp-archive-gvfs-host (archive)
384 "Return host name of ARCHIVE as used in GVFS for mounting"
385 (url-hexify-string (tramp-gvfs-url-file-name archive)))
386
377(defun tramp-archive-dissect-file-name (name) 387(defun tramp-archive-dissect-file-name (name)
378 "Return a `tramp-file-name' structure. 388 "Return a `tramp-file-name' structure.
379The structure consists of the `tramp-archive-method' method, the 389The structure consists of the `tramp-archive-method' method, the
@@ -397,8 +407,7 @@ name is kept in slot `hop'"
397 (let ((archive 407 (let ((archive
398 (tramp-make-tramp-file-name 408 (tramp-make-tramp-file-name
399 (tramp-archive-dissect-file-name archive) nil 'noarchive))) 409 (tramp-archive-dissect-file-name archive) nil 'noarchive)))
400 (setf (tramp-file-name-host vec) 410 (setf (tramp-file-name-host vec) (tramp-archive-gvfs-host archive)))
401 (url-hexify-string (tramp-gvfs-url-file-name archive))))
402 (puthash archive (list vec) tramp-archive-hash)) 411 (puthash archive (list vec) tramp-archive-hash))
403 412
404 ;; http://... 413 ;; http://...
@@ -411,15 +420,13 @@ name is kept in slot `hop'"
411 (url-type (url-generic-parse-url archive)) 420 (url-type (url-generic-parse-url archive))
412 url-tramp-protocols)) 421 url-tramp-protocols))
413 (archive (url-tramp-convert-url-to-tramp archive))) 422 (archive (url-tramp-convert-url-to-tramp archive)))
414 (setf (tramp-file-name-host vec) 423 (setf (tramp-file-name-host vec) (tramp-archive-gvfs-host archive)))
415 (url-hexify-string (tramp-gvfs-url-file-name archive))))
416 (puthash archive (list vec) tramp-archive-hash)) 424 (puthash archive (list vec) tramp-archive-hash))
417 425
418 ;; GVFS supported schemes. 426 ;; GVFS supported schemes.
419 ((or (tramp-gvfs-file-name-p archive) 427 ((or (tramp-gvfs-file-name-p archive)
420 (not (file-remote-p archive))) 428 (not (file-remote-p archive)))
421 (setf (tramp-file-name-host vec) 429 (setf (tramp-file-name-host vec) (tramp-archive-gvfs-host archive))
422 (url-hexify-string (tramp-gvfs-url-file-name archive)))
423 (puthash archive (list vec) tramp-archive-hash)) 430 (puthash archive (list vec) tramp-archive-hash))
424 431
425 ;; Anything else. Here we call `file-local-copy', which we 432 ;; Anything else. Here we call `file-local-copy', which we
@@ -428,8 +435,7 @@ name is kept in slot `hop'"
428 (inhibit-file-name-handlers 435 (inhibit-file-name-handlers
429 (cons 'jka-compr-handler inhibit-file-name-handlers)) 436 (cons 'jka-compr-handler inhibit-file-name-handlers))
430 (copy (file-local-copy archive))) 437 (copy (file-local-copy archive)))
431 (setf (tramp-file-name-host vec) 438 (setf (tramp-file-name-host vec) (tramp-archive-gvfs-host copy))
432 (url-hexify-string (tramp-gvfs-url-file-name copy)))
433 (puthash archive (cons vec copy) tramp-archive-hash)))) 439 (puthash archive (cons vec copy) tramp-archive-hash))))
434 440
435 ;; So far, `vec' handles just the mount point. Add `localname', 441 ;; So far, `vec' handles just the mount point. Add `localname',
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index ab3768a91f4..cbb9cd37005 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -144,7 +144,8 @@ This includes password cache, file cache, connection cache, buffers."
144 (clrhash tramp-cache-data) 144 (clrhash tramp-cache-data)
145 145
146 ;; Cleanup local copies of archives. 146 ;; Cleanup local copies of archives.
147 (tramp-archive-cleanup-hash) 147 (when (bound-and-true-p tramp-archive-enabled)
148 (tramp-archive-cleanup-hash))
148 149
149 ;; Remove buffers. 150 ;; Remove buffers.
150 (dolist (name (tramp-list-tramp-buffers)) 151 (dolist (name (tramp-list-tramp-buffers))