From d2630e456923d2bd70fdd59267fe6e3d8eeb69ca Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 4 Feb 2018 13:25:10 +0100 Subject: [PATCH] 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. --- lisp/net/tramp-archive.el | 44 ++++++++++++++----------- lisp/net/tramp-cmds.el | 3 +- test/lisp/net/tramp-archive-tests.el | 49 +++++++++++++++++----------- 3 files changed, 57 insertions(+), 39 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 @@ ;; would load Tramp. So we make a cheaper check. ;;;###autoload (defvar tramp-archive-enabled (featurep 'dbusbind) - "Non-nil when GVFS is available.") + "Non-nil when file archive support is available.") +;; After loading tramp-gvfs.el, we know it better. (setq tramp-archive-enabled tramp-gvfs-enabled) ;; @@ -175,6 +176,9 @@ It must be supported by libarchive(3).") "\\)" ;; \1 "\\(" "/" ".*" "\\)" "\\'"))) ;; \2 +;; In older Emacsen (prior 27.1), `tramp-archive-autoload-file-name-regexp' +;; is not autoloaded. So we cannot expect it to be known in +;; tramp-loaddefs.el. But it exists, when tramp-archive.el is loaded. ;;;###tramp-autoload (defconst tramp-archive-file-name-regexp (ignore-errors (tramp-archive-autoload-file-name-regexp)) @@ -266,7 +270,7 @@ It must be supported by libarchive(3).") (vc-registered . ignore) (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) (write-region . tramp-archive-handle-not-implemented)) - "Alist of handler functions for GVFS archive method. + "Alist of handler functions for file archive method. Operations not mentioned here will be handled by the default Emacs primitives.") (defsubst tramp-archive-file-name-for-operation (operation &rest args) @@ -288,7 +292,7 @@ pass to the OPERATION." ;;;###tramp-autoload (defun tramp-archive-file-name-handler (operation &rest args) - "Invoke the GVFS archive related OPERATION. + "Invoke the file archive related OPERATION. First arg specifies the OPERATION, second arg is a list of arguments to pass to the OPERATION." (let* ((filename (apply 'tramp-archive-file-name-for-operation @@ -323,8 +327,16 @@ pass to the OPERATION." (put 'tramp-archive-file-name-handler 'safe-magic t)))) ;;;###autoload -(add-hook 'after-init-hook 'tramp-register-archive-file-name-handler) - +(progn + (add-hook 'after-init-hook 'tramp-register-archive-file-name-handler) + (add-hook + 'tramp-archive-unload-hook + (lambda () + (remove-hook + 'after-init-hook 'tramp-register-archive-file-name-handler)))) + +;; In older Emacsen (prior 27.1), the autoload above does not exist. +;; So we call it again; it doesn't hurt. (tramp-register-archive-file-name-handler) ;; Mark `operations' the handler is responsible for. @@ -343,12 +355,6 @@ pass to the OPERATION." (remove-hook 'url-handler-mode-hook 'tramp-register-file-name-handlers))))) -;; Debug. -;(trace-function-background 'tramp-archive-file-name-handler) -;(trace-function-background 'tramp-gvfs-file-name-handler) -;(trace-function-background 'tramp-file-name-archive) -;(trace-function-background 'tramp-archive-dissect-file-name) - ;; File name conversions. @@ -374,6 +380,10 @@ 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.") +(defsubst tramp-archive-gvfs-host (archive) + "Return host name of ARCHIVE as used in GVFS for mounting" + (url-hexify-string (tramp-gvfs-url-file-name archive))) + (defun tramp-archive-dissect-file-name (name) "Return a `tramp-file-name' structure. The structure consists of the `tramp-archive-method' method, the @@ -397,8 +407,7 @@ name is kept in slot `hop'" (let ((archive (tramp-make-tramp-file-name (tramp-archive-dissect-file-name archive) nil 'noarchive))) - (setf (tramp-file-name-host vec) - (url-hexify-string (tramp-gvfs-url-file-name archive)))) + (setf (tramp-file-name-host vec) (tramp-archive-gvfs-host archive))) (puthash archive (list vec) tramp-archive-hash)) ;; http://... @@ -411,15 +420,13 @@ name is kept in slot `hop'" (url-type (url-generic-parse-url archive)) url-tramp-protocols)) (archive (url-tramp-convert-url-to-tramp archive))) - (setf (tramp-file-name-host vec) - (url-hexify-string (tramp-gvfs-url-file-name archive)))) + (setf (tramp-file-name-host vec) (tramp-archive-gvfs-host archive))) (puthash archive (list vec) tramp-archive-hash)) ;; GVFS supported schemes. ((or (tramp-gvfs-file-name-p archive) (not (file-remote-p archive))) - (setf (tramp-file-name-host vec) - (url-hexify-string (tramp-gvfs-url-file-name archive))) + (setf (tramp-file-name-host vec) (tramp-archive-gvfs-host archive)) (puthash archive (list vec) tramp-archive-hash)) ;; Anything else. Here we call `file-local-copy', which we @@ -428,8 +435,7 @@ name is kept in slot `hop'" (inhibit-file-name-handlers (cons 'jka-compr-handler inhibit-file-name-handlers)) (copy (file-local-copy archive))) - (setf (tramp-file-name-host vec) - (url-hexify-string (tramp-gvfs-url-file-name copy))) + (setf (tramp-file-name-host vec) (tramp-archive-gvfs-host copy)) (puthash archive (cons vec copy) tramp-archive-hash)))) ;; 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." (clrhash tramp-cache-data) ;; Cleanup local copies of archives. - (tramp-archive-cleanup-hash) + (when (bound-and-true-p tramp-archive-enabled) + (tramp-archive-cleanup-hash)) ;; Remove buffers. (dolist (name (tramp-list-tramp-buffers)) diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el index e4ae1217002..33916f82dac 100644 --- a/test/lisp/net/tramp-archive-tests.el +++ b/test/lisp/net/tramp-archive-tests.el @@ -808,21 +808,29 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." ;; Autoloading tramp-archive works since Emacs 27.1. (skip-unless (tramp-archive--test-emacs27-p)) + ;; tramp-archive is neither loaded at Emacs startup, nor when + ;; loading a file like "/ssh::" (which loads Tramp). (let ((default-directory (expand-file-name temporary-file-directory)) (code + "(progn \ + (message \"tramp-archive loaded: %%s %%s\" \ + (featurep 'tramp) (featurep 'tramp-archive)) \ + (file-attributes %S \"/\") \ + (message \"tramp-archive loaded: %%s %%s\" \ + (featurep 'tramp) (featurep 'tramp-archive)))")) + (dolist (file `("/ssh::foo" ,(concat tramp-archive-test-archive "foo"))) + (should + (string-match + (format + "tramp-archive loaded: nil nil[[:ascii:]]+tramp-archive loaded: t %s" + (tramp-archive-file-name-p file)) + (shell-command-to-string (format - "(message \"Tramp loaded: %%s\" (and (file-exists-p %S) t))" - tramp-archive-test-archive))) - (should - (string-match - "Tramp loaded: t[\n\r]+" - (shell-command-to-string - (format - "%s -batch -Q -L %s --eval %s" - (shell-quote-argument - (expand-file-name invocation-name invocation-directory)) - (mapconcat 'shell-quote-argument load-path " -L ") - (shell-quote-argument code))))))) + "%s -batch -Q -L %s --eval %s" + (shell-quote-argument + (expand-file-name invocation-name invocation-directory)) + (mapconcat 'shell-quote-argument load-path " -L ") + (shell-quote-argument (format code file))))))))) (ert-deftest tramp-archive-test42-delay-load () "Check that `tramp-archive' is loaded lazily, only when needed." @@ -836,18 +844,21 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (let ((default-directory (expand-file-name temporary-file-directory)) (code "(progn \ - (setq tramp-archive-enabled %s) \ - (message \"Tramp loaded: %%s\" (featurep 'tramp-archive)) \ - (find-file %S \"/\") \ - (message \"Tramp loaded: %%s\" (featurep 'tramp-archive)) \ - (file-attributes %S \"/\") \ - (message \"Tramp loaded: %%s\" (featurep 'tramp-archive)))")) + (setq tramp-archive-enabled %s) \ + (message \"tramp-archive loaded: %%s\" \ + (featurep 'tramp-archive)) \ + (file-attributes %S \"/\") \ + (message \"tramp-archive loaded: %%s\" \ + (featurep 'tramp-archive)) \ + (file-attributes %S \"/\") \ + (message \"tramp-archive loaded: %%s\" \ + (featurep 'tramp-archive)))")) ;; tramp-archive doesn't load when `tramp-archive-enabled' is nil. (dolist (tae '(t nil)) (should (string-match (format - "Tramp loaded: nil[[:ascii:]]+Tramp loaded: nil[[:ascii:]]+Tramp loaded: %s" + "tramp-archive loaded: nil[[:ascii:]]+tramp-archive loaded: nil[[:ascii:]]+tramp-archive loaded: %s" tae) (shell-command-to-string (format -- 2.39.2