diff options
| author | Michael Albinus | 2023-04-26 18:06:39 +0200 |
|---|---|---|
| committer | Michael Albinus | 2023-04-26 18:06:39 +0200 |
| commit | 022f50ebe616e04bb34487a26d529ca08954d287 (patch) | |
| tree | 617a2abdf09c7f17931a850f9e53709f7327b9f6 | |
| parent | d07815a7cc3540201afa06e3c80c061e9f497815 (diff) | |
| download | emacs-022f50ebe616e04bb34487a26d529ca08954d287.tar.gz emacs-022f50ebe616e04bb34487a26d529ca08954d287.zip | |
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'.
| -rw-r--r-- | doc/misc/tramp.texi | 15 | ||||
| -rw-r--r-- | etc/NEWS | 7 | ||||
| -rw-r--r-- | lisp/net/tramp-adb.el | 9 | ||||
| -rw-r--r-- | lisp/net/tramp-cmds.el | 67 | ||||
| -rw-r--r-- | lisp/net/tramp-compat.el | 10 | ||||
| -rw-r--r-- | lisp/net/tramp-crypt.el | 3 | ||||
| -rw-r--r-- | lisp/net/tramp-gvfs.el | 9 | ||||
| -rw-r--r-- | lisp/net/tramp-rclone.el | 3 | ||||
| -rw-r--r-- | lisp/net/tramp-sh.el | 20 | ||||
| -rw-r--r-- | lisp/net/tramp-smb.el | 28 | ||||
| -rw-r--r-- | lisp/net/tramp-sshfs.el | 3 | ||||
| -rw-r--r-- | lisp/net/tramp-sudoedit.el | 8 | ||||
| -rw-r--r-- | lisp/net/tramp.el | 18 | ||||
| -rw-r--r-- | 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 | |||
| 4377 | Flushes all active remote connection objects, the same as in | 4377 | Flushes all active remote connection objects, the same as in |
| 4378 | @code{tramp-cleanup-connection}. This command removes also ad-hoc | 4378 | @code{tramp-cleanup-connection}. This command removes also ad-hoc |
| 4379 | proxy definitions (@pxref{Ad-hoc multi-hops}). | 4379 | proxy definitions (@pxref{Ad-hoc multi-hops}). |
| 4380 | |||
| 4381 | @end deffn | 4380 | @end deffn |
| 4382 | 4381 | ||
| 4383 | @deffn Command tramp-cleanup-all-buffers | 4382 | @deffn Command tramp-cleanup-all-buffers |
| @@ -4386,6 +4385,20 @@ connections and ad-hoc proxy definition are cleaned up in addition to | |||
| 4386 | killing all buffers related to remote connections. | 4385 | killing all buffers related to remote connections. |
| 4387 | @end deffn | 4386 | @end deffn |
| 4388 | 4387 | ||
| 4388 | @deffn Command tramp-cleanup-some-buffers | ||
| 4389 | Similar to @code{tramp-cleanup-all-buffers}, where all remote | ||
| 4390 | connections and ad-hoc proxy definition are cleaned up. However, | ||
| 4391 | additional buffers are killed only if one of the functions in | ||
| 4392 | @code{tramp-cleanup-some-buffers-hook} returns @code{t}. | ||
| 4393 | @end deffn | ||
| 4394 | |||
| 4395 | @defopt tramp-cleanup-some-buffers-hook | ||
| 4396 | The functions in this hook determine, whether a remote buffer is | ||
| 4397 | killed when @code{tramp-cleanup-some-buffers} is called. Per default, | ||
| 4398 | remote buffers which are linked to a remote file, remote @code{dired} | ||
| 4399 | buffers, and buffers related to a remote process are cleaned up. | ||
| 4400 | @end defopt | ||
| 4401 | |||
| 4389 | 4402 | ||
| 4390 | @node Renaming remote files | 4403 | @node Renaming remote files |
| 4391 | @section Renaming remote files | 4404 | @section Renaming remote files |
| @@ -222,6 +222,11 @@ The latter suppresses also "ControlMaster" settings in the user's | |||
| 222 | "~/.ssh/config" file, or connection share configuration in PuTTY | 222 | "~/.ssh/config" file, or connection share configuration in PuTTY |
| 223 | sessions, respectively. | 223 | sessions, respectively. |
| 224 | 224 | ||
| 225 | +++ | ||
| 226 | *** New command 'tramp-cleanup-some-buffers'. | ||
| 227 | It allows to kill only selected remote buffers, controlled by user | ||
| 228 | option 'tramp-cleanup-some-buffers-hook'. | ||
| 229 | |||
| 225 | ** EWW | 230 | ** EWW |
| 226 | 231 | ||
| 227 | +++ | 232 | +++ |
| @@ -239,7 +244,7 @@ for tab completion. | |||
| 239 | +++ | 244 | +++ |
| 240 | *** 'eww' URL and keyword prompt now completes suggested URIs and bookmarks. | 245 | *** 'eww' URL and keyword prompt now completes suggested URIs and bookmarks. |
| 241 | The interactive minibuffer prompt when invoking 'eww' now provides | 246 | The interactive minibuffer prompt when invoking 'eww' now provides |
| 242 | completions from 'eww-suggest-uris'. 'eww-suggest-uris' now includes | 247 | completions from 'eww-suggest-uris'. 'eww-suggest-uris' now includes |
| 243 | bookmark URIs. | 248 | bookmark URIs. |
| 244 | 249 | ||
| 245 | ** go-ts-mode | 250 | ** 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." | |||
| 1000 | ;; deleted. | 1000 | ;; deleted. |
| 1001 | (when (bufferp stderr) | 1001 | (when (bufferp stderr) |
| 1002 | (ignore-errors | 1002 | (ignore-errors |
| 1003 | (tramp-taint-remote-process-buffer stderr) | ||
| 1003 | (with-current-buffer stderr | 1004 | (with-current-buffer stderr |
| 1004 | (insert-file-contents-literally | 1005 | (insert-file-contents-literally |
| 1005 | remote-tmpstderr 'visit))) | 1006 | remote-tmpstderr 'visit))) |
| @@ -1237,8 +1238,6 @@ connection if a previous connection has died for some reason." | |||
| 1237 | tramp-adb-program args))) | 1238 | tramp-adb-program args))) |
| 1238 | (prompt (md5 (concat (prin1-to-string process-environment) | 1239 | (prompt (md5 (concat (prin1-to-string process-environment) |
| 1239 | (current-time-string))))) | 1240 | (current-time-string))))) |
| 1240 | (tramp-message | ||
| 1241 | vec 6 "%s" (string-join (process-command p) " ")) | ||
| 1242 | ;; Wait for initial prompt. On some devices, it needs an | 1241 | ;; Wait for initial prompt. On some devices, it needs an |
| 1243 | ;; initial RET, in order to get it. | 1242 | ;; initial RET, in order to get it. |
| 1244 | (sleep-for 0.1) | 1243 | (sleep-for 0.1) |
| @@ -1247,11 +1246,9 @@ connection if a previous connection has died for some reason." | |||
| 1247 | (unless (process-live-p p) | 1246 | (unless (process-live-p p) |
| 1248 | (tramp-error vec 'file-error "Terminated!")) | 1247 | (tramp-error vec 'file-error "Terminated!")) |
| 1249 | 1248 | ||
| 1250 | ;; Set sentinel and query flag. Initialize variables. | 1249 | ;; Set sentinel. Initialize variables. |
| 1251 | (set-process-sentinel p #'tramp-process-sentinel) | 1250 | (set-process-sentinel p #'tramp-process-sentinel) |
| 1252 | (process-put p 'tramp-vector vec) | 1251 | (tramp-post-process-creation p vec) |
| 1253 | (process-put p 'adjust-window-size-function #'ignore) | ||
| 1254 | (set-process-query-on-exit-flag p nil) | ||
| 1255 | 1252 | ||
| 1256 | ;; Set connection-local variables. | 1253 | ;; Set connection-local variables. |
| 1257 | (tramp-set-connection-local-variables vec) | 1254 | (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." | |||
| 207 | ;; The end. | 207 | ;; The end. |
| 208 | (run-hooks 'tramp-cleanup-all-connections-hook)) | 208 | (run-hooks 'tramp-cleanup-all-connections-hook)) |
| 209 | 209 | ||
| 210 | (defcustom tramp-cleanup-some-buffers-hook nil | ||
| 211 | "Hook for `tramp-cleanup-some-buffers'. | ||
| 212 | The functions determine which buffers shall be killed. This | ||
| 213 | happens when at least one of the functions returns non-nil. The | ||
| 214 | functions are called with `current-buffer' set." | ||
| 215 | :group 'tramp | ||
| 216 | :version "30.1" | ||
| 217 | :type 'hook) | ||
| 218 | |||
| 219 | (add-hook 'tramp-cleanup-some-buffers-hook | ||
| 220 | #'buffer-file-name) | ||
| 221 | |||
| 222 | (defun tramp-cleanup-dired-buffer-p () | ||
| 223 | "Return t if current buffer runs `dired-mode'." | ||
| 224 | (derived-mode-p 'dired-mode)) | ||
| 225 | |||
| 226 | (add-hook 'tramp-cleanup-some-buffers-hook | ||
| 227 | #'tramp-cleanup-dired-buffer-p) | ||
| 228 | |||
| 229 | (defvar tramp-tainted-remote-process-buffers nil | ||
| 230 | "List of process buffers to be cleaned up.") | ||
| 231 | |||
| 232 | (defun tramp-delete-tainted-remote-process-buffer-function () | ||
| 233 | "Delete current buffer from `tramp-tainted-remote-process-buffers'." | ||
| 234 | (setq tramp-tainted-remote-process-buffers | ||
| 235 | (delete (current-buffer) tramp-tainted-remote-process-buffers))) | ||
| 236 | |||
| 210 | ;;;###tramp-autoload | 237 | ;;;###tramp-autoload |
| 211 | (defun tramp-cleanup-all-buffers () | 238 | (defun tramp-taint-remote-process-buffer (buffer) |
| 212 | "Kill all remote buffers." | 239 | "Mark buffer as related to remote processes." |
| 240 | (add-to-list 'tramp-tainted-remote-process-buffers buffer)) | ||
| 241 | |||
| 242 | (add-hook 'kill-buffer-hook | ||
| 243 | #'tramp-delete-tainted-remote-process-buffer-function) | ||
| 244 | (add-hook 'tramp-unload-hook | ||
| 245 | (lambda () | ||
| 246 | (remove-hook 'kill-buffer-hook | ||
| 247 | #'tramp-delete-tainted-remote-process-buffer-function))) | ||
| 248 | |||
| 249 | (defun tramp-cleanup-remote-process-p () | ||
| 250 | "Return t if current buffer belongs to a remote process." | ||
| 251 | (memq (current-buffer) tramp-tainted-remote-process-buffers)) | ||
| 252 | |||
| 253 | (add-hook 'tramp-cleanup-some-buffers-hook | ||
| 254 | #'tramp-cleanup-remote-process-p) | ||
| 255 | |||
| 256 | ;;;###tramp-autoload | ||
| 257 | (defun tramp-cleanup-some-buffers () | ||
| 258 | "Kill some remote buffers. | ||
| 259 | A buffer is killed when it has a remote `default-directory', and | ||
| 260 | one of the functions in `tramp-cleanup-some-buffers-hook' returns | ||
| 261 | non-nil." | ||
| 213 | (interactive) | 262 | (interactive) |
| 214 | 263 | ||
| 215 | ;; Remove all Tramp related connections. | 264 | ;; Remove all Tramp related connections. |
| 216 | (tramp-cleanup-all-connections) | 265 | (tramp-cleanup-all-connections) |
| 217 | 266 | ||
| 218 | ;; Remove all buffers with a remote default-directory. | 267 | ;; Remove all buffers with a remote default-directory which fit the hook. |
| 219 | (dolist (name (tramp-list-remote-buffers)) | 268 | (dolist (name (tramp-list-remote-buffers)) |
| 220 | (when (bufferp (get-buffer name)) (kill-buffer name)))) | 269 | (and (buffer-live-p (get-buffer name)) |
| 270 | (with-current-buffer (get-buffer name) | ||
| 271 | (run-hook-with-args-until-success 'tramp-cleanup-some-buffers-hook)) | ||
| 272 | (kill-buffer name)))) | ||
| 273 | |||
| 274 | ;;;###tramp-autoload | ||
| 275 | (defun tramp-cleanup-all-buffers () | ||
| 276 | "Kill all remote buffers." | ||
| 277 | (interactive) | ||
| 278 | (let ((tramp-cleanup-some-buffers-hook '(tramp-compat-always))) | ||
| 279 | (tramp-cleanup-some-buffers))) | ||
| 221 | 280 | ||
| 222 | (defcustom tramp-default-rename-alist nil | 281 | (defcustom tramp-default-rename-alist nil |
| 223 | "Default target for renaming remote buffer file names. | 282 | "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." | |||
| 219 | (lambda (sequence length) | 219 | (lambda (sequence length) |
| 220 | (= (length sequence) length)))) | 220 | (= (length sequence) length)))) |
| 221 | 221 | ||
| 222 | ;; `always' is introduced with Emacs 28.1. | ||
| 223 | (defalias 'tramp-compat-always | ||
| 224 | (if (fboundp 'always) | ||
| 225 | #'always | ||
| 226 | (lambda (&rest _arguments) | ||
| 227 | "Do nothing and return t. | ||
| 228 | This function accepts any number of ARGUMENTS, but ignores them. | ||
| 229 | Also see `ignore'." | ||
| 230 | t))) | ||
| 231 | |||
| 222 | ;; `permission-denied' is introduced in Emacs 29.1. | 232 | ;; `permission-denied' is introduced in Emacs 29.1. |
| 223 | (defconst tramp-permission-denied | 233 | (defconst tramp-permission-denied |
| 224 | (if (get 'permission-denied 'error-conditions) 'permission-denied 'file-error) | 234 | (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." | |||
| 316 | :name (tramp-get-connection-name vec) | 316 | :name (tramp-get-connection-name vec) |
| 317 | :buffer (tramp-get-connection-buffer vec) | 317 | :buffer (tramp-get-connection-buffer vec) |
| 318 | :server t :host 'local :service t :noquery t))) | 318 | :server t :host 'local :service t :noquery t))) |
| 319 | (process-put p 'tramp-vector vec) | 319 | (tramp-post-process-creation p vec))) |
| 320 | (set-process-query-on-exit-flag p nil))) | ||
| 321 | 320 | ||
| 322 | ;; The following operations must be performed without | 321 | ;; The following operations must be performed without |
| 323 | ;; `tramp-crypt-file-name-handler'. | 322 | ;; `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." | |||
| 1498 | (if (not (processp p)) | 1498 | (if (not (processp p)) |
| 1499 | (tramp-error | 1499 | (tramp-error |
| 1500 | v 'file-notify-error "Monitoring not supported for `%s'" file-name) | 1500 | v 'file-notify-error "Monitoring not supported for `%s'" file-name) |
| 1501 | (tramp-message | ||
| 1502 | v 6 "Run `%s', %S" (string-join (process-command p) " ") p) | ||
| 1503 | (process-put p 'tramp-vector v) | ||
| 1504 | (process-put p 'tramp-events events) | 1501 | (process-put p 'tramp-events events) |
| 1505 | (process-put p 'tramp-watch-name localname) | 1502 | (process-put p 'tramp-watch-name localname) |
| 1506 | (process-put p 'adjust-window-size-function #'ignore) | ||
| 1507 | (set-process-query-on-exit-flag p nil) | ||
| 1508 | (set-process-filter p #'tramp-gvfs-monitor-process-filter) | 1503 | (set-process-filter p #'tramp-gvfs-monitor-process-filter) |
| 1509 | (set-process-sentinel p #'tramp-file-notify-process-sentinel) | 1504 | (set-process-sentinel p #'tramp-file-notify-process-sentinel) |
| 1505 | (tramp-post-process-creation p v) | ||
| 1510 | ;; There might be an error if the monitor is not supported. | 1506 | ;; There might be an error if the monitor is not supported. |
| 1511 | ;; Give the filter a chance to read the output. | 1507 | ;; Give the filter a chance to read the output. |
| 1512 | (while (tramp-accept-process-output p)) | 1508 | (while (tramp-accept-process-output p)) |
| @@ -2204,8 +2200,7 @@ connection if a previous connection has died for some reason." | |||
| 2204 | :name (tramp-get-connection-name vec) | 2200 | :name (tramp-get-connection-name vec) |
| 2205 | :buffer (tramp-get-connection-buffer vec) | 2201 | :buffer (tramp-get-connection-buffer vec) |
| 2206 | :server t :host 'local :service t :noquery t))) | 2202 | :server t :host 'local :service t :noquery t))) |
| 2207 | (process-put p 'tramp-vector vec) | 2203 | (tramp-post-process-creation p vec) |
| 2208 | (set-process-query-on-exit-flag p nil) | ||
| 2209 | 2204 | ||
| 2210 | ;; Set connection-local variables. | 2205 | ;; Set connection-local variables. |
| 2211 | (tramp-set-connection-local-variables vec))) | 2206 | (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." | |||
| 371 | :name (tramp-get-connection-name vec) | 371 | :name (tramp-get-connection-name vec) |
| 372 | :buffer (tramp-get-connection-buffer vec) | 372 | :buffer (tramp-get-connection-buffer vec) |
| 373 | :server t :host 'local :service t :noquery t))) | 373 | :server t :host 'local :service t :noquery t))) |
| 374 | (process-put p 'tramp-vector vec) | 374 | (tramp-post-process-creation p vec) |
| 375 | (set-process-query-on-exit-flag p nil) | ||
| 376 | 375 | ||
| 377 | ;; Set connection-local variables. | 376 | ;; Set connection-local variables. |
| 378 | (tramp-set-connection-local-variables vec))) | 377 | (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." | |||
| 2426 | (tramp-get-connection-name v) | 2426 | (tramp-get-connection-name v) |
| 2427 | (tramp-get-connection-buffer v) | 2427 | (tramp-get-connection-buffer v) |
| 2428 | copy-program copy-args))) | 2428 | copy-program copy-args))) |
| 2429 | (tramp-message v 6 "%s" (string-join (process-command p) " ")) | ||
| 2430 | (process-put p 'tramp-vector v) | ||
| 2431 | ;; This is neded for ssh or PuTTY based processes, and | 2429 | ;; This is neded for ssh or PuTTY based processes, and |
| 2432 | ;; only if the respective options are set. Perhaps, | 2430 | ;; only if the respective options are set. Perhaps, |
| 2433 | ;; the setting could be more fine-grained. | 2431 | ;; the setting could be more fine-grained. |
| 2434 | ;; (process-put p 'tramp-shared-socket t) | 2432 | ;; (process-put p 'tramp-shared-socket t) |
| 2435 | (process-put p 'adjust-window-size-function #'ignore) | 2433 | (tramp-post-process-creation p v) |
| 2436 | (set-process-query-on-exit-flag p nil) | ||
| 2437 | 2434 | ||
| 2438 | ;; We must adapt `tramp-local-end-of-line' for sending | 2435 | ;; We must adapt `tramp-local-end-of-line' for sending |
| 2439 | ;; the password. Also, we indicate that perhaps | 2436 | ;; the password. Also, we indicate that perhaps |
| @@ -2934,6 +2931,7 @@ implementation will be used." | |||
| 2934 | v 'file-error "Stderr buffer `%s' not supported" stderr)) | 2931 | v 'file-error "Stderr buffer `%s' not supported" stderr)) |
| 2935 | (with-current-buffer stderr | 2932 | (with-current-buffer stderr |
| 2936 | (setq buffer-read-only nil)) | 2933 | (setq buffer-read-only nil)) |
| 2934 | (tramp-taint-remote-process-buffer stderr) | ||
| 2937 | ;; Create named pipe. | 2935 | ;; Create named pipe. |
| 2938 | (tramp-send-command | 2936 | (tramp-send-command |
| 2939 | v (format (tramp-get-remote-mknod-or-mkfifo v) tmpstderr)) | 2937 | 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." | |||
| 3759 | v 'file-notify-error | 3757 | v 'file-notify-error |
| 3760 | "`%s' failed to start on remote host" | 3758 | "`%s' failed to start on remote host" |
| 3761 | (string-join sequence " ")) | 3759 | (string-join sequence " ")) |
| 3762 | (tramp-message v 6 "Run `%s', %S" (string-join sequence " ") p) | ||
| 3763 | (process-put p 'tramp-vector v) | ||
| 3764 | ;; This is neded for ssh or PuTTY based processes, and only if | 3760 | ;; This is neded for ssh or PuTTY based processes, and only if |
| 3765 | ;; the respective options are set. Perhaps, the setting could | 3761 | ;; the respective options are set. Perhaps, the setting could |
| 3766 | ;; be more fine-grained. | 3762 | ;; be more fine-grained. |
| @@ -3768,9 +3764,9 @@ Fall back to normal file name handler if no Tramp handler exists." | |||
| 3768 | ;; Needed for process filter. | 3764 | ;; Needed for process filter. |
| 3769 | (process-put p 'tramp-events events) | 3765 | (process-put p 'tramp-events events) |
| 3770 | (process-put p 'tramp-watch-name localname) | 3766 | (process-put p 'tramp-watch-name localname) |
| 3771 | (set-process-query-on-exit-flag p nil) | ||
| 3772 | (set-process-filter p filter) | 3767 | (set-process-filter p filter) |
| 3773 | (set-process-sentinel p #'tramp-file-notify-process-sentinel) | 3768 | (set-process-sentinel p #'tramp-file-notify-process-sentinel) |
| 3769 | (tramp-post-process-creation p v) | ||
| 3774 | ;; There might be an error if the monitor is not supported. | 3770 | ;; There might be an error if the monitor is not supported. |
| 3775 | ;; Give the filter a chance to read the output. | 3771 | ;; Give the filter a chance to read the output. |
| 3776 | (while (tramp-accept-process-output p)) | 3772 | (while (tramp-accept-process-output p)) |
| @@ -5130,19 +5126,15 @@ connection if a previous connection has died for some reason." | |||
| 5130 | (and tramp-encoding-command-interactive | 5126 | (and tramp-encoding-command-interactive |
| 5131 | (list tramp-encoding-command-interactive))))))) | 5127 | (list tramp-encoding-command-interactive))))))) |
| 5132 | 5128 | ||
| 5133 | ;; Set sentinel and query flag. Initialize variables. | ||
| 5134 | (set-process-sentinel p #'tramp-process-sentinel) | ||
| 5135 | (process-put p 'tramp-vector vec) | ||
| 5136 | ;; This is neded for ssh or PuTTY based processes, and | 5129 | ;; This is neded for ssh or PuTTY based processes, and |
| 5137 | ;; only if the respective options are set. Perhaps, | 5130 | ;; only if the respective options are set. Perhaps, |
| 5138 | ;; the setting could be more fine-grained. | 5131 | ;; the setting could be more fine-grained. |
| 5139 | ;; (process-put p 'tramp-shared-socket t) | 5132 | ;; (process-put p 'tramp-shared-socket t) |
| 5140 | (process-put p 'adjust-window-size-function #'ignore) | 5133 | ;; Set sentinel. Initialize variables. |
| 5141 | (set-process-query-on-exit-flag p nil) | 5134 | (set-process-sentinel p #'tramp-process-sentinel) |
| 5135 | (tramp-post-process-creation p vec) | ||
| 5142 | (setq tramp-current-connection (cons vec (current-time))) | 5136 | (setq tramp-current-connection (cons vec (current-time))) |
| 5143 | 5137 | ||
| 5144 | (tramp-message vec 6 "%s" (string-join (process-command p) " ")) | ||
| 5145 | |||
| 5146 | ;; Set connection-local variables. | 5138 | ;; Set connection-local variables. |
| 5147 | (tramp-set-connection-local-variables vec) | 5139 | (tramp-set-connection-local-variables vec) |
| 5148 | 5140 | ||
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." | |||
| 556 | (tramp-get-connection-name v) | 556 | (tramp-get-connection-name v) |
| 557 | (tramp-get-connection-buffer v) | 557 | (tramp-get-connection-buffer v) |
| 558 | tramp-smb-program args))) | 558 | tramp-smb-program args))) |
| 559 | 559 | (tramp-post-process-creation p v) | |
| 560 | (tramp-message | ||
| 561 | v 6 "%s" (string-join (process-command p) " ")) | ||
| 562 | (process-put p 'tramp-vector v) | ||
| 563 | (process-put | ||
| 564 | p 'adjust-window-size-function #'ignore) | ||
| 565 | (set-process-query-on-exit-flag p nil) | ||
| 566 | (tramp-process-actions | 560 | (tramp-process-actions |
| 567 | p v nil tramp-smb-actions-with-tar) | 561 | p v nil tramp-smb-actions-with-tar) |
| 568 | 562 | ||
| @@ -816,12 +810,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." | |||
| 816 | (tramp-get-connection-name v) | 810 | (tramp-get-connection-name v) |
| 817 | (tramp-get-connection-buffer v) | 811 | (tramp-get-connection-buffer v) |
| 818 | tramp-smb-acl-program args))) | 812 | tramp-smb-acl-program args))) |
| 819 | 813 | (tramp-post-process-creation p v) | |
| 820 | (tramp-message | ||
| 821 | v 6 "%s" (string-join (process-command p) " ")) | ||
| 822 | (process-put p 'tramp-vector v) | ||
| 823 | (process-put p 'adjust-window-size-function #'ignore) | ||
| 824 | (set-process-query-on-exit-flag p nil) | ||
| 825 | (tramp-process-actions p v nil tramp-smb-actions-get-acl) | 814 | (tramp-process-actions p v nil tramp-smb-actions-get-acl) |
| 826 | (when (> (point-max) (point-min)) | 815 | (when (> (point-max) (point-min)) |
| 827 | (substring-no-properties (buffer-string)))))))))))) | 816 | (substring-no-properties (buffer-string)))))))))))) |
| @@ -1416,12 +1405,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." | |||
| 1416 | (tramp-get-connection-name v) | 1405 | (tramp-get-connection-name v) |
| 1417 | (tramp-get-connection-buffer v) | 1406 | (tramp-get-connection-buffer v) |
| 1418 | tramp-smb-acl-program args))) | 1407 | tramp-smb-acl-program args))) |
| 1419 | 1408 | (tramp-post-process-creation p v) | |
| 1420 | (tramp-message | ||
| 1421 | v 6 "%s" (string-join (process-command p) " ")) | ||
| 1422 | (process-put p 'tramp-vector v) | ||
| 1423 | (process-put p 'adjust-window-size-function #'ignore) | ||
| 1424 | (set-process-query-on-exit-flag p nil) | ||
| 1425 | (tramp-process-actions p v nil tramp-smb-actions-set-acl) | 1409 | (tramp-process-actions p v nil tramp-smb-actions-set-acl) |
| 1426 | ;; This is meant for traces, and returning from | 1410 | ;; This is meant for traces, and returning from |
| 1427 | ;; the function. No error is propagated outside, | 1411 | ;; the function. No error is propagated outside, |
| @@ -1965,11 +1949,7 @@ If ARGUMENT is non-nil, use it as argument for | |||
| 1965 | (if argument | 1949 | (if argument |
| 1966 | tramp-smb-winexe-program tramp-smb-program) | 1950 | tramp-smb-winexe-program tramp-smb-program) |
| 1967 | args)))) | 1951 | args)))) |
| 1968 | 1952 | (tramp-post-process-creation p vec) | |
| 1969 | (tramp-message vec 6 "%s" (string-join (process-command p) " ")) | ||
| 1970 | (process-put p 'tramp-vector vec) | ||
| 1971 | (process-put p 'adjust-window-size-function #'ignore) | ||
| 1972 | (set-process-query-on-exit-flag p nil) | ||
| 1973 | 1953 | ||
| 1974 | ;; Set connection-local variables. | 1954 | ;; Set connection-local variables. |
| 1975 | (tramp-set-connection-local-variables vec) | 1955 | (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." | |||
| 399 | :name (tramp-get-connection-name vec) | 399 | :name (tramp-get-connection-name vec) |
| 400 | :buffer (tramp-get-connection-buffer vec) | 400 | :buffer (tramp-get-connection-buffer vec) |
| 401 | :server t :host 'local :service t :noquery t))) | 401 | :server t :host 'local :service t :noquery t))) |
| 402 | (process-put p 'tramp-vector vec) | 402 | (tramp-post-process-creation p vec) |
| 403 | (set-process-query-on-exit-flag p nil) | ||
| 404 | 403 | ||
| 405 | ;; Set connection-local variables. | 404 | ;; Set connection-local variables. |
| 406 | (tramp-set-connection-local-variables vec))) | 405 | (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." | |||
| 720 | :name (tramp-get-connection-name vec) | 720 | :name (tramp-get-connection-name vec) |
| 721 | :buffer (tramp-get-connection-buffer vec) | 721 | :buffer (tramp-get-connection-buffer vec) |
| 722 | :server t :host 'local :service t :noquery t))) | 722 | :server t :host 'local :service t :noquery t))) |
| 723 | (process-put p 'tramp-vector vec) | 723 | (tramp-post-process-creation p vec) |
| 724 | (set-process-query-on-exit-flag p nil) | ||
| 725 | 724 | ||
| 726 | ;; Set connection-local variables. | 725 | ;; Set connection-local variables. |
| 727 | (tramp-set-connection-local-variables vec) | 726 | (tramp-set-connection-local-variables vec) |
| @@ -755,12 +754,9 @@ in case of error, t otherwise." | |||
| 755 | (tramp-cache-read-persistent-data t) | 754 | (tramp-cache-read-persistent-data t) |
| 756 | ;; We do not want to save the password. | 755 | ;; We do not want to save the password. |
| 757 | auth-source-save-behavior) | 756 | auth-source-save-behavior) |
| 758 | (tramp-message vec 6 "%s" (string-join (process-command p) " ")) | ||
| 759 | ;; Avoid process status message in output buffer. | 757 | ;; Avoid process status message in output buffer. |
| 760 | (set-process-sentinel p #'ignore) | 758 | (set-process-sentinel p #'ignore) |
| 761 | (process-put p 'tramp-vector vec) | 759 | (tramp-post-process-creation p vec) |
| 762 | (process-put p 'adjust-window-size-function #'ignore) | ||
| 763 | (set-process-query-on-exit-flag p nil) | ||
| 764 | (tramp-set-connection-property p "password-vector" tramp-sudoedit-null-hop) | 760 | (tramp-set-connection-property p "password-vector" tramp-sudoedit-null-hop) |
| 765 | (tramp-process-actions p vec nil tramp-sudoedit-sudo-actions) | 761 | (tramp-process-actions p vec nil tramp-sudoedit-sudo-actions) |
| 766 | (tramp-message vec 6 "%s\n%s" (process-exit-status p) (buffer-string)) | 762 | (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 | |||
| 4941 | (unless (member "" x) x)) | 4941 | (unless (member "" x) x)) |
| 4942 | args)))) | 4942 | args)))) |
| 4943 | 4943 | ||
| 4944 | (defun tramp-post-process-creation (proc vec) | ||
| 4945 | "Apply actions after creation of process PROC." | ||
| 4946 | (process-put proc 'tramp-vector vec) | ||
| 4947 | (process-put proc 'adjust-window-size-function #'ignore) | ||
| 4948 | (set-process-query-on-exit-flag proc nil) | ||
| 4949 | (tramp-taint-remote-process-buffer (process-buffer proc)) | ||
| 4950 | (tramp-message vec 6 "%s" (string-join (process-command proc) " "))) | ||
| 4951 | |||
| 4952 | (put #'tramp-post-process-creation 'tramp-suppress-trace t) | ||
| 4953 | |||
| 4944 | (defun tramp-direct-async-process-p (&rest args) | 4954 | (defun tramp-direct-async-process-p (&rest args) |
| 4945 | "Whether direct async `make-process' can be called." | 4955 | "Whether direct async `make-process' can be called." |
| 4946 | (let ((v (tramp-dissect-file-name default-directory)) | 4956 | (let ((v (tramp-dissect-file-name default-directory)) |
| @@ -5090,15 +5100,19 @@ substitution. SPEC-LIST is a list of char/value pairs used for | |||
| 5090 | ;; t. See Bug#51177. | 5100 | ;; t. See Bug#51177. |
| 5091 | (when filter | 5101 | (when filter |
| 5092 | (set-process-filter p filter)) | 5102 | (set-process-filter p filter)) |
| 5093 | (process-put p 'tramp-vector v) | 5103 | (tramp-post-process-creation p v) |
| 5104 | ;; Query flag is overwritten in `tramp-post-process-creation', | ||
| 5105 | ;; so we reset it. | ||
| 5106 | (set-process-query-on-exit-flag p (null noquery)) | ||
| 5094 | ;; This is neded for ssh or PuTTY based processes, and | 5107 | ;; This is neded for ssh or PuTTY based processes, and |
| 5095 | ;; only if the respective options are set. Perhaps, the | 5108 | ;; only if the respective options are set. Perhaps, the |
| 5096 | ;; setting could be more fine-grained. | 5109 | ;; setting could be more fine-grained. |
| 5097 | ;; (process-put p 'tramp-shared-socket t) | 5110 | ;; (process-put p 'tramp-shared-socket t) |
| 5098 | (process-put p 'remote-command orig-command) | 5111 | (process-put p 'remote-command orig-command) |
| 5099 | (tramp-set-connection-property p "remote-command" orig-command) | 5112 | (tramp-set-connection-property p "remote-command" orig-command) |
| 5113 | (when (bufferp stderr) | ||
| 5114 | (tramp-taint-remote-process-buffer stderr)) | ||
| 5100 | 5115 | ||
| 5101 | (tramp-message v 6 "%s" (string-join (process-command p) " ")) | ||
| 5102 | p)))))) | 5116 | p)))))) |
| 5103 | 5117 | ||
| 5104 | (defun tramp-handle-make-symbolic-link | 5118 | (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. | |||
| 297 | (tramp--test-message | 297 | (tramp--test-message |
| 298 | "%s %f sec" ,message (float-time (time-subtract nil start)))))) | 298 | "%s %f sec" ,message (float-time (time-subtract nil start)))))) |
| 299 | 299 | ||
| 300 | ;; `always' is introduced with Emacs 28.1. | ||
| 301 | (defalias 'tramp--test-always | ||
| 302 | (if (fboundp 'always) | ||
| 303 | #'always | ||
| 304 | (lambda (&rest _arguments) | ||
| 305 | "Do nothing and return t. | ||
| 306 | This function accepts any number of ARGUMENTS, but ignores them. | ||
| 307 | Also see `ignore'." | ||
| 308 | t))) | ||
| 309 | |||
| 310 | (ert-deftest tramp-test00-availability () | 300 | (ert-deftest tramp-test00-availability () |
| 311 | "Test availability of Tramp functions." | 301 | "Test availability of Tramp functions." |
| 312 | :expected-result (if (tramp--test-enabled) :passed :failed) | 302 | :expected-result (if (tramp--test-enabled) :passed :failed) |
| @@ -2563,9 +2553,9 @@ This checks also `file-name-as-directory', `file-name-directory', | |||
| 2563 | ;; `tramp-test39-make-lock-file-name'. | 2553 | ;; `tramp-test39-make-lock-file-name'. |
| 2564 | 2554 | ||
| 2565 | ;; Do not overwrite if excluded. | 2555 | ;; Do not overwrite if excluded. |
| 2566 | (cl-letf (((symbol-function #'y-or-n-p) #'tramp--test-always) | 2556 | (cl-letf (((symbol-function #'y-or-n-p) #'tramp-compat-always) |
| 2567 | ;; Ange-FTP. | 2557 | ;; Ange-FTP. |
| 2568 | ((symbol-function 'yes-or-no-p) #'tramp--test-always)) | 2558 | ((symbol-function 'yes-or-no-p) #'tramp-compat-always)) |
| 2569 | (write-region "foo" nil tmp-name nil nil nil 'mustbenew)) | 2559 | (write-region "foo" nil tmp-name nil nil nil 'mustbenew)) |
| 2570 | (should-error | 2560 | (should-error |
| 2571 | (cl-letf (((symbol-function #'y-or-n-p) #'ignore) | 2561 | (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'." | |||
| 3991 | (should-error | 3981 | (should-error |
| 3992 | (make-symbolic-link tmp-name1 tmp-name2 0) | 3982 | (make-symbolic-link tmp-name1 tmp-name2 0) |
| 3993 | :type 'file-already-exists))) | 3983 | :type 'file-already-exists))) |
| 3994 | (cl-letf (((symbol-function #'yes-or-no-p) #'tramp--test-always)) | 3984 | (cl-letf (((symbol-function #'yes-or-no-p) #'tramp-compat-always)) |
| 3995 | (make-symbolic-link tmp-name1 tmp-name2 0) | 3985 | (make-symbolic-link tmp-name1 tmp-name2 0) |
| 3996 | (should | 3986 | (should |
| 3997 | (string-equal | 3987 | (string-equal |
| @@ -4071,7 +4061,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." | |||
| 4071 | (should-error | 4061 | (should-error |
| 4072 | (add-name-to-file tmp-name1 tmp-name2 0) | 4062 | (add-name-to-file tmp-name1 tmp-name2 0) |
| 4073 | :type 'file-already-exists)) | 4063 | :type 'file-already-exists)) |
| 4074 | (cl-letf (((symbol-function #'yes-or-no-p) #'tramp--test-always)) | 4064 | (cl-letf (((symbol-function #'yes-or-no-p) #'tramp-compat-always)) |
| 4075 | (add-name-to-file tmp-name1 tmp-name2 0) | 4065 | (add-name-to-file tmp-name1 tmp-name2 0) |
| 4076 | (should (file-regular-p tmp-name2))) | 4066 | (should (file-regular-p tmp-name2))) |
| 4077 | (add-name-to-file tmp-name1 tmp-name2 'ok-if-already-exists) | 4067 | (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'." | |||
| 5202 | ;; `file-truename' does it by side-effect. Suppress | 5192 | ;; `file-truename' does it by side-effect. Suppress |
| 5203 | ;; `tramp--test-enabled', in order to keep the connection. | 5193 | ;; `tramp--test-enabled', in order to keep the connection. |
| 5204 | ;; Suppress "Process ... finished" messages. | 5194 | ;; Suppress "Process ... finished" messages. |
| 5205 | (cl-letf (((symbol-function #'tramp--test-enabled) #'tramp--test-always) | 5195 | (cl-letf (((symbol-function #'tramp--test-enabled) #'tramp-compat-always) |
| 5206 | ((symbol-function #'internal-default-process-sentinel) | 5196 | ((symbol-function #'internal-default-process-sentinel) |
| 5207 | #'ignore)) | 5197 | #'ignore)) |
| 5208 | (file-truename ert-remote-temporary-file-directory) | 5198 | (file-truename ert-remote-temporary-file-directory) |
| @@ -6410,7 +6400,7 @@ INPUT, if non-nil, is a string sent to the process." | |||
| 6410 | (tramp-cleanup-connection | 6400 | (tramp-cleanup-connection |
| 6411 | tramp-test-vec 'keep-debug 'keep-password) | 6401 | tramp-test-vec 'keep-debug 'keep-password) |
| 6412 | (cl-letf (((symbol-function #'yes-or-no-p) | 6402 | (cl-letf (((symbol-function #'yes-or-no-p) |
| 6413 | #'tramp--test-always)) | 6403 | #'tramp-compat-always)) |
| 6414 | (should (stringp (make-auto-save-file-name)))))))) | 6404 | (should (stringp (make-auto-save-file-name)))))))) |
| 6415 | 6405 | ||
| 6416 | ;; Cleanup. | 6406 | ;; Cleanup. |
| @@ -6556,8 +6546,7 @@ INPUT, if non-nil, is a string sent to the process." | |||
| 6556 | :type 'file-error)) | 6546 | :type 'file-error)) |
| 6557 | (tramp-cleanup-connection | 6547 | (tramp-cleanup-connection |
| 6558 | tramp-test-vec 'keep-debug 'keep-password) | 6548 | tramp-test-vec 'keep-debug 'keep-password) |
| 6559 | (cl-letf (((symbol-function #'yes-or-no-p) | 6549 | (cl-letf (((symbol-function #'yes-or-no-p) #'tramp-compat-always)) |
| 6560 | #'tramp--test-always)) | ||
| 6561 | (should (stringp (car (find-backup-file-name tmp-name1))))))) | 6550 | (should (stringp (car (find-backup-file-name tmp-name1))))))) |
| 6562 | 6551 | ||
| 6563 | ;; Cleanup. | 6552 | ;; Cleanup. |
| @@ -6712,8 +6701,7 @@ INPUT, if non-nil, is a string sent to the process." | |||
| 6712 | :type 'file-error)) | 6701 | :type 'file-error)) |
| 6713 | (tramp-cleanup-connection | 6702 | (tramp-cleanup-connection |
| 6714 | tramp-test-vec 'keep-debug 'keep-password) | 6703 | tramp-test-vec 'keep-debug 'keep-password) |
| 6715 | (cl-letf (((symbol-function #'yes-or-no-p) | 6704 | (cl-letf (((symbol-function #'yes-or-no-p) #'tramp-compat-always)) |
| 6716 | #'tramp--test-always)) | ||
| 6717 | (write-region "foo" nil tmp-name1)))) | 6705 | (write-region "foo" nil tmp-name1)))) |
| 6718 | 6706 | ||
| 6719 | ;; Cleanup. | 6707 | ;; Cleanup. |
| @@ -6783,7 +6771,8 @@ INPUT, if non-nil, is a string sent to the process." | |||
| 6783 | (should (file-locked-p tmp-name))))) | 6771 | (should (file-locked-p tmp-name))))) |
| 6784 | 6772 | ||
| 6785 | ;; `save-buffer' removes the file lock. | 6773 | ;; `save-buffer' removes the file lock. |
| 6786 | (cl-letf (((symbol-function 'yes-or-no-p) #'tramp--test-always) | 6774 | (cl-letf (((symbol-function 'yes-or-no-p) |
| 6775 | #'tramp-compat-always) | ||
| 6787 | ((symbol-function 'read-char-choice) | 6776 | ((symbol-function 'read-char-choice) |
| 6788 | (lambda (&rest _) ?y))) | 6777 | (lambda (&rest _) ?y))) |
| 6789 | (should (buffer-modified-p)) | 6778 | (should (buffer-modified-p)) |