comparison lisp/comint.el @ 92765:8a7561cc8360

Fix up indentation and comment style. Remove `function'.

92764:79b4e32b9b79

  :group 'comint)

;; Autoload is necessary for Custom to recognize old alias.
;;;###autoload
(define-obsolete-variable-alias 'comint-use-prompt-regexp-instead-of-fields
    'comint-use-prompt-regexp "22.1")

(defcustom comint-mode-hook nil
  "Hook run upon entry to `comint-mode'.
This is run before the process is cranked up."
  :type 'hook

  ;; what the original problem was.  If there are problems with point
  ;; not going to the end, consider re-enabling this.
  ;; http://lists.gnu.org/archive/html/emacs-devel/2007-08/msg00827.html
  ;;
  ;; This makes it really work to keep point at the bottom.
;;;  (make-local-variable 'scroll-conservatively)
;;;  (setq scroll-conservatively 10000)
  (add-hook 'pre-command-hook 'comint-preinput-scroll-to-bottom t t)
  (make-local-variable 'comint-ptyp)
  (make-local-variable 'comint-process-echoes)
  (make-local-variable 'comint-file-name-chars)
  (make-local-variable 'comint-file-name-quote-list)

	     (goto-char (point-max))
	     (insert-file-contents startfile)
	     (setq startfile (buffer-substring (point) (point-max)))
	     (delete-region (point) (point-max))
	     (comint-send-string proc startfile)))
    (run-hooks 'comint-exec-hook)
    buffer)))

;; This auxiliary function cranks up the process for comint-exec in
;; the appropriate environment.

(defun comint-exec-1 (name buffer command switches)

(defvar comint-dynamic-list-input-ring-window-conf)

(defun comint-dynamic-list-input-ring-select ()
  "Choose the input history entry that point is in or next to."
  (interactive)
  (let (beg end completion (buffer completion-reference-buffer)
	(base-size completion-base-size))
    (if (and (not (eobp)) (get-text-property (point) 'mouse-face))
	(setq end (point) beg (1+ (point))))
    (if (and (not (bobp)) (get-text-property (1- (point)) 'mouse-face))
	(setq end (1- (point)) beg (point)))
    (if (null beg)

Similarly for Soar, Scheme, etc."
  (interactive)
  ;; Note that the input string does not include its terminal newline.
  (let ((proc (get-buffer-process (current-buffer))))
    (if (not proc) (error "Current buffer has no process")
        (widen)
	(let* ((pmark (process-mark proc))
	       (intxt (if (>= (point) (marker-position pmark))
			  (progn (if comint-eol-on-send (end-of-line))
				 (buffer-substring pmark (point)))
			(let ((copy (funcall comint-get-old-input)))
			  (goto-char pmark)
			  (insert copy)
			  copy)))
	       (input (if (not (eq comint-input-autoexpand 'input))
			  ;; Just whatever's already there
			  intxt
			;; Expand and leave it visible in buffer
			(comint-replace-by-expanded-history t pmark)
			(buffer-substring pmark (point))))
	       (history (if (not (eq comint-input-autoexpand 'history))
			    input
			  ;; This is messy 'cos ultimately the original
			  ;; functions used do insertion, rather than return
			  ;; strings.  We have to expand, then insert back.
			  (comint-replace-by-expanded-history t pmark)
			  (let ((copy (buffer-substring pmark (point)))
				(start (point)))
			    (insert input)
			    (delete-region pmark start)
			    copy))))

	  (unless no-newline
	    (insert ?\n))

	  (comint-add-to-input-history history)

	  (run-hook-with-args 'comint-input-filter-functions
			      (if no-newline input
				(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"
		   field 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)

	  (setq comint-save-input-ring-index comint-input-ring-index)
	  (setq comint-input-ring-index nil)
	  ;; Update the markers before we send the input
	  ;; in case we get output amidst sending the input.
	  (set-marker comint-last-input-start pmark)
	  (set-marker comint-last-input-end (point))
	  (set-marker (process-mark proc) (point))
	  ;; clear the "accumulation" marker
	  (set-marker comint-accum-marker nil)
	  (let ((comint-input-sender-no-newline no-newline))
	    (funcall comint-input-sender proc input))

	  ;; Optionally delete echoed input (after checking it).
 	  (when (and comint-process-echoes (not artificial))
	    (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)
			     (point-max))
			  (zerop
			   (compare-buffer-substrings
			    nil comint-last-input-start
			    (- (point-max) echo-len)
			    ;; Above difference is equivalent to
			    ;; (+ comint-last-input-start
			    ;;    (- (point-max) comint-last-input-end))
			    nil comint-last-input-end (point-max)))))
	      (if (and
		   (<= (+ comint-last-input-end echo-len)
		       (point-max))
		   (zerop
		    (compare-buffer-substrings
		     nil comint-last-input-start comint-last-input-end
		     nil comint-last-input-end
		     (+ comint-last-input-end echo-len))))
		  ;; Certain parts of the text to be deleted may have
		  ;; been mistaken for prompts.  We have to prevent
		  ;; problems when `comint-prompt-read-only' is non-nil.
		  (let ((inhibit-read-only t))
		    (delete-region comint-last-input-end
				   (+ comint-last-input-end echo-len))
		    (when comint-prompt-read-only
		      (save-excursion
			(goto-char comint-last-input-end)
			(comint-update-fence)))))))

	  ;; This used to call comint-output-filter-functions,
	  ;; but that scrolled the buffer in undesirable ways.
	  (run-hook-with-args 'comint-output-filter-functions "")))))

(defvar comint-preoutput-filter-functions nil
  "List of functions to call before inserting Comint output into the buffer.
Each function gets one argument, a string containing the text received
from the subprocess.  It should return the string to insert, perhaps

	     (scroll comint-scroll-to-bottom-on-input))
	(if (and process (< (point) (process-mark process)))
	    (if (eq scroll 'this)
		(goto-char (point-max))
	      (walk-windows
	       (function (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)))))
	       nil t))))))

(defun comint-postoutput-scroll-to-bottom (string)
  "Go to the end of buffer in some or all windows showing it.
Does not scroll if the current line is the last line in the buffer.

	 (process (get-buffer-process current))
	 (scroll comint-move-point-for-output))
    (unwind-protect
	(if process
	    (walk-windows
	     (function (lambda (window)
	       (if (eq (window-buffer window) current)
		   (progn
		     (select-window window)
		     (if (and (< (point) (process-mark process))
			      (or (eq scroll t) (eq scroll 'all)
				  ;; Maybe user wants point to jump to end.
				  (and (eq scroll 'this) (eq selected window))
				  (and (eq scroll 'others) (not (eq selected window)))
				  ;; If point was at the end, keep it at end.
				  (and (marker-position comint-last-output-start)
				       (>= (point) comint-last-output-start))))
			 (goto-char (process-mark process)))
		     ;; Optionally scroll so that the text
		     ;; ends at the bottom of the window.
		     (if (and comint-scroll-show-maximum-output
			      (= (point) (point-max)))
			 (save-excursion
			   (goto-char (point-max))
			   (recenter (- -1 scroll-margin))))
		     (select-window selected)))))
	     nil t))
      (set-buffer current))))

(defun comint-truncate-buffer (&optional string)
  "Truncate the buffer to `comint-buffer-maximum-size'.

				  (buffer-substring pmark (point))))
	(delete-region pmark (point))))
    ;; Output message and put back prompt
    (comint-output-filter proc replacement)))
(define-obsolete-function-alias 'comint-kill-output
    'comint-delete-output "21.1")

(defun comint-write-output (filename &optional append mustbenew)
  "Write output from interpreter since last input to FILENAME.
Any prompt at the end of the output is not written.

This command also kills the pending input
between the process mark and point."
  (interactive)
  (comint-skip-input)
  (interrupt-process nil comint-ptyp)
;;  (process-send-string nil "\n")
)

(defun comint-kill-subjob ()
  "Send kill signal to the current subjob.
This command also kills the pending input
between the process mark and point."

		       (condition-case ()
			   (file-exists-p stringfile)
			 (error nil))
		       (not (file-directory-p stringfile))))
	 (defdir  (if sfile-p (file-name-directory stringfile)
		      (car def)))
	 (deffile (if sfile-p (file-name-nondirectory stringfile)
		      (cdr def)))
	 (ans (read-file-name (if deffile (format "%s(default %s) "
						  prompt    deffile)
				  prompt)
			      defdir
			      (concat defdir deffile)
			      mustmatch-p)))
    (list (expand-file-name (substitute-in-file-name ans)))))

Magic characters are those in `comint-file-name-quote-list'."
  (if (null comint-file-name-quote-list)
      filename
    (let ((regexp
	   (format "[%s]"
	    (mapconcat 'char-to-string comint-file-name-quote-list ""))))
      (save-match-data
	(let ((i 0))
	  (while (string-match regexp filename i)
	    (setq filename (replace-match "\\\\\\&" nil nil filename))
	    (setq i (1+ (match-end 0)))))

INPUT-STRING is the input from the Comint process.

This function does not need to be invoked by the end user."
  (let ((output-buffer-list
	 (if (listp comint-redirect-output-buffer)
	    comint-redirect-output-buffer
	   (list comint-redirect-output-buffer)))
	(filtered-input-string input-string))

    ;; If there are any filter functions, give them a chance to modify the string
    (let ((functions comint-redirect-filter-functions))

	   (save-excursion
	     (goto-char (point-max))
	     (or (re-search-backward comint-prompt-regexp nil t)
		 (error "No prompt found or `comint-prompt-regexp' not set properly"))))

    ;;;;;;;;;;;;;;;;;;;;;
      ;; Set up for redirection
    ;;;;;;;;;;;;;;;;;;;;;
      (comint-redirect-setup
       ;; Output Buffer
       output-buffer
       ;; Comint Buffer
       (current-buffer)
       ;; Finished Regexp
       comint-prompt-regexp
       ;; Echo input
       echo)

    ;;;;;;;;;;;;;;;;;;;;;
      ;; Set the filter
    ;;;;;;;;;;;;;;;;;;;;;
      ;; Save the old filter
      (setq comint-redirect-original-filter-function
	    (process-filter proc))
      (set-process-filter proc 'comint-redirect-filter)

    ;;;;;;;;;;;;;;;;;;;;;
      ;; Send the command
    ;;;;;;;;;;;;;;;;;;;;;
      (process-send-string
       (current-buffer)
       (concat command "\n"))

    ;;;;;;;;;;;;;;;;;;;;;
      ;; Show the output
    ;;;;;;;;;;;;;;;;;;;;;
      (or no-display
	  (display-buffer
	   (get-buffer-create
	    (if (listp output-buffer)
		(car output-buffer)

		     (match-beginning regexp-group)
		     (match-end regexp-group))
		    results)))
      results)))

(mapc (lambda (x)
	(add-to-list 'debug-ignored-errors x))
      '("^Not at command line$"
	"^Empty input ring$"
	"^No history$"
	"^Not found$"			; Too common?
	"^Current buffer has no process$"))


;; Converting process modes to use comint mode
;; ===========================================================================
;; The code in the Emacs 19 distribution has all been modified to use comint

92765:8a7561cc8360

  :group 'comint)

;; Autoload is necessary for Custom to recognize old alias.
;;;###autoload
(define-obsolete-variable-alias 'comint-use-prompt-regexp-instead-of-fields
  'comint-use-prompt-regexp "22.1")

(defcustom comint-mode-hook nil
  "Hook run upon entry to `comint-mode'.
This is run before the process is cranked up."
  :type 'hook

  ;; what the original problem was.  If there are problems with point
  ;; not going to the end, consider re-enabling this.
  ;; http://lists.gnu.org/archive/html/emacs-devel/2007-08/msg00827.html
  ;;
  ;; This makes it really work to keep point at the bottom.
  ;; (make-local-variable 'scroll-conservatively)
  ;; (setq scroll-conservatively 10000)
  (add-hook 'pre-command-hook 'comint-preinput-scroll-to-bottom t t)
  (make-local-variable 'comint-ptyp)
  (make-local-variable 'comint-process-echoes)
  (make-local-variable 'comint-file-name-chars)
  (make-local-variable 'comint-file-name-quote-list)

	     (goto-char (point-max))
	     (insert-file-contents startfile)
	     (setq startfile (buffer-substring (point) (point-max)))
	     (delete-region (point) (point-max))
	     (comint-send-string proc startfile)))
      (run-hooks 'comint-exec-hook)
      buffer)))

;; This auxiliary function cranks up the process for comint-exec in
;; the appropriate environment.

(defun comint-exec-1 (name buffer command switches)

(defvar comint-dynamic-list-input-ring-window-conf)

(defun comint-dynamic-list-input-ring-select ()
  "Choose the input history entry that point is in or next to."
  (interactive)
  (let ((buffer completion-reference-buffer)
        (base-size completion-base-size)
        beg end completion)
    (if (and (not (eobp)) (get-text-property (point) 'mouse-face))
	(setq end (point) beg (1+ (point))))
    (if (and (not (bobp)) (get-text-property (1- (point)) 'mouse-face))
	(setq end (1- (point)) beg (point)))
    (if (null beg)

Similarly for Soar, Scheme, etc."
  (interactive)
  ;; Note that the input string does not include its terminal newline.
  (let ((proc (get-buffer-process (current-buffer))))
    (if (not proc) (error "Current buffer has no process")
      (widen)
      (let* ((pmark (process-mark proc))
             (intxt (if (>= (point) (marker-position pmark))
                        (progn (if comint-eol-on-send (end-of-line))
                               (buffer-substring pmark (point)))
                      (let ((copy (funcall comint-get-old-input)))
                        (goto-char pmark)
                        (insert copy)
                        copy)))
             (input (if (not (eq comint-input-autoexpand 'input))
                        ;; Just whatever's already there
                        intxt
                      ;; Expand and leave it visible in buffer
                      (comint-replace-by-expanded-history t pmark)
                      (buffer-substring pmark (point))))
             (history (if (not (eq comint-input-autoexpand 'history))
                          input
                        ;; This is messy 'cos ultimately the original
                        ;; functions used do insertion, rather than return
                        ;; strings.  We have to expand, then insert back.
                        (comint-replace-by-expanded-history t pmark)
                        (let ((copy (buffer-substring pmark (point)))
                              (start (point)))
                          (insert input)
                          (delete-region pmark start)
                          copy))))

        (unless no-newline
          (insert ?\n))

        (comint-add-to-input-history history)

        (run-hook-with-args 'comint-input-filter-functions
                            (if no-newline input
                              (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"
                 field 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)

        (setq comint-save-input-ring-index comint-input-ring-index)
        (setq comint-input-ring-index nil)
        ;; Update the markers before we send the input
        ;; in case we get output amidst sending the input.
        (set-marker comint-last-input-start pmark)
        (set-marker comint-last-input-end (point))
        (set-marker (process-mark proc) (point))
        ;; clear the "accumulation" marker
        (set-marker comint-accum-marker nil)
        (let ((comint-input-sender-no-newline no-newline))
          (funcall comint-input-sender proc input))

        ;; Optionally delete echoed input (after checking it).
        (when (and comint-process-echoes (not artificial))
          (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)
                           (point-max))
                        (zerop
                         (compare-buffer-substrings
                          nil comint-last-input-start
                          (- (point-max) echo-len)
                          ;; Above difference is equivalent to
                          ;; (+ comint-last-input-start
                          ;;    (- (point-max) comint-last-input-end))
                          nil comint-last-input-end (point-max)))))
            (if (and
                 (<= (+ comint-last-input-end echo-len)
                     (point-max))
                 (zerop
                  (compare-buffer-substrings
                   nil comint-last-input-start comint-last-input-end
                   nil comint-last-input-end
                   (+ comint-last-input-end echo-len))))
                ;; Certain parts of the text to be deleted may have
                ;; been mistaken for prompts.  We have to prevent
                ;; problems when `comint-prompt-read-only' is non-nil.
                (let ((inhibit-read-only t))
                  (delete-region comint-last-input-end
                                 (+ comint-last-input-end echo-len))
                  (when comint-prompt-read-only
                    (save-excursion
                      (goto-char comint-last-input-end)
                      (comint-update-fence)))))))

        ;; This used to call comint-output-filter-functions,
        ;; but that scrolled the buffer in undesirable ways.
        (run-hook-with-args 'comint-output-filter-functions "")))))

(defvar comint-preoutput-filter-functions nil
  "List of functions to call before inserting Comint output into the buffer.
Each function gets one argument, a string containing the text received
from the subprocess.  It should return the string to insert, perhaps

	     (scroll comint-scroll-to-bottom-on-input))
	(if (and process (< (point) (process-mark process)))
	    (if (eq scroll 'this)
		(goto-char (point-max))
	      (walk-windows
               (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))))
	       nil t))))))

(defun comint-postoutput-scroll-to-bottom (string)
  "Go to the end of buffer in some or all windows showing it.
Does not scroll if the current line is the last line in the buffer.

	 (process (get-buffer-process current))
	 (scroll comint-move-point-for-output))
    (unwind-protect
	(if process
	    (walk-windows
             (lambda (window)
               (when (eq (window-buffer window) current)
                 (select-window window)
                 (if (and (< (point) (process-mark process))
                          (or (eq scroll t) (eq scroll 'all)
                              ;; Maybe user wants point to jump to end.
                              (and (eq scroll 'this) (eq selected window))
                              (and (eq scroll 'others) (not (eq selected window)))
                              ;; If point was at the end, keep it at end.
                              (and (marker-position comint-last-output-start)
                                   (>= (point) comint-last-output-start))))
                     (goto-char (process-mark process)))
                 ;; Optionally scroll so that the text
                 ;; ends at the bottom of the window.
                 (if (and comint-scroll-show-maximum-output
                          (= (point) (point-max)))
                     (save-excursion
                       (goto-char (point-max))
                       (recenter (- -1 scroll-margin))))
                 (select-window selected)))
	     nil t))
      (set-buffer current))))

(defun comint-truncate-buffer (&optional string)
  "Truncate the buffer to `comint-buffer-maximum-size'.

				  (buffer-substring pmark (point))))
	(delete-region pmark (point))))
    ;; Output message and put back prompt
    (comint-output-filter proc replacement)))
(define-obsolete-function-alias 'comint-kill-output
  'comint-delete-output "21.1")

(defun comint-write-output (filename &optional append mustbenew)
  "Write output from interpreter since last input to FILENAME.
Any prompt at the end of the output is not written.

This command also kills the pending input
between the process mark and point."
  (interactive)
  (comint-skip-input)
  (interrupt-process nil comint-ptyp)
  ;; (process-send-string nil "\n")
  )

(defun comint-kill-subjob ()
  "Send kill signal to the current subjob.
This command also kills the pending input
between the process mark and point."

		       (condition-case ()
			   (file-exists-p stringfile)
			 (error nil))
		       (not (file-directory-p stringfile))))
	 (defdir  (if sfile-p (file-name-directory stringfile)
                    (car def)))
	 (deffile (if sfile-p (file-name-nondirectory stringfile)
                    (cdr def)))
	 (ans (read-file-name (if deffile (format "%s(default %s) "
						  prompt    deffile)
                                prompt)
			      defdir
			      (concat defdir deffile)
			      mustmatch-p)))
    (list (expand-file-name (substitute-in-file-name ans)))))

Magic characters are those in `comint-file-name-quote-list'."
  (if (null comint-file-name-quote-list)
      filename
    (let ((regexp
	   (format "[%s]"
                   (mapconcat 'char-to-string comint-file-name-quote-list ""))))
      (save-match-data
	(let ((i 0))
	  (while (string-match regexp filename i)
	    (setq filename (replace-match "\\\\\\&" nil nil filename))
	    (setq i (1+ (match-end 0)))))

INPUT-STRING is the input from the Comint process.

This function does not need to be invoked by the end user."
  (let ((output-buffer-list
	 (if (listp comint-redirect-output-buffer)
             comint-redirect-output-buffer
	   (list comint-redirect-output-buffer)))
	(filtered-input-string input-string))

    ;; If there are any filter functions, give them a chance to modify the string
    (let ((functions comint-redirect-filter-functions))

	   (save-excursion
	     (goto-char (point-max))
	     (or (re-search-backward comint-prompt-regexp nil t)
		 (error "No prompt found or `comint-prompt-regexp' not set properly"))))

      ;; Set up for redirection
      (comint-redirect-setup
       output-buffer
       (current-buffer)                 ; Comint 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)

      ;; Send the command
      (process-send-string (current-buffer) (concat command "\n"))

      ;; Show the output
      (or no-display
	  (display-buffer
	   (get-buffer-create
	    (if (listp output-buffer)
		(car output-buffer)

		     (match-beginning regexp-group)
		     (match-end regexp-group))
		    results)))
      results)))

(dolist (x '("^Not at command line$"
             "^Empty input ring$"
             "^No history$"
             "^Not found$"			; Too common?
             "^Current buffer has no process$"))
  (add-to-list 'debug-ignored-errors x))


;; Converting process modes to use comint mode
;; ===========================================================================
;; The code in the Emacs 19 distribution has all been modified to use comint