;;;
;;; Main functions for Talk process management.
;;;
;;; ----------------------------------------------------------------------
;;; This file is part of ILOG Talk.
;;; Inquiries to ILOG S.A.
;;;              9 rue de Verdun, BP 85,
;;;              94253 Gentilly Cedex, France.
;;;
;;; Copyright (c) 1993-1996 by ILOG
;;; ----------------------------------------------------------------------
;;;
;;; Name prefixes:
;;;
;;; tp		General prefix for Talk Process mode identifiers.
;;;
;;; tpl:	Buffer-specific variables which are relative to Talk
;;; 		processes.
;;;
;;; tpp:	Talk process buffer specific functions and variables.
;;; 		Can be called or referenced only when the current buffer
;;; 		is a process buffer.
;;;


(require 'talk-mode)

(if emacs19p
    (require 'talk-process19)
  (require 'talk-process18))


;; Parameters
;; ----------
;;

(defvar tp:clever-newline-p t
  "When true, \\C-m sends the output to Talk only if the current expression
is complete; otherwise, it always send the output.")

(defvar tp:always-send-complete-expression-p t
  "When true, \\C-m always sends the output to Talk, even when not at the end
of the buffer.")

(defvar tp:max-pseudo-input-lines 5
  "Maximum number of lines inserted in the buffer when showing commands
launched from emacs.")

(defvar tp:shell-file-name
  (if (eq system-type 'windows-nt)
    () ; (or (getenv "ESHELL") (getenv "SHELL")) ;; seems to work better with ()
    "/bin/sh")
  "Shell used to launch a Talk.")

(defvar tp:launch-command
  (if (eq system-type 'windows-nt) "italk.exe" "italk")
  "The default command to launch a Talk process.")

(defvar tp:erase-buffer-p t
  "True if the talk buffer must be erased when a new process is launched")

;; Parameters
;; ----------
;;

(defvar tp:talk-process-other-window tm:pop-other-window-default
  "When true, a new window is opened for Talk processes.")


;; Global variables
;; ----------------
;;

(defvar tp:talk-process-map ()
  "The Talk process keymap.")

(defvar tp:search-history-map ()
  "The history search process keymap.")

(defvar tp:build-program-unit-fmt "(analyze-program-unit '%s buildp: t)"
  "Command inserted verbatim to analyze a program unit.")

(defvar tp:analyze-program-unit-fmt "(analyze-program-unit '%s)"
  "Command inserted verbatim to analyze a program unit.")

(defvar tp:update-load-program-unit-fmt
  "(update-program-units '(%s) action: 'load)"
  "Command inserted verbatim to update-load a program unit.")

(defvar tp:update-analyze-program-unit-fmt 
  "(update-program-units '(%s) action: 'analyze)"
  "Command inserted verbatim to update-analyze a program unit.")

(defvar tp:update-analyze-build-program-unit-fmt 
  "(update-program-units '(%s) action: 'build)"
  "Command inserted verbatim to update-analyze-build a program unit.")

(defvar tp:load-program-unit-fmt "(load-program-unit '%s)"
  "Command inserted verbatim to analyze a program unit.")

(defvar tp:test-program-unit-fmt "(test-program-unit '%s)"
  "Command inserted verbatim to test a program unit.")

(defvar tp:load-program-unit-interpreted-fmt
  "(load-program-unit '%s interpretedp: t)"
  "Command inserted verbatim to load a program unit interpreted.")

(defvar tp:in-workspace-fmt
  "(in-workspaces '(%s))"
  "Command inserted verbatim to put ourselves into a workspace.")

(defvar tp:max-send-region-size 
  255
  "Maximum size of packets sent with process-send-region")


;; Buffer specific variables
;; -------------------------
;;

(defvar tpl:talk-process ()
  "If the buffer is attached to a Talk process, contains that process,
otherwise ().")


;; Key map
;; -------
;;

(if tp:talk-process-map
    ()
  (setq tp:talk-process-map (copy-keymap tm:talk-mode-map))
  (define-key tp:talk-process-map "\C-c\C-c" 'tpp:send-interrupt)
  (define-key tp:talk-process-map "\C-\\" 'tpp:kill-talk-process)
  (define-key tp:talk-process-map "\M-r" 'tpp:isearch-history-backward)
  (define-key tp:talk-process-map "\M-s" 'tpp:isearch-history-forward)
  (define-key tp:talk-process-map "\M-p" 'tpp:previous-command)
  (define-key tp:talk-process-map "\M-n" 'tpp:next-command)
  (define-key tp:talk-process-map "\C-a" 'tp:beginning-of-line)
  (define-key tp:talk-process-map "\C-x\C-q" 'tpp:toggle-protected-mode)
  (define-key tp:talk-process-map "\C-c\C-b"
    'tpp:insert-analyze-build-program-unit)
  (define-key tp:talk-process-map "\C-c\C-u\C-l"
    'tpp:insert-update-load-program-unit)
  (define-key tp:talk-process-map "\C-c\C-u\C-a"
    'tpp:insert-update-analyze-program-unit)
  (define-key tp:talk-process-map "\C-c\C-u\C-b"
    'tpp:insert-update-analyze-build-program-unit)
  (define-key tp:talk-process-map "\C-c\C-l"
    'tpp:insert-load-program-unit)
  (define-key tp:talk-process-map "\C-c\C-i"
    'tpp:insert-load-program-unit-interpreted)
  (define-key tp:talk-process-map "\C-c\C-t"
    'tpp:insert-test-program-unit)
  (define-key tp:talk-process-map "\C-c\C-a" 
    'tpp:insert-analyze-program-unit)
  (define-key tp:talk-process-map "\C-c\C-w" 
    'tpp:insert-in-workspaces)
  (let ((indent (if tm:indent-on-return "\C-m" "\C-j"))
	(send (if tm:indent-on-return "\C-j" "\C-m")))
    (if (not tp:clever-newline-p)
	(define-key tp:talk-process-map indent 'tpp:newline-send-input)
      (define-key tp:talk-process-map indent 'tpp:newline-send-complete-input))
    (define-key tp:talk-process-map send 'tpp:newline-send-input)))



;; To start a Talk process
;; -----------------------

(defun tpp:run-talk (command options)
  "Start a Talk process with COMMAND and OPTIONS in the current buffer."
  (tpp:talk-process-mode)
  (make-local-variable 'tpl:talk-process)
  (setq command (concat command " -form-input-mode " options))
  (setq tpl:talk-process
	(if (not (eq system-type 'windows-nt))
	  (start-process "talk" (current-buffer)
			 tp:shell-file-name
			 "-c" (concat "stty -echo -onlcr; exec " command))
	  ;; On WinNT, we do not necessarily have a shell.
	  (if tp:shell-file-name
            (start-process "talk" (current-buffer)
			   tp:shell-file-name
			   "-c" (concat "exec " command))
	    ;; Split the command line into separate args, separated by spaces.
	    (let ((args ()))
              (while (string-match "[ \t]+" command)
		(setq args (cons (substring command 0 (match-beginning 0)) args)
		      command (substring command (match-end 0))))
	      (unless (string= command "") (setq args (cons command args)))
	      (apply 'start-process "talk" (current-buffer) (nreverse args))
	) ) )
  )
  (make-local-variable 'tml:other-screen-p)
  (setq tml:other-screen-p tp:talk-process-other-window)
  (set-process-sentinel tpl:talk-process 'tp:process-sentinel)
  (set-process-filter tpl:talk-process 'tp:process-filter)
  (tm:show-buffer (current-buffer) () t 'end))

(defun tpp:talk-process-mode ()
  "Set all the buffer local variables for process number COUNT."
  (use-local-map tp:talk-process-map)
  (setq mode-name "Talk Process")
  (tm:talk-mode-variables)
  (tpp:talk-process-variables)
  (set-syntax-table tm:talk-mode-syntax-table)
  (run-hooks 'talk-process-mode-hook))

(defun tpp:talk-process-variables ()
  "Create Talk process buffer variables."

  ;; A list of strings containing the command history. The first element
  ;; contains the current command.
  (make-local-variable 'tpp:history-list)
  (put 'tpp:history-list 'permanent-local t) ; For kill-all-local-variables
  (if (or (not (boundp 'tpp:history-list))
	  (null tpp:history-list))
      ;; So that history is preserved across processes
      (setq tpp:history-list (list ())))

  ;; An index to the currently selected command in tpp:history-list.
  (make-local-variable 'tpp:history-list-index)
  (setq tpp:history-list-index 0)

  ;; A marker pointing to the end of the last process output.
  (make-local-variable 'tpp:insertion-marker)
  (setq tpp:insertion-marker (make-marker))
  (set-marker tpp:insertion-marker (point-max))

  ;; A string representing the prompt
  (make-local-variable 'tpp:talk-prompt)
  (setq tpp:talk-prompt "? ")

  (make-local-variable 'defun-prompt-regexp)
  (setq defun-prompt-regexp (concat "^" (regexp-quote tpp:talk-prompt)))

  (tpp:talk-process-specific-variables))


;; Command history
;; ---------------
;;

(defun tpp:previous-command ()
  "Insert the previous history command."
  (interactive)
  (tpp:goto-input-region)
  (if (not (tpp:previous-command-p))
      (error "No previous command")
    (progn
      (if (= tpp:history-list-index 0)
	  (rplaca tpp:history-list (tpp:current-input)))
      (setq tpp:history-list-index (1+ tpp:history-list-index))
      (tpp:replace-current-input 
       (nth tpp:history-list-index tpp:history-list)))))

(defun tpp:previous-command-p ()
  "Return T if there is a previous command."
  (< tpp:history-list-index (1- (length tpp:history-list))))

(defun tpp:next-command ()
  "Insert the next history command."
  (interactive)
  (tpp:goto-input-region)
  (if (not (tpp:next-command-p))
      (error "No next command")
    (progn
      (setq tpp:history-list-index (1- tpp:history-list-index))
      (tpp:replace-current-input
       (nth tpp:history-list-index tpp:history-list)))))

(defun tpp:next-command-p ()
  "Return T if there is a next command."
  (> tpp:history-list-index 0))

(defun tpp:isearch-history-forward ()
  "As you type characters, they add to the search string and are found.
Type Delete to cancel characters from end of search string.
Type C-s to search again forward, C-r to search again backward.
C-g aborts and moves point to starting point.
Other control and meta characters terminate the search
 and are then executed normally."
  (interactive)
  (tpp:isearch-history t))

(defun tpp:isearch-history-backward ()
  "As you type characters, they add to the search string and are found.
Type Delete to cancel characters from end of search string.
Type C-s to search again forward, C-r to search again backward.
C-g aborts and moves point to starting point.
Other control and meta characters terminate the search
 and are then executed normally."
  (interactive)
  (tpp:isearch-history ()))

(if tp:search-history-map
    ()
  (setq tp:search-history-map (make-keymap))
  (let ((i 32)
	(str (make-string 1 0)))
    (while (< i 127)
      (aset str 0 i)
      (define-key tp:search-history-map str 'tp:search-hist-printing-char)
      (setq i (1+ i))))
  (define-key tp:search-history-map "\t" 'tp:search-hist-printing-char)
  (define-key tp:search-history-map "\C-g" 'tp:search-hist-cancel)
  (define-key tp:search-history-map "\C-m" 'tp:search-hist-accept)
  (define-key tp:search-history-map "\M-r" 'tp:search-hist-back-again)
  (define-key tp:search-history-map "\M-s" 'tp:search-hist-forward-again)
  (define-key tp:search-history-map
    (if emacs19p [delete] "\177")
    'tp:search-hist-delete))

(defun tp:search-hist-cancel ()
  "For \C-g"
  (interactive)
  (tpp:replace-current-input
   (nth tpp:history-list-index tpp:history-list))
  (setq *index* tpp:history-list-index)
  (goto-char initial-point)
  (throw 'search-done ()))

(defun tp:search-hist-accept ()
  "For \C-m"
  (interactive)
  (goto-char (point-max))
  (throw 'search-done ()))

(defun tp:search-hist-back-again ()
  "For \M-r"
  (interactive)
  (cond
    (*forwardp*
     (setq *forwardp* ())
     (tpp:search-and-push))
    ((= (length *search-string*) 0)
     (setq *search-string* search-last-string)
     (tpp:search-and-push))
    (t
     (tpp:search-and-push t))))

(defun tp:search-hist-forward-again ()
  "For \M-s"
  (interactive)
  (cond
    ((not *forwardp*)
     (setq *forwardp* t)
     (tpp:search-and-push))
    ((= (length *search-string*) 0)
     (setq *search-string* search-last-string)
     (tpp:search-and-push))
    (t
     (tpp:search-and-push t))))

(defun tp:search-hist-delete ()
  "For DEL"
  (interactive)
  (if (cdr *stack*)
      (tpp:pop-state)
    (message *message*)))

(defun tp:search-hist-printing-char ()
  "For graphical characters"
  (interactive)
  (setq *search-string*
    (concat *search-string* (tm:key-string *key*)))
  (tpp:search-and-push))

(defun tpp:isearch-history (forwardp)
  "Do incremental search in the command history, in the direction specified
by FORWARDP."
  (tpp:goto-input-region)
  (let ((inhibit-quit t)
	(initial-point (point))
	(*search-string* "")
	(*successp* ())			; True if search is successful
	(*index* tpp:history-list-index) ; Index in the history
	(*stack* ())			; Stack of states
	(*forwardp* forwardp)
	(*message* ()))
    (if (eq tpp:history-list-index 0)
	(rplaca tpp:history-list (tpp:current-input)))
    (tpp:search-and-push)
    (catch 'search-done
      (while t
	(if quit-flag
	    (tp:search-hist-cancel)
	  (let* ((event (tm:read-event))
		 (*key* (tm:event-key event))
		 (cmd ()))
	    (cond
	      ((null *key*)
	       (tm:unread-event event)
	       (throw 'search-done ()))
	      ((and (setq cmd (lookup-key tp:search-history-map *key*))
		    (symbolp cmd))
	       (command-execute cmd))
	      (t
	       (tm:unread-event event)
	       (throw 'search-done ())))))))
    (if (not (string= *search-string* ""))
	(setq search-last-string *search-string*))))

(defun tpp:search-in-history (index search-string forwardp againp)
  (let ((regexp-string (regexp-quote search-string))
	(new-index (if (not againp)
		       index
		     (+ index (if forwardp -1 1))))
	(found ()))
    (if forwardp
	(while (and (>= new-index 0) (null found))
	  (let ((str (nth new-index tpp:history-list)))
	    (if (string-match regexp-string str)
		(setq found str)
	      (setq new-index (- new-index 1)))))
      (let ((l (nthcdr new-index tpp:history-list)))
	(while (and l (null found))
	  (let ((str (car l)))
	    (if (string-match regexp-string str)
		(setq found str)
	      (setq l (cdr l))
	      (setq new-index (+ new-index 1)))))))
    (if (not found)
	()
      (tpp:replace-current-input found)
      (if (not (string= search-string ""))
	  (progn
	    (goto-char tpp:insertion-marker)
	    (search-forward search-string)))
      new-index)))

(defun tpp:search-and-push (&optional againp)
  (let ((new-successp
	 (tpp:search-in-history *index* *search-string* *forwardp* againp)))
    (if new-successp
	(setq *index* new-successp)
      (if *successp* (ding)))
    (setq *successp* new-successp)
    (let ((msg (concat (if new-successp "" "failing ")
		       "command I-search"
		       (if *forwardp* " forward: " ": ")
		       *search-string*)))
      (aset msg 0 (upcase (aref msg 0)))
      (setq *message* msg)
      (message msg)
      (if (not (and againp (not new-successp))) 
	  (tpp:push-state)))))

(defun tpp:push-state ()
  (setq *stack*
	(cons (list (point) *index* *search-string* *message*)
	      *stack*)))

(defun tpp:pop-state ()
  (setq *stack* (cdr *stack*))
  (let ((state (car *stack*)))
    (setq *index* (nth 1 state))
    (setq *search-string* (nth 2 state))
    (setq *message* (nth 3 state))
    (tpp:replace-current-input (nth (car (cdr state)) tpp:history-list))
    (goto-char (car state))
    (message *message*)
    (setq *successp* ())))



;; Command edition
;; ---------------
;;
;; Replacements for delete-backward-char and beginning-of-line
;; which check for the beginning of a command.

(defvar tp:original-backward-delete-char 
  (symbol-function 'delete-backward-char))

(defun delete-backward-char (arg &optional killp)
  (interactive "*p\nP")
  (if (and tpl:talk-process (>= arg 0))
      (let ((point (point)))
	(if (>= (point) tpp:insertion-marker)
	    (let ((new-point (- point arg)))
	      (if (< new-point tpp:insertion-marker)
		  (setq arg (- point tpp:insertion-marker)))))))
  (funcall tp:original-backward-delete-char arg killp))

(defun tp:beginning-of-line (&optional arg)
  (interactive "p")
  (if (null arg) (setq arg 1))
  (if (and tpl:talk-process (>= (point) tpp:insertion-marker))
      (let ((new-point (save-excursion
			 (beginning-of-line arg)
			 (point))))
	(if (< new-point tpp:insertion-marker)
	    (setq new-point tpp:insertion-marker))
	(goto-char new-point))
    (beginning-of-line arg)))


;; Process filter
;; --------------
;;

(defun tp:process-filter (process output)
  "Filter for a Talk process."
  (let ((proc-buffer (process-buffer process)))
    (if (buffer-name proc-buffer)
	(let ((original-buffer (current-buffer)))
	  (unwind-protect (progn
			    (set-buffer proc-buffer)
			    (tpp:insert output 'talk-output))
	    (set-buffer original-buffer))))))

(defun tpp:insert (string type &optional newlinep)
  "Insert in the current buffer, at tpp:insertion-marker, the string STRING
with type TYPE, which is either talk-output, user-input or pseudo-user-input.
If optional NEWLINEP is true, insert a newline after STRING."
  (if (> (length string) 0)
      (let* ((inhibit-quit t)
	     (buffer (current-buffer))
	     (window (tm:get-buffer-window buffer))
	     (goto-end-p (and window (= (point) tpp:insertion-marker))))
	(save-excursion
	  (goto-char tpp:insertion-marker)
	  (insert string)
	  (if newlinep (newline))
	  (tpp:accept-buffer-substring (marker-position tpp:insertion-marker)
				       (point)
				       type)
	  (set-marker tpp:insertion-marker (point)))
	(if goto-end-p
	    (progn
	      (goto-char tpp:insertion-marker)
	      (set-window-point window tpp:insertion-marker)))
	(sit-for 0))))

(defun tpp:insert-buffer-substring (source-buffer start end max-lines type)
  "Insert the substring of BUFFER from START to END in the current buffer
at tpp:insertion-marker, with type TYPE (see tpp:insert for details on
TYPE). If MAX-LINES is given, it is taken as the maximum number of shown
lines; if the text extends beyond this number of lines, dots are inserted."
  (let* ((inhibit-quit t)
	 (column (progn
		   (goto-char tpp:insertion-marker)
		   (current-column)))
	 (visible-end (if (null max-lines)
			  end
			(save-excursion
			  (set-buffer source-buffer)
			  (save-excursion
			    (goto-char start)
			    (forward-line (1- max-lines))
			    (end-of-line)
			    (min end (point))))))
	 (buffer (current-buffer))
	 (window (tm:get-buffer-window buffer))
	 (goto-end-p (and window (= (point) tpp:insertion-marker))))
    (save-excursion
      (goto-char tpp:insertion-marker)
      (insert-buffer-substring source-buffer start visible-end)
      (if (< visible-end end)
	  (insert " ..."))
      (indent-rigidly (save-excursion
			(goto-char tpp:insertion-marker)
			(forward-line 1)
			(point))
		      (point)
		      column)
      (newline)
      (tpp:accept-buffer-substring (marker-position tpp:insertion-marker)
				   (point)
				   type)
      (set-marker tpp:insertion-marker (point)))
    (if goto-end-p
	(progn
	  (goto-char tpp:insertion-marker)
	  (set-window-point window tpp:insertion-marker)))
    (sit-for 0)))


;; Process sentinel
;; ----------------
;;

(defun tp:process-sentinel (process status-string)
  (if (tm:process-dead-p process)
      (let ((status (process-exit-status process)))
	(delete-process process)
	(let ((buffer (process-buffer process)))
	  (if (buffer-name buffer)
	      (save-excursion
		(set-buffer buffer)
		(goto-char (point-max))
		(if (= status 0)
		    (insert "<process terminated>")
		  (insert (format "<process terminated, status = %d>" status)))
		(if (fboundp 'tsp:kill-bridge-process)
		    (tsp:kill-bridge-process))))))))


;; Sending input to the process
;; ----------------------------
;;

(defun tpp:newline-send-complete-input ()
  "Insert a newline and send the current input to the Talk process if
the current expression is complete and we are at the end of the buffer.
Because of an Emacs bug, a complete input may not be seen as complete
if it contains comments with unbalanced parentheses. If you are bothered
with this bug, set the variable tp:clever-newline-p to ()."
  (interactive)
  (cond
    ((< (point) tpp:insertion-marker)
     (goto-char (point-max)))
    ((and (or tp:always-send-complete-expression-p (looking-at "[ \t\n]*\\'"))
	  (tpp:current-input-complete-p))
     (tpp:newline-send-input))
    (t
     (save-restriction
       (narrow-to-region (save-excursion 
			   (goto-char tpp:insertion-marker)
			   (beginning-of-line)
			   (point))
			 (point-max))
       (newline-and-indent)))))

(defun tpp:newline-send-input ()
  "Insert a newline and send the current input."
  (interactive)
  (let ((process (tp:buffer-process)))
    (goto-char (point-max))
    (tpp:record-in-history (tpp:current-input))
    (setq tpp:history-list-index 0)
    (let ((start (marker-position tpp:insertion-marker)))
      (newline)
      (tpp:accept-buffer-substring (marker-position tpp:insertion-marker)
				   (point-max)
				   'user-input)
      (set-marker tpp:insertion-marker (point))
      (tp:process-send-region process start (point)))))

(defun tp:process-send-region (process start end)
  "Same as process-send-region, but output is sliced in pieces
of no more than tp:max-send-region-size characters."
  (if (<= (- end start) tp:max-send-region-size)
      (process-send-region process start end)
    (while (> (- end start) tp:max-send-region-size)
      (let ((new-start (+ start tp:max-send-region-size)))
	(process-send-region process start new-start)
	(accept-process-output)
	(setq start new-start)))
    (process-send-region process start end)))

(defun tp:process-send-region-copy (process start end)
  "Same as tpp:process-send-region, but region is copied to another buffer
before being sent."
  (if (<= (- end start) tp:max-send-region-size)
      (process-send-region process start end)
    (let ((buf (generate-new-buffer "temp")))
      (unwind-protect
	  (progn
	    (copy-to-buffer buf start end)
	    (save-excursion
	      (set-buffer buf)
	      (let ((s 1)
		    (e (+ (- end start) 1)))
		(while (> (- e s) tp:max-send-region-size)
		  (let ((new-s (+ s tp:max-send-region-size)))
		    (process-send-region process s new-s)
		    (accept-process-output)
		    (setq s new-s)))
		(process-send-region process s e))))
	(kill-buffer buf)))))

(defun tpp:record-in-history (input)
  "Record the string INPUT in the history if it has more than one character
and is not blank."
  (if (and (> (length input) 1)
	   (not (string-match "\\`\\(\\s \\|\n\\)*\\'" input)))
      (progn
	(rplaca tpp:history-list (tpp:current-input))
	(setq tpp:history-list (cons "" tpp:history-list)))))  

(defun tpp:send-interrupt ()
  "Send an interruption (C-c) to the current Talk process."
  (interactive)
  (let ((process (tp:buffer-process)))
    (tp:interrupt-process process)))

(defun tp:interrupt-process (process)
  "Send an interruption (C-c) to PROCESS."
  (interrupt-process process))

(defun tpp:kill-talk-process ()
  "Kill the current Talk process."
  (interactive)
  (if (and tpl:talk-process (not (tm:process-dead-p tpl:talk-process)))
      (tm:quit-process tpl:talk-process)))

(defun tpp:current-input-complete-p ()
  "Return T if the current input is made only of complete expressions.
Buggy because Emacs doesn't parse comments properly."
  (save-excursion
    (goto-char tpp:insertion-marker)
    (let ((completep t))
      (condition-case ()
	  (while (and completep (not (eobp)))
	    (skip-chars-forward " \t\n)") ; Emacs will fail on closing parens
	    (forward-sexp 1))
	(error (setq completep ())))
      completep)))

;; Compilation, analysis and co
;; ----------------------------
;;

(defun tpp:insert-analyze-build-program-unit ()
  "Insert a command to analyze and build a program unit."
  (interactive)
  (tpp:insert-talk-command tp:build-program-unit-fmt))

(defun tpp:insert-load-program-unit ()
  "Insert a command to load a program unit."
  (interactive)
  (tpp:insert-talk-command tp:load-program-unit-fmt))

(defun tpp:insert-test-program-unit ()
  "Insert a command to test a program unit."
  (interactive)
  (tpp:insert-talk-command tp:test-program-unit-fmt))

(defun tpp:insert-load-program-unit-interpreted ()
  "Insert a command to load a program unit interpreted."
  (interactive)
  (tpp:insert-talk-command tp:load-program-unit-interpreted-fmt))

(defun tpp:insert-analyze-program-unit ()
  "Insert a command to analyze a program unit."
  (interactive)
  (tpp:insert-talk-command tp:analyze-program-unit-fmt))

(defun tpp:insert-in-workspaces ()
  "Insert a command to go to a workspace."
  (interactive)
  (tpp:insert-talk-command tp:in-workspace-fmt))

(defun tpp:insert-update-load-program-unit ()
  "Insert a command to update-load a program unit."
  (interactive)
  (tpp:insert-talk-command tp:update-load-program-unit-fmt))

(defun tpp:insert-update-analyze-program-unit ()
  "Insert a command to update-analyze a program unit."
  (interactive)
  (tpp:insert-talk-command tp:update-analyze-program-unit-fmt))

(defun tpp:insert-update-analyze-build-program-unit ()
  "Insert a command to update analyze build a program unit."
  (interactive)
  (tpp:insert-talk-command tp:update-analyze-build-program-unit-fmt))

(defun tpp:insert-talk-command (fmt)
  "Replace current input with FMT. FMT is a format string containing one
%s; the point is moved to the position of this %s."
  (tpp:goto-input-region)
  (tpp:replace-current-input (format fmt ""))
  (if (string-match "\\(%s\\)" fmt)
      (forward-char (- (match-end 1) (length fmt)))))


;; Utilities
;; ---------
;;

(defun tp:talk-process-buffer-p (buffer)
  "Return T if BUFFER is a Talk process buffer."
  (save-excursion
    (set-buffer buffer)
    tpl:talk-process))

(defun tpp:goto-input-region ()
  "If not in the input region, goto the end of the buffer."
  (if (< (point) tpp:insertion-marker)
      (goto-char (point-max))))

(defun tp:buffer-process ()
  "Return the current buffer process, or signal an error if there is no
process attached to the buffer."
  (if (or (null tpl:talk-process) (tm:process-dead-p tpl:talk-process))
      (error "No Talk process.")
    tpl:talk-process))

(defun tpp:replace-current-input (string)
  "Replace current command input with STRING."
  (delete-region tpp:insertion-marker (point-max))
  (insert-string string))

(defun tpp:current-input ()
  "Return the current command input."
  (buffer-substring tpp:insertion-marker (point-max)))

(defun tm:beginning-of-defun ()
  "Go to the beginning of the current toplevel expression."
  (interactive)
  (cond
    ((not tpl:talk-process)
     (tm:basic-beginning-of-defun))
    ((>= (point) tpp:insertion-marker)
     (goto-char tpp:insertion-marker))
    (t (and
	(re-search-backward (tpp:talk-prompt-regexp) nil 'move)
	(goto-char (match-end 1))))))

(defun tpp:talk-prompt-regexp ()
  "Return a regular expression which matches the prompt at the beginning
of a line."
  (concat "^\\(" (regexp-quote tpp:talk-prompt) "\\)"))


(provide 'talk-process)
