lisp/eshell/esh-proc.el

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