Merge from emacs-24; up to 2014-04-25T10:35:01Z!michael.albinus@gmx.de
[bpt/emacs.git] / lisp / comint.el
index 217bd4e..da37827 100644 (file)
@@ -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 <shivers@cs.cmu.edu>
 ;;     Simon Marshall <simon@gnu.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
 ;; Keywords: processes
 ;; Package: emacs
 
@@ -186,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',
@@ -347,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)
 
@@ -460,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)
@@ -636,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)
@@ -748,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))
@@ -1209,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
@@ -1218,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.
@@ -1406,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)
 
@@ -1562,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.
@@ -1767,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")
@@ -1902,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.
@@ -2055,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 ()
@@ -2296,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)))))
@@ -2317,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)))
@@ -2680,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
@@ -2694,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))
@@ -2709,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))))))
 \f
 ;; Support for source-file processing commands.
@@ -3108,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)))))
@@ -3211,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))))
@@ -3275,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)
@@ -3307,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")))
 
@@ -3322,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)
@@ -3631,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
@@ -3794,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