(in-package "CL-USER")
(require "comm")

;;; ----------------------------------------------------------------------
;;; A KPML Mini-Server in Lisp that shows how a simple Lisp server
;;; using the socket handling facilities of Lispworks (at least)
;;; can support a generation server. The commands that the
;;; server accepts are based on the KPML black-box
;;; facility.  Freely modelled on the Lispworks 5 documentation
;;; examples.
;;;
;;; LISPWORKS 5 ONLY.
;;; ----------------------------------------------------------------------

(defvar *talk-port* 10244) ; a free TCP port number
(defvar *has-terminated* nil)
(defvar kpml::*waiting-verbose* nil)

 
(defun MAKE-STREAM-AND-GENERATE (handle) 
  (let ((stream (make-instance
                 'comm:socket-stream :socket handle 
                 :direction :io :element-type
                 'base-char))) 
    (mp:process-run-function (format nil "talk ~D" handle)
                             '() 'generate-on-stream stream)
    )
  )


(defun GENERATE-ON-STREAM (stream)
  (unwind-protect 
      (handler-case
          (loop for line  = 
                (read-line stream nil nil) 
	    while line
	    do 
	    (let ((input 
		   (let ((*package* (find-package "KPML")))
		     (read-from-string line))))
	      (cond 
	       ((equal input :stop)
		(let ((process (mp:find-process-from-name
				(format nil "~S server" *talk-port*))))
		  (format *trace-output* "~%;;; Closing down...)")
		  (format stream "bye~%")
		  (close stream)
		  (when process (mp:process-kill  process))
		  (return-from GENERATE-ON-STREAM nil)
		  ))
	       ((equal input :verbose)
		(setf kpml::*waiting-verbose* (not kpml::*waiting-verbose*))
		(format stream "ok~%")
		(force-output stream))
	       (t
		(when kpml::*waiting-verbose*
		  (format *trace-output* "~%;;; received: ~S" input))
		(format stream 
			"~S~%"
			(kpml::iron-plated-simple-say input))
		(force-output stream)
		))))
        (error () (progn (close stream) (print "Connection lost!"))))
        (close stream))
    )

(defun START-KPML-SERVER (&optional (port *talk-port*))
  (setf *talk-port* port)
  (comm:start-up-server 
   :function 'make-stream-and-generate
   :service port))
