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, 2009, 2010, 2011 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 of the License, or
  13 ;; (at your option) 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.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;;; Code:
  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 (defvar eshell-needs-pipe '("bc")
 242   "List of commands which need `process-connection-type' to be nil.
 243 Currently only affects commands in pipelines, and not those at
 244 the front.  If an element contains a directory part it must match
 245 the full name of a command, otherwise just the nondirectory part must match.")
 246
 247 (defun eshell-needs-pipe-p (command)
 248   "Return non-nil if COMMAND needs `process-connection-type' to be nil.
 249 See `eshell-needs-pipe'."
 250   (and eshell-in-pipeline-p
 251        (not (eq eshell-in-pipeline-p 'first))
 252        ;; FIXME should this return non-nil for anything that is
 253        ;; neither 'first nor 'last?  See bug#1388 discussion.
 254        (catch 'found
 255          (dolist (exe eshell-needs-pipe)
 256            (if (string-equal exe (if (string-match "/" exe)
 257                                      command
 258                                    (file-name-nondirectory command)))
 259                (throw 'found t))))))
 260
 261 (defun eshell-gather-process-output (command args)
 262   "Gather the output from COMMAND + ARGS."
 263   (unless (and (file-executable-p command)
 264                (file-regular-p (file-truename command)))
 265     (error "%s: not an executable file" command))
 266   (let* ((delete-exited-processes
 267           (if eshell-current-subjob-p
 268               eshell-delete-exited-processes
 269             delete-exited-processes))
 270          (process-environment (eshell-environment-variables))
 271          proc decoding encoding changed)
 272     (cond
 273      ((fboundp 'start-file-process)
 274       (setq proc
 275             (let ((process-connection-type
 276                    (unless (eshell-needs-pipe-p command)
 277                      process-connection-type))
 278                   (command (or (file-remote-p command 'localname) command)))
 279               (apply 'start-file-process
 280                      (file-name-nondirectory command) nil
 281                      ;; `start-process' can't deal with relative filenames.
 282                      (append (list (expand-file-name command)) args))))
 283       (eshell-record-process-object proc)
 284       (set-process-buffer proc (current-buffer))
 285       (if (eshell-interactive-output-p)
 286           (set-process-filter proc 'eshell-output-filter)
 287         (set-process-filter proc 'eshell-insertion-filter))
 288       (set-process-sentinel proc 'eshell-sentinel)
 289       (run-hook-with-args 'eshell-exec-hook proc)
 290       (when (fboundp 'process-coding-system)
 291         (let ((coding-systems (process-coding-system proc)))
 292           (setq decoding (car coding-systems)
 293                 encoding (cdr coding-systems)))
 294         ;; If start-process decided to use some coding system for
 295         ;; decoding data sent from the process and the coding system
 296         ;; doesn't specify EOL conversion, we had better convert CRLF
 297         ;; to LF.
 298         (if (vectorp (coding-system-eol-type decoding))
 299             (setq decoding (coding-system-change-eol-conversion decoding 'dos)
 300                   changed t))
 301         ;; Even if start-process left the coding system for encoding
 302         ;; data sent from the process undecided, we had better use the
 303         ;; same one as what we use for decoding.  But, we should
 304         ;; suppress EOL conversion.
 305         (if (and decoding (not encoding))
 306             (setq encoding (coding-system-change-eol-conversion decoding 'unix)
 307                   changed t))
 308         (if changed
 309             (set-process-coding-system proc decoding encoding))))
 310      (t
 311       ;; No async subprocesses...
 312       (let ((oldbuf (current-buffer))
 313             (interact-p (eshell-interactive-output-p))
 314             lbeg lend line proc-buf exit-status)
 315         (and (not (markerp eshell-last-sync-output-start))
 316              (setq eshell-last-sync-output-start (point-marker)))
 317         (setq proc-buf
 318               (set-buffer (get-buffer-create eshell-scratch-buffer)))
 319         (erase-buffer)
 320         (set-buffer oldbuf)
 321         (run-hook-with-args 'eshell-exec-hook command)
 322         (setq exit-status
 323               (apply 'call-process-region
 324                      (append (list eshell-last-sync-output-start (point)
 325                                    command t
 326                                    eshell-scratch-buffer nil)
 327                              args)))
 328         ;; When in a pipeline, record the place where the output of
 329         ;; this process will begin.
 330         (and eshell-in-pipeline-p
 331              (set-marker eshell-last-sync-output-start (point)))
 332         ;; Simulate the effect of the process filter.
 333         (when (numberp exit-status)
 334           (set-buffer proc-buf)
 335           (goto-char (point-min))
 336           (setq lbeg (point))
 337           (while (eq 0 (forward-line 1))
 338             (setq lend (point)
 339                   line (buffer-substring-no-properties lbeg lend))
 340             (set-buffer oldbuf)
 341             (if interact-p
 342                 (eshell-output-filter nil line)
 343               (eshell-output-object line))
 344             (setq lbeg lend)
 345             (set-buffer proc-buf))
 346           (set-buffer oldbuf))
 347         (eshell-update-markers eshell-last-output-end)
 348         ;; Simulate the effect of eshell-sentinel.
 349         (eshell-close-handles (if (numberp exit-status) exit-status -1))
 350         (run-hook-with-args 'eshell-kill-hook command exit-status)
 351         (or eshell-in-pipeline-p
 352             (setq eshell-last-sync-output-start nil))
 353         (if (not (numberp exit-status))
 354           (error "%s: external command failed: %s" command exit-status))
 355         (setq proc t))))
 356     proc))
 357
 358 (defun eshell-insertion-filter (proc string)
 359   "Insert a string into the eshell buffer, or a process/file/buffer.
 360 PROC is the process for which we're inserting output.  STRING is the
 361 output."
 362   (when (buffer-live-p (process-buffer proc))
 363     (with-current-buffer (process-buffer proc)
 364       (let ((entry (assq proc eshell-process-list)))
 365         (when entry
 366           (setcar (nthcdr 3 entry)
 367                   (concat (nth 3 entry) string))
 368           (unless (nth 4 entry)         ; already being handled?
 369             (while (nth 3 entry)
 370               (let ((data (nth 3 entry)))
 371                 (setcar (nthcdr 3 entry) nil)
 372                 (setcar (nthcdr 4 entry) t)
 373                 (eshell-output-object data nil (cadr entry))
 374                 (setcar (nthcdr 4 entry) nil)))))))))
 375
 376 (defun eshell-sentinel (proc string)
 377   "Generic sentinel for command processes.  Reports only signals.
 378 PROC is the process that's exiting.  STRING is the exit message."
 379   (when (buffer-live-p (process-buffer proc))
 380     (with-current-buffer (process-buffer proc)
 381       (unwind-protect
 382           (let* ((entry (assq proc eshell-process-list)))
 383 ;           (if (not entry)
 384 ;               (error "Sentinel called for unowned process `%s'"
 385 ;                      (process-name proc))
 386             (when entry
 387               (unwind-protect
 388                   (progn
 389                     (unless (string= string "run")
 390                       (unless (string-match "^\\(finished\\|exited\\)" string)
 391                         (eshell-insertion-filter proc string))
 392                       (eshell-close-handles (process-exit-status proc) 'nil
 393                                             (cadr entry))))
 394                 (eshell-remove-process-entry entry))))
 395         (run-hook-with-args 'eshell-kill-hook proc string)))))
 396
 397 (defun eshell-process-interact (func &optional all query)
 398   "Interact with a process, using PROMPT if more than one, via FUNC.
 399 If ALL is non-nil, background processes will be interacted with as well.
 400 If QUERY is non-nil, query the user with QUERY before calling FUNC."
 401   (let (defunct result)
 402     (eshell-for entry eshell-process-list
 403       (if (and (memq (process-status (car entry))
 404                     '(run stop open closed))
 405                (or all
 406                    (not (nth 2 entry)))
 407                (or (not query)
 408                    (y-or-n-p (format query (process-name (car entry))))))
 409           (setq result (funcall func (car entry))))
 410       (unless (memq (process-status (car entry))
 411                     '(run stop open closed))
 412         (setq defunct (cons entry defunct))))
 413     ;; clean up the process list; this can get dirty if an error
 414     ;; occurred that brought the user into the debugger, and then they
 415     ;; quit, so that the sentinel was never called.
 416     (eshell-for d defunct
 417       (eshell-remove-process-entry d))
 418     result))
 419
 420 (defcustom eshell-kill-process-wait-time 5
 421   "*Seconds to wait between sending termination signals to a subprocess."
 422   :type 'integer
 423   :group 'eshell-proc)
 424
 425 (defcustom eshell-kill-process-signals '(SIGINT SIGQUIT SIGKILL)
 426   "*Signals used to kill processes when an Eshell buffer exits.
 427 Eshell calls each of these signals in order when an Eshell buffer is
 428 killed; if the process is still alive afterwards, Eshell waits a
 429 number of seconds defined by `eshell-kill-process-wait-time', and
 430 tries the next signal in the list."
 431   :type '(repeat symbol)
 432   :group 'eshell-proc)
 433
 434 (defcustom eshell-kill-processes-on-exit nil
 435   "*If non-nil, kill active processes when exiting an Eshell buffer.
 436 Emacs will only kill processes owned by that Eshell buffer.
 437
 438 If nil, ownership of background and foreground processes reverts to
 439 Emacs itself, and will die only if the user exits Emacs, calls
 440 `kill-process', or terminates the processes externally.
 441
 442 If `ask', Emacs prompts the user before killing any processes.
 443
 444 If `every', it prompts once for every process.
 445
 446 If t, it kills all buffer-owned processes without asking.
 447
 448 Processes are first sent SIGHUP, then SIGINT, then SIGQUIT, then
 449 SIGKILL.  The variable `eshell-kill-process-wait-time' specifies how
 450 long to delay between signals."
 451   :type '(choice (const :tag "Kill all, don't ask" t)
 452                  (const :tag "Ask before killing" ask)
 453                  (const :tag "Ask for each process" every)
 454                  (const :tag "Don't kill subprocesses" nil))
 455   :group 'eshell-proc)
 456
 457 (defun eshell-round-robin-kill (&optional query)
 458   "Kill current process by trying various signals in sequence.
 459 See the variable `eshell-kill-processes-on-exit'."
 460   (let ((sigs eshell-kill-process-signals))
 461     (while sigs
 462       (eshell-process-interact
 463        (function
 464         (lambda (proc)
 465           (signal-process (process-id proc) (car sigs)))) t query)
 466       (setq query nil)
 467       (if (not eshell-process-list)
 468           (setq sigs nil)
 469         (sleep-for eshell-kill-process-wait-time)
 470         (setq sigs (cdr sigs))))))
 471
 472 (defun eshell-query-kill-processes ()
 473   "Kill processes belonging to the current Eshell buffer, possibly w/ query."
 474   (when (and eshell-kill-processes-on-exit
 475              eshell-process-list)
 476     (save-window-excursion
 477       (list-processes)
 478       (if (or (not (eq eshell-kill-processes-on-exit 'ask))
 479               (y-or-n-p (format "Kill processes owned by `%s'? "
 480                                 (buffer-name))))
 481           (eshell-round-robin-kill
 482            (if (eq eshell-kill-processes-on-exit 'every)
 483                "Kill Eshell child process `%s'? ")))
 484       (let ((buf (get-buffer "*Process List*")))
 485         (if (and buf (buffer-live-p buf))
 486             (kill-buffer buf)))
 487       (message nil))))
 488
 489 (custom-add-option 'eshell-exit-hook 'eshell-query-kill-processes)
 490
 491 (defun eshell-interrupt-process ()
 492   "Interrupt a process."
 493   (interactive)
 494   (unless (eshell-process-interact 'interrupt-process)
 495     (run-hook-with-args 'eshell-kill-hook nil "interrupt")))
 496
 497 (defun eshell-kill-process ()
 498   "Kill a process."
 499   (interactive)
 500   (unless (eshell-process-interact 'kill-process)
 501     (run-hook-with-args 'eshell-kill-hook nil "killed")))
 502
 503 (defun eshell-quit-process ()
 504   "Send quit signal to process."
 505   (interactive)
 506   (unless (eshell-process-interact 'quit-process)
 507     (run-hook-with-args 'eshell-kill-hook nil "quit")))
 508
 509 ;(defun eshell-stop-process ()
 510 ;  "Send STOP signal to process."
 511 ;  (interactive)
 512 ;  (unless (eshell-process-interact 'stop-process)
 513 ;    (run-hook-with-args 'eshell-kill-hook nil "stopped")))
 514
 515 ;(defun eshell-continue-process ()
 516 ;  "Send CONTINUE signal to process."
 517 ;  (interactive)
 518 ;  (unless (eshell-process-interact 'continue-process)
 519 ;    ;; jww (1999-09-17): this signal is not dealt with yet.  For
 520 ;    ;; example, `eshell-reset' will be called, and so will
 521 ;    ;; `eshell-resume-eval'.
 522 ;    (run-hook-with-args 'eshell-kill-hook nil "continue")))
 523
 524 (defun eshell-send-eof-to-process ()
 525   "Send EOF to process."
 526   (interactive)
 527   (eshell-send-input nil nil t)
 528   (eshell-process-interact 'process-send-eof))
 529
 530 ;; arch-tag: ac477a3e-ee4d-4b44-8ec6-212010e607bb
 531 ;;; esh-proc.el ends here