(in-package "KPML-I")
;;;
;;; File: interface-root.lisp
;;; Author: John Bateman
;;; Created: 14 Oct 95
;;; Last Update: Oct 98, user levels added.
;;;
;;; Contains all the definitions for the windows and commands associated
;;; with the root of the new KPML interface. This includes basic
;;; window commands, environment and flag setting, and resource
;;; management such as loading and writing resources to files, etc.
;;;
;;; build in font switching to the changing of languages...
;;; but only when the flag *global-font-switching* is T.
;;;
;;; The font referred to is used uniquely in the inspector windows
;;; of the development and inspector frames (after the changes
;;; below!)
;;;
;;; 1.1 adds additional menu-reachable commands for selecting 
;;; global options (that are used for toggling experimental or
;;; new features that may change behaviour in ways that a user
;;; does not want) and for activating various tools as they
;;; become available (candidates here are: the subgrammar extractor,
;;; Mick's coder, or whatever...)
;;; 
;;; ======================================================================

(defvar *global-font-switching* nil)
(defvar *fix--bold--11* (clim:parse-text-style
			 '(:fix :bold 11)))
(defvar *highlight-collected-features?* T)
(defvar *warning-display-count* 60)                   ;; 4.0
(defvar *graphical-focusing-ops* nil
  "set true when graphical focusing selection activated")

;;; ----------------------------------------------------------------------
;;; Basic startup function for the new KPML interface.

;;; 1.1 wraps a protocol file around all uses of the interface so
;;;     that editing changes can be saved in case of catastrophic
;;;     collapses prior to saving out a revised resource version.
;;; 1.2 :color keyword added for Knut.
;;; 2.1 :demo behaviour changed so that there is no change of 
;;;           compiled code
;;;     :configure added as default so that a configuration file gets
;;;           loaded at startup at latest.
;;; 3.1 :frame-manager added for the frame-managing tool
;;;     :protocol added for activating or deactivating the editing log.
;;; 4.0 :frame-manager uses a window and processing structuring that
;;;           is not so compatible with the new CLIM window management in
;;;           Allegro ACL5 and above. For now, just remove the option for
;;;           ACL5 up until it can be checked out. And also remove it
;;;           by default for Windows, since there we have a better overview
;;;           of the windows in any case.
;;; 4.1+  there was a really stupid line just following the defun that
;;;          just squashes all using of the flag *editing-protocol*. Removed.
;;;          No idea how it got in or why. (John, Jan 2009)

(defun STARTUP 
    (&key (reset T)
          (size :small)
          (demo nil)
          (color kpml::*monochrome*)
	  (configure T)
          (frame-manager #+unix T #-unix nil)
          (protocol kpml::*editing-protocol*))

    ;; need this for some nasty Windows interactions in LW5 (2012-03-12)
    #+lispworks5 (win32:set-application-themed nil)

  ;; ----------------------------------------------------------------------
  ;; 4.0 temporary one hopes...
  #+allegro
  (:version-case (":ALLEGRO-V")
		 ((- "4.4")   (setf *frame-tool-activated* frame-manager))
		 ((+ "4.4")   (setf *frame-tool-activated* nil)))
  #+lispworks
  (setf *frame-tool-activated* frame-manager)
  ;; ----------------------------------------------------------------------

  (when reset 
    (close-all-windows)
    (kpml::close-edit-protocol-stream)
    ;; 2.0 to make sure it doesn't get set to something unsuitable
    ;;     by other processes...
    (setf clim:*default-text-style* 
      (clim:make-text-style :sans-serif :roman 10)))

  (when (or reset (not kpml::window-interface-flag))
	(setf *color-pilot-palette* 
	      (clim:frame-palette 
	       (clim:make-application-frame 'color-pilot)))
	(color (if (eq color T) :color
		 (if (eq color nil) :mono
		   color))))

  (when configure (kpml::load-kpml-configuration-file))     ;; 2.1
  (set-window-sizes size)
  (when (or demo
            kpml-i::*font-size-update-pending*)
    (configure-kpml-font-sizes))                   ;; 2.1
  (setf kpml::window-interface-flag T)
  (when protocol  (kpml::open-and-start-editing-log)) ;; 4.1+
	
  (protected-window-startup))

;;; ----------------------------------------------------------------------
;;; Core startup of windows as conditionalized according to version
;;; and startup configuration...
;;; 2.1 conditionalization range added...
;;; 3.0 frame overview tool

(defun PROTECTED-WINDOW-STARTUP ()
  #+allegro(:version-case (":ALLEGRO-V")
			  ((+ "4.2")
			   #+unix 
			   (setq xm-silica::*use-clim-gc-cursor* T)
			   ))
  (unwind-protect 
      (progn
        (setf *fof* (if *frame-tool-activated* nil :closing))
	(case kpml::*startup-windows*
	      ((:all :conditional)
	       (startup-resource-management-frame)
	       #-acl3.0(when (or (equal kpml::*startup-windows* :all)
				 (> (length kpml::systems) 0))
			     (startup-resource-development-frame)
			     #+ignore (startup-resource-inspector-frame)))
	      (:development
	       (setf *development-frame-only* T)
	       (startup-resource-development-frame))
	      (:root
	       (startup-resource-management-frame))))
    #+acl3.0(kpml::close-edit-protocol-stream))
  T)

;;; ----------------------------------------------------------------------
;;; Application frame definition and layout
;;; 2.0 Second kpml-prompt-function does not any start tools...

(clim:define-application-frame 
 KPML-INTERFACE ()
 ()
 (:menu-bar nil)
 (:top-level (clim:default-frame-top-level :prompt kpml-prompt-function-2))
 (:panes (menu        :command-menu
		      :height 100
		      :foreground menu-fg
		      :background menu-bg
		      :text-style *menu-font*)
	 (Interactor  :interactor
		      :foreground interactor-fg
		      :background interactor-bg
		      :text-style *fix--roman--12*)
	 (inspector   :application
		      :scroll-bars :vertical
		      :foreground inspector-fg
		      :background inspector-bg 
		      :text-style *fix--bold--10*)
	 (kpml-modes  :application
		      :foreground inspector-fg
		      :background inspector-bg
		      :text-style *fix--bold--10*)
	 (mouse-doc   :pointer-documentation
		      :foreground  mouse-doc-fg
		      :background  mouse-doc-bg)
	 )
 (:layouts (first (clim:vertically
		   ()
		   #+lispworks menu #-lispworks (100 menu)
		   (1/3 interactor)
		   (:fill inspector)
		   (clim:horizontally 
		       ()
		     (clim:make-pane 'clim:push-button
				     :background clim:+cyan+
				     :text-style *sans-serif--bold--10*
				     :label 
				     +launch-dev-window-label+
				     :client clim:*application-frame* :id 'startup-dev
				     :width #+unix 2000 #-unix 200
				     :activate-callback
				     #'(lambda (gadget)
					 (declare (ignore gadget))
					 (format *standard-output*
						 "~%Development windows launched...")
				 (startup-resource-development-frame)
				 (unless common-lisp-user::*extended-development-frame*
				   (startup-resource-inspector-frame))
				 ))
		     
		     (clim:make-pane 'clim:push-button
				     :background clim:+cyan+
				     :text-style *sans-serif--bold--10*
				     :label "Tools"
				     :client clim:*application-frame* 
				     :id 'kpml-tools
				     :activate-callback
				     #'(lambda (gadget)
					 (declare (ignore gadget))
					 (select-kpml-tools)))
		     #+(and :kpml-level>= :kpml-l2)
		     (clim:make-pane 'clim:push-button
				     :background clim:+cyan+
				     :foreground clim:+red+
				     :text-style *sans-serif--bold--10*
				     :label "Options"
				     :client clim:*application-frame* 
				     :id 'kpml-options
				     :activate-callback
				     #'(lambda (gadget)
					 (declare (ignore gadget))
					 (set-kpml-global-options))))
		   #-lispworks (2/32 mouse-doc)))
	   (second (clim:vertically
		   ()
		   (2/3 interactor)
		   (:fill inspector)
		   #-lispworks mouse-doc))))

;;; ----------------------------------------------------------------------
;;; Startup function for the resource managment window...
;;; ----------------------------------------------------------------------

(defvar *long-title* "KOMET-PENMAN (Multilingual) ")
(defvar *short-title* "KPML")

(defun KPML-MAIN-FRAME-NAME ()
  (concatenate 'string
    *short-title*
    " -- version: "
    (format nil "~A" (kpml::major-version-nr))  ;; 4.0 for robustness
    (if (numberp (kpml::micro-version-nr))
	(if (> (kpml::micro-version-nr) 0)
	    (format nil " --              (~A)"
		    (kpml::micro-version-nr))
	  "")
      (string (kpml::micro-version-nr)))))

(defun STARTUP-RESOURCE-MANAGEMENT-FRAME ()
  (unless *resource-manager-frame*
    (let* ((frame (setf *resource-manager-frame*
		    (clim:make-application-frame
		     'kpml-interface
		     :pretty-name (kpml-main-frame-name)
		     :left 10 :top 10
		     :width 500 :height 430)))
	   (process
	    (process-run-function 
	     "KPML-MA" 
	     #'run-packaged-frame
	     *resource-manager-frame* *package*)))
      (push (cons frame process) *frame-process-alist*))))

;;; ----------------------------------------------------------------------
;;; Commands relevant for the resource managment window...

;;; Menu...

#-(and acl3.0 aclpc)
(define-kpml-interface-command (com-QUIT :name t :menu T)
    ;; 2.0.45 folded in...
    ()
  (when (check-for-patches clim:*application-frame*)
    (kpml::close-edit-protocol-stream)
    (setf kpml::window-interface-flag nil)
    (close-all-windows)
    (setf *fof* :closing)
    ;; 3.1
    (close-a-window clim:*application-frame*)
    ))

#+(and acl3.0 aclpc)(defun COM-QUIT (&rest args)
                      (declare (ignore args))
                      (check-for-patches clim:*application-frame*))

;;; ----------------------------------------------------------------------
;;; The following provides a check that patches, if made, have been
;;; saved.
;;;
;;; 2.1 improved (in the hope that the individual Lisps know how to
;;;     change the format commands into appropriate sequences for both
;;;     Unix and PCs).
;;; ----------------------------------------------------------------------

(defun CHECK-FOR-PATCHES (frame)
  (if kpml::*patches-exist*
      (clim:notify-user 
       frame
       (concatenate 'string
	 "Warning!"
	 (format nil "~2%~{~A~%~}" 
		 (kpml::indent-and-fill 
                  (append 
                   (list "Patches have been made in the currently loaded resources and these have not yet been saved!! If you exit the interface, then it is up to you to take further action to save changes that you have made in this session. ")
		   #+unix
                   (list "You may cancel to continue using the interface, or select OK to leave.")
                   #-unix(list "To exit, close the window manually."))))))
    T))

#+(and :kpml-level>= :kpml-l2)
(define-kpml-interface-command (com-FLAGS :name t :menu T)
  ()
  (kpml::kpml-system-flags-menu))

#+(and :kpml-level>= :kpml-l2)
(define-kpml-interface-command (com-GIVE-KPML-VERSION :name t :menu nil)
  ()
  (clim:notify-user clim:*application-frame*
		    (with-output-to-string 
		     (stream)
		     (kpml::describe-kpml stream))))

#+(and :kpml-level>= :kpml-l2)
(define-kpml-interface-command (com-TOGGLE-VERSIONING :name t :menu nil)
  ()
  (let* ((versioning? (kpml::toggle-kpml-versioning))  ;; 2.1
	 (stream (or (clim::get-frame-pane *resource-development-frame*
					   'inspector)
		     (clim::get-frame-pane *resource-manager-frame*
					   'inspector))))
    (setf kpml::*patch-status* versioning?)
    (when stream
      (if versioning?
	  (format stream "~%Resource versioning on.")
	(format stream "~%Resource versioning off.")))))

(define-kpml-interface-command (com-TOGGLE-SPL-SHOWING :name t :menu nil)
    ()
  (let* ((stream (or (clim::get-frame-pane *resource-development-frame*
					   'inspector)
		     (clim::get-frame-pane *resource-manager-frame*
					   'inspector))))
    (setf kpml-i::*show-spl-on-generation* (not kpml-i::*show-spl-on-generation*))
    (when stream
      (if kpml-i::*show-spl-on-generation*
	  (format stream "~%SPLs will be shown when generating.")
	(format stream "~%SPLs will not be shown when generating.")))))


#+(and :kpml-level>= :kpml-l2)
(define-kpml-interface-command 
    (com-ENVIRONMENT-DIRECTORIES :name "Environment" :menu T)
    ()
  (kpml::set-environment-directories))

;;; ----------------------------------------------------------------------
;;; 2.0.31
;;; ----------------------------------------------------------------------

#+(or (not :kpml-level>=) (and :kpml-level>= :kpml-l2))
(define-kpml-interface-command 
    (com-STORE-GRAMMAR-RESOURCE 
     :name "Store Resources" 
     :menu T)
    ()
  (kpml::create-grammar-resource-option))

#-(or (not :kpml-level>=) (and :kpml-level>= :kpml-l2))
(define-kpml-interface-command 
    (com-STORE-GRAMMAR-RESOURCE 
     :name "Store Resources" 
     :menu nil)
    ()
  (let ((common-lisp-user::*root-of-resources* 
	 (if kpml::*local-root-of-resources*       ;; 4.0 make sure you don't
	     kpml::*local-root-of-resources*       ;;     stuck with NIL as 
	   common-lisp-user::*root-of-resources*)) ;;     this messes up the
	(kpml::*loading-saving-profile*            ;;     dialog box...
	 (remove :resource-patches kpml::*loading-saving-profile*)))
    (kpml::create-grammar-resource-option)))


;;; ----------------------------------------------------------------------
;;; 2.0.31 local resource sets...
;;; ----------------------------------------------------------------------

(define-kpml-interface-command 
    (com-TOGGLE-LOCAL-NONLOCAL-RESOURCES 
     :name "Toggle local/nonlocal resources" :menu nil)
    ()
  (when kpml::*local-root-of-resources*
    (cond ((equal common-lisp-user::*root-of-resources* 
		  kpml::*local-root-of-resources*)
	   (setf  common-lisp-user::*root-of-resources* 
	     kpml::*other-root-of-resources*))
	  (t 
	   (setf kpml::*other-root-of-resources* 
	     common-lisp-user::*root-of-resources*)
	   (setf common-lisp-user::*root-of-resources*
	     kpml::*local-root-of-resources*)))))


;;; 4.0
#+(and :kpml-level>= :kpml-l2)
(define-kpml-interface-command 
    (com-RESHOW-WARNINGS
     :name "Show warnings" :menu nil)
    ()
    (if kpml::warnings
	(let ((warning-strings 
	       (loop for w 
		     in (if *warning-display-count*
			    (reverse 
			     (last 
			      (reverse kpml::warnings) 
			      *warning-display-count*))
			  (reverse kpml::warnings))
		     collect (kpml::indent-and-fill (list w) 
						    :except-first-p T 
						    :right-margin 35
						    :right-margin-p T))))
	  (startup-an-info-window
	   "Warnings history"
	   (if (> (length kpml::warnings) *warning-display-count*)
	       (append 
		warning-strings
		(list 
		 (list (format 
			nil "~A more warnings not shown..." 
			(- (length kpml::warnings) 
			   *warning-display-count*)))))
	     warning-strings)
	   :type :formatted-strings))
      (clim:notify-user clim:*application-frame* "No warnings issued!")))


#+(and :kpml-level>= :kpml-l2)
(define-kpml-interface-command (com-CLEAR-WARNINGS :name nil)
  ()
  (setf kpml::warnings nil))


#+(and :kpml-level>= :kpml-l2)
(define-kpml-interface-command (com-CREATE-NEW-LANGUAGE 
				:name "New Resource" :menu T)
    ()
  (kpml::create-new-language-resource-option))

(define-kpml-interface-command 
    (com-LOAD-LINGUISTIC-RESOURCE :name "Load Resources" :menu T)
    ()
  (unless kpml::*root-of-resources* (kpml::set-environment-directories))
  (case 
      #+(and :kpml-level>= :kpml-l2) kpml::*ml-loading-mode*
      #-(and :kpml-level>= :kpml-l2) :multilingual
    (:monolingual 
     (kpml::load-monolingual-resource-option))
    (:contrastive
     (kpml::load-contrastive-resource-option))
    (:multilingual
     (kpml::load-multilingual-resource-option))))

#+(and :kpml-level>= :kpml-l1)
(define-kpml-interface-command (com-LOAD-LEXICON-FILES :name T :menu nil)
  ()
  (unless kpml::*root-of-resources* (kpml::set-environment-directories))
  (kpml::interface-lexicon-loading))

#+(and :kpml-level>= :kpml-l1)
(define-kpml-interface-command (com-WRITE-LEXICON-FILES :name T)
  ()
  (kpml::protocol-edit ";;; Lexicon files written.")
  (kpml::interface-lexicon-saving))
	 
#+(and :kpml-level>= :kpml-l2)
(define-kpml-interface-command (com-WRITE-NEW-LEXICAL-ITEMS :name T)
    ()
  (kpml::protocol-edit ";;; Newly acquired lexical items written.")
  (cond (kpml::*new-lexical-items*
	 (kpml::interface-new-lexemes-saving))
	(t
	 (clim:notify-user clim:*application-frame*
			   "No newly acquired lexical items to save."))))

#+(and :kpml-level>= :kpml-l2)
(define-kpml-interface-command (com-CLEAR-LEXICON :name T)
  ()
  (kpml::protocol-edit '(clear :lexicon)) 
  (kpml::erase-lexicon))
	 
;;; 1.1 example equivalents added for completeness and for use in the
;;; example operations menu...

(define-kpml-interface-command (com-LOAD-EXAMPLE-FILES :name T :menu nil)
  ()
  (let ((stream (clim::frame-top-level-sheet clim:*application-frame*))
	(*standard-output* *trace-output*))
    (unless kpml::*root-of-resources* (kpml::set-environment-directories))
    (kpml::load-examples-from-interface stream)))

#+(and :kpml-level>= :kpml-l2)
(define-kpml-interface-command (com-WRITE-EXAMPLE-FILES :name T :menu nil)
  ()
  (let ((stream (clim::frame-top-level-sheet clim:*application-frame*)))
    (kpml::protocol-edit ";;; Examples written out.")
    (kpml::interface-example-saving stream)))

#+(and :kpml-level>= :kpml-l2)
(define-kpml-interface-command
    (com-reload-last-example-file-main :name "Reload Last Example File" :menu nil)
    ()
  (if kpml::*last-loaded-example-file*
      (let ((*standard-output* *trace-output*))
	(kpml::kpml-load kpml::*last-loaded-example-file*))
    (com-load-example-files)))

#+(and :kpml-level>= :kpml-l2)
(define-kpml-interface-command (com-CLEAR-EXAMPLES :name T)
  ()
  (kpml::protocol-edit '(clear :examples)) 
  (kpml::erase-examples))

#+(and :kpml-level>= :kpml-l2)
(define-kpml-interface-command (com-CLEAR-INDIRECTION :name T)
    ()
  (setf *indirect-reload-filename* nil))

#+(and :kpml-level>= :kpml-l2)
(define-kpml-interface-command (com-CLEAR-SYSTEMIC-NETWORKS 
				:name "Clear Networks" :menu T)
  ()
  (kpml::protocol-edit '(clear :networks))  
  (kpml::erase-grammar))

#+(and :kpml-level>= :kpml-l2)
(define-kpml-interface-command (com-FOCUSING-OPERATIONS :name T :menu T)
    ()
  (if *graphical-focusing-ops*
      (ascertain-focusing-options-graphically T)
    (kpml::ml-focusing-operations)))

#+(and :kpml-level>= :kpml-l2)
(define-kpml-interface-command (com-MULTILINGUAL-BEHAVIOUR-MODES 
				:name "Multilingual Modes" :menu T)
    ()
  (let ((merging-local (if kpml::*merging-active* :merging :overwriting))
	(stream (clim::frame-top-level-sheet clim:*application-frame*)))
    (clim:accepting-values
     (#-acl3.0 stream #+acl3.0 *query-io* :own-window t
	     :resynchronize-every-pass t
	     :label "Multilingual behaviour modes" :exit-boxes 
	     '((:exit "Click here when selection made")
	       (:abort "Click here to cancel")))
     (let ((stream #-acl3.0 stream #+acl3.0 *query-io*))
     (radio-box-accept merging-local  (:overwriting :merging) "Merging behaviour.....")
     (setf kpml::*merging-active*
	   (if (eq merging-local :overwriting)
	       nil T))
     (radio-box-accept kpml::*ml-loading-mode* (:monolingual :contrastive :multilingual)
		       "Loading behaviour.....")
     (radio-box-accept kpml::*ml-saving-mode* (:monolingual :contrastive :multilingual)
		       "Saving behaviour......")
     (radio-box-accept kpml::*ml-display-mode* (:monolingual :contrastive :multilingual)
		       "Display behaviour.....")
     (radio-box-accept kpml::*ml-graphing-mode* (:monolingual :contrastive :multilingual)
		       "Graphing behaviour....")
     (radio-box-accept kpml::*ml-generation-mode* (:monolingual :contrastive)
		       "Generation behaviour..")
     (kpml-i-terpri stream)
     (setq kpml::*clearing-flag*
       (clim:accept #-lispworks '(member t nil) 
                    #+lispworks 'clim:boolean
                    :stream stream
		    #-lispworks :view #-lispworks 'clim:list-pane-view
		    :prompt "Clear before monolingual resource loading ."
		    :default kpml::*clearing-flag*))
     #+lispworks (dialog-end-spacing)
     ))))

;;; 0.9.22
;;; Following neglected to activate language conditionalization at all...

#+(and :kpml-level>= :kpml-l2)
(define-kpml-interface-command (com-SET-DEFAULT-LANGUAGE
				:name T :menu nil)
    ()
  (com-set-loading-defaults))

#+(and :kpml-level>= :kpml-l2)
(define-kpml-interface-command (com-SET-LOADING-DEFAULTS
				:name T :menu T)
    ()
  (let ((stream (clim::frame-top-level-sheet clim:*application-frame*))
	(languages nil)
	(merging-local (if kpml::*merging-active* :merging :overwriting))
        )
    (clim:accepting-values
	(#-acl3.0 stream #+acl3.0 *query-io* 
                  :own-window *own-window*
	          :scroll-bars :horizontal
	          :resynchronize-every-pass t
	          :label "Default Language for Input Interpretation" :exit-boxes 
	          '((:exit "Click here to start")(:abort "Click here to cancel")))
	(let ((stream #-acl3.0 stream #+acl3.0 *query-io*))
	  (kpml-i-terpri stream)
	  (if kpml::*current-default-languages*
	      (clim:with-text-style  
		  (stream kpml-i::*fix--bold-italic--12*)
		(format stream "~%Current default languages for interpreting
input are: ~A~2%" kpml::*current-default-languages*)
		(format stream "Merging mode is switched ~:[OFF~;ON~]~%"
			kpml::*merging-active*))
	(format stream "~4%"))
      (kpml-i-terpri stream)
      (setf languages
	    #-(and acl3.0 aclpc)
	    (clim:accept `(clim:subset-sequence 
			   ,(cons  "Clear Default" kpml::all_languages))
			 :stream stream
			 #-lispworks :view #-lispworks 'clim:list-pane-view
			 :prompt "Default language(s) during input evaluation"
			 :default languages)
	    #+(and acl3.0 aclpc)
	    (kpml::get-a-subset-from 
	     (cons  "Clear Default" kpml::all_languages)
	     languages
	     "Default language(s) during input evaluation"))
      (cond ((stringp (first languages))
	     (setf kpml::*in-ml-region* nil)  ;; 0.9.22
	     (setf kpml::*current-default-languages* nil))
	    ((and languages
		  (loop for l in languages always (kpml::lg-designator-p l)))
	     (setf kpml::*in-ml-region* T)  ;; 0.9.22
	     (setf kpml::*current-default-languages* languages))
	    (t nil))

      (kpml-i-terpri stream)
      (kpml-i-terpri stream)
     (setf merging-local
	   (clim:accept '(member :overwriting :merging)
			:stream stream
			#-lispworks :view #-lispworks '(clim:list-pane-view)
			:prompt "Merging behaviour....."
			:default merging-local))
     (setf kpml::*merging-active*
	   (if (eq merging-local :overwriting)
	       nil T))
     (kpml-i-terpri stream)))
    ))

  
  
  
;;; Other commands...
  
(define-kpml-interface-command (com-eval-lisp-expr :name ",")
  ((expression 'clim:expression))
  (eval-lisp-expression expression))
  
#+(and :kpml-level>= :kpml-l2)
(define-kpml-interface-command (com-suspend-interface :name "Suspend")
    ()
  (setf kpml::window-interface-flag nil))
  
#+(and :kpml-level>= :kpml-l2)
(define-kpml-interface-command (com-unsuspend-interface :name "Activate")
    ()
  (setf kpml::window-interface-flag T))

#+(and :kpml-level>= :kpml-l2)  
(define-kpml-interface-command 
  (com-CLEAR-Windows :name t)
  ()
  (clear-resource-development-panes)
  (clear-generation-history-panes)
  (clear-fat-pane))


;;; ----------------------------------------------------------------------
;;; An extra command to fill in the menu! :-)
;;; 0.9.60 

#+(and :kpml-level>= :kpml-l2)
(define-kpml-interface-command 
    (com-CLEAR-LANGUAGE-VARIETIES :name T :menu T)
  ()
  (setf kpml::all_languages nil)
  (setf kpml::curlan nil))

;;; 1.1
(define-kpml-interface-command 
    (com-INITIALIZE-ALL :name "Do pre-generation initializations" :menu nil)
    ()
  (kpml::do-all-kpml-initializations))

(define-kpml-interface-command 
    (com-CLEAR-GENHISTORY-2 :name "Clear cumulative history" :menu nil)
    ()
  (kpml::reset-generation-history))

;;; ----------------------------------------------------------------------
;;; 1.0.35
;;; The :options command for controlling the extra facilities that
;;; become available on an experimental basis... Note that from 1.1
;;; onwards this is a standard feature, that is reached from a main
;;; window menu bar. 
;;; ----------------------------------------------------------------------

(define-kpml-interface-command (com-KPML-OPTIONS :name "Options" :menu nil)
  ()
  (set-kpml-global-options))

;;; ----------------------------------------------------------------------
;;; Optional tools may also be added...
;;; ----------------------------------------------------------------------

(define-kpml-interface-command (com-KPML-TOOLS :name "Tools" :menu nil)
  ()
  (select-kpml-tools))

(defun SELECT-KPML-TOOLS ()
  (when *kpml-tool-list*
    (let ((tool (kpml-i::menu-choose  *kpml-tool-list* :label "Select tool")))
      (when tool
	(apply (car tool) (cdr tool))))))

;;; ----------------------------------------------------------------------
;;; replaces stubb in image-makers.lisp
;;; ----------------------------------------------------------------------

(defun KPML::KPML-TOOLS-DESCRIBER (&optional (stream T))
  (if *kpml-tool-list*
      (progn
	(format stream "~%     Tools installed: ")
	(loop for tool in *kpml-tool-list*
	    do (format stream "~%       ~A" (car tool)))
	(if kpml::*starttool*
	    (format stream "~%     Start tool is: ~A" kpml::*starttool*)
	  (format stream "~%     No start tool set."))
	(format stream "~2%"))
    (format stream 
	    "~2%     No additional KPML extension tools installed.")))

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

#+acl3.0
(define-kpml-interface-command 
  (com-LOAD-FSL :name "Load Compiled File" :menu nil)
  ()
  (let ((filename (clim:select-file clim:*application-frame*))
	;; previously: (common-lisp-user::ask-user-for-filename "")
	(load-ok? nil))
    (when (open filename :direction :probe)
	  (format *trace-output* ";;; File: ~A found and being loaded..."
		  filename)
	  (unwind-protect
	      (progn
		(load filename)
		(format *trace-output* " ... done.")
		(setf load-ok? T))
	    (unless load-ok?
		    (format *trace-output* " ... error in load. Abandoned."))))
    t))

(define-kpml-interface-command 
    ;; 2.0.20
    (com-LOAD-KPML-CONFIG-MENU :name "Reconfigure" 
			       :menu #+(and :kpml-level>= :kpml-l1) T
			             #-(and :kpml-level>= :kpml-l1) nil)
  ()
  (kpml::load-kpml-configuration-file)
  (when kpml-i::*font-size-update-pending* (configure-kpml-font-sizes)) ;; 2.1
  T)


;;; ----------------------------------------------------------------------
;;; A little more info when one needs it...

(define-kpml-interface-command 
    (com-VERSION
     :name "Version" 
     :menu nil)
    ()
  (kpml::describe-kpml))

