Commit 4db69b32 authored by Michael Albinus's avatar Michael Albinus
Browse files

Fix bug#48476

* lisp/net/tramp-archive.el (tramp-archive-autoload-file-name-handler):
Add implementation.

* lisp/net/tramp-integration.el (tramp-rename-files)
(tramp-rename-these-files): Declare them.

* lisp/net/tramp.el (tramp-autoload-file-name-handler):
Load tramp-archive.el if needed.  (Bug#48476)

* test/lisp/net/tramp-archive-tests.el (tramp-archive-test45-auto-load):
Extend test.

Use #' syntax for function symbols.
parent 84e207c8
Pipeline #10913 failed with stages
in 128 minutes and 22 seconds
......@@ -345,8 +345,12 @@ arguments to pass to the OPERATION."
(tramp-archive-run-real-handler operation args)))))))
;;;###autoload
(defalias
'tramp-archive-autoload-file-name-handler #'tramp-autoload-file-name-handler)
(progn (defun tramp-archive-autoload-file-name-handler (operation &rest args)
"Load Tramp archive file name handler, and perform OPERATION."
(if tramp-archive-enabled
(let ((tramp-archive-autoload t))
tramp-archive-autoload ; Silence byte compiler.
(apply #'tramp-autoload-file-name-handler operation args)))))
;;;###autoload
(progn (defun tramp-register-archive-file-name-handler ()
......
......@@ -237,8 +237,7 @@ Return VALUE."
;;;###tramp-autoload
(defun tramp-flush-file-properties (key file)
"Remove all properties of FILE in the cache context of KEY."
(let* ((file (tramp-run-real-handler
#'directory-file-name (list file)))
(let* ((file (tramp-run-real-handler #'directory-file-name (list file)))
(truename (tramp-get-file-property key file "file-truename" nil)))
;; Unify localname. Remove hop from `tramp-file-name' structure.
(setq file (tramp-compat-file-name-unquote file)
......
......@@ -1089,7 +1089,7 @@ file names."
'copy filename newname ok-if-already-exists keep-date
preserve-uid-gid preserve-extended-attributes)
(tramp-run-real-handler
'copy-file
#'copy-file
(list filename newname ok-if-already-exists keep-date
preserve-uid-gid preserve-extended-attributes))))
......
......@@ -42,6 +42,8 @@
(declare-function tramp-dissect-file-name "tramp")
(declare-function tramp-file-name-equal-p "tramp")
(declare-function tramp-tramp-file-p "tramp")
(declare-function tramp-rename-files "tramp-cmds")
(declare-function tramp-rename-these-files "tramp-cmds")
(defvar eshell-path-env)
(defvar ido-read-file-name-non-ido)
(defvar info-lookup-alist)
......@@ -184,14 +186,14 @@ NAME must be equal to `tramp-current-connection'."
;;; Integration of ido.el:
(with-eval-after-load 'ido
(add-to-list 'ido-read-file-name-non-ido 'tramp-rename-files)
(add-to-list 'ido-read-file-name-non-ido 'tramp-these-rename-files)
(add-to-list 'ido-read-file-name-non-ido #'tramp-rename-files)
(add-to-list 'ido-read-file-name-non-ido #'tramp-rename-these-files)
(add-hook 'tramp-integration-unload-hook
(lambda ()
(setq ido-read-file-name-non-ido
(delq 'tramp-these-rename-files ido-read-file-name-non-ido)
(delq #'tramp-rename-these-files ido-read-file-name-non-ido)
ido-read-file-name-non-ido
(delq 'tramp-rename-files ido-read-file-name-non-ido)))))
(delq #'tramp-rename-files ido-read-file-name-non-ido)))))
;;; Integration of ivy.el:
......@@ -199,17 +201,17 @@ NAME must be equal to `tramp-current-connection'."
(add-to-list 'ivy-completing-read-handlers-alist
'(tramp-rename-files . completing-read-default))
(add-to-list 'ivy-completing-read-handlers-alist
'(tramp-these-rename-files . completing-read-default))
'(tramp-rename-these-files . completing-read-default))
(add-hook
'tramp-integration-unload-hook
(lambda ()
(setq ivy-completing-read-handlers-alist
(delete
(assq 'tramp-these-rename-files ivy-completing-read-handlers-alist)
(assq #'tramp-rename-these-files ivy-completing-read-handlers-alist)
ivy-completing-read-handlers-alist)
ivy-completing-read-handlers-alist
(delete
(assq 'tramp-rename-files ivy-completing-read-handlers-alist)
(assq #'tramp-rename-files ivy-completing-read-handlers-alist)
ivy-completing-read-handlers-alist)))))
;;; Integration of info-look.el:
......
......@@ -1843,7 +1843,7 @@ ID-FORMAT valid values are `string' and `integer'."
'copy filename newname ok-if-already-exists keep-date
preserve-uid-gid preserve-extended-attributes)
(tramp-run-real-handler
'copy-file
#'copy-file
(list filename newname ok-if-already-exists keep-date
preserve-uid-gid preserve-extended-attributes))))
......@@ -1884,7 +1884,7 @@ ID-FORMAT valid values are `string' and `integer'."
;; We must do it file-wise.
(tramp-run-real-handler
'copy-directory
#'copy-directory
(list dirname newname keep-date parents copy-contents)))
;; When newname did exist, we have wrong cached values.
......
......@@ -650,7 +650,7 @@ component is used as the target of the symlink."
'rename filename newname ok-if-already-exists
'keep-date 'preserve-uid-gid)
(tramp-run-real-handler
'rename-file (list filename newname ok-if-already-exists))))
#'rename-file (list filename newname ok-if-already-exists))))
(defun tramp-sudoedit-handle-set-file-acl (filename acl-string)
"Like `set-file-acl' for Tramp files."
......
......@@ -2631,6 +2631,8 @@ Falls back to normal file name handler if no Tramp file name handler exists."
;; might be an older, incompatible version active. We try to
;; overload this.
(let ((default-directory temporary-file-directory))
(when (bound-and-true-p tramp-archive-autoload)
(load "tramp-archive" 'noerror 'nomessage))
(load "tramp" 'noerror 'nomessage)))
(apply operation args)))
......@@ -2642,7 +2644,7 @@ Falls back to normal file name handler if no Tramp file name handler exists."
"Add Tramp file name handlers to `file-name-handler-alist' during autoload."
(add-to-list 'file-name-handler-alist
(cons tramp-autoload-file-name-regexp
'tramp-autoload-file-name-handler))
#'tramp-autoload-file-name-handler))
(put #'tramp-autoload-file-name-handler 'safe-magic t)))
;;;###autoload (tramp-register-autoload-file-name-handlers)
......@@ -2854,7 +2856,7 @@ not in completion mode."
result1
(ignore-errors
(tramp-run-real-handler
'file-name-all-completions (list filename directory))))))
#'file-name-all-completions (list filename directory))))))
;; Method, host name and user name completion for a file.
(defun tramp-completion-handle-file-name-completion
......@@ -3275,7 +3277,7 @@ User is always nil."
(tramp-compat-file-missing (tramp-dissect-file-name directory) directory))
;; We must do it file-wise.
(tramp-run-real-handler
'copy-directory
#'copy-directory
(list directory newname keep-date parents copy-contents)))
(defun tramp-handle-directory-file-name (directory)
......
......@@ -887,27 +887,35 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
;; tramp-archive is neither loaded at Emacs startup, nor when
;; loading a file like "/mock::foo" (which loads Tramp).
(let ((default-directory (expand-file-name temporary-file-directory))
(code
(let ((code
"(progn \
(message \"tramp-archive loaded: %%s %%s\" \
(featurep 'tramp) (featurep 'tramp-archive)) \
(message \"tramp-archive loaded: %%s\" \
(featurep 'tramp-archive)) \
(file-attributes %S \"/\") \
(message \"tramp-archive loaded: %%s %%s\" \
(featurep 'tramp) (featurep 'tramp-archive)))"))
(dolist (file `("/mock::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
"%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)))))))))
(message \"tramp-archive loaded: %%s\" \
(featurep 'tramp-archive)))"))
(dolist (default-directory
`(,temporary-file-directory
;; Starting Emacs in a directory which has
;; `tramp-archive-file-name-regexp' syntax is
;; supported only with Emacs > 27.2 (sigh!).
;; (Bug#48476)
,(file-name-as-directory tramp-archive-test-directory)))
(dolist (file `("/mock::foo" ,(concat tramp-archive-test-archive "foo")))
(should
(string-match
(format
"tramp-archive loaded: %s[[:ascii:]]+tramp-archive loaded: %s"
(tramp-archive-file-name-p default-directory)
(or (tramp-archive-file-name-p default-directory)
(tramp-archive-file-name-p file)))
(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 (format code file))))))))))
(ert-deftest tramp-archive-test45-delay-load ()
"Check that `tramp-archive' is loaded lazily, only when needed."
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment