Sync with Tramp 2.8.2

* lisp/net/tramp-message.el (tramp-trace-add-package): New defun.

* lisp/net/tramp-smb.el (tramp-smb-maybe-open-connection):
Remove superfluous comment.

* lisp/net/tramp.el (tramp-restricted-shell-hosts-alist):
Use `file-name-sans-extension'.
(tramp-completion-handle-expand-file-name):
Apply `tramp-drop-volume-letter' consequently.

* test/lisp/net/tramp-tests.el
(tramp--test-ignore-make-symbolic-link-error): Use `file-error'
instead of `remote-file-error'
(tramp--test-instrument-test-case-p): Fix doxstring.
(tramp-test10-write-region-other-file-name-handler)
(tramp-test49-external-backend-function): Adapt tests.
This commit is contained in:
Michael Albinus 2026-06-22 14:17:18 +02:00
parent 7be92efa5e
commit 25084664ba
6 changed files with 67 additions and 40 deletions

View file

@ -794,9 +794,8 @@ This is needed if there are compatibility problems."
(interactive)
;; We expect just one Tramp package is installed.
(when-let*
((dir (tramp-compat-funcall
'package-desc-dir
(car (alist-get 'tramp (bound-and-true-p package-alist))))))
((dir (tramp-compat-funcall 'package-desc-dir
(car (alist-get 'tramp (bound-and-true-p package-alist))))))
(dolist (elc (directory-files dir 'full (rx ".elc" eos)))
(delete-file elc))
(with-current-buffer (get-buffer-create byte-compile-log-buffer)

View file

@ -103,7 +103,7 @@ Add the extension of F, if existing."
dir-flag (file-name-extension f t)))
(defalias 'tramp-compat-error-type-p
(if (fboundp 'error-type-p) ;Emacs-31
(if (fboundp 'error-type-p) ; Emacs-31
#'error-type-p
(lambda (symbol) (get symbol 'error-conditions))))
@ -264,10 +264,20 @@ value is the default binding of the variable."
;; kept, for example when the HANDLER propagates the error with
;; `(signal (car err) (cdr err)'.
;;
;; * Starting with Emacs 31.1, use `(signal err)' instead of `(signal
;; (car err) (cdr err)'.
;;
;; * Starting with Emacs 30.1, use '(_ VALUEFORM)' instead of
;; '(VALUEFORM)' in 'if-let*/when-let*/and-let*'.
;;
;; * Starting with Emacs 30, use `static-if'. Starting with Emacs 31,
;; use `static-when' and `static-unless'.
;;
;; * Starting with Emacs 31.1, use `(signal err)' instead of `(signal
;; (car err) (cdr err)'. Use also the functions `error-type-p', `error-type',
;; `error-has-type-p', and `error-slot-value'.
;;
;; * Starting with Emacs 31.1, use `set-local' and `setopt-local'.
;;
;; * Starting with Emacs 31.1, use `plusp', `minusp', `oddp' and `evenp'.
;;
;; * Starting with Emacs 31.1, use `hash-table-contains-p'.
;;; tramp-compat.el ends here

View file

@ -211,6 +211,13 @@ They are completed by `M-x TAB' only in Tramp debug buffers."
(defvar tramp-trace-functions nil
"A list of non-Tramp functions to be traced with `tramp-verbose' > 10.")
(defun tramp-trace-add-package (package)
"Add all functions of PACKAGE to `tramp-trace-functions'."
(when (and (symbolp package) (require package nil 'noerror))
(dolist (elt (apropos-internal
(rx bos (literal (symbol-name package))) #'functionp))
(add-to-list 'tramp-trace-functions elt))))
(defun tramp-debug-message (vec fmt-string &rest arguments)
"Append message to debug buffer of VEC.
Message is formatted with FMT-STRING as control string and the remaining

View file

@ -2053,11 +2053,6 @@ If ARGUMENT is non-nil, use it as argument for
(let* (coding-system-for-read
(process-connection-type tramp-process-connection-type)
;; There might be some unfortunate values of
;; `tramp-smb-connection-local-default-system-variables'.
;(path-separator (default-value 'path-separator))
;(null-device (default-value 'null-device))
;(exec-suffixes (default-value 'exec-suffixes))
(p (apply #'tramp-start-process vec
(tramp-get-connection-name vec)
(tramp-get-connection-buffer vec)

View file

@ -571,7 +571,9 @@ interpreted as a regular expression which always matches."
;; <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=38079#20>.
(defcustom tramp-restricted-shell-hosts-alist
(when (and (eq system-type 'windows-nt)
(not (string-match-p (rx "sh" eol) tramp-encoding-shell)))
(not (string-match-p
(rx "sh" eol)
(file-name-sans-extension tramp-encoding-shell))))
(list (rx
bos (| (literal (downcase tramp-system-name))
(literal (upcase tramp-system-name)))
@ -3006,24 +3008,26 @@ not in completion mode."
"Like `expand-file-name' for partial Tramp files."
;; We need special handling only when a method is needed. Then we
;; check, whether DIRECTORY is "/method:" or "/[method/".
(let ((dir (or directory default-directory "/")))
(cond
((file-name-absolute-p filename)
;; FILENAME could be like "~/". We must expand this.
(tramp-run-real-handler #'expand-file-name (list filename directory)))
((and (eq tramp-syntax 'simplified)
(string-match-p (rx (regexp tramp-postfix-host-regexp) eos) dir))
(concat dir filename))
((string-match-p
(rx (regexp tramp-prefix-regexp)
(* (regexp tramp-remote-file-name-spec-regexp)
(regexp tramp-postfix-hop-regexp))
(? (regexp tramp-method-regexp) (regexp tramp-postfix-method-regexp)
(? (regexp tramp-user-regexp) (regexp tramp-postfix-user-regexp)))
eos)
dir)
(concat dir filename))
(t (tramp-run-real-handler #'expand-file-name (list filename directory))))))
(tramp-drop-volume-letter
(let ((dir (or directory default-directory "/")))
(cond
((file-name-absolute-p filename)
;; FILENAME could be like "~/". We must expand this.
(tramp-run-real-handler #'expand-file-name (list filename directory)))
((and (eq tramp-syntax 'simplified)
(string-match-p (rx (regexp tramp-postfix-host-regexp) eos) dir))
(concat dir filename))
((string-match-p
(rx (regexp tramp-prefix-regexp)
(* (regexp tramp-remote-file-name-spec-regexp)
(regexp tramp-postfix-hop-regexp))
(? (regexp tramp-method-regexp) (regexp tramp-postfix-method-regexp)
(? (regexp tramp-user-regexp) (regexp tramp-postfix-user-regexp)))
eos)
dir)
(concat dir filename))
(t (tramp-run-real-handler
#'expand-file-name (list filename directory)))))))
;; This is needed in pcomplete.el.
(defun tramp-completion-handle-file-directory-p (filename)

View file

@ -263,15 +263,17 @@ If QUOTED is non-nil, the local part of the file name is quoted.
The temporary file is not created."
(make-temp-name (tramp--test-make-temp-prefix local quoted)))
;; Method "smb" supports `make-symbolic-link' only if the remote host
;; has CIFS capabilities. tramp-adb.el, tramp-gvfs.el, tramp-rclone.el
;; and tramp-sshfs.el do not support symbolic links at all.
;; If `system-type' is `windows-nt', making symbolic links is not
;; supported. Method "smb" supports `make-symbolic-link' only if the
;; remote host has CIFS capabilities. tramp-adb.el, tramp-gvfs.el,
;; tramp-rclone.el and tramp-sshfs.el do not support symbolic links at
;; all.
(defmacro tramp--test-ignore-make-symbolic-link-error (&rest body)
"Run BODY, ignoring \"make-symbolic-link not supported\" file error."
(declare (indent defun) (debug (body)))
`(condition-case err
(progn ,@body)
(remote-file-error
(file-error
(unless (string-match-p
(rx bol (| "make-symbolic-link not supported"
(: "Making symbolic link"
@ -282,7 +284,7 @@ The temporary file is not created."
;; Don't print messages in nested `tramp--test-instrument-test-case' calls.
(defvar tramp--test-instrument-test-case-p nil
"Whether `tramp--test-instrument-test-case' run.
This shall used dynamically bound only.")
This shall be used dynamically bound only.")
;; When `tramp-verbose' is greater than 10, and you want to trace
;; other functions as well, do something like
@ -2980,8 +2982,14 @@ This checks also `file-name-as-directory', `file-name-directory',
(should (string-equal (buffer-string) "foo\nbar\n")))))
;; Cleanup.
(ignore-errors (kill-buffer buffer1))
(ignore-errors (kill-buffer buffer2))
;; Modifying `read-from-minibuffer' doesn't work on MS Windows.
;; `kill-buffer--possibly-save' exists since Emacs 29.1.
(if (fboundp 'kill-buffer--possibly-save)
(cl-letf (((symbol-function #'kill-buffer--possibly-save) #'always))
(ignore-errors (kill-buffer buffer1))
(ignore-errors (kill-buffer buffer2)))
(ignore-errors (kill-buffer buffer1))
(ignore-errors (kill-buffer buffer2)))
(ignore-errors (delete-file tmp-file)))))
(ert-deftest tramp-test11-copy-file ()
@ -9081,8 +9089,12 @@ process sentinels. They shall not disturb each other."
(should
(string-equal (tramp--test-operation tramp-test-vec)
(tramp--handle-test-operation tramp-test-vec)))
(let ((vec (copy-tramp-file-name tramp-test-vec)))
(setf (tramp-file-name-method vec) (if (tramp--test-sh-p) "rclone" "sudo"))
(let ((vec (copy-tramp-file-name tramp-test-vec))
;; This is needed for the `simplified' syntax.
(tramp-default-method (if (tramp--test-sh-p) "rclone" "sudo"))
;; "rclone" is not multi-hop capable.
(tramp-multi-hop-p-hook #'always))
(setf (tramp-file-name-method vec) tramp-default-method)
(should-not
(string-equal (tramp--test-operation vec)
(tramp--handle-test-operation vec))))