;;; comint.el --- general command interpreter in a window stuff
-;; Copyright (C) 1988, 90, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 2001
+;; Copyright (C) 1988, 90, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 2001, 2002
;; Free Software Foundation, Inc.
;; Author: Olin Shivers <shivers@cs.cmu.edu>
;; For further information on the standard derived modes (shell,
;; inferior-lisp, inferior-scheme, ...), see the relevant source files.
-
-;; To give your mode support for the programmable, dynamic completion
-;; facility in "pcomplete.el", you should define two functions in the
-;; following form, replacing <MODE> with the prefix of your mode:
-
-;; (defvar <MODE>-pcomplete-setup-p nil)
-;; (defun <MODE>-pcomplete ()
-;; "Cycle forwards through completions at point, using `pcomplete'.
-;; This function merely invokes `pcomplete', after ensuring this buffer
-;; is set up for it."
-;; (interactive)
-;; (unless (prog1 <MODE>-pcomplete-setup-p
-;; (setq <MODE>-pcomplete-setup-p t))
-;; (pcomplete-comint-setup '<MODE>-dynamic-complete-functions))
-;; (setq this-command 'pcomplete)
-;; (call-interactively #'pcomplete))
-
-;; (defun <MODE>-pcomplete-reverse ()
-;; "Cycle backwards through completions at point, using `pcomplete'.
-;; This function merely invokes `pcomplete-reverse', after ensuring this
-;; buffer is set up for it."
-;; (interactive)
-;; (unless (prog1 <MODE>-pcomplete-setup-p
-;; (setq <MODE>-pcomplete-setup-p t))
-;; (pcomplete-comint-setup '<MODE>-dynamic-complete-functions))
-;; (setq this-command 'pcomplete-reverse)
-;; (call-interactively #'pcomplete-reverse))
-
;; For hints on converting existing process modes (e.g., tex-mode,
;; background, dbx, gdb, kermit, prolog, telnet) to use comint-mode
;; instead of shell-mode, see the notes at the end of this file.
;; 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
(other :tag "on" t))
:group 'comint)
-(defcustom comint-highlight-input t
- "*If non-nil, highlight input; also allow choosing previous input with a mouse.
-The face used is `comint-highlight-input'."
- :type 'boolean
- :group 'comint)
-
(defface comint-highlight-input '((t (:weight bold)))
- "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.
-The face used is `comint-highlight-prompt'."
- :type 'boolean
+ "Face to use to highlight user input."
:group 'comint)
(defface comint-highlight-prompt
'((((background dark)) (:foreground "cyan"))
(t (:foreground "dark blue")))
- "Face to use to highlight prompt when `comint-highlight-prompt' is non-nil."
+ "Face to use to highlight prompts."
:group 'comint)
(defcustom comint-input-ignoredups nil
;; 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 \\|Kerberos \\|'s \\|login \\|CVS \\|UNIX \\|^\\)\
-[Pp]assword\\( (again)\\)?\\|pass phrase\\|Enter passphrase\\)\
+ "\\(\\([Oo]ld \\|[Nn]ew \\|'s \\|login \\|\
+Kerberos \\|CVS \\|UNIX \\| SMB \\|^\\)\
+[Pp]assword\\( (again)\\)?\\|\
+pass phrase\\|\\(Enter\\|Repeat\\) passphrase\\)\
\\( for [^:]+\\)?:\\s *\\'"
"*Regexp matching prompts for passwords in the inferior process.
This is used by `comint-watch-for-password-prompt'."
"Functions to call before input is sent to the process.
These functions get one argument, a string containing the text to send.
-This variable is buffer-local.")
+You can use `add-hook' to add functions to this list
+either globally or locally.")
(defvar comint-output-filter-functions '(comint-postoutput-scroll-to-bottom)
"Functions to call after output is inserted into the buffer.
See also `comint-preoutput-filter-functions'.
-This variable is buffer-local.")
+You can use `add-hook' to add functions to this list
+either globally or locally.")
(defvar comint-input-sender-no-newline nil
"Non-nil directs the `comint-input-sender' function not to send a newline.")
:type 'boolean
:group 'comint)
-(defcustom comint-mode-hook '()
+(defcustom comint-mode-hook '(turn-on-font-lock)
"Called upon entry into `comint-mode'
This is run before the process is cranked up."
:type 'hook
(set (make-local-variable 'comint-last-input-start) (point-min-marker))
(set (make-local-variable 'comint-last-input-end) (point-min-marker))
(set (make-local-variable '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-scroll-to-bottom-on-input)
(make-local-variable 'comint-scroll-to-bottom-on-output)
(make-local-variable 'comint-scroll-show-maximum-output)
+ ;; This makes it really work to keep point at the bottom.
+ (make-local-variable 'scroll-conservatively)
+ (setq scroll-conservatively 10000)
(add-hook 'pre-command-hook 'comint-preinput-scroll-to-bottom t t)
(make-local-variable 'comint-ptyp)
(make-local-variable 'comint-process-echoes)
(make-local-variable 'comint-file-name-chars)
(make-local-variable 'comint-file-name-quote-list)
(set (make-local-variable 'comint-accum-marker) (make-marker))
+ (add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
;; This behavior is not useful in comint buffers, and is annoying
(set (make-local-variable 'next-line-add-newlines) nil))
(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))))
- (goto-char (point-max))
- (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 global definition.
- (let* ((keys (this-command-keys))
- (last-key (and (vectorp keys) (aref keys (1- (length keys)))))
- (fun (and last-key (lookup-key global-map (vector last-key)))))
- (if fun (call-interactively fun))))))
+ (let ((pos (posn-point (event-end event))))
+ (if (not (eq (get-char-property pos 'field) 'input))
+ ;; No input at POS, fall back to the global definition.
+ (let* ((keys (this-command-keys))
+ (last-key (and (vectorp keys) (aref keys (1- (length keys)))))
+ (fun (and last-key (lookup-key global-map (vector last-key)))))
+ (and fun (call-interactively fun)))
+ ;; There's previous input at POS, insert it at the end of the buffer.
+ (goto-char (point-max))
+ ;; First delete any old unsent input at the end
+ (delete-region
+ (or (marker-position comint-accum-marker)
+ (process-mark (get-buffer-process (current-buffer))))
+ (point))
+ ;; Insert the clicked-upon input
+ (insert (buffer-substring-no-properties
+ (previous-single-char-property-change (1+ pos) 'field)
+ (next-single-char-property-change pos 'field))))))
+
\f
;; Input history processing in a buffer
(let ((beg (marker-position pmark))
(end (if no-newline (point) (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))
- (when comint-highlight-input
- (overlay-put over 'face 'comint-highlight-input)
- (overlay-put over 'mouse-face 'highlight)
- (overlay-put over
- 'help-echo
- "mouse-2: insert after prompt as new input")
- (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 'inhibit-line-move-field-capture t)
- (overlay-put over 'evaporate t))))
+ (when (> end beg)
+ ;; Set text-properties for the input field
+ (add-text-properties
+ beg end
+ '(front-sticky t
+ font-lock-face comint-highlight-input
+ mouse-face highlight
+ help-echo "mouse-2: insert after prompt as new input"))
+ (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.
+ (put-text-property beg end 'field 'input)))
+ (unless (or no-newline comint-use-prompt-regexp-instead-of-fields)
+ ;; Cover the terminating newline
+ (add-text-properties end (1+ end)
+ '(rear-nonsticky t
+ field boundary
+ inhibit-line-move-field-capture t))))
(comint-snapshot-last-prompt)
the last function is the text that is actually inserted in the
redirection buffer.
-This variable is permanent-local.")
+You can use `add-hook' to add functions to this list
+either globally or locally.")
-;; 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)
+(defvar comint-inhibit-carriage-motion nil
+ "If nil, comint will interpret `carriage control' characters in output.
+See `comint-carriage-motion' for details.")
;; 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.
+;; `snapshot' any current comint-last-prompt-overlay, freezing its
+;; attributes in place, even when more input comes a long and moves the
+;; 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)))
+ (let ((inhibit-read-only t))
+ (add-text-properties (overlay-start comint-last-prompt-overlay)
+ (overlay-end comint-last-prompt-overlay)
+ (overlay-properties comint-last-prompt-overlay)))))
-(defun comint-carriage-motion (string)
- "Handle carriage control characters in comint output.
+(defun comint-carriage-motion (start end)
+ "Interpret carriage control characters in the region from START to END.
Translate carriage return/linefeed sequences to linefeeds.
Make single carriage returns delete to the beginning of the line.
-Make backspaces delete the previous character.
-
-This function should be in the list `comint-output-filter-functions'."
- (save-match-data
- ;; We first check to see if STRING contains any magic characters, to
- ;; avoid overhead in the common case where it does not
- (when (string-match "[\r\b]" string)
- (let ((pmark (process-mark (get-buffer-process (current-buffer)))))
- (save-excursion
- (save-restriction
- (widen)
- (let ((inhibit-field-text-motion t)
- (buffer-read-only nil))
- ;; CR LF -> LF
- ;; Note that this won't work properly when the CR and LF
- ;; are in different output chunks, but this is probably an
- ;; exceedingly rare case (because they are generally
- ;; written as a unit), and to delay interpretation of a
- ;; trailing CR in a chunk would result in odd interactive
- ;; behavior (and this case is probably far more common).
- (goto-char comint-last-output-start)
- (while (re-search-forward "\r$" pmark t)
- (delete-char -1))
- ;; bare CR -> delete preceding line
- (goto-char comint-last-output-start)
- (while (search-forward "\r" pmark t)
- (delete-region (point) (line-beginning-position)))
- ;; BS -> delete preceding character
- (goto-char comint-last-output-start)
- (while (search-forward "\b" pmark t)
- (delete-char -2)))))))))
-
-(add-hook 'comint-output-filter-functions 'comint-carriage-motion)
+Make backspaces delete the previous character."
+ (save-excursion
+ ;; First do a quick check to see if there are any applicable
+ ;; characters, so we can avoid calling save-match-data and
+ ;; save-restriction if not.
+ (goto-char start)
+ (when (< (skip-chars-forward "^\b\r" end) (- end start))
+ (save-match-data
+ (save-restriction
+ (widen)
+ (let ((inhibit-field-text-motion t)
+ (buffer-read-only nil))
+ ;; CR LF -> LF
+ ;; Note that this won't work properly when the CR and LF
+ ;; are in different output chunks, but this is probably an
+ ;; exceedingly rare case (because they are generally
+ ;; written as a unit), and to delay interpretation of a
+ ;; trailing CR in a chunk would result in odd interactive
+ ;; behavior (and this case is probably far more common).
+ (while (re-search-forward "\r$" end t)
+ (delete-char -1))
+ ;; bare CR -> delete preceding line
+ (goto-char start)
+ (while (search-forward "\r" end t)
+ (delete-region (point) (line-beginning-position)))
+ ;; BS -> delete preceding character
+ (goto-char start)
+ (while (search-forward "\b" end t)
+ (delete-char -2))))))))
;; The purpose of using this filter for comint processes
;; is to keep comint-last-input-end from moving forward
;; Run preoutput filters
(let ((functions comint-preoutput-filter-functions))
(while (and functions string)
- (setq string (funcall (car functions) string))
+ (if (eq (car functions) t)
+ (let ((functions (default-value 'comint-preoutput-filter-functions)))
+ (while (and functions string)
+ (setq string (funcall (car functions) string))
+ (setq functions (cdr functions))))
+ (setq string (funcall (car functions) string)))
(setq functions (cdr functions))))
;; Insert STRING
;; Advance process-mark
(set-marker (process-mark process) (point))
+ (unless comint-inhibit-carriage-motion
+ ;; Interpret any carriage motion characters (newline, backspace)
+ (comint-carriage-motion comint-last-output-start (point)))
+
+ (run-hook-with-args 'comint-output-filter-functions string)
+
+ (goto-char (process-mark process)) ; in case a filter moved it
+
(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 '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
- (setq comint-last-prompt-overlay
- (make-overlay prompt-start (point)))
- (overlay-put comint-last-prompt-overlay
- 'face 'comint-highlight-prompt)))))
-
- (goto-char saved-point)
-
- (run-hook-with-args 'comint-output-filter-functions string)))))))
+ (let ((inhibit-read-only t))
+ (add-text-properties comint-last-output-start (point)
+ '(rear-nonsticky t
+ field output
+ inhibit-line-move-field-capture t))))
+
+ ;; 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
+ (setq comint-last-prompt-overlay
+ (make-overlay prompt-start (point)))
+ (overlay-put comint-last-prompt-overlay
+ 'font-lock-face 'comint-highlight-prompt))))
+
+ (goto-char saved-point)))))))
(defun comint-preinput-scroll-to-bottom ()
"Go to the end of buffer in all windows showing it.
;; Optionally scroll so that the text
;; ends at the bottom of the window.
(if (and comint-scroll-show-maximum-output
- (>= (point) (process-mark process)))
+ (= (point) (point-max)))
(save-excursion
(goto-char (point-max))
(recenter -1)))
`comint-prompt-regexp' removed."
(let ((bof (field-beginning)))
(if (eq (get-char-property bof 'field) 'input)
- (field-string bof)
+ (field-string-no-properties bof)
(comint-bol)
- (buffer-substring (point) (line-end-position)))))
+ (buffer-substring-no-properties (point) (line-end-position)))))
(defun comint-copy-old-input ()
"Insert after prompt old input at point as new input to be edited.
This function could be in the list `comint-output-filter-functions'."
(when (string-match comint-password-prompt-regexp string)
+ (when (string-match "^[ \n\r\t\v\f\b\a]+" string)
+ (setq string (replace-match "" t t string)))
(let ((pw (comint-read-noecho string t)))
(send-invisible pw))))
\f
This command also kills the pending input
between the process-mark and point."
(interactive)
- (comint-kill-input)
+ (comint-skip-input)
(interrupt-process nil comint-ptyp))
(defun comint-kill-subjob ()
This command also kills the pending input
between the process-mark and point."
(interactive)
- (comint-kill-input)
+ (comint-skip-input)
(kill-process nil comint-ptyp))
(defun comint-quit-subjob ()
This command also kills the pending input
between the process-mark and point."
(interactive)
- (comint-kill-input)
+ (comint-skip-input)
(quit-process nil comint-ptyp))
(defun comint-stop-subjob ()
this, use \\[comint-continue-subjob] to resume the process. (This
is not a problem with most shells, since they ignore this signal.)"
(interactive)
- (comint-kill-input)
+ (comint-skip-input)
(stop-process nil comint-ptyp))
(defun comint-continue-subjob ()
(interactive)
(continue-process nil comint-ptyp))
+(defun comint-skip-input ()
+ "Skip all pending input, from last stuff output by interpreter to point.
+This means mark it as if it had been sent as input, without sending it."
+ (let ((comint-input-sender 'ignore)
+ (comint-input-filter-functions nil))
+ (comint-send-input t))
+ (end-of-line)
+ (let ((pos (point))
+ (marker (process-mark (get-buffer-process (current-buffer)))))
+ (insert " " (key-description (this-command-keys)))
+ (if (= marker pos)
+ (set-marker marker (point)))))
+
(defun comint-kill-input ()
"Kill all text from last stuff output by interpreter to point."
(interactive)
"Move to end of Nth next prompt in the buffer.
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'."
+occurrence of text matching `comint-prompt-regexp'."
(interactive "p")
(if comint-use-prompt-regexp-instead-of-fields
;; Use comint-prompt-regexp
"Move to end of Nth previous prompt in the buffer.
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'."
+occurrence of text matching `comint-prompt-regexp'."
(interactive "p")
(comint-next-prompt (- n)))
(and (search-forward "\"" eol t)
(1- (point))))))
(and start end
- (buffer-substring start end)))))
+ (buffer-substring-no-properties start end)))))
(defun comint-get-source (prompt prev-dir/file source-modes mustmatch-p)
(let* ((def (comint-source-default prev-dir/file source-modes))
(mapcar 'comint-quote-filename completions)))))
+;; This is bound locally in a *Completions* buffer to the list of
+;; completions displayed, and is used to detect the case where the same
+;; command is repeatedly used without the set of completions changing.
+(defvar comint-displayed-dynamic-completions nil)
+
(defun comint-dynamic-list-completions (completions)
"List in help buffer sorted COMPLETIONS.
Typing SPC flushes the help buffer."
(let ((window (get-buffer-window "*Completions*")))
+ (setq completions (sort completions 'string-lessp))
(if (and (eq last-command this-command)
window (window-live-p window) (window-buffer window)
- (buffer-name (window-buffer window)))
+ (buffer-name (window-buffer window))
+ ;; The above tests are not sufficient to detect the case where we
+ ;; should scroll, because the top-level interactive command may
+ ;; not have displayed a completions window the last time it was
+ ;; invoked, and there may be such a window left over from a
+ ;; previous completion command with a different set of
+ ;; completions. To detect that case, we also test that the set
+ ;; of displayed completions is in fact the same as the previously
+ ;; displayed set.
+ (equal completions
+ (buffer-local-value 'comint-displayed-dynamic-completions
+ (window-buffer window))))
;; If this command was repeated, and
;; there's a fresh completion window with a live buffer,
;; and this command is repeated, scroll that window.
(let ((conf (current-window-configuration)))
(with-output-to-temp-buffer "*Completions*"
- (display-completion-list (sort completions 'string-lessp)))
+ (display-completion-list completions))
(message "Type space to flush; repeat completion command to scroll")
(let (key first)
(if (save-excursion
(set-buffer (get-buffer "*Completions*"))
+ (set (make-local-variable
+ 'comint-displayed-dynamic-completions)
+ completions)
(setq key (read-key-sequence nil)
first (aref key 0))
(and (consp first) (consp (event-start first))
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.")
+last function is the text that is actually inserted in the redirection buffer.
-(make-variable-buffer-local 'comint-redirect-filter-functions)
+You can use `add-hook' to add functions to this list
+either globally or locally.")
;; Internal variables
;; 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))
+ (if (eq (car functions) t)
+ ;; If a local value says "use the default value too",
+ ;; do that.
+ (let ((functions (default-value 'comint-redirect-filter-functions)))
+ (while (and functions filtered-input-string)
+ (setq filtered-input-string
+ (funcall (car functions) filtered-input-string))
+ (setq functions (cdr functions))))
+ (setq filtered-input-string
+ (funcall (car functions) filtered-input-string)))
(setq functions (cdr functions))))
;; Clobber `comint-redirect-finished-regexp'
HCoop / bpt / emacs.git / blobdiff