aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorMichael Albinus2017-08-21 17:30:33 +0200
committerMichael Albinus2017-08-21 17:30:33 +0200
commit01844e40dc43baf1fdc088ef6400343e908ea449 (patch)
tree65ffb9b54340522908591de90a01f402b6226b8d /lisp
parent76fbe2f4541b11af8bcb0b5e57bb155b796b8d8e (diff)
downloademacs-01844e40dc43baf1fdc088ef6400343e908ea449.tar.gz
emacs-01844e40dc43baf1fdc088ef6400343e908ea449.zip
Implement `interrupt-process-functions'
* lisp/net/tramp.el (tramp-interrupt-process): Rename from `tramp-advice-interrupt-process'. Adapt according to changed API. (top): Add it to `interrupt-process-functions'. * src/process.c (Finternal_default_interrupt_process): New defun. (Finterrupt_process): Change implementation, based on Vinterrupt_process_functions. (Vinterrupt_process_functions): New defvar. * test/lisp/net/tramp-tests.el (tramp-test40-unload): Do not test removal of advice.
Diffstat (limited to 'lisp')
-rw-r--r--lisp/net/tramp.el53
1 files changed, 28 insertions, 25 deletions
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 3469d45ff2a..2aa9a6b9859 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -4381,33 +4381,36 @@ Only works for Bourne-like shells."
4381;;; Signal handling. This works for remote processes, which have set 4381;;; Signal handling. This works for remote processes, which have set
4382;;; the process property `remote-pid'. 4382;;; the process property `remote-pid'.
4383 4383
4384(defun tramp-advice-interrupt-process (orig-fun &rest args) 4384(defun tramp-interrupt-process (&optional process _current-group)
4385 "Interrupt remote process PROC." 4385 "Interrupt remote process PROC."
4386 (let* ((arg0 (car args)) 4386 ;; CURRENT-GROUP is not implemented yet.
4387 (proc (cond 4387 (let ((proc (cond
4388 ((processp arg0) arg0) 4388 ((processp process) process)
4389 ((bufferp arg0) (get-buffer-process arg0)) 4389 ((bufferp process) (get-buffer-process process))
4390 ((stringp arg0) (or (get-process arg0) 4390 ((stringp process) (or (get-process process)
4391 (get-buffer-process arg0))) 4391 (get-buffer-process process)))
4392 ((null arg0) (get-buffer-process (current-buffer))) 4392 ((null process) (get-buffer-process (current-buffer)))
4393 (t arg0))) 4393 (t process)))
4394 pid) 4394 pid)
4395 ;; If it's a Tramp process, send the INT signal remotely. 4395 ;; If it's a Tramp process, send the INT signal remotely.
4396 (if (and (processp proc) 4396 (when (and (processp proc)
4397 (setq pid (process-get proc 'remote-pid))) 4397 (setq pid (process-get proc 'remote-pid)))
4398 (progn 4398 (tramp-message proc 5 "Interrupt process %s with pid %s" proc pid)
4399 (tramp-message proc 5 "%s %s" proc pid) 4399 ;; This is for tramp-sh.el. Other backends do not support this (yet).
4400 (tramp-send-command 4400 (tramp-compat-funcall
4401 (tramp-get-connection-property proc "vector" nil) 4401 'tramp-send-command
4402 (format "kill -2 %d" pid))) 4402 (tramp-get-connection-property proc "vector" nil)
4403 ;; Otherwise, just run the original function. 4403 (format "kill -2 %d" pid))
4404 (apply orig-fun args)))) 4404 ;; Report success.
4405 4405 proc)))
4406(advice-add 'interrupt-process :around 'tramp-advice-interrupt-process) 4406
4407(add-hook 4407;; `interrupt-process-functions' exists since Emacs 26.1.
4408 'tramp-unload-hook 4408(when (boundp 'interrupt-process-functions)
4409 (lambda () 4409 (add-hook 'interrupt-process-functions 'tramp-interrupt-process)
4410 (advice-remove 'interrupt-process 'tramp-advice-interrupt-process))) 4410 (add-hook
4411 'tramp-unload-hook
4412 (lambda ()
4413 (remove-hook 'interrupt-process-functions 'tramp-interrupt-process))))
4411 4414
4412;;; Integration of eshell.el: 4415;;; Integration of eshell.el:
4413 4416