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
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
"~/.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
+++
+++
*** '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
;; deleted.
(when (bufferp stderr)
(ignore-errors
+ (tramp-taint-remote-process-buffer stderr)
(with-current-buffer stderr
(insert-file-contents-literally
remote-tmpstderr 'visit)))
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)
(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)
;; 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.
(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)
: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'.
(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))
: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)))
: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)))
(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
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))
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.
;; 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))
(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)
(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)
(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))))))))))))
(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,
(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)
: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)))
: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)
(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))
(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))
;; 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
(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)
;; `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)
(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
(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)
;; `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)
(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.
: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.
: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.
(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))
projects / emacs.git / commitdiff