master 022f50ebe61: New command 'tramp-cleanup-some-buffers'

[Michael Albinus]

branch: master
commit 022f50ebe616e04bb34487a26d529ca08954d287
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>

    New command 'tramp-cleanup-some-buffers'
    
    * doc/misc/tramp.texi (Cleanup remote connections):
    Document tramp-cleanup-some-buffers and
    tramp-cleanup-some-buffers-hook.
    
    * etc/NEWS: New command 'tramp-cleanup-some-buffers'.
    
    * lisp/net/tramp.el (tramp-handle-make-process):
    * lisp/net/tramp-adb.el (tramp-adb-handle-make-process):
    * lisp/net/tramp-sh.el (tramp-sh-handle-make-process):
    Use `tramp-taint-remote-process-buffer'.
    
    * lisp/net/tramp.el (tramp-post-process-creation): New defun.
    (tramp-handle-make-process):
    * lisp/net/tramp-adb.el (tramp-adb-maybe-open-connection):
    * lisp/net/tramp-crypt.el (tramp-crypt-maybe-open-connection):
    * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-notify-add-watch)
    (tramp-gvfs-maybe-open-connection):
    * lisp/net/tramp-rclone.el (tramp-rclone-maybe-open-connection):
    * lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band)
    (tramp-sh-handle-file-notify-add-watch)
    (tramp-maybe-open-connection):
    * lisp/net/tramp-smb.el (tramp-smb-handle-copy-directory)
    (tramp-smb-handle-file-acl, tramp-smb-handle-set-file-acl)
    (tramp-smb-maybe-open-connection):
    * lisp/net/tramp-sshfs.el (tramp-sshfs-maybe-open-connection):
    * lisp/net/tramp-sudoedit.el (tramp-sudoedit-maybe-open-connection)
    (tramp-sudoedit-send-command): Use it.
    
    * lisp/net/tramp-cmds.el (tramp-tainted-remote-process-buffers):
    New defvar.
    (tramp-cleanup-dired-buffer-p)
    (tramp-delete-tainted-remote-process-buffer-function)
    (kill-buffer-hook, tramp-cleanup-remote-process-p)
    (tramp-cleanup-some-buffers): New defuns.
    (tramp-cleanup-some-buffers-hook): New defcustom.  Add
    `buffer-file-name', `tramp-cleanup-dired-buffer-p' and
    `tramp-cleanup-remote-process-p' to the hook.
    (kill-buffer-hook):
    Add `tramp-delete-tainted-remote-process-buffer-function'.
    (tramp-cleanup-all-buffers): Rework.
    
    * lisp/net/tramp-compat.el (tramp-compat-always): New defalias.
    
    * test/lisp/net/tramp-tests.el (tramp--test-always): Delete.
    (tramp-test10-write-region, tramp-test21-file-links)
    (tramp--test-deftest-direct-async-process)
    (tramp-test37-make-auto-save-file-name)
    (tramp-test38-find-backup-file-name)
    (tramp-test39-make-lock-file-name)
    (tramp-test39-detect-external-change): Use `tramp-compat-always'.
---
 doc/misc/tramp.texi          | 15 +++++++++-
 etc/NEWS                     |  7 ++++-
 lisp/net/tramp-adb.el        |  9 ++----
 lisp/net/tramp-cmds.el       | 67 +++++++++++++++++++++++++++++++++++++++++---
 lisp/net/tramp-compat.el     | 10 +++++++
 lisp/net/tramp-crypt.el      |  3 +-
 lisp/net/tramp-gvfs.el       |  9 ++----
 lisp/net/tramp-rclone.el     |  3 +-
 lisp/net/tramp-sh.el         | 20 ++++---------
 lisp/net/tramp-smb.el        | 28 +++---------------
 lisp/net/tramp-sshfs.el      |  3 +-
 lisp/net/tramp-sudoedit.el   |  8 ++----
 lisp/net/tramp.el            | 18 ++++++++++--
 test/lisp/net/tramp-tests.el | 31 +++++++-------------
 14 files changed, 139 insertions(+), 92 deletions(-)

diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 247d718b59a..43792c4e9e3 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -4377,7 +4377,6 @@ Flushes the current buffer's remote connection objects, 
the same as in
 Flushes all active remote connection objects, the same as in
 @code{tramp-cleanup-connection}.  This command removes also ad-hoc
 proxy definitions (@pxref{Ad-hoc multi-hops}).
-
 @end deffn
 
 @deffn Command tramp-cleanup-all-buffers
@@ -4386,6 +4385,20 @@ connections and ad-hoc proxy definition are cleaned up 
in addition to
 killing all buffers related to remote connections.
 @end deffn
 
+@deffn Command tramp-cleanup-some-buffers
+Similar to @code{tramp-cleanup-all-buffers}, where all remote
+connections and ad-hoc proxy definition are cleaned up.  However,
+additional buffers are killed only if one of the functions in
+@code{tramp-cleanup-some-buffers-hook} returns @code{t}.
+@end deffn
+
+@defopt tramp-cleanup-some-buffers-hook
+The functions in this hook determine, whether a remote buffer is
+killed when @code{tramp-cleanup-some-buffers} is called.  Per default,
+remote buffers which are linked to a remote file, remote @code{dired}
+buffers, and buffers related to a remote process are cleaned up.
+@end defopt
+
 
 @node Renaming remote files
 @section Renaming remote files
diff --git a/etc/NEWS b/etc/NEWS
index d39343b8bd4..87d312596cd 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -222,6 +222,11 @@ The latter suppresses also "ControlMaster" settings in the 
user's
 "~/.ssh/config" file, or connection share configuration in PuTTY
 sessions, respectively.
 
++++
+*** New command 'tramp-cleanup-some-buffers'.
+It allows to kill only selected remote buffers, controlled by user
+option 'tramp-cleanup-some-buffers-hook'.
+
 ** EWW
 
 +++
@@ -239,7 +244,7 @@ for tab completion.
 +++
 *** 'eww' URL and keyword prompt now completes suggested URIs and bookmarks.
 The interactive minibuffer prompt when invoking 'eww' now provides
-completions from 'eww-suggest-uris'. 'eww-suggest-uris' now includes
+completions from 'eww-suggest-uris'.  'eww-suggest-uris' now includes
 bookmark URIs.
 
 ** go-ts-mode
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 3f3fb1ea6b3..5a8044f8a53 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -1000,6 +1000,7 @@ implementation will be used."
                            ;; deleted.
                            (when (bufferp stderr)
                              (ignore-errors
+                               (tramp-taint-remote-process-buffer stderr)
                                (with-current-buffer stderr
                                  (insert-file-contents-literally
                                   remote-tmpstderr 'visit)))
@@ -1237,8 +1238,6 @@ connection if a previous connection has died for some 
reason."
                             tramp-adb-program args)))
                 (prompt (md5 (concat (prin1-to-string process-environment)
                                      (current-time-string)))))
-           (tramp-message
-            vec 6 "%s" (string-join (process-command p) " "))
            ;; Wait for initial prompt.  On some devices, it needs an
            ;; initial RET, in order to get it.
             (sleep-for 0.1)
@@ -1247,11 +1246,9 @@ connection if a previous connection has died for some 
reason."
            (unless (process-live-p p)
              (tramp-error vec 'file-error "Terminated!"))
 
-           ;; Set sentinel and query flag.  Initialize variables.
+           ;; Set sentinel.  Initialize variables.
            (set-process-sentinel p #'tramp-process-sentinel)
-           (process-put p 'tramp-vector vec)
-           (process-put p 'adjust-window-size-function #'ignore)
-           (set-process-query-on-exit-flag p nil)
+           (tramp-post-process-creation p vec)
 
            ;; Set connection-local variables.
            (tramp-set-connection-local-variables vec)
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index 1a9d8003530..07f449a3a2e 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -207,17 +207,76 @@ This includes password cache, file cache, connection 
cache, buffers."
   ;; The end.
   (run-hooks 'tramp-cleanup-all-connections-hook))
 
+(defcustom tramp-cleanup-some-buffers-hook nil
+  "Hook for `tramp-cleanup-some-buffers'.
+The functions determine which buffers shall be killed.  This
+happens when at least one of the functions returns non-nil.  The
+functions are called with `current-buffer' set."
+  :group 'tramp
+  :version "30.1"
+  :type 'hook)
+
+(add-hook 'tramp-cleanup-some-buffers-hook
+         #'buffer-file-name)
+
+(defun tramp-cleanup-dired-buffer-p ()
+  "Return t if current buffer runs `dired-mode'."
+  (derived-mode-p 'dired-mode))
+
+(add-hook 'tramp-cleanup-some-buffers-hook
+         #'tramp-cleanup-dired-buffer-p)
+
+(defvar tramp-tainted-remote-process-buffers nil
+  "List of process buffers to be cleaned up.")
+
+(defun tramp-delete-tainted-remote-process-buffer-function ()
+  "Delete current buffer from `tramp-tainted-remote-process-buffers'."
+  (setq tramp-tainted-remote-process-buffers
+       (delete (current-buffer) tramp-tainted-remote-process-buffers)))
+
 ;;;###tramp-autoload
-(defun tramp-cleanup-all-buffers ()
-  "Kill all remote buffers."
+(defun tramp-taint-remote-process-buffer (buffer)
+  "Mark buffer as related to remote processes."
+  (add-to-list 'tramp-tainted-remote-process-buffers buffer))
+
+(add-hook 'kill-buffer-hook
+         #'tramp-delete-tainted-remote-process-buffer-function)
+(add-hook 'tramp-unload-hook
+         (lambda ()
+           (remove-hook 'kill-buffer-hook
+                        
#'tramp-delete-tainted-remote-process-buffer-function)))
+
+(defun tramp-cleanup-remote-process-p ()
+  "Return t if current buffer belongs to a remote process."
+  (memq (current-buffer) tramp-tainted-remote-process-buffers))
+
+(add-hook 'tramp-cleanup-some-buffers-hook
+         #'tramp-cleanup-remote-process-p)
+
+;;;###tramp-autoload
+(defun tramp-cleanup-some-buffers ()
+  "Kill some remote buffers.
+A buffer is killed when it has a remote `default-directory', and
+one of the functions in `tramp-cleanup-some-buffers-hook' returns
+non-nil."
   (interactive)
 
   ;; Remove all Tramp related connections.
   (tramp-cleanup-all-connections)
 
-  ;; Remove all buffers with a remote default-directory.
+  ;; Remove all buffers with a remote default-directory which fit the hook.
   (dolist (name (tramp-list-remote-buffers))
-    (when (bufferp (get-buffer name)) (kill-buffer name))))
+    (and (buffer-live-p (get-buffer name))
+        (with-current-buffer (get-buffer name)
+          (run-hook-with-args-until-success 'tramp-cleanup-some-buffers-hook))
+        (kill-buffer name))))
+
+;;;###tramp-autoload
+(defun tramp-cleanup-all-buffers ()
+  "Kill all remote buffers."
+  (interactive)
+  (let ((tramp-cleanup-some-buffers-hook '(tramp-compat-always)))
+    (tramp-cleanup-some-buffers)))
 
 (defcustom tramp-default-rename-alist nil
   "Default target for renaming remote buffer file names.
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 420d6cadb9c..150c3fbf187 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -219,6 +219,16 @@ Add the extension of F, if existing."
     (lambda (sequence length)
       (= (length sequence) length))))
 
+;; `always' is introduced with Emacs 28.1.
+(defalias 'tramp-compat-always
+  (if (fboundp 'always)
+      #'always
+    (lambda (&rest _arguments)
+      "Do nothing and return t.
+This function accepts any number of ARGUMENTS, but ignores them.
+Also see `ignore'."
+      t)))
+
 ;; `permission-denied' is introduced in Emacs 29.1.
 (defconst tramp-permission-denied
   (if (get 'permission-denied 'error-conditions) 'permission-denied 
'file-error)
diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el
index 4d15695ccbf..ea27c704587 100644
--- a/lisp/net/tramp-crypt.el
+++ b/lisp/net/tramp-crypt.el
@@ -316,8 +316,7 @@ connection if a previous connection has died for some 
reason."
              :name (tramp-get-connection-name vec)
              :buffer (tramp-get-connection-buffer vec)
              :server t :host 'local :service t :noquery t)))
-      (process-put p 'tramp-vector vec)
-      (set-process-query-on-exit-flag p nil)))
+      (tramp-post-process-creation p vec)))
 
   ;; The following operations must be performed without
   ;; `tramp-crypt-file-name-handler'.
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index d44fd55b225..ad7b1ff054c 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -1498,15 +1498,11 @@ If FILE-SYSTEM is non-nil, return file system 
attributes."
       (if (not (processp p))
          (tramp-error
           v 'file-notify-error "Monitoring not supported for `%s'" file-name)
-       (tramp-message
-        v 6 "Run `%s', %S" (string-join (process-command p) " ") p)
-       (process-put p 'tramp-vector v)
        (process-put p 'tramp-events events)
        (process-put p 'tramp-watch-name localname)
-       (process-put p 'adjust-window-size-function #'ignore)
-       (set-process-query-on-exit-flag p nil)
        (set-process-filter p #'tramp-gvfs-monitor-process-filter)
        (set-process-sentinel p #'tramp-file-notify-process-sentinel)
+       (tramp-post-process-creation p v)
        ;; There might be an error if the monitor is not supported.
        ;; Give the filter a chance to read the output.
        (while (tramp-accept-process-output p))
@@ -2204,8 +2200,7 @@ connection if a previous connection has died for some 
reason."
              :name (tramp-get-connection-name vec)
              :buffer (tramp-get-connection-buffer vec)
              :server t :host 'local :service t :noquery t)))
-      (process-put p 'tramp-vector vec)
-      (set-process-query-on-exit-flag p nil)
+      (tramp-post-process-creation p vec)
 
       ;; Set connection-local variables.
       (tramp-set-connection-local-variables vec)))
diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el
index ec6a1da684f..74295de4c29 100644
--- a/lisp/net/tramp-rclone.el
+++ b/lisp/net/tramp-rclone.el
@@ -371,8 +371,7 @@ connection if a previous connection has died for some 
reason."
                  :name (tramp-get-connection-name vec)
                  :buffer (tramp-get-connection-buffer vec)
                  :server t :host 'local :service t :noquery t)))
-         (process-put p 'tramp-vector vec)
-         (set-process-query-on-exit-flag p nil)
+         (tramp-post-process-creation p vec)
 
          ;; Set connection-local variables.
          (tramp-set-connection-local-variables vec)))
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 2df3006c1d9..0369e19378c 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -2426,14 +2426,11 @@ The method used must be an out-of-band method."
                      (tramp-get-connection-name v)
                      (tramp-get-connection-buffer v)
                      copy-program copy-args)))
-               (tramp-message v 6 "%s" (string-join (process-command p) " "))
-               (process-put p 'tramp-vector v)
                ;; This is neded for ssh or PuTTY based processes, and
                ;; only if the respective options are set.  Perhaps,
                ;; the setting could be more fine-grained.
                ;; (process-put p 'tramp-shared-socket t)
-               (process-put p 'adjust-window-size-function #'ignore)
-               (set-process-query-on-exit-flag p nil)
+               (tramp-post-process-creation p v)
 
                ;; We must adapt `tramp-local-end-of-line' for sending
                ;; the password.  Also, we indicate that perhaps
@@ -2934,6 +2931,7 @@ implementation will be used."
                 v 'file-error "Stderr buffer `%s' not supported" stderr))
              (with-current-buffer stderr
                (setq buffer-read-only nil))
+             (tramp-taint-remote-process-buffer stderr)
              ;; Create named pipe.
              (tramp-send-command
               v (format (tramp-get-remote-mknod-or-mkfifo v) tmpstderr))
@@ -3759,8 +3757,6 @@ Fall back to normal file name handler if no Tramp handler 
exists."
           v 'file-notify-error
           "`%s' failed to start on remote host"
           (string-join sequence " "))
-       (tramp-message v 6 "Run `%s', %S" (string-join sequence " ") p)
-       (process-put p 'tramp-vector v)
        ;; This is neded for ssh or PuTTY based processes, and only if
        ;; the respective options are set.  Perhaps, the setting could
        ;; be more fine-grained.
@@ -3768,9 +3764,9 @@ Fall back to normal file name handler if no Tramp handler 
exists."
        ;; Needed for process filter.
        (process-put p 'tramp-events events)
        (process-put p 'tramp-watch-name localname)
-       (set-process-query-on-exit-flag p nil)
        (set-process-filter p filter)
        (set-process-sentinel p #'tramp-file-notify-process-sentinel)
+       (tramp-post-process-creation p v)
        ;; There might be an error if the monitor is not supported.
        ;; Give the filter a chance to read the output.
        (while (tramp-accept-process-output p))
@@ -5130,19 +5126,15 @@ connection if a previous connection has died for some 
reason."
                            (and tramp-encoding-command-interactive
                                 (list tramp-encoding-command-interactive)))))))
 
-               ;; Set sentinel and query flag.  Initialize variables.
-               (set-process-sentinel p #'tramp-process-sentinel)
-               (process-put p 'tramp-vector vec)
                ;; This is neded for ssh or PuTTY based processes, and
                ;; only if the respective options are set.  Perhaps,
                ;; the setting could be more fine-grained.
                ;; (process-put p 'tramp-shared-socket t)
-               (process-put p 'adjust-window-size-function #'ignore)
-               (set-process-query-on-exit-flag p nil)
+               ;; Set sentinel.  Initialize variables.
+               (set-process-sentinel p #'tramp-process-sentinel)
+               (tramp-post-process-creation p vec)
                (setq tramp-current-connection (cons vec (current-time)))
 
-               (tramp-message vec 6 "%s" (string-join (process-command p) " "))
-
                ;; Set connection-local variables.
                (tramp-set-connection-local-variables vec)
 
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 13d5e17a9ff..9a24403bb18 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -556,13 +556,7 @@ arguments to pass to the OPERATION."
                                     (tramp-get-connection-name v)
                                     (tramp-get-connection-buffer v)
                                     tramp-smb-program args)))
-
-                           (tramp-message
-                            v 6 "%s" (string-join (process-command p) " "))
-                           (process-put p 'tramp-vector v)
-                           (process-put
-                            p 'adjust-window-size-function #'ignore)
-                           (set-process-query-on-exit-flag p nil)
+                           (tramp-post-process-creation p v)
                            (tramp-process-actions
                             p v nil tramp-smb-actions-with-tar)
 
@@ -816,12 +810,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are 
completely ignored."
                          (tramp-get-connection-name v)
                          (tramp-get-connection-buffer v)
                          tramp-smb-acl-program args)))
-
-                 (tramp-message
-                  v 6 "%s" (string-join (process-command p) " "))
-                 (process-put p 'tramp-vector v)
-                 (process-put p 'adjust-window-size-function #'ignore)
-                 (set-process-query-on-exit-flag p nil)
+                 (tramp-post-process-creation p v)
                  (tramp-process-actions p v nil tramp-smb-actions-get-acl)
                  (when (> (point-max) (point-min))
                    (substring-no-properties (buffer-string))))))))))))
@@ -1416,12 +1405,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are 
completely ignored."
                        (tramp-get-connection-name v)
                        (tramp-get-connection-buffer v)
                        tramp-smb-acl-program args)))
-
-               (tramp-message
-                v 6 "%s" (string-join (process-command p) " "))
-               (process-put p 'tramp-vector v)
-               (process-put p 'adjust-window-size-function #'ignore)
-               (set-process-query-on-exit-flag p nil)
+               (tramp-post-process-creation p v)
                (tramp-process-actions p v nil tramp-smb-actions-set-acl)
                ;; This is meant for traces, and returning from
                ;; the function.  No error is propagated outside,
@@ -1965,11 +1949,7 @@ If ARGUMENT is non-nil, use it as argument for
                               (if argument
                                   tramp-smb-winexe-program tramp-smb-program)
                               args))))
-
-             (tramp-message vec 6 "%s" (string-join (process-command p) " "))
-             (process-put p 'tramp-vector vec)
-             (process-put p 'adjust-window-size-function #'ignore)
-             (set-process-query-on-exit-flag p nil)
+             (tramp-post-process-creation p vec)
 
              ;; Set connection-local variables.
              (tramp-set-connection-local-variables vec)
diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el
index a4f6246ec23..fe126361ac3 100644
--- a/lisp/net/tramp-sshfs.el
+++ b/lisp/net/tramp-sshfs.el
@@ -399,8 +399,7 @@ connection if a previous connection has died for some 
reason."
              :name (tramp-get-connection-name vec)
              :buffer (tramp-get-connection-buffer vec)
              :server t :host 'local :service t :noquery t)))
-      (process-put p 'tramp-vector vec)
-      (set-process-query-on-exit-flag p nil)
+      (tramp-post-process-creation p vec)
 
       ;; Set connection-local variables.
       (tramp-set-connection-local-variables vec)))
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index defd4f430bc..941c1e8dd24 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -720,8 +720,7 @@ connection if a previous connection has died for some 
reason."
              :name (tramp-get-connection-name vec)
              :buffer (tramp-get-connection-buffer vec)
              :server t :host 'local :service t :noquery t)))
-      (process-put p 'tramp-vector vec)
-      (set-process-query-on-exit-flag p nil)
+      (tramp-post-process-creation p vec)
 
       ;; Set connection-local variables.
       (tramp-set-connection-local-variables vec)
@@ -755,12 +754,9 @@ in case of error, t otherwise."
           (tramp-cache-read-persistent-data t)
           ;; We do not want to save the password.
           auth-source-save-behavior)
-      (tramp-message vec 6 "%s" (string-join (process-command p) " "))
       ;; Avoid process status message in output buffer.
       (set-process-sentinel p #'ignore)
-      (process-put p 'tramp-vector vec)
-      (process-put p 'adjust-window-size-function #'ignore)
-      (set-process-query-on-exit-flag p nil)
+      (tramp-post-process-creation p vec)
       (tramp-set-connection-property p "password-vector" 
tramp-sudoedit-null-hop)
       (tramp-process-actions p vec nil tramp-sudoedit-sudo-actions)
       (tramp-message vec 6 "%s\n%s" (process-exit-status p) (buffer-string))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 3420bb76d14..81473404f0c 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -4941,6 +4941,16 @@ substitution.  SPEC-LIST is a list of char/value pairs 
used for
        (unless (member "" x) x))
       args))))
 
+(defun tramp-post-process-creation (proc vec)
+  "Apply actions after creation of process PROC."
+  (process-put proc 'tramp-vector vec)
+  (process-put proc 'adjust-window-size-function #'ignore)
+  (set-process-query-on-exit-flag proc nil)
+  (tramp-taint-remote-process-buffer (process-buffer proc))
+  (tramp-message vec 6 "%s" (string-join (process-command proc) " ")))
+
+(put #'tramp-post-process-creation 'tramp-suppress-trace t)
+
 (defun tramp-direct-async-process-p (&rest args)
   "Whether direct async `make-process' can be called."
   (let ((v (tramp-dissect-file-name default-directory))
@@ -5090,15 +5100,19 @@ substitution.  SPEC-LIST is a list of char/value pairs 
used for
            ;; t.  See Bug#51177.
            (when filter
              (set-process-filter p filter))
-           (process-put p 'tramp-vector v)
+           (tramp-post-process-creation p v)
+           ;; Query flag is overwritten in `tramp-post-process-creation',
+           ;; so we reset it.
+           (set-process-query-on-exit-flag p (null noquery))
            ;; This is neded for ssh or PuTTY based processes, and
            ;; only if the respective options are set.  Perhaps, the
            ;; setting could be more fine-grained.
            ;; (process-put p 'tramp-shared-socket t)
            (process-put p 'remote-command orig-command)
            (tramp-set-connection-property p "remote-command" orig-command)
+           (when (bufferp stderr)
+             (tramp-taint-remote-process-buffer stderr))
 
-           (tramp-message v 6 "%s" (string-join (process-command p) " "))
            p))))))
 
 (defun tramp-handle-make-symbolic-link
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 9bca6a03754..5fde783087e 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -297,16 +297,6 @@ is greater than 10.
        (tramp--test-message
        "%s %f sec" ,message (float-time (time-subtract nil start))))))
 
-;; `always' is introduced with Emacs 28.1.
-(defalias 'tramp--test-always
-  (if (fboundp 'always)
-      #'always
-    (lambda (&rest _arguments)
-      "Do nothing and return t.
-This function accepts any number of ARGUMENTS, but ignores them.
-Also see `ignore'."
-      t)))
-
 (ert-deftest tramp-test00-availability ()
   "Test availability of Tramp functions."
   :expected-result (if (tramp--test-enabled) :passed :failed)
@@ -2563,9 +2553,9 @@ This checks also `file-name-as-directory', 
`file-name-directory',
            ;; `tramp-test39-make-lock-file-name'.
 
            ;; Do not overwrite if excluded.
-           (cl-letf (((symbol-function #'y-or-n-p) #'tramp--test-always)
+           (cl-letf (((symbol-function #'y-or-n-p) #'tramp-compat-always)
                      ;; Ange-FTP.
-                     ((symbol-function 'yes-or-no-p) #'tramp--test-always))
+                     ((symbol-function 'yes-or-no-p) #'tramp-compat-always))
              (write-region "foo" nil tmp-name nil nil nil 'mustbenew))
            (should-error
             (cl-letf (((symbol-function #'y-or-n-p) #'ignore)
@@ -3991,7 +3981,7 @@ This tests also `make-symbolic-link', `file-truename' and 
`add-name-to-file'."
                (should-error
                 (make-symbolic-link tmp-name1 tmp-name2 0)
                 :type 'file-already-exists)))
-           (cl-letf (((symbol-function #'yes-or-no-p) #'tramp--test-always))
+           (cl-letf (((symbol-function #'yes-or-no-p) #'tramp-compat-always))
              (make-symbolic-link tmp-name1 tmp-name2 0)
              (should
               (string-equal
@@ -4071,7 +4061,7 @@ This tests also `make-symbolic-link', `file-truename' and 
`add-name-to-file'."
               (should-error
                (add-name-to-file tmp-name1 tmp-name2 0)
                :type 'file-already-exists))
-            (cl-letf (((symbol-function #'yes-or-no-p) #'tramp--test-always))
+            (cl-letf (((symbol-function #'yes-or-no-p) #'tramp-compat-always))
               (add-name-to-file tmp-name1 tmp-name2 0)
               (should (file-regular-p tmp-name2)))
             (add-name-to-file tmp-name1 tmp-name2 'ok-if-already-exists)
@@ -5202,7 +5192,7 @@ If UNSTABLE is non-nil, the test is tagged as 
`:unstable'."
        ;; `file-truename' does it by side-effect.  Suppress
        ;; `tramp--test-enabled', in order to keep the connection.
        ;; Suppress "Process ... finished" messages.
-       (cl-letf (((symbol-function #'tramp--test-enabled) #'tramp--test-always)
+       (cl-letf (((symbol-function #'tramp--test-enabled) 
#'tramp-compat-always)
                 ((symbol-function #'internal-default-process-sentinel)
                  #'ignore))
         (file-truename ert-remote-temporary-file-directory)
@@ -6410,7 +6400,7 @@ INPUT, if non-nil, is a string sent to the process."
                  (tramp-cleanup-connection
                   tramp-test-vec 'keep-debug 'keep-password)
                  (cl-letf (((symbol-function #'yes-or-no-p)
-                            #'tramp--test-always))
+                            #'tramp-compat-always))
                    (should (stringp (make-auto-save-file-name))))))))
 
        ;; Cleanup.
@@ -6556,8 +6546,7 @@ INPUT, if non-nil, is a string sent to the process."
                 :type 'file-error))
              (tramp-cleanup-connection
               tramp-test-vec 'keep-debug 'keep-password)
-             (cl-letf (((symbol-function #'yes-or-no-p)
-                        #'tramp--test-always))
+             (cl-letf (((symbol-function #'yes-or-no-p) #'tramp-compat-always))
                (should (stringp (car (find-backup-file-name tmp-name1)))))))
 
        ;; Cleanup.
@@ -6712,8 +6701,7 @@ INPUT, if non-nil, is a string sent to the process."
                 :type 'file-error))
              (tramp-cleanup-connection
               tramp-test-vec 'keep-debug 'keep-password)
-             (cl-letf (((symbol-function #'yes-or-no-p)
-                        #'tramp--test-always))
+             (cl-letf (((symbol-function #'yes-or-no-p) #'tramp-compat-always))
                (write-region "foo" nil tmp-name1))))
 
        ;; Cleanup.
@@ -6783,7 +6771,8 @@ INPUT, if non-nil, is a string sent to the process."
                        (should (file-locked-p tmp-name)))))
 
                  ;; `save-buffer' removes the file lock.
-                 (cl-letf (((symbol-function 'yes-or-no-p) 
#'tramp--test-always)
+                 (cl-letf (((symbol-function 'yes-or-no-p)
+                            #'tramp-compat-always)
                            ((symbol-function 'read-char-choice)
                             (lambda (&rest _) ?y)))
                    (should (buffer-modified-p))