X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/bd358779861f265a7acff31ead40172735af693e..5c92e00da487df29752ec5dc21bc59fca2598626:/lisp/comint.el diff --git a/lisp/comint.el b/lisp/comint.el index 592f63fa68..7407392e02 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -1,6 +1,6 @@ ;;; comint.el --- general command interpreter in a window stuff -*- lexical-binding: t -*- -;; Copyright (C) 1988, 1990, 1992-2013 Free Software Foundation, Inc. +;; Copyright (C) 1988, 1990, 1992-2014 Free Software Foundation, Inc. ;; Author: Olin Shivers ;; Simon Marshall @@ -460,10 +460,10 @@ executed once when the buffer is created." (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) @@ -636,7 +636,7 @@ Entry to this mode runs the hooks on `comint-mode-hook'." (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-overlay) + (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) @@ -752,6 +752,7 @@ See `make-comint' and `comint-exec'." (let ((name (file-name-nondirectory program))) (switch-to-buffer (make-comint name program)) (run-hooks (intern-soft (concat "comint-" name "-hook"))))) +(put 'comint-run 'interactive-only 'make-comint) (defun comint-exec (buffer name command startfile switches) "Start up a process named NAME in buffer BUFFER for Comint modes. @@ -1209,8 +1210,9 @@ If N is negative, find the previous or Nth previous match." 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 @@ -1218,9 +1220,10 @@ If N is negative, search forwards for the -Nth following match." (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. @@ -1406,13 +1409,13 @@ If nil, Isearch operates on the whole comint buffer." "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-local comint-history-isearch-message-overlay nil) @@ -1562,8 +1565,9 @@ or to the last history element for a backward search." "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. @@ -1902,21 +1906,24 @@ either globally or locally.") "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)) - (with-silent-modifications - (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. @@ -2055,28 +2062,22 @@ Make backspaces delete the previous character." (let ((prompt-start (save-excursion (forward-line 0) (point))) (inhibit-read-only t)) (when comint-prompt-read-only - (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 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 () @@ -2296,7 +2297,7 @@ Security bug: your string can still be temporarily recovered with (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))))) @@ -2680,7 +2681,7 @@ if necessary." (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 @@ -2694,7 +2695,6 @@ prompts should stay at the beginning of a line. If this is not 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)) @@ -2709,9 +2709,9 @@ updated using `comint-update-fence', if necessary." (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)))))) ;; Support for source-file processing commands. @@ -3108,7 +3108,7 @@ completions listing is dependent on the value of `comint-completion-autolist'. 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))))) @@ -3211,7 +3211,7 @@ 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)))) @@ -3308,7 +3308,7 @@ Typing SPC flushes the completions buffer." (current-window-configuration)) (with-output-to-temp-buffer "*Completions*" (display-completion-list completions common-substring)) - (if (window-minibuffer-p (selected-window)) + (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"))) @@ -3725,20 +3725,21 @@ REGEXP-GROUP is the regular expression group in REGEXP to use." 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))) + (nreverse results)))) ;; Converting process modes to use comint mode ;; =========================================================================== @@ -3793,25 +3794,21 @@ REGEXP-GROUP is the regular expression group in REGEXP to use." ;; 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" 'completion-at-point) -;; (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) ;; (setq-local shell-directory-stack nil) -;; (add-hook 'comint-input-filter-functions 'shell-directory-tracker) -;; (run-mode-hooks 'shell-mode-hook)) +;; (add-hook 'comint-input-filter-functions 'shell-directory-tracker)) ;; ;; ;; Completion for comint-mode users