;;; comint.el --- general command interpreter in a window stuff
-;; Copyright (C) 1988, 90, 92, 93, 94, 95, 96, 97, 98 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 90, 92, 93, 94, 95, 96, 97, 98, 99 Free Software Foundation, Inc.
;; Author: Olin Shivers <shivers@cs.cmu.edu> then
-;; Simon Marshall <simon@gnu.ai.mit.edu>
+;; Simon Marshall <simon@gnu.org>
;; Maintainer: FSF
;; Keywords: processes
;; Please send me bug reports, bug fixes, and extensions, so that I can
;; merge them into the master source.
;; - Olin Shivers (shivers@cs.cmu.edu)
-;; - Simon Marshall (simon@gnu.ai.mit.edu)
+;; - Simon Marshall (simon@gnu.org)
;; This file defines a general command-interpreter-in-a-buffer package
;; (comint mode). The idea is that you can build specific process-in-a-buffer
;; Comint Mode Commands: (common to all derived modes, like shell & cmulisp
;; mode)
;;
-;; m-p comint-previous-input Cycle backwards in input history
-;; m-n comint-next-input Cycle forwards
+;; m-p comint-previous-input Cycle backwards in input history
+;; m-n comint-next-input Cycle forwards
;; m-r comint-previous-matching-input Previous input matching a regexp
;; m-s comint-next-matching-input Next input that matches
-;; m-c-l comint-show-output Show last batch of process output
+;; m-c-l comint-show-output Show last batch of process output
;; return comint-send-input
-;; c-d comint-delchar-or-maybe-eof Delete char unless at end of buff
-;; c-c c-a comint-bol Beginning of line; skip prompt
+;; c-d comint-delchar-or-maybe-eof Delete char unless at end of buff
+;; c-c c-a comint-bol-or-process-mark First time, move point to bol;
+;; second time, move to process-mark.
;; c-c c-u comint-kill-input ^u
;; c-c c-w backward-kill-word ^w
;; c-c c-c comint-interrupt-subjob ^c
;; comint-continue-subjob Send CONT signal to buffer's process
;; group. Useful if you accidentally
;; suspend your process (with C-c C-z).
+;; comint-get-next-from-history Fetch successive input history lines
+;; comint-accumulate Combine lines to send them together
+;; as input.
+;; comint-goto-process-mark Move point to where process-mark is.
+;; comint-set-process-mark Set process-mark to point.
;; comint-mode-hook is the comint mode hook. Basically for your keybindings.
;; comint-input-ring-size integer For the input history
;; comint-input-ring ring mechanism
;; comint-input-ring-index number ...
+;; comint-save-input-ring-index number ...
;; comint-input-autoexpand symbol ...
;; comint-input-ignoredups boolean ...
-;; comint-last-input-match string ...
;; comint-dynamic-complete-functions hook For the completion mechanism
;; comint-completion-fignore list ...
;; comint-file-name-chars string ...
;; comint-scroll-to-bottom-on-input symbol For scroll behavior
;; comint-scroll-to-bottom-on-output symbol ...
;; comint-scroll-show-maximum-output boolean ...
+;; comint-accum-marker maker For comint-accumulate
;;
;; Comint mode non-buffer local variables:
;; comint-completion-addsuffix boolean/cons For file name
This variable is buffer-local."
:type '(choice (const :tag "off" nil)
- (const :tag "on" t)
(const input)
- (const history))
+ (const history)
+ (other :tag "on" t))
:group 'comint)
(defcustom comint-input-ignoredups nil
(defvar comint-input-ring-size 32
"Size of input history ring.")
+(defvar comint-input-ring-separator "\n"
+ "Separator between commands in the history file.")
+
(defcustom comint-process-echoes nil
"*If non-nil, assume that the subprocess echoes any input.
If so, delete one copy of the input so that only one copy eventually
:type 'boolean
:group 'comint)
-;; AIX puts the name of the person being su'd to in from of the prompt.
+;; AIX puts the name of the person being su'd to in front of the prompt.
+;; kinit prints a prompt like `Password for devnull@GNU.ORG: '.
+;; ksu prints a prompt like `Kerberos password for devnull/root@GNU.ORG: '.
+;; ssh-add prints a prompt like `Enter passphrase: '.
+;; Some implementations of passwd use "Password (again)" as the 2nd prompt.
(defcustom comint-password-prompt-regexp
- "\\(\\([Oo]ld \\|[Nn]ew \\|'s \\|^\\)[Pp]assword\\|pass phrase\\):\\s *\\'"
+ "\\(\\([Oo]ld \\|[Nn]ew \\|Kerberos \\|'s \\|login \\|^\\)\
+[Pp]assword\\( (again)\\)?\\|pass phrase\\|Enter passphrase\\)\
+\\( for [^@ \t\n]+@[^@ \t\n]+\\)?:\\s *\\'"
"*Regexp matching prompts for passwords in the inferior process.
This is used by `comint-watch-for-password-prompt'."
:type 'regexp
"Index of last matched history element.")
(defvar comint-matching-input-from-input-string ""
"Input previously used to match input history.")
+(defvar comint-save-input-ring-index
+ "Last input ring index which you copied.
+This is to support the command \\[comint-get-next-from-history].")
+
+(defvar comint-accum-marker nil
+ "Non-nil if you are accumulating input lines to send as input together.
+The command \\[comint-accumulate] sets this.")
(put 'comint-replace-by-expanded-history 'menu-enable 'comint-input-autoexpand)
(put 'comint-input-ring 'permanent-local t)
(put 'comint-input-ring-index 'permanent-local t)
+(put 'comint-save-input-ring-index 'permanent-local t)
(put 'comint-input-autoexpand 'permanent-local t)
(put 'comint-input-filter-functions 'permanent-local t)
(put 'comint-output-filter-functions 'permanent-local t)
(or (and (boundp 'comint-input-ring) comint-input-ring)
(setq comint-input-ring (make-ring comint-input-ring-size)))
(make-local-variable 'comint-input-ring-index)
+ (make-local-variable 'comint-save-input-ring-index)
(or (and (boundp 'comint-input-ring-index) comint-input-ring-index)
(setq comint-input-ring-index nil))
+ (or (and (boundp 'comint-save-input-ring-index) comint-save-input-ring-index)
+ (setq comint-save-input-ring-index nil))
(make-local-variable 'comint-matching-input-from-input-string)
(make-local-variable 'comint-input-autoexpand)
(make-local-variable 'comint-input-ignoredups)
(make-local-variable 'comint-scroll-to-bottom-on-input)
(make-local-variable 'comint-scroll-to-bottom-on-output)
(make-local-variable 'comint-scroll-show-maximum-output)
- (make-local-variable 'pre-command-hook)
- (add-hook 'pre-command-hook 'comint-preinput-scroll-to-bottom)
+ (make-local-hook 'pre-command-hook)
+ (add-hook 'pre-command-hook 'comint-preinput-scroll-to-bottom t t)
(make-local-hook 'comint-output-filter-functions)
+ (make-local-hook 'comint-exec-hook)
(make-local-variable 'comint-ptyp)
- (make-local-variable 'comint-exec-hook)
(make-local-variable 'comint-process-echoes)
(make-local-variable 'comint-file-name-chars)
(make-local-variable 'comint-file-name-quote-list)
+ (make-local-variable 'comint-accum-marker)
+ (setq comint-accum-marker (make-marker))
+ (set-marker comint-accum-marker nil)
(run-hooks 'comint-mode-hook))
(if comint-mode-map
(define-key comint-mode-map [C-down] 'comint-next-input)
(define-key comint-mode-map "\er" 'comint-previous-matching-input)
(define-key comint-mode-map "\es" 'comint-next-matching-input)
- (define-key comint-mode-map [?\A-\M-r] 'comint-previous-matching-input-from-input)
- (define-key comint-mode-map [?\A-\M-s] 'comint-next-matching-input-from-input)
+ (define-key comint-mode-map [?\C-c ?\M-r] 'comint-previous-matching-input-from-input)
+ (define-key comint-mode-map [?\C-c ?\M-s] 'comint-next-matching-input-from-input)
(define-key comint-mode-map "\e\C-l" 'comint-show-output)
(define-key comint-mode-map "\C-m" 'comint-send-input)
(define-key comint-mode-map "\C-d" 'comint-delchar-or-maybe-eof)
- (define-key comint-mode-map "\C-c\C-a" 'comint-bol)
+ (define-key comint-mode-map "\C-c " 'comint-accumulate)
+ (define-key comint-mode-map "\C-c\C-x" 'comint-get-next-from-history)
+ (define-key comint-mode-map "\C-c\C-a" 'comint-bol-or-process-mark)
(define-key comint-mode-map "\C-c\C-u" 'comint-kill-input)
(define-key comint-mode-map "\C-c\C-w" 'backward-kill-word)
(define-key comint-mode-map "\C-c\C-c" 'comint-interrupt-subjob)
(default-directory
(if (file-accessible-directory-p default-directory)
default-directory
- (char-to-string directory-sep-char))))
- (apply 'start-process name buffer command switches)))
+ (char-to-string directory-sep-char)))
+ proc decoding encoding changed)
+ (let ((exec-path (if (file-name-directory command)
+ ;; If the command has slashes, make sure we
+ ;; first look relative to the current directory.
+ (cons default-directory exec-path) exec-path)))
+ (setq proc (apply 'start-process name buffer command switches)))
+ (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))
+ proc))
\f
;; Input history processing in a buffer
;; ===========================================================================
This function is useful for major mode commands and mode hooks.
-The structure of the history file should be one input command per line,
-with the most recent command last.
+The commands stored in the history file are separated by the
+`comint-input-ring-separator'. The most recent command comes last.
+
See also `comint-input-ignoredups' and `comint-write-input-ring'."
(cond ((or (null comint-input-ring-file-name)
(equal comint-input-ring-file-name ""))
(while (and (< count comint-input-ring-size)
(re-search-backward "^[ \t]*\\([^#\n].*\\)[ \t]*$"
nil t))
- (let ((history (buffer-substring (match-beginning 1)
- (match-end 1))))
- (if (or (null comint-input-ignoredups)
- (ring-empty-p ring)
- (not (string-equal (ring-ref ring 0) history)))
- (ring-insert-at-beginning ring history)))
- (setq count (1+ count))))
+ (let (start end history)
+ (while (and (< count comint-input-ring-size)
+ (re-search-backward comint-input-ring-separator nil t)
+ (setq end (match-beginning 0))
+ (re-search-backward comint-input-ring-separator nil t)
+ (setq start (match-end 0))
+ (setq history (buffer-substring start end))
+ (goto-char start))
+ (if (or (null comint-input-ignoredups)
+ (ring-empty-p ring)
+ (not (string-equal (ring-ref ring 0) history)))
+ (ring-insert-at-beginning ring history)))
+ (setq count (1+ count)))))
(kill-buffer history-buf))
(setq comint-input-ring ring
comint-input-ring-index nil)))))
(erase-buffer)
(while (> index 0)
(setq index (1- index))
- (insert (ring-ref ring index) ?\n))
+ (insert (ring-ref ring index) comint-input-ring-separator))
(write-region (buffer-string) nil file nil 'no-message)
(kill-buffer nil))))))
(message "History item: %d" (1+ pos))
(delete-region
;; Can't use kill-region as it sets this-command
- (process-mark (get-buffer-process (current-buffer))) (point))
+ (or (marker-position comint-accum-marker)
+ (process-mark (get-buffer-process (current-buffer))))
+ (point))
(insert (ring-ref comint-input-ring pos)))))
(defun comint-next-matching-input (regexp arg)
;; Starting a new search
(setq comint-matching-input-from-input-string
(buffer-substring
- (process-mark (get-buffer-process (current-buffer)))
+ (or (marker-position comint-accum-marker)
+ (process-mark (get-buffer-process (current-buffer))))
(point))
comint-input-ring-index nil))
(comint-previous-matching-input
(comint-previous-matching-input-from-input (- arg)))
-(defun comint-replace-by-expanded-history (&optional silent)
+(defun comint-replace-by-expanded-history (&optional silent start)
"Expand input command history references before point.
Expansion is dependent on the value of `comint-input-autoexpand'.
If the optional argument SILENT is non-nil, never complain
even if history reference seems erroneous.
+If the optional argument START is non-nil, that specifies the
+start of the text to scan for history references, rather
+than the logical beginning of line.
+
See `comint-magic-space' and `comint-replace-by-expanded-history-before-point'.
Returns t if successful."
(looking-at comint-prompt-regexp)))
;; Looks like there might be history references in the command.
(let ((previous-modified-tick (buffer-modified-tick)))
- (message "Expanding history references...")
- (comint-replace-by-expanded-history-before-point silent)
+ (comint-replace-by-expanded-history-before-point silent start)
(/= previous-modified-tick (buffer-modified-tick)))))
-(defun comint-replace-by-expanded-history-before-point (silent)
+(defun comint-replace-by-expanded-history-before-point (silent &optional start)
"Expand directory stack reference before point.
-See `comint-replace-by-expanded-history'. Returns t if successful."
+See `comint-replace-by-expanded-history'. Returns t if successful.
+
+If the optional argument START is non-nil, that specifies the
+start of the text to scan for history references, rather
+than the logical beginning of line."
(save-excursion
(let ((toend (- (save-excursion (end-of-line nil) (point)) (point)))
- (start (progn (comint-bol nil) (point))))
+ (start (or start (progn (comint-bol nil) (point)))))
(while (progn
(skip-chars-forward "^!^"
(save-excursion
(replace-match new t t)
(message "History item: substituted"))))
(t
- (goto-char (match-end 0))))))))
+ (forward-char 1)))))))
(defun comint-magic-space (arg)
"Return from STRING the NTH to MTH arguments.
NTH and/or MTH can be nil, which means the last argument.
Returned arguments are separated by single spaces.
-We assume whitespace separates arguments, except within quotes.
+We assume whitespace separates arguments, except within quotes
+and except for a space or tab that immediately follows a backslash.
Also, a run of one or more of a single character
in `comint-delimiter-argument-list' is a separate argument.
Argument 0 is the command name."
- ;; The first line handles ordinary characters and backslash-sequences.
+ ;; The first line handles ordinary characters and backslash-sequences
+ ;; (except with w32 msdos-like shells, where backslashes are valid).
;; The second matches "-quoted strings.
;; The third matches '-quoted strings.
;; The fourth matches `-quoted strings.
;; This seems to fit the syntax of BASH 2.0.
- (let ((argpart "[^ \n\t\"'`\\]+\\|\\\\[\"'`\\]+\\|\
-\\(\"\\([^\"\\]\\|\\\\.\\)*\"\\|\
+ (let* ((first (if (and (eq system-type 'windows-nt)
+ (w32-shell-dos-semantics))
+ "[^ \n\t\"'`]+\\|"
+ "[^ \n\t\"'`\\]+\\|\\\\[\"'`\\ \t]+\\|"))
+ (argpart (concat first
+ "\\(\"\\([^\"\\]\\|\\\\.\\)*\"\\|\
'[^']*'\\|\
-`[^`]*`\\)")
- (args ()) (pos 0)
- (count 0)
- beg str value quotes)
+`[^`]*`\\)"))
+ (args ()) (pos 0)
+ (count 0)
+ beg str value quotes)
;; Build a list of all the args until we have as many as we want.
(while (and (or (null mth) (<= count mth))
(string-match argpart string pos))
;; Just whatever's already there
intxt
;; Expand and leave it visible in buffer
- (comint-replace-by-expanded-history t)
+ (comint-replace-by-expanded-history t pmark)
(buffer-substring pmark (point))))
(history (if (not (eq comint-input-autoexpand 'history))
input
;; This is messy 'cos ultimately the original
;; functions used do insertion, rather than return
;; strings. We have to expand, then insert back.
- (comint-replace-by-expanded-history t)
+ (comint-replace-by-expanded-history t pmark)
(let ((copy (buffer-substring pmark (point)))
(start (point)))
(insert input)
(ring-insert comint-input-ring history))
(run-hook-with-args 'comint-input-filter-functions
(concat input "\n"))
+ (setq comint-save-input-ring-index comint-input-ring-index)
(setq comint-input-ring-index nil)
;; Update the markers before we send the input
;; in case we get output amidst sending the input.
(set-marker comint-last-input-start pmark)
(set-marker comint-last-input-end (point))
(set-marker (process-mark proc) (point))
+ ;; clear the "accumulation" marker
+ (set-marker comint-accum-marker nil)
(funcall comint-input-sender proc input)
;; This used to call comint-output-filter-functions,
;; but that scrolled the buffer in undesirable ways.
(run-hook-with-args 'comint-output-filter-functions "")))))
(defvar comint-preoutput-filter-functions nil
- "Functions to call before output is inserted into the buffer.
-These functions get one argument, a string containing the text to be
-inserted. They return the string as it should be inserted.
+ "List of functions to call before inserting Comint output into the buffer.
+Each function gets one argument, a string containing the text received
+from the subprocess. It should return the string to insert, perhaps
+the same string that was received, or perhaps a modified or transformed
+string.
-This variable is buffer-local.")
+The functions on the list are called sequentially, and each one is
+given the string returned by the previous one. The string returned by
+the last function is the text that is actually inserted in the
+redirection buffer.
+
+This variable is permanent-local.")
;; The purpose of using this filter for comint processes
;; is to keep comint-last-input-end from moving forward
;; when output is inserted.
(defun comint-output-filter (process string)
- ;; First check for killed buffer
(let ((oprocbuf (process-buffer process)))
- (let ((functions comint-preoutput-filter-functions))
- (while (and functions string)
- (setq string (funcall (car functions) string))
- (setq functions (cdr functions))))
- (if (and string oprocbuf (buffer-name oprocbuf))
- (let ((obuf (current-buffer))
- (opoint nil) (obeg nil) (oend nil))
- (set-buffer oprocbuf)
+ ;; First check for killed buffer or no input.
+ (when (and string oprocbuf (buffer-name oprocbuf))
+ (with-current-buffer oprocbuf
+ (let ((functions comint-preoutput-filter-functions))
+ (while (and functions string)
+ (setq string (funcall (car functions) string))
+ (setq functions (cdr functions))))
+ (let (opoint obeg oend)
(setq opoint (point))
(setq obeg (point-min))
(setq oend (point-max))
(narrow-to-region obeg oend)
(goto-char opoint)
- (run-hook-with-args 'comint-output-filter-functions string)
- (set-buffer obuf)))))
+ (run-hook-with-args 'comint-output-filter-functions string))))))
(defun comint-preinput-scroll-to-bottom ()
"Go to the end of buffer in all windows showing it.
(and (eq scroll 'this) (eq selected window))
(and (eq scroll 'others) (not (eq selected window)))
;; If point was at the end, keep it at end.
- (>= (point) comint-last-output-start)))
+ (and (marker-position comint-last-output-start)
+ (>= (point) comint-last-output-start))))
(goto-char (process-mark process)))
;; Optionally scroll so that the text
;; ends at the bottom of the window.
This is a good thing to set in mode hooks.")
(defvar comint-file-name-quote-list nil
- "List of characters to quote with `\' when in a file name.
+ "List of characters to quote with `\\' when in a file name.
This is a good thing to set in mode hooks.")
(set-window-configuration conf)
(setq unread-command-events (listify-key-sequence key)))))))
\f
+(defun comint-get-next-from-history ()
+ "After fetching a line from input history, this fetches the following line.
+In other words, this recalls the input line after the line you recalled last.
+You can use this to repeat a sequence of input lines."
+ (interactive)
+ (if comint-save-input-ring-index
+ (progn
+ (setq comint-input-ring-index (1+ comint-save-input-ring-index))
+ (comint-next-input 1))
+ (message "No previous history command")))
+
+(defun comint-accumulate ()
+ "Accumulate a line to send as input along with more lines.
+This inserts a newline so that you can enter more text
+to be sent along with this line. Use \\[comint-send-input]
+to send all the accumulated input, at once.
+The entire accumulated text becomes one item in the input history
+when you send it."
+ (interactive)
+ (insert "\n")
+ (set-marker comint-accum-marker (point))
+ (if comint-input-ring-index
+ (setq comint-save-input-ring-index
+ (- comint-input-ring-index 1))))
+
+(defun comint-goto-process-mark ()
+ "Move point to the process mark.
+The process mark separates output, and input already sent,
+from input that has not yet been sent."
+ (interactive)
+ (let ((proc (or (get-buffer-process (current-buffer))
+ (error "Current buffer has no process"))))
+ (goto-char (process-mark proc))
+ (message "Point is now at the process mark")))
+
+(defun comint-bol-or-process-mark ()
+ "Move point to beginning of line (after prompt) or to the process mark.
+The first time you use this command, it moves to the beginning of the line
+\(but after the prompt, if any). If you repeat it again immediately,
+it moves point to the process mark.
+
+The process mark separates the process output, along with input already sent,
+from input that has not yet been sent. Ordinarily, the process mark
+is at the beginning of the current input line; but if you have
+used \\[comint-accumulate] to send multiple lines at once,
+the process mark is at the beginning of the accumulated input."
+ (interactive)
+ (if (not (eq last-command 'comint-bol-or-process-mark))
+ (comint-bol nil)
+ (comint-goto-process-mark)))
+
+(defun comint-set-process-mark ()
+ "Set the process mark at point."
+ (interactive)
+ (let ((proc (or (get-buffer-process (current-buffer))
+ (error "Current buffer has no process"))))
+ (set-marker (process-mark proc) (point))
+ (message "Process mark set")))
+
+\f
+;; Author: Peter Breton <pbreton@ne.mediaone.net>
+
+;; This little add-on for comint is intended to make it easy to get
+;; output from currently active comint buffers into another buffer,
+;; or buffers, and then go back to using the comint shell.
+;;
+;; My particular use is SQL interpreters; I want to be able to execute a
+;; query using the process associated with a comint-buffer, and save that
+;; somewhere else. Because the process might have state (for example, it
+;; could be in an uncommitted transaction), just running starting a new
+;; process and having it execute the query and then finish, would not
+;; work. I'm sure there are other uses as well, although in many cases
+;; starting a new process is the simpler, and thus preferable, approach.
+;;
+;; The basic implementation is as follows: comint-redirect changes the
+;; preoutput filter functions (comint-preoutput-filter-functions) to use
+;; its own filter. The filter puts the output into the designated buffer,
+;; or buffers, until it sees a regexp that tells it to stop (by default,
+;; this is the prompt for the interpreter, comint-prompt-regexp). When it
+;; sees the stop regexp, it restores the old filter functions, and runs
+;; comint-redirect-hook.
+;;
+;; Each comint buffer may only use one redirection at a time, but any number
+;; of different comint buffers may be simultaneously redirected.
+;;
+;; NOTE: It is EXTREMELY important that `comint-prompt-regexp' be set to the
+;; correct prompt for your interpreter, or that you supply a regexp that says
+;; when the redirection is finished. Otherwise, redirection will continue
+;; indefinitely. The code now does a sanity check to ensure that it can find
+;; a prompt in the comint buffer; however, it is still important to ensure that
+;; this prompt is set correctly.
+;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Variables
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defcustom comint-redirect-verbose nil
+ "*If non-nil, print messages each time the redirection filter is invoked.
+Also print a message when redirection is completed."
+ :group 'comint
+ :type 'boolean)
+
+;; Directly analagous to comint-preoutput-filter-functions
+(defvar comint-redirect-filter-functions nil
+ "List of functions to call before inserting redirected process output.
+Each function gets one argument, a string containing the text received
+from the subprocess. It should return the string to insert, perhaps
+the same string that was received, or perhaps a modified or transformed
+string.
+
+The functions on the list are called sequentially, and each one is given
+the string returned by the previous one. The string returned by the
+last function is the text that is actually inserted in the redirection buffer.")
+
+(make-variable-buffer-local 'comint-redirect-filter-functions)
+
+;; Internal variables
+
+(defvar comint-redirect-output-buffer nil
+ "The buffer or list of buffers to put output into.")
+
+(defvar comint-redirect-finished-regexp nil
+ "Regular expression that determines when to stop redirection in Comint.
+When the redirection filter function is given output that matches this regexp,
+the output is inserted as usual, and redirection is completed.")
+
+(defvar comint-redirect-insert-matching-regexp nil
+ "If non-nil, the text that ends a redirection is included in it.
+More precisely, the text that matches `comint-redirect-finished-regexp'
+and therefore terminates an output redirection is inserted in the
+redirection target buffer, along with the preceding output.")
+
+(defvar comint-redirect-echo-input nil
+ "Non-nil means echo input in the process buffer even during redirection.")
+
+(defvar comint-redirect-completed nil
+ "Non-nil if redirection has completed in the current buffer.")
+
+(defvar comint-redirect-original-mode-line-process nil
+ "Original mode line for redirected process.")
+
+(defvar comint-redirect-perform-sanity-check t
+ "If non-nil, check that redirection is likely to complete successfully.
+More precisely, before starting a redirection, verify that the
+regular expression `comint-redirect-finished-regexp' that controls
+when to terminate it actually matches some text already in the process
+buffer. The idea is that this regular expression should match a prompt
+string, and that there ought to be at least one copy of your prompt string
+in the process buffer already.")
+
+(defvar comint-redirect-original-filter-function nil
+ "The process filter that was in place when redirection is started.
+When redirection is completed, the process filter is restored to
+this value.")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun comint-redirect-setup (output-buffer
+ comint-buffer
+ finished-regexp
+ &optional echo-input)
+ "Set up for output redirection.
+This function sets local variables that are used by `comint-redirect-filter'
+to perform redirection.
+
+Output from COMINT-BUFFER is redirected to OUTPUT-BUFFER, until something
+in the output matches FINISHED-REGEXP.
+
+If optional argument ECHO-INPUT is non-nil, output is echoed to the
+original comint buffer.
+
+This function is called by `comint-redirect-send-command-to-process',
+and does not normally need to be invoked by the end user or programmer."
+ (with-current-buffer comint-buffer
+
+ (make-local-variable 'comint-redirect-original-mode-line-process)
+ (setq comint-redirect-original-mode-line-process mode-line-process)
+
+ (make-local-variable 'comint-redirect-output-buffer)
+ (setq comint-redirect-output-buffer output-buffer)
+
+ (make-local-variable 'comint-redirect-finished-regexp)
+ (setq comint-redirect-finished-regexp finished-regexp)
+
+ (make-local-variable 'comint-redirect-echo-input)
+ (setq comint-redirect-echo-input echo-input)
+
+ (make-local-variable 'comint-redirect-completed)
+ (setq comint-redirect-completed nil)
+
+ (setq mode-line-process
+ (if mode-line-process
+ (list (concat (elt mode-line-process 0) " Redirection"))
+ (list ":%s Redirection")))))
+
+(defun comint-redirect-cleanup ()
+ "End a Comint redirection. See `comint-redirect-send-command'."
+ (interactive)
+ ;; Restore the process filter
+ (set-process-filter (get-buffer-process (current-buffer))
+ comint-redirect-original-filter-function)
+ ;; Restore the mode line
+ (setq mode-line-process comint-redirect-original-mode-line-process)
+ ;; Set the completed flag
+ (setq comint-redirect-completed t))
+
+;; Because the cleanup happens as a callback, it's not easy to guarantee
+;; that it really occurs.
+(defalias 'comint-redirect-remove-redirection 'comint-redirect-cleanup)
+
+(defun comint-redirect-filter (process input-string)
+ "Filter function which redirects output from PROCESS to a buffer or buffers.
+The variable `comint-redirect-output-buffer' says which buffer(s) to
+place output in.
+
+INPUT-STRING is the input from the comint process.
+
+This function runs as a process filter, and does not need to be invoked by the
+end user."
+ (and process
+ (with-current-buffer (process-buffer process)
+ (comint-redirect-preoutput-filter input-string)
+ ;; If we have to echo output, give it to the original filter function
+ (and comint-redirect-echo-input
+ comint-redirect-original-filter-function
+ (funcall comint-redirect-original-filter-function
+ process input-string)))))
+
+
+(defun comint-redirect-preoutput-filter (input-string)
+ "Comint filter function which redirects comint output to a buffer or buffers.
+The variable `comint-redirect-output-buffer' says which buffer(s) to
+place output in.
+
+INPUT-STRING is the input from the comint process.
+
+This function does not need to be invoked by the end user."
+ (let ((output-buffer-list
+ (if (listp comint-redirect-output-buffer)
+ comint-redirect-output-buffer
+ (list comint-redirect-output-buffer)))
+ (filtered-input-string input-string))
+
+ ;; If there are any filter functions, give them a chance to modify the string
+ (let ((functions comint-redirect-filter-functions))
+ (while (and functions filtered-input-string)
+ (setq filtered-input-string
+ (funcall (car functions) filtered-input-string))
+ (setq functions (cdr functions))))
+
+ ;; Clobber `comint-redirect-finished-regexp'
+ (or comint-redirect-insert-matching-regexp
+ (and (string-match comint-redirect-finished-regexp filtered-input-string)
+ (setq filtered-input-string
+ (replace-match "" nil nil filtered-input-string))))
+
+ ;; Send output to all registered buffers
+ (save-excursion
+ (mapcar
+ (function (lambda(buf)
+ ;; Set this buffer to the output buffer
+ (set-buffer (get-buffer-create buf))
+ ;; Go to the end of the buffer
+ (goto-char (point-max))
+ ;; Insert the output
+ (insert filtered-input-string)))
+ output-buffer-list))
+
+ ;; Message
+ (and comint-redirect-verbose
+ (message "Redirected output to buffer(s) %s"
+ (mapconcat 'identity output-buffer-list " ")))
+
+ ;; If we see the prompt, tidy up
+ ;; We'll look for the prompt in the original string, so nobody can
+ ;; clobber it
+ (and (string-match comint-redirect-finished-regexp input-string)
+ (progn
+ (and comint-redirect-verbose
+ (message "Redirection completed"))
+ (comint-redirect-cleanup)
+ (run-hooks 'comint-redirect-hook)))
+ ;; Echo input?
+ (if comint-redirect-echo-input
+ filtered-input-string
+ "")))
+
+;;;###autoload
+(defun comint-redirect-send-command (command output-buffer echo &optional no-display)
+ "Send COMMAND to process in current buffer, with output to OUTPUT-BUFFER.
+With prefix arg, echo output in process buffer.
+
+If NO-DISPLAY is non-nil, do not show the output buffer."
+ (interactive "sCommand: \nBOutput Buffer: \nP")
+ (let ((process (get-buffer-process (current-buffer))))
+ (if process
+ (comint-redirect-send-command-to-process
+ command output-buffer (current-buffer) echo no-display)
+ (error "No process for current buffer"))))
+
+;;;###autoload
+(defun comint-redirect-send-command-to-process
+ (command output-buffer process echo &optional no-display)
+ "Send COMMAND to PROCESS, with output to OUTPUT-BUFFER.
+With prefix arg, echo output in process buffer.
+
+If NO-DISPLAY is non-nil, do not show the output buffer."
+ (interactive "sCommand: \nBOutput Buffer: \nbProcess Buffer: \nP")
+ (let* (;; The process buffer
+ (process-buffer (if (processp process)
+ (process-buffer process)
+ process))
+ (proc (get-buffer-process process-buffer)))
+ ;; Change to the process buffer
+ (set-buffer process-buffer)
+
+ ;; Make sure there's a prompt in the current process buffer
+ (and comint-redirect-perform-sanity-check
+ (save-excursion
+ (goto-char (point-max))
+ (or (re-search-backward comint-prompt-regexp nil t)
+ (error "No prompt found or `comint-prompt-regexp' not set properly"))))
+
+ ;;;;;;;;;;;;;;;;;;;;;
+ ;; Set up for redirection
+ ;;;;;;;;;;;;;;;;;;;;;
+ (comint-redirect-setup
+ ;; Output Buffer
+ output-buffer
+ ;; Comint Buffer
+ (current-buffer)
+ ;; Finished Regexp
+ comint-prompt-regexp
+ ;; Echo input
+ echo)
+
+ ;;;;;;;;;;;;;;;;;;;;;
+ ;; Set the filter
+ ;;;;;;;;;;;;;;;;;;;;;
+ ;; Save the old filter
+ (setq comint-redirect-original-filter-function
+ (process-filter proc))
+ (set-process-filter proc 'comint-redirect-filter)
+
+ ;;;;;;;;;;;;;;;;;;;;;
+ ;; Send the command
+ ;;;;;;;;;;;;;;;;;;;;;
+ (process-send-string
+ (current-buffer)
+ (concat command "\n"))
+
+ ;;;;;;;;;;;;;;;;;;;;;
+ ;; Show the output
+ ;;;;;;;;;;;;;;;;;;;;;
+ (or no-display
+ (display-buffer
+ (get-buffer-create
+ (if (listp output-buffer)
+ (car output-buffer)
+ output-buffer))))))
+
+;;;###autoload
+(defun comint-redirect-results-list (command regexp regexp-group)
+ "Send COMMAND to current process.
+Return a list of expressions in the output which match REGEXP.
+REGEXP-GROUP is the regular expression group in REGEXP to use."
+ (comint-redirect-results-list-from-process
+ (get-buffer-process (current-buffer))
+ command regexp regexp-group))
+
+;;;###autoload
+(defun comint-redirect-results-list-from-process (process command regexp regexp-group)
+ "Send COMMAND to PROCESS.
+Return a list of expressions in the output which match REGEXP.
+REGEXP-GROUP is the regular expression group in REGEXP to use."
+ (let ((output-buffer " *Comint Redirect Work Buffer*")
+ results)
+ (save-excursion
+ (set-buffer (get-buffer-create output-buffer))
+ (erase-buffer)
+ (comint-redirect-send-command-to-process command
+ output-buffer process nil t)
+ ;; Wait for the process to complete
+ (set-buffer (process-buffer process))
+ (while (null comint-redirect-completed)
+ (accept-process-output nil 1))
+ ;; Collect the output
+ (set-buffer output-buffer)
+ (goto-char (point-min))
+ ;; Skip past the command, if it was echoed
+ (and (looking-at command)
+ (forward-line))
+ (while (re-search-forward regexp nil t)
+ (setq results
+ (cons (buffer-substring-no-properties
+ (match-beginning regexp-group)
+ (match-end regexp-group))
+ results)))
+ results)))
+
+\f
;; Converting process modes to use comint mode
;; ===========================================================================
;; The code in the Emacs 19 distribution has all been modified to use comint