(in-package "KPML-I")
;;;
;;; File: misc-extra-frames.lisp
;;; Author: John Bateman
;;; Created: 14 Oct 95
;;; Last Update: Apr 99, 2.1
;;;
;;; In the new KPML interface there is a miscellany of extra windows
;;; that are used for various kinds of information; this is so that
;;; they are available without cluttering the main information
;;; giving windows. Their definitions are gathered here.
;;;
;;; Windows (i.e., application frames and their options) so far
;;; included are:
;;; 1) the function association information during generation...
;;; 2) system and inquiry history during generation...
;;; 3) user-response frame
;;; 4) info fram
;;; 5) generated string and semantics frame
;;; 6) a frame for use when showing examples of features
;;; ----------------------------------------------------------------------

(defvar *results-display-font* *sans-serif--roman--14*)

;;; ----------------------------------------------------------------------
;;; Function association frame
;;;
(clim:define-application-frame 
 FAT-FRAME ()
 ()
 (:menu-bar NIL)
 (:command-table 
  (fat-frame
   :inherit-from (kpml-resource-inspector)))
 (:top-level (clim:default-frame-top-level))
 (:panes (fat         :application
                      :scroll-bars T
		      :foreground spl-fg
		      :background spl-bg
		      :text-style *sans-serif--roman--12*))
 (:layouts (first 
	     fat)))

#+acl3.0(defun STARTUP-FAT-FRAME (&optional (reset T))
	  (setf *fat-frame*
		*resource-development-frame*))

#-acl3.0
(defun STARTUP-FAT-FRAME (&optional (reset T))
  (when (and reset *fat-frame*)
    (close-a-window *fat-frame*)
    (setf *fat-frame* nil))
  (unless *fat-frame*
	  (let* ((frame (setf *fat-frame*
			      (clim:make-application-frame
			       'fat-frame
			       :pretty-name 
			       "Function-Associations (KPML)"
			       :left 100 :top 20
			       :width 350 :height 400)))
		 (process
		  (process-run-function "KPML-FAT" 
					   #'run-packaged-frame
					   *fat-frame* *package*)))
	    (push (cons frame process) *frame-process-alist*))))


(defun CLEAR-FAT-PANE ()
  (when *fat-frame*
    (let ((pane (clim:get-frame-pane *fat-frame* 'fat :errorp nil)))
      (when pane (clim:window-clear pane)))))


;;; ----------------------------------------------------------------------
;;; System and inquiry history during generation
;;; 1.0 color problem (palette full) goes away with ACL4.3

(clim:define-application-frame 
 GENERATION-HISTORY-FRAME ()
 ()
 (:menu-bar T)
 (:top-level (clim:default-frame-top-level))
 (:command-table 
  (generation-history-commands
   :inherit-from (kpml-resource-inspector)
   :menu
   (("Generate" :menu generation-options-table)
    ("Graph structure" :command com-graph-sentence-structure)
    ("Stepping" :menu generation-stepper-table))))
 (:panes 
  (system      :application
	       :scroll-bars nil
	       :foreground system-fg
	       :background system-bg 
	       :text-style *fix--bold--12*)
  (system-history   :application
		    :scroll-bars :vertical
		    :foreground system-history-fg
		    :background system-history-bg 
		    :text-style *sans-serif--roman--12*)
  (inquiry-gloss      :application
		      :scroll-bars :vertical
		      :foreground inquiry-fg
		      :background inquiry-bg
		      :text-style *fix--bold--12*)
  (inquiry     :application
	       :scroll-bars nil
	       :foreground inquiry-fg
	       :background inquiry-bg 
	       :text-style *fix--bold--12*)
  (inquiry-history     
   :application
   :scroll-bars :vertical
   :foreground inquiry-history-fg
   :background inquiry-history-bg 
   :text-style *sans-serif--roman--12*)
  (mouse-doc   :pointer-documentation
	       :foreground  mouse-doc-fg
	       :background  mouse-doc-bg))
 (:layouts (first 
	    (clim:vertically
	     ()
	     (:fill
	      (clim:horizontally 
	       ()
	       (1/2 (clim:vertically 
		     ()
		     (1/6 system)
		     (:fill system-history)))
	       (:fill (clim:vertically
		       ()
		       (1/6 inquiry)
		       (:fill inquiry-history)))))
	     (10/32 inquiry-gloss)
	     #-lispworks mouse-doc))))



(defun STARTUP-GENERATION-HISTORY-FRAME (&optional (reset T))
  (when (and reset *generation-history-frame*)
    (close-a-window *generation-history-frame*)
    (setf *generation-history-frame* nil))
  (unless *generation-history-frame*
	  (let* ((frame (setf *generation-history-frame*
			      (clim:make-application-frame
			       'generation-history-frame
			       :pretty-name 
			       "Generation History (KPML)"
			       :left 100 :top 20
			       :width 500 :height 400)))
		 (process
		  (process-run-function "KPML-GH" 
					   #'run-packaged-frame
					   frame 
					   (find-package "KPML"))))
	    (label-generation-history-panes)
	    (push (cons frame process) *frame-process-alist*))))


(defun LABEL-GENERATION-HISTORY-PANES ()
  #+lispworks
  (loop until (clim:get-frame-pane *generation-history-frame* 'system :errorp nil) 
        do (sleep 1))
  (format (clim:get-frame-pane *generation-history-frame* 'system) 
	  "System:")
  (format (clim:get-frame-pane *generation-history-frame* 'inquiry) 
	  "Inquiry:")
  )

(defun CLEAR-GENERATION-HISTORY-PANES ()
  (let ((windows '(SYSTEM INQUIRY 
		   SYSTEM-HISTORY 
		   INQUIRY-HISTORY 
		   INQUIRY-GLOSS)))
    (when *generation-history-frame*
	  (loop for window-name in windows
		for window = (clim:get-frame-pane
			      *generation-history-frame* 
			      window-name :errorp NIL)
		if window do (clim:window-clear window))
	  (label-generation-history-panes))))

;;; ----------------------------------------------------------------------

(clim:define-application-frame 
 INFO-DISPLAY-FRAME ()
 ((info-to-display :initform nil)
  (type-of-info :initform nil)
  (highlighter1 :initform nil)
  (highlight2-p :initform nil)
  (origin :initform nil))
 (:menu-bar NIL)
 (:top-level (clim:default-frame-top-level))
 (:command-table 
  (user-response-commands
   :inherit-from (kpml-resource-inspector)))
  (:panes 
   (info :application
;;; 0.9.2
	 :incremental-redisplay T
	 :display-function 'info-displayer
	 :width 300
	 :foreground inspector-fg
	 :background inspector-bg 
	 :text-style *fix--bold--10*))
  (:layouts
   (first info)))

(defmethod INFO-DISPLAYER ((frame info-display-frame) stream)
  (cond (
	 ;; 4.0 an extra option... 
	 ;;     this type of information expects lists of lists of
	 ;;     strings that are already trimmed to an appropriate
	 ;;     length for display purposes. Each list of lists
	 ;;     is one "item" of information...
	 ;;
	 (equal (slot-value frame 'type-of-info) :formatted-strings)
	 (loop for w in (slot-value frame 'info-to-display)
	       do (format stream "~{~%~A~}" w)))
	((slot-value frame 'type-of-info)
	 (macrolet 
	  ((print-it () 
		     '(format stream  
			      #-acl3.0 "~0T~W"
			      #+acl3.0 "~0T~A"
			      item)))
	  (with-slots (highlighter1 highlight2-p) frame
		      (loop for item in (slot-value frame 'info-to-display)
			    as count from 0
			    do 
			    (clim:updating-output 
			     (stream :unique-id count
				     :cache-value item)
			     (clim:with-output-as-presentation 
			      (stream item (slot-value frame 'type-of-info))
			      (cond ((and highlighter1 (funcall highlighter1 item))
				     (clim:with-drawing-options 
				      (stream :ink clim:+magenta+)
				      (clim:with-text-face (stream :bold)
							   (print-it))))
				    ((and highlight2-p (funcall highlight2-p item))
				     (clim:with-text-face (stream :italic)
							  (print-it)))
				    (t (print-it))))
			     (kpml-i-terpri stream))))))
	(t
	 (kpml-i::pen-pprint-for-clim 
	  (slot-value frame 'info-to-display) nil stream))))

(defvar *info-frame* nil)
(defvar *info-offset* nil)

(defvar *current-offsets* '(150 20) "current top lh-corners of popups")
(defvar *initial-offsets* '(150 20) "starting top lh-corners of popups")

(defvar *offset-deltas* '(20 20))

(defun OFFSET-WINDOW-IF-NECESSARY (offset)
  (cond ((and offset
	      (eq offset *info-offset*))
	 (setf 
	   (first *current-offsets*)
	   (+ (first *current-offsets*) (first *offset-deltas*))
	   (second *current-offsets*)
	   (+ (second *current-offsets*) (second *offset-deltas*))))
	(t
	 (setf *info-offset* offset)
	 (setf (first *current-offsets*) (first *initial-offsets*)
	       (second *current-offsets*) (second *initial-offsets*)))))


;;; 2.0 parameters changed to keys and highlighters added.
;;; 2.1 origin in structure parameter added.
(defun STARTUP-AN-INFO-WINDOW (label info 
			       &key (type nil)(offset nil)(node-origin nil)
                                    (highlight1-p nil)
                                    (highlight2-p nil))
  (offset-window-if-necessary offset)       ;; 1.0.8
  (setf *info-frame*
    (clim:make-application-frame
     'info-display-frame
     :pretty-name label
     :left (first *current-offsets*) :top (second *current-offsets*)
     :width #+lispworks (get-label-width label)
            #-lispworks 300 
     :height 400))
  (setf (slot-value *info-frame* 'info-to-display) info)
  (setf (slot-value *info-frame* 'type-of-info) type)
  (setf (slot-value *info-frame* 'highlighter1) highlight1-p)
  (setf (slot-value *info-frame* 'highlight2-p) highlight2-p)
  (setf (slot-value *info-frame* 'origin) node-origin)
  (process-run-function 
   "KPML-INFO"
   #'RUN-PACKAGED-FRAME
   *info-frame* (find-package "KPML") ))

;;; ----------------------------------------------------------------------
;;; Harlequin PC Lispworks sometimes goes and breaks on us if the label is
;;; to wide for the window :-(. 
;;; ----------------------------------------------------------------------

(defun GET-LABEL-WIDTH (label)
  600)

;;; ----------------------------------------------------------------------
;;; Following no longer relevant since using a display method
;;; solves the problem of the pane not knowing how big it is.

(defun PANE-INSPECTION-CHAR-WIDTH (pane)
  (floor
   (/
    (clim:bounding-rectangle-width 
     (clim:window-viewport 
      pane))
    7.0)))

;;; ----------------------------------------------------------------------
;;; And another more or less the same for displaying the results of
;;; generation in a pop-up window. Turned off by default, but pretty
;;; for demos (when larger fonts are switched on...)

;;; With 1.0 adds in language slot to the frame so that different languages
;;; can select their required fonts more readily... Mostly for
;;; Greek and Russian, since other fonts will need more extensive
;;; double-byte treatments I suppose.
;;; 0.9.10 (0.9.36 and 0.9.38 folded in).

(clim:define-application-frame 
 RESULTS-DISPLAY-FRAME ()
 ((info-to-display :initform nil)
  (lg :initform nil))
 (:menu-bar T)
 (:top-level (clim:default-frame-top-level))
 (:command-table 
  (results-display-frame
   :inherit-from (kpml-resource-development)
   :menu
   (("Generate" :menu generation-options-table-2)
    ("Redisplay" :command com-redisplay-results)
    ("Structure" :command com-graph-sentence-structure)
    ("Quit" :command com-quit-results))))
 (:panes 
  (info :application
	 :display-function 'results-displayer
	 :foreground inspector-fg
	 :background inspector-bg 
	 :text-style *results-display-font*))
  (:layouts
   (first info)))


(defvar *display-frame* nil)

(define-results-display-frame-command 
    (com-REDISPLAY-RESULTS :menu t :name "Redisplay")
    ()
  (clim:redisplay-frame-pane clim:*application-frame* 'info)
  (undo-lg-based-font-decision *results-display-font*))

(define-results-display-frame-command
    (com-QUIT-RESULTS :menu t :name "Quit")
    ()
  (undo-lg-based-font-decision *results-display-font*)
  (close-a-window clim:*application-frame*))



(defun STARTUP-A-RESULTS-WINDOW (&optional (lg kpml::curlan)(offset nil))
  (cond ((eq (kpml::language-font-style lg :popup T) :mule) ;; 0.9.36/41
	 (display-generated-string-in-emacs-buffer))
	((eq (kpml::language-font-style lg :popup T) :emacs) ;; 0.9.41
	 (display-generated-string-in-emacs-buffer))
	(t
	 (offset-window-if-necessary offset)                ;; 0.9.36
	 (setf *display-frame*
	   (clim:make-application-frame
	    'results-display-frame
	    :pretty-name "Generation Result"
	    :left (first *current-offsets*) :top (second *current-offsets*)
	    :width 500 :height (if *display-structures* 600 300)))
	 (setf (slot-value *display-frame* 'info-to-display) 
	   kpml::*mouseable-sentences*
	   (slot-value *display-frame* 'lg) lg)             ;; 0.9.36
	 (process-run-function 
	  "KPML-RESULTS"
	  #'run-packaged-frame
	  *display-frame* (find-package "PENMAN"))
	 (undo-lg-based-font-decision *results-display-font*))))


;;; ----------------------------------------------------------------------
;;; 2.1 added non-specific method...
;;;
;;;     under Lispworks, the following seem to be getting an unfortunately
;;;     small window width passed down which causes them to break lines
;;;     very uglily.... This is evidently due to a bug in filling-output
;;;     so this is conditionalized out in Lispworks until further notice.
;;;     LWW4.1.19 at least appears to have fixed the filling-output
;;;     bug, so conditionalized back in...  
;;; ----------------------------------------------------------------------

(defmethod RESULTS-DISPLAYER ((frame results-display-frame) stream)
  (generic-results-display frame stream))

(defun GENERIC-RESULTS-DISPLAY (frame stream)
  (let ((lg (slot-value frame 'lg)))
    ;; 2.0.17
    (with-possible-font-changes-for-language 
	(stream lg *results-display-font*)
      (loop for result in (slot-value frame 'info-to-display)
	  as index from 1
	  do 
	    (when *display-structures*
	      (format stream "~%Function Structure: ~A" index)
	      (mouseable-structure-display  
	       result
	       (kpml::printable-constituent-to-structure-tree result)
	       0 stream))
	    (kpml-i-terpri stream)
            #-lispworks4.0
            (clim:filling-output 
		(stream :fill-width 
			(max 100
			     (- (clim:bounding-rectangle-width 
				 (clim:window-viewport stream))
				100)))
              (mouseable-sentence-display result stream lg))  ;; 0.9.38
            #+lispworks4.0
            (mouseable-sentence-display result stream lg)
	    (kpml-i-terpri stream)))))

;;; ----------------------------------------------------------------------
;;; 2.1
;;;     Spl and generation result frame... (not multilingual yet)
;;;
  ;; 3.2.42
  ;; In 3.2+ the following should also become a frame slot
  ;; along the lines of mouse-sensitive-spl-p. But don't to that
  ;; here to avoid patching the entire frame definition.
  ;; Or maybe not: perhaps it is better the other round, and these
  ;; do become global flags, since it is often the behaviour during
  ;; a session that one wants to influence not individuals. The
  ;; best option is therefore to have both: a global default setting
  ;; and individual window setting as desired. Just need a place
  ;; for setting the defaults...
  ;;
  ;; 4.0 added dynamic control of SPL size as it is a pain to keep
  ;;     going through the font defaults for a demo.
;;; ----------------------------------------------------------------------

(defvar *mouse-sensitive-spl-p* T)
(defvar *spl+generated-result-sentence-mousing* T)

(defun SPL-SIZE-PALETTE (frame stream)
  (with-slots (spl-size sentence-size mouse-sensitive-spl-p) frame
    (clim:formatting-table (stream)
      (clim:formatting-row (stream)
	(clim:formatting-cell 
	 (stream)
	 (hd-accepts spl-size '(integer 4 18) "SPL"
		     '(clim:slider-view :show-value-p t)))
        )
      (clim:formatting-row (stream)
	(clim:formatting-cell 
	 (stream)
	 (hd-accepts sentence-size '(integer 4 18) "sent"
		     '(clim:slider-view :show-value-p t)))
        )
      (clim:formatting-row (stream)
	(clim:formatting-cell 
	 (stream)
          (on-or-off *spl+generated-result-sentence-mousing* "mousing")
	 (setf mouse-sensitive-spl-p
	       *spl+generated-result-sentence-mousing*)
	 )
	))))

(clim:define-application-frame 
    SPL+GENERATED-RESULT-FRAME ()
  ((example-name :initform nil)
   (lg :initform kpml::curlan)
   (spl-size :initform *major-info-font-size*)
   (sentence-size :initform *major-info-font-size*)
   (info-to-display :initform nil)
   (mouse-sensitive-spl-p :initform *mouse-sensitive-spl-p*))
  (:menu-bar T)
  (:top-level (clim:default-frame-top-level))
  (:command-table 
   (spl+generated-result-frame-commands
    :inherit-from (kpml-resource-inspector kpml-resource-development
		  )))
  (:panes 
   (spl-display :application
		:scroll-bars :vertical
		:foreground interactor-fg
		:background interactor-bg
		:display-function 'spl-displayer)
   (generated-result :application
		     :scroll-bars :vertical
		     :display-function 'results-displayer)
   #-lispworks4.0
   (option-palette :accept-values
                   :text-style *sans-serif--roman--6*
                   :scroll-bars nil
                   :display-function '(clim:accept-values-pane-displayer
                                       :align-prompts t
                                       :displayer spl-size-palette)
                   :help-callback "SPL size")
   (mouse-doc   :pointer-documentation
	       :foreground  mouse-doc-fg
	       :background  mouse-doc-bg)
   (info       :application)
   )
  (:layouts
   (first (clim:vertically () 
	    (:fill spl-display) 
	    #-lispworks4.0 
	    (1/4 
	     (clim:horizontally 
	      ()
	      (7/8 generated-result)
	      (:fill option-palette)))
	    #+lispworks4.0
	    (:fill generated-result)
	    #-lispworks (2/32 mouse-doc)
	    ))))

;;; ----------------------------------------------------------------------
;;; Display methods...
;;; ----------------------------------------------------------------------

(defmethod RESULTS-DISPLAYER ((frame spl+generated-result-frame) stream)
  (when kpml::*mouseable-sentences*
    (kpml-i-terpri stream)
    (setf (slot-value frame 'info-to-display) kpml::*Mouseable-sentences*)
    (if *spl+generated-result-sentence-mousing*
	(generic-results-display frame stream)
      (with-slots (sentence-size) frame
      (clim:with-text-size 
       (stream sentence-size)
       (loop for s in kpml::*mouseable-sentences*
	     do
	     (filling (20)
	       (format stream "~{~A~}" 
		       (kpml::printable-constituent-to-printable-list s)))))))))
  
(defmethod SPL-DISPLAYER ((frame spl+generated-result-frame) spl-frame)
  (flet ((SPL-MOUSE-SENSITIVE-PP (object-as-string object-type)
	   (if kpml::*displaying-patched-object*
	       (clim:with-text-face (spl-frame :italic)
		 (kpml::kpml-mouse-sensitive-pp-intern 
		  spl-frame object-as-string object-type))
	     (kpml::kpml-mouse-sensitive-pp-intern 
	      spl-frame object-as-string object-type))))
    (with-slots (example-name mouse-sensitive-spl-p spl-size) frame
      (when example-name
	(let ((kpml::*shadowed-slots* 
	       '(:NAME :GENERATEDFORM :TARGETFORM :SELECTIONEXPRESSIONS
		 :PRESELECTIONS :SET-NAME :PATCH-STATUS :GLOSS :STRUCTURE))
	      (kpml::*window-right-margin* 60))
	  (declare (special 
		    kpml::*shadowed-slots* kpml::*window-right-margin*))
	  (clim:with-text-style (spl-frame kpml-i::*fix--bold--8*)
	    (clim:with-text-size 
		(spl-frame *info-font-size*)
	      (if mouse-sensitive-spl-p
		  (kpml::systemic-display example-name :object-type :example
					  :stream :interface
					  :presentation-handler 
					  #'spl-mouse-sensitive-pp)
		(let ((*standard-output* spl-frame))
		  (clim:with-text-size (spl-frame spl-size)
		    (kpml::print-example example-name)))))))))))

;;; ----------------------------------------------------------------------
;;; Startup function... displays SPL immediately and generated string
;;; when say is done.
;;; 3.0 generic
;;; ----------------------------------------------------------------------
  
(defun STARTUP-SPL-AND-GENERATED-RESULT-FRAME 
    (example-name preselections)
  (startup-spl-and-generated-result-frame-internal 
   example-name preselections :frame-tool-label example-name))

;;; ----------------------------------------------------------------------
;;; Usual minimal commands...
;;; ----------------------------------------------------------------------

(define-spl+generated-result-frame-command
    (com-QUIT-GENERATION-RESULTS :menu t :name "Quit")
    ()
  (undo-lg-based-font-decision *results-display-font*)
  (close-a-window clim:*application-frame*))

(define-spl+generated-result-frame-command
    (com-EDIT-SPL-FROM-GENERATION-RESULTS :menu t :name "Edit")
    ()
  (with-slots (example-name) clim:*application-frame*
      (let ((old-slot-shadows kpml::*shadowed-slots*)) 
	(push :structure kpml::*shadowed-slots*) ;; dont want to edit this stuff
	(push :selectionexpressions kpml::*shadowed-slots*)
	(push :preselections kpml::*shadowed-slots*)
	
	(edit-object example-name :example)
	(setf kpml::*shadowed-slots* old-slot-shadows))))

(define-spl+generated-result-frame-command
    (com-TOGGLE-SPL-SENSITIVITY :menu t :name "SPL mouse sensitivity?")
    ()
  (with-slots (mouse-sensitive-spl-p) clim:*application-frame*
    (setf mouse-sensitive-spl-p 
      (not mouse-sensitive-spl-p))
      (clim:redisplay-frame-pane clim:*application-frame* 'spl-display)))

(define-spl+generated-result-frame-command 
    (com-REDISPLAY-RESULTS+SPL :menu t :name "Redisplay")
    ()
  (clim:redisplay-frame-pane clim:*application-frame* 'generated-result)
  (clim:redisplay-frame-pane clim:*application-frame* 'spl-display)
  (undo-lg-based-font-decision *results-display-font*))

(define-spl+generated-result-frame-command
    (com-TOGGLE-SENTENCE-SENSITIVITY 
     :menu t :name "Sentence mouse sensitivity?")
    ()
    (setf *spl+generated-result-sentence-mousing*
	  (not *spl+generated-result-sentence-mousing*))
    (clim:redisplay-frame-pane clim:*application-frame* 'generated-result))

;;; ----------------------------------------------------------------------
;;; ... and access to the constituency structure...
;;;     separate out the menu and showing the semantic term (left)
;;;     corresponding to the selected element (right)
;;; ----------------------------------------------------------------------

(clim:define-presentation-action PRESENT-MOUSABLE-KPML-OUTPUT-IN-SPL+RESULTS
    (mousable-kpml-output nil spl+generated-result-frame-commands
			  :gesture :menu
			  :documentation "Inspect constituent")
  (object)
  (mouseable-sentence-menu object clim:*application-frame*))
      
(clim:define-presentation-action PRESENT-SEMANTICS-IN-SPL+RESULTS
    (mousable-kpml-output nil spl+generated-result-frame-commands
			  :gesture :select
			  :documentation "Show SPL")
  (object)
  (kpml::describe-spl-term 
   (kpml::printable-constituent-concept (first object))))

;;; ----------------------------------------------------------------------
;;; The beginnings of better things for showing example generated strings
;;; as online documentation...
;;; ----------------------------------------------------------------------

(clim:define-application-frame 
     GENERATED-EXAMPLE-STRINGS ()
  ( (features :initform nil)
    (max-examples-shown  :initform *max-examples-shown*)
    (max-neg-examples-shown :initform *max-neg-examples-shown*)
    (sorted :initform *sort-examples-by-length*)
    (highlights :initform nil)
    )
  (:menu-bar T)
  (:top-level (clim:default-frame-top-level))
  (:command-definer T)
  (:command-table (GENERATED-EXAMPLE-STRINGS-COMMANDS
                   :menu
                   (
                    ("Set positive and negative maximum" :command com-set-max-examples)
                    ("Toggle sorting by length" :command com-sort-genexstrings)
                    ("Redisplay" :command com-redisplay-genexstrings)
                    ("-----" :divider :line)
                    #-acl3.0
                    ("Quit" :command com-quit-generated-example-strings))
                   ))
  (:panes 
   (example-list :application
		 :foreground interactor-fg
		 :background interactor-bg
		 :incremental-redisplay T
		 :display-after-commands T
		 :end-of-line-action :allow
		 :end-of-page-action :allow
		 :initial-cursor-visibility :inactive
		 :display-function 'generated-example-strings-displayer
		 :text-style *sans-serif--bold--10*
		 :scroll-bars :both)
   (mouse-doc   :pointer-documentation
		:foreground  mouse-doc-fg
		:background  mouse-doc-bg))
  (:layouts 
   (first 
    (clim:vertically
	()
      (:fill example-list)
      (2/32 mouse-doc)))
   ))

;;; ----------------------------------------------------------------------
;;; The commands...
;;; ----------------------------------------------------------------------

#-acl3.0
(define-generated-example-strings-command 
    (com-QUIT-GENERATED-EXAMPLE-STRINGS :name "Quit" :menu T)
    ()
  (close-a-window clim:*application-frame*)
  )

(define-generated-example-strings-command 
    (com-REDISPLAY-GENEXSTRINGS :name "Redisplay" :menu T)
    ()
  (clim:redisplay-frame-pane clim:*application-frame* 'example-list :force-p t))

(define-generated-example-strings-command 
    (com-SORT-GENEXSTRINGS :name "Toggle sorting by length" :menu T)
    ()
  (with-slots (sorted) clim:*application-frame*
    (setf sorted (not sorted))
    (clim:redisplay-frame-pane clim:*application-frame* 'example-list :force-p t)))

(define-generated-example-strings-command 
    (com-SET-MAX-EXAMPLES :name "Set positive and negative maximum" :menu T)
    ()
  (with-slots (max-examples-shown max-neg-examples-shown) clim:*application-frame*
    (let ((stream (clim::frame-top-level-sheet clim:*application-frame*)))
      (clim:accepting-values
        (#-acl3.0 stream #+acl3.0 *query-io* :own-window t
		  :height 200
		  :scroll-bars nil
		  :resynchronize-every-pass t
		  :label "Maximum number of examples to display dialogue" :exit-boxes 
		  '((:exit "Click here to exit")))
      (let ((stream #-acl3.0 stream #+acl3.0 *query-io*))
        (setf max-examples-shown
             (clim:accept 
              '(integer 1 10) :stream stream
              :default max-examples-shown
              :prompt #+lispworks (format nil "Maximum positive examples (~2D):" max-examples-shown)
                      #-lispworks "Maximum positive examples:"
              :view '(clim:slider-view :show-value-p t)))
        (kpml-i-terpri stream)
        (setf max-neg-examples-shown
             (clim:accept 
              '(integer 1 10) :stream stream
              :default max-neg-examples-shown
              :prompt #+lispworks (format nil "Maximum negative examples (~2D):" max-neg-examples-shown)
                      #-lispworks "Maximum negative examples:"
              :view '(clim:slider-view :show-value-p t)))))
    (clim:redisplay-frame-pane clim:*application-frame* 'example-list :force-p nil))))
        
;;; ----------------------------------------------------------------------
;;; The work... this time in a display method...
;;; ----------------------------------------------------------------------

(defmethod GENERATED-EXAMPLE-STRINGS-DISPLAYER ((frame generated-example-strings) stream)
  (with-slots (features max-examples-shown max-neg-examples-shown sorted) frame
    (clim:with-end-of-line-action (stream :wrap)
      (loop for f in features 
            do
            (let ((max (if (kpml::negative-feature-p f) max-neg-examples-shown max-examples-shown)))
              (clim:updating-output (stream :cache-value (cons f max))
                (let* ((fset (list f))
                       (examples-list
                        (filter-selected-examples (kpml::get-examples-with-features fset)))
                       (exlist
                        (if sorted
                            (sort examples-list
                                  #'(lambda (a b)
                                      (< (length (kpml::fetch-example-info a 'kpml::generatedform))
                                         (length (kpml::fetch-example-info b 'kpml::generatedform)))))
                          examples-list))
                       (kpml::*collected-features* fset))
                  (declare (special kpml::*collected-features*))
                  (if exlist
                      (let* ((*highlights* nil))    
                        (declare (special *highlights*))
                        (setf *highlights* (kpml::get-used-microfunctions features))
                        (clim:updating-output (stream :cache-value exlist)
                          (let ((examples exlist))
                            (clim:with-text-style  
                                (stream *fix--bold-italic--10*)
                              (format stream "~%Using feature: ~A~%" f))
                            (clim:with-text-style
                                (stream *sans-serif--roman--9*)
                              (clim:with-text-size
                                  (stream *major-info-font-size*)
                                (loop for ex in examples
                                      as n from 1 to max
                                      do 
                                      (clim:updating-output (stream :cache-value ex)
                                        (display-string-of-example ex nil stream))))))))
                    (clim:updating-output (stream :cache-value exlist)
                      (clim:with-text-style  
                          (stream *fix--bold-italic--10*)
                        (format 
                         stream "~%No examples using feature: ~A~%" f)))))))))))
  
(define-GENERATED-EXAMPLE-STRINGS-command
    (com-PRESENT-MOUSABLE-EXAMPLE-CONSTITUENT
     :name "Graph constituent structure" :menu nil)
    ((object 'mousable-kpml-output :gesture :select))
  (graph-example-structure (first object)))

(define-GENERATED-EXAMPLE-STRINGS-command
    (com-PRESENT-MOUSABLE-EXAMPLE-CONSTITUENT-MENU
     :name "Constituent inspection menu" :menu nil)
    ((object 'mousable-kpml-output :gesture :menu))
  (genex-mouseable-sentence-menu object))

(defun STARTUP-GENERATED-EXAMPLE-STRING-FRAME (features label)
  ;; taken from results window above...
  (declare (special *display-frame*))
  (setf *display-frame*
        (clim:make-application-frame
            'generated-example-strings
          :pretty-name label
          :left (first *current-offsets*) :top (second *current-offsets*)
          :width 500 :height 600))
  (setf (slot-value *display-frame* 'features) features)
  (process-run-function 
   "KPML-GENERATION" 
   #'run-packaged-frame *display-frame* (find-package "KPML")))


(defun GENEX-MOUSEABLE-SENTENCE-MENU (full-node)
  (let* ((node (first full-node))
	 (lg   (third full-node))
	 (example (second full-node))
	 (stream (clim:get-frame-pane *resource-development-frame*
				      'inspector))
	 (stream2 (clim:get-frame-pane *resource-inspector-frame*
				     'inspector))
	 (function-key (kpml::function-pack
			(kpml::printable-constituent-functions node))))
    (case
	(menu-choose 
	 '(|Show corresponding fundle|
	   |Inspect selection expression|
	   |Inspect corresponding semantic term|
	   |Mark this example|
	   )
	 :associated-window 
	 (clim:frame-top-level-sheet *display-frame*)
	 :label "Generated string options ...")
      (|Mark this example|
       (pushnew example *currently-marked*)
       (when *ex-op-frame*
	 (setf (slot-value *ex-op-frame* 'marked-set) *currently-marked*)))
      (|Show corresponding fundle|
       (format stream "~%Corresponding fundle is: ~A"
	       function-key))
      (|Graph corresponding constituent and below|
       (graph-example-structure node))
      (|Inspect selection expression|
       (show-selection-expression stream stream2 node))
      (|Inspect corresponding semantic term|
       (format stream2 "~%Semantic term for grammatical function ~A is:"
	       function-key)
       (kpml::describe-spl-term (kpml::printable-constituent-concept
				   node)))
      )))
