lisp/eshell/esh-proc.el

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