(in-package "KPML")

;;; File: ml-window-ops.lisp
;;;
;;; Contains the options concerning with loading and saving linguistic
;;; resources and those for setting loading and saving behavior.

;;;;----------------------------------------------------------------------
;;;; DEVELOPMENT HISTORY
;;;; Version 0.6: saving and loading operations restricted...
;;;;              see below.
;;;; Version 0.7: restricted merging available, but not advertised...
;;;;
;;;    Most functions updated in order to put back in the missing abort
;;;    cases for the menus; patch: 0.7.20
;;; 
;;;    Also patch .23 added into MULTILINGUAL-OPERATIONS, since previously
;;;    it was impossible to load a lexicon from the noncurrent language!
;;;    Also patch .25 added in RESOURCE-MAINTENANCE-OPTIONS, so that the
;;;    set current language window disappears before the language is
;;;    set.
;;; 
;;;; Version 0.8: merging fully functional and ml modes added.
;;;  Version 0.9: access to the commands/functionalities moved to
;;;     the main menu of the interface.
;;;  Version 1.0: multilingual modes sensitivity properly added to
;;;     individual lexicon and example loading and saving.
;;;     Check so that existing resources not overwritten using the
;;;     resource maintenance flag: *resource-directory-versioning*.
;;;  Version 1.1PC: CLIM 2 for PC doesn't get subset-sequences right
;;;     at all, so they are all conditionalized here to use a function
;;;     in Processes/ui-aclwin.
;;;  2.0 references to CLIM-1 removed.
;;;  2.0.55 records last used file so that it can be readily reused 
;;;  3.2+   uses macro for positioned accepting-values for backwards-comp
;;;;----------------------------------------------------------------------

(defvar *default-ml-resource-set-name* nil)
(defvar *default-ml-resource-set-prefix* "ML")
(defvar *full-example-structures-saved* nil)
(defvar *last-loaded-example-file* nil)
(defvar *last-loaded-lexicon-file* nil)

;;; ----------------------------------------------------------------------
;;; Individual lexicon loading options...

(defun INTERFACE-LEXICON-LOADING 
    (&optional
     (stream (clim::frame-top-level-sheet clim:*application-frame*)))
  (case *ml-loading-mode*
    (:monolingual 
     (load-monolingual-lexicon-option stream))
    (:contrastive
     (load-contrastive-lexicon-option stream))
    (:multilingual
     (load-multilingual-lexicon-option stream))))

(defun LOAD-MONOLINGUAL-LEXICON-OPTION
    (&optional
     (stream (clim::frame-top-level-sheet clim:*application-frame*)))
  (let ((lexicon-lg curlan)
	(*clearing-flag* nil))
    (kpml-i::positioned-accepting-values
	(stream :own-window kpml-i::*own-window*
                :x-position (first kpml-i::*confirmation-popups-xy*)
                :y-position (second kpml-i::*confirmation-popups-xy*)
		:resynchronize-every-pass t
		:label "Loading subops (lexicons; mono)" 
		:exit-boxes 
		'((:exit "Click to start loading")
		  (:abort "Click here to cancel")))
      (kpml-i-terpri stream)
      (setf lexicon-lg
	(clim:accept `(member ,@kpml::all_languages) :stream stream
		     #-lispworks4.0 :view #-lispworks4.0 'clim:list-pane-view
		     :prompt "Lexicon for resource set ....."
		     :default lexicon-lg))
      (loading-status-message lexicon-lg :monolingual stream)
      #+lispworks (kpml-i::dialog-end-spacing))
    (load-individual-lexicons lexicon-lg)))

(defun LOAD-CONTRASTIVE-LEXICON-OPTION
    (&optional
     (stream (clim::frame-top-level-sheet clim:*application-frame*)))
  (let ((languages (if *languages-in-focus* 
		       *languages-in-focus*
		     all_languages))
	(*clearing-flag* nil))
    (kpml-i::positioned-accepting-values
	(stream :own-window kpml-i::*own-window*
                :x-position (first kpml-i::*confirmation-popups-xy*)
                :y-position (second kpml-i::*confirmation-popups-xy*)
		:scroll-bars :horizontal
		:resynchronize-every-pass t
		:label "Loading subops (lexicons; contrastive)" :exit-boxes 
		'((:exit "Click here to start loading")
		  (:abort "Click here to cancel")))
     
     (setf common-lisp-user::*root-of-resources*
	   (clim:accept 'clim:pathname :stream stream
                        #+lispworks :view #+lispworks clim:+textual-dialog-view+
			:prompt "Root of resources         ............"
			:default common-lisp-user::*root-of-resources*))
     (kpml-i-terpri stream)
     (setf languages
	   #-(and acl3.0 aclpc)
	   (clim:accept `(clim:subset-sequence ,kpml::all_languages) 
			:stream stream
			#-lispworks4.0 :view #-lispworks4.0 'clim:list-pane-view
			:prompt "Languages to be loaded     ............"
			:default languages)
	   #+(and acl3.0 aclpc)
	   (kpml::get-a-subset-from 
	    kpml::all_languages
	    languages
	    "Languages to be loaded     ............")
	    )
     (loading-status-message languages :contrastive stream)
     #+lispworks (kpml-i::dialog-end-spacing))
    (load-individual-lexicons languages)))
	
(defun LOAD-MULTILINGUAL-LEXICON-OPTION
    (&optional
     (stream (clim::frame-top-level-sheet clim:*application-frame*)))
  (let ((variety-name (kpml-i::language-variety-menu-choice))
	(*clearing-flag* nil))
    (when variety-name
      (kpml-i::positioned-accepting-values
	  (stream :own-window kpml-i::*own-window*
                :x-position (first kpml-i::*confirmation-popups-xy*)
                :y-position (second kpml-i::*confirmation-popups-xy*)                  
                :scroll-bars :horizontal
                :resynchronize-every-pass t
                :label "Loading subops (lexicons; multi)" :exit-boxes 
                '((:exit "Click here to start loading")
                  (:abort "Click here to cancel")))
	(loading-status-message variety-name :multilingual stream)
        #+lispworks (kpml-i::dialog-end-spacing))
      (load-individual-lexicons variety-name))))

;;; Individual lexicon saving options...
;;; (modelled on general resource saving function)



(defun INTERFACE-LEXICON-SAVING
  (&optional
   (stream (clim::frame-top-level-sheet clim:*application-frame*)))
  (let ((resources-directory common-lisp-user::*root-of-resources*)
	(languages (if *languages-in-focus*
		       *languages-in-focus*
		     (list curlan)))
	)
    (kpml-i::positioned-accepting-values
     (stream :own-window kpml-i::*own-window*
	     :scroll-bars :horizontal
             :x-position (first kpml-i::*confirmation-popups-xy*)
             :y-position (second kpml-i::*confirmation-popups-xy*)
	     :resynchronize-every-pass t
	     :label "Lexicon saving" :exit-boxes 
	     '((:exit "Click to start saving")(:abort "Click here to cancel")))
     
     (setf resources-directory
	   (clim:accept 'clim:pathname :stream stream
                        #+lispworks :view #+lispworks clim:+textual-dialog-view+
			:prompt "Resources directory      ............"
			:default resources-directory))
     (kpml-i-terpri stream)
     (cond ((or (eq *ml-saving-mode* :contrastive)
		(eq *ml-saving-mode* :multilingual))
	    (setf languages
		  #-(and acl3.0 aclpc)
		  (clim:accept 
		   `(clim:subset-sequence ,kpml::all_languages)
		   :stream stream
		   #-lispworks4.0 :view #-lispworks4.0 'clim:list-pane-view
		   :prompt "For languages            ............"
		   :default languages)
		  #+(and acl3.0 aclpc)
		  (kpml::get-a-subset-from 
		   kpml::all_languages
		   languages
		   "For languages     ............")
		  ))
	   (t
	    (setf languages 
	      (list
	       (clim:accept `(member ,@kpml::all_languages) :stream stream
			    :view #+lispworks 'clim:radio-box-view
			          #-lispworks 'clim:list-pane-view
			    :prompt "For language             ............"
			    :default (first languages))))))
     (kpml-i-terpri stream)
     (setf *resource-directory-versioning*
       (clim:accept '(member T nil) :stream stream
			    :view #+lispworks 'clim:radio-box-view
			          #-lispworks 'clim:list-pane-view
			    :prompt "Create new resource directory  ......"
			    :default *resource-directory-versioning*))
     (kpml-i-terpri stream)
     #+ignore ;; 2.0.59 lexemes aren't versioned in 2.0
     (when (member :resource-patches *loading-saving-profile*)
       (patch-only-message stream)))
    
    (let ((*languages-in-focus* languages)
	  (*loading-saving-profile* 
	   #+ignore ;; 2.0.59 lexemes aren't versioned in 2.0
	   (if (member :resource-patches *loading-saving-profile*)
	       '(:lexemes :resource-patches)
	     '(:lexemes))
	   '(:lexemes)
	   ))
      (case *ml-saving-mode*
	(:monolingual (save-linguistic-resources 
		       (first languages)
		       :root-directory resources-directory))
	(:contrastive (save-linguistic-resources
		       languages
		       :root-directory resources-directory))
	(:multilingual (save-linguistic-resources 
			(make-ml-resource-name *languages-in-focus*)
			:root-directory resources-directory))))))

;;; 2.0 a further variant for newly acquired lexical items only. Must
;;;     still select a language for them...

(defun INTERFACE-NEW-LEXEMES-SAVING
  (&optional
   (stream (clim::frame-top-level-sheet clim:*application-frame*)))
  (let ((resources-directory common-lisp-user::*root-of-resources*)
	(language (kpml-i::language-variety-menu-choice))
	(message-stream
	 (clim:get-frame-pane 
	  kpml-i::*resource-development-frame* 'kpml-i::inspector)))
    (kpml::make-new-lexical-items-file 
     (coerce-directory
      (merge-pathnames 
       (string-upcase (string language)) resources-directory)))
    (format message-stream "~%Newly acquired lexical items written.")))
     





;;; ----------------------------------------------------------------------
;;; Individual example set loading...
;;; (just the above functions with a global replace of lexicon for 
;;;  example)

(defun LOAD-EXAMPLES-FROM-INTERFACE 
    (&optional
     (stream (clim::frame-top-level-sheet clim:*application-frame*)))
  (case *ml-loading-mode*
    (:monolingual 
     (load-monolingual-example-option stream))
    (:contrastive
     (load-contrastive-example-option stream))
    (:multilingual
     (load-multilingual-example-option stream))))

(defun LOAD-MONOLINGUAL-EXAMPLE-OPTION
    (&optional
     (stream (clim::frame-top-level-sheet clim:*application-frame*)))
  (let ((example-lg curlan)
	(*clearing-flag* nil))
    (kpml-i::positioned-accepting-values
	(stream :own-window kpml-i::*own-window*
		:resynchronize-every-pass t
                :x-position (first kpml-i::*confirmation-popups-xy*)
                :y-position (second kpml-i::*confirmation-popups-xy*)
		:label "Loading subops (examples; mono)" 
		:exit-boxes 
		'((:exit "Click to start loading")
		  (:abort "Click here to cancel")))
      (kpml-i-terpri stream)
      (setf example-lg
	(clim:accept `(member ,@kpml::all_languages) :stream stream
		     #-lispworks4.0 :view #-lispworks4.0 'clim:list-pane-view
		     :prompt "Example for resource set ....."
		     :default example-lg))
      (loading-status-message example-lg :monolingual stream)
      #+lispworks (kpml-i::dialog-end-spacing))
    (load-individual-examples example-lg)))

(defun LOAD-CONTRASTIVE-EXAMPLE-OPTION
    (&optional
     (stream (clim::frame-top-level-sheet clim:*application-frame*)))
  (let ((languages (if *languages-in-focus* 
		       *languages-in-focus*
		     all_languages))
	(*clearing-flag* nil))
    (kpml-i::positioned-accepting-values
	(stream :own-window kpml-i::*own-window*
		:scroll-bars :horizontal
                :x-position (first kpml-i::*confirmation-popups-xy*)
                :y-position (second kpml-i::*confirmation-popups-xy*)
		:resynchronize-every-pass t
		:label "Loading subops (examples; contrastive)" :exit-boxes 
		'((:exit "Click here to start loading")
		  (:abort "Click here to cancel")))
     
     (setf common-lisp-user::*root-of-resources*
       (clim:accept 
	'clim:pathname :stream stream
	#+lispworks :view #+lispworks clim:+textual-dialog-view+
	:prompt "Root of resources         ............"
	:default common-lisp-user::*root-of-resources*))
     (kpml-i-terpri stream)
     (setf languages
	   #-(and acl3.0 aclpc)
	   (clim:accept `(clim:subset-sequence ,kpml::all_languages) 
			:stream stream
			#-lispworks4.0 :view #-lispworks4.0 'clim:list-pane-view
			:prompt "Languages to be loaded     ............"
			:default languages)
	   #+(and acl3.0 aclpc)
	   (kpml::get-a-subset-from
	    kpml::all_languages
	    languages
	    "Languages to be loaded..."))
     (loading-status-message languages :contrastive stream)
     #+lispworks (kpml-i::dialog-end-spacing))
    (load-individual-examples languages)))
	
(defun LOAD-MULTILINGUAL-EXAMPLE-OPTION
    (&optional
     (stream (clim::frame-top-level-sheet clim:*application-frame*)))
  (let ((variety-name (kpml-i::language-variety-menu-choice))
	(*clearing-flag* nil))
    (when variety-name
      (kpml-i::positioned-accepting-values
	  (stream :own-window kpml-i::*own-window*
		  :scroll-bars :horizontal
                  :x-position (first kpml-i::*confirmation-popups-xy*)
                  :y-position (second kpml-i::*confirmation-popups-xy*)
		  :resynchronize-every-pass t
		  :label "Loading subops (examples; multi)" :exit-boxes 
		  '((:exit "Click here to start loading")
		    (:abort "Click here to cancel")))
	(loading-status-message variety-name :multilingual stream)
        #+lispworks (kpml-i::dialog-end-spacing))
      (load-individual-examples variety-name ))))


;;; ----------------------------------------------------------------------
;;; Individual example saving options...
;;; (modelled on general resource saving function)

;;; 2.0.59
;;; Following fn happily set the resource versioning to be on, even though
;;; this means that no examples are ever saved (because the appropriate
;;; function that is called in kpml-resource-maintenance, 
;;; SAVE-RESOURCE-PATCHES-TO-DIRECTORY, only bothers to look at
;;; systems, choosers and inquiries. If none of these are called for,
;;; which they aren't given the following function, then nothing
;;; happens. The following commented out component can be put back
;;; if SAVE-RESOURCE-PATCHES-TO-DIRECTORY is extended to look at
;;; examples (and presumably, lexemes), but this can only happen when
;;; examples (and presumably, lexemes) have been made versionable.
;;; At present they are *not*. 
;;; ----------------------------------------------------------------------

(defun INTERFACE-EXAMPLE-SAVING
  (&optional
   (stream (clim::frame-top-level-sheet clim:*application-frame*)))
  (let ((resources-directory common-lisp-user::*root-of-resources*)
	(languages (if *languages-in-focus*
		       *languages-in-focus*
		     (list curlan)))
	)
    (kpml-i::positioned-accepting-values
     (stream :own-window kpml-i::*own-window*
	     :scroll-bars :horizontal
	     :resynchronize-every-pass t
             :x-position (first kpml-i::*confirmation-popups-xy*)
             :y-position (second kpml-i::*confirmation-popups-xy*)
	     :label "Example saving" :exit-boxes 
	     '((:exit "Click to start saving")(:abort "Click here to cancel")))
     
     (setf resources-directory
	   (clim:accept 'clim:pathname :stream stream
                        #+lispworks :view #+lispworks clim:+textual-dialog-view+
			:prompt "Resources directory      ............"
			:default resources-directory))
     (kpml-i-terpri stream)
     (cond ((or (eq *ml-saving-mode* :contrastive)
		(eq *ml-saving-mode* :multilingual))
	    (setf languages
              #-(and acl3.0 aclpc)
	      (clim:accept 
	       `(clim:subset-sequence ,kpml::all_languages)
	       :stream stream
	       #-lispworks4.0 :view #-lispworks4.0 'clim:list-pane-view
	       :prompt "For languages            ............"
	       :default languages)
	      #+(and acl3.0 aclpc)
	      (kpml::get-a-subset-from 
	       kpml::all_languages
	       languages
	       "For languages ...")))
	   (t
	    (setf languages 
	      (list
	       (clim:accept `(member ,@kpml::all_languages) :stream stream
			    :view #+lispworks 'clim:radio-box-view
			          #-lispworks 'clim:list-pane-view
			    :prompt "For language             ............"
			    :default (first languages))))))
     (kpml-i-terpri stream)
     (setf *resource-directory-versioning*
       (clim:accept '(member T nil) :stream stream
		    :view #+lispworks 'clim:radio-box-view
		          #-lispworks 'clim:list-pane-view
		    :prompt "Create new resource directory  ......"
		    :default *resource-directory-versioning*))
     (kpml-i-terpri stream)
     (setf *full-example-structures-saved*
       (clim:accept '(member T nil) :stream stream
		    :view #+lispworks 'clim:radio-box-view
			          #-lispworks 'clim:list-pane-view
		    :prompt "Save generated structures ..........."
		    :default *full-example-structures-saved*))
     
     #+ignore ;; 2.0.59 examples aren't versioned in 2.0
     (when (member :resource-patches *loading-saving-profile*)
       (patch-only-message stream)))
    
    (let ((*languages-in-focus* languages)
	  (*shadowed-slots* 
	   (if *full-example-structures-saved*
               (set-difference *shadowed-slots* *spl-slot-shadowing-for-html-reports*)
             (remove-duplicates
              (append *shadowed-slots* *spl-slot-shadowing-for-html-reports*))))
	  (*loading-saving-profile* 
	   #+ignore ;; 2.0.59 examples aren't versioned in 2.0
	   (if (member :resource-patches *loading-saving-profile*)
	       '(:examples :resource-patches)
	     '(:examples))
	   ;; 2.0.59 
	   '(:examples)
	   ))
      (declare (special *shadowed-slots*))
      (protocol-edit ";;; Some examples written out.")
      (case *ml-saving-mode*
	(:monolingual (save-linguistic-resources 
		       (first languages)
		       :root-directory resources-directory))
	(:contrastive (save-linguistic-resources
		       languages
		       :root-directory resources-directory))
	(:multilingual (save-linguistic-resources 
			(make-ml-resource-name *languages-in-focus*)
			:root-directory resources-directory)))))) 

;;;----------------------------------------------------------------------
;;; 1.0: old 0.8.22 separated out into a function of its own and
;;;      expanded to cover lexicons as well as examples...
;;;      Note can only be called from new-style interface...


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

(defun LOAD-INDIVIDUAL-LEXICONS 
    (variety-designations
     &optional 
     &key
     (root-directory common-lisp-user::*root-of-resources*))
  (dolist (lg (if (consp variety-designations)
		  variety-designations
		(list variety-designations)))
    (dolist (file 
		(kpml-i::files-from-directory-menu-choice 
		 (coerce-directory
		  (merge-pathnames
		   "Lexicons"
		   (coerce-directory
		    (merge-pathnames 
		     (string lg) 
		     root-directory))))
		 "lexicon"))
      (when file 
	(kpml-load file)
	;; 2.0.55
	(setf *last-loaded-lexicon-file* file)))))

(defun LOAD-INDIVIDUAL-EXAMPLES
    (variety-designations
     &optional 
     &key
     (root-directory common-lisp-user::*root-of-resources*))
  (dolist (lg (if (consp variety-designations)
		  variety-designations
		(list variety-designations)))
    (dolist (file 
		(kpml-i::files-from-directory-menu-choice 
		 (coerce-directory
		  (merge-pathnames
		   "Examples"
		   (coerce-directory
		    (merge-pathnames 
		     (string lg) 
		     root-directory))))
		 "spl"))
      (when file 
	(kpml-load file)
	;; 2.0.55
	(setf *last-loaded-example-file* file))
      )))


;;;===================================================================

(defun RESOURCE-MAINTENANCE-OPTIONS () 
  (let ((message-stream 
         (clim:get-frame-pane kpml-i::*resource-manager-frame* 
                              'kpml-i::inspector))
	(stream  (clim::frame-top-level-sheet clim:*application-frame*))
	(generate-an-example NIL))
    (block asking
	   (loop
	    (case
	     (kpml-i::menu-choose 
	      '(|Reset network for current language|
		|Reset all|
		|Grammar consistency checks|
		|Operations on Examples|
		|Set current language|
		|Done| )
	      :associated-window 
	      (clim:frame-top-level-sheet kpml-i::*resource-manager-frame*)
	      :label "Resource Maintenance and Testing")
	     (|Operations on Examples|
	      (setf generate-an-example (example-operations))
	      (when generate-an-example (return-from asking T)))
	     (|Grammar consistency checks|
	      (kpml::perform-static-consistency-checks
	       :to-file "TESTING-CONSISTENCY-CHECKS"
	       :lg-restricted t))
	     (|Set current language|
	      (let ((desired-lg (kpml-i::menu-choose 
				 kpml::all_languages
				 :associated-window 
				 (clim:frame-top-level-sheet kpml-i::*resource-manager-frame*)
				 :label "Select a language")))
		(when desired-lg
		      (kpml-i-terpri stream)
		      (switch-language 
		       :language desired-lg 
		       :load-patches *patch-loading-on-language-switching*))
		))
	     (|Done| 
	      (return-from resource-maintenance-options nil))
	     (|Reset network for current language|
	      (reset-system-network t))
	     (|Reset all|
	      (format message-stream "~%Setting up connectivity for the system network")
	      (reset-system-network))
	     
	     )))
    
    (when generate-an-example
	  #+mcl(setf kpml-i::*say-process*
		     (clim:run-say-top-level))
	  #+(or allegro lucid)(setf kpml-i::*say-process*
				(cpc:make-process #'kpml-i::run-say-top-level
						  :name "say"))
	  )))

  
;;;================================================================================
  

(defun CREATE-GRAMMAR-RESOURCE-OPTION
  (&optional
   (stream (clim::frame-top-level-sheet clim:*application-frame*)))
  (let ((resources-directory common-lisp-user::*root-of-resources*)
	(languages (if *languages-in-focus*
		       *languages-in-focus*
		     (list curlan)))
	)
    (kpml-i::positioned-accepting-values
     (stream :own-window kpml-i::*own-window*
	     :scroll-bars :horizontal
             :x-position (first kpml-i::*confirmation-popups-xy*)
             :y-position (second kpml-i::*confirmation-popups-xy*)
	     :resynchronize-every-pass t
	     :label "Resource saving" :exit-boxes 
	     '((:exit "Click to start")(:abort "Click here to cancel")))
     
     (setf resources-directory
	   (clim:accept 'clim:pathname :stream stream
                        #+lispworks :view #+lispworks clim:+textual-dialog-view+
			:prompt "Resources directory      ............"
			:default resources-directory))
     (kpml-i-terpri stream)
     (cond ((or (eq *ml-saving-mode* :contrastive)
		(eq *ml-saving-mode* :multilingual))
	    (setf languages
              #-(and acl3.0 aclpc)
	      (clim:accept 
	       `(clim:subset-sequence ,kpml::all_languages)
	       :stream stream
	       #-lispworks4.0 :view #-lispworks4.0 'clim:list-pane-view
	       :prompt "For languages            ............"
	       :default languages)
	      #+(and acl3.0 aclpc)
	      (kpml::get-a-subset-from kpml::all_languages languages
				       "For languages ...")))
	   (t
	    (setf languages 
	      (list
	       (clim:accept `(member ,@kpml::all_languages) :stream stream
			    :view #+lispworks 'clim:radio-box-view
			          #-lispworks 'clim:list-pane-view
			    :prompt "For language             ............"
			    :default (first languages))))))
     (kpml-i-terpri stream)
     (setf *resource-directory-versioning*
       (clim:accept '(member T nil) :stream stream
			    :view #+lispworks 'clim:radio-box-view
			          #-lispworks 'clim:list-pane-view
			    :prompt "Create new resource directory  ......"
			    :default *resource-directory-versioning*))
     (kpml-i-terpri stream)
     (when (member :resource-patches *loading-saving-profile*)
       (patch-only-message stream)))
    
    (let ((*standard-output* 
	   (clim:get-frame-pane 
	    kpml-i::*resource-manager-frame* 'kpml-i::inspector))
	  (*query-io*  
	   (clim:get-frame-pane 
	    kpml-i::*resource-manager-frame* 'kpml-i::inspector))
	  (*languages-in-focus* languages))
      ;; 1.1
      (protocol-edit ";;; New language created.")
      ;; 0.8.25+1.0
      (case *ml-saving-mode*
	(:monolingual (save-linguistic-resources 
		       (first languages)
		       :root-directory resources-directory))
	(:contrastive (save-linguistic-resources
		       languages
		       :root-directory resources-directory))
	(:multilingual (save-linguistic-resources 
			(make-ml-resource-name *languages-in-focus*)
			:root-directory resources-directory))))))
  
(defun PATCH-ONLY-MESSAGE (stream)
       (kpml-i-terpri stream)
       (kpml-i-terpri stream)
       (format stream "~20T")
       (clim:surrounding-output-with-border
	  (stream :shape :rectangle)
	 (clim:with-text-style  
	     (stream kpml-i::*fix--bold-italic--12*)
	   (format stream "N.B.: PATCHES ONLY!")))
       (kpml-i-terpri stream))

(defun MAKE-ML-RESOURCE-NAME (lg-set)
  (concatenate 'string
    *default-ml-resource-set-prefix*
    (reduce #'(lambda (lg1 rest) 
		(concatenate 'string "-" (subseq (string lg1) 0 2) rest))
	    (sort lg-set #'string<)
	    :initial-value ""
	    :from-end T)))



;;; ----------------------------------------------------------------------
  
(defun CREATE-NEW-LANGUAGE-RESOURCE-OPTION 
  (&optional
   (stream (clim::frame-top-level-sheet clim:*application-frame*)))
  (let ((resource-directory common-lisp-user::*root-of-resources*)
	(language curlan)
	(inheriting-from curlan)
	(old-curlan curlan))
    
    (kpml-i::positioned-accepting-values
     (stream :own-window kpml-i::*own-window*
	     :resynchronize-every-pass t
             :x-position (first kpml-i::*confirmation-popups-xy*)
             :y-position (second kpml-i::*confirmation-popups-xy*)
	     :label "New Language Resource Creation" :exit-boxes 
	     '((:exit "Click here to start")(:abort "Click here to cancel")))
     
     (setf resource-directory
	   (clim:accept 'clim:pathname :stream stream
                        #+lispworks :view #+lispworks clim:+textual-dialog-view+
			:prompt "Resource directory           ............"
			:default resource-directory))
     (kpml-i-terpri stream)
     (setf language
	   (clim:accept 'symbol :stream stream
                        #+lispworks :view #+lispworks clim:+textual-dialog-view+
			:prompt "For language                 ............"
			:default language))
     (kpml-i-terpri stream)
     (setq inheriting-from
	   (clim:accept `(member ,@kpml::all_languages) :stream stream
			:view #+lispworks 'clim:radio-box-view
			          #-lispworks 'clim:list-pane-view
			:prompt "Inheriting from language     ............"
			:default inheriting-from))
     (kpml-i-terpri stream)
     (setf *resource-directory-versioning*
	   (clim:accept '(member T nil) :stream stream
			:view #+lispworks 'clim:radio-box-view
			          #-lispworks 'clim:list-pane-view
			:prompt "Create new resource directory  ......"
			:default *resource-directory-versioning*))
     (kpml-i-terpri stream))
    (save-linguistic-resources                ;; 0.8.5
     (intern (string language) "KEYWORD")
     :root-directory resource-directory
     :inheriting-from inheriting-from)
    (setf curlan old-curlan)))

  
;;; Note: under Windows95 the dismiss button is bound to the normal
;;;       :exit event, not the :abort event. So dismissing the dialog
;;;       is the same as saying do-it.

(defun LOAD-MONOLINGUAL-RESOURCE-OPTION
  (&optional
   (stream (clim::frame-top-level-sheet clim:*application-frame*)))
  (let ((language curlan))
    
    (kpml-i::positioned-accepting-values
     (stream :own-window kpml-i::*own-window*
	     :resynchronize-every-pass t
             :x-position (first kpml-i::*confirmation-popups-xy*)
             :y-position (second kpml-i::*confirmation-popups-xy*)
	     :label "Loading  Resource" :exit-boxes 
	     '((:exit "Click here to start")(:abort "Click here to cancel")))
     
     (setf common-lisp-user::*root-of-resources*
	   (clim:accept 'clim:pathname
                        #+lispworks :view #+lispworks clim:+textual-dialog-view+
                        :stream stream
			:prompt "Root of resources         ............"
			:default  (pathname common-lisp-user::*root-of-resources*)))
     (kpml-i-terpri stream)
     
     (setf language
	   (clim:accept `(member ,@kpml::all_languages) :stream stream
			#-lispworks4.0 :view #-lispworks4.0 'clim:list-pane-view
			:prompt "Language to be loaded     ............"
			:default language))
     (loading-status-message language :monolingual stream)
     #+lispworks (kpml-i::dialog-end-spacing)
     )
    (format *trace-output* "~%;;; KPML: New language resource to be loaded...")
    (format *trace-output* "~%;;; ...language variety: ~A" language)
    (format *trace-output* "~%;;; ...merging mode: ~A" *merging-active*)
    (format *trace-output* "~%;;; ...monolingual loading.~%")
    (let ((*standard-output* (clim:get-frame-pane kpml-i::*resource-manager-frame* 'kpml-i::inspector))
	  (*query-io*        (clim:get-frame-pane kpml-i::*resource-manager-frame* 'kpml-i::inspector)))
      (format t "~2% Loading resources for: ~A~2%" language)
      (load-linguistic-resources language :merge *merging-active* :clear *clearing-flag*))))


(defun LOADING-STATUS-MESSAGE (languages mode stream)
  (kpml-i-terpri stream)
  (kpml-i-terpri stream)
  (format stream "~20T")
  (clim:surrounding-output-with-border
      (stream :shape :rectangle)
    (clim:with-text-style  
	(stream kpml-i::*fix--bold-italic--12*)
      (case mode
	(:monolingual 
	 (format stream "~% Monolingual mode; language variety: ~A" languages))
	(:contrastive
	 (format stream "~% Contrastive mode; language varieties: 
    ~{ ~A~}" 
		 languages))
	(:multilingual
	 (format stream "~% Multilingual mode; resource set: ~A" 
		 languages)))
      (if *merging-active*
	  (format stream "~% Merging mode is on.")
	(format stream "~% Merging mode is off."))
      (if *clearing-flag*
	  (format stream "~% Resources will be cleared before loading.")
	(format stream "~% Resources will not be cleared before loading."))))
  (kpml-i-terpri stream))

  
(defun LOAD-CONTRASTIVE-RESOURCE-OPTION
  (&optional
   (stream  (clim::frame-top-level-sheet clim:*application-frame*)))
  (let ((languages (if *languages-in-focus* 
		       *languages-in-focus*
		     all_languages)))
    
    (kpml-i::positioned-accepting-values
     (stream :own-window kpml-i::*own-window*
	     :scroll-bars :horizontal
             :x-position (first kpml-i::*confirmation-popups-xy*)
             :y-position (second kpml-i::*confirmation-popups-xy*)
	     :resynchronize-every-pass t
	     :label "Loading  Resources" :exit-boxes 
	     '((:exit "Click here to start")(:abort "Click here to cancel")))
     
     (setf common-lisp-user::*root-of-resources*
	   (clim:accept 'clim:pathname :stream stream
                        #+lispworks :view #+lispworks clim:+textual-dialog-view+
			:prompt "Root of resources         ............"
			:default common-lisp-user::*root-of-resources*))
     (kpml-i-terpri stream)
     
     (setf languages
       #-(and acl3.0 aclpc)
       (clim:accept `(clim:subset-sequence ,kpml::all_languages) 
		    :stream stream
		    #-lispworks4.0 :view #-lispworks4.0 'clim:list-pane-view
		    :prompt "Languages to be loaded     ............"
		    :default languages)
       #+(and acl3.0 aclpc)
       (kpml::get-a-subset-from kpml::all_languages languages
				"Languages to be loaded ..."))
     (loading-status-message languages :contrastive stream)
     #+lispworks (kpml-i::dialog-end-spacing))
    
    (format *trace-output* "~%;;; KPML: New language resources to be loaded...")
    (format *trace-output* "~%;;; ...language varieties: ~A" languages)
    (format *trace-output* "~%;;; ...contrastive loading.~%")
    (let ((*standard-output* (clim:get-frame-pane kpml-i::*resource-manager-frame* 'kpml-i::inspector))
	  (*query-io*        (clim:get-frame-pane kpml-i::*resource-manager-frame* 'kpml-i::inspector)))
      (load-linguistic-resources languages :merge t))))

  
(defun LOAD-MULTILINGUAL-RESOURCE-OPTION
  (&optional
     (stream (clim::frame-top-level-sheet clim:*application-frame*)))
    (let ((variety-name (kpml-i::language-variety-menu-choice)))
      (when variety-name
	(kpml-i::positioned-accepting-values
	    (stream :own-window kpml-i::*own-window*
                    :x-position (first kpml-i::*confirmation-popups-xy*)
                    :y-position (second kpml-i::*confirmation-popups-xy*)
		    :scroll-bars :horizontal
		    :resynchronize-every-pass t
		    :label "Loading  Resources" :exit-boxes 
		    '((:exit "Click here to start")
		      (:abort "Click here to cancel")))
	  (loading-status-message variety-name :multilingual stream)
          #+lispworks (kpml-i::dialog-end-spacing))
	(format *trace-output* 
		"~%;;; KPML: New language resource to be loaded...")
	(format *trace-output* 
		"~%;;; ...language variety set: ~A" variety-name)
	(format *trace-output* 
		"~%;;; ...merging mode is set at: ~A" *merging-active*)
	(format *trace-output*
		"~%;;; ...clearing flag is set at: ~A" *clearing-flag*)
	(format *trace-output* 
		"~%;;; ...multilingual loading....~%")
	(let ((*standard-output* 
	       (clim:get-frame-pane kpml-i::*resource-manager-frame* 
				    'kpml-i::inspector))
	      (*query-io*  (clim:get-frame-pane 
			    kpml-i::*resource-manager-frame* 
			    'kpml-i::inspector)))
	  (format t "~2% Loading resources for resource set: ~A~2%" 
		  variety-name)
;;; 0.8.27: merging was hardwired on.
	  (load-linguistic-resources 
	   variety-name :merge *merging-active*)
	  ))))
  
  
;;;----------------------------------------------------------------------
  
(defun ML-FOCUSING-OPERATIONS ()
  (let ((stream (clim::frame-top-level-sheet clim:*application-frame*)))
      (loop
       (case
	(#-lispworks kpml-i::menu-choose 
         #+lispworks kpml-i::no-messing-menu-choice  ;; (don't ask...) 
	 '(|Focus on selected regions|
	   |Release region focus|
	   |Clear region focus and set|
	   |Focus on selected languages|
	   |Release language focus|
	   |Focus on selected linguistic objects|
	   |Release linguistic object focus|
	   |DONE|) 
	 :associated-window 
	 (clim:frame-top-level-sheet kpml-i::*resource-manager-frame*)
	 :label "Resource Focusing Operations"
	 :scroll-bars :horizontal)
	(|DONE|
	 (return-from ml-focusing-operations nil))
	(|Focus on selected regions|
	 (let ((region-list (get-regions)))
	   (kpml-i::positioned-accepting-values
	    (stream :own-window kpml-i::*own-window*
		    :resynchronize-every-pass T
                    :x-position (first kpml-i::*confirmation-popups-xy*)
                    :y-position (second kpml-i::*confirmation-popups-xy*)
		    :label "Multilingual focusing modes (regions)" :exit-boxes 
		    '((:exit "Click here when selection made")
		      (:abort "Click here to cancel")))
	    
	    (kpml-i-terpri stream)
	    (setf *regions-in-focus*
	      #-(and acl3.0 aclpc)
	      (clim:accept `(clim:subset-sequence ,region-list)
			   #-lispworks4.0 :view #-lispworks4.0 'clim:list-pane-view
			   :stream stream
			   :prompt "Focus on some set of regions....."
			   :default (if *regions-in-focus*
					*regions-in-focus*
				      region-list))
	      #+(and acl3.0 aclpc)
	      (kpml::get-a-subset-from region-list
				       (if *regions-in-focus*
					   *regions-in-focus*
					 region-list)
				       "Focus on some set of regions.....")
	      ))))
	(|Release region focus|
	 (setf *regions-in-focus* nil))
	(|Clear region focus and set|
	 (let ((region-list (get-regions)))
	   (setf *regions-in-focus* nil)
	   (kpml-i::positioned-accepting-values
	    (stream :own-window kpml-i::*own-window*
                    :x-position (first kpml-i::*confirmation-popups-xy*)
                    :y-position (second kpml-i::*confirmation-popups-xy*)
		    :resynchronize-every-pass T
		    :label "Multilingual focusing modes (regions)" :exit-boxes 
		    '((:exit "Click here when selection made")
		      (:abort "Click here to cancel")))
	    
	    (kpml-i-terpri stream)
	    (setf *regions-in-focus*
	      #-(and acl3.0 aclpc)
	      (clim:accept `(clim:subset-sequence ,region-list)
			   #-lispworks4.0 :view #-lispworks4.0 'clim:list-pane-view
			   :stream stream
			   :prompt "Focus on some set of regions....."
			   :default *regions-in-focus*)
	      #+(and acl3.0 aclpc)
	      (kpml::get-a-subset-from region-list 
				       *regions-in-focus*
				       "Focus on some set of regions.....")
	      ))))
	(|Focus on selected languages|
	 (kpml-i::positioned-accepting-values
	  (stream :own-window kpml-i::*own-window*
		  :resynchronize-every-pass T
                  :x-position (first kpml-i::*confirmation-popups-xy*)
                  :y-position (second kpml-i::*confirmation-popups-xy*)
		  :label "Multilingual focusing modes (languages)" :exit-boxes 
		  '((:exit "Click here when selection made")
		    (:abort "Click here to cancel")))
	  
	  (kpml-i-terpri stream)
	  (setf *languages-in-focus*
		#-(and acl3.0 aclpc)
		(clim:accept `(clim:subset-sequence ,all_languages)
			     #-lispworks4.0 :view #-lispworks4.0 'clim:list-pane-view
			     :stream stream
			     :prompt "Focus on some set of languages....."
			     :default *languages-in-focus*)
		#+(and acl3.0 aclpc)
		(kpml::get-a-subset-from 
		 kpml::all_languages
		 *languages-in-focus*
		 "Focus on some set of Languages....")
		)))
	(|Release language focus|
	 (setf *languages-in-focus* nil))
	(|Focus on selected linguistic objects|
	 (kpml-i::positioned-accepting-values
	  (stream :own-window kpml-i::*own-window*
                  :x-position (first kpml-i::*confirmation-popups-xy*)
                  :y-position (second kpml-i::*confirmation-popups-xy*)
		  :resynchronize-every-pass T
		  :label "Multilingual focusing modes (linguistic objects)" :exit-boxes 
		  '((:exit "Click here when selection made")
		    (:abort "Click here to cancel")))
	  
	  (kpml-i-terpri stream)
	  (setf *loading-saving-profile* 
		#+(and acl3.0 aclpc)
		(kpml::get-a-subset-from *full-loading-saving-options*
					 *loading-saving-profile*
					 "Focus on some of: ")
		#-(and acl3.0 aclpc)
		(clim:accept `(clim:subset-sequence 
			       ,*full-loading-saving-options*)
                             #-lispworks4.0 :view #-lispworks4.0 'clim:list-pane-view
			     :stream stream
			     :prompt "Focus on some of: "
			     :default *loading-saving-profile*)))
	 (when (member :resource-patches *loading-saving-profile*)
	   (setf *patch-status* T)))
	(|Release linguistic object focus|
	 (reset-loading-saving-profile))))))
  
  
;;; ----------------------------------------------------------------------
;;; Should turn the interface off during example running, since
;;; it can't be used then...
;;;  
;;; 2.0.61
;;; Pass down the stream to give notes of progress...
;;; ----------------------------------------------------------------------

(defun EXAMPLE-RUNNER-TO-FILE-ONLY 
  (example-list output-file-name 
   &key (say-p t)
	(message-stream *trace-output*) ;; 2.0.61
	)
  (let ((inspector 
	 (if (boundp 'kpml-i::*resource-manager-frame*) 
	     kpml-i::*resource-manager-frame* nil))
	   (state-of-window-interface-flag window-interface-flag))
    (setf kpml-i::*resource-manager-frame* nil)
    (setf window-interface-flag nil)
      
    (unwind-protect
	(block nil
	  (with-open-file 
	      (*standard-output*
	       (merge-pathnames (pathname (string output-file-name))
				(user-homedir-pathname))
	       :direction :output :if-exists :new-version)
	    (example-runner example-list 
			    :say-p say-p
			    :data-file-stream *standard-output*
			    :message-stream message-stream))))   ;; 2.0.61
    
    (setf kpml-i::*resource-manager-frame* inspector)
    (setf window-interface-flag state-of-window-interface-flag)))
  
  
;;; ----------------------------------------------------------------------
;;; In 1.0- the command Example Operations called a function
;;; example-operations that brought up a small menu of options.
;;; This functionality is now taken over by the full example
;;; operations menu defined in ../example-operations.lisp.  

#+ignore
(defun EXAMPLE-OPERATIONS ()
  (let ((stream (clim::frame-top-level-sheet clim:*application-frame*))
	(generate-an-example NIL))
    (block asking
	   (loop
	    (case
	     (kpml-i::menu-choose 
	      '(|Load examples| 
		|Write examples|
		|Clear examples|
		|Generate from example SPL|
		|Graph example structure|
		|Show examples with features|
		|Copy examples with new names|
		|Delete some examples|
		|Example runner| 
		|Features used in examples survey|
		|Done|)
	      :associated-window 
              (clim:frame-top-level-sheet kpml-i::*resource-manager-frame*)
	      :label "Operations on examples")
	     (|Done| 
	      (return-from asking nil))
	     (|Delete some examples|
	      (let ((examples-to-delete nil))
		(kpml-i::positioned-accepting-values
		    (stream :own-window kpml-i::*own-window*
                            :x-position (first kpml-i::*confirmation-popups-xy*)
                            :y-position (second kpml-i::*confirmation-popups-xy*)
			    :resynchronize-every-pass T
			    :label "Delete some examples" 
			    :exit-boxes 
			    '((:exit "Click here when selection made")
			      (:abort "Click here to cancel")))
	  	  (kpml-i-terpri stream)
		  (setf examples-to-delete
		    #-(and acl3.0 aclpc)
		    (clim:accept `(clim:subset-sequence 
				   ,(sort  (kpml-i::example-selector) 
					   #'string<))
				 #-lispworks4.0 :view #-lispworks4.0 'clim:list-pane-view
				 :stream stream
				 :prompt "Delete examples: "
				 :default examples-to-delete)
		    #+(and acl3.0 aclpc)
		    (kpml::get-a-subset-from 
		     (sort  (kpml-i::example-selector)  #'string<)
		     examples-to-delete
		     "Delete examples:")
		    ))
		(loop for x in examples-to-delete
		    do (kpml::delete-example x))))
	     (|Copy examples with new names|
;;; 0.9.45 was using the wrong stream for the wrong things...
	      (let ((examples-to-rename nil))
		(kpml-i::positioned-accepting-values
		    (stream :own-window kpml-i::*own-window*
                            :x-position (first kpml-i::*confirmation-popups-xy*)
                            :y-position (second kpml-i::*confirmation-popups-xy*)
			    :resynchronize-every-pass T
			    :label "Rename some examples" 
			    :exit-boxes 
			    '((:exit "Click here when selection made")
			      (:abort "Click here to cancel")))
	  	  (kpml-i-terpri stream)
		  (setf examples-to-rename
		    #-(and acl3.0 aclpc)
		    (clim:accept `(clim:subset-sequence 
				   ,(sort  (kpml-i::example-selector) 
					   #'string<))
				 #-lispworks4.0 :view #-lispworks4.0 'clim:list-pane-view
				 :stream stream
				 :prompt "Rename examples: "
				 :default examples-to-rename)
		    #+(and acl3.0 aclpc)
		    (kpml::get-a-subset-from 
		     (sort  (kpml-i::example-selector)  #'string<)
		     examples-to-rename
		     "Delete examples:")
		    ))
		(loop for x in examples-to-rename
		    do (kpml-i::example-renamer x))))
	      (|Generate from example SPL|
	       (setf generate-an-example T)
	       (return-from asking T))
	      (|Show examples with features|
	       (show-examples-with-features *collected-features*))
	      (|Example runner|
	       (example-runner-to-file-only
		(list-of-examples) 
		(namestring
		 (merge-pathnames
		  *example-runner-results*
		  (pathname (make-example-results-filename))))
		:say-p t))
	      (|Features used in examples survey|
;;; 0.9.45
	       (let ((*standard-output* *trace-output*)
		     (kpml::window-interface-flag nil))
		 (feature-survey)))
	      (|Graph example structure|
	       (kpml-i::graph-generated-structure-in-example-record))
	      (|Grammar consistency checks|
	       (kpml::perform-static-consistency-checks
		:to-file "TESTING-CONSISTENCY-CHECKS"
		:lg-restricted t))
	      (|Load examples|
	       (load-examples-from-interface stream))
	      (|Write examples|
	       (protocol-edit ";;; Examples written out.")
	       (interface-example-saving stream))
	      (|Clear examples|
	       (protocol-edit '(clear :examples))
	       (erase-examples)))))
    generate-an-example))


;;; ----------------------------------------------------------------------
;;; Following probably not used anymore...

(defun INTERFACE-LINGUISTIC-RESOURCES-LOADING
  (&optional
   (stream (clim::frame-top-level-sheet clim:*application-frame*)))
  (let ((resource-set curlan))
    (if (and (eq *ml-saving-mode* :contrastive)
	     *languages-in-focus*)
	(load-linguistic-resources *languages-in-focus*)
      (progn
	(kpml-i::positioned-accepting-values
	 (stream :own-window kpml-i::*own-window*
                 :x-position (first kpml-i::*confirmation-popups-xy*)
                 :y-position (second kpml-i::*confirmation-popups-xy*)
		 :resynchronize-every-pass t
		 :label "Multilingual saving subops (resources)" :exit-boxes 
		 '((:exit "Click to start loading")
		   (:abort "Click here to cancel")))
	 (kpml-i-terpri stream)
	 (setf resource-set
	       (clim:accept `(member ,@kpml::all_languages) :stream stream
			    :view #+lispworks 'clim:radio-box-view
			          #-lispworks 'clim:list-pane-view
			    :prompt "Lexicon for resource set ....."
			    :default resource-set)))
	(load-linguistic-resources resource-set)))))