(in-package "KPML-I")

;;; File: startups.lisp
;;;
;;; Contains a complete set of frame startup definitions for KPML-I.
;;; These conform to the ACL5.0 PC 'frame definitions must be in the
;;; same thread as the frame use' constraint. They are backwards
;;; compatible with other Lisps however and so should replace the
;;; previous frame starts when fully checked.
;;;
;;; 4.0 these are now the standard startups. They are still gathered
;;;     all together here however. The originating startup functions
;;;     can be commented or conditionalized in the individual frame
;;;     definition files.
;;;
;;;     Some titles changed so that it is easier to recognise them
;;;     from the initial strings... particularly for windows where
;;;     one gets a lot of instances (e.g., system views, etc.)

(define-kpml-i-frame-starter 
 startup-resource-management-frame
 kpml-interface
 "KPML ROOT WINDOW"
 *resource-manager-frame*
 :reset-default T
 :layout (:pretty-name (kpml-main-frame-name)
			 :left 10 :top 10 :width 500 :height 430)
 )


(define-kpml-i-frame-starter 
 startup-region-overview-frame
 region-overview-graph
 "KPML REGION OVERVIEW TOOL"
 *frame*
 :args (region exclusions language)
 :layout (:left 10 :top 10 :width 500 :height 430 :pretty-name 
		(concatenate 'string
			     (string region)
			     ": [region-overview-graph]"
			     ))
 :frameinits ((language . language)
              (region-region .   (kpml::make-region-overview-info))
	      (root-regions . (list region))
	      (exclusions . exclusions)))

;; 4.0 variant...

(define-kpml-i-frame-starter 
 startup-region-overview-from-feature-frame
 region-overview-graph
 "KPML REGION FROM FEATURE OVERVIEW TOOL"
 *frame*
 :args (feature exclusions language)
 :layout (:left 10 :top 10 :width 500 :height 430 :pretty-name 
		(concatenate 'string
			     (string feature)
			     ": [region-overview-from-feature-graph]"
			     ))
 :frameinits ((language . language)
              (region-region .   (kpml::make-region-overview-info))
	      (root-regions . 
			    (loop for f in (kpml::who-has-as-input feature) 
				  collect (kpml::fetch-system-region f)))
	      (exclusions . exclusions)))

;;; example-operations.lisp

(define-kpml-i-frame-starter 
 STARTUP-EXAMPLE-OPERATIONS-FRAME
 example-operations-frame
 "KPML EXAMPLE MANAGER"
 *ex-op-frame*
 :reset-default T
 :layout (:pretty-name "Example Manager (KPML)"
		       :left 100 :top 20 
		       :width #-acl3.0 500 #+acl3.0 800 :height 400)
 :frameinits ((marked-set . *currently-marked*)
	      (ex-set-shown . *focused-exercise-set*)))


;;; cautious-rs-dialog-box.lisp

(define-kpml-i-frame-starter 
  STARTUP-RS-BUILDER-FRAME
  rs-building-frame
  "KPML REALISATION STATEMENT BUILDER"
  *frame*
  :args (feature default)
  :layout (:pretty-name 
	   (concatenate 'string
			(string feature)
			": [Realization statement maker on feature] "
			)
	   :left 100 :top 20 :width 450 :height 400)
  :body
;;	  (declare (special *rs-selection-made* *constructed-rs* *rs-process*))
	  ((setf *rs-selection-made* nil)
	   (setf *constructed-rs* nil))
  :frameinits ((rs . default)
	       (selected-realop . (if default (first default) 'kpml::insert))
	       (feature . feature)))
    

(defun STARTUP-RS-BULDER (feature default)
  (let ((*rs-process* (startup-rs-builder-frame feature default)))
    (declare (special *rs-process* *rs-selection-made* *constructed-rs*))
    
    ;; note that the following is really necessary in Lispworks to let 
    ;; any other process get a look-in...
    (loop until (or *rs-selection-made*
                    #+lispworks(equal (mp:process-state *rs-process*) :killed)
		    #-lispworks T)
	  do (sleep 1))

    (case *rs-selection-made* 
	  (:no (setf *constructed-rs* default))
	  (:yes *constructed-rs*)
	  (otherwise
	   (setf *constructed-rs* default)))))

;;; chooser-display.lisp

(define-kpml-i-frame-starter 
  MAKE-A-CHOOSER-GRAPH-INTERNAL
  chooser-display-graph
  "KPML CHOOSER DISPLAY"
  *chooser-grapher*
  :args (chooser-name record offset example-name for-constituent)
  :offset T
  :layout (:pretty-name 
	   (concatenate 'string
			(string chooser-name)
			": [chooser-definition] "  
			" (" (string kpml::curlan)
		       (if example-name                ;; 1.1
			   (concatenate 'string "; Ex: " (string example-name)) "")
                       (if for-constituent (format nil ";  At: ~A" for-constituent) "") ")"
		       (if (kpml::fetch-chooser-info chooser-name 'kpml::patch-status)
			   "  (***patched***)"
			 ""))
	   :width *resource-graph-width*
	   :height *resource-graph-height*)
 :frameinits ((root-definition . (kpml::fetch-chooser-info chooser-name 'kpml::definition))
	      (displayed-chooser-name . chooser-name)
	      (record . record))
 :body
 ((setf *highlighted-path* nil)))


;;; chooser-editor.lisp

(define-kpml-i-frame-starter 
 MAKE-A-CHOOSER-EDITOR
 chooser-editor-graph
 "KPML CHOOSER EDITOR"
 *frame*
 :args (chooser-name)
 :layout (:pretty-name 
	  (concatenate 'string
		       "chooser editor: "
		       (if chooser-name (string chooser-name) "NEW CHOOSER")
		       " (" (string kpml::curlan) ")"
		       (if (kpml::fetch-chooser-info chooser-name 'kpml::patch-status)
			   "  (***patched***)" ""))
	  :left (first *current-offsets*) 
	  :top (second *current-offsets*)
	  :width *resource-graph-width*
	  :height *resource-graph-height*)
 :frameinits ((root-definition . (kpml::digest-chooser
				  (kpml::fetch-chooser-info chooser-name 'kpml::definition)))
	      (comments . (kpml::fetch-chooser-info chooser-name 'kpml::comments))
	      (edited-chooser-name . chooser-name))
 :body
 ((setf *highlighted-path* nil)))


;;; cumulative-history-display.lisp

(define-kpml-i-frame-starter 
  STARTUP-CUMULATIVE-GH-FRAME
  cumulative-gh-frame
  "KPML CUMULATIVE GENERATION HISTORY"
  *cumulative-gh-frame*
  :reset-default T
  :layout (:pretty-name "Cumulative Generation History (KPML)"
	   :left 100 :top 20 :width 500 :height 400)
  :body
  ((kpml::finalize-pending-entries)))

;;; example-grapher-interface.lisp

(define-kpml-i-frame-starter 
  GRAPH-EXAMPLE-STRUCTURE
  example-graph
  "KPML EXAMPLE STRUCTURE"
  *example-grapher*
  :args (example-structure-node)
  :frameinits  ((info . example-structure-node)
		(lg . kpml::curlan))
  :layout (:left 10 :top 10 :width *structure-graph-width* :height *structure-graph-height*)
  :body ((setf *example-structure-node* example-structure-node))
  :postbody (undo-lg-based-font-decision *structure-graphing-font*))

;;; exrun-progress-interface.lisp

(define-kpml-i-frame-starter 
  STARTUP-EXAMPLE-RUNNING-PROGRESS-FRAME
  example-running-progress-frame
  "KPML EXAMPLE RUNNING PROGRESS"
  *ex-running-frame*
  :reset-default T
  :args (label)
  :layout (:pretty-name label :left 100 :top 20 :width 500 :height 400))

;;; genre-grapher.lisp
;;; Following needs updating to use a display method!!!

(defun GRAPH-GENRE-STRUCTURE ()
  (let ((gen-sep 100)
	(inter-gen-sep 10)
	stream )
    (when (and (stringp kpml::*the-text*)
	       (string= kpml::*the-text* ""))
      (return-from GRAPH-GENRE-STRUCTURE nil))
    (unless kpml::*the-text* (return-from GRAPH-GENRE-STRUCTURE nil))

    (setf *genre-structure-grapher*
      (clim:make-application-frame
       'genre-structure-graph
       :left 10 :top 10
       :width *structure-graph-width*
       :height *structure-graph-height*))

     (setq *genre-structure-process*
	   (process-run-function 
	    "KPML GENERIC STRUCTURE"
	    #'run-packaged-frame
	    *genre-structure-grapher* *package*))    
    (setf stream
	  (clim:get-frame-pane
	    *genre-structure-grapher* 'graph))
    (clim::window-expose stream)
    (clim::window-stack-on-top stream)
    (clim:window-clear stream)
    (clim:format-graph-from-roots
     (list (kpml::inter-axis-relation-synt kpml::*the-text*))
     #'print-generic-structure-nodes
     #'generic-stage-children
     :generation-separation gen-sep
     :within-generation-separation inter-gen-sep
     :merge-duplicates nil
     :move-cursor nil
     :orientation :vertical
     :stream stream)))

;;; inquiry-editor.lisp

(defun STARTUP-AN-INQUIRY-EDITOR-FRAME 
    (inquiry &key (id-inquiry nil)
		  (answerset nil)
		  (name nil)
                  (frame-tool-label nil))
    (startup-an-inquiry-editor-frame-internal inquiry id-inquiry answerset name
                                              :frame-tool-label frame-tool-label))

(define-kpml-i-frame-starter 
  STARTUP-AN-INQUIRY-EDITOR-FRAME-INTERNAL
  inquiry-editing-frame
  "KPML INQUIRY EDITOR"
  *frame*
  :args (inquiry id-inquiry answerset name)
  :layout (:pretty-name 
	   (concatenate 
	    'string 
	    "Inquiry editing frame (" (if inquiry (string inquiry) "new inquiry")  
	    ") [alpha version]")
	   :height 400)
  :body ((cond (inquiry (initialize-edited-inquiry inquiry frame))
	      (t (setf (slot-value frame 'modified) nil)
		 (setf (slot-value frame 'id-inquiry) id-inquiry)
		 (setf (slot-value frame 'name) name)
		 (when answerset
		   (setf (kpml::inquiry-operator-answerset
			  (slot-value frame 'edited-inquiry))
			 answerset))))))

;;; inspection.lisp

(define-kpml-i-frame-starter 
  STARTUP-RESOURCE-INSPECTOR-FRAME
  kpml-resource-inspector
  "KPML INSPECTOR"
  *resource-inspector-frame*
  :reset-default T
  :layout (:pretty-name "Inspector (KPML)" :left 110 :top 30 :width 500 :height 400))

;;; lof.lisp

(define-kpml-i-frame-starter 
  ASCERTAIN-FOCUSING-OPTIONS-GRAPHICALLY
  focusing-operations-frame
  "KPML SET FOCUSING OPTIONS"
  *object-focusing-frame*
  :reset-default T
  :optional-reset T
  :layout (:pretty-name "KPML: Linguistic Object Focusing" :left 10 :top 10 :width 630 :height 370)
  :body ((import-object-focus-statuses)
	 (setf +dark-gray+ *grey*)))

;;; misc-extra-frames.lisp

(define-kpml-i-frame-starter 
  STARTUP-FAT-FRAME
  fat-frame
  "KPML FAT"
  *fat-frame*
  :optional-reset T
  :layout (:pretty-name "Function-Associations (KPML)" 
			:left 100 :top 20 :width 350 :height 400))

(define-kpml-i-frame-starter 
  STARTUP-GENERATION-HISTORY-FRAME
  generation-history-frame
  "KPML GENERATION HISTORY"
  *generation-history-frame*
  :optional-reset T
  :layout (:pretty-name "Generation History (KPML)" 
			:left 100 :top 20 :width 500 :height 400)
  :postbody (label-generation-history-panes))


(define-kpml-i-frame-starter 
  STARTUP-AN-INFO-WINDOW-INTERNAL
  info-display-frame
  "KPML INFO"
  *info-frame*
  :offset T
  :reset-default T
  :args (label info type offset node-origin highlight1-p highlight2-p)
  :layout (:pretty-name label
			:width #+lispworks (get-label-width label) #-lispworks 300 
			:height 400)
  :frameinits
  ((info-to-display . info)
   (type-of-info . type)
   (highlighter1 . highlight1-p)
   (highlight2-p . highlight2-p)
   (origin . node-origin)))
  

(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
	 (display-generated-string-in-kpml-window lg offset))))

(define-kpml-i-frame-starter 
  DISPLAY-GENERATED-STRING-IN-KPML-WINDOW
  results-display-frame
  "KPML GENERATED RESULTS"
  *display-frame* 
  :offset T
  :args (lg offset)
  :layout (:pretty-name "Generation Result"
			:width 500 :height (if *display-structures* 600 300))
  :frameinits
  ((info-to-display . kpml::*mouseable-sentences*)
   (lg . lg))
  :postbody (undo-lg-based-font-decision *results-display-font*))

(define-kpml-i-frame-starter 
  STARTUP-SPL-AND-GENERATED-RESULT-FRAME-INTERNAL
  spl+generated-result-frame
  "KPML SPL and GENERATED RESULTS" 
  *display-frame*
  :args (example-name preselections)
  :layout (:pretty-name 
	   (format nil "~A (~A) : [Generation]" example-name kpml::curlan)
	   :left (first *current-offsets*) :top (second *current-offsets*)
	   :width 500 :height 600)
  :frameinits ((example-name . example-name)
	       (lg . kpml::curlan))
  :body ((setf kpml::*mouseable-sentences* nil))
  :postbody
  (progn
    (kpml::say example-name :preselections preselections)
    (clim:redisplay-frame-pane *display-frame* 'generated-result :force-p T)))

(define-kpml-i-frame-starter 
  STARTUP-GENERATED-EXAMPLE-STRING-FRAME 
  generated-example-strings
  "KPML GENERATED EXAMPLE STRING" 
  *display-frame*
  :args (features label)
  :layout (:pretty-name label
			:left (first *current-offsets*) :top (second *current-offsets*)
			:width 500 :height 600)
  :frameinits
  ((features . features)))


;;; options-selection.lisp

(define-kpml-i-frame-starter 
  STARTUP-KPML-OPTIONS-FRAME
  kpml-options-frame
  "KPML OPTIONS"
  *options-frame*
  :layout (:pretty-name "Options (KPML)" :left 100 :top 20
			:width #-acl3.0 500 #+acl3.0 800 :height 400)
  :reset-default T
  :frameinits
  ((current-option . (first (first kpml-i::*kpml-options*)))))

;;; resource-grapher-interface.lisp

(define-kpml-i-frame-starter 
  CREATE-A-RESOURCE-GRAPH
  systemic-resource-graph
  "KPML SYSTEM NETWORK RESOURCE GRAPH"	   
  *resource-grapher*
  :args (system)
  :layout (:pretty-name 
	   (concatenate 'string 
			(string system)
			": [Systemic resource graph]"
			)
	   :left 10 :top 10
	   :width *resource-graph-width*
	   :height *resource-graph-height*)
  :body (
	  (setf *root-system* system)
	  (setf *region-graphing-mode* nil)
	  (setf *graphed-region* (if (gethash system kpml::system-table)
				     (kpml::fetch-system-region 
				      (kpml::monolingualize-node system))
				   (kpml::fetch-system-region
				    (first
				     (kpml::who-has-as-output 
				      (kpml::monolingualize-node system))))))
	  (initialize-display-tool-variables))
  :frameinits
  ((mode . :single)
   (regions . (list *graphed-region*))
   (root-systems . (list *root-system*))
   (languages . (list kpml::curlan))
   (region-graphing-mode .  *region-graphing-mode*)))

(define-kpml-i-frame-starter 
  CREATE-A-REGION-GRAPH
  systemic-resource-graph
  "KPML REGION RESOURCE GRAPH"	   
  *resource-grapher*
  :args (region)
  :layout (:pretty-name (concatenate 'string (string region)
				     ": [Systemic region graph]"
				     )
			:left 10 :top 10
			:width *resource-graph-width*
			:height *resource-graph-height*)
  :body (
	  (setf *region-graphing-mode* t)
	  (setf *graphed-region* region)
	  (setf kpml::*resource-graphing-region-restricted?* t)
	  (initialize-display-tool-variables))
  :frameinits
  ((mode . :region)
   (regions . (list *graphed-region*))
   (root-systems . (list *root-system*))
   (languages . (list kpml::curlan))
   (region-graphing-mode .  T)))

(define-kpml-i-frame-starter 
  CREATE-A-CONTRASTIVE-REGION-GRAPH
  systemic-resource-graph
  "KPML CONTRASTIVE REGION GRAPH"	   
  *resource-grapher*
  :args (region)
  :layout (:pretty-name 
	   (concatenate 'string 
			(string region)
			": Systemic resource graph (multilingual region)"
			)
			:left 10 :top 10
			:width *resource-graph-width*
			:height *resource-graph-height*)
  :body 
  ((let ((mode :ml-region))
    (setf kpml::*contrastive-graphing-languages*
	  (let ((language-set (if kpml::*languages-in-focus*
				  kpml::*languages-in-focus*
				kpml::all_languages)))
	    (cond ((> (length language-set) 2)
		   (setf mode :ml>2-region)
		   (when (and (> (length language-set) 7)
                              (eq *contrastive-label-mode* :color))
                     (kpml::warning
                      "Too many languages for a contrastive view using distinctive colors! ("
                      (length language-set)
                      ") Using language abbreviations instead.")
                     (setf *contrastive-label-mode* :abbreviations))
                   language-set)
		  ((< (length language-set) 2)
		   (kpml::warning 
		    "Not enough languages for a contrastive view!")
		   (return-from create-a-contrastive-region-graph nil))
		  (t 
		   (setf mode
			 (case *bilingual-style*
			       (:bilingual :ml-region)
			       (:multilingual :ml>2-region)))
		   language-set))))
    (setf *region-graphing-mode* t)
    (setf *graphed-region* region)
    (setf kpml::*resource-graphing-region-restricted?* t)
    (setf (slot-value frame 'mode) mode)
    (setf (slot-value frame 'regions) (list *graphed-region*))
    (setf (slot-value frame 'languages) kpml::*contrastive-graphing-languages*)
    (setf (slot-value frame 'region-graphing-mode) T)
    (initialize-display-tool-variables))))

(define-kpml-i-frame-starter 
  CREATE-A-CONTRASTIVE-RESOURCE-GRAPH
  systemic-resource-graph
  "KPML CONTRASTIVE NETWORK GRAPH"	   
  *resource-grapher*
  :args (system)
  :layout (:pretty-name 
	   (concatenate 
	    'string
	    (string system)
	    ": [Systemic resource graph (multilingual)] " )
	   :left 10 :top 10
			:width *resource-graph-width*
			:height *resource-graph-height*)
  :body 
  ((let ((old-curlan kpml::curlan)
	(mode :ml))
    (setf kpml::*contrastive-graphing-languages*
	  (let ((language-set (if kpml::*languages-in-focus*
				  kpml::*languages-in-focus*
				kpml::all_languages)))
	    (cond ((> (length language-set) 2)
		   (setf mode :ml>2)
		   (if (> (length language-set) 7)
		       (progn
			 (kpml::warning
			  "Too many languages for a contrastive view! ("
			  (length language-set)
			  "). Taking first 7.")
			 (subseq language-set 0 7))
		     language-set))
		  ((< (length language-set) 2)
		   (kpml::warning 
		    "Not enough languages for a contrastive view!")
		   (return-from CREATE-A-CONTRASTIVE-RESOURCE-GRAPH nil))
		  (t 
		   (setf mode
		     (case *bilingual-style*
		       (:bilingual :ml)
		       (:multilingual :ml>2)))
		   language-set))))

      (setf *region-graphing-mode* nil)
      (setf *graphed-regions* 
	    (remove-duplicates
	     (loop for lg in kpml::*contrastive-graphing-languages*
		   collect
		   (progn ()
			  (setf kpml::curlan lg)
			  (kpml::fetch-system-region 
			   (kpml::monolingualize-node system))))))
      (setf kpml::curlan old-curlan)
      (setf *root-system* system)
      (setf (slot-value frame 'mode) mode)
      (setf (slot-value frame 'root-systems) (list *root-system*))
      (setf (slot-value frame 'regions) *graphed-regions*)
      (setf (slot-value frame 'languages) kpml::*contrastive-graphing-languages*)
      (setf (slot-value frame 'region-graphing-mode) nil)
      (initialize-display-tool-variables))))



(define-kpml-i-frame-starter 
  CREATE-A-STRATUM-GRAPH
  systemic-resource-graph
  "KPML STRATUM NETWORK GRAPH"	   
  *resource-grapher*
  :args (stratum)
  :layout (:pretty-name (concatenate 'string "Systemic stratum graph: "
				     (string stratum))
			:left 10 :top 10
			:width *resource-graph-width*
			:height *resource-graph-height*)
  :body (
	 (let ((root-systems (kpml::who-has-as-input stratum)))
	   (setf *region-graphing-mode* nil
		 *graphed-stratum* stratum
		 *graphed-region* (kpml::fetch-system-region 
				   (kpml::monolingualize-node (first root-systems))))
	   (setf kpml::*resource-graphing-region-restricted?* t)
	   (setf *root-system* (first root-systems))
	   (initialize-display-tool-variables)))
  :frameinits
  ((mode . :stratum)
   (regions . (list *graphed-region*))
   (root-systems . (kpml::who-has-as-input stratum))
   (languages . (list kpml::curlan))
   (region-graphing-mode .  nil)))


(define-kpml-i-frame-starter 
  CREATE-A-RESOURCE-GRAPH-FROM-FEATURES
  systemic-resource-graph
  "KPML NETWORK GRAPH FROM FEATURES"	   
  *resource-grapher*
  :args (feature-list)
  :layout (:pretty-name "Systemic resource graph from features"
			:left 10 :top 10 :width *resource-graph-width* 
			:height *resource-graph-height*)
  :body (
	 (setf *region-graphing-mode* nil)
	 (setf *graphed-regions* 
	       (remove-duplicates
		(loop for f in feature-list
		      collect
		      (kpml::fetch-system-region (first (kpml::who-has-as-output f))))))
	 (initialize-display-tool-variables))
  :frameinits
  ((mode . :collection)
   (regions . *graphed-regions*)
   (root-systems . feature-list)
   (languages . (list kpml::curlan))
   (region-graphing-mode .  nil)))


(define-kpml-i-frame-starter 
  CREATE-A-SEMANTIC-RESOURCE-GRAPH
  systemic-resource-graph
  "KPML SEMANTIC RESOURCES GRAPH"	   
  *resource-grapher*
  :args (concept)
  :layout (:pretty-name 
	   (concatenate 'string
			;; 2.0.9 was sometimes getting a concept-object
			;;       through here (with Loom) that string
			;;       was not (understandably) happy with...
			(string 
			 (or 
			  (kpml::kb-getconceptname concept)
			  concept))
			": [Semantics: systemic-resource-graph] "
			)
	   :left 10 :top 10 :width *resource-graph-width* 
	   :height *resource-graph-height*)
  :body (
	 (setf *root-system* concept)
	 (setf *region-graphing-mode* nil)
	 (setf *graphed-region* nil)
	 (initialize-display-tool-variables))
  :frameinits
  ((mode . :kr)
   (regions . (list *graphed-region*))
   (root-systems . (list *root-system*))
   (languages . (list kpml::curlan))
   (region-graphing-mode .  *region-graphing-mode*)))

;;; selection-expression-tool.lisp

(defun STARTUP-SELEXPRESSION-TOOL-INTERNAL
       (label string selexpr origin whereami preselections incomplete-p 
              &optional 
              (reuse *re-use-selexpression-window*)
              (reset *reset-selection-tool*))
  (when reset
    (close-a-window *selexpression-frame*)
    (setf *selexpression-frame* nil))
  (setf *whereami* whereami)                              ;; 4.1
  (if (or (not *selexpression-frame*)
	  (not (clim:get-frame-pane *selexpression-frame* 'selexpr :errorp nil))
	  (not reuse))
      (startup-selexpression-tool-frame
       label string selexpr origin whereami preselections incomplete-p
       :frame-tool-label string)
    (progn
      (setf (slot-value *selexpression-frame* 'label)         label
	    (slot-value *selexpression-frame* 'selexpr)       (reverse selexpr)
	    (slot-value *selexpression-frame* 'origin)        origin
	    (slot-value *selexpression-frame* 'whereami)      whereami
	    (slot-value *selexpression-frame* 'string)        string
	    (slot-value *selexpression-frame* 'preselections) preselections
	    (slot-value *selexpression-frame* 'incomplete-p)  incomplete-p
	    (slot-value *selexpression-frame* 'selexpr-region-width) *selexpr-region-width*)
      (redisplay-selexpr-panes *selexpression-frame*))))

(define-kpml-i-frame-starter 
  STARTUP-SELEXPRESSION-TOOL-FRAME
  selection-expression-frame
  "KPML SELECTION EXPRESSION TOOL"
  *selexpression-frame*
  :args (label string selexpr origin whereami preselections incomplete-p)
  :layout (:pretty-name "Selection expression tool"
			:left 100 :top 25 :width 600 :height 400)
  :frameinits
  ((label .    label)
   (selexpr .  (reverse selexpr))
   (origin .   origin)
   (whereami . whereami)
   (string .   string)
   (preselections . preselections)
   (incomplete-p .  incomplete-p)
   (selexpr-region-width . *selexpr-region-width*)))

;;; structure-grapher-interface.lisp
;;; 4.0 expansion info added.

(define-kpml-i-frame-starter 
  GRAPH-SENTENCE-STRUCTURE
  structure-graph
  "KPML SENTENCE STRUCTURE"
  *structure-grapher*
  :layout (:pretty-name "Generated Structure" :left 10 :top 10
			:width *structure-graph-width*
			:height *structure-graph-height*)
  :frameinits
  ((lg . kpml::curlan)
   (info . (kpml::copy-pass-table kpml::show-pass-hash-table))
   (expansion-info . (kpml::extract-pass-expansion-info))
   )
  :postbody (undo-lg-based-font-decision *structure-graphing-font*))

;;; system-popups-interface.lisp

(define-kpml-i-frame-starter 
  CREATE-A-SYSTEM-EDITING-GRAPH-INTERNAL
  system-editor-frame
  "KPML SYSTEM EDITOR"
  *frame*
  :offset T
  :args (system offset calling-frame window-name)
  :layout (:pretty-name window-name
			:width #+lispworks 700 #-lispworks 600
			:height #-lispworks *resource-graph-height*
			#+lispworks 700)
  :frameinits
  ((created-system . 
		   (make-skeleton-system :name system
					 :outputs (kpml::fetch-system-outputs system)
					 :inputs (kpml::fetch-system-inputs system)
					 :chooser (kpml::fetch-system-chooser system)
					 :region (kpml::fetch-system-region system)
					 :comments (kpml::fetch-system-comments system)))
   (calling-frame . (if (eq (type-of calling-frame) 'SYSTEMIC-RESOURCE-GRAPH)
			calling-frame nil))))
    
;;; #+ignore (setf (clim:frame-current-layout editor-frame) 'default)

(define-kpml-i-frame-starter 
  CREATE-A-NEW-SYSTEM-EDITING-FRAME
  system-editor-frame
  "KPML NEW SYSTEM EDITOR"
  *frame*
  :args (system-name entry-condition region features calling-frame)
  :layout (:pretty-name (concatenate 'string
				     (if system-name (string system-name)
				       "NEW SYSTEM")
				     ": [system-editor] "
				     )
			:width #+lispworks 700 #-lispworks 600
			:height #-lispworks *resource-graph-height*
			#+lispworks 700)
  :frameinits
  ((created-system . (make-skeleton-system :name system-name
			    :outputs features
			    :inputs entry-condition
			    :chooser nil
			    :region (if region region *default-region-name*)
			    :comments nil))
   (calling-frame . (if (eq (type-of calling-frame) 'SYSTEMIC-RESOURCE-GRAPH)
			calling-frame nil))))

    ;; 2.0 Lispworks cannot change layouts very well it seems
    ;;     so start with the most useful as default and change explicitly
    ;;     here in those Lisps which can cope...
    ;; 2.0.29 in fact, virtually no lisp copes with the following
    ;;     reliably, Lispworks breaks, Allegro throws to some catch
    ;;     about a layout changing. So this probably needs to be redone
    ;;     in a more robust fashion. This makes patch 2.0.5 redundent
    ;;     btw.
    #+ignore(setf (clim:frame-current-layout editor-frame) 'default)

(defun CREATE-A-NEW-SYSTEM-EDITING-GRAPH 
  (system-name entry-condition region
	       &optional (features '((0.5 feature1) (0.5 feature2)))
	       (calling-frame nil))
    (create-a-new-system-editing-frame
       system-name entry-condition region features calling-frame))

;;; traversal-graph.lisp

(define-kpml-i-frame-starter 
  STARTUP-A-TRAVERSAL-FRAME
  traversal-graph-frame
  "KPML TRAVERSAL INSPECTION TOOL"
  *traversal-frame*
  :layout (:pretty-name (format nil 
				"Network Graphical Traversal (ex: ~A)"
				kpml::*most-recent-example*)
			:left 20 :top 20 :width 630 :height 400)
  :frameinits
  ((traversal . (make-hash-table))
   (record-id . (gensym))))


