(in-package "KPML-I")
;;;
;;; File: development.lisp
;;; Author: John Bateman
;;; Created: 14 Oct 95
;;; Last Update: Dec 99, Mar 2005
;;;
;;; Contains all the definitions for the windows and commands associated
;;; with the resource development functionality of the new KPML interface.
;;;
;;; 1.1 Extended functionality for the single development frame added to
;;;     support no-threading Allegro Common Lisp (3.0.2) for PCs. The
;;;     main interface commands are provided as a menu bar, while the
;;;     development commands continue in the menu pane as described in
;;;     the 1.1 manual. This is actually quite neat, and so will be provided
;;;     as an option for general use in any case.
;;;
;;; 2.1 user levels added.
;;;     Apr99, references/conditionalizations for CLIM-2 removed (no other
;;;            CLIM is supported).
;;;
;;; 3.0 Dec99, support for the non-extended development frame removed.
;;;
;;; 4.0 Mar05, more careful about looking for panes of windows that have
;;;            carelessly been killed by the user while no one was 
;;;            looking. This should actually be done systematically
;;;            for all uses of the clim:get-frame-pane, since it
;;;            might almost always be the case that the frame has
;;;            been got at. Just done for a couple of cases that
;;;            more often crop up for now.
;;; ----------------------------------------------------------------------
;;; Application frame definition and layout

(eval-when (:execute :load-toplevel :compile-toplevel)
  (setf common-lisp-user::*extended-development-frame* T))

;;; A dummy frame to hold the command table for the commands defined for
;;; development in the extended, single window version...
;;; This dummy frame thus mops up all the commands defined in this file
;;; and others. 

(clim:define-application-frame 
    DEVELOPMENT ()
  ()
  (:menu-bar NIL)
  (:top-level 
   (clim:default-frame-top-level :prompt kpml-prompt-function))
  (:panes (menu :command-menu))
  (:command-table 
   (kpml-resource-development 
    :inherit-from (kpml-interface kpml-resource-inspector)))
  (:command-definer define-kpml-resource-development-command)
  (:layouts (default menu)))

;;; The following frame is the one that is actually shown.

(clim:define-application-frame 
    KPML-RESOURCE-DEVELOPMENT ()
  ()
  (:menu-bar T)
  (:command-table 
   (development
    :inherit-from (kpml-resource-development kpml-interface 
			 flag-bar-frame)
    :menu
	  (("File" :menu file-menu-command-table)
	   ("Edit" :menu edit-menu-command-table)
	   ("Inspect" :menu inspect-menu-command-table)
           #+(and :kpml-level>= :kpml-l2)
           ("Traces" :menu GENERATION-MODES-COMMAND-TABLE)
	   #+(and :kpml-level>= :kpml-l2)	
	   ("Clear" :menu clear-menu-command-table)
	   #+(and :kpml-level>= :kpml-l2)	
	   ("Flags" :menu flag-menu-command-table)
	   #+(and :kpml-level>= :kpml-l2)	
	   ("Focusing" :command com-FOCUSING-OPERATIONS)
	   #+(and :kpml-level>= :kpml-l2)
	   ("MLM" :command com-MULTILINGUAL-BEHAVIOUR-MODES)
           #+(and :kpml-level>= :kpml-l1)
	   ("Windows" :menu window-launcher-table))))
  (:top-level 
	 (clim:default-frame-top-level :prompt kpml-prompt-function))
	(:panes 
	 (spl        :application
	  :foreground spl-fg
	  :background spl-bg
	  :text-style *sans-serif--roman--12*)
	 (target      :application
	  :scroll-bars nil
	  :foreground target-fg
	  :background target-bg
	  :text-style *fix--roman--12*)
	 (mode        :application
	  :foreground mode-fg
	  :background mode-bg
	  :text-style *sans-serif--roman--12*)
	 (output      :application
	  :foreground output-fg
	  :background output-bg
	  :text-style *fix--roman--10*)	   
	 (loom        :application
	  :foreground loom-fg
	  :background loom-bg
	  :text-style *fix--roman--10*)
	 (interactor  :interactor
	  :foreground interactor-fg
	  :background interactor-bg
	  :text-style *fix--roman--12*)
	 (ask-user    :application
	  :foreground ask-user-fg
	  :background ask-user-bg 
	  :text-style *sans-serif--roman--12*)
	 (inspector   :application
	  :scroll-bars :vertical
	  :foreground inspector-fg
	  :background inspector-bg 
               :incremental-redisplay T   ;; 4.1
	       ;; Dec08
	       ;; with LW 5 there are problems with the rather haphazard writing
	       ;; to this pane that was done previously. The following disables
	       ;; automatic scrolling but at least keeps the content of the pane
	       ;; from getting unreadable...
	       :display-after-commands T    
	       ;; :end-of-line-action :allow
	       #+(and :LISPWORKS5 :MSWINDOWS)  
	       :end-of-page-action 
	       #+(and :LISPWORKS5 :MSWINDOWS)  :allow
	  :text-style *main-info-font*)
	 (mouse-doc   :pointer-documentation
	  :foreground  mouse-doc-fg
	  :background  mouse-doc-bg)
	 (flag-bar   :application                       ;; 2.1
	  :display-function 'flag-bar-displayer
	  :height 20
	  :scroll-bars nil
	  :incremental-redisplay T
	  :initial-cursor-visibility :inactive
	  :foreground  flag-bar-fg
	  :background  mouse-doc-bg)
	 (menu        :command-menu
	  :height 100
	  :max-height 100
	  :display-function 'development-menu-displayer
	  :foreground menu-fg
	  :background menu-bg
	  :text-style *menu-font*))
	(:layouts 
	 #+(and :kpml-level>= :kpml-l2)	
	 (first
	  (clim:vertically 
	      ()
	    #-lispworks (100 menu) #+lispworks menu
	    (4/32 interactor)
	    (:fill inspector)
	    #-lispworks (20 flag-bar) #+lispworks flag-bar ;; 2.1
	    #-lispworks (2/32 mouse-doc)))
	 #-(and :kpml-level>= :kpml-l2)	
	 (first
	  (clim:vertically 
	      ()
	    #-lispworks (100 menu) #+lispworks menu
	    (4/32 interactor)
	    (:fill inspector)
	    #-lispworks (2/32 mouse-doc)))
	 (third inspector))
       (:command-definer kpml-resource-development-external-definer))


;;; ======================================================================
;;; Menu displayer for the extended development frame...
;;; (Not defined as a method since the generic function gets confused
;;; about how many arguments it gets!)

(defun DEVELOPMENT-MENU-DISPLAYER 
  (frame stream &key (max-height nil)(max-width nil))
  (clim:with-text-style 
      (stream (clim:medium-default-text-style 
	       (clim::get-frame-pane frame 'menu)))
    #-lispworks
    (clim:display-command-table-menu 
     (clim:find-command-table 'kpml-resource-development)
     stream
     :row-wise t)
    #+lispworks
    (clim:display-command-table-menu 
     (clim:find-command-table 'kpml-resource-development)
     stream
     :row-wise t
     :max-height max-height
     :n-columns 3)))

;;; ======================================================================
;;; Frame startups...
;;;
;;; 1.1 Note: for KPML under Windows using ACL3.0.2+ without threading, we
;;;     use the development inspector pane as the inspection pane generally.
;;; 3.0 frame definition moved within the thread that runs the frame for
;;;     conformance with ACL5.0 on PCs...

(defun STARTUP-RESOURCE-DEVELOPMENT-FRAME (&optional (reset nil))
  (when (and reset *resource-development-frame*)
    (close-a-window *resource-development-frame*)
    (setf *resource-development-frame* nil))
  (setf kpml::window-interface-flag T)
  (let ((process nil))
    (flet ((do-it ()
	     (let* ((frame (setf *resource-development-frame*
			     (clim:make-application-frame
			      'kpml-resource-development
			      :pretty-name 
			      "Development (KPML)"
			      :left 60 :top 20
			      :width #-mswindows 500 #+mswindows 800 :height 400))))
	       (setf *resource-inspector-frame* *resource-development-frame*)
	       (setf *frame* frame)
	       (when *development-frame-only*
		 (setf *resource-manager-frame* *resource-development-frame*))
	       (when kpml::*motd* (kpml::give-kpml-message-of-the-day))
	       (if (slot-value frame 'clim-internals::top-level-process)
		   (progn
		     (when (eq (clim::frame-state frame) :shrunk)
		       (clim::note-frame-deiconified (clim::frame-manager frame) frame))
		     (clim::raise-frame frame))
		 (run-packaged-frame frame *package*)))))
      (setf *frame* nil)
      (setf process (process-run-function "KPML DEVELOPMENT"  #'do-it))
      (loop for i from 1 to *frame-wait-timeout*
	  do
	    (sleep 1)
	    (when *frame*
              (let ((*frame-id* clim:*application-frame*))
                (declare (special *frame-id*))
                (update-frame-info *frame* process "root")
                (update-frame-list))
	      (return-from STARTUP-RESOURCE-DEVELOPMENT-FRAME T)))
      (kpml::warning "Frame creation timeout for: KPML DEVELOPMENT")

      ;; 2.1 following is removed, since there are not any panes to label anymore!
      ;;     it in any case can well produce an error (and does under Lispworks4.1)
      ;;     when the frame is not yet complete when the following is tried. When
      ;;     frame construction is slow, we can unbound slots that the following
      ;;     function tried to do something about. If we need to label anything
      ;;     anytime, should replace this function call with some suitable before
      ;;     method within the running frame process...
      #+ignore(label-resource-development-panes)))
  T)

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

(defun LABEL-RESOURCE-DEVELOPMENT-PANES ()
  (when *resource-development-frame*
	(let ((stream 
	       (clim:get-frame-pane *resource-development-frame* 
				    'target  :errorp NIL)))
	  (when stream
		(clim::with-text-style (stream *fix--bold--10*)
				       (format stream "Target:"))))))


;;; ----------------------------------------------------------------------
;;; Commands... (2.1 ordered so as to come out more sensibly in the menu
;;;                  display...)
;;; ----------------------------------------------------------------------

(define-kpml-resource-development-command 
  (com-GRAPH-SENTENCE-STRUCTURE
   :name "Graph Structure"		      
   :menu t)
  ()
  (GRAPH-SENTENCE-STRUCTURE))

(define-kpml-resource-development-command (com-SET-LANGUAGE
					   :name t :menu T)
  ()
  (let ((desired-lg (menu-choose 
		     kpml::all_languages
		     :associated-window 
		     (clim:frame-top-level-sheet 
		      clim:*application-frame*)
		     :label "Select a language")))
    (when desired-lg
	  (kpml::switch-language 
	   :language desired-lg 
	   :load-patches kpml::*patch-loading-on-language-switching*)

	  ;; 2.0.17
	  #+(and :unix :allegro)
	  (when (and
		 *global-font-switching*
		 (kpml::language-font-style desired-lg :inspector))
	    (setf (clim::text-style-mapping (clim::find-port) *main-info-font*)
	      (kpml::language-font-style desired-lg :inspector)))
	  )))

#+(and :kpml-level>= :kpml-l2)
(define-kpml-resource-development-command 
  (com-DEVELOPMENT-BS-OPTIONS :name "Clear tracing options" :menu T)
  ;; ... was difficult to clear inquiry pausing.
  ()
  (case
      (menu-choose
       '(("Clear all tracing" :value :clear-trace)
	 ("Clear traced systems" :value :clear-systems-trace)
	 ("Clear traced choosers" :value :clear-chooser-trace)
	 ("Clear traced inquiries" :value :clear-inqs-trace)
	 ("Clear paused inquiries" :value :clear-inqs-pause)
	 ("Clear collected features" :value :clear-features)
	 ("Clear resource graph stop points" :value :clear-stops)))
    (:clear-stops
     (setf *graph-stop-points* nil))
    (:clear-systems-trace
     (setf kpml::*traced-systems* nil))
    (:clear-chooser-trace
     (setf kpml::*traced-chooser-inquiries* nil))
    (:clear-inqs-pause
     (setf kpml::*inquiries-to-pause-upon* nil))
    (:clear-inqs-trace
     (setf kpml::*traced-inquiries* nil))
    (:clear-trace
     (setf kpml::*traced-inquiries* nil)
     (setf kpml::*traced-chooser-inquiries* nil)
     (setf kpml::*traced-systems* nil)
     (setf kpml::*inquiries-to-pause-upon* nil))
    (:clear-features
     (setf kpml::*collected-features* nil))))

(define-kpml-resource-development-command 
  (com-GENERATE-SENTENCE :name t :menu T)
  ()
  #+(or lispworks allegro lucid)(setf *say-process*
				  (cpc:make-process #'run-say-top-level
						    :name "say"))
  #+(and aclpc acl3.0)(run-say-top-level))

#+(and :kpml-level>= :kpml-l2)
(define-kpml-resource-development-command 
    (com-Abort-Generation-RD :name "Abort Generation" :menu t)
    ()
  (when (equalp (clim-sys:process-state *say-process*) "active")
    (format (clim::get-frame-pane 
	     *resource-development-frame*
	     'inspector)
	    "~%<Development activities reset.>~%")
    (clim-sys:destroy-process *say-process*)))

#+(and :kpml-level>= :kpml-l2)
(define-kpml-resource-development-command (com-RESET-GENERATION-MODES
			      :name t			      
			      :menu t)
    ()
    (kpml::reset-tracing-levels))

;;; Added in patch 0.7.22
(define-kpml-resource-development-command 
  (com-GENERATE-AGAIN :name t :menu T)
  ()
  #+(or allegro lispworks lucid)
  (setf *say-process* (cpc:make-process #'run-say-again :name "say"))
  #+(and aclpc acl3.0)(run-say-again))



#+(and (not :acl3.0) :kpml-level>= :kpml-l2)
(define-kpml-resource-development-command (com-PAUSE
				:name t
				:menu T)
    ()
  (when (and (find *say-process* (cpc:all-processes))
	     (equalp (cpc:process-state *say-process*) "active"))
	(format (clim::get-frame-pane 
		 *resource-development-frame*
		 'inspector)
		"~%<PAUSE>~%")
	(cpc:disable-process *say-process*)))

;;; ----------------------------------------------------------------------
;;; 2.0.55
;;; Following command for Prague! Allows easier to-ing and fro-ing between
;;; KPML and nonsupported editors. Set up a file containing the name of
;;; the file to be worked with, and use the -->Reload command anytime that
;;; file is to be reloaded. Use of kpml-load explicitly limits this to
;;; linguistic resources.
;;; 2.1, July99
;;; Jiri is never satisfied (:-), extended so that the indirection file contain
;;; a list of file names, one per line, and all of them are then reloaded
;;; in sequence...
;;; 3.2+ available in novice mode too so that lexical items and
;;;      examples can be easily defined in standalone mode.
;;; ----------------------------------------------------------------------

(define-kpml-resource-development-command
    (com-RELOAD-INDIRECTLY :name "-->Reload" :menu T)
    ()
  (unless *indirect-reload-filename*
    (setf *indirect-reload-filename*
      (clim:select-file clim:*application-frame*
			:directory kpml-i::*default-kpml-hardcopy-directory*)))
  (when *indirect-reload-filename*
    (with-open-file (stream *indirect-reload-filename*
		     :direction :input
		     :if-does-not-exist nil)
      (if (streamp stream)
          (loop for name = (read-line stream nil nil)
                while name
                do
                (let ((pathname (pathname name)))
	          (if (open pathname :direction :probe)
		      (kpml::kpml-load pathname)
		    ;; 3.0
		    ;; if we get a bad file name, then bomb out, since we
		    ;; we may be reading garbage...
		    (progn
		      (clim:notify-user clim:*application-frame*
					(format nil
						"Indirect path ~A does not exist. ~%Either create the file or reset from under the menubar option: CLEAR>indirect load file."
						pathname))
		      (return-from COM-RELOAD-INDIRECTLY nil)))))))))

;;; Added for 1.1
#+(and :kpml-level>= :kpml-l2)
(define-kpml-resource-development-command 
  (com-GENERATE-NEXT :name t :menu T)
  ()
  #+(or allegro lucid lispworks)
  (setf *say-process* (cpc:make-process #'run-say-on-next-example :name "say"))
  #+(and aclpc acl3.0)(run-say-on-next-example))

#+(and (not :acl3.0) :kpml-level>= :kpml-l2)
(define-kpml-resource-development-command (com-RESUME
			      :name t			      
			      :menu T)
    ()
    (when (and *say-process*
	       (find *say-process* (cpc:all-processes)))
	  (unless  (equalp (cpc:process-state *say-process*) "active")
		   (format (clim::get-frame-pane 
			    *resource-development-frame*
			    'inspector)
			   "~%<RESUME>~%")
		   (cpc:enable-process *say-process*))))

;;; Added for  2.0.54   
(define-kpml-resource-development-command 
  (com-TRAVERSE-GRAMMAR :name t :menu T)
    ()
  (if (kpml::who-has-as-input 'kpml::start)
      (let ((example (kpml::example :name kpml::%%traversal
				    :logicalform (u / um-thing))))
	(declare (ignore example))
	#+(and (or lispworks allegro lucid) CLIM-2) 
	(setf *say-process*
	  (cpc:make-process 
	   #'(lambda () (run-say-top-level 'kpml::%%traversal))
	   :name "say"))
	#+(and aclpc acl3.0)(run-say-top-level 'kpml::%%traversal))

    (clim:notify-user clim:*application-frame*
		      (format nil
			      "No network available for current language: ~A"
			      kpml::curlan))))



;;; Added for 1.1
#+(and :kpml-level>= :kpml-l2)
(define-kpml-resource-development-command 
  (com-GENERATE-NEXT-MARKED :name t :menu T)
  ()
  #+(or allegro lispworks lucid)
  (setf *say-process* (cpc:make-process #'run-say-on-next-marked-example
					:name "say"))
  #+(and aclpc acl3.0)(run-say-on-next-marked-example))

;;; ----------------------------------------------------------------------
;;; Remaining commands are available (when the user level is appropriate)
;;; but not from a menu... must type at prompt if really wanted (although
;;; some get picked up from menubar submenus).
;;; ----------------------------------------------------------------------

;;; 2.1 moved from main menu on to menu bar.
(define-kpml-resource-development-command 
  (com-GENERATION-DISPLAY-MODES :name "Generation Modes" :menu nil)
  ()
  (run-modes))

(define-kpml-resource-development-command 
  (com-READY-SPL-DEFAULTS :name t)
  ()
  (kpml::ml-ready-defaults kpml::curlan))

(define-kpml-resource-development-command (com-TOGGLE-SINGLE-STEP-2
					   :name "Toggle Single Step"      
					   :menu nil)
    ()
    (let ((stream (or (clim::get-frame-pane *resource-development-frame*
					    'inspector)
		      (clim::get-frame-pane *resource-manager-frame*
					    'inspector))))
      (setf kpml::stop-action-flag (not kpml::stop-action-flag))
      (when stream
        (if kpml::stop-action-flag
            (format stream "~%Single stepping on.")
	  (format stream "~%Single stepping off.")))))

;;; ----------------------------------------------------------------------
;;; More window and display management functions primarily for the
;;; development frame...
;;; ----------------------------------------------------------------------

(defun CLEAR-RESOURCE-DEVELOPMENT-PANES ()
  (let ((windows '(SPL 
		   OUTPUT 
		   ASK-USER 
		   INSPECTOR 
		   TARGET)))
    (loop for window-name in windows
	  for window = (clim:get-frame-pane
			*resource-development-frame* window-name :errorp NIL)
	  if window do (clim:window-clear window))
    (label-resource-development-panes)))


;;; 1.1 replaces example operations...
;;; 2.1 moved to window menubar option.
;;; 3.1 moved back again (for Jiri)...
(define-kpml-resource-development-command (com-EXAMPLE-MANAGER 
                                           :name "EXAMPLE MANAGER" :menu t)
  ()
  (startup-example-operations-frame))


;;; 3.1 added...
#+(and :kpml-level>= :kpml-l3)
(define-kpml-resource-development-command (com-PRE-FLIGHT-CHECKS
                                           :name "Perform checks" :menu t)
  ()
  (kpml::select-consistency-checks))


#+(and :kpml-level>= :kpml-l3)
(define-kpml-resource-development-command
  (com-SHOW-CUMULATIVE-HISTORY :name t :menu nil)
    ;; 2.0.55 remove from main development menu...
  ()
  (startup-cumulative-gh-frame))

  ;; 3.2.8 was not resetting code page during loading of the file.
  ;;
(define-kpml-resource-development-command 
  (com-RELOAD-LEXICON-FILE
   :name "Reload last loaded lexicon file"		      
   :menu nil)
  ()
  (if kpml::*last-loaded-lexicon-file*
      (let ((*standard-output* *trace-output*))
	(kpml::with-code-page-settings 
	 (kpml::curlan)
	 (kpml::kpml-load kpml::*last-loaded-lexicon-file*)))
    (kpml::interface-lexicon-loading)))

;;; ----------------------------------------------------------------------
;;; 2.0 updated to use fundle information in selectionexpressions
;;;     and secondary highlighting added.
;;; 2.0.17 font changes allowed here too under Lispworks...
;;; 2.0.26 fix folded in
;;; ----------------------------------------------------------------------

(defun MOUSEABLE-SENTENCE-DISPLAY 
    (mouseable-constituent-tree
     &optional (stream (clim:get-frame-pane 
			*resource-development-frame* 'inspector))
	       (lg kpml::curlan))
  (macrolet ((print-it ()
	       '(clim:updating-output (stream :cache-value element)
                  (if (and *highlights*
		     (intersection 
		      ;; 4.0 used to use the removed function
		      ;;     microfunction-name
		      (mapcar #'kpml::remove-fn-tag
		       (kpml::printable-constituent-functions
			mouseable-constituent-tree))
		      *highlights*))
		 (clim:with-text-face (stream '(:italic :bold))
		   (present-mouseable-sentence-element element stream lg))
		 (present-mouseable-sentence-element element stream lg)))))

    (with-conditional-font-changes-for-language 
	(stream lg)
      (clim:with-output-as-presentation
	(stream 
	 (list mouseable-constituent-tree kpml::*most-recent-example* lg)
	 'mousable-kpml-output)
      (dolist (element (kpml::printable-constituent-spelling
			mouseable-constituent-tree))
	(if (and *highlight-collected-features?*
		 kpml::*collected-features*
		 (let* ((concept 
			 (kpml::printable-constituent-concept 
			  mouseable-constituent-tree))
			(fundle (kpml::printable-constituent-functions
				 mouseable-constituent-tree))
			(example (find-example concept))
			(selexpr (find-sel-expr 
				  concept fundle 
				  ;; 2.0.26 why might the example change?
				  (or example kpml::*most-recent-example*))
				 ))
		   (loop for s in selexpr
		       thereis (intersection s  kpml::*collected-features*))))
	    (clim:with-drawing-options 
		(stream :ink clim:+magenta+)
	      (clim:with-text-face (stream :italic)
                (print-it)))
	  (print-it)))))))


;;; ----------------------------------------------------------------------
;;; Code for starting development actions such as generation...
;;; 0.9 example name mouse-sensitive
;;;     auto-creation of new examples added
;;;
;;; 1.1 following core startup code broken out of the various generate
;;;     functions added for 1.1 that follow...
;;; 2.1 demo-mode added for Renate
;;; ----------------------------------------------------------------------

(defun RUN-SAY-STARTUP 
  (example-name stream 
		&key
		(pre-message "~%<GENERATING (example: ")
		(post-message ")>"))
  (when *example-auto-creation*
	(let ((new-example-name (new-example-name example-name)))
	  (kpml::rename-example example-name new-example-name)
	  (setf example-name new-example-name)))
  (format stream pre-message)
  (clim:with-output-as-presentation
      (stream example-name 'example-name)
    (format stream "~A" example-name))
  (format stream post-message)
  ;; 2.1
  (when *reset-generation-history-each-generation* 
    (kpml::reset-generation-history))
  ;; We need to catch ABORT gestures from dialogs that might
  ;; pop up during generation. MAF 24/11/94
  (restart-case 
   (let ((*standard-output* stream))
     (if *show-spl-on-generation* 
	 (show-spl-and-say-and-display-results example-name stream)
       (say-and-display-results example-name stream)))
   (ABORT () 
	  (format stream "~2%Generation process aborted.~%")))
  (kpml-i-terpri stream))


(defun RUN-SAY-TOP-LEVEL (&optional (name nil))
  ;; 0.7.22 slight update for GENERATE AGAIN command.
  ;; 2.0.25 ordering of examples made more sensible
  ;; 4.0    added a check that the inspector frame actually exists
  ;;        in case someone kills it by accident before we
  ;;        we need it...
  (let* ((spl-frame (clim:get-frame-pane 
		     *resource-development-frame* 'inspector :errorp nil))
	 (selected-examples 
	  (sort (example-selector) #'kpml::numbered-name-lessp))
	 (example-name
	  (or name
	      (possibly-large-example-menu-choose 
	       selected-examples 30
	       ))))
 
    ;; 4.0
    (unless spl-frame
      (startup-resource-development-frame t)
      (setf spl-frame
            (clim:get-frame-pane 
             *resource-development-frame* 'inspector)))

    (when example-name (run-say-startup example-name spl-frame))))

(defun RUN-SAY-AGAIN ()
;;; From 0.7.22
;;;      0.8 - changed to use the already existing global variable
;;;    
  (let ((spl-frame (clim:get-frame-pane 
		    *resource-development-frame* 'inspector))
	(example-name kpml::*most-recent-example*))
    (if example-name
	(run-say-startup example-name spl-frame :post-message " AGAIN)>")
      (run-say-top-level))))

(defun RUN-SAY-ON-NEXT-EXAMPLE ()
;;; 1.1 remodelled run-say-again...
;;;    
  (let ((spl-frame (clim:get-frame-pane 
		    *resource-development-frame* 'inspector))
	(example-name kpml::*most-recent-example*)
	(selected-examples (sort  (example-selector) #'kpml::numbered-name-lessp)))
    (if example-name
	(let ((nex (loop for ex in selected-examples 
			 for nex in (cdr selected-examples)
			 when (equal ex example-name)
			 return nex)))
	  (setf example-name (if nex nex (first selected-examples)))
	  (run-say-startup example-name spl-frame
			   :pre-message "~%<GENERATING (next example: "))
      (run-say-top-level))))

(defun RUN-SAY-ON-NEXT-MARKED-EXAMPLE ()
;;; 1.1 remodelled run-say-again...
;;;    
  (let ((spl-frame (clim:get-frame-pane 
		    *resource-development-frame* 'inspector))
	(example-name kpml::*most-recent-example*)
	(selected-examples (if *currently-focused-examples*
			       *currently-focused-examples*
			     (sort  (example-selector) #'kpml::numbered-name-lessp))))
    (if *currently-marked*
	(let ((nex (if example-name
		       (loop for ex on selected-examples 
			   when (equal (first ex) example-name)
			   return
			     (loop for nex in (rest ex)
				 when (member nex *currently-marked*)
				 return nex))
		     nil)))
	  (setf example-name (if nex nex 
			       (loop for ex in selected-examples
				     when (member ex *currently-marked*)
				     return ex)))
	  (if example-name
	      (run-say-startup example-name spl-frame
			       :pre-message 
			       "~%<GENERATING (next marked example: ")
	    (format spl-frame "~%No next marked example visible.")))
      (format spl-frame "~%No examples currently marked.~%"))))


(defun RUN-SAY-ON-NEXT-UNGENERATED-EXAMPLE ()
  (let* ((spl-frame (clim:get-frame-pane 
		     *resource-development-frame* 'inspector))
	 (example-name kpml::*most-recent-example*)
	 (selected-examples (if *currently-focused-examples*
				*currently-focused-examples*
			      (sort  (example-selector) #'kpml::numbered-name-lessp)))
	 (nex (if example-name
		  (loop for ex on selected-examples 
		      when (equal (first ex) example-name)
		      return
			(loop for nex in (rest ex)
			      unless (kpml::fetch-example-info
				      nex 'kpml::structure)
			    return nex))
		nil)))
    (setf example-name (if nex nex 
			 (loop for ex in selected-examples
			     unless (kpml::fetch-example-info
				       ex 'kpml::structure)
			     return ex)))
    (if example-name
	(run-say-startup example-name spl-frame
			 :pre-message 
			 "~%<GENERATING (next ungenerated example: ")
      (format spl-frame "~%No examples currently ungenerated.~%"))))


(defun RUN-SAY-ON-NEXT-MISMATCHED-EXAMPLE ()
  (let* ((spl-frame (clim:get-frame-pane 
		     *resource-development-frame* 'inspector))
	 (example-name kpml::*most-recent-example*)
	 (selected-examples (if *currently-focused-examples*
				*currently-focused-examples*
			      (sort  (example-selector) #'kpml::numbered-name-lessp)))
	 (nex (if example-name
		  (loop for ex on selected-examples 
		      when (equal (first ex) example-name)
		      return
			(loop for nex in (rest ex)
			      unless (kpml::target-generated-match-p nex)
			      return nex))
		nil)))
    (setf example-name (if nex nex 
			 (loop for ex in selected-examples
			       unless (kpml::target-generated-match-p ex)
			       return ex)))
    (if example-name
	(run-say-startup example-name spl-frame
			 :pre-message 
			 "~%<GENERATING (next mismatched example: ")
      (format spl-frame "~%No examples currently mismatched.~%"))))


;;; ----------------------------------------------------------------------
;;; Displaying the results...
;;;
;;; Various combinations are possible. For example, one can mark
;;; up the generated string so that it also reflects structure, or
;;; one can leave the string bare and display the structure 
;;; separately. Displaying the structure is obviously particularly
;;; useful if one does not have the window interface with graphing
;;; available. 
;;;   Sensible combinations are:
;;;   (i) displayed structure off (*display-structures* nil)
;;;       and full bracketting in string (*ol- and *or-bracketting set
;;;       to ( and ) respectively)
;;;   (ii) displayed structures on and bracketting set to null strings.
;;; These are provided by the following shortcut:

(defun TOGGLE-GENERATED-STRING-DISPLAY ()
  (if *display-structures*
      (setf *display-structures* nil
	    *ol-bracketting* "("
	    *or-bracketting* ")")
    (setf *display-structures* T
	    *ol-bracketting* ""
	    *or-bracketting* "")))
	 
(defun SAY-AND-DISPLAY-RESULTS 
    (example-name spl-frame &key (preselections nil))
  ;; 2.1 made to respect suspended interface option...
  (let ((stream (if kpml::window-interface-flag spl-frame 
                  kpml::*base-output-stream*)))
    (cond ((eq kpml::*ml-generation-mode* :contrastive)
	   (let ((related (gensym)))
	     (dolist (lg (if kpml::*languages-in-focus*
			     kpml::*languages-in-focus*
			   kpml::all_languages))
	       (format stream "~%Language: ~A~%" lg)
	       (kpml::say example-name :language lg :preselections preselections)
	       (display-generated-structure stream lg related)))) ;; 0.9.36
	  (t
	   (kpml::say example-name :preselections preselections)
	   (display-generated-structure stream)))))
  
 ;; ----------------------------------------------------------------------
 ;; 3.2.36 was not wrapping font conditionalization around the
 ;;        development inspector pane version of the generated
 ;;        structure...
 ;; 3.2.43
 ;;        filling added.

(defun DISPLAY-GENERATED-STRUCTURE 
    (spl-frame &optional (lg kpml::curlan)(related? nil))
  (if (member :generated-strings kpml::*pop-ups*)
      (startup-a-results-window lg related?)             ;; 0.9.36
    (with-conditional-font-changes-for-language          ;; 3.2.36
     (spl-frame lg)
     (loop for result in kpml::*mouseable-sentences*
	   as index from 1
	   do 
	  (when *display-structures*
	    (kpml-i-terpri spl-frame)
	    (format spl-frame "~%Function Structure: ~A" index)
	    (mouseable-structure-display  
	     result
	     (kpml::printable-constituent-to-structure-tree result)
	     0
	     spl-frame))
	  (kpml-i-terpri spl-frame)
	  (let ((stream                                  ;; 3.2.43
		 (clim:get-frame-pane 
		  *resource-development-frame* 'inspector)))
	    (kpml-i-terpri spl-frame)                    ;; 4.1
	    (kpml-i-terpri spl-frame)
	    (filling (30)
		     (mouseable-sentence-display result stream
						 lg))      ;; 0.9.38
	    (kpml-i-terpri spl-frame))))))

;;; ----------------------------------------------------------------------
;;; 2.1 addition for nicer demos...
;;; ----------------------------------------------------------------------

(defun SHOW-SPL-AND-SAY-AND-DISPLAY-RESULTS 
    (example-name spl-frame &key (preselections nil))
  (startup-spl-and-generated-result-frame 
   example-name preselections))

;;; ----------------------------------------------------------------------
;;; Displaying mouse sensitive structures and strings...
;;;
;;; KPML 0.8: integrated mouse sensitive generated string...
;;; ----------------------------------------------------------------------

(clim:define-presentation-type MOUSABLE-KPML-OUTPUT ())

(clim:define-presentation-action PRESENT-MOUSABLE-KPML-OUTPUT
    (mousable-kpml-output nil kpml-resource-development
			  :gesture :select
			  :documentation "Inspect corresponding SPL")
  (object)
  (kpml::describe-spl-term 
   (kpml::printable-constituent-concept (first object))))

  ;; 4.0
  ;; For some reason the following function call was being bound
  ;; to the left-mouse button, so explicitly rename and associate
  ;; with the right-click gesure here. This may have
  ;; been causing the strange rightclick black hole that 
  ;; has been observed on many systems.
  ;;
(clim:define-presentation-action INVESTIGATE-MOUSABLE-KPML-OUTPUT
    (mousable-kpml-output nil kpml-resource-development
			  :gesture :menu
			  :documentation "Generated result inspection options")
    (object)
    (mouseable-sentence-menu object clim:*application-frame*))

;;; ----------------------------------------------------------------------
;;; 2.1 the following function is responsible for bringing up the menu
;;;     of options for a mouse sensitive string showing constituents.
;;;     It used just to use the resource development window as its
;;;     'associated window' for the purposes of bringing up the dialogue
;;;     box. This appears  not to work when the actually current
;;;     application frame is something else, so we now add the 
;;;     application frame as an additional argument. This allows
;;;     its use elsewhere for other windows and frames... Although
;;;     maybe it should just always have been clim:*application-frame*,
;;;     this function was pretty old...
;;;
  ;; 3.2.59
  ;;
  ;; Small addition for printing out the results of punctuation tracing.
  ;; Add it to the generated string options, because that is where the
  ;; punctuation is...
  ;; 
;;; ----------------------------------------------------------------------

  (defun MOUSEABLE-SENTENCE-MENU (full-node &optional (window clim:*application-frame*))
  (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|
	   |Graph corresponding constituent and below|
	   |Inspect selection expression|
       	   |Show used punctuation rules|               ;; 3.2.59
	   |Inspect corresponding semantic term|
	   |Generate again up to but not including this constituent|
	   |Mark this example|
	   )
	 :associated-window (clim:frame-top-level-sheet window)
	 :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))
      ;; 3.2.59
      (|Show used punctuation rules|
       (if kpml::*applied-punctuation-list*
	   (format stream2 "~%Punctuation rules used were: ~{~%~3T~{~A:~14T~A ~A=>~S~}~}" 
		   kpml::*applied-punctuation-list*)
	 (format stream2 "~%No punctuation rules were triggered.")))
      (|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)))
      (|Generate again up to but not including this constituent|
       (let* ((child-of-node (first (example-constit-children node)))
	      (child-fundle-label 
	       (if (and child-of-node
			(kpml::printable-constituent-p child-of-node))
		   (kpml::function-pack
		    (kpml::printable-constituent-functions child-of-node))
		 "")))
       (setf kpml::*trace-this-constituent*
	 (extract-cycle-from-fundle child-fundle-label))
       (let ((kpml::curlan lg))
	 (run-say-top-level example))
       )))))

(defun EXTRACT-CYCLE-FROM-FUNDLE (fundle-label)
  (if (find '#\# fundle-label)
      (1- (parse-integer fundle-label 
		     :start (1+ (position '#\# fundle-label :from-end t))))
    nil))

;;; Clicking on non-last strings regenerates the clicked upon example
;;; not the last generated example... Maintain example and language
;;; information with each presented constituent.
;;; Note that the same change should be made for the structure display
;;; and for the generated string display method...

(defun PRESENT-MOUSEABLE-SENTENCE-ELEMENT (element stream lg)
    (typecase element
      (string
       (if kpml::*activate-word-rank-and-below*
	   (format stream "~a" element)
	 (format stream "~a "  element)))
      (kpml::printable-constituent
       (clim:with-drawing-options 
	   (stream :ink clim:+red+)
	 (clim:with-text-style (stream *sans-serif--roman--10*)
	   (format stream "~a" *ol-bracketting*)))
       (mouseable-sentence-display element stream lg)
       (clim:with-drawing-options 
	   (stream :ink clim:+red+)
	 (clim:with-text-style (stream *sans-serif--roman--10*)
	   (format stream "~a" *or-bracketting*))))))


;;; ----------------------------------------------------------------------
;;; Following provides the mouseable equivalent 
;;; of pprint-constituent-structure-as-list in 
;;; kpml-resources/pretty-printing.lisp.

(clim:define-presentation-type MOUSABLE-KPML-STRUCTURE ())

(clim:define-presentation-action PRESENT-MOUSABLE-KPML-STRUCTURE
    (mousable-kpml-structure nil kpml-resource-development
			     :documentation "Inspect structure element")
  (object)
  (mouseable-structure-menu object))


;;; 1.0.31 somehow the following went missing between 0.9 and 1.0 !
;;; Should change this so that under ACL3.0 we don't always do
;;; a newline on going up through the recursion after printing...
(defun MOUSEABLE-STRUCTURE-DISPLAY (mouseable-structure constit
				    &optional 
				    (indent 0)
				    (stream (clim:get-frame-pane 
					     *resource-development-frame* 'inspector)))
  (clim:with-output-as-presentation
   (stream (list constit mouseable-structure) 'mousable-kpml-structure)
   
   #+acl3.0(kpml-i-terpri stream)
   #-acl3.0(fresh-line stream)
   (format stream "~VT [~{~A~^/~}]" indent (first constit))
   (cond ((stringp (second constit))
	  (format stream ".. = ~S" (second constit)))
	 (t
	  (loop for sub in (cdr constit) do
		(setf indent (+ indent 4))
		(mouseable-structure-display 
		 mouseable-structure sub indent stream)
		(setf indent (- indent 4))
		#-acl3.0(fresh-line stream)
		#+acl3.0(kpml-i-terpri stream))))))




(defun MOUSEABLE-STRUCTURE-MENU (object)
  (let ((stream (clim:get-frame-pane *resource-inspector-frame*
				     'inspector))
	(printable-structure (second object))
	(function-key        (first (first object))))
        
     (case
      (menu-choose 
       '(
	 |Graph this constituent and below|
	 |Show selection expression|
	 |Show corresponding semantic term|
	 |Generate again up to but not including this constituent|
	 )
       :associated-window 
      (clim:frame-top-level-sheet *resource-inspector-frame*)
       :label "Generated structure options ...")
      (|Graph this constituent and below|
       (graph-example-structure
	(find-node-from-function-key 
	 printable-structure function-key)))
      (|Show selection expression|
       (show-selection-expression stream stream 
				  (find-node-from-function-key 
				   printable-structure function-key)))
      (|Show corresponding semantic term|
       (format stream "~%Semantic term for grammatical function ~A is:"
	       function-key)
       (kpml::describe-spl-term (kpml::printable-constituent-concept
				   (find-node-from-function-key 
				    printable-structure function-key)))
       )
      (|Generate again up to but not including this constituent|
       (let* ((node (find-node-from-function-key 
		     printable-structure function-key))
	      (child-of-node (first (example-constit-children node)))
	      (child-fundle-label 
	       (if (and child-of-node
			(kpml::printable-constituent-p child-of-node))
		   (kpml::function-pack
		    (kpml::printable-constituent-functions child-of-node))
		 "")))
	 (setf kpml::*trace-this-constituent*
	   (extract-cycle-from-fundle child-fundle-label))
	 (run-say-again))))))




(defun FIND-NODE-FROM-FUNCTION-KEY (structure function-key)
  (when (kpml::printable-constituent-p structure)
	(if (equal (kpml::printable-constituent-functions structure)
		   function-key)
	    (return-from find-node-from-function-key structure)
	  (loop for sub in (kpml::printable-constituent-spelling structure)
		when (kpml::printable-constituent-p sub)
		do 
		(let ((result (find-node-from-function-key sub function-key)))
		  (when result (return-from find-node-from-function-key result))))))
  nil)
	  


;;; ----------------------------------------------------------------------
;;; And graphing structure from already generated examples...

(defun GRAPH-GENERATED-STRUCTURE-IN-EXAMPLE-RECORD ()
  (let* ((spl-frame (clim:get-frame-pane 
		     *resource-development-frame* 'inspector))
	 (selected-examples (sort  (example-selector) #'kpml::numbered-name-lessp))
	 (example-name
	  (or (possibly-large-example-menu-choose 
	       selected-examples 30))))
    (if example-name
	(graph-example-structure
	 (kpml::fetch-example-info example-name 'kpml::structure))
      (format spl-frame "~%No example structure selected."))))


;;; ----------------------------------------------------------------------
;;; 0.9.12  --- if this is loaded (i.e., we are in Allegro/Lispworks 
;;;             and CLIM-2), then it overwrites the vanilla version
;;;             in generation/generate.lisp 
;;; 2.1 --- no it didn't, package specifier was missing here too!
;;;         and parameterized failure string...
;;; 2.1 --- and this is sometimes called when we are not even
;;;         generating as it is associated with the abort gesture.
;;;         Make sure it just does nothing instead of breaking.
;;; 4.0 --- OK, I will (only took 8 years, but well...)
;;; ----------------------------------------------------------------------

(defun KPML::ABANDON-GENERATION ()
  (let ((message-frame 
	 (if kpml-i::*resource-development-frame*
             (clim:get-frame-pane 
	      kpml-i::*resource-development-frame* 'kpml-i::inspector :errorp nil)
           nil)))
    (when message-frame
      (format message-frame "~%Generation aborted.")
      (format *trace-output* "~%;;; Generation aborted."))
    (setf kpml::*mouseable-sentences* nil)
    ;; 4.0 add this hack in the spirit of a hack is better
    ;;     than a user detectable crash...
    ;;     Wing it...
    ;;
    (multiple-value-bind (value error)
        (ignore-errors 
          (throw 'kpml::kpml-say-error  ;; 1.1 kpml package spec missing
                 (values kpml::*failure-string* nil))
          )
      (when error                      ;; here we give a litte prayer
        (clim:notify-user              ;; in the hope that it does not
         clim:*application-frame*      ;; get hopelessly confused...
         "Selection aborted. Select 'Done' to exit.")))
    ))

;;; ----------------------------------------------------------------------
;;; New stuff... as for the generated string popup, but does its
;;; stuff to an emacs buffer... 

(defun DISPLAY-GENERATED-STRING-IN-EMACS-BUFFER ()
  (kpml::send-string-to-emacs
   (with-output-to-string (stream)
     (loop for result in kpml::*mouseable-sentences*
	 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)
	   (mouseable-sentence-display result stream)
	   (kpml-i-terpri stream)))))

;;; ----------------------------------------------------------------------
;;; Utility for selection expression display from example records...
;;; 2.0

(defun SHOW-SELECTION-EXPRESSION (stream stream2 node)
  (let* ((concept 
	  (if node (kpml::printable-constituent-concept node)
	    nil))
	 (fundle (kpml::printable-constituent-functions node))
	 (example (find-example concept))
	 (selexpr 
	  (if example
	      (find-sel-expr concept fundle example)
	    (format stream
		    "~%No information maintained for this node.")))
	 (preselections
	  (if example
	      (loop for (f . p) 
		  in (kpml::fetch-example-info example 'kpml::preselections)
		  until (member f fundle :test #'equal)
		  finally (return p)))))
    (if selexpr
	(if (member :selection-expressions kpml::*pop-ups*)
	    (let ((offset (gensym)))
	      (loop for s in selexpr
		  do (kpml::pop-up-a-selection-expression 
		      (kpml::function-pack fundle)
		      s :offset offset :preselections preselections)))
	  (loop for s in selexpr
	      as n from 1
	      do (format stream2 "~%Selection expression: ~A" n)
		 (pen-pprint-for-clim s nil stream2)))
      (format stream "~%No selection expression."))))


;;; ......................................................................
;;; 4.0
;;;
;;; And then come a few of the mini commands that 4.0 adds in.
;;; They may be moved elsewhere
;;; sometime...
;;;

#+(and :kpml-level>= :kpml-l2)
(define-kpml-resource-development-command 
  (com-CLEAR-PLAN-GRAPHS :name "Clear plan graphs" :menu nil)
  ()
  (let ((stream (or (clim::get-frame-pane *resource-development-frame*
					    'inspector)
		      (clim::get-frame-pane *resource-manager-frame*
					    'inspector))))
    (if kpml::*plan-graphs*
        (if (hash-table-p kpml::*plan-graphs*)
            (progn
              (format stream "~%Clearing plan graph records. ~A removed."
	              (hash-table-count kpml::*plan-graphs*))
              (clrhash kpml::*plan-graphs*))
          (if (consp kpml::*plan-graphs*)
              (progn
                (format stream "~%Clearing plan graph records. ~A removed."
	                (length kpml::*plan-graphs*))
                (setf kpml::*plan-graphs* nil))))
      (format stream "~%No plan graph records present."))))

#+(and :kpml-level>= :kpml-l2)
(define-kpml-resource-development-command 
  (com-CLEAR-COREFS :name "Clear coreference table" :menu nil)
  ()
  (let ((stream (or (clim::get-frame-pane *resource-development-frame*
					  'inspector)
		    (clim::get-frame-pane *resource-manager-frame*
					  'inspector))))
    (format stream "~%Clearing coreference information. ~A removed."
	    (hash-table-count kpml::*coreferentials*))
    (clrhash kpml::*coreferentials*)))

;;; ----------------------------------------------------------------------
;;; 4.1 something to help out given bad scrolling and displaying 
;;;     with LW5 and Windows... (Does not do much good though,
;;;     there is probably just too much making its way into
;;;     the pane and bypassing the recording history.)


(define-kpml-resource-development-command 
  (com-DEVELOPMENT-BLANK-SPACE-OPTIONS :name "Redisplay" :menu nil)
  ()
  (clim:redisplay-frame-pane 
   clim:*application-frame* 'inspector :force-p nil))

(clim:define-presentation-to-command-translator DEVELOPMANT-BLANK-SPACE-OPTIONS
    (clim:blank-area com-development-blank-space-options kpml-resource-development
		     :documentation "Redisplay")
  (x y)
  (declare (ignore x y))
  (values))






















