(in-package "IPC")

;;; File: client.lisp
;;; John: Ober-Ramstadt. August 1996. 

;;; Provides for a Lisp client that can ask for generation to be
;;; performed by a KPML-server.

;;; A client side from Lisp can secure access to the socket
;;; by issuing an (ipc::open-network-stream :socket-file "<socket-name">).
;;; It can then use the function ipc::send-to-socket
;;; defined below. Once stopped, the daemon needs to be killed
;;; before re-use, (ipc::kill-lisp-listener-daemon).
;;; Both named sockets and host and port numbers can be used:
;;; for host/ports simply omit the set-socket call above to make
;;; sure that ipc::*unix-domain* is nil. Then issue a
;;; (ipc::open-network-stream :host "..." :port nnn) to get 
;;; a stream to the port.

(unless (find-package "KPML")(make-package "KPML"))
(unless (find-package "PENMAN")(make-package "PENMAN"))

(defvar kpml::*default-com-file* (pathname 
			    (merge-pathnames
			     "KpmlCom.tmp"
			     (user-homedir-pathname))))
(defvar kpml::*com-file* kpml::*default-com-file*)
(defvar kpml::*server-stream* nil)

;;; ----------------------------------------------------------------------
;;; Variation on set-com-file for using host and port numbers...

(defun kpml::GET-COM-INFO-FROM-FILE (file)
  (with-open-file 
   (s (pathname (string file)))
   (let* ((input (read-line s nil))
	  (pos (position #\# input)))
     (values
      (read-from-string (subseq input 0 pos))
      (subseq input (1+ pos) (length input))))))

;;; ----------------------------------------------------------------------
;;; The following function can be used from a client
;;; to send information to the server started above.
;;; The read-char seems to be necessary in order to
;;; jog the socket into action: until this is given
;;; the server's read does not return an item.
(defun SEND-TO-SOCKET (item s)
  (print item s)
  (Read-char s nil))

;;; ----------------------------------------------------------------------
(in-package "KPML")

(defun KPML::START-KPML-CLIENT ()
  (multiple-value-bind (port host)
      (kpml::get-com-info-from-file (namestring kpml::*com-file*))
    (ipc::open-network-stream :host host :port port)))


;;; ----------------------------------------------------------------------
;;; Following is the most simple and primitive function. It 
;;; takes an spl or example name and the stream for the connection
;;; and returns the generated string.

(defun KPML::SERVER-SAY-STRING (input stream) 
  (ipc::send-to-socket #\a stream)
  (ipc::send-to-socket input stream)
  ;; ignore noise...
  (loop for i = (read-char stream nil)
      until (or (not i)(char= i #\*)))
  ;; get the result...
  (coerce (loop for i = (read-char stream nil)
	      until (or (not i)(char= i #\*))
	      collect i) 'string))

;;; ----------------------------------------------------------------------
;;; Following functions support more flexible interaction with the
;;; KPML server, including returning of the full presentation
;;; structure generated for each string generated.

(defvar kpml::mouseable-terminals :all)
(defvar kpml::mouseable-constits  :all)
(defvar kpml::curlan :english)

;;; Following is meant to be the usual way of getting results back
;;; from KPML...

(defmacro KPML::WITH-SERVER-ACCESS 
    ((&key (stream nil)
	   (com-file kpml::*com-file*)
	   (language kpml::curlan)
	   (close-stream T)
	   (terminals kpml::mouseable-terminals)
	   (constituents kpml::mouseable-constits))
     &rest body)
  `(let ((kpml::mouseable-terminals ,terminals)
	 (kpml::mouseable-constits ,constituents)
	 (kpml::curlan ,language)
	 (kpml::*server-stream*
	  ,(if stream stream
	     '(kpml::start-kpml-client))))
     ,@body
     ,(if close-stream 
	  '(close kpml::*server-stream*)
	'kpml::*server-stream*)))

(export 'with-server-access)


(defun KPML::SAY 
    (spl 
     &key (language kpml::curlan)
	  (m-consts kpml::mouseable-constits)
	  (m-terms kpml::mouseable-terminals)
	  (stream kpml::*server-stream*))
  (ipc::send-to-socket #\s stream)
  (ipc::send-to-socket (list spl language m-consts m-terms) stream)
  ;; ignore noise...
  (loop for i = (read-char stream nil)
      until (or (not i)(char= i #\*)))
  ;; get the result...
  (read stream nil))

(export 'say)


(defun KPML::SET-MOUSE-SENSITIVE-CONSTITUENTS (consts)
  (setf kpml::mouseable-constits consts)
  (values))

(export 'set-mouse-sensitive-constituents)


(defun KPML::SET-MOUSE-SENSITIVE-TERMINALS (terms)
  (setf kpml::mouseable-terminals terms)
  (values))

(export 'SET-MOUSE-SENSITIVE-TERMINALS)


(defun KPML::SET-LANGUAGE (lg)
  (setf kpml::curlan lg))

(export 'SET-LANGUAGE)

;;; ----------------------------------------------------------------------
;;; Something for more advanced maintenance stuff, although probably
;;; not that useful for normal applications...

(defun GET-FULL-EXAMPLE-STRUCTURE 
    (spl 
     &key (language kpml::curlan)
	  (m-consts kpml::mouseable-constits)
	  (m-terms kpml::mouseable-terminals)
	  (stream kpml::*server-stream*))
  (let ((struct nil))
    (ipc::send-to-socket #\f stream)
    (ipc::send-to-socket (list spl language m-consts m-terms) stream)
    ;; ignore noise...
    (loop for i = (read-char stream nil)
	until (or (not i)(char= i #\*)))
    ;; get the result...
    (setf struct (read stream nil))
    (ipc::send-to-socket #\n stream)
    struct))

;;; ----------------------------------------------------------------------
;;; Misc.

(defun GET-KPML-EXAMPLE-LIST (&key (stream kpml::*server-stream*))
  (let ((struct nil))
    (ipc::send-to-socket #\l stream)
    (loop for i = (read-char stream nil)
	until (or (not i)(char= i #\*)))
    ;; get the result...
    (setf struct (read stream nil))
    (ipc::send-to-socket #\n stream)
    struct))

(export 'get-kpml-example-list)

(defun GET-LANGUAGE-RANGE (&key (stream kpml::*server-stream*))
  (let ((struct nil))
    (ipc::send-to-socket #\v stream)
    (loop for i = (read-char stream nil)
	until (or (not i)(char= i #\*)))
    ;; get the result...
    (setf struct (read stream nil))
    (ipc::send-to-socket #\n stream)
    struct))

(export 'get-language-range)

;;; ----------------------------------------------------------------------
;;; Simple display functions for the presentation structure...

;;; Based on function from KPML.../new-window-interface/development.lisp

(defun SENTENCE-DISPLAY 
    (mouseable-constituent-tree &optional (stream T)(refs nil))
  (let* ((ref (penman::printable-constituent-annotation 
	       mouseable-constituent-tree))
	 (ref-decision (and ref
			    (not (member ref refs :test #'equal)))))
    (when ref-decision
      (format stream "<A HREF=~S>" ref)
      (push ref refs))
  (dolist (element (penman::printable-constituent-spelling
		    mouseable-constituent-tree))
    (present-mouseable-sentence-element stream element refs))
    (when ref-decision
      (format stream "</A>"))))

(defun PRESENT-MOUSEABLE-SENTENCE-ELEMENT (stream element refs)
    (typecase element
      (string
       (format stream "~a "  element))
      (penman::printable-constituent
       (sentence-display element stream refs))))

(export 'sentence-display)

;;; ----------------------------------------------------------------------
;;; Structures sent back by the server... then just use the lisp reader
;;; to interpret them. Needs a more low-level solution for other
;;; client types.

;;; Presentation structure sent back by KPML...

(in-package "PENMAN")

(defstruct penman::printable-constituent 
  "Presentation structure for generated strings"
  (id nil)
  (concept nil)
  (spelling nil)
  (node-type nil)
  (annotation nil)            
  (functions nil)             
  )

(export 'printable-constituent)


;;; ----------------------------------------------------------------------
;;; Example structure...

(defstruct example "the definition of an example."
	   (name nil)
	   (targetform nil)              ;; name changed for KPML 0.8
	   (englishform nil)             ;; slot preserved for compatibility.
	   (generatedform nil)           ;; added for KPML 0.7
	   (logicalform nil)
	   (structure nil)               ;; added for KPML 0.8
	   (rootnode nil)                ;; transitory
	   (verbalizationgraph nil)      
	   (quantificationgraph nil)     ;; used?
	   (paragraph-theme nil)         ;; should be multilingual
	   (focus nil)                   ;; should be multilingual
	   (includedhubs nil)            
	   (selectionexpressions nil)
	   (comments nil)                ;; could be multilingual
	   (editor nil)                  ;; could be multilingual
	   (date nil)                    ;; could be multilingual
	   (kbenvironment nil)           ;; transitory? NO!
	   (tpenvironment nil)           ;; transitory? NO!
	   (discoursecontext             ;; transitory?
	    (make-discourse-context))
	   (source-file nil)             ;; added for KPML 0.8
	   (ls-set nil)                  ;; added for KPML 0.8
	   )

(export 'example)


(defstruct discourse-context
  (speaker 'I :type atom)
  (hearer 'you :type atom)
  (speaking-time 'timenow :type atom)
  (realm-of-speech 'here :type atom)
  (identifiables nil :type list)
  (priorrefs nil :type list))
	
(export 'discourse-context)

;;; ----------------------------------------------------------------------
;;; Package problems...
;;; ... due to a few symbols turning up as externals...
;;; ... and other packages leaking horribly, these should all be
;;;     cleaned up.

;;; following is a hack since it seems that this Loom package grabs
;;; some of the Penman symbols; should all be shadowed I guess, found
;;; so far: kbclasses:unknown.

(unless (find-package "KBCLASSES")(make-package "KBCLASSES"))
(in-package "KBCLASSES")

(export 'unknown)

;;; Following appropriately declares the external CLISP 
;;; package symbols that might come along...

(unless (find-package "CLISP")
  (defpackage "CLISP"
    (:use "COMMON-LISP")
    (:export "ALWAYS" "ASSQ" "BIND" "COLLECT"
	     "CONCAT" "CREATE" 
	     "DREMOVE"
	     "DREVERSE" "FOR" "IN" "VALUE-IF-LISTP"
	     "MEMQ" "MKLIST" "NEQ" "NEVER" 
	     "NLEFT" "NLISTP" 
	     "ON" "PUTHASH" "SUBSTRING" "SUM" 
	     "THEREIS" "WHILE")))


;;; Following is also necessary if inquiry responses from German
;;; resources are returned from the server...
(unless (find-package "KOMET-INQS")(make-package "KOMET-INQS"))

