[Emacs-diffs] Changes to emacs/lisp/eshell/esh-proc.el [lexbind]

[Miles Bader]

Index: emacs/lisp/eshell/esh-proc.el
diff -c /dev/null emacs/lisp/eshell/esh-proc.el:1.6.8.1
*** /dev/null   Tue Oct 14 19:51:53 2003
--- emacs/lisp/eshell/esh-proc.el       Tue Oct 14 19:51:31 2003
***************
*** 0 ****
--- 1,507 ----
+ ;;; esh-proc.el --- process management
+ 
+ ;; Copyright (C) 1999, 2000 Free Software Foundation
+ 
+ ;; Author: John Wiegley <address@hidden>
+ 
+ ;; This file is part of GNU Emacs.
+ 
+ ;; GNU Emacs is free software; you can redistribute it and/or modify
+ ;; it under the terms of the GNU General Public License as published by
+ ;; the Free Software Foundation; either version 2, or (at your option)
+ ;; any later version.
+ 
+ ;; GNU Emacs is distributed in the hope that it will be useful,
+ ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;; GNU General Public License for more details.
+ 
+ ;; You should have received a copy of the GNU General Public License
+ ;; along with GNU Emacs; see the file COPYING.  If not, write to the
+ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ ;; Boston, MA 02111-1307, USA.
+ 
+ (provide 'esh-proc)
+ 
+ (eval-when-compile (require 'esh-maint))
+ 
+ (defgroup eshell-proc nil
+   "When Eshell invokes external commands, it always does so
+ asynchronously, so that Emacs isn't tied up waiting for the process to
+ finish."
+   :tag "Process management"
+   :group 'eshell)
+ 
+ ;;; Commentary:
+ 
+ ;;; User Variables:
+ 
+ (defcustom eshell-proc-load-hook '(eshell-proc-initialize)
+   "*A hook that gets run when `eshell-proc' is loaded."
+   :type 'hook
+   :group 'eshell-proc)
+ 
+ (defcustom eshell-process-wait-seconds 0
+   "*The number of seconds to delay waiting for a synchronous process."
+   :type 'integer
+   :group 'eshell-proc)
+ 
+ (defcustom eshell-process-wait-milliseconds 50
+   "*The number of milliseconds to delay waiting for a synchronous process."
+   :type 'integer
+   :group 'eshell-proc)
+ 
+ (defcustom eshell-done-messages-in-minibuffer t
+   "*If non-nil, subjob \"Done\" messages will display in minibuffer."
+   :type 'boolean
+   :group 'eshell-proc)
+ 
+ (defcustom eshell-delete-exited-processes t
+   "*If nil, process entries will stick around until `jobs' is run.
+ This variable sets the buffer-local value of `delete-exited-processes'
+ in Eshell buffers.
+ 
+ This variable causes Eshell to mimic the behavior of bash when set to
+ nil.  It allows the user to view the exit status of a completed subjob
+ \(process) at their leisure, because the process entry remains in
+ memory until the user examines it using \\[list-processes].
+ 
+ Otherwise, if `eshell-done-messages-in-minibuffer' is nil, and this
+ variable is set to t, the only indication the user will have that a
+ subjob is done is that it will no longer appear in the
+ \\[list-processes\\] display.
+ 
+ Note that Eshell will have to be restarted for a change in this
+ variable's value to take effect."
+   :type 'boolean
+   :group 'eshell-proc)
+ 
+ (defcustom eshell-reset-signals
+   "^\\(interrupt\\|killed\\|quit\\|stopped\\)"
+   "*If a termination signal matches this regexp, the terminal will be reset."
+   :type 'regexp
+   :group 'eshell-proc)
+ 
+ (defcustom eshell-exec-hook nil
+   "*Called each time a process is exec'd by `eshell-gather-process-output'.
+ It is passed one argument, which is the process that was just started.
+ It is useful for things that must be done each time a process is
+ executed in a eshell mode buffer (e.g., `process-kill-without-query').
+ In contrast, `eshell-mode-hook' is only executed once when the buffer
+ is created."
+   :type 'hook
+   :group 'eshell-proc)
+ 
+ (defcustom eshell-kill-hook '(eshell-reset-after-proc)
+   "*Called when a process run by `eshell-gather-process-output' has ended.
+ It is passed two arguments: the process that was just ended, and the
+ termination status (as a string).  Note that the first argument may be
+ nil, in which case the user attempted to send a signal, but there was
+ no relevant process.  This can be used for displaying help
+ information, for example."
+   :type 'hook
+   :group 'eshell-proc)
+ 
+ ;;; Internal Variables:
+ 
+ (defvar eshell-current-subjob-p nil)
+ 
+ (defvar eshell-process-list nil
+   "A list of the current status of subprocesses.")
+ 
+ ;;; Functions:
+ 
+ (defun eshell-proc-initialize ()
+   "Initialize the process handling code."
+   (make-local-variable 'eshell-process-list)
+   (define-key eshell-command-map [(meta ?i)] 'eshell-insert-process)
+   (define-key eshell-command-map [(control ?c)]  'eshell-interrupt-process)
+   (define-key eshell-command-map [(control ?k)]  'eshell-kill-process)
+   (define-key eshell-command-map [(control ?d)]  'eshell-send-eof-to-process)
+ ; (define-key eshell-command-map [(control ?q)]  'eshell-continue-process)
+   (define-key eshell-command-map [(control ?s)]  'list-processes)
+ ; (define-key eshell-command-map [(control ?z)]  'eshell-stop-process)
+   (define-key eshell-command-map [(control ?\\)] 'eshell-quit-process))
+ 
+ (defun eshell-reset-after-proc (proc status)
+   "Reset the command input location after a process terminates.
+ The signals which will cause this to happen are matched by
+ `eshell-reset-signals'."
+   (if (and (stringp status)
+          (string-match eshell-reset-signals status))
+       (eshell-reset)))
+ 
+ (defun eshell-wait-for-process (&rest procs)
+   "Wait until PROC has successfully completed."
+   (while procs
+     (let ((proc (car procs)))
+       (when (eshell-processp proc)
+       ;; NYI: If the process gets stopped here, that's bad.
+       (while (assq proc eshell-process-list)
+         (if (input-pending-p)
+             (discard-input))
+         (sit-for eshell-process-wait-seconds
+                  eshell-process-wait-milliseconds))))
+     (setq procs (cdr procs))))
+ 
+ (defalias 'eshell/wait 'eshell-wait-for-process)
+ 
+ (defun eshell/jobs (&rest args)
+   "List processes, if there are any."
+   (and (fboundp 'process-list)
+        (process-list)
+        (list-processes)))
+ 
+ (defun eshell/kill (&rest args)
+   "Kill processes, buffers, symbol or files."
+   (let ((ptr args)
+       (signum 'SIGINT))
+     (while ptr
+       (if (or (eshell-processp (car ptr))
+             (and (stringp (car ptr))
+                  (string-match "^[A-Za-z/][A-Za-z0-9<>/]+$"
+                                (car ptr))))
+         ;; What about when $lisp-variable is possible here?
+         ;; It could very well name a process.
+         (setcar ptr (get-process (car ptr))))
+       (setq ptr (cdr ptr)))
+     (while args
+       (let ((id (if (eshell-processp (car args))
+                   (process-id (car args))
+                 (car args))))
+       (when id
+         (cond
+          ((null id)
+           (error "kill: bad signal spec"))
+          ((and (numberp id) (= id 0))
+           (error "kill: bad signal spec `%d'" id))
+          ((and (stringp id)
+                (string-match "^-?[0-9]+$" id))
+           (setq signum (abs (string-to-number id))))
+          ((stringp id)
+           (let (case-fold-search)
+             (if (string-match "^-\\([A-Z]+\\)$" id)
+                 (setq signum
+                       (intern (concat "SIG" (match-string 1 id))))
+               (error "kill: bad signal spec `%s'" id))))
+          ((< id 0)
+           (setq signum (abs id)))
+          (t
+           (signal-process id signum)))))
+       (setq args (cdr args)))
+     nil))
+ 
+ (defun eshell-read-process-name (prompt)
+   "Read the name of a process from the minibuffer, using completion.
+ The prompt will be set to PROMPT."
+   (completing-read prompt
+                  (mapcar
+                   (function
+                    (lambda (proc)
+                      (cons (process-name proc) t)))
+                   (process-list)) nil t))
+ 
+ (defun eshell-insert-process (process)
+   "Insert the name of PROCESS into the current buffer at point."
+   (interactive
+    (list (get-process
+         (eshell-read-process-name "Name of process: "))))
+   (insert-and-inherit "#<process " (process-name process) ">"))
+ 
+ (defsubst eshell-record-process-object (object)
+   "Record OBJECT as now running."
+   (if (and (eshell-processp object)
+          eshell-current-subjob-p)
+       (eshell-interactive-print
+        (format "[%s] %d\n" (process-name object) (process-id object))))
+   (setq eshell-process-list
+       (cons (list object eshell-current-handles
+                   eshell-current-subjob-p nil nil)
+             eshell-process-list)))
+ 
+ (defun eshell-remove-process-entry (entry)
+   "Record the process ENTRY as fully completed."
+   (if (and (eshell-processp (car entry))
+          (nth 2 entry)
+          eshell-done-messages-in-minibuffer)
+       (message (format "[%s]+ Done %s" (process-name (car entry))
+                      (process-command (car entry)))))
+   (setq eshell-process-list
+       (delq entry eshell-process-list)))
+ 
+ (defvar eshell-scratch-buffer " *eshell-scratch*"
+   "Scratch buffer for holding Eshell's input/output.")
+ (defvar eshell-last-sync-output-start nil
+   "A marker that tracks the beginning of output of the last subprocess.
+ Used only on systems which do not support async subprocesses.")
+ 
+ (defun eshell-gather-process-output (command args)
+   "Gather the output from COMMAND + ARGS."
+   (unless (and (file-executable-p command)
+              (file-regular-p command))
+     (error "%s: not an executable file" command))
+   (let* ((delete-exited-processes
+         (if eshell-current-subjob-p
+             eshell-delete-exited-processes
+           delete-exited-processes))
+        (process-environment (eshell-environment-variables))
+        proc decoding encoding changed)
+     (cond
+      ((fboundp 'start-process)
+       (setq proc
+           (apply 'start-process
+                  (file-name-nondirectory command) nil
+                  ;; `start-process' can't deal with relative
+                  ;; filenames
+                  (append (list (expand-file-name command)) args)))
+       (eshell-record-process-object proc)
+       (set-process-buffer proc (current-buffer))
+       (if (eshell-interactive-output-p)
+         (set-process-filter proc 'eshell-output-filter)
+       (set-process-filter proc 'eshell-insertion-filter))
+       (set-process-sentinel proc 'eshell-sentinel)
+       (run-hook-with-args 'eshell-exec-hook proc)
+       (when (fboundp 'process-coding-system)
+       (let ((coding-systems (process-coding-system proc)))
+         (setq decoding (car coding-systems)
+               encoding (cdr coding-systems)))
+       ;; If start-process decided to use some coding system for
+       ;; decoding data sent from the process and the coding system
+       ;; doesn't specify EOL conversion, we had better convert CRLF
+       ;; to LF.
+       (if (vectorp (coding-system-eol-type decoding))
+           (setq decoding (coding-system-change-eol-conversion decoding 'dos)
+                 changed t))
+       ;; Even if start-process left the coding system for encoding
+       ;; data sent from the process undecided, we had better use the
+       ;; same one as what we use for decoding.  But, we should
+       ;; suppress EOL conversion.
+       (if (and decoding (not encoding))
+           (setq encoding (coding-system-change-eol-conversion decoding 'unix)
+                 changed t))
+       (if changed
+           (set-process-coding-system proc decoding encoding))))
+      (t
+       ;; No async subprocesses...
+       (let ((oldbuf (current-buffer))
+           (interact-p (eshell-interactive-output-p))
+           lbeg lend line proc-buf exit-status)
+       (and (not (markerp eshell-last-sync-output-start))
+            (setq eshell-last-sync-output-start (point-marker)))
+       (setq proc-buf
+             (set-buffer (get-buffer-create eshell-scratch-buffer)))
+       (erase-buffer)
+       (set-buffer oldbuf)
+       (run-hook-with-args 'eshell-exec-hook command)
+       (setq exit-status
+             (apply 'call-process-region
+                    (append (list eshell-last-sync-output-start (point)
+                                  command t
+                                  eshell-scratch-buffer nil)
+                            args)))
+       ;; When in a pipeline, record the place where the output of
+       ;; this process will begin.
+       (and eshell-in-pipeline-p
+            (set-marker eshell-last-sync-output-start (point)))
+       ;; Simulate the effect of the process filter.
+       (when (numberp exit-status)
+         (set-buffer proc-buf)
+         (goto-char (point-min))
+         (setq lbeg (point))
+         (while (eq 0 (forward-line 1))
+           (setq lend (point)
+                 line (buffer-substring-no-properties lbeg lend))
+           (set-buffer oldbuf)
+           (if interact-p
+               (eshell-output-filter nil line)
+             (eshell-output-object line))
+           (setq lbeg lend)
+           (set-buffer proc-buf))
+         (set-buffer oldbuf))
+       (eshell-update-markers eshell-last-output-end)
+       ;; Simulate the effect of eshell-sentinel.
+       (eshell-close-handles (if (numberp exit-status) exit-status -1))
+       (run-hook-with-args 'eshell-kill-hook command exit-status)
+       (or eshell-in-pipeline-p
+           (setq eshell-last-sync-output-start nil))
+       (if (not (numberp exit-status))
+         (error "%s: external command failed: %s" command exit-status))
+       (setq proc t))))
+     proc))
+ 
+ (defun eshell-insertion-filter (proc string)
+   "Insert a string into the eshell buffer, or a process/file/buffer.
+ PROC is the process for which we're inserting output.  STRING is the
+ output."
+   (when (buffer-live-p (process-buffer proc))
+     (set-buffer (process-buffer proc))
+     (let ((entry (assq proc eshell-process-list)))
+       (when entry
+       (setcar (nthcdr 3 entry)
+               (concat (nth 3 entry) string))
+       (unless (nth 4 entry)           ; already being handled?
+         (while (nth 3 entry)
+           (let ((data (nth 3 entry)))
+             (setcar (nthcdr 3 entry) nil)
+             (setcar (nthcdr 4 entry) t)
+             (eshell-output-object data nil (cadr entry))
+             (setcar (nthcdr 4 entry) nil))))))))
+ 
+ (defun eshell-sentinel (proc string)
+   "Generic sentinel for command processes.  Reports only signals.
+ PROC is the process that's exiting.  STRING is the exit message."
+   (when (buffer-live-p (process-buffer proc))
+     (set-buffer (process-buffer proc))
+     (unwind-protect
+       (let* ((entry (assq proc eshell-process-list)))
+ ;       (if (not entry)
+ ;           (error "Sentinel called for unowned process `%s'"
+ ;                  (process-name proc))
+         (when entry
+           (unwind-protect
+               (progn
+                 (unless (string= string "run")
+                   (unless (string-match "^\\(finished\\|exited\\)" string)
+                     (eshell-insertion-filter proc string))
+                   (eshell-close-handles (process-exit-status proc) 'nil
+                                         (cadr entry))))
+             (eshell-remove-process-entry entry))))
+       (run-hook-with-args 'eshell-kill-hook proc string))))
+ 
+ (defun eshell-process-interact (func &optional all query)
+   "Interact with a process, using PROMPT if more than one, via FUNC.
+ If ALL is non-nil, background processes will be interacted with as well.
+ If QUERY is non-nil, query the user with QUERY before calling FUNC."
+   (let (defunct result)
+     (eshell-for entry eshell-process-list
+       (if (and (memq (process-status (car entry))
+                   '(run stop open closed))
+              (or all
+                  (not (nth 2 entry)))
+              (or (not query)
+                  (y-or-n-p (format query (process-name (car entry))))))
+         (setq result (funcall func (car entry))))
+       (unless (memq (process-status (car entry))
+                   '(run stop open closed))
+       (setq defunct (cons entry defunct))))
+     ;; clean up the process list; this can get dirty if an error
+     ;; occurred that brought the user into the debugger, and then they
+     ;; quit, so that the sentinel was never called.
+     (eshell-for d defunct
+       (eshell-remove-process-entry d))
+     result))
+ 
+ (defcustom eshell-kill-process-wait-time 5
+   "*Seconds to wait between sending termination signals to a subprocess."
+   :type 'integer
+   :group 'eshell-proc)
+ 
+ (defcustom eshell-kill-process-signals '(SIGINT SIGQUIT SIGKILL)
+   "*Signals used to kill processes when an Eshell buffer exits.
+ Eshell calls each of these signals in order when an Eshell buffer is
+ killed; if the process is still alive afterwards, Eshell waits a
+ number of seconds defined by `eshell-kill-process-wait-time', and
+ tries the next signal in the list."
+   :type '(repeat symbol)
+   :group 'eshell-proc)
+ 
+ (defcustom eshell-kill-processes-on-exit nil
+   "*If non-nil, kill active processes when exiting an Eshell buffer.
+ Emacs will only kill processes owned by that Eshell buffer.
+ 
+ If nil, ownership of background and foreground processes reverts to
+ Emacs itself, and will die only if the user exits Emacs, calls
+ `kill-process', or terminates the processes externally.
+ 
+ If `ask', Emacs prompts the user before killing any processes.
+ 
+ If `every', it prompts once for every process.
+ 
+ If t, it kills all buffer-owned processes without asking.
+ 
+ Processes are first sent SIGHUP, then SIGINT, then SIGQUIT, then
+ SIGKILL.  The variable `eshell-kill-process-wait-time' specifies how
+ long to delay between signals."
+   :type '(choice (const :tag "Kill all, don't ask" t)
+                (const :tag "Ask before killing" ask)
+                (const :tag "Ask for each process" every)
+                (const :tag "Don't kill subprocesses" nil))
+   :group 'eshell-proc)
+ 
+ (defun eshell-round-robin-kill (&optional query)
+   "Kill current process by trying various signals in sequence.
+ See the variable `eshell-kill-processes-on-exit'."
+   (let ((sigs eshell-kill-process-signals))
+     (while sigs
+       (eshell-process-interact
+        (function
+       (lambda (proc)
+         (signal-process (process-id proc) (car sigs)))) t query)
+       (setq query nil)
+       (if (not eshell-process-list)
+         (setq sigs nil)
+       (sleep-for eshell-kill-process-wait-time)
+       (setq sigs (cdr sigs))))))
+ 
+ (defun eshell-query-kill-processes ()
+   "Kill processes belonging to the current Eshell buffer, possibly w/ query."
+   (when (and eshell-kill-processes-on-exit
+            eshell-process-list)
+     (save-window-excursion
+       (list-processes)
+       (if (or (not (eq eshell-kill-processes-on-exit 'ask))
+             (y-or-n-p (format "Kill processes owned by `%s'? "
+                               (buffer-name))))
+         (eshell-round-robin-kill
+          (if (eq eshell-kill-processes-on-exit 'every)
+              "Kill Eshell child process `%s'? ")))
+       (let ((buf (get-buffer "*Process List*")))
+       (if (and buf (buffer-live-p buf))
+           (kill-buffer buf)))
+       (message nil))))
+ 
+ (custom-add-option 'eshell-exit-hook 'eshell-query-kill-processes)
+ 
+ (defun eshell-interrupt-process ()
+   "Interrupt a process."
+   (interactive)
+   (unless (eshell-process-interact 'interrupt-process)
+     (run-hook-with-args 'eshell-kill-hook nil "interrupt")))
+ 
+ (defun eshell-kill-process ()
+   "Kill a process."
+   (interactive)
+   (unless (eshell-process-interact 'kill-process)
+     (run-hook-with-args 'eshell-kill-hook nil "killed")))
+ 
+ (defun eshell-quit-process ()
+   "Send quit signal to process."
+   (interactive)
+   (unless (eshell-process-interact 'quit-process)
+     (run-hook-with-args 'eshell-kill-hook nil "quit")))
+ 
+ ;(defun eshell-stop-process ()
+ ;  "Send STOP signal to process."
+ ;  (interactive)
+ ;  (unless (eshell-process-interact 'stop-process)
+ ;    (run-hook-with-args 'eshell-kill-hook nil "stopped")))
+ 
+ ;(defun eshell-continue-process ()
+ ;  "Send CONTINUE signal to process."
+ ;  (interactive)
+ ;  (unless (eshell-process-interact 'continue-process)
+ ;    ;; jww (1999-09-17): this signal is not dealt with yet.  For
+ ;    ;; example, `eshell-reset' will be called, and so will
+ ;    ;; `eshell-resume-eval'.
+ ;    (run-hook-with-args 'eshell-kill-hook nil "continue")))
+ 
+ (defun eshell-send-eof-to-process ()
+   "Send EOF to process."
+   (interactive)
+   (eshell-send-input nil nil t)
+   (eshell-process-interact 'process-send-eof))
+ 
+ ;;; Code:
+ 
+ ;;; arch-tag: ac477a3e-ee4d-4b44-8ec6-212010e607bb
+ ;;; esh-proc.el ends here