;;; comint.el --- general command interpreter in a window stuff -*- lexical-binding: t -*-
-;; Copyright (C) 1988, 1990, 1992-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 1990, 1992-2013 Free Software Foundation, Inc.
;; Author: Olin Shivers <shivers@cs.cmu.edu>
;; Simon Marshall <simon@gnu.org>
;;; Code:
-(eval-when-compile (require 'cl))
(require 'ring)
(require 'ansi-color)
(require 'regexp-opt) ;For regexp-opt-charset.
`comint-kill-whole-line' or `comint-kill-region' with no
narrowing in effect. This way you will be certain that none of
the remaining prompts will be accidentally messed up. You may
-wish to put something like the following in your `.emacs' file:
+wish to put something like the following in your init file:
\(add-hook 'comint-mode-hook
(lambda ()
(defun comint-search-arg (arg)
;; First make sure there is a ring and that we are after the process mark
(cond ((not (comint-after-pmark-p))
- (error "Not at command line"))
+ (user-error "Not at command line"))
((or (null comint-input-ring)
(ring-empty-p comint-input-ring))
- (error "Empty input ring"))
+ (user-error "Empty input ring"))
((zerop arg)
;; arg of zero resets search from beginning, and uses arg of 1
(setq comint-input-ring-index nil)
Moves relative to START, or `comint-input-ring-index'."
(if (or (not (ring-p comint-input-ring))
(ring-empty-p comint-input-ring))
- (error "No history"))
+ (user-error "No history"))
(let* ((len (ring-length comint-input-ring))
(motion (if (> arg 0) 1 -1))
(n (mod (- (or start (comint-search-start arg)) motion) len))
(let ((pos (comint-previous-matching-input-string-position regexp n)))
;; Has a match been found?
(if (null pos)
- (error "Not found")
+ (user-error "Not found")
;; If leaving the edit line, save partial input
(if (null comint-input-ring-index) ;not yet on ring
(setq comint-stored-incomplete-input
(goto-char (match-beginning 0))
(if (not (search-forward old pos t))
(or silent
- (error "Not found"))
+ (user-error "Not found"))
(replace-match new t t)
(message "History item: substituted"))))
(t
(if comint-history-isearch-message-overlay
(delete-overlay comint-history-isearch-message-overlay))
(setq isearch-message-prefix-add nil)
- (setq isearch-search-fun-function nil)
+ (setq isearch-search-fun-function 'isearch-search-fun-default)
(setq isearch-message-function nil)
(setq isearch-wrap-function nil)
(setq isearch-push-state-function nil)
(defun comint-history-isearch-search ()
"Return the proper search function, for Isearch in input history."
- (cond
- (isearch-word
- (if isearch-forward 'word-search-forward 'word-search-backward))
- (t
- (lambda (string bound noerror)
- (let ((search-fun
- ;; Use standard functions to search within comint text
- (cond
- (isearch-regexp
- (if isearch-forward 're-search-forward 're-search-backward))
- (t
- (if isearch-forward 'search-forward 'search-backward))))
- found)
- ;; Avoid lazy-highlighting matches in the comint prompt and in the
- ;; output when searching forward. Lazy-highlight calls this lambda
- ;; with the bound arg, so skip the prompt and the output.
- (if (and bound isearch-forward (not (comint-after-pmark-p)))
- (goto-char (process-mark (get-buffer-process (current-buffer)))))
- (or
- ;; 1. First try searching in the initial comint text
- (funcall search-fun string
- (if isearch-forward bound (comint-line-beginning-position))
- noerror)
- ;; 2. If the above search fails, start putting next/prev history
- ;; elements in the comint successively, and search the string
- ;; in them. Do this only when bound is nil (i.e. not while
- ;; lazy-highlighting search strings in the current comint text).
- (unless bound
- (condition-case nil
- (progn
- (while (not found)
- (cond (isearch-forward
- ;; Signal an error here explicitly, because
- ;; `comint-next-input' doesn't signal an error.
- (when (null comint-input-ring-index)
- (error "End of history; no next item"))
- (comint-next-input 1)
- (goto-char (comint-line-beginning-position)))
- (t
- ;; Signal an error here explicitly, because
- ;; `comint-previous-input' doesn't signal an error.
- (when (eq comint-input-ring-index
- (1- (ring-length comint-input-ring)))
- (error "Beginning of history; no preceding item"))
- (comint-previous-input 1)
- (goto-char (point-max))))
- (setq isearch-barrier (point) isearch-opoint (point))
- ;; After putting the next/prev history element, search
- ;; the string in them again, until comint-next-input
- ;; or comint-previous-input raises an error at the
- ;; beginning/end of history.
- (setq found (funcall search-fun string
- (unless isearch-forward
- ;; For backward search, don't search
- ;; in the comint prompt
- (comint-line-beginning-position))
- noerror)))
- ;; Return point of the new search result
- (point))
- ;; Return nil on the error "no next/preceding item"
- (error nil)))))))))
+ (lambda (string bound noerror)
+ (let ((search-fun
+ ;; Use standard functions to search within comint text
+ (isearch-search-fun-default))
+ found)
+ ;; Avoid lazy-highlighting matches in the comint prompt and in the
+ ;; output when searching forward. Lazy-highlight calls this lambda
+ ;; with the bound arg, so skip the prompt and the output.
+ (if (and bound isearch-forward (not (comint-after-pmark-p)))
+ (goto-char (process-mark (get-buffer-process (current-buffer)))))
+ (or
+ ;; 1. First try searching in the initial comint text
+ (funcall search-fun string
+ (if isearch-forward bound (comint-line-beginning-position))
+ noerror)
+ ;; 2. If the above search fails, start putting next/prev history
+ ;; elements in the comint successively, and search the string
+ ;; in them. Do this only when bound is nil (i.e. not while
+ ;; lazy-highlighting search strings in the current comint text).
+ (unless bound
+ (condition-case nil
+ (progn
+ (while (not found)
+ (cond (isearch-forward
+ ;; Signal an error here explicitly, because
+ ;; `comint-next-input' doesn't signal an error.
+ (when (null comint-input-ring-index)
+ (error "End of history; no next item"))
+ (comint-next-input 1)
+ (goto-char (comint-line-beginning-position)))
+ (t
+ ;; Signal an error here explicitly, because
+ ;; `comint-previous-input' doesn't signal an error.
+ (when (eq comint-input-ring-index
+ (1- (ring-length comint-input-ring)))
+ (error "Beginning of history; no preceding item"))
+ (comint-previous-input 1)
+ (goto-char (point-max))))
+ (setq isearch-barrier (point) isearch-opoint (point))
+ ;; After putting the next/prev history element, search
+ ;; the string in them again, until comint-next-input
+ ;; or comint-previous-input raises an error at the
+ ;; beginning/end of history.
+ (setq found (funcall search-fun string
+ (unless isearch-forward
+ ;; For backward search, don't search
+ ;; in the comint prompt
+ (comint-line-beginning-position))
+ noerror)))
+ ;; Return point of the new search result
+ (point))
+ ;; Return nil on the error "no next/preceding item"
+ (error nil)))))))
(defun comint-history-isearch-message (&optional c-q-hack ellipsis)
"Display the input history search prompt.
If there are no search errors, this function displays an overlay with
the Isearch prompt which replaces the original comint prompt.
Otherwise, it displays the standard Isearch message returned from
-`isearch-message'."
+the function `isearch-message'."
(if (not (and isearch-success (not isearch-error)))
;; Use standard function `isearch-message' when not in comint prompt,
;; or search fails, or has an error (like incomplete regexp).
"Wrap the input history search when search fails.
Move point to the first history element for a forward search,
or to the last history element for a backward search."
- (unless isearch-word
- ;; When `comint-history-isearch-search' fails on reaching the
- ;; beginning/end of the history, wrap the search to the first/last
- ;; input history element.
- (if isearch-forward
- (comint-goto-input (1- (ring-length comint-input-ring)))
- (comint-goto-input nil))
- (setq isearch-success t))
+ ;; When `comint-history-isearch-search' fails on reaching the
+ ;; beginning/end of the history, wrap the search to the first/last
+ ;; input history element.
+ (if isearch-forward
+ (comint-goto-input (1- (ring-length comint-input-ring)))
+ (comint-goto-input nil))
+ (setq isearch-success t)
(goto-char (if isearch-forward (comint-line-beginning-position) (point-max))))
(defun comint-history-isearch-push-state ()
(interactive)
;; Note that the input string does not include its terminal newline.
(let ((proc (get-buffer-process (current-buffer))))
- (if (not proc) (error "Current buffer has no process")
+ (if (not proc) (user-error "Current buffer has no process")
(widen)
(let* ((pmark (process-mark proc))
(intxt (if (>= (point) (marker-position pmark))
(let ((echo-len (- comint-last-input-end
comint-last-input-start)))
;; Wait for all input to be echoed:
- (while (and (accept-process-output proc)
- (> (+ comint-last-input-end echo-len)
+ (while (and (> (+ comint-last-input-end echo-len)
(point-max))
+ (accept-process-output proc)
(zerop
(compare-buffer-substrings
nil comint-last-input-start
(goto-char (process-mark process))
(set-marker comint-last-output-start (point))
+ ;; Try to skip repeated prompts, which can occur as a result of
+ ;; commands sent without inserting them in the buffer.
+ (let ((bol (save-excursion (forward-line 0) (point)))) ;No fields.
+ (when (and (not (bolp))
+ (looking-back comint-prompt-regexp bol))
+ (let* ((prompt (buffer-substring bol (point)))
+ (prompt-re (concat "\\`" (regexp-quote prompt))))
+ (while (string-match prompt-re string)
+ (setq string (substring string (match-end 0)))))))
+ (while (string-match (concat "\\(^" comint-prompt-regexp
+ "\\)\\1+")
+ string)
+ (setq string (replace-match "\\1" nil nil string)))
+
;; insert-before-markers is a bad thing. XXX
;; Luckily we don't have to use it any more, we use
;; window-point-insertion-type instead.
(if (and comint-scroll-to-bottom-on-input
(memq this-command '(self-insert-command comint-magic-space yank
hilit-yank)))
- (let* ((selected (selected-window))
- (current (current-buffer))
+ (let* ((current (current-buffer))
(process (get-buffer-process current))
(scroll comint-scroll-to-bottom-on-input))
(if (and process (< (point) (process-mark process)))
(lambda (window)
(if (and (eq (window-buffer window) current)
(or (eq scroll t) (eq scroll 'all)))
- (progn
- (select-window window)
- (goto-char (point-max))
- (select-window selected))))
+ (with-selected-window window
+ (goto-char (point-max)))))
nil t))))))
+(defvar follow-mode)
+(declare-function follow-comint-scroll-to-bottom "follow" (&optional window))
+
(defun comint-postoutput-scroll-to-bottom (_string)
"Go to the end of buffer in some or all windows showing it.
-Does not scroll if the current line is the last line in the buffer.
+Do not scroll if the current line is the last line in the buffer.
Depends on the value of `comint-move-point-for-output' and
`comint-scroll-show-maximum-output'.
This function should be in the list `comint-output-filter-functions'."
- (let* ((selected (selected-window))
- (current (current-buffer))
- (process (get-buffer-process current))
- (scroll comint-move-point-for-output))
+ (let* ((current (current-buffer))
+ (process (get-buffer-process current)))
(unwind-protect
- (if process
- (walk-windows
- (lambda (window)
- (when (eq (window-buffer window) current)
- (select-window window)
- (if (and (< (point) (process-mark process))
- (or (eq scroll t) (eq scroll 'all)
- ;; Maybe user wants point to jump to end.
- (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.
- (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.
- (if (and comint-scroll-show-maximum-output
- (= (point) (point-max)))
- (save-excursion
- (goto-char (point-max))
- (recenter (- -1 scroll-margin))))
- (select-window selected)))
- nil t))
+ (cond
+ ((null process))
+ ((bound-and-true-p follow-mode)
+ (follow-comint-scroll-to-bottom))
+ (t
+ (dolist (w (get-buffer-window-list current nil t))
+ (comint-adjust-window-point w process)
+ ;; Optionally scroll to the bottom of the window.
+ (and comint-scroll-show-maximum-output
+ (eq (window-point w) (point-max))
+ (with-selected-window w
+ (recenter (- -1 scroll-margin)))))))
(set-buffer current))))
+
+(defun comint-adjust-window-point (window process)
+ "Move point in WINDOW based on Comint settings.
+For point adjustment use the process-mark of PROCESS."
+ (and (< (window-point window) (process-mark process))
+ (or (memq comint-move-point-for-output '(t all))
+ ;; Maybe user wants point to jump to end.
+ (eq comint-move-point-for-output
+ (if (eq (selected-window) window) 'this 'others))
+ ;; If point was at the end, keep it at end.
+ (and (marker-position comint-last-output-start)
+ (>= (window-point window) comint-last-output-start)))
+ (set-window-point window (process-mark process))))
+
+
+;; this function is nowhere used
+(defun comint-adjust-point (selected)
+ "Move point in the selected window based on Comint settings.
+SELECTED is the window that was originally selected."
+ (let ((process (get-buffer-process (current-buffer))))
+ (and (< (point) (process-mark process))
+ (or (memq comint-move-point-for-output '(t all))
+ ;; Maybe user wants point to jump to end.
+ (eq comint-move-point-for-output
+ (if (eq (selected-window) selected) 'this 'others))
+ ;; If point was at the end, keep it at end.
+ (and (marker-position comint-last-output-start)
+ (>= (point) comint-last-output-start)))
+ (goto-char (process-mark process)))))
+
(defun comint-truncate-buffer (&optional _string)
"Truncate the buffer to `comint-buffer-maximum-size'.
This function could be on `comint-output-filter-functions' or bound to a key."
(let ((input (funcall comint-get-old-input))
(process (get-buffer-process (current-buffer))))
(if (not process)
- (error "Current buffer has no process")
+ (user-error "Current buffer has no process")
(goto-char (process-mark process))
(insert input))))
(save-excursion
(while (/= n 0)
(unless (re-search-backward regexp nil t dir)
- (error "Not found"))
+ (user-error "Not found"))
(unless (get-char-property (point) 'field)
(setq n (- n dir))))
(field-beginning))))
the case, this command just calls `kill-region' with all
read-only properties intact. The read-only status of newlines is
updated using `comint-update-fence', if necessary."
+ (declare (advertised-calling-convention (beg end) "23.3"))
(interactive "r")
(save-excursion
(let* ((true-beg (min beg end))
(let ((inhibit-read-only t))
(kill-region beg end yank-handler)
(comint-update-fence))))))
-(set-advertised-calling-convention 'comint-kill-region '(beg end) "23.3")
-
\f
;; Support for source-file processing commands.
;;============================================================================
(if (and buff
(buffer-modified-p buff)
(y-or-n-p (format "Save buffer %s first? " (buffer-name buff))))
- ;; save BUFF.
- (let ((old-buffer (current-buffer)))
- (set-buffer buff)
- (save-buffer)
- (set-buffer old-buffer)))))
+ (with-current-buffer buff
+ (save-buffer)))))
(defun comint-extract-string ()
"Return string around point, or nil."
"Return the word of WORD-CHARS at point, or nil if none is found.
Word constituents are considered to be those in WORD-CHARS, which is like the
inside of a \"[...]\" (see `skip-chars-forward'), plus all non-ASCII characters."
+ ;; FIXME: Need to handle "..." and '...' quoting in shell.el!
+ ;; This should be combined with completion parsing somehow.
(save-excursion
(let ((here (point))
giveup)
(while (not giveup)
(let ((startpoint (point)))
(skip-chars-backward (concat "\\\\" word-chars))
- ;; Fixme: This isn't consistent with Bash, at least -- not
- ;; all non-ASCII chars should be word constituents.
- (if (and (> (- (point) 2) (point-min))
- (= (char-after (- (point) 2)) ?\\))
+ (if (and comint-file-name-quote-list
+ (eq (char-before (1- (point))) ?\\))
(forward-char -2))
- (if (and (> (- (point) 1) (point-min))
- (>= (char-after (- (point) 1)) 128))
+ ;; FIXME: This isn't consistent with Bash, at least -- not
+ ;; all non-ASCII chars should be word constituents.
+ (if (and (not (bobp)) (>= (char-before) 128))
(forward-char -1))
(if (= (point) startpoint)
(setq giveup t))))
(defun comint--unquote&requote-argument (qstr &optional upos)
(unless upos (setq upos 0))
(let* ((qpos 0)
- (dquotes nil)
(ustrs '())
(re (concat
- "[\"']\\|\\\\\\(.\\)"
- "\\|\\$\\(?:\\([[:alpha:]][[:alnum:]]*\\)"
- "\\|{\\(?2:[^{}]+\\)}\\)"
+ "\\$\\(?:\\([[:alpha:]][[:alnum:]]*\\)"
+ "\\|{\\(?1:[^{}]+\\)}\\)"
(when (memq system-type '(ms-dos windows-nt))
- "\\|%\\(?2:[^\\\\/]*\\)%")))
+ "\\|%\\(?1:[^\\\\/]*\\)%")
+ (when comint-file-name-quote-list
+ "\\|\\\\\\(.\\)")))
(qupos nil)
(push (lambda (str end)
(push str ustrs)
(while (setq match (string-match re qstr qpos))
(funcall push (substring qstr qpos match) match)
(cond
- ((match-beginning 1) (funcall push (match-string 1 qstr) (match-end 0)))
- ((match-beginning 2) (funcall push (getenv (match-string 2 qstr))
+ ((match-beginning 2) (funcall push (match-string 2 qstr) (match-end 0)))
+ ((match-beginning 1) (funcall push (getenv (match-string 1 qstr))
(- (match-end 0))))
- ((eq (aref qstr match) ?\") (setq dquotes (not dquotes)))
- ((eq (aref qstr match) ?\')
- (cond
- (dquotes (funcall push "'" (match-end 0)))
- ((< match (1+ (length qstr)))
- (let ((end (string-match "'" qstr (1+ match))))
- (funcall push (substring qstr (1+ match) end)
- (or end (length qstr)))))
- (t nil)))
(t (error "Unexpected case in comint--unquote&requote-argument!")))
(setq qpos (match-end 0)))
(funcall push (substring qstr qpos) (length qstr))
(defun comint--unquote-argument (str)
(car (comint--unquote&requote-argument str)))
(define-obsolete-function-alias 'comint--unquote&expand-filename
- #'comint--unquote-argument "24.2")
+ #'comint--unquote-argument "24.3")
(defun comint-match-partial-filename ()
"Return the unquoted&expanded filename at point, or nil if none is found.
(defun comint-unquote-filename (filename)
"Return FILENAME with quoted characters unquoted."
+ (declare (obsolete nil "24.3"))
(if (null comint-file-name-quote-list)
filename
(save-match-data
(replace-regexp-in-string "\\\\\\(.\\)" "\\1" filename t))))
-(make-obsolete 'comint-unquote-filename nil "24.2")
(defun comint--requote-argument (upos qstr)
;; See `completion-table-with-quoting'.
See `completion-table-with-quoting' and `comint-requote-function'.")
(defvar comint-requote-function #'comint--requote-argument
"Function to use for completion of quoted data.
-See `completion-table-with-quoting' and `comint-requote-function'.")
+See `completion-table-with-quoting' and `comint-unquote-function'.")
(defun comint--complete-file-name-data ()
"Return the completion data for file name at point."
(complete-with-action action table string pred))))
(unless (zerop (length filesuffix))
(list :exit-function
- (lambda (_s finished)
- (when (memq finished '(sole finished))
+ (lambda (_s status)
+ (when (eq status 'finished)
(if (looking-at (regexp-quote filesuffix))
(goto-char (match-end 0))
(insert filesuffix)))))))))
(defun comint-dynamic-complete-as-filename ()
"Dynamically complete at point as a filename.
See `comint-dynamic-complete-filename'. Returns t if successful."
+ (declare (obsolete comint-filename-completion "24.1"))
(let ((data (comint--complete-file-name-data)))
(completion-in-region (nth 0 data) (nth 1 data) (nth 2 data))))
-(make-obsolete 'comint-dynamic-complete-as-filename
- 'comint-filename-completion "24.1")
(defun comint-replace-by-expanded-filename ()
"Dynamically expand and complete the filename at point.
Return `listed' if a completion listing was shown.
See also `comint-dynamic-complete-filename'."
+ (declare (obsolete completion-in-region "24.1"))
(let* ((completion-ignore-case (memq system-type '(ms-dos windows-nt cygwin)))
(minibuffer-p (window-minibuffer-p (selected-window)))
(suffix (cond ((not comint-completion-addsuffix) "")
(unless minibuffer-p
(message "Partially completed"))
'partial)))))))
-(make-obsolete 'comint-dynamic-simple-complete 'completion-in-region "24.1")
-
(defun comint-dynamic-list-filename-completions ()
"Display a list of possible completions for the filename at point."
from input that has not yet been sent."
(interactive)
(let ((proc (or (get-buffer-process (current-buffer))
- (error "Current buffer has no process"))))
+ (user-error "Current buffer has no process"))))
(goto-char (process-mark proc))
(when (called-interactively-p 'interactive)
(message "Point is now at the process mark"))))
"Set the process mark at point."
(interactive)
(let ((proc (or (get-buffer-process (current-buffer))
- (error "Current buffer has no process"))))
+ (user-error "Current buffer has no process"))))
(set-marker (process-mark proc) (point))
(message "Process mark set")))
This is useful, for instance, for insertion into Help mode buffers.
You probably want to set it locally to the output buffer.")
+(defvar comint-redirect-previous-input-string nil
+ "Last redirected line of text.
+Allows detection of the end of the redirection in case the
+completion string is split between two output segments.")
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(make-local-variable 'comint-redirect-completed)
(setq comint-redirect-completed nil)
+ (make-local-variable 'comint-redirect-previous-input-string)
+ (setq comint-redirect-previous-input-string "")
+
(setq mode-line-process
(if mode-line-process
(list (concat (elt mode-line-process 0) " Redirection"))
(defun comint-redirect-cleanup ()
"End a Comint redirection. See `comint-redirect-send-command'."
(interactive)
+ ;; Release the last redirected string
+ (setq comint-redirect-previous-input-string nil)
;; Restore the process filter
(set-process-filter (get-buffer-process (current-buffer))
comint-redirect-original-filter-function)
;; Message
(and comint-redirect-verbose
- (message "Redirected output to buffer(s) %s"
- (mapconcat 'identity output-buffer-list " ")))
+ (message "Redirected output to buffer(s) %s" 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)
+ (and (string-match comint-redirect-finished-regexp
+ (concat comint-redirect-previous-input-string
+ input-string))
(progn
(and comint-redirect-verbose
(message "Redirection completed"))
(comint-redirect-cleanup)
(run-hooks 'comint-redirect-hook)))
+ (setq comint-redirect-previous-input-string input-string)
+
;; Echo input?
(if comint-redirect-echo-input
filtered-input-string
(match-end regexp-group))
results))
results)))
-
-(dolist (x '("^Not at command line$"
- "^Empty input ring$"
- "^No history$"
- "^Not found$" ; Too common?
- "^Current buffer has no process$"))
- (add-to-list 'debug-ignored-errors x))
-
\f
;; Converting process modes to use comint mode
;; ===========================================================================