(in-package "KPML-I")

;;; File: generation-modes-menu-bar.lisp
;;;
;;; Allows the generation modes to be set from the menu bar of the development
;;; window and elsewhere rather than with the rather long dialog box (which sometimes
;;; does not startup OK under some installations of Lispworks apparently)...
;;;
;;; Bremen, 10 June 1999
;;; KPML 2.1
;;;

;;; ----------------------------------------------------------------------
;;; A general macro for defining toggling commands for the generation modes...
;;; ----------------------------------------------------------------------

(defmacro MAKE-GENERATION-MODE-MENU-COMMAND 
          (command-name label var &body body)
  `(define-kpml-resource-development-command 
    (,command-name
     :name ,(concatenate 'string "Toggle " label)
     :menu nil)
    ()
    (let ((stream (or (clim::get-frame-pane *resource-development-frame*
                                            'inspector)
                      (clim::get-frame-pane *resource-manager-frame*
                                            'inspector))))
      (setf ,var (not ,var))
      (when stream
        (if ,var
            (format stream "~%~A: ON" ,(string-capitalize label))
          (format stream "~%~A: OFF" ,(string-capitalize label))))
      ,@body)))

;;; ----------------------------------------------------------------------
;;; Another one for groups of toggling actions...
;;; ----------------------------------------------------------------------

(defmacro MAKE-GENERATION-MODE-GROUP-TOGGLE-COMMAND
          (on-command off-command flags &body body)
  `(progn
     (define-kpml-resource-development-command 
      (,on-command :name "All on" :menu nil)
      ()
       ,@(loop for var in flags collect `(setf ,var nil))
       ,@body)
     (define-kpml-resource-development-command 
      (,off-command :name "All on" :menu nil)
      ()
       ,@(loop for var in flags collect `(setf ,var T))
       ,@body)))




;;; ----------------------------------------------------------------------
;;; Top level command table and menu structure...
;;; ----------------------------------------------------------------------

(clim:define-command-table
 GENERATION-MODES-COMMAND-TABLE
 :menu (("Information accumulation options" 
         :menu  GENERATION-MODES-ACCUMULATIONS-COMMAND-TABLE)
        ("Network traversal tracing" :menu GENERATION-MODES-GRAMMAR-TRAVERSAL)
        ("Inquiry usage tracing" :menu  GENERATION-MODES-INQUIRIES)
        ("Constituent ordering tracing" :menu  GENERATION-MODES-ORDERING-COMMAND-TABLE)
        ("Lexical selection tracing" :menu  GENERATION-MODES-LEXICAL-INFO)
        ("Realizations and associations" :menu  GENERATION-MODES-REALIZATIONS)
        ("div1" :divider :line)
        ("Example and lexeme acquisition" :menu  GENERATION-MODES-EXAMPLE-LEXEME-ACQ)
        ("Traversal control options" :menu  GENERATION-MODES-CONTROL)
	("div2" :divider :line)
	("Toggle showing cautions" :command COM-GM-CAUTION-TOGGLE)
	))

;;; ----------------------------------------------------------------------
;;; Toggling caution display...
;;; ----------------------------------------------------------------------

(make-generation-mode-menu-command
 COM-GM-CAUTION-TOGGLE "showing cautions" kpml::show-cautions-flag)

;;; ----------------------------------------------------------------------
;;; Example and lexical item control...
;;; ----------------------------------------------------------------------

(clim:define-command-table
 GENERATION-MODES-EXAMPLE-LEXEME-ACQ
 :menu (("Toggle automatic new examples creation" :command com-mode-example-auto)
        ("Toggle automatic acquisition of unknown lexical items"
         :command  com-mode-acquire-lexemes)))

(make-generation-mode-menu-command
    com-mode-example-auto "automatic new examples creation" kpml-i::*example-auto-creation*)

(make-generation-mode-menu-command
    com-mode-acquire-lexemes "automatic acquisition of unknown lexical items"
    kpml::*acquire-lexical-items-mode*)


;;; ----------------------------------------------------------------------
;;; Ordering information...
;;; ----------------------------------------------------------------------

(clim:define-command-table
 GENERATION-MODES-ORDERING-COMMAND-TABLE
 :menu (("Toggle ordering constraints" :command com-mode-show-ordering-constraints)
        ("Toggle ordering events" :command com-mode-show-ordering-events)
        ("Toggle ordering results" :command com-mode-show-ordering-results)
        ("------" :divider)
        ("All on" :command com-all-ordering-on)
        ("All off" :command com-all-ordering-off)
        ))

(make-generation-mode-menu-command
 com-mode-show-ordering-constraints "ordering constraints" kpml::show-ordering-constraints)
 
(make-generation-mode-menu-command
 com-mode-show-ordering-events  
 "ordering events"  kpml::show-ordering-events-flag)

(make-generation-mode-menu-command
 com-mode-show-ordering-results  "ordering results" kpml::ordering-dump-flag)

(make-generation-mode-group-toggle-command
 COM-ALL-ORDERING-ON COM-ALL-ORDERING-OFF
 (kpml::show-ordering-constraints 
  kpml::show-ordering-events-flag
  kpml::ordering-dump-flag)
 (com-mode-show-ordering-constraints)
 (com-mode-show-ordering-events)
 (com-mode-show-ordering-results))

;;; ----------------------------------------------------------------------
;;; Accumulation of information ...
;;; ----------------------------------------------------------------------

(clim:define-command-table
 GENERATION-MODES-ACCUMULATIONS-COMMAND-TABLE
 :menu (("Toggle updating example records" :command com-mode-update-env)
        ("System and chooser activity" :menu generation-modes-chooser-accumulations)
        ("----------" :divider)
        ("All on" :command com-accumulate-everything)
        ("All off" :command com-accumulate-nothing)
        ("Toggle clearing history before each generation" 
         :command com-toggle-history-clearing)
        ))

(make-generation-mode-group-toggle-command
 COM-ACCUMULATE-EVERYTHING COM-ACCUMULATE-NOTHING
 (kpml::store-to-environment-flag)
 (com-mode-update-env)
 (if kpml::store-to-environment-flag
     (com-mode-chooser-all)
   (com-mode-chooser-none)))

(clim:define-command-table
 GENERATION-MODES-CHOOSER-ACCUMULATIONS
 :menu (("Accumulate all chooser activity" :command com-mode-chooser-all)
        ("Accumulate only traced chooser activity" :command com-mode-chooser-traced)
        ("Accumulate no chooser activity" :command com-mode-chooser-none)
        ("Clear accumulations of chooser activity" :command com-clear-genhistory-2)))

(make-generation-mode-menu-command
 com-toggle-history-clearing 
 "clearing history before each generation" 
 *reset-generation-history-each-generation*)

(make-generation-mode-menu-command
 com-mode-update-env "updating example records" kpml::store-to-environment-flag
 '(setf kpml::Domain-Implemented-Value-Compare-Flag
        kpml::store-to-environment-flag))

(define-kpml-resource-development-command (com-MODE-CHOOSER-ALL
					   :name "Accumulate all chooser activity"
					   :menu nil)
    ()
  (let ((stream (or (clim::get-frame-pane *resource-development-frame*
                                          'inspector)
                    (clim::get-frame-pane *resource-manager-frame*
                                          'inspector))))
    (setf kpml::*cumulate-chooser-activity* :all)
    (when stream (format stream "~%All chooser activity now being accumulated."))))

(define-kpml-resource-development-command (com-MODE-CHOOSER-TRACED
					   :name "Accumulate only traced chooser activity"
					   :menu nil)
    ()
  (let ((stream (or (clim::get-frame-pane *resource-development-frame*
                                          'inspector)
                    (clim::get-frame-pane *resource-manager-frame*
                                          'inspector))))
    (setf kpml::*cumulate-chooser-activity* :traced)
    (when stream (format stream "~%Only traced chooser activity now being accumulated."))))

(define-kpml-resource-development-command (com-MODE-CHOOSER-NONE
					   :name "Accumulate only traced chooser activity"
					   :menu nil)
    ()
  (let ((stream (or (clim::get-frame-pane *resource-development-frame*
                                          'inspector)
                    (clim::get-frame-pane *resource-manager-frame*
                                          'inspector))))
    (setf kpml::*cumulate-chooser-activity* nil)
    (when stream (format stream "~%No chooser activity now being accumulated."))))


;;; ----------------------------------------------------------------------
;;; Trace grammar traversal...
;;; ----------------------------------------------------------------------

(clim:define-command-table
 GENERATION-MODES-GRAMMAR-TRAVERSAL
 :menu (("Toggle system and inquiry activity" :command com-trace-system-activity)
        ("Toggle selective realization" :command  com-mode-realize-selectively)
        ("-----------" :divider)
        ("Toggle constituent starts" :command com-mode-const-starts)
        ("Toggle why system is firing" :command  com-why-system-firing)
        ("Toggle disabled candidate systems" :command  com-mode-show-disabled)
        ("Toggle system entry dependencies" :command  com-mode-show-dependencies)
        ("Toggle preselections" :command  com-mode-show-preselections)
        ("Toggle Interactively augmenting preselections" 
         :command com-modes-suppl-preselections)))

(make-generation-mode-menu-command
 com-trace-system-activity  "system and inquiry activity" kpml::english-trace-flag
 (when kpml::english-trace-flag
   (let ((frame-tool-label "tracing"))
     (declare (special frame-tool-label))
     (startup-generation-history-frame t)
     (startup-fat-frame t))))

(make-generation-mode-menu-command
 com-mode-const-starts "constituent starts" kpml::show-constituent-starts
 (when kpml::show-constituent-starts (startup-fat-frame t)))

(make-generation-mode-menu-command
 com-why-system-firing  "why system is firing" kpml::show-why-system-is-firing-flag)

(make-generation-mode-menu-command
 com-mode-show-disabled  "disabled candidate systems"  kpml::*show-disabled-systems-flag*)

(make-generation-mode-menu-command
 com-mode-show-dependencies  "system entry dependencies" kpml::show-dependency-choices)

(make-generation-mode-menu-command
 com-mode-show-preselections "preselections" kpml::show-preselections-flag)

;;; ----------------------------------------------------------------------
;;; Realization activities...
;;; ----------------------------------------------------------------------

(clim:define-command-table
 GENERATION-MODES-REALIZATIONS
 :menu (("Toggle immediate realizations" :command  com-show-immediate-realizations)
        ("Toggle associations" :command  com-modes-show-associations)))

(make-generation-mode-menu-command
 com-show-immediate-realizations  "immediate realizations"
 kpml::show-immediate-realizations-flag)

(make-generation-mode-menu-command
 com-modes-show-associations  "associations"  kpml::display-association-flag
 (when kpml::display-association-flag (startup-fat-frame t)))

;;; ----------------------------------------------------------------------
;;; Lexical and morphological information...
;;; ----------------------------------------------------------------------

(clim:define-command-table
 GENERATION-MODES-LEXICAL-INFO
 :menu (("Toggle lexicalization history" :command com-modes-toggle-lex-history)
        ("Toggle showing lexical features" :command  com-modes-show-lexical-features)
        ("Toggle showing lexical selection" :command  com-modes-show-lexical-selection)
        ("Toggle morphological selection" :command com-modes-show-morphology)
        ("-------" :divider)
        ("All on" :command com-modes-lexical-on)
        ("All off" :command com-modes-lexical-off)
        ))

(make-generation-mode-group-toggle-command
 COM-MODES-LEXICAL-ON COM-MODES-LEXICAL-OFF
 (kpml::show-lexical-features-flag kpml::*lexical-history-flag*
   kpml::show-lexical-selection kpml::*show-morphology-selection-flag*)
  (com-modes-toggle-lex-history)
  (com-modes-show-lexical-features)
  (com-modes-show-lexical-selection)
  (com-modes-show-morphology))

(make-generation-mode-menu-command
    com-modes-show-lexical-features "lexical features" kpml::show-lexical-features-flag)

(make-generation-mode-menu-command
    com-modes-toggle-lex-history "lexical history" kpml::*lexical-history-flag*)

(make-generation-mode-menu-command
    com-modes-show-lexical-selection  "lexical selection" kpml::show-lexical-selection
 (setf kpml::*show-lexical-selection-flag* kpml::show-lexical-selection))

(make-generation-mode-menu-command
 com-modes-show-morphology "morphological selection" kpml::*show-morphology-selection-flag*)

;;; ----------------------------------------------------------------------
;;; Inquiry information during traversal...
;;; ----------------------------------------------------------------------

(clim:define-command-table
 GENERATION-MODES-INQUIRIES
 :menu (("Toggle inquiry answer source" :command  com-modes-inquiry-source)
        ("Toggle entailed inquiry response" :command  com-modes-show-preselected-response)))

(make-generation-mode-menu-command
 com-modes-inquiry-source "inquiry answer source" kpml::*show-inquiry-answer-source*)

(make-generation-mode-menu-command
 com-modes-show-preselected-response "entailed inquiry response"
 kpml::show-preselected-response-flag)

;;; ----------------------------------------------------------------------
;;; Controlling traversal...
;;; ----------------------------------------------------------------------

(clim:define-command-table
 GENERATION-MODES-CONTROL
 :menu (("Toggle selective realization" :command  com-mode-realize-selectively)
        ("Toggle interactively augmenting preselections"
         :command  com-modes-suppl-preselections)
        ("Toggle single step" :command com-TOGGLE-SINGLE-STEP-2)
        ("Toggle entering debugger on warnings" :command  com-modes-debug-warnings)
        ))

(make-generation-mode-menu-command
 com-mode-realize-selectively "selective realization" kpml::realize-selectively-flag)
 
(make-generation-mode-menu-command
 com-modes-debug-warnings  "entering debugger on warnings" kpml::warning-stop-flag)

(make-generation-mode-menu-command
 com-modes-suppl-preselections  "Interactively augmenting preselections"
 kpml::supplement-preselections-flag)


