1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-05 22:20:24 -08:00

Tramp cleanup

* doc/misc/tramp.texi (Configuration): Extend example.

* lisp/net/tramp.el (tramp-skeleton-write-region):
* lisp/net/tramp-cache.el (tramp-flush-file-upper-properties):
* lisp/net/tramp-sh.el (tramp-sh-handle-insert-directory):
Use `when-let*'	consequently.

* lisp/net/tramp-cmds.el (tramp-file-name-with-method):
Add :initialize and :set functions.
(tramp-set-file-name-with-method): New defun.
(with-tramp-file-name-with-method): Filter out enabled methods.

* lisp/net/tramp-compat.el: Add TODO.

* test/lisp/net/tramp-archive-tests.el
(tramp-archive-test-cascaded-file-archive): Use "foo.zip".

* test/lisp/net/tramp-tests.el (tramp--test-instrument-test-case-p):
Extend check.
(tramp-test48-session-timeout): Adapt test.

* test/lisp/net/tramp-archive-resources/foo.zip: Renamed from outer.zip.
This commit is contained in:
Michael Albinus 2025-10-20 14:42:12 +02:00
parent 71526e7584
commit c024b9c661
9 changed files with 68 additions and 41 deletions

View file

@ -678,7 +678,10 @@ not auto loaded by Emacs. All examples require @value{tramp} to be
installed and loaded:
@lisp
@group
(require 'tramp)
(customize-set-variable 'tramp-verbose 6 "Enable remote command traces")
@end group
@end lisp
For functions used to configure @value{tramp}, the following clause

View file

@ -253,9 +253,9 @@ Return VALUE."
(defun tramp-flush-file-upper-properties (key file)
"Remove some properties of FILE's upper directory."
(when (file-name-absolute-p file)
(when-let* (((file-name-absolute-p file))
;; `file-name-directory' can return nil, for example for "~".
(when-let* ((file (file-name-directory file))
(file (file-name-directory file))
(file (directory-file-name file)))
(setq key (tramp-file-name-unify key file))
(unless (eq key tramp-cache-undefined)
@ -265,7 +265,7 @@ Return VALUE."
bos (| "directory-" "file-name-all-completions"
"file-entries"))
property)
(tramp-flush-file-property key file property)))))))
(tramp-flush-file-property key file property))))))
;;;###tramp-autoload
(defun tramp-flush-file-properties (key file)

View file

@ -632,13 +632,28 @@ For details, see `tramp-rename-files'."
"Which method to be used in `tramp-file-name-with-sudo'."
:group 'tramp
:version "31.1"
;; It should be a choice of constant strings. See
;; `with-tramp-file-name-with-method'.
:type '(choice (const "su") (const "surs")
(const "sudo") (const "sudors")
(const "doas")
(const "run0")
(const "ksu"))
:initialize #'custom-initialize-default
:set #'tramp-set-file-name-with-method
:link '(tramp-info-link :tag "Tramp manual" tramp-file-name-with-method))
(defun tramp-set-file-name-with-method (symbol value)
"Set SYMBOL to value VALUE.
Used in user option `tramp-file-name-with-method'. If VALUE is an
optional method, enable it."
(unless (string-equal (symbol-value symbol) value)
;; Enable optional method.
(tramp-enable-method value)
;; Set the value.
(when (assoc value tramp-methods)
(set-default symbol value))))
(defun tramp-get-file-name-with-method ()
"Return connection-local value of `tramp-file-name-with-method'."
(tramp-compat-connection-local-value tramp-file-name-with-method))
@ -651,8 +666,11 @@ Run BODY."
(if current-prefix-arg
(completing-read
"Tramp method: "
;; Filter out enabled methods.
(seq-intersection
(mapcar #'car tramp-methods)
(mapcar
#'cadr (cdr (get 'tramp-file-name-with-method 'custom-type)))
#'cadr (cdr (get 'tramp-file-name-with-method 'custom-type))))
nil t (tramp-get-file-name-with-method))
(tramp-get-file-name-with-method))))
,@body))

View file

@ -259,5 +259,8 @@ value is the default binding of the variable."
;; instead of `condition-case' when the origin of an error shall be
;; kept, for example when the HANDLER propagates the error with
;; `(signal (car err) (cdr err)'.
;;
;; * Starting with Emacs 30.1, use '(_ VALUEFORM)' instead of
;; '(VALUEFORM)' in 'if-let*/when-let*/and-let*'.
;;; tramp-compat.el ends here

View file

@ -2934,15 +2934,15 @@ The method used must be an out-of-band method."
;; Try to insert the amount of free space.
(goto-char (point-min))
;; First find the line to put it on.
(when (and (search-forward-regexp
(rx bol (group (* blank) "total")) nil t)
(when-let* (((search-forward-regexp
(rx bol (group (* blank) "total")) nil t))
;; Emacs 29.1 or later.
(not (fboundp 'dired--insert-disk-space)))
(when-let* ((available (get-free-disk-space ".")))
((not (fboundp 'dired--insert-disk-space)))
(available (get-free-disk-space ".")))
;; Replace "total" with "total used", to avoid confusion.
(replace-match "\\1 used in directory")
(end-of-line)
(insert " available " available))))
(insert " available " available)))
(prog1 (goto-char end-marker)
(set-marker beg-marker nil)

View file

@ -941,7 +941,7 @@ to be set, depending on VALUE."
;; Cleanup existing buffers.
(unless (eq (symbol-value symbol) value)
(tramp-cleanup-all-buffers))
;; Set the value:
;; Set the value.
(set-default symbol value)
;; Reset the depending variables.
(setq tramp-prefix-format (tramp-build-prefix-format)
@ -4088,8 +4088,8 @@ BODY is the backend specific code."
(let (last-coding-system-used (need-chown t))
;; Set file modification time.
(when (or (eq ,visit t) (stringp ,visit))
(when-let* ((file-attr (file-attributes filename 'integer)))
(when-let* (((or (eq ,visit t) (stringp ,visit)))
(file-attr (file-attributes filename 'integer)))
(set-visited-file-modtime
;; We must pass modtime explicitly, because FILENAME
;; can be different from (buffer-file-name), f.e. if
@ -4098,7 +4098,7 @@ BODY is the backend specific code."
(current-time)))
(when (and (= (file-attribute-user-id file-attr) uid)
(= (file-attribute-group-id file-attr) gid))
(setq need-chown nil))))
(setq need-chown nil)))
;; Set the ownership.
(when need-chown
@ -7221,6 +7221,7 @@ Consults the auth-source package."
(tramp-compat-auth-info-password auth-info))))
;; Try the password cache.
;; Starting with Emacs 31.1, this isn't needed anymore.
(with-tramp-suspended-timers
(setq auth-passwd
(password-read

View file

@ -45,7 +45,7 @@
"A directory file name, which looks like an archive.")
(defvar tramp-archive-test-cascaded-file-archive
(ert-resource-file "outer.zip/foo.tar.gz")
(ert-resource-file "foo.zip/foo.tar.gz")
"The cascaded test file archive.")
(defvar tramp-archive-test-cascaded-archive

View file

@ -181,8 +181,11 @@ The temporary file is not created."
`(condition-case err
(progn ,@body)
(file-error
(unless (string-equal (error-message-string err)
"make-symbolic-link not supported")
(unless (string-match-p
(rx bol (| "make-symbolic-link not supported"
(: "Making symbolic link"
(? ":") " Operation not permitted")))
(error-message-string err))
(signal (car err) (cdr err))))))
;; Don't print messages in nested `tramp--test-instrument-test-case' calls.
@ -8540,8 +8543,7 @@ process sentinels. They shall not disturb each other."
(ert-deftest tramp-test48-session-timeout ()
"Check that Tramp handles a session timeout properly."
(skip-unless (tramp--test-enabled))
(skip-unless
(tramp-get-method-parameter tramp-test-vec 'tramp-session-timeout))
(skip-unless (tramp--test-sh-p))
;; We want to see the timeout message.
(tramp--test-instrument-test-case 3