Merge from emacs-24; up to 2012-12-08T12:11:29Z!eliz@gnu.org
[bpt/emacs.git] / lisp / comint.el
index 0e614d4..42ac08a 100644 (file)
@@ -1,6 +1,6 @@
 ;;; comint.el --- general command interpreter in a window stuff -*- lexical-binding: t -*-
 
-;; Copyright (C) 1988, 1990, 1992-201 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 1990, 1992-2013 Free Software Foundation, Inc.
 
 ;; Author: Olin Shivers <shivers@cs.cmu.edu>
 ;;     Simon Marshall <simon@gnu.org>
 
 ;;; Code:
 
-(eval-when-compile (require 'cl))
 (require 'ring)
 (require 'ansi-color)
 (require 'regexp-opt)                   ;For regexp-opt-charset.
@@ -182,7 +181,7 @@ override the read-only-ness of comint prompts is to call
 `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 ()
@@ -1848,9 +1847,9 @@ Similarly for Soar, Scheme, etc."
           (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
@@ -2006,6 +2005,20 @@ Make backspaces delete the previous character."
            (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.
@@ -2075,8 +2088,7 @@ This function should be a pre-command hook."
   (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)))
@@ -2086,14 +2098,12 @@ This function should be a pre-command hook."
                (lambda (window)
                  (if (and (eq (window-buffer window) current)
                           (or (eq scroll t) (eq scroll 'all)))
-                     (progn
-                       (select-window window)
-                       (goto-char (point-max))
-                       (select-window selected))))
+                     (with-selected-window window
+                       (goto-char (point-max)))))
               nil t))))))
 
 (defvar follow-mode)
-(declare-function follow-comint-scroll-to-bottom "follow" ())
+(declare-function follow-comint-scroll-to-bottom "follow" (&optional window))
 
 (defun comint-postoutput-scroll-to-bottom (_string)
   "Go to the end of buffer in some or all windows showing it.
@@ -2110,19 +2120,31 @@ This function should be in the list `comint-output-filter-functions'."
         ((bound-and-true-p follow-mode)
          (follow-comint-scroll-to-bottom))
         (t
-         (let ((selected (selected-window)))
-           (dolist (w (get-buffer-window-list current nil t))
-             (select-window w)
-             (unwind-protect
-                 (progn
-                   (comint-adjust-point selected)
-                   ;; Optionally scroll to the bottom of the window.
-                   (and comint-scroll-show-maximum-output
-                        (eobp)
-                        (recenter (- -1 scroll-margin))))
-               (select-window selected))))))
+          (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."
@@ -2672,6 +2694,7 @@ 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))
@@ -2690,8 +2713,6 @@ updated using `comint-update-fence', if necessary."
        (let ((inhibit-read-only t))
          (kill-region beg end yank-handler)
          (comint-update-fence))))))
-(set-advertised-calling-convention 'comint-kill-region '(beg end) "23.3")
-
 \f
 ;; Support for source-file processing commands.
 ;;============================================================================
@@ -2771,11 +2792,8 @@ the load or compile."
     (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."
@@ -3034,7 +3052,7 @@ See `comint-word'."
 (defun comint--unquote-argument (str)
   (car (comint--unquote&requote-argument str)))
 (define-obsolete-function-alias 'comint--unquote&expand-filename
-  #'comint--unquote-argument "24.2")
+  #'comint--unquote-argument "24.3")
 
 (defun comint-match-partial-filename ()
   "Return the unquoted&expanded filename at point, or nil if none is found.
@@ -3057,11 +3075,11 @@ Magic characters are those in `comint-file-name-quote-list'."
 
 (defun comint-unquote-filename (filename)
   "Return FILENAME with quoted characters unquoted."
+  (declare (obsolete nil "24.3"))
   (if (null comint-file-name-quote-list)
       filename
     (save-match-data
       (replace-regexp-in-string "\\\\\\(.\\)" "\\1" filename t))))
-(make-obsolete 'comint-unquote-filename nil "24.2")
 
 (defun comint--requote-argument (upos qstr)
   ;; See `completion-table-with-quoting'.
@@ -3149,8 +3167,8 @@ See `completion-table-with-quoting' and `comint-unquote-function'.")
           (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)))))))))
@@ -3158,10 +3176,9 @@ See `completion-table-with-quoting' and `comint-unquote-function'.")
 (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.
@@ -3192,6 +3209,7 @@ Return `partial' if completed as far as possible.
 Return `listed' if a completion listing was shown.
 
 See also `comint-dynamic-complete-filename'."
+  (declare (obsolete completion-in-region "24.1"))
   (let* ((completion-ignore-case (memq system-type '(ms-dos windows-nt cygwin)))
         (minibuffer-p (window-minibuffer-p (selected-window)))
         (suffix (cond ((not comint-completion-addsuffix) "")
@@ -3234,8 +3252,6 @@ See also `comint-dynamic-complete-filename'."
                    (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."
@@ -3486,6 +3502,11 @@ 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
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -3523,6 +3544,9 @@ and does not normally need to be invoked by the end user or programmer."
     (make-local-variable 'comint-redirect-completed)
     (setq comint-redirect-completed nil)
 
+    (make-local-variable 'comint-redirect-previous-input-string)
+    (setq comint-redirect-previous-input-string "")
+
     (setq mode-line-process
          (if mode-line-process
              (list (concat (elt mode-line-process 0) " Redirection"))
@@ -3531,6 +3555,8 @@ and does not normally need to be invoked by the end user or programmer."
 (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)
@@ -3612,18 +3638,21 @@ This function does not need to be invoked by the end user."
 
     ;; 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