;;;; Start a subprocess and execute Lisp code sent by the subprocess.

(defvar listener-subprocess-program "emacs-listener"
  "Program to execute in listener subprocess.")

(defvar listener-subprocess-name "*listener*"
  "Name of listener subprocess.")

(defvar listener-subprocess nil
  "Process variable of listener subprocess.")

(defvar listener-buffer-name " *listener-buffer*"
  "Name of buffer to execute listener subprocess in.")

(defvar listener-buffer nil
  "Buffer to execute listener subprocess in.")

(defvar listener-transaction-number 0)

(defun listener-start (&optional arg)
  "Start the listener.
With prefix arg, kill existing subprocess first."
  (interactive "P")
  (if arg
      (listener-shutdown))
  (if (not listener-buffer)
      (setq listener-buffer (get-buffer-create listener-buffer-name)))
  (if listener-subprocess
      (message "Already running: %s" listener-subprocess)
    (message "Starting %s" (listener-start-subprocess))))

(defun listener-shutdown (&optional proc message)
  "Shutdown listener process.
Used as process sentinel."
  (interactive)
  (if listener-subprocess
      (progn
	(condition-case dummy
	    (delete-process listener-subprocess)
	  (error nil))
	(setq listener-subprocess nil))) 
  (if listener-buffer
      (progn
	(kill-buffer listener-buffer)
	(setq listener-buffer nil)))
  (if (and proc message)
      (message "Process %s shutdown: %s" proc message)))

(defun listener-remove-braces (string)
  "Remove all braces from STRING.
This is necessary to move around Tcl's messed-up quoting."
  (replace-in-string string "[{}]" ""))

(defun listener-filter (proc string)
  "Process output of listener subprocess."
  (setq listener-transaction-number (1+ listener-transaction-number))
  (save-excursion
    (set-buffer listener-buffer)
    (goto-char (point-max))
    (setq string (listener-remove-braces string))
    (insert string)
    ;;    (debug)
    (let ((result (condition-case error
		      (eval (read string))
		    (end-of-file nil)
		    (error error))))
      (if result
	  (message "%s" result)))))

(defun listener-start-subprocess ()
  "Start the listener subprocess."
  (setq listener-subprocess
	(start-process listener-subprocess-name
		       listener-buffer
		       listener-subprocess-program))
  (set-process-filter listener-subprocess 'listener-filter)
  (set-process-sentinel listener-subprocess 'listener-shutdown)
  (process-kill-without-query listener-subprocess)
  listener-subprocess)

;;; EOF