;;; 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 ()
(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.
"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 ()
(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" ())
+(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.
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."