1;;; esh-proc.el --- process management 2 3;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 4;; 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: John Wiegley <johnw@gnu.org> 7 8;; This file is part of GNU Emacs. 9 10;; GNU Emacs is free software; you can redistribute it and/or modify 11;; it under the terms of the GNU General Public License as published by 12;; the Free Software Foundation; either version 2, or (at your option) 13;; any later version. 14 15;; GNU Emacs is distributed in the hope that it will be useful, 16;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18;; GNU General Public License for more details. 19 20;; You should have received a copy of the GNU General Public License 21;; along with GNU Emacs; see the file COPYING. If not, write to the 22;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 23;; Boston, MA 02110-1301, USA. 24 25(provide 'esh-proc) 26 27(eval-when-compile (require 'esh-maint)) 28 29(defgroup eshell-proc nil 30 "When Eshell invokes external commands, it always does so 31asynchronously, so that Emacs isn't tied up waiting for the process to 32finish." 33 :tag "Process management" 34 :group 'eshell) 35 36;;; Commentary: 37 38;;; User Variables: 39 40(defcustom eshell-proc-load-hook '(eshell-proc-initialize) 41 "*A hook that gets run when `eshell-proc' is loaded." 42 :type 'hook 43 :group 'eshell-proc) 44 45(defcustom eshell-process-wait-seconds 0 46 "*The number of seconds to delay waiting for a synchronous process." 47 :type 'integer 48 :group 'eshell-proc) 49 50(defcustom eshell-process-wait-milliseconds 50 51 "*The number of milliseconds to delay waiting for a synchronous process." 52 :type 'integer 53 :group 'eshell-proc) 54 55(defcustom eshell-done-messages-in-minibuffer t 56 "*If non-nil, subjob \"Done\" messages will display in minibuffer." 57 :type 'boolean 58 :group 'eshell-proc) 59 60(defcustom eshell-delete-exited-processes t 61 "*If nil, process entries will stick around until `jobs' is run. 62This variable sets the buffer-local value of `delete-exited-processes' 63in Eshell buffers. 64 65This variable causes Eshell to mimic the behavior of bash when set to 66nil. It allows the user to view the exit status of a completed subjob 67\(process) at their leisure, because the process entry remains in 68memory until the user examines it using \\[list-processes]. 69 70Otherwise, if `eshell-done-messages-in-minibuffer' is nil, and this 71variable is set to t, the only indication the user will have that a 72subjob is done is that it will no longer appear in the 73\\[list-processes\\] display. 74 75Note that Eshell will have to be restarted for a change in this 76variable's value to take effect." 77 :type 'boolean 78 :group 'eshell-proc) 79 80(defcustom eshell-reset-signals 81 "^\\(interrupt\\|killed\\|quit\\|stopped\\)" 82 "*If a termination signal matches this regexp, the terminal will be reset." 83 :type 'regexp 84 :group 'eshell-proc) 85 86(defcustom eshell-exec-hook nil 87 "*Called each time a process is exec'd by `eshell-gather-process-output'. 88It is passed one argument, which is the process that was just started. 89It is useful for things that must be done each time a process is 90executed in a eshell mode buffer (e.g., `process-kill-without-query'). 91In contrast, `eshell-mode-hook' is only executed once when the buffer 92is created." 93 :type 'hook 94 :group 'eshell-proc) 95 96(defcustom eshell-kill-hook '(eshell-reset-after-proc) 97 "*Called when a process run by `eshell-gather-process-output' has ended. 98It is passed two arguments: the process that was just ended, and the 99termination status (as a string). Note that the first argument may be 100nil, in which case the user attempted to send a signal, but there was 101no relevant process. This can be used for displaying help 102information, for example." 103 :type 'hook 104 :group 'eshell-proc) 105 106;;; Internal Variables: 107 108(defvar eshell-current-subjob-p nil) 109 110(defvar eshell-process-list nil 111 "A list of the current status of subprocesses.") 112 113;;; Functions: 114 115(defun eshell-proc-initialize () 116 "Initialize the process handling code." 117 (make-local-variable 'eshell-process-list) 118 (define-key eshell-command-map [(meta ?i)] 'eshell-insert-process) 119 (define-key eshell-command-map [(control ?c)] 'eshell-interrupt-process) 120 (define-key eshell-command-map [(control ?k)] 'eshell-kill-process) 121 (define-key eshell-command-map [(control ?d)] 'eshell-send-eof-to-process) 122; (define-key eshell-command-map [(control ?q)] 'eshell-continue-process) 123 (define-key eshell-command-map [(control ?s)] 'list-processes) 124; (define-key eshell-command-map [(control ?z)] 'eshell-stop-process) 125 (define-key eshell-command-map [(control ?\\)] 'eshell-quit-process)) 126 127(defun eshell-reset-after-proc (proc status) 128 "Reset the command input location after a process terminates. 129The signals which will cause this to happen are matched by 130`eshell-reset-signals'." 131 (if (and (stringp status) 132 (string-match eshell-reset-signals status)) 133 (eshell-reset))) 134 135(defun eshell-wait-for-process (&rest procs) 136 "Wait until PROC has successfully completed." 137 (while procs 138 (let ((proc (car procs))) 139 (when (eshell-processp proc) 140 ;; NYI: If the process gets stopped here, that's bad. 141 (while (assq proc eshell-process-list) 142 (if (input-pending-p) 143 (discard-input)) 144 (sit-for eshell-process-wait-seconds 145 eshell-process-wait-milliseconds)))) 146 (setq procs (cdr procs)))) 147 148(defalias 'eshell/wait 'eshell-wait-for-process) 149 150(defun eshell/jobs (&rest args) 151 "List processes, if there are any." 152 (and (fboundp 'process-list) 153 (process-list) 154 (list-processes))) 155 156(defun eshell/kill (&rest args) 157 "Kill processes, buffers, symbol or files." 158 (let ((ptr args) 159 (signum 'SIGINT)) 160 (while ptr 161 (if (or (eshell-processp (car ptr)) 162 (and (stringp (car ptr)) 163 (string-match "^[A-Za-z/][A-Za-z0-9<>/]+$" 164 (car ptr)))) 165 ;; What about when $lisp-variable is possible here? 166 ;; It could very well name a process. 167 (setcar ptr (get-process (car ptr)))) 168 (setq ptr (cdr ptr))) 169 (while args 170 (let ((id (if (eshell-processp (car args)) 171 (process-id (car args)) 172 (car args)))) 173 (when id 174 (cond 175 ((null id) 176 (error "kill: bad signal spec")) 177 ((and (numberp id) (= id 0)) 178 (error "kill: bad signal spec `%d'" id)) 179 ((and (stringp id) 180 (string-match "^-?[0-9]+$" id)) 181 (setq signum (abs (string-to-number id)))) 182 ((stringp id) 183 (let (case-fold-search) 184 (if (string-match "^-\\([A-Z]+[12]?\\)$" id) 185 (setq signum 186 (intern (concat "SIG" (match-string 1 id)))) 187 (error "kill: bad signal spec `%s'" id)))) 188 ((< id 0) 189 (setq signum (abs id))) 190 (t 191 (signal-process id signum))))) 192 (setq args (cdr args))) 193 nil)) 194 195(defun eshell-read-process-name (prompt) 196 "Read the name of a process from the minibuffer, using completion. 197The prompt will be set to PROMPT." 198 (completing-read prompt 199 (mapcar 200 (function 201 (lambda (proc) 202 (cons (process-name proc) t))) 203 (process-list)) nil t)) 204 205(defun eshell-insert-process (process) 206 "Insert the name of PROCESS into the current buffer at point." 207 (interactive 208 (list (get-process 209 (eshell-read-process-name "Name of process: ")))) 210 (insert-and-inherit "#<process " (process-name process) ">")) 211 212(defsubst eshell-record-process-object (object) 213 "Record OBJECT as now running." 214 (if (and (eshell-processp object) 215 eshell-current-subjob-p) 216 (eshell-interactive-print 217 (format "[%s] %d\n" (process-name object) (process-id object)))) 218 (setq eshell-process-list 219 (cons (list object eshell-current-handles 220 eshell-current-subjob-p nil nil) 221 eshell-process-list))) 222 223(defun eshell-remove-process-entry (entry) 224 "Record the process ENTRY as fully completed." 225 (if (and (eshell-processp (car entry)) 226 (nth 2 entry) 227 eshell-done-messages-in-minibuffer) 228 (message "[%s]+ Done %s" (process-name (car entry)) 229 (process-command (car entry)))) 230 (setq eshell-process-list 231 (delq entry eshell-process-list))) 232 233(defvar eshell-scratch-buffer " *eshell-scratch*" 234 "Scratch buffer for holding Eshell's input/output.") 235(defvar eshell-last-sync-output-start nil 236 "A marker that tracks the beginning of output of the last subprocess. 237Used only on systems which do not support async subprocesses.") 238 239(defun eshell-gather-process-output (command args) 240 "Gather the output from COMMAND + ARGS." 241 (unless (and (file-executable-p command) 242 (file-regular-p command)) 243 (error "%s: not an executable file" command)) 244 (let* ((delete-exited-processes 245 (if eshell-current-subjob-p 246 eshell-delete-exited-processes 247 delete-exited-processes)) 248 (process-environment (eshell-environment-variables)) 249 proc decoding encoding changed) 250 (cond 251 ((fboundp 'start-process) 252 (setq proc 253 (apply 'start-process 254 (file-name-nondirectory command) nil 255 ;; `start-process' can't deal with relative 256 ;; filenames 257 (append (list (expand-file-name command)) args))) 258 (eshell-record-process-object proc) 259 (set-process-buffer proc (current-buffer)) 260 (if (eshell-interactive-output-p) 261 (set-process-filter proc 'eshell-output-filter) 262 (set-process-filter proc 'eshell-insertion-filter)) 263 (set-process-sentinel proc 'eshell-sentinel) 264 (run-hook-with-args 'eshell-exec-hook proc) 265 (when (fboundp 'process-coding-system) 266 (let ((coding-systems (process-coding-system proc))) 267 (setq decoding (car coding-systems) 268 encoding (cdr coding-systems))) 269 ;; If start-process decided to use some coding system for 270 ;; decoding data sent from the process and the coding system 271 ;; doesn't specify EOL conversion, we had better convert CRLF 272 ;; to LF. 273 (if (vectorp (coding-system-eol-type decoding)) 274 (setq decoding (coding-system-change-eol-conversion decoding 'dos) 275 changed t)) 276 ;; Even if start-process left the coding system for encoding 277 ;; data sent from the process undecided, we had better use the 278 ;; same one as what we use for decoding. But, we should 279 ;; suppress EOL conversion. 280 (if (and decoding (not encoding)) 281 (setq encoding (coding-system-change-eol-conversion decoding 'unix) 282 changed t)) 283 (if changed 284 (set-process-coding-system proc decoding encoding)))) 285 (t 286 ;; No async subprocesses... 287 (let ((oldbuf (current-buffer)) 288 (interact-p (eshell-interactive-output-p)) 289 lbeg lend line proc-buf exit-status) 290 (and (not (markerp eshell-last-sync-output-start)) 291 (setq eshell-last-sync-output-start (point-marker))) 292 (setq proc-buf 293 (set-buffer (get-buffer-create eshell-scratch-buffer))) 294 (erase-buffer) 295 (set-buffer oldbuf) 296 (run-hook-with-args 'eshell-exec-hook command) 297 (setq exit-status 298 (apply 'call-process-region 299 (append (list eshell-last-sync-output-start (point) 300 command t 301 eshell-scratch-buffer nil) 302 args))) 303 ;; When in a pipeline, record the place where the output of 304 ;; this process will begin. 305 (and eshell-in-pipeline-p 306 (set-marker eshell-last-sync-output-start (point))) 307 ;; Simulate the effect of the process filter. 308 (when (numberp exit-status) 309 (set-buffer proc-buf) 310 (goto-char (point-min)) 311 (setq lbeg (point)) 312 (while (eq 0 (forward-line 1)) 313 (setq lend (point) 314 line (buffer-substring-no-properties lbeg lend)) 315 (set-buffer oldbuf) 316 (if interact-p 317 (eshell-output-filter nil line) 318 (eshell-output-object line)) 319 (setq lbeg lend) 320 (set-buffer proc-buf)) 321 (set-buffer oldbuf)) 322 (eshell-update-markers eshell-last-output-end) 323 ;; Simulate the effect of eshell-sentinel. 324 (eshell-close-handles (if (numberp exit-status) exit-status -1)) 325 (run-hook-with-args 'eshell-kill-hook command exit-status) 326 (or eshell-in-pipeline-p 327 (setq eshell-last-sync-output-start nil)) 328 (if (not (numberp exit-status)) 329 (error "%s: external command failed: %s" command exit-status)) 330 (setq proc t)))) 331 proc)) 332 333(defun eshell-insertion-filter (proc string) 334 "Insert a string into the eshell buffer, or a process/file/buffer. 335PROC is the process for which we're inserting output. STRING is the 336output." 337 (when (buffer-live-p (process-buffer proc)) 338 (set-buffer (process-buffer proc)) 339 (let ((entry (assq proc eshell-process-list))) 340 (when entry 341 (setcar (nthcdr 3 entry) 342 (concat (nth 3 entry) string)) 343 (unless (nth 4 entry) ; already being handled? 344 (while (nth 3 entry) 345 (let ((data (nth 3 entry))) 346 (setcar (nthcdr 3 entry) nil) 347 (setcar (nthcdr 4 entry) t) 348 (eshell-output-object data nil (cadr entry)) 349 (setcar (nthcdr 4 entry) nil)))))))) 350 351(defun eshell-sentinel (proc string) 352 "Generic sentinel for command processes. Reports only signals. 353PROC is the process that's exiting. STRING is the exit message." 354 (when (buffer-live-p (process-buffer proc)) 355 (set-buffer (process-buffer proc)) 356 (unwind-protect 357 (let* ((entry (assq proc eshell-process-list))) 358; (if (not entry) 359; (error "Sentinel called for unowned process `%s'" 360; (process-name proc)) 361 (when entry 362 (unwind-protect 363 (progn 364 (unless (string= string "run") 365 (unless (string-match "^\\(finished\\|exited\\)" string) 366 (eshell-insertion-filter proc string)) 367 (eshell-close-handles (process-exit-status proc) 'nil 368 (cadr entry)))) 369 (eshell-remove-process-entry entry)))) 370 (run-hook-with-args 'eshell-kill-hook proc string)))) 371 372(defun eshell-process-interact (func &optional all query) 373 "Interact with a process, using PROMPT if more than one, via FUNC. 374If ALL is non-nil, background processes will be interacted with as well. 375If QUERY is non-nil, query the user with QUERY before calling FUNC." 376 (let (defunct result) 377 (eshell-for entry eshell-process-list 378 (if (and (memq (process-status (car entry)) 379 '(run stop open closed)) 380 (or all 381 (not (nth 2 entry))) 382 (or (not query) 383 (y-or-n-p (format query (process-name (car entry)))))) 384 (setq result (funcall func (car entry)))) 385 (unless (memq (process-status (car entry)) 386 '(run stop open closed)) 387 (setq defunct (cons entry defunct)))) 388 ;; clean up the process list; this can get dirty if an error 389 ;; occurred that brought the user into the debugger, and then they 390 ;; quit, so that the sentinel was never called. 391 (eshell-for d defunct 392 (eshell-remove-process-entry d)) 393 result)) 394 395(defcustom eshell-kill-process-wait-time 5 396 "*Seconds to wait between sending termination signals to a subprocess." 397 :type 'integer 398 :group 'eshell-proc) 399 400(defcustom eshell-kill-process-signals '(SIGINT SIGQUIT SIGKILL) 401 "*Signals used to kill processes when an Eshell buffer exits. 402Eshell calls each of these signals in order when an Eshell buffer is 403killed; if the process is still alive afterwards, Eshell waits a 404number of seconds defined by `eshell-kill-process-wait-time', and 405tries the next signal in the list." 406 :type '(repeat symbol) 407 :group 'eshell-proc) 408 409(defcustom eshell-kill-processes-on-exit nil 410 "*If non-nil, kill active processes when exiting an Eshell buffer. 411Emacs will only kill processes owned by that Eshell buffer. 412 413If nil, ownership of background and foreground processes reverts to 414Emacs itself, and will die only if the user exits Emacs, calls 415`kill-process', or terminates the processes externally. 416 417If `ask', Emacs prompts the user before killing any processes. 418 419If `every', it prompts once for every process. 420 421If t, it kills all buffer-owned processes without asking. 422 423Processes are first sent SIGHUP, then SIGINT, then SIGQUIT, then 424SIGKILL. The variable `eshell-kill-process-wait-time' specifies how 425long to delay between signals." 426 :type '(choice (const :tag "Kill all, don't ask" t) 427 (const :tag "Ask before killing" ask) 428 (const :tag "Ask for each process" every) 429 (const :tag "Don't kill subprocesses" nil)) 430 :group 'eshell-proc) 431 432(defun eshell-round-robin-kill (&optional query) 433 "Kill current process by trying various signals in sequence. 434See the variable `eshell-kill-processes-on-exit'." 435 (let ((sigs eshell-kill-process-signals)) 436 (while sigs 437 (eshell-process-interact 438 (function 439 (lambda (proc) 440 (signal-process (process-id proc) (car sigs)))) t query) 441 (setq query nil) 442 (if (not eshell-process-list) 443 (setq sigs nil) 444 (sleep-for eshell-kill-process-wait-time) 445 (setq sigs (cdr sigs)))))) 446 447(defun eshell-query-kill-processes () 448 "Kill processes belonging to the current Eshell buffer, possibly w/ query." 449 (when (and eshell-kill-processes-on-exit 450 eshell-process-list) 451 (save-window-excursion 452 (list-processes) 453 (if (or (not (eq eshell-kill-processes-on-exit 'ask)) 454 (y-or-n-p (format "Kill processes owned by `%s'? " 455 (buffer-name)))) 456 (eshell-round-robin-kill 457 (if (eq eshell-kill-processes-on-exit 'every) 458 "Kill Eshell child process `%s'? "))) 459 (let ((buf (get-buffer "*Process List*"))) 460 (if (and buf (buffer-live-p buf)) 461 (kill-buffer buf))) 462 (message nil)))) 463 464(custom-add-option 'eshell-exit-hook 'eshell-query-kill-processes) 465 466(defun eshell-interrupt-process () 467 "Interrupt a process." 468 (interactive) 469 (unless (eshell-process-interact 'interrupt-process) 470 (run-hook-with-args 'eshell-kill-hook nil "interrupt"))) 471 472(defun eshell-kill-process () 473 "Kill a process." 474 (interactive) 475 (unless (eshell-process-interact 'kill-process) 476 (run-hook-with-args 'eshell-kill-hook nil "killed"))) 477 478(defun eshell-quit-process () 479 "Send quit signal to process." 480 (interactive) 481 (unless (eshell-process-interact 'quit-process) 482 (run-hook-with-args 'eshell-kill-hook nil "quit"))) 483 484;(defun eshell-stop-process () 485; "Send STOP signal to process." 486; (interactive) 487; (unless (eshell-process-interact 'stop-process) 488; (run-hook-with-args 'eshell-kill-hook nil "stopped"))) 489 490;(defun eshell-continue-process () 491; "Send CONTINUE signal to process." 492; (interactive) 493; (unless (eshell-process-interact 'continue-process) 494; ;; jww (1999-09-17): this signal is not dealt with yet. For 495; ;; example, `eshell-reset' will be called, and so will 496; ;; `eshell-resume-eval'. 497; (run-hook-with-args 'eshell-kill-hook nil "continue"))) 498 499(defun eshell-send-eof-to-process () 500 "Send EOF to process." 501 (interactive) 502 (eshell-send-input nil nil t) 503 (eshell-process-interact 'process-send-eof)) 504 505;;; Code: 506 507;;; arch-tag: ac477a3e-ee4d-4b44-8ec6-212010e607bb 508;;; esh-proc.el ends here 509