* comint.el (comint-redirect-results-list-from-process): Fix
[bpt/emacs.git] / lisp / comint.el
index f3450e3..c1a1c56 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>
   "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.
@@ -213,7 +214,7 @@ This mirrors the optional behavior of tcsh (its autoexpand and histlist).
 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)
@@ -350,7 +351,7 @@ This variable is buffer-local."
     '("password" "Password" "passphrase" "Passphrase"
       "pass phrase" "Pass phrase" "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"
@@ -371,7 +372,7 @@ text matching `comint-prompt-regexp', depending on the value of
   '(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.")
 
@@ -616,7 +617,7 @@ Input ring expansion is controlled by the variable `comint-input-autoexpand',
 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
@@ -631,10 +632,10 @@ to continue it.
 
 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))
+  (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-overlay)
   (make-local-variable 'comint-prompt-regexp)        ; Don't set; default
   (make-local-variable 'comint-input-ring-size)      ; ...to global val.
@@ -676,17 +677,15 @@ Entry to this mode runs the hooks on `comint-mode-hook'."
   (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.
@@ -778,8 +777,7 @@ series of processes in the same Comint buffer.  The hook
               (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))
@@ -1191,7 +1189,9 @@ If N is negative, find the next or Nth next match."
          (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)))))
 
@@ -1414,8 +1414,7 @@ If nil, Isearch operates on the whole comint buffer."
   (let ((comint-history-isearch t))
     (isearch-backward-regexp)))
 
-(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.
@@ -1425,14 +1424,14 @@ Intended to be added to `isearch-mode-hook' in `comint-mode'."
                 ;; 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 ()
@@ -1521,7 +1520,7 @@ Intended to be added to `isearch-mode-hook' in `comint-mode'."
 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).
@@ -1540,8 +1539,11 @@ Otherwise, it displays the standard Isearch message returned from
       (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.
@@ -1805,28 +1807,28 @@ Similarly for Soar, Scheme, etc."
                               (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)
 
@@ -1847,9 +1849,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
@@ -1909,11 +1911,12 @@ See `comint-carriage-motion' for details.")
 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)))))
+    (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))))))
 
 (defun comint-carriage-motion (start end)
   "Interpret carriage control characters in the region from START to END.
@@ -2036,11 +2039,10 @@ Make backspaces delete the previous character."
            (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)
@@ -2051,16 +2053,16 @@ Make backspaces delete the previous character."
            ;; 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))))
+                (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
@@ -2585,10 +2587,8 @@ text matching `comint-prompt-regexp'."
   (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
@@ -2655,16 +2655,16 @@ read-only property of `fence', unless it already is read-only.
 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.
@@ -2892,7 +2892,7 @@ its response can be seen."
 ;; 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.
@@ -2901,7 +2901,7 @@ its response can be seen."
 
 ;; 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)))
 ;;
@@ -3315,8 +3315,8 @@ Typing SPC flushes the completions buffer."
     ;; 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))
@@ -3491,11 +3491,6 @@ buffer.  The idea is that this regular expression should match a prompt
 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.
@@ -3529,23 +3524,17 @@ This function is called by `comint-redirect-send-command-to-process',
 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)
 
-    (make-local-variable 'comint-redirect-output-buffer)
-    (setq comint-redirect-output-buffer output-buffer)
+    (setq-local comint-redirect-output-buffer output-buffer)
 
-    (make-local-variable 'comint-redirect-finished-regexp)
-    (setq comint-redirect-finished-regexp finished-regexp)
+    (setq-local comint-redirect-finished-regexp finished-regexp)
 
-    (make-local-variable 'comint-redirect-echo-input)
-    (setq comint-redirect-echo-input echo-input)
+    (setq-local comint-redirect-echo-input echo-input)
 
-    (make-local-variable 'comint-redirect-completed)
-    (setq comint-redirect-completed nil)
+    (setq-local comint-redirect-completed nil)
 
-    (make-local-variable 'comint-redirect-previous-input-string)
-    (setq comint-redirect-previous-input-string "")
+    (setq-local comint-redirect-previous-input-string "")
 
     (setq mode-line-process
          (if mode-line-process
@@ -3558,8 +3547,8 @@ and does not normally need to be invoked by the end user or programmer."
   ;; 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
@@ -3569,7 +3558,7 @@ and does not normally need to be invoked by the end user or programmer."
 ;; 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.
@@ -3583,9 +3572,8 @@ end user."
         (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)
@@ -3701,10 +3689,8 @@ If NO-DISPLAY is non-nil, do not show the output buffer."
        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"))
@@ -3739,8 +3725,8 @@ 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))
@@ -3812,7 +3798,7 @@ REGEXP-GROUP is the regular expression group in REGEXP to use."
 ;;        (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 "\t" 'completion-at-point)
 ;;        (define-key shell-mode-map "\M-?"
 ;;          'comint-dynamic-list-filename-completions)))
 ;;
@@ -3823,8 +3809,7 @@ REGEXP-GROUP is the regular expression group in REGEXP to use."
 ;;   (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)
+;;   (setq-local shell-directory-stack nil)
 ;;   (add-hook 'comint-input-filter-functions 'shell-directory-tracker)
 ;;   (run-mode-hooks 'shell-mode-hook))
 ;;