(in-package "KPML")

;;; File: system-to-interface.lisp
;;; Author: John Bateman, 
;;;         original starting point: Penman/KPML 0.8 file, penman-fns.lisp
;;; 
;;; Contains the interface between the internal KPML stuff and the
;;; KPML window interface. Replaces the KPML-internal tty-output 
;;; functions (but leaves access to these in place in case one
;;; wants to revert).
;;;
;;; Redefines: printwindow and askwindow-real-window
;;; (from tty-io.lisp)
;;; 2.0 references to CLIM-1 removed, support for Lispworks and ACL-PC
;;;     added.
;;; 2.1 display-pane messages suppressed in demo-mode.
;;;
;;; The allocation of KPML logical panes to streams and windows
;;; of the KPML interface is here cleaned up considerably in
;;; relation to the old KPML interface (0.8 and before).
;;; These relations can be noted here as follows:
;;;
;;; ----------------------------------------------------------------------
;;; Information giving
;;;
;;;   logical-pane                        KPML frame       KPML pane
;;;  
;;; :system-name-pane                        GH             system
;;; :system-feature-choice-pane              GH             system-history
;;; :function-association-table-pane         FAT            fat
;;; :display-pane                            DEV            inspector
;;; :realization-pane                        RF             realizations
;;; :setup-item-list-for-show-pass-menu	     --
;;; :clear-item-list-for-show-pass-menu	     --
;;; :inquiry-name-pane                       GH             inquiry
;;; :inquiry-question-pane                   GH             inquiry-gloss
;;; :inquiry-response-pane                   GH             inquiry-history
;;; :target-text-pane                        DEV            target
;;;       (1.1 target disabled when in an extended-development-frame)
;;;
;;; Information seekings are in their own windows, but with the
;;; lisp listener of the inspection frame (interactor):
;;; 
;;; :choice
;;; :yes-or-no
;;; :value
;;; :any-key-to-continue
;;;
;;; ----------------------------------------------------------------------
;;;
(defvar item-list-for-show-pass-menu nil)

;;; --------------------------------------------------------
;;;			     PRINTWINDOW
;;; --------------------------------------------------------

(unless (fboundp 'tty-printwindow)
;;; Save the old version before committing the new one. MAF 22/10/94
	(setf (symbol-function 'tty-printwindow) #'printwindow)
	)


;;; 0.9.13: more context in pop-up dialogues
;;; 0.9.53 folded in.
;;; 0.9.61 folded in.
;;; 2.1    display-pane output will not be given if we are in demo-mode.

;;;
(defun PRINTWINDOW (window-name &optional strings-to-print)
  "Prints a list of strings on the given window one string per line.
   In some windows the strings will be truncated,
   in others they will be wrapped around.
   Also used to setup various window interface data structures.
   All output is done through this function."

;; If the KPMLI Inspector is not up, use the TTY version. MAF 22/10/94
  (when (not (and (boundp 'kpml-i::*resource-inspector-frame*)
                  kpml-i::*resource-inspector-frame*))
	(return-from printwindow 
	  (tty-printwindow window-name strings-to-print)))

  (when (stringp strings-to-print)
    (setq strings-to-print (list strings-to-print)))
  (when (symbolp strings-to-print)
    (setq strings-to-print (string strings-to-print)))
  (when (member window-name '(:system-name-pane :system-feature-choice-pane 
			      :inquiry-name-pane :inquiry-question-pane
			      :inquiry-response-pane))
    (unless kpml-i::*generation-history-frame* 
      (kpml-i::startup-generation-history-frame)))
  (when (member window-name '(:function-association-table-pane))
    (unless kpml-i::*fat-frame*
      (kpml-i::startup-fat-frame t)))
  (case window-name
    (:system-name-pane
     (let* ((string (first strings-to-print))   ;; 0.9.53 system name was going
	    (system (intern string "KPML"))     ;;        to wrong package
	    (stream     
	     (clim:get-frame-pane 
	      kpml-i::*generation-history-frame* 'kpml-i::system)))
      (clim:with-output-as-presentation
	  (stream system 'kpml-i::system)
	(clim:window-clear stream)
	(kpml-i-terpri stream)
	(format stream "System:  ~a" system))))

    (:system-feature-choice-pane
;;; this is where output of systems and their respective choices happens...
;;; In KPML this is changed to be a properly formatted table. Previously
;;; the system name and the feature were bundled up in a single string,
;;; which is not very information preserving; this is therefore changed 
;;; at the source calling function, ie., penman::choose, in 
;;; systemic-networks/sgchoice.lisp.

     (let ((system (first strings-to-print))
	   (feature (second strings-to-print))
	   (stream (clim:get-frame-pane kpml-i::*generation-history-frame*
				 'kpml-i::system-history)))
       (clim:with-output-as-presentation
	   (stream system 'kpml-i::system)
         (format stream "~%~0T~25a" system))
       (clim:with-output-as-presentation
	   (stream feature 'kpml-i::feature)
         (format stream "~25T~a" feature))))
    (:function-association-table-pane
     (let ((stream (clim:get-frame-pane kpml-i::*fat-frame*
					'kpml-i::fat :errorp NIL)))
       ;; MAF 27/9/94: When we're in layout FIRST, 
       ;;              then the OUTPUT pane isn't there.
       (when stream 
	 (dolist (item strings-to-print)
	   (let ((short-string (truncate-string item 60)))
             ;;	       (format stream "~%~a" short-string)
             (kpml-i::pen-pprint-for-clim short-string nil stream T)
             )))))
    ((:display-pane :realization-pane)
     (unless *demo-mode*
       (if window-interface-flag
	   (let ((stream 
                  (clim:get-frame-pane kpml-i::*resource-development-frame*
                                       'kpml-i::inspector)))
	     (kpml-i-terpri stream)
	     (dolist (line strings-to-print)
	       (format stream "~%~a" (string line))))
         (dolist (line  strings-to-print )
           (format *standard-output* "~%~a" line)))))
    (:setup-item-list-for-show-pass-menu		
      (setq item-list-for-show-pass-menu
	    (append item-list-for-show-pass-menu
		    (list (format nil "Pass ~a" constituent-index)))))
    (:clear-item-list-for-show-pass-menu		
      (setq item-list-for-show-pass-menu nil))
    (:inquiry-name-pane
     ;;
     ;; 4.0 it was always annoying that a killed generation history
     ;;     frame would then cause problems here because it is
     ;;     not restarted when required. Fixed.
     ;;
     (let ((careful (clim:get-frame-pane kpml-i::*generation-history-frame*
				       'kpml-i::inquiry :errorp nil)))
       (unless careful
         (kpml-i::startup-generation-history-frame T))
          
      (let ((stream (clim:get-frame-pane kpml-i::*generation-history-frame*
				       'kpml-i::inquiry)))
       (setf *last-inquiry-mentioned* strings-to-print)
       (clim:with-output-as-presentation
	   (stream strings-to-print 'kpml-i::inquiry)
         (clim:window-clear stream)
         (kpml-i-terpri stream)
         (format stream "Inquiry:  ~a" strings-to-print)))) ;; 0.9.61
     )
    (:inquiry-question-pane
     (let ((stream (clim:get-frame-pane kpml-i::*generation-history-frame*
				        'kpml-i::inquiry-gloss)))
       (clim:with-output-as-presentation
	   (stream :object-was-missing-in-original 'string)
         (setq strings-to-print (indent-and-fill strings-to-print))
         (setf *last-question-mentioned* strings-to-print)
         (clim:window-clear stream)
         (clim:filling-output 
             (stream :fill-width 
	             (clim:bounding-rectangle-width 
                      (clim:window-viewport stream)))
           (dolist (item strings-to-print)
             (format stream "~a " item))))))
    (:inquiry-response-pane
     (let ((string (first strings-to-print))
	   blanks inquiry response
	   (stream (clim:get-frame-pane kpml-i::*generation-history-frame*
				 'kpml-i::inquiry-history)))
       (multiple-value-bind (atom position)
	   (read-from-string string)
	   (setf inquiry atom)
	   (setf response (read-from-string string nil nil :start position)))
       (setf blanks (- (length string)
		       (length (symbol-name inquiry))
;;; John:IPSI:Nov94; note that the types were in the wrong order since
;;; atom includes number...
		       (typecase response
			   (number (length (write-to-string response)))
			   (atom (length (symbol-name response)))
			   (cons
			    (+ 2 (length (symbol-name (first response)))))
			   (t 2))))
       (clim:with-output-as-presentation
	   (stream inquiry 'kpml-i::inquiry)
         (format stream "~%~a" inquiry)
         (dotimes (i blanks)
	   (format stream " ")))
       (cond ((and (atom response)
		   (or (member response *plan-graphs*)
		       (and (symbolp response)
			    (boundp response)
			    (typep (symbol-value response) 'term-graph))))
	      (clim:with-output-as-presentation
		  (stream response 'kpml-i::spl-term)
	        (format stream "~a" response)))
	     ((and (atom response)
		 (gethash response lexicon))
	    (clim:with-output-as-presentation
		(stream response 'kpml-i::lex-item)
	      (format stream "~a" response)))
	     ((listp response)
	      (format stream "(")
	      (dolist (item response)
	        (if (and (atom item)
		         (gethash item lexicon))
		    (clim:with-output-as-presentation
		        (stream item 'kpml-i::lex-item)
		      (format stream "~a" item))
		  (clim:with-output-as-presentation
		      (stream item 'string)
		    (format stream "~a" response))))
	      (format stream ")"))
	     (t (clim:with-output-as-presentation
		    (stream response 'string)
		  (format stream "~a" response))))))
    (:target-text-pane
     #-(and aclpc acl3.0)
     (unless (or *demo-mode* common-lisp-user::*extended-development-frame*)
       (let ((stream
	      (clim:get-frame-pane 
	       kpml-i::*resource-development-frame* 'kpml-i::target)))
	 (clim:with-output-as-presentation
	     (stream :this-object-was-missing-in-original 'string)
	   (clim:window-clear stream)
	   (clim:filling-output 
	       (stream 
		:fill-width 
		(clim:bounding-rectangle-width (clim:window-viewport stream)))
	     (clim::with-text-style (stream Kpml-I::*fix--bold--10*)
	       (format stream "Target:  "))
	     (dolist (item strings-to-print)
	       (format stream "~a " item))))))))
  t)

;;; --------------------------------------------------------
;;;			      Askwindow
;;; --------------------------------------------------------
;;;
;;; ***KPML: this function is changed in parts, since it
;;;          was not possible under pint to have reasonable
;;;          interaction when the grammar met exception
;;;          conditions...
;;; **       Several patches from Markus have been added
;;;          (Oct94; Nov94)
;;  **       Throws back to the example runner tag if any
;;           questions come up during example running (John:
;;           Jan95)

(unless (fboundp 'tty-askwindow-real-window)
;;; Save the old version before committing the new one. MAF 22/10/94
	(setf (symbol-function 'tty-askwindow-real-window) 
	      #'askwindow-real-window)
	)


;;; The following got into trouble if used before the inspector
;;; frame is up and running. The simplest thing is to use the
;;; main root-frame if no development frame is up. If the
;;; interface is loaded, but a window is missing, the
;;; frames are bound to nil. 
;;; (0.9.14 now folded in as per 0.9.39)
;;; 0.9.44 folded in.
;;; 1.1 slight corrections...

#+(or allegro aclpc lispworks)
(defun ASKWINDOW-REAL-WINDOW 
    (type-of-ask strings-to-print &optional (choices nil))
  "Performs a version of prompt-and-read,
   all user input is done through this function"

  ;; If running examples, never ask anything!
  (when example-runner-flag
	(user-request-during-example-running strings-to-print))

  (let* ((user-answer nil)
	 (source-frame 
	  (cond ((and (boundp 'kpml-i::*resource-inspector-frame*)
		      kpml-i::*resource-inspector-frame*)
		 kpml-i::*resource-inspector-frame*)
		((and (boundp 'kpml-i::*resource-manager-frame*)
		      kpml-i::*resource-manager-frame*)
		 kpml-i::*resource-manager-frame*)
		(t nil)))
	 (lisp-listener-pane
	  (when source-frame
		(clim:get-frame-pane source-frame 'kpml-i::interactor))))
    (declare (ignore lisp-listener-pane))

  ;; If the KPMLI Inspector is not up, use the TTY version. MAF 22/10/94
    (unless source-frame
      (return-from askwindow-real-window
	(askwindow-tty type-of-ask strings-to-print choices)))

    (unwind-protect
	(block nil
	  (setq *in-askwindow-flag* t)
	  (when (stringp strings-to-print)
	    (setq strings-to-print (list strings-to-print)))
	  (case type-of-ask
	    (:choice
;; the old choice by choosing a number is replaced by a 
;; menu...	     
	      (unless (>= (length choices) 2)
		(break "~%Asking for a choice with less than 2 choices does not
                          make sense - choices: ~a" choices))
	      (setf user-answer
	       (#-lispworks kpml-i::menu-choose
                #+lispworks kpml-i::no-messing-menu-choice
                choices
                :associated-window (clim:frame-top-level-sheet source-frame)
                :label
                (format nil "User Choice~%~{~%~A~}" strings-to-print))))
	    (:yes-or-no
;;; 0.9: under Allegro and CLIM-2, the previous treatment had the
;;; completely unwanted effect that all other processes were held up
;;; waiting for the selection to be made: often what we want is
;;; precisely to hold generation up so that options in the other
;;; processes can be reset. This needs to be achieved here but is
;;; tricky, since an open menu or accepting-values seems to put all
;;; other contexts out of business. We use an additional application
;;; frame for this with its own process, which seems like a bit of
;;; overkill but is at least straightforward...

	     (setf user-answer (kpml-i::startup-user-response-frame
				strings-to-print))
	     (when (eq user-answer :abort) (abandon-generation)) ;; 0.9.14
	     (setf user-answer
	       (if (or (eq user-answer :no)(eq user-answer :abort))
		   nil
		 T)))
	    (:value
	     ;; introduced an accepting-values dialog here. MAF, 19/10/94
             ;; 2.1 lispworks appears extra fussy suddenly...
             (let ((stream #-lispworks NIL
                           #+lispworks (clim:frame-top-level-sheet
                                        source-frame)))  
                ;; see :yes-or-no case above. MAF, 24/11/94
	       (restart-case
		   (clim:accepting-values 
		       (stream
			:own-window T
			:exit-boxes '((:exit "Accept")(:abort "Abort")))
		     (dolist (line  strings-to-print )
		       (format stream "~%~a" line))
		     (kpml-i-terpri stream)
		     (setq user-answer 
		       (clim::accept 'clim::string :stream stream
                                     :default "")))
		 (abort () 
		   ;; 2.1 was to wrong packaged version
		   (abandon-generation)))))
	    (:any-key-to-continue
	     ;; 0.9.44 Previously used a clim:notify-user which freezes the
	     ;; the entire interface...
	     (setf user-answer (kpml-i::startup-user-response-frame
				'("Select any of the additional "
				  "options available in the menu "
				  " and then click (yes or no) to continue.")))
	     (when (eq user-answer :abort) (abandon-generation)) ;; 2.1
	     (setf user-answer
	       (if (eq user-answer :yes)
		   T
		 nil)))
	    
	    (otherwise (break)))
	  (unless (or (eq user-answer t)
		      (eq user-answer nil)
		      (equal user-answer ':continuing))
		  (printwindow :display-pane
			       `( " "
				  ,(format nil "The user answers: ~a" 
					   user-answer)
				  " ")))
	  (return-from askwindow-real-window user-answer))
      )))





(defun ASKSOMETHING (strings-to-print)
  (let ((stream NIL)
        (user-answer nil))
    (kpml-i::startup-user-response-frame strings-to-print)
    ;; 2.1 no kpml-i package version anymore
    (abandon-generation)))

