;;; comint.el --- general command interpreter in a window stuff
-;; Copyright (C) 1988, 90, 92, 93, 94, 95, 96, 97, 98, 99 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 90, 92, 93, 94, 95, 96, 97, 98, 99, 2000
+;; 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-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-output symbol ...
;; comint-scroll-show-maximum-output boolean ...
;; comint-accum-marker maker For comint-accumulate
+;; comint-last-output-overlay overlay
;;
;; Comint mode non-buffer local variables:
;; comint-completion-addsuffix boolean/cons For file name
:prefix "comint-"
:group 'comint)
-
(defvar comint-prompt-regexp "^"
"Regexp to recognise prompts in the inferior process.
Defaults to \"^\", the null string at BOL.
+This variable is only used if the variable
+`comint-use-prompt-regexp-instead-of-fields' is non-nil.
+
Good choices:
Canonical Lisp: \"^[^> \\n]*>+:? *\" (Lucid, franz, kcl, T, cscheme, oaklisp)
Lucid Common Lisp: \"^\\\\(>\\\\|\\\\(->\\\\)+\\\\) *\"
(other :tag "on" t))
:group 'comint)
+(defcustom comint-highlight-input t
+ "*If non-nil, highlight input; also allow choosing previous input with a mouse.
+See also `comint-highlight-face'."
+ :type 'boolean
+ :group 'comint)
+
+(defface comint-highlight-input-face '((t (:bold t)))
+ "Face to use to highlight input when `comint-highlight-input' is non-nil."
+ :group 'comint)
+
+(defcustom comint-highlight-prompt t
+ "*If non-nil, highlight program prompts.
+See also `comint-highlight-face'."
+ :type 'boolean
+ :group 'comint)
+
+(defface comint-highlight-prompt-face
+ '((((background dark)) (:foreground "cyan"))
+ (t (:foreground "dark blue")))
+ "Face to use to highlight prompt when `comint-highlight-prompt' is non-nil."
+ :group 'comint)
+
(defcustom comint-input-ignoredups nil
"*If non-nil, don't add input matching the last on the input ring.
This mirrors the optional behavior of bash.
See also `comint-read-input-ring' and `comint-write-input-ring'.
This variable is buffer-local, and is a good thing to set in mode hooks."
- :type 'boolean
+ :type '(choice (const :tag "nil" nil)
+ file)
:group 'comint)
(defcustom comint-scroll-to-bottom-on-input 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
;; Here are the per-interpreter hooks.
(defvar comint-get-old-input (function comint-get-old-input-default)
"Function that returns old text in comint mode.
-This function is called when return is typed while the point is in old text.
-It returns the text to be submitted as process input. The default is
-`comint-get-old-input-default', which grabs the current line, and strips off
-leading text matching `comint-prompt-regexp'.")
+This function is called when return is typed while the point is in old
+text. It returns the text to be submitted as process input. The
+default is `comint-get-old-input-default', which either grabs the
+current input field or grabs the current line and strips off leading
+text matching `comint-prompt-regexp', depending on the value of
+`comint-use-prompt-regexp-instead-of-fields'.")
(defvar comint-dynamic-complete-functions
'(comint-replace-by-expanded-history comint-dynamic-complete-filename)
:type 'boolean
:group 'comint)
+;; Note: If it is decided to purge comint-prompt-regexp from the source
+;; entirely, searching for uses of this variable will help to identify
+;; places that need attention.
+(defcustom comint-use-prompt-regexp-instead-of-fields nil
+ "*If non-nil, use `comint-prompt-regexp' to distinguish prompts from user-input.
+If nil, then program output and user-input are given different `field'
+properties, which emacs commands can use to distinguish them (in
+particular, common movement commands such as begining-of-line respect
+field boundaries in a natural way)."
+ :type 'boolean
+ :group 'comint)
+
(defcustom comint-mode-hook '()
- "Called upon entry into comint-mode
+ "Called upon entry into `comint-mode'
This is run before the process is cranked up."
:type 'hook
:group 'comint)
(put 'comint-mode 'mode-class 'special)
-(defun comint-mode ()
+(define-derived-mode comint-mode fundamental-mode "Comint"
"Major mode for interacting with an inferior interpreter.
Interpreter name is same as buffer name, sans the asterisks.
Return at end of buffer sends line as input.
\\{comint-mode-map}
Entry to this mode runs the hooks on `comint-mode-hook'."
- (interactive)
- ;; Do not remove this. All major modes must do this.
- (kill-all-local-variables)
- (setq major-mode 'comint-mode)
- (setq mode-name "Comint")
(setq mode-line-process '(":%s"))
- (use-local-map comint-mode-map)
(make-local-variable 'comint-last-input-start)
(setq comint-last-input-start (make-marker))
(set-marker comint-last-input-start (point-min))
(set-marker comint-last-input-end (point-min))
(make-local-variable 'comint-last-output-start)
(setq comint-last-output-start (make-marker))
+ (make-local-variable 'comint-last-output-overlay)
+ (make-local-variable 'comint-last-prompt-overlay)
(make-local-variable 'comint-prompt-regexp) ; Don't set; default
(make-local-variable 'comint-input-ring-size) ; ...to global val.
(make-local-variable 'comint-input-ring)
(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))
+ (set-marker comint-accum-marker nil))
(if comint-mode-map
nil
(define-key comint-mode-map "\C-c\C-n" 'comint-next-prompt)
(define-key comint-mode-map "\C-c\C-p" 'comint-previous-prompt)
(define-key comint-mode-map "\C-c\C-d" 'comint-send-eof)
+ ;; Mouse Buttons:
+ (define-key comint-mode-map [mouse-2] 'comint-insert-clicked-input)
;; Menu bars:
;; completion:
(define-key comint-mode-map [menu-bar completion]
(let ((buffer (get-buffer-create (concat "*" name "*"))))
;; If no process, or nuked process, crank up a new one and put buffer in
;; comint mode. Otherwise, leave buffer and existing process alone.
- (cond ((not (comint-check-proc buffer))
- (save-excursion
- (set-buffer buffer)
- (comint-mode)) ; Install local vars, mode, keymap, ...
- (comint-exec buffer name program startfile switches)))
+ (unless (comint-check-proc buffer)
+ (with-current-buffer buffer
+ (comint-mode)) ; Install local vars, mode, keymap, ...
+ (comint-exec buffer name program startfile switches))
buffer))
;;;###autoload
default-directory
(char-to-string directory-sep-char)))
proc decoding encoding changed)
- (setq proc (apply 'start-process name buffer command switches))
+ (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 form the process and the coding system doesn't
+ ;; 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)
(if changed
(set-process-coding-system proc decoding encoding))
proc))
+
+
+(defun comint-insert-clicked-input (event)
+ "In a comint buffer, set the current input to the clicked-on previous input."
+ (interactive "e")
+ (let ((over (catch 'found
+ ;; Ignore non-input overlays
+ (dolist (ov (overlays-at (posn-point (event-end event))))
+ (when (eq (overlay-get ov 'field) 'input)
+ (throw 'found ov))))))
+ ;; do we have input in this area?
+ (if over
+ (let ((input-str (buffer-substring (overlay-start over)
+ (overlay-end over))))
+ (delete-region
+ ;; Can't use kill-region as it sets this-command
+ (or (marker-position comint-accum-marker)
+ (process-mark (get-buffer-process (current-buffer))))
+ (point))
+ (insert input-str))
+ ;; fall back to the user's previous definition if we aren't
+ ;; on previous input region.
+ (let ((fun (lookup-key global-map (this-command-keys))))
+ (if fun (call-interactively fun))))))
+
\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 ""))
(message "Cannot read history file %s"
comint-input-ring-file-name)))
(t
- (let ((history-buf (get-buffer-create " *temp*"))
- (file comint-input-ring-file-name)
- (count 0)
- (ring (make-ring comint-input-ring-size)))
+ (let* ((history-buf (get-buffer-create " *temp*"))
+ (file comint-input-ring-file-name)
+ (count 0)
+ (size comint-input-ring-size)
+ (ring (make-ring size)))
(unwind-protect
(save-excursion
(set-buffer history-buf)
;; Save restriction in case file is already visited...
;; Watch for those date stamps in history files!
(goto-char (point-max))
- (while (and (< count comint-input-ring-size)
+ (while (and (< count 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))))))
(interactive)
(if (and comint-input-autoexpand
(string-match "!\\|^\\^" (funcall comint-get-old-input))
- (save-excursion (beginning-of-line)
- (looking-at comint-prompt-regexp)))
+ (if comint-use-prompt-regexp-instead-of-fields
+ ;; Use comint-prompt-regexp
+ (save-excursion (beginning-of-line)
+ (looking-at comint-prompt-regexp))
+ ;; Use input fields. User input that hasn't been entered
+ ;; yet, at the end of the buffer, has a nil `field' property.
+ (null (get-char-property (point) 'field))))
;; Looks like there might be history references in the command.
(let ((previous-modified-tick (buffer-modified-tick)))
(comint-replace-by-expanded-history-before-point silent start)
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 (or start (progn (comint-bol nil) (point)))))
+ (let ((toend (- (line-end-position) (point)))
+ (start (comint-line-beginning-position)))
(while (progn
- (skip-chars-forward "^!^"
- (save-excursion
- (end-of-line nil) (- (point) toend)))
- (< (point)
- (save-excursion
- (end-of-line nil) (- (point) toend))))
+ (skip-chars-forward "^!^" (- (line-end-position) toend))
+ (< (point) (- (line-end-position) toend)))
;; This seems a bit complex. We look for references such as !!, !-num,
;; !foo, !?foo, !{bar}, !?{bar}, ^oh, ^my^, ^god^it, ^never^ends^.
;; If that wasn't enough, the plings can be suffixed with argument
"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."
(let* ((first (if (and (eq system-type 'windows-nt)
(w32-shell-dos-semantics))
"[^ \n\t\"'`]+\\|"
- "[^ \n\t\"'`\\]+\\|\\\\[\"'`\\]+\\|"))
+ "[^ \n\t\"'`\\]+\\|\\\\[\"'`\\ \t]+\\|"))
(argpart (concat first
"\\(\"\\([^\"\\]\\|\\\\.\\)*\"\\|\
'[^']*'\\|\
in the buffer. E.g.,
If the interpreter is the csh,
- comint-get-old-input is the default: take the current line, discard any
- initial string matching regexp comint-prompt-regexp.
+ comint-get-old-input is the default: either return the current
+ field, or take the current line and discard any
+ initial string matching regexp `comint-prompt-regexp', depending
+ on the value of `comint-use-prompt-regexp-instead-of-fields'.
comint-input-filter-functions monitors input for \"cd\", \"pushd\", and
\"popd\" commands. When it sees one, it cd's the buffer.
comint-input-filter is the default: returns t if the input isn't all white
(insert input)
(delete-region pmark start)
copy))))
+
(if comint-process-echoes
(delete-region pmark (point))
- (insert-before-markers ?\n))
+ (insert ?\n))
+
(if (and (funcall comint-input-filter history)
(or (null comint-input-ignoredups)
(not (ring-p comint-input-ring))
(not (string-equal (ring-ref comint-input-ring 0)
history))))
(ring-insert comint-input-ring history))
+
(run-hook-with-args 'comint-input-filter-functions
(concat input "\n"))
+
+ (let ((beg (marker-position pmark))
+ (end (1- (point))))
+ (when (not (> beg end)) ; handle a special case
+ ;; Make an overlay for the input field
+ (let ((over (make-overlay beg end nil nil t)))
+ (unless comint-use-prompt-regexp-instead-of-fields
+ ;; Give old user input a field property of `input', to
+ ;; distinguish it from both process output and unsent
+ ;; input. The terminating newline is put into a special
+ ;; `boundary' field to make cursor movement between input
+ ;; and output fields smoother.
+ (overlay-put over 'field 'input)
+ (overlay-put over 'front-sticky t))
+ (when comint-highlight-input
+ (overlay-put over 'face 'comint-highlight-input-face)
+ (overlay-put over 'mouse-face 'highlight)
+ (overlay-put over 'evaporate t))))
+ (unless comint-use-prompt-regexp-instead-of-fields
+ ;; Make an overlay for the terminating newline
+ (let ((over (make-overlay end (1+ end) nil t nil)))
+ (overlay-put over 'field 'boundary)
+ (overlay-put over 'rear-nonsticky t)
+ (overlay-put over 'evaporate t))))
+
+ (comint-snapshot-last-prompt)
+
(setq comint-save-input-ring-index comint-input-ring-index)
(setq comint-input-ring-index nil)
;; Update the markers before we send the input
(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.
-
-This variable is buffer-local.")
+ "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.
+
+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.")
+
+;; When non-nil, this is the last overlay used for output.
+;; It is kept around so that we can extend it instead of creating
+;; multiple contiguous overlays for multiple contiguous output chunks.
+(defvar comint-last-output-overlay nil)
+
+;; When non-nil, this is an overlay over the last recognized prompt in
+;; the buffer; it is used when highlighting the prompt.
+(defvar comint-last-prompt-overlay nil)
+
+;; `snapshot' any current comint-last-prompt-overlay, freezing it in place.
+;; Any further output will then create a new comint-last-prompt-overlay.
+(defun comint-snapshot-last-prompt ()
+ (when comint-last-prompt-overlay
+ (overlay-put comint-last-prompt-overlay 'evaporate t)
+ (setq comint-last-prompt-overlay nil)))
;; 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)
- (setq opoint (point))
- (setq obeg (point-min))
- (setq oend (point-max))
- (let ((buffer-read-only nil)
- (nchars (length string))
- (ostart nil))
+ ;; First check for killed buffer or no input.
+ (when (and string oprocbuf (buffer-name oprocbuf))
+ (with-current-buffer oprocbuf
+ ;; Run preoutput filters
+ (let ((functions comint-preoutput-filter-functions))
+ (while (and functions string)
+ (setq string (funcall (car functions) string))
+ (setq functions (cdr functions))))
+
+ ;; Insert STRING
+ (let ((buffer-read-only nil)
+ ;; Avoid the overhead of save-excursion, since we just
+ ;; fiddle with the point
+ (saved-point (point-marker)))
+
+ ;; The point should float after any insertion we do
+ (set-marker-insertion-type saved-point t)
+
+ ;; We temporarly remove any buffer narrowing, in case the
+ ;; process mark is outside of the restriction
+ (save-restriction
(widen)
+
(goto-char (process-mark process))
- (setq ostart (point))
- (if (<= (point) opoint)
- (setq opoint (+ opoint nchars)))
- ;; Insert after old_begv, but before old_zv.
- (if (< (point) obeg)
- (setq obeg (+ obeg nchars)))
- (if (<= (point) oend)
- (setq oend (+ oend nchars)))
+ (set-marker comint-last-output-start (point))
+
+ ;; insert-before-markers is a bad thing. XXX
+ ;;
+ ;; It is used here to force window-point markers (used to
+ ;; store the value of point in non-selected windows) to
+ ;; advance, but it also screws up any other markers that we
+ ;; don't _want_ to advance, such as the start-marker of some
+ ;; of the overlays we create.
+ ;;
+ ;; We work around the problem with the overlays by
+ ;; explicitly adjusting them after we do the insertion, but
+ ;; in the future this problem should be solved correctly, by
+ ;; using `insert', and making the insertion-type of
+ ;; window-point markers settable (via a buffer-local
+ ;; variable). In comint buffers, this variable would be set
+ ;; to `t', to cause point in non-select windows to advance.
(insert-before-markers string)
- ;; Don't insert initial prompt outside the top of the window.
- (if (= (window-start (selected-window)) (point))
- (set-window-start (selected-window) (- (point) (length string))))
- (if (and comint-last-input-end
- (marker-buffer comint-last-input-end)
- (= (point) comint-last-input-end))
- (set-marker comint-last-input-end (- comint-last-input-end nchars)))
- (set-marker comint-last-output-start ostart)
+ ;; Fixup markers and overlays that got screwed up because we
+ ;; used `insert-before-markers'.
+ (let ((old-point (- (point) (length string))))
+ ;; comint-last-output-start marker
+ (set-marker comint-last-output-start old-point)
+ ;; No overlays we create are set to advance upon insertion
+ ;; (at the start/end), so we assume that any overlay which
+ ;; is at the current point was incorrectly advanced by
+ ;; insert-before-markers. First fixup overlays that might
+ ;; start at point:
+ (dolist (over (overlays-at (point)))
+ (when (= (overlay-start over) (point))
+ (let ((end (overlay-end over)))
+ (move-overlay over
+ old-point
+ (if (= end (point)) old-point end)))))
+ ;; Then do overlays that might end at point:
+ (dolist (over (overlays-at (1- (point))))
+ (when (= (overlay-end over) (point))
+ (move-overlay over
+ (min (overlay-start over) old-point)
+ old-point))))
+
+ ;; Advance process-mark
(set-marker (process-mark process) (point))
- (force-mode-line-update))
- (narrow-to-region obeg oend)
- (goto-char opoint)
- (run-hook-with-args 'comint-output-filter-functions string)
- (set-buffer obuf)))))
+ (unless comint-use-prompt-regexp-instead-of-fields
+ ;; We check to see if the last overlay used for output is
+ ;; adjacent to the new input, and if so, just extend it.
+ (if (and comint-last-output-overlay
+ (equal (overlay-end comint-last-output-overlay)
+ (marker-position comint-last-output-start)))
+ ;; Extend comint-last-output-overlay to include the
+ ;; most recent output
+ (move-overlay comint-last-output-overlay
+ (overlay-start comint-last-output-overlay)
+ (point))
+ ;; Create a new overlay
+ (let ((over (make-overlay comint-last-output-start (point))))
+ (overlay-put over 'field 'output)
+ (overlay-put over 'inhibit-line-move-field-capture t)
+ (overlay-put over 'front-sticky t)
+ (overlay-put over 'rear-nonsticky t)
+ (overlay-put over 'evaporate t)
+ (setq comint-last-output-overlay over))))
+
+ (when comint-highlight-prompt
+ ;; Highlight the prompt, where we define `prompt' to mean
+ ;; the most recent output that doesn't end with a newline.
+ (unless (and (bolp) (null comint-last-prompt-overlay))
+ ;; Need to create or move the prompt overlay (in the case
+ ;; where there is no prompt ((bolp) == t), we still do
+ ;; this if there's already an existing overlay).
+ (let ((prompt-start (save-excursion (forward-line 0) (point))))
+ (if comint-last-prompt-overlay
+ ;; Just move an existing overlay
+ (move-overlay comint-last-prompt-overlay
+ prompt-start (point))
+ ;; Need to create the overlay
+ (let ((over (make-overlay prompt-start (point))))
+ (overlay-put over 'face 'comint-highlight-prompt-face)
+ (overlay-put over 'front-sticky t)
+ (overlay-put over 'rear-nonsticky t)
+ (setq comint-last-prompt-overlay over))))))
+
+ ;;(force-mode-line-update)
+
+ (goto-char saved-point)
+
+ (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.
(defun comint-get-old-input-default ()
"Default for `comint-get-old-input'.
-Take the current line, and discard any initial text matching
-`comint-prompt-regexp'."
- (save-excursion
- (beginning-of-line)
- (comint-skip-prompt)
- (let ((beg (point)))
- (end-of-line)
- (buffer-substring beg (point)))))
+Returns either the current field, or the current line with any initial
+text matching `comint-prompt-regexp' stripped off, depending on the
+value of `comint-use-prompt-regexp-instead-of-fields'."
+ (if comint-use-prompt-regexp-instead-of-fields
+ (save-excursion
+ (beginning-of-line)
+ (comint-skip-prompt)
+ (let ((beg (point)))
+ (end-of-line)
+ (buffer-substring beg (point))))
+ ;; Return the contents of the field at the current point.
+ (field-string)))
+
(defun comint-copy-old-input ()
"Insert after prompt old input at point as new input to be edited.
(comint-send-string proc string)
(comint-send-string proc "\n"))
-(defun comint-bol (arg)
+(defun comint-line-beginning-position ()
+ "Returns the buffer position of the beginning of the line, after any prompt.
+If `comint-use-prompt-regexp-instead-of-fields' is non-nil, then the
+prompt skip is done by skipping text matching the regular expression
+`comint-prompt-regexp', a buffer local variable."
+ (if comint-use-prompt-regexp-instead-of-fields
+ ;; Use comint-prompt-regexp
+ (save-excursion
+ (beginning-of-line)
+ (comint-skip-prompt)
+ (point))
+ ;; Use input fields. Note that, unlike the behavior of
+ ;; `line-beginning-position' inside a field, this function will
+ ;; return the position of the end of a prompt, even if the point is
+ ;; already inside the prompt. In order to do this, it assumes that
+ ;; if there are two fields on a line, then the first one is the
+ ;; prompt, and the second one is an input field, and is front-sticky
+ ;; (as input fields should be).
+ (constrain-to-field (line-beginning-position) (line-end-position))))
+
+(defun comint-bol (&optional arg)
"Goes to the beginning of line, then skips past the prompt, if any.
-If prefix argument is given (\\[universal-argument]) the prompt is not skipped.
-
-The prompt skip is done by skipping text matching the regular expression
+If prefix argument is given (\\[universal-argument]) the prompt is not skipped.
+If `comint-use-prompt-regexp-instead-of-fields' is non-nil, then the
+prompt skip is done by skipping text matching the regular expression
`comint-prompt-regexp', a buffer local variable."
(interactive "P")
- (beginning-of-line)
- (if (null arg) (comint-skip-prompt)))
+ (if arg
+ ;; Unlike `beginning-of-line', forward-line ignores field boundaries
+ (forward-line 0)
+ (goto-char (comint-line-beginning-position))))
;; These three functions are for entering text you don't want echoed or
;; saved -- typically passwords to ftp, telnet, or somesuch.
(cond ((not proc)
(error "Current buffer has no process"))
((stringp str)
+ (comint-snapshot-last-prompt)
(funcall comint-input-sender proc str))
(t
(let ((str (comint-read-noecho "Non-echoed text: " t)))
`comint-password-prompt-regexp'.
This function could be in the list `comint-output-filter-functions'."
- (if (string-match comint-password-prompt-regexp string)
- (send-invisible nil)))
+ (when (string-match comint-password-prompt-regexp string)
+ (let ((pw (comint-read-noecho string t)))
+ (send-invisible pw))))
\f
;; Low-level process communication
-(defalias 'comint-send-string 'process-send-string)
-(defalias 'comint-send-region 'process-send-region)
+(defun comint-send-string (process string)
+ "Like `process-send-string', but also does extra bookkeeping for comint mode."
+ (with-current-buffer (process-buffer process)
+ (comint-snapshot-last-prompt))
+ (process-send-string process string))
+
+(defun comint-send-region (process start end)
+ "Like `process-send-region', but also does extra bookkeeping for comint mode."
+ (with-current-buffer (process-buffer process)
+ (comint-snapshot-last-prompt))
+ (process-send-region process start end))
\f
;; Random input hackage
Sets mark to the value of point when this command is run."
(interactive)
(push-mark)
- (let ((pos (point)))
- (goto-char (or (marker-position comint-last-input-end) (point-max)))
- (beginning-of-line 0)
- (set-window-start (selected-window) (point))
- (comint-skip-prompt)))
+ (let ((pos (or (marker-position comint-last-input-end) (point-max))))
+ (cond (comint-use-prompt-regexp-instead-of-fields
+ (goto-char pos)
+ (beginning-of-line 0)
+ (set-window-start (selected-window) (point))
+ (comint-skip-prompt))
+ (t
+ (goto-char (field-beginning pos))
+ (set-window-start (selected-window) (point))))))
+
(defun comint-interrupt-subjob ()
"Interrupt the current subjob.
(interactive "p")
(let ((proc (get-buffer-process (current-buffer))))
(if (and (eobp) proc (= (point) (marker-position (process-mark proc))))
- (process-send-eof)
+ (comint-send-eof)
(delete-char arg))))
(defun comint-send-eof ()
"Send an EOF to the current buffer's process."
(interactive)
+ (comint-snapshot-last-prompt)
(process-send-eof))
(defun comint-backward-matching-input (regexp arg)
- "Search backward through buffer for match for REGEXP.
-Matches are searched for on lines that match `comint-prompt-regexp'.
+ "Search backward through buffer for input fields that match REGEXP.
+If `comint-use-prompt-regexp-instead-of-fields' is non-nil, then input
+fields are identified by lines that match `comint-prompt-regexp'.
+
With prefix argument N, search for Nth previous match.
If N is negative, find the next or Nth next match."
(interactive (comint-regexp-arg "Backward input matching (regexp): "))
- (let* ((re (concat comint-prompt-regexp ".*" regexp))
- (pos (save-excursion (end-of-line (if (> arg 0) 0 1))
- (if (re-search-backward re nil t arg)
- (point)))))
- (if (null pos)
- (progn (message "Not found")
- (ding))
- (goto-char pos)
- (comint-bol nil))))
+ (if comint-use-prompt-regexp-instead-of-fields
+ ;; Use comint-prompt-regexp
+ (let* ((re (concat comint-prompt-regexp ".*" regexp))
+ (pos (save-excursion (end-of-line (if (> arg 0) 0 1))
+ (if (re-search-backward re nil t arg)
+ (point)))))
+ (if (null pos)
+ (progn (message "Not found")
+ (ding))
+ (goto-char pos)
+ (comint-bol nil)))
+ ;; Use input fields
+ (let* ((dir (if (< arg 0) -1 1))
+ (pos
+ (save-excursion
+ (while (/= arg 0)
+ (unless (re-search-backward regexp nil t dir)
+ (error "Not found"))
+ (when (eq (get-char-property (point) 'field) 'input)
+ (setq arg (- arg dir))))
+ (field-beginning))))
+ (goto-char pos))))
+
(defun comint-forward-matching-input (regexp arg)
- "Search forward through buffer for match for REGEXP.
-Matches are searched for on lines that match `comint-prompt-regexp'.
+ "Search forward through buffer for input fields that match REGEXP.
+If `comint-use-prompt-regexp-instead-of-fields' is non-nil, then input
+fields are identified by lines that match `comint-prompt-regexp'.
+
With prefix argument N, search for Nth following match.
If N is negative, find the previous or Nth previous match."
(interactive (comint-regexp-arg "Forward input matching (regexp): "))
(defun comint-next-prompt (n)
"Move to end of Nth next prompt in the buffer.
-See `comint-prompt-regexp'."
+If `comint-use-prompt-regexp-instead-of-fields' is nil, then this means
+the beginning of the Nth next `input' field, otherwise, it means the Nth
+occurance of text matching `comint-prompt-regexp'."
(interactive "p")
- (let ((paragraph-start comint-prompt-regexp))
- (end-of-line (if (> n 0) 1 0))
- (forward-paragraph n)
- (comint-skip-prompt)))
+ (if comint-use-prompt-regexp-instead-of-fields
+ ;; Use comint-prompt-regexp
+ (let ((paragraph-start comint-prompt-regexp))
+ (end-of-line (if (> n 0) 1 0))
+ (forward-paragraph n)
+ (comint-skip-prompt))
+ ;; Use input fields
+ (let ((pos (point))
+ (input-pos nil))
+ (while (/= n 0)
+ (setq pos
+ (if (> n 0)
+ (next-single-char-property-change pos 'field)
+ (previous-single-char-property-change pos 'field)))
+ (cond ((null pos)
+ ;; Ran off the end of the buffer.
+ (setq n 0))
+ ((eq (get-char-property pos 'field) 'input)
+ (setq n (if (< n 0) (1+ n) (1- n)))
+ (setq input-pos pos))))
+ (when input-pos
+ (goto-char input-pos)))))
+
(defun comint-previous-prompt (n)
"Move to end of Nth previous prompt in the buffer.
-See `comint-prompt-regexp'."
+If `comint-use-prompt-regexp-instead-of-fields' is nil, then this means
+the beginning of the Nth previous `input' field, otherwise, it means the Nth
+occurance of text matching `comint-prompt-regexp'."
(interactive "p")
(comint-next-prompt (- n)))
\f
(setq env-var-val (if (getenv env-var-name)
(getenv env-var-name)
""))
- (setq name (replace-match env-var-val nil nil name))))))
+ (setq name (replace-match env-var-val t t name))))))
name))
(defun comint-match-partial-filename ()
(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.
+;;
+;; XXX: This doesn't work so well unless comint-prompt-regexp is set;
+;; perhaps it should prompt for a terminating string (with an
+;; appropriate magic default by examining what we think is the prompt)?
+;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 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)))
+
+(mapc (lambda (x)
+ (add-to-list 'debug-ignored-errors x))
+ '("^Not at command line$"
+ "^Empty input ring$"
+ "^No history$"
+ "^Not found$" ; Too common?
+ "^Current buffer has no process$"))
+\f
;; Converting process modes to use comint mode
;; ===========================================================================
;; The code in the Emacs 19 distribution has all been modified to use comint
HCoop / bpt / emacs.git / blobdiff