[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master d2630e4: Make tramp-archive fit for older Emacsen
From: |
Michael Albinus |
Subject: |
[Emacs-diffs] master d2630e4: Make tramp-archive fit for older Emacsen |
Date: |
Sun, 4 Feb 2018 07:25:18 -0500 (EST) |
branch: master
commit d2630e456923d2bd70fdd59267fe6e3d8eeb69ca
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>
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 ac1c4e1..5f28756 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)
;; <https://github.com/libarchive/libarchive/wiki/LibarchiveFormats>
@@ -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 ab3768a..cbb9cd3 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 e4ae121..33916f8 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
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] master d2630e4: Make tramp-archive fit for older Emacsen,
Michael Albinus <=