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