;;; 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-2014 Free Software Foundation, Inc.
;; Author: Olin Shivers <shivers@cs.cmu.edu>
;; Simon Marshall <simon@gnu.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: processes
;; Package: emacs
;;; Code:
-(eval-when-compile (require 'cl))
(require 'ring)
(require 'ansi-color)
+(require 'regexp-opt) ;For regexp-opt-charset.
\f
;; Buffer Local Variables:
;;============================================================================
"Completion facilities in comint."
:group 'comint)
-(defgroup comint-source nil
- "Source finding facilities in comint."
- :prefix "comint-"
- :group 'comint)
+;; Unused.
+;;; (defgroup comint-source nil
+;;; "Source finding facilities in comint."
+;;; :prefix "comint-"
+;;; :group 'comint)
(defvar comint-prompt-regexp "^"
"Regexp to recognize prompts in the inferior process.
`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 ()
- (define-key comint-mode-map \"\\C-w\" 'comint-kill-region)
- (define-key comint-mode-map [C-S-backspace]
+ (define-key comint-mode-map [remap kill-region] 'comint-kill-region)
+ (define-key comint-mode-map [remap kill-whole-line]
'comint-kill-whole-line)))
If you sometimes use comint-mode on text-only terminals or with `emacs -nw',
If the value is `input', then the expansion is seen on input.
If the value is `history', then the expansion is only when inserting
into the buffer's input ring. See also `comint-magic-space' and
-`comint-dynamic-complete'.
+`completion-at-point'.
This variable is buffer-local."
:type '(choice (const :tag "off" nil)
"Old" "old" "New" "new" "'s" "login"
"Kerberos" "CVS" "UNIX" " SMB" "LDAP" "[sudo]" "Repeat" "Bad") t)
" +\\)"
- (regexp-opt
- '("password" "Password" "passphrase" "Passphrase"
- "pass phrase" "Pass phrase" "Response"))
+ "\\(?:" (regexp-opt password-word-equivalents) "\\|Response\\)"
"\\(?:\\(?:, try\\)? *again\\| (empty for no passphrase)\\| (again)\\)?\
-\\(?: for [^:]+\\)?:\\s *\\'")
+\\(?: for [^:：៖]+\\)?[:：៖]\\s *\\'")
"Regexp matching prompts for passwords in the inferior process.
This is used by `comint-watch-for-password-prompt'."
- :version "24.1"
+ :version "24.4"
:type 'regexp
:group 'comint)
'(comint-c-a-p-replace-by-expanded-history comint-filename-completion)
"List of functions called to perform completion.
Works like `completion-at-point-functions'.
-See also `comint-dynamic-complete'.
+See also `completion-at-point'.
This is a good thing to set in mode hooks.")
(define-key map "\e\C-l" 'comint-show-output)
(define-key map "\C-m" 'comint-send-input)
(define-key map "\C-d" 'comint-delchar-or-maybe-eof)
- ;; The following two are standardly aliased to C-d,
+ ;; The following two are standardly bound to delete-forward-char,
;; but they should never do EOF, just delete.
- (define-key map [delete] 'delete-char)
- (define-key map [kp-delete] 'delete-char)
+ (define-key map [delete] 'delete-forward-char)
+ (define-key map [kp-delete] 'delete-forward-char)
(define-key map "\C-c " 'comint-accumulate)
(define-key map "\C-c\C-x" 'comint-get-next-from-history)
(define-key map "\C-c\C-a" 'comint-bol-or-process-mark)
and addition is controlled by the variable `comint-input-ignoredups'.
Commands with no default key bindings include `send-invisible',
-`comint-dynamic-complete', `comint-dynamic-list-filename-completions', and
+`completion-at-point', `comint-dynamic-list-filename-completions', and
`comint-magic-space'.
Input to, and output from, the subprocess can cause the window to scroll to
Entry to this mode runs the hooks on `comint-mode-hook'."
(setq mode-line-process '(":%s"))
- (set (make-local-variable 'window-point-insertion-type) t)
- (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-prompt-overlay)
+ (setq-local window-point-insertion-type t)
+ (setq-local comint-last-input-start (point-min-marker))
+ (setq-local comint-last-input-end (point-min-marker))
+ (setq-local comint-last-output-start (make-marker))
+ (make-local-variable 'comint-last-prompt)
(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-chars)
(make-local-variable 'comint-file-name-quote-list)
;; dir tracking on remote files
- (set (make-local-variable 'comint-file-name-prefix)
- (or (file-remote-p default-directory) ""))
- (make-local-variable 'comint-accum-marker)
- (setq comint-accum-marker (make-marker))
- (make-local-variable 'font-lock-defaults)
- (setq font-lock-defaults '(nil t))
+ (setq-local comint-file-name-prefix
+ (or (file-remote-p default-directory) ""))
+ (setq-local comint-accum-marker (make-marker))
+ (setq-local font-lock-defaults '(nil t))
(add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
(add-hook 'isearch-mode-hook 'comint-history-isearch-setup nil t)
(add-hook 'completion-at-point-functions 'comint-completion-at-point nil t)
;; This behavior is not useful in comint buffers, and is annoying
- (set (make-local-variable 'next-line-add-newlines) nil))
+ (setq-local next-line-add-newlines nil))
(defun comint-check-proc (buffer)
"Return non-nil if there is a living process associated w/buffer BUFFER.
The file name is used to make a symbol name, such as `comint-sh-hook', and any
hooks on this symbol are run in the buffer.
See `make-comint' and `comint-exec'."
+ (declare (interactive-only make-comint))
(interactive "sRun program: ")
(let ((name (file-name-nondirectory program)))
(switch-to-buffer (make-comint name program))
(open-network-stream name buffer (car command) (cdr command))
(comint-exec-1 name buffer command switches))))
(set-process-filter proc 'comint-output-filter)
- (make-local-variable 'comint-ptyp)
- (setq comint-ptyp process-connection-type) ; t if pty, nil if pipe.
+ (setq-local comint-ptyp process-connection-type) ; t if pty, nil if pipe.
;; Jump to the end, and set the process mark.
(goto-char (point-max))
(set-marker (process-mark proc) (point))
(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
(funcall comint-get-old-input)))
(setq comint-input-ring-index pos)
- (message "History item: %d" (1+ pos))
+ (unless isearch-mode
+ (let ((message-log-max nil)) ; Do not write to *Messages*.
+ (message "History item: %d" (1+ pos))))
(comint-delete-input)
(insert (ring-ref comint-input-ring pos)))))
With prefix argument N, search for Nth previous match.
If N is negative, search forwards for the -Nth following match."
(interactive "p")
- (if (not (memq last-command '(comint-previous-matching-input-from-input
- comint-next-matching-input-from-input)))
+ (let ((opoint (point)))
+ (unless (memq last-command '(comint-previous-matching-input-from-input
+ comint-next-matching-input-from-input))
;; Starting a new search
(setq comint-matching-input-from-input-string
(buffer-substring
(process-mark (get-buffer-process (current-buffer))))
(point))
comint-input-ring-index nil))
- (comint-previous-matching-input
- (concat "^" (regexp-quote comint-matching-input-from-input-string))
- n))
+ (comint-previous-matching-input
+ (concat "^" (regexp-quote comint-matching-input-from-input-string))
+ n)
+ (goto-char opoint)))
(defun comint-next-matching-input-from-input (n)
"Search forwards through input history for match for current 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
"Search for a string backward in input history using Isearch."
(interactive)
(let ((comint-history-isearch t))
- (isearch-backward)))
+ (isearch-backward nil t)))
(defun comint-history-isearch-backward-regexp ()
"Search for a regular expression backward in input history using Isearch."
(interactive)
(let ((comint-history-isearch t))
- (isearch-backward-regexp)))
+ (isearch-backward-regexp nil t)))
-(defvar comint-history-isearch-message-overlay nil)
-(make-variable-buffer-local 'comint-history-isearch-message-overlay)
+(defvar-local comint-history-isearch-message-overlay nil)
(defun comint-history-isearch-setup ()
"Set up a comint for using Isearch to search the input history.
;; Point is at command line.
(comint-after-pmark-p)))
(setq isearch-message-prefix-add "history ")
- (set (make-local-variable 'isearch-search-fun-function)
- 'comint-history-isearch-search)
- (set (make-local-variable 'isearch-message-function)
- 'comint-history-isearch-message)
- (set (make-local-variable 'isearch-wrap-function)
- 'comint-history-isearch-wrap)
- (set (make-local-variable 'isearch-push-state-function)
- 'comint-history-isearch-push-state)
+ (setq-local isearch-search-fun-function
+ #'comint-history-isearch-search)
+ (setq-local isearch-message-function
+ #'comint-history-isearch-message)
+ (setq-local isearch-wrap-function
+ #'comint-history-isearch-wrap)
+ (setq-local isearch-push-state-function
+ #'comint-history-isearch-push-state)
(add-hook 'isearch-mode-end-hook 'comint-history-isearch-end nil t)))
(defun comint-history-isearch-end ()
(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).
(overlay-put comint-history-isearch-message-overlay 'evaporate t))
(overlay-put comint-history-isearch-message-overlay
'display (isearch-message-prefix c-q-hack ellipsis))
- ;; And clear any previous isearch message.
- (message "")))
+ (if (and comint-input-ring-index (not ellipsis))
+ ;; Display the current history index.
+ (message "History item: %d" (1+ comint-input-ring-index))
+ ;; Or clear a previous isearch message.
+ (message ""))))
(defun comint-history-isearch-wrap ()
"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 ()
"Save a function restoring the state of input history search.
Save `comint-input-ring-index' to the additional state parameter
in the search status stack."
- `(lambda (cmd)
- (comint-history-isearch-pop-state cmd ,comint-input-ring-index)))
+ (let ((index comint-input-ring-index))
+ (lambda (cmd)
+ (comint-history-isearch-pop-state cmd index))))
(defun comint-history-isearch-pop-state (_cmd hist-pos)
"Restore the input history search state.
Similarly for Soar, Scheme, etc."
(interactive)
+ ;; If we're currently completing, stop. We're definitely done
+ ;; completing, and by sending the input, we might cause side effects
+ ;; that will confuse the code running in the completion
+ ;; post-command-hook.
+ (when completion-in-region-mode
+ (completion-in-region-mode -1))
;; 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))
(concat input "\n")))
(let ((beg (marker-position pmark))
- (end (if no-newline (point) (1- (point))))
- (inhibit-modification-hooks t))
- (when (> end beg)
- (add-text-properties beg end
- '(front-sticky t
- font-lock-face comint-highlight-input))
- (unless comint-use-prompt-regexp
- ;; 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.
- (add-text-properties
- beg end
- '(mouse-face highlight
- help-echo "mouse-2: insert after prompt as new input"))))
- (unless (or no-newline comint-use-prompt-regexp)
- ;; Cover the terminating newline
- (add-text-properties end (1+ end)
- '(rear-nonsticky t
- field boundary
- inhibit-line-move-field-capture t))))
+ (end (if no-newline (point) (1- (point)))))
+ (with-silent-modifications
+ (when (> end beg)
+ (add-text-properties beg end
+ '(front-sticky t
+ font-lock-face comint-highlight-input))
+ (unless comint-use-prompt-regexp
+ ;; 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.
+ (add-text-properties
+ beg end
+ '(mouse-face highlight
+ help-echo "mouse-2: insert after prompt as new input"))))
+ (unless (or no-newline comint-use-prompt-regexp)
+ ;; 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)
(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
"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)
+(defvar comint-last-prompt nil
+ "Markers pointing to the last prompt.
+If non-nil, a cons cell containing markers. The car points to
+the start, the cdr to the end of the last prompt recognized.")
(defun comint-snapshot-last-prompt ()
- "`snapshot' any current `comint-last-prompt-overlay'.
-Freeze its attributes in place, even when more input comes along
-and moves the prompt overlay."
- (when comint-last-prompt-overlay
- (let ((inhibit-read-only t)
- (inhibit-modification-hooks t))
- (add-text-properties (overlay-start comint-last-prompt-overlay)
- (overlay-end comint-last-prompt-overlay)
- (overlay-properties comint-last-prompt-overlay)))))
+ "Snapshot the current `comint-last-prompt'.
+Freezes the `font-lock-face' text property in place."
+ (when comint-last-prompt
+ (with-silent-modifications
+ (add-text-properties
+ (car comint-last-prompt)
+ (cdr comint-last-prompt)
+ '(font-lock-face comint-highlight-prompt)))
+ ;; Reset comint-last-prompt so later on comint-output-filter does
+ ;; not remove the font-lock-face text property of the previous
+ ;; (this) prompt.
+ (setq comint-last-prompt nil)))
(defun comint-carriage-motion (start end)
"Interpret carriage control characters in the region from START to END.
(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.
(run-hook-with-args 'comint-output-filter-functions string)
(set-marker saved-point (point))
- (goto-char (process-mark process)) ; in case a filter moved it
+ (goto-char (process-mark process)) ; In case a filter moved it.
(unless comint-use-prompt-regexp
- (let ((inhibit-read-only t)
- (inhibit-modification-hooks t))
+ (with-silent-modifications
(add-text-properties comint-last-output-start (point)
'(front-sticky
(field inhibit-line-move-field-capture)
;; Highlight the prompt, where we define `prompt' to mean
;; the most recent output that doesn't end with a newline.
(let ((prompt-start (save-excursion (forward-line 0) (point)))
- (inhibit-read-only t)
- (inhibit-modification-hooks t))
+ (inhibit-read-only t))
(when comint-prompt-read-only
- (or (= (point-min) prompt-start)
- (get-text-property (1- prompt-start) 'read-only)
- (put-text-property
- (1- prompt-start) prompt-start 'read-only 'fence))
- (add-text-properties
- prompt-start (point)
- '(read-only t rear-nonsticky t front-sticky (read-only))))
- (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).
- (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))))
-
+ (with-silent-modifications
+ (or (= (point-min) prompt-start)
+ (get-text-property (1- prompt-start) 'read-only)
+ (put-text-property (1- prompt-start)
+ prompt-start 'read-only 'fence))
+ (add-text-properties prompt-start (point)
+ '(read-only t front-sticky (read-only)))))
+ (when comint-last-prompt
+ (remove-text-properties (car comint-last-prompt)
+ (cdr comint-last-prompt)
+ '(font-lock-face)))
+ (setq comint-last-prompt
+ (cons (copy-marker prompt-start) (point-marker)))
+ (add-text-properties prompt-start (point)
+ '(rear-nonsticky t
+ font-lock-face comint-highlight-prompt)))
(goto-char saved-point)))))))
(defun comint-preinput-scroll-to-bottom ()
(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))))
(interactive "P") ; Defeat snooping via C-x ESC ESC
(let ((proc (get-buffer-process (current-buffer)))
(prefix
- (if (eq (window-buffer (selected-window)) (current-buffer))
+ (if (eq (window-buffer) (current-buffer))
""
(format "(In buffer %s) "
(current-buffer)))))
`comint-password-prompt-regexp'.
This function could be in the list `comint-output-filter-functions'."
- (when (string-match comint-password-prompt-regexp string)
+ (when (let ((case-fold-search t))
+ (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)))
(send-invisible string)))
(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))))
(comint-next-prompt (- n)))
;; State used by `comint-insert-previous-argument' when cycling.
-(defvar comint-insert-previous-argument-last-start-pos nil)
-(make-variable-buffer-local 'comint-insert-previous-argument-last-start-pos)
-(defvar comint-insert-previous-argument-last-index nil)
-(make-variable-buffer-local 'comint-insert-previous-argument-last-index)
+(defvar-local comint-insert-previous-argument-last-start-pos nil)
+(defvar-local comint-insert-previous-argument-last-index nil)
;; Needs fixing:
;; make comint-arguments understand negative indices as bash does
If the character after point does not have a front-sticky
read-only property, any read-only property of `fence' on the
preceding newline is removed."
- (let* ((pt (point)) (lst (get-text-property pt 'front-sticky))
- (inhibit-modification-hooks t))
+ (let* ((pt (point)) (lst (get-text-property pt 'front-sticky)))
(and (bolp)
(not (bobp))
- (if (and (get-text-property pt 'read-only)
- (if (listp lst) (memq 'read-only lst) t))
- (unless (get-text-property (1- pt) 'read-only)
- (put-text-property (1- pt) pt 'read-only 'fence))
- (when (eq (get-text-property (1- pt) 'read-only) 'fence)
- (remove-list-of-text-properties (1- pt) pt '(read-only)))))))
+ (with-silent-modifications
+ (if (and (get-text-property pt 'read-only)
+ (if (listp lst) (memq 'read-only lst) t))
+ (unless (get-text-property (1- pt) 'read-only)
+ (put-text-property (1- pt) pt 'read-only 'fence))
+ (when (eq (get-text-property (1- pt) 'read-only) 'fence)
+ (remove-list-of-text-properties (1- pt) pt '(read-only))))))))
(defun comint-kill-whole-line (&optional count)
"Kill current line, ignoring read-only and field properties.
(kill-whole-line count)
(when (>= count 0) (comint-update-fence))))
-(defun comint-kill-region (beg end &optional yank-handler)
+(defun comint-kill-region (beg end)
"Like `kill-region', but ignores read-only properties, if safe.
This command assumes that the buffer contains read-only
\"prompts\" which are regions with front-sticky read-only
(if (listp end-lst) (memq 'read-only end-lst) t))))
(if (or (and (not beg-bolp) (or beg-bad end-bad))
(and (not end-bolp) end-bad))
- (kill-region beg end yank-handler)
+ (kill-region beg end)
(let ((inhibit-read-only t))
- (kill-region beg end yank-handler)
+ (kill-region beg end)
(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."
;; Useful completion functions, courtesy of the Ergo group.
;; Six commands:
-;; comint-dynamic-complete Complete or expand command, filename,
+;; completion-at-point Complete or expand command, filename,
;; history at point.
;; comint-dynamic-complete-filename Complete filename at point.
;; comint-dynamic-list-filename-completions List completions in help buffer.
;; These are not installed in the comint-mode keymap. But they are
;; available for people who want them. Shell-mode installs them:
-;; (define-key shell-mode-map "\t" 'comint-dynamic-complete)
+;; (define-key shell-mode-map "\t" 'completion-at-point)
;; (define-key shell-mode-map "\M-?"
;; 'comint-dynamic-list-filename-completions)))
;;
"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))))
See `comint-word'."
(comint-word comint-file-name-chars))
-(defun comint--unquote&expand-filename (filename)
- ;; FIXME: The code below does unquote-then-expand which means that "\\$HOME"
- ;; gets expanded to the same as "$HOME"
- (comint-substitute-in-file-name
- (comint-unquote-filename filename)))
+(defun comint--unquote&requote-argument (qstr &optional upos)
+ (unless upos (setq upos 0))
+ (let* ((qpos 0)
+ (ustrs '())
+ (re (concat
+ "\\$\\(?:\\([[:alpha:]][[:alnum:]]*\\)"
+ "\\|{\\(?1:[^{}]+\\)}\\)"
+ (when (memq system-type '(ms-dos windows-nt))
+ "\\|%\\(?1:[^\\\\/]*\\)%")
+ (when comint-file-name-quote-list
+ "\\|\\\\\\(.\\)")))
+ (qupos nil)
+ (push (lambda (str end)
+ (push str ustrs)
+ (setq upos (- upos (length str)))
+ (unless (or qupos (> upos 0))
+ (setq qupos (if (< end 0) (- end) (+ upos end))))))
+ match)
+ (while (setq match (string-match re qstr qpos))
+ (funcall push (substring qstr qpos match) match)
+ (cond
+ ((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))))
+ (t (error "Unexpected case in comint--unquote&requote-argument!")))
+ (setq qpos (match-end 0)))
+ (funcall push (substring qstr qpos) (length qstr))
+ (list (mapconcat #'identity (nreverse ustrs) "")
+ qupos #'comint-quote-filename)))
+
+(defun comint--unquote-argument (str)
+ (car (comint--unquote&requote-argument str)))
+(define-obsolete-function-alias 'comint--unquote&expand-filename
+ #'comint--unquote-argument "24.3")
(defun comint-match-partial-filename ()
"Return the unquoted&expanded filename at point, or nil if none is found.
Environment variables are substituted. See `comint-word'."
(let ((filename (comint--match-partial-filename)))
- (and filename (comint--unquote&expand-filename filename))))
+ (and filename (comint--unquote-argument filename))))
(defun comint-quote-filename (filename)
"Return FILENAME with magic characters quoted.
Magic characters are those in `comint-file-name-quote-list'."
(if (null comint-file-name-quote-list)
filename
- (let ((regexp
- (format "[%s]"
- (mapconcat 'char-to-string comint-file-name-quote-list ""))))
+ (let ((regexp (regexp-opt-charset comint-file-name-quote-list)))
(save-match-data
(let ((i 0))
(while (string-match regexp filename i)
(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))))
+(defun comint--requote-argument (upos qstr)
+ ;; See `completion-table-with-quoting'.
+ (let ((res (comint--unquote&requote-argument qstr upos)))
+ (cons (nth 1 res) (nth 2 res))))
+
(defun comint-completion-at-point ()
(run-hook-with-args-until-success 'comint-dynamic-complete-functions))
Returns t if successful."
(interactive)
(when (comint--match-partial-filename)
- (unless (window-minibuffer-p (selected-window))
+ (unless (window-minibuffer-p)
(message "Completing file name..."))
(let ((data (comint--complete-file-name-data)))
(completion-in-region (nth 0 data) (nth 1 data) (nth 2 data)))))
(when (comint--match-partial-filename)
(comint--complete-file-name-data)))
-;; FIXME: comint--common-suffix, comint--common-quoted-suffix, and
-;; comint--table-subvert don't fully solve the problem, since
-;; selecting a file from *Completions* won't quote it, among several
-;; other problems.
-
-(defun comint--common-suffix (s1 s2)
- (assert (not (or (string-match "\n" s1) (string-match "\n" s2))))
- ;; Since S2 is expected to be the "unquoted/expanded" version of S1,
- ;; there shouldn't be any case difference, even if the completion is
- ;; case-insensitive.
- (let ((case-fold-search nil))
- (string-match ".*?\\(.*\\)\n.*\\1\\'" (concat s1 "\n" s2))
- (- (match-end 1) (match-beginning 1))))
-
-(defun comint--common-quoted-suffix (s1 s2)
- ;; FIXME: Copied in pcomplete.el.
- "Find the common suffix between S1 and S2 where S1 is the expanded S2.
-S1 is expected to be the unquoted and expanded version of S2.
-Returns (PS1 . PS2), i.e. the shortest prefixes of S1 and S2, such that
-S1 = (concat PS1 SS1) and S2 = (concat PS2 SS2) and
-SS1 = (unquote SS2)."
- (let* ((cs (comint--common-suffix s1 s2))
- (ss1 (substring s1 (- (length s1) cs)))
- (qss1 (comint-quote-filename ss1))
- qc s2b)
- (if (and (not (equal ss1 qss1))
- (setq qc (comint-quote-filename (substring ss1 0 1)))
- (setq s2b (- (length s2) cs (length qc) -1))
- (>= s2b 0) ;bug#11158.
- (eq t (compare-strings s2 s2b (- (length s2) cs -1)
- qc nil nil)))
- ;; The difference found is just that one char is quoted in S2
- ;; but not in S1, keep looking before this difference.
- (comint--common-quoted-suffix
- (substring s1 0 (- (length s1) cs))
- (substring s2 0 s2b))
- (cons (substring s1 0 (- (length s1) cs))
- (substring s2 0 (- (length s2) cs))))))
-
-(defun comint--table-subvert (table s1 s2 &optional quote-fun unquote-fun)
- "Completion table that replaces the prefix S1 with S2 in STRING.
-The result is a completion table which completes strings of the
-form (concat S1 S) in the same way as TABLE completes strings of
-the form (concat S2 S)."
- (lambda (string pred action)
- (let* ((str (if (eq t (compare-strings string 0 (length s1) s1 nil nil
- completion-ignore-case))
- (let ((rest (substring string (length s1))))
- (concat s2 (if unquote-fun
- (funcall unquote-fun rest) rest)))))
- (res (if str (complete-with-action action table str pred))))
- (when res
- (cond
- ((and (eq (car-safe action) 'boundaries))
- (let ((beg (or (and (eq (car-safe res) 'boundaries) (cadr res)) 0)))
- (list* 'boundaries
- (max (length s1)
- ;; FIXME: Adjust because of quoting/unquoting.
- (+ beg (- (length s1) (length s2))))
- (and (eq (car-safe res) 'boundaries) (cddr res)))))
- ((stringp res)
- (if (eq t (compare-strings res 0 (length s2) s2 nil nil
- completion-ignore-case))
- (let ((rest (substring res (length s2))))
- (concat s1 (if quote-fun (funcall quote-fun rest) rest)))))
- ((eq action t)
- (let ((bounds (completion-boundaries str table pred "")))
- (if (>= (car bounds) (length s2))
- (if quote-fun (mapcar quote-fun res) res)
- (let ((re (concat "\\`"
- (regexp-quote (substring s2 (car bounds))))))
- (delq nil
- (mapcar (lambda (c)
- (if (string-match re c)
- (let ((str (substring c (match-end 0))))
- (if quote-fun
- (funcall quote-fun str) str))))
- res))))))
- ;; E.g. action=nil and it's the only completion.
- (res))))))
-
(defun comint-completion-file-name-table (string pred action)
(if (not (file-name-absolute-p string))
(completion-file-name-table string pred action)
res)))
(t (completion-file-name-table string pred action)))))
+(defvar comint-unquote-function #'comint--unquote-argument
+ "Function to use for completion of quoted data.
+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-unquote-function'.")
+
(defun comint--complete-file-name-data ()
"Return the completion data for file name at point."
(let* ((filesuffix (cond ((not comint-completion-addsuffix) "")
(filename (comint--match-partial-filename))
(filename-beg (if filename (match-beginning 0) (point)))
(filename-end (if filename (match-end 0) (point)))
- (unquoted (if filename (comint--unquote&expand-filename filename) ""))
(table
- (let ((prefixes (comint--common-quoted-suffix
- unquoted filename)))
- (comint--table-subvert
- #'comint-completion-file-name-table
- (cdr prefixes) (car prefixes)
- #'comint-quote-filename #'comint-unquote-filename))))
+ (completion-table-with-quoting
+ #'comint-completion-file-name-table
+ comint-unquote-function
+ comint-requote-function)))
(nconc
(list
filename-beg filename-end
(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)))
+ (minibuffer-p (window-minibuffer-p))
(suffix (cond ((not comint-completion-addsuffix) "")
((not (consp comint-completion-addsuffix)) " ")
(t (cdr 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."
(defun comint-dynamic-list-completions (completions &optional common-substring)
"Display a list of sorted COMPLETIONS.
-The meaning of COMMON-SUBSTRING is the same as in `display-completion-list'.
-Typing SPC flushes the completions buffer."
+Typing SPC flushes the completions buffer.
+
+The optional argument COMMON-SUBSTRING, if non-nil, should be a string
+specifying a common substring for adding the faces
+`completions-first-difference' and `completions-common-part' to
+the completions."
(let ((window (get-buffer-window "*Completions*" 0)))
(setq completions (sort completions 'string-lessp))
(if (and (eq last-command this-command)
(setq comint-dynamic-list-completions-config
(current-window-configuration))
(with-output-to-temp-buffer "*Completions*"
- (display-completion-list completions common-substring))
- (if (window-minibuffer-p (selected-window))
+ (display-completion-list
+ (completion-hilit-commonality completions (length common-substring))))
+ (if (window-minibuffer-p)
(minibuffer-message "Type space to flush; repeat completion command to scroll")
(message "Type space to flush; repeat completion command to scroll")))
;; Read the next key, to process SPC.
(let (key first)
(if (with-current-buffer (get-buffer "*Completions*")
- (set (make-local-variable 'comint-displayed-dynamic-completions)
- completions)
+ (setq-local comint-displayed-dynamic-completions
+ completions)
(setq key (read-key-sequence nil)
first (aref key 0))
(and (consp first) (consp (event-start first))
(eq (window-buffer (posn-window (event-start first)))
(get-buffer "*Completions*"))
- (eq (key-binding key) 'mouse-choose-completion)))
- ;; If the user does mouse-choose-completion with the mouse,
+ (memq (key-binding key)
+ '(mouse-choose-completion choose-completion))))
+ ;; If the user does choose-completion with the mouse,
;; execute the command, then delete the completion window.
(progn
(choose-completion first)
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")))
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.")
-
(defvar comint-redirect-subvert-readonly nil
"Non-nil means `comint-redirect' can insert into read-only buffers.
This works by binding `inhibit-read-only' around the insertion.
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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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)
+ (setq-local comint-redirect-original-mode-line-process mode-line-process)
+
+ (setq-local comint-redirect-output-buffer output-buffer)
- (make-local-variable 'comint-redirect-output-buffer)
- (setq comint-redirect-output-buffer output-buffer)
+ (setq-local comint-redirect-finished-regexp finished-regexp)
- (make-local-variable 'comint-redirect-finished-regexp)
- (setq comint-redirect-finished-regexp finished-regexp)
+ (setq-local comint-redirect-echo-input echo-input)
- (make-local-variable 'comint-redirect-echo-input)
- (setq comint-redirect-echo-input echo-input)
+ (setq-local comint-redirect-completed nil)
- (make-local-variable 'comint-redirect-completed)
- (setq comint-redirect-completed nil)
+ (setq-local comint-redirect-previous-input-string "")
(setq mode-line-process
(if mode-line-process
(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)
+ (remove-function (process-filter (get-buffer-process (current-buffer)))
+ #'comint-redirect-filter)
;; Restore the mode line
(setq mode-line-process comint-redirect-original-mode-line-process)
;; Set the completed flag
;; that it really occurs.
(defalias 'comint-redirect-remove-redirection 'comint-redirect-cleanup)
-(defun comint-redirect-filter (process input-string)
+(defun comint-redirect-filter (orig-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.
(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)))))
+ orig-filter
+ (funcall orig-filter process input-string)))))
(defun comint-redirect-preoutput-filter (input-string)
;; 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
comint-prompt-regexp ; Finished Regexp
echo) ; Echo input
- ;; Set the filter
- (setq comint-redirect-original-filter-function ; Save the old filter
- (process-filter proc))
- (set-process-filter proc 'comint-redirect-filter)
+ ;; Set the filter.
+ (add-function :around (process-filter proc) #'comint-redirect-filter)
;; Send the command
(process-send-string (current-buffer) (concat command "\n"))
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))
+ (while (and (null comint-redirect-completed)
+ (accept-process-output process)))
;; 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)
+ (while (and (not (eobp))
+ (re-search-forward regexp nil t))
(push (buffer-substring-no-properties
(match-beginning regexp-group)
(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))
-
+ (nreverse results))))
\f
;; Converting process modes to use comint mode
;; ===========================================================================
;; comint-mode will take care of it. The following example, from shell.el,
;; is typical:
;;
-;; (defvar shell-mode-map '())
-;; (cond ((not shell-mode-map)
-;; (setq shell-mode-map (copy-keymap comint-mode-map))
-;; (define-key shell-mode-map "\C-c\C-f" 'shell-forward-command)
-;; (define-key shell-mode-map "\C-c\C-b" 'shell-backward-command)
-;; (define-key shell-mode-map "\t" 'comint-dynamic-complete)
-;; (define-key shell-mode-map "\M-?"
-;; 'comint-dynamic-list-filename-completions)))
+;; (defvar shell-mode-map
+;; (let ((map (make-sparse-keymap)))
+;; (set-keymap-parent map comint-mode-map)
+;; (define-key map "\C-c\C-f" 'shell-forward-command)
+;; (define-key map "\C-c\C-b" 'shell-backward-command)
+;; (define-key map "\t" 'completion-at-point)
+;; (define-key map "\M-?"
+;; 'comint-dynamic-list-filename-completions)
+;; map))
;;
-;; (defun shell-mode ()
-;; (interactive)
-;; (comint-mode)
+;; (define-derived-mode shell-mode comint-mode "Shell"
+;; "Doc."
;; (setq comint-prompt-regexp shell-prompt-pattern)
-;; (setq major-mode 'shell-mode)
-;; (setq mode-name "Shell")
-;; (use-local-map shell-mode-map)
-;; (make-local-variable 'shell-directory-stack)
-;; (setq shell-directory-stack nil)
-;; (add-hook 'comint-input-filter-functions 'shell-directory-tracker)
-;; (run-mode-hooks 'shell-mode-hook))
+;; (setq-local shell-directory-stack nil)
+;; (add-hook 'comint-input-filter-functions 'shell-directory-tracker))
;;
;;
;; Completion for comint-mode users
HCoop / bpt / emacs.git / blobdiff