X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/2dcc73bca70096848e4f51530f8084973c19f530..d7aff0d6929c16d15992304dd44c5f528df8f895:/lisp/comint.el

diff --git a/lisp/comint.el b/lisp/comint.el
index d5d95f8cbc..8e1b2105de 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -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.
@@ -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"
@@ -631,11 +632,11 @@ 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))
-  (make-local-variable 'comint-last-prompt-overlay)
+  (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)
   (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)
@@ -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 ()
@@ -1540,8 +1539,11 @@ the function `isearch-message'."
       (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.
@@ -1560,8 +1562,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.
@@ -1900,21 +1903,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.
@@ -2061,20 +2067,15 @@ Make backspaces delete the previous character."
                   (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))))
-
+	      (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 (car comint-last-prompt)
+				   (cdr comint-last-prompt)
+				   '(font-lock-face comint-highlight-prompt)))
 	    (goto-char saved-point)))))))
 
 (defun comint-preinput-scroll-to-bottom ()
@@ -2294,7 +2295,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)))))
@@ -2585,10 +2586,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
@@ -2680,7 +2679,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 +2693,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 +2707,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 +3106,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 +3209,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,15 +3306,15 @@ 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")))
 
     ;; 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))
@@ -3524,23 +3522,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
@@ -3564,7 +3556,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.
@@ -3578,9 +3570,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)
@@ -3697,7 +3688,7 @@ If NO-DISPLAY is non-nil, do not show the output buffer."
        echo)                            ; Echo input
 
       ;; Set the filter.
-      (add-function :override (process-filter proc) #'comint-redirect-filter)
+      (add-function :around (process-filter proc) #'comint-redirect-filter)
 
       ;; Send the command
       (process-send-string (current-buffer) (concat command "\n"))
@@ -3732,20 +3723,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
 ;; ===========================================================================
@@ -3800,26 +3792,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)
-;;   (make-local-variable 'shell-directory-stack)
-;;   (setq shell-directory-stack nil)
-;;   (add-hook 'comint-input-filter-functions 'shell-directory-tracker)
-;;   (run-mode-hooks 'shell-mode-hook))
+;;   (setq-local shell-directory-stack nil)
+;;   (add-hook 'comint-input-filter-functions 'shell-directory-tracker))
 ;;
 ;;
 ;; Completion for comint-mode users