X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/d14365f9411ab4b20db6c455aa9cf24ce6a0bcb1..51721edc6ba92f9c7cb6a2daab45bb538a696f3d:/lisp/comint.el?ds=sidebyside diff --git a/lisp/comint.el b/lisp/comint.el index c796f4fda3..da3782717c 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -1,10 +1,10 @@ ;;; 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 -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: processes ;; Package: emacs @@ -148,10 +148,11 @@ "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. @@ -185,8 +186,8 @@ 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', @@ -346,14 +347,12 @@ This variable is buffer-local." "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) @@ -459,10 +458,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) @@ -635,7 +634,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) @@ -747,6 +746,7 @@ The buffer name is made by surrounding the file name of PROGRAM with `*'s. 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)) @@ -1189,7 +1189,8 @@ If N is negative, find the next or Nth next match." (funcall comint-get-old-input))) (setq comint-input-ring-index pos) (unless isearch-mode - (message "History item: %d" (1+ pos))) + (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))))) @@ -1207,8 +1208,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 @@ -1216,9 +1218,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. @@ -1404,13 +1407,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) @@ -1560,8 +1563,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. @@ -1765,6 +1769,12 @@ If the Comint is Lucid Common Lisp, 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) (user-error "Current buffer has no process") @@ -1900,21 +1910,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. @@ -2053,28 +2066,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 () @@ -2294,7 +2301,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))))) @@ -2315,7 +2322,8 @@ process if STRING contains a password prompt defined by `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))) @@ -2678,7 +2686,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 @@ -2692,7 +2700,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)) @@ -2707,9 +2714,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. @@ -3106,7 +3113,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))))) @@ -3209,7 +3216,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)))) @@ -3273,8 +3280,12 @@ See also `comint-dynamic-complete-filename'." (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) @@ -3305,8 +3316,9 @@ Typing SPC flushes the completions buffer." (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"))) @@ -3320,8 +3332,9 @@ Typing SPC flushes the completions buffer." (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) @@ -3629,8 +3642,8 @@ This function does not need to be invoked by the end user." ;; 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 - (concat comint-redirect-previous-input-string + (and (string-match comint-redirect-finished-regexp + (concat comint-redirect-previous-input-string input-string)) (progn (and comint-redirect-verbose @@ -3723,20 +3736,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 ;; =========================================================================== @@ -3791,25 +3805,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