(in-package "KPML-I")

  ;; File: examples-as-docu.lisp
  ;; (experimental and underdevelopment)
  ;;
  ;; Moved from origin in misc-extra-frames.lisp in KPML 3.2 and before
  ;;   to be an independent file (patch 3.2.43 and integrated 3.2+).
  ;;
  ;;   March2001, Bremen: some of the sorting options for displaying
  ;;                      examples that were introduced for the grammar
  ;;                      explorer had somehow gone missing since 1998
  ;;                      or so. Reintroduced here by copying the necessary
  ;;                      commands from the KPML coding tool.
  ;;
  ;;   July2006, Bremen:  a couple of extra flags added, showing the
  ;;                      example names for example
  ;;
  ;; The scoring and the ordering of examples is pretty chaotic and just
  ;; sets out the means that are provided elsewhere in KPML for a variety
  ;; of reasons. But this is the place where ranking methods can be explored
  ;; and experimented with as required.

  ;; ----------------------------------------------------------------------
  ;; Flags...
  ;; ----------------------------------------------------------------------

(defvar *moused-examples-in-docu* nil)
(defvar *example-names-in-docu* nil)
(defvar *example-set-names-in-docu* nil)

  ;; N.B. ******************************************************************
  ;; The following two definitions were in example-operations.lisp, they
  ;; have been removed from there as these definitions replace them.
  ;;      ******************************************************************

(defun FILTER-SELECTED-EXAMPLES (exlist-para)
  (let ((exlist (if *example-set-restriction*
		       (remove-if
			#'(lambda (ex)
			    (member (kpml::fetch-example-info ex 'kpml::set-name)
				    *example-set-restriction*))
			exlist-para)
		     exlist-para)))
    (when exlist
      (labels ((select (feature-set-filter) 
		 (let ((scores 
			(loop for ex in exlist
			    collect 
			      (cons (score-feature-occurrence ex feature-set-filter)
				    ex))))
		   (if (and *max-examples-shown*
			    (> (length scores) *max-examples-shown*))
		       (loop for n from 1 to *max-examples-shown*
			   while scores 
			   collect
			     (loop for (s . ex) in scores
				 with max = -1
				 and bestex = nil
				 when (> s max)
				 do (setf max s bestex ex)
				 finally 
				   (progn
				     (setf scores
				       (remove-if 
					#'(lambda (x)
					    (and (= (car x) max)
						 (equal (cdr x) bestex)))
					scores))
				     (return bestex))))
		     (mapcar #'cdr (sort scores #'> :key #'car))))))
	(case *example-filter-method*
	  (:none exlist)
	  (:collected 
	   (let ((exlist (remove-if 
			  #'(lambda (ex) 
			      (not (kpml::example-uses-features-p
				    ex kpml::*collected-features*)))
			  exlist)))
	     (select kpml::*collected-features*)))
	  (:selected 
	   (let ((exlist (remove-if 
			  #'(lambda (ex) 
			      (not (kpml::example-uses-features-p
				    ex kpml::*collected-features*)))
			  exlist)))
	     (select kpml::feature-selections))))))))
     

(defun SCORE-FEATURE-OCCURRENCE (ex filter)
  (loop for s 
      in (kpml::fetch-example-info ex 'kpml::selectionexpressions)
      sum (length (intersection (cddr s) filter))))


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

(clim:define-command-table 
 EXAMPLE-STYLE-TABLE
 :menu (
	("Sentence mouse sensitivity?" :command com-toggle-exdocu-sensitivity)
	("Set positive and negative maximum" :command com-set-max-examples)
	("Toggle sorting by length" :command com-sort-genexstrings)
	;; 4.0 extra options: July 2006
	("Toggle showing example names" :command com-toggle-exname-display)
	("Toggle showing example set names" :command com-toggle-exset-name-display)
	))

(clim:define-command-table 
    DOCU-EXAMPLE-RANKING-TABLE
    :menu (("No ranking of examples" :command com-coder-no-example-ranking)
	   ("----" :divider :line)
	   ("Ranked by collected features" 
	    :command com-coder-example-ranking-by-collecteds)
	   ("Ranked by current selection expression" 
	    :command com-coder-example-ranking-by-se)
	   ("---" :divider :line)
	   ("Collected features in single selection expression"
	    :command com-EXDOCU-COLLECTED-FEATURES-IN-SINGLE-SE)
	   ("Collected features anywhere"
	    :command com-EXDOCU-COLLECTED-FEATURES-ANYWHERE)
	   ("Collected feature anywhere"
	    :command com-EXDOCU-COLLECTED-FEATURE-ANYWHERE)
	   ))


(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
                   (
                    ("Redisplay" :command com-redisplay-genexstrings)
                    ("line1" :divider :line)
		    ("Select example ranking"
		     :menu docu-example-ranking-table)
		    ("Example presentation style"
		     :menu example-style-table)
		    ("Example set restrictions"
		     :command com-exdocu-restrict-exsets)
		    ("line2" :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...
;;; Proper filling added.
;;; ----------------------------------------------------------------------

(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))
	     ;;
	     ;; first thing we do is to get a list of filtered examples... 
	     ;; then we sort these according to length if required
	     ;; and go on to display them in that order, with highlighting 
	     ;; set appropriately for the particular feature or feature group
	     ;; that we are providing examples for...
	     ;;
	     (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*)
			  (filling 
			   (10)
			   (loop for ex in examples
				 as n from 1 to max
				 if *moused-examples-in-docu*
				 do
				 (clim:updating-output 
				  (stream :cache-value ex)
				  (show-example-ids ex stream)
				  (display-string-of-example ex nil stream))
				 else
				 do
				 (clim:updating-output
				  (stream :cache-value (cons ex nil))
				  (show-example-ids ex stream)
				  (format 
				   stream "~A~2%" (kpml::fetch-example-info 
						ex 'kpml::generatedform)))
				  )))))))
		 (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)))
      )))

  ;; ----------------------------------------------------------------------
  ;; Commands copied over from the KPML coder... Since these already
  ;; expect to have an effect on the example displays, there is nothing
  ;; else to do apart from add them in to menus so that they are
  ;; reachable.
  ;; ----------------------------------------------------------------------

(define-GENERATED-EXAMPLE-STRINGS-command
    (com-exdocu-RESTRICT-EXSETS :name "Restrict example sets" :menu T)
    ()
  (setf kpml-i::*example-set-restriction*
    (let ((selection
	   #-(and acl3.0 aclpc)
	   (let ((stream 
		  (clim::frame-top-level-sheet clim:*application-frame*))
		 (value kpml-i::*example-set-restriction*))
	     (clim:accepting-values
		 (stream :own-window T
			 :resynchronize-every-pass t
			 :label "Select example sets exclusion")
	       (setf value
		 (clim:accept `(clim:subset-sequence ,kpml::*ex-sets*)
			      :stream stream
			      :view 'clim:list-pane-view
			      :prompt "Select"
			      :default value))))
	   #+(and acl3.0 aclpc)
	   (kpml::get-a-subset-from kpml::*ex-sets* nil "Select:")))
      selection)))

(define-GENERATED-EXAMPLE-STRINGS-command
    (com-CODER-NO-EXAMPLE-RANKING :name "No example ranking" :menu nil)
    ()
  (setf kpml-i::*example-filter-method* :none)
  )

(define-GENERATED-EXAMPLE-STRINGS-command
    (com-CODER-EXAMPLE-RANKING-BY-COLLECTEDS 
     :name "Ranked by collected features" :menu nil)
    ()
    (unless kpml::*collected-features*
      (clim:notify-user clim:*application-frame*
			"N.B.: there are no features collected at present!"))
    (setf kpml-i::*example-filter-method* :collected)
    )

(define-GENERATED-EXAMPLE-STRINGS-command
    (com-CODER-EXAMPLE-RANKING-BY-SE
     :name "Ranked by current selection expression" :menu nil)
    ()
  (setf kpml-i::*example-filter-method* :selected)
  )

(define-GENERATED-EXAMPLE-STRINGS-command
    (com-TOGGLE-EXDOCU-SENSITIVITY 
     :menu t :name "Sentence mouse sensitivity?")
    ()
    (setf *moused-examples-in-docu*
	  (not *moused-examples-in-docu*))
    (clim:redisplay-frame-pane clim:*application-frame* 'example-list))

(define-GENERATED-EXAMPLE-STRINGS-command
    (com-TOGGLE-EXNAME-DISPLAY
     :menu t :name "Toggle showing example names")
    ()
    (setf *example-names-in-docu*
	  (not *example-names-in-docu*))
    (clim:redisplay-frame-pane clim:*application-frame* 'example-list))

(define-GENERATED-EXAMPLE-STRINGS-command
    (com-TOGGLE-EXSET-NAME-DISPLAY
     :menu t :name "Toggle showing example set names")
    ()
    (setf *example-set-names-in-docu*
	  (not *example-set-names-in-docu*))
    (clim:redisplay-frame-pane clim:*application-frame* 'example-list))


  ;; ----------------------------------------------------------------------
  ;; And these are modified straight from the example manager...
  ;; ----------------------------------------------------------------------

(define-GENERATED-EXAMPLE-STRINGS-command
    (com-EXDOCU-COLLECTED-FEATURES-IN-SINGLE-SE :name t :menu nil)
    ()
  (setf kpml::*example-using-features-condition* :in-same-selexpr))

(define-GENERATED-EXAMPLE-STRINGS-command
    (com-EXDOCU-COLLECTED-FEATURES-ANYWHERE :name t :menu nil)
    ()
  (setf kpml::*example-using-features-condition* :anywhere))

(define-GENERATED-EXAMPLE-STRINGS-command
    (com-EXDOCU-COLLECTED-FEATURE-ANYWHERE :name t :menu nil)
    ()
  (setf kpml::*example-using-features-condition* :some-feature-anywhere))

  ;; ----------------------------------------------------------------------
  ;; broken out display information ...
  ;; ----------------------------------------------------------------------

(defun SHOW-EXAMPLE-IDS (ex stream)
  (clim:updating-output 
   (stream :cache-value (cons :name *example-names-in-docu*))
   (when (and *example-names-in-docu* 
	      (not *example-set-names-in-docu*))
     (clim:with-text-style
      (stream *sans-serif--roman--9*)
      (format stream "[~A]" ex))))
  (clim:updating-output 
   (stream :cache-value 
	   (cons *example-names-in-docu* *example-set-names-in-docu*))
   (when (and *example-names-in-docu* *example-set-names-in-docu*)
     (clim:with-text-style
      (stream *sans-serif--roman--9*)
      (format stream "[~A in ~A]" 
	      ex
	      (kpml::fetch-example-info ex 'kpml::set-name))
      (unless *moused-examples-in-docu* (format stream "~%"))
      )))
  (clim:updating-output 
   (stream :cache-value (cons :sets *example-set-names-in-docu*))
   (when (and (not *example-names-in-docu*)
	      *example-set-names-in-docu*)
     (clim:with-text-style
      (stream *sans-serif--roman--9*)
      (format stream "[in ~A]" 
	      (kpml::fetch-example-info ex 'kpml::set-name))))))