lisp/eshell/esh-proc.el

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