]> code.delx.au - gnu-emacs/blobdiff - lisp/comint.el
Fix race conditions with MS-Windows lock files by using _sopen.
[gnu-emacs] / lisp / comint.el
index db0f5b8b46065fbc9132968784bef77c342bf314..21bd732b43c4f1cfb2bbc1ade382987afbb536f9 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 ()
@@ -1441,7 +1440,7 @@ Intended to be added to `isearch-mode-hook' in `comint-mode'."
   (if comint-history-isearch-message-overlay
       (delete-overlay comint-history-isearch-message-overlay))
   (setq isearch-message-prefix-add nil)
-  (setq isearch-search-fun-function nil)
+  (setq isearch-search-fun-function 'isearch-search-fun-default)
   (setq isearch-message-function nil)
   (setq isearch-wrap-function nil)
   (setq isearch-push-state-function nil)
@@ -1463,74 +1462,66 @@ Intended to be added to `isearch-mode-hook' in `comint-mode'."
 
 (defun comint-history-isearch-search ()
   "Return the proper search function, for Isearch in input history."
-  (cond
-   (isearch-word
-    (if isearch-forward 'word-search-forward 'word-search-backward))
-   (t
-    (lambda (string bound noerror)
-      (let ((search-fun
-            ;; Use standard functions to search within comint text
-             (cond
-              (isearch-regexp
-               (if isearch-forward 're-search-forward 're-search-backward))
-              (t
-               (if isearch-forward 'search-forward 'search-backward))))
-           found)
-       ;; Avoid lazy-highlighting matches in the comint prompt and in the
-       ;; output when searching forward.  Lazy-highlight calls this lambda
-       ;; with the bound arg, so skip the prompt and the output.
-       (if (and bound isearch-forward (not (comint-after-pmark-p)))
-           (goto-char (process-mark (get-buffer-process (current-buffer)))))
-        (or
-        ;; 1. First try searching in the initial comint text
-        (funcall search-fun string
-                 (if isearch-forward bound (comint-line-beginning-position))
-                 noerror)
-        ;; 2. If the above search fails, start putting next/prev history
-        ;; elements in the comint successively, and search the string
-        ;; in them.  Do this only when bound is nil (i.e. not while
-        ;; lazy-highlighting search strings in the current comint text).
-        (unless bound
-          (condition-case nil
-              (progn
-                (while (not found)
-                  (cond (isearch-forward
-                         ;; Signal an error here explicitly, because
-                         ;; `comint-next-input' doesn't signal an error.
-                         (when (null comint-input-ring-index)
-                           (error "End of history; no next item"))
-                         (comint-next-input 1)
-                         (goto-char (comint-line-beginning-position)))
-                        (t
-                         ;; Signal an error here explicitly, because
-                         ;; `comint-previous-input' doesn't signal an error.
-                         (when (eq comint-input-ring-index
-                                   (1- (ring-length comint-input-ring)))
-                           (error "Beginning of history; no preceding item"))
-                         (comint-previous-input 1)
-                         (goto-char (point-max))))
-                  (setq isearch-barrier (point) isearch-opoint (point))
-                  ;; After putting the next/prev history element, search
-                  ;; the string in them again, until comint-next-input
-                  ;; or comint-previous-input raises an error at the
-                  ;; beginning/end of history.
-                  (setq found (funcall search-fun string
-                                       (unless isearch-forward
-                                         ;; For backward search, don't search
-                                         ;; in the comint prompt
-                                         (comint-line-beginning-position))
-                                       noerror)))
-                ;; Return point of the new search result
-                (point))
-            ;; Return nil on the error "no next/preceding item"
-            (error nil)))))))))
+  (lambda (string bound noerror)
+    (let ((search-fun
+          ;; Use standard functions to search within comint text
+          (isearch-search-fun-default))
+         found)
+      ;; Avoid lazy-highlighting matches in the comint prompt and in the
+      ;; output when searching forward.  Lazy-highlight calls this lambda
+      ;; with the bound arg, so skip the prompt and the output.
+      (if (and bound isearch-forward (not (comint-after-pmark-p)))
+         (goto-char (process-mark (get-buffer-process (current-buffer)))))
+      (or
+       ;; 1. First try searching in the initial comint text
+       (funcall search-fun string
+               (if isearch-forward bound (comint-line-beginning-position))
+               noerror)
+       ;; 2. If the above search fails, start putting next/prev history
+       ;; elements in the comint successively, and search the string
+       ;; in them.  Do this only when bound is nil (i.e. not while
+       ;; lazy-highlighting search strings in the current comint text).
+       (unless bound
+        (condition-case nil
+            (progn
+              (while (not found)
+                (cond (isearch-forward
+                       ;; Signal an error here explicitly, because
+                       ;; `comint-next-input' doesn't signal an error.
+                       (when (null comint-input-ring-index)
+                         (error "End of history; no next item"))
+                       (comint-next-input 1)
+                       (goto-char (comint-line-beginning-position)))
+                      (t
+                       ;; Signal an error here explicitly, because
+                       ;; `comint-previous-input' doesn't signal an error.
+                       (when (eq comint-input-ring-index
+                                 (1- (ring-length comint-input-ring)))
+                         (error "Beginning of history; no preceding item"))
+                       (comint-previous-input 1)
+                       (goto-char (point-max))))
+                (setq isearch-barrier (point) isearch-opoint (point))
+                ;; After putting the next/prev history element, search
+                ;; the string in them again, until comint-next-input
+                ;; or comint-previous-input raises an error at the
+                ;; beginning/end of history.
+                (setq found (funcall search-fun string
+                                     (unless isearch-forward
+                                       ;; For backward search, don't search
+                                       ;; in the comint prompt
+                                       (comint-line-beginning-position))
+                                     noerror)))
+              ;; Return point of the new search result
+              (point))
+          ;; Return nil on the error "no next/preceding item"
+          (error nil)))))))
 
 (defun comint-history-isearch-message (&optional c-q-hack ellipsis)
   "Display the input history search prompt.
 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).
@@ -1556,14 +1547,13 @@ Otherwise, it displays the standard Isearch message returned from
   "Wrap the input history search when search fails.
 Move point to the first history element for a forward search,
 or to the last history element for a backward search."
-  (unless isearch-word
-    ;; When `comint-history-isearch-search' fails on reaching the
-    ;; beginning/end of the history, wrap the search to the first/last
-    ;; input history element.
-    (if isearch-forward
-       (comint-goto-input (1- (ring-length comint-input-ring)))
-      (comint-goto-input nil))
-    (setq isearch-success t))
+  ;; When `comint-history-isearch-search' fails on reaching the
+  ;; beginning/end of the history, wrap the search to the first/last
+  ;; input history element.
+  (if isearch-forward
+      (comint-goto-input (1- (ring-length comint-input-ring)))
+    (comint-goto-input nil))
+  (setq isearch-success t)
   (goto-char (if isearch-forward (comint-line-beginning-position) (point-max))))
 
 (defun comint-history-isearch-push-state ()
@@ -1857,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
@@ -2015,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.
@@ -2084,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)))
@@ -2095,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.
@@ -2119,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."
@@ -2681,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))
@@ -2699,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.
 ;;============================================================================
@@ -2780,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."
@@ -2969,7 +2978,7 @@ This is a good thing to set in mode hooks.")
 Word constituents are considered to be those in WORD-CHARS, which is like the
 inside of a \"[...]\" (see `skip-chars-forward'), plus all non-ASCII characters."
   ;; FIXME: Need to handle "..." and '...' quoting in shell.el!
-  ;; This should be combined with pomplete-parsing somehow.
+  ;; This should be combined with completion parsing somehow.
   (save-excursion
     (let ((here (point))
          giveup)
@@ -3043,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.
@@ -3066,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'.
@@ -3158,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)))))))))
@@ -3167,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.
@@ -3201,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) "")
@@ -3243,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."
@@ -3495,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
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -3532,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"))
@@ -3540,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)
@@ -3621,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