[Emacs-diffs] master 84c9dba: Autoload tramp-archive

[Michael Albinus]

branch: master
commit 84c9dba4cee052b68b194c3a2e5c297a94d8c8af
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>

    Autoload tramp-archive
    
    * doc/misc/tramp.texi (Archive file names): Do not require to
    load Tramp explicitly, this is autoloaded now also for file archives.
    
    * lisp/net/tramp-archive.el (tramp-archive-suffixes)
    (tramp-archive-compression-suffixes): Autoload them.
    (tramp-archive-autoload-file-name-regexp): New defmacro.
    (tramp-archive-file-name-regexp): Use it.
    (tramp-register-archive-file-name-handler): New defun.  Call
    it in `after-init-hook'.
    
    * test/lisp/net/tramp-archive-tests.el
    (tramp-archive-test40-file-system-info): Rename from
    `tramp-archive-test40-archive-file-system-info.
    (tramp-archive-test42-auto-load)
    (tramp-archive-test42-delay-load): New tests.
---
 doc/misc/tramp.texi                  | 11 ++++----
 lisp/net/tramp-archive.el            | 35 ++++++++++++++++++------
 test/lisp/net/tramp-archive-tests.el | 52 +++++++++++++++++++++++++++++++++++-
 3 files changed, 84 insertions(+), 14 deletions(-)

diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index f5dfef2..235627c 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -3117,15 +3117,14 @@ similar @samp{/scp:user@@host:...}.  See the constant
 @code{tramp-archive-all-gvfs-methods} for a complete list of
 @code{tramp-gvfs} supported method names.
 
-If @value{tramp} is loaded and @code{url-handler-mode} is enabled,
-archives could be visited via URLs, like
+If @code{url-handler-mode} is enabled, archives could be visited via
+URLs, like
 @file{https://ftp.gnu.org/gnu/tramp/tramp-2.3.2.tar.gz/INSTALL}.  This
 allows complex file operations like
 
 @lisp
 @group
 (progn
-  (require 'tramp)
   (url-handler-mode 1)
   (ediff-directories
    "https://ftp.gnu.org/gnu/tramp/tramp-2.3.1.tar.gz/tramp-2.3.1";
@@ -3137,8 +3136,10 @@ It is even possible to access file archives in file 
archives, as
 
 @lisp
 @group
-(find-file
- 
"http://ftp.debian.org/debian/pool/main/c/coreutils/coreutils_8.28-1_amd64.deb/control.tar.gz/control";)
+(progn
+  (url-handler-mode 1)
+  (find-file
+   
"http://ftp.debian.org/debian/pool/main/c/coreutils/coreutils_8.28-1_amd64.deb/control.tar.gz/control";))
 @end group
 @end lisp
 
diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el
index e012ac3..23191f1 100644
--- a/lisp/net/tramp-archive.el
+++ b/lisp/net/tramp-archive.el
@@ -113,7 +113,7 @@
 (defvar url-tramp-protocols)
 
 ;; <https://github.com/libarchive/libarchive/wiki/LibarchiveFormats>
-;;;###tramp-autoload
+;;;###autoload
 (defconst tramp-archive-suffixes
   ;; "cab", "lzh" and "zip" are included with lower and upper letters,
   ;; because Microsoft Windows provides them often with capital
@@ -143,25 +143,33 @@
 It must be supported by libarchive(3).")
 
 ;; <http://unix-memo.readthedocs.io/en/latest/vfs.html>
-;;    read and write: tar, cpio, pax , gzip , zip, bzip2, xz, lzip, lzma, ar, 
mtree, iso9660, compress,
-;;    read only: 7-Zip, mtree, xar, lha/lzh, rar, microsoft cab,
+;;    read and write: tar, cpio, pax , gzip , zip, bzip2, xz, lzip, lzma, ar, 
mtree, iso9660, compress.
+;;    read only: 7-Zip, mtree, xar, lha/lzh, rar, microsoft cab.
 
-;;;###tramp-autoload
+;;;###autoload
 (defconst tramp-archive-compression-suffixes
   '("bz2" "gz" "lrz" "lz" "lz4" "lzma" "lzo" "uu" "xz" "Z")
   "List of suffixes which indicate a compressed file.
 It must be supported by libarchive(3).")
 
-;;;###tramp-autoload
-(defconst tramp-archive-file-name-regexp
-  (concat
+;; The definition of `tramp-archive-file-name-regexp' contains calls
+;; to `regexp-opt', which cannot be autoloaded while loading
+;; loaddefs.el.  So we use a macro, which is evaluated only when needed.
+;;;###autoload
+(progn (defmacro tramp-archive-autoload-file-name-regexp ()
+  "Regular expression matching archive file names."
+  `(concat
     "\\`" "\\(" ".+" "\\."
       ;; Default suffixes ...
       (regexp-opt tramp-archive-suffixes)
       ;; ... with compression.
       "\\(?:" "\\." (regexp-opt tramp-archive-compression-suffixes) "\\)*"
     "\\)" ;; \1
-    "\\(" "/" ".*" "\\)" "\\'") ;; \2
+    "\\(" "/" ".*" "\\)" "\\'"))) ;; \2
+
+;;;###tramp-autoload
+(defconst tramp-archive-file-name-regexp
+  (tramp-archive-autoload-file-name-regexp)
   "Regular expression matching archive file names.")
 
 ;;;###tramp-autoload
@@ -297,6 +305,17 @@ pass to the OPERATION."
            (save-match-data (apply (cdr fn) args))
          (tramp-archive-run-real-handler operation args))))))
 
+;;;###autoload
+(progn (defun tramp-register-archive-file-name-handler ()
+  "Add archive file name handler to `file-name-handler-alist'."
+  (add-to-list 'file-name-handler-alist
+              (cons (tramp-archive-autoload-file-name-regexp)
+                    'tramp-autoload-file-name-handler))
+  (put 'tramp-archive-file-name-handler 'safe-magic t)))
+
+;;;###autoload
+(add-hook 'after-init-hook 'tramp-register-archive-file-name-handler)
+
 ;; Mark `operations' the handler is responsible for.
 (put 'tramp-archive-file-name-handler 'operations
      (mapcar 'car tramp-archive-file-name-handler-alist))
diff --git a/test/lisp/net/tramp-archive-tests.el 
b/test/lisp/net/tramp-archive-tests.el
index 96c6a71..bebdf10 100644
--- a/test/lisp/net/tramp-archive-tests.el
+++ b/test/lisp/net/tramp-archive-tests.el
@@ -779,7 +779,7 @@ This tests also `file-executable-p', `file-writable-p' and 
`set-file-modes'."
     (delete-directory tmp-file)
     (should-not (file-exists-p tmp-file))))
 
-(ert-deftest tramp-archive-test40-archive-file-system-info ()
+(ert-deftest tramp-archive-test40-file-system-info ()
   "Check that `file-system-info' returns proper values."
   (skip-unless tramp-gvfs-enabled)
   ;; Since Emacs 27.1.
@@ -796,6 +796,56 @@ This tests also `file-executable-p', `file-writable-p' and 
`set-file-modes'."
                 (zerop (nth 1 fsi))
                 (zerop (nth 2 fsi))))))
 
+(ert-deftest tramp-archive-test42-auto-load ()
+  "Check that `tramp-archive' autoloads properly."
+  (skip-unless tramp-gvfs-enabled)
+
+  (let ((default-directory (expand-file-name temporary-file-directory))
+       (code
+        (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)))))))
+
+(ert-deftest tramp-archive-test42-delay-load ()
+  "Check that `tramp-archive' is loaded lazily, only when needed."
+  (skip-unless tramp-gvfs-enabled)
+
+  ;; Tramp is neither loaded at Emacs startup, nor when completing a
+  ;; non archive file name like "/foo".  Completing an archive file
+  ;; name like "/foo.tar/" autoloads Tramp, when `tramp-mode' is t.
+  (let ((default-directory (expand-file-name temporary-file-directory))
+       (code
+         (format
+         "(progn \
+           (message \"Tramp loaded: %%s\" (featurep 'tramp-archive)) \
+           (file-name-all-completions %S \"/\") \
+           (message \"Tramp loaded: %%s\" (featurep 'tramp-archive)) \
+           (file-name-all-completions %S \"/\") \
+           (message \"Tramp loaded: %%s\" (featurep 'tramp-archive)))"
+         tramp-archive-test-file-archive
+         tramp-archive-test-archive)))
+    ;; Tramp doesn't load when `tramp-mode' is nil.
+    (should
+     (string-match
+      "Tramp loaded: nil[\n\r]+Tramp loaded: nil[\n\r]+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)))))))
+
 (ert-deftest tramp-archive-test99-libarchive-tests ()
   "Run tests of libarchive test files."
   :tags '(:expensive-test)