(in-package "KPML")

;;; File: standard-default-declarations.lisp
;;; KPML-0.8
;;; June 1995, John Bateman.
;;; IPSI.
;;;

;;;----------------------------------------------------------------------
;;; Individual languages can declare what kind of start up
;;; SPL default environments they wish to use. 

;;; Code here is modelled exactly on ml-default-orderings.lisp. Could
;;; maybe be parameterized one fine day. 
;;;----------------------------------------------------------------------

(declaim (special *merging-during-language-switching*
		    curlan
		    *defined-default-environments*))


;;; Following allows languages to state a preference for whether
;;; morphology will be activated without doing it explicitly
;;; all the time...

(defvar *language-standard-defaults* '())

(defmacro DEFINE-LANGUAGE-STANDARD-DEFAULTS
  (&key (language nil)(defaults nil))
  (if (and language defaults)
      `(setf *language-standard-defaults*
	     (merge-in-spl-defaults-declaration 
	      (intern (string ',language) :keyword)
	      ',defaults
	      *language-standard-defaults*))
    (warning "Ill-formed standard defaults definition!")))


(defun MERGE-IN-SPL-DEFAULTS-DECLARATION (lg defaults profiles)
  (let ((modified-profiles nil)
	(consumed nil))
    (loop for lg-defaults in profiles
	  do
	  (cond ((eq (first lg-defaults) lg)
		 (push (list lg defaults) modified-profiles)
		 (warning "Standard defaults for language " lg 
			  " being updated.")
		 (setf consumed t))
		(t
		 (push lg-defaults modified-profiles))))
    (unless consumed (push (list lg defaults) modified-profiles))
    modified-profiles))


;;; ----------------------------------------------------------------------
;;; Following function is called when activation of the standard
;;; default environments is deemed necessary. Where we used to load an
;;; activation file (load-basic-defaults or some such), we now
;;; go to the standard defaults profile for the language specified
;;; and put the corresponding defaults in place directly. This
;;; builds on the SPL begin-default-env function for unpacking
;;; the inquiries used in an SPL default environment, but does
;;; not trigger stacking of environments. If there are no standard
;;; profiles, but there are old KPML 0.7 style activation files
;;; to be found, then these old ones are taken with a warning.

(defun ML-ACTIVATE-DEFAULTS (language)
  (let* ((lg-name (string language))
	 (lg-root-directory 
	  (pathname
	   (coerce-directory
	    (merge-pathnames common-lisp-user::*root-of-resources* lg-name))))
	 (kpml-0.7-load-basic-defaults
	  (merge-pathnames (pathname lg-root-directory)  
			   "load-basic-defaults.lisp"))
	 (kpml-0.7-load-basic-defaults? 
	  (open kpml-0.7-load-basic-defaults :direction :probe)))
    (cond ((assoc language *language-standard-defaults*)
	   (format *trace-output* 
		   "~%;;; Additionally activating SPL defaults for language: ~A" 
		   language)
	   (install-defaults 
	    language
	    (second (assoc language *language-standard-defaults*)))
	   (when kpml-0.7-load-basic-defaults?
		 (warning "Old-style load-basic-defaults file is also present: this is being ignored and should be removed.")))
	  (kpml-0.7-load-basic-defaults?
	   (warning "Only old-style load-basic-defaults file found. This is being loaded, but the resource set should be updated for 0.8")
	   (load kpml-0.7-load-basic-defaults)))))



(defun INSTALL-DEFAULTS (language environment-list)
  (let ((*merging-during-language-switching* T)
	(curlan language))
    (set-trivial-defaults)
    (dolist 
     (env-name environment-list)
     (let ((env-def (assoc env-name *defined-default-environments*)))
       (if env-def
	   (let ((features (default-env-features env-def)))
	     (dolist 
	      (feature features)
	      (let ((inq (find-symbol 
			  (string (first feature))
			  (find-package "KPML"))))
		(set-current-default-value
		 inq
		 (cdr feature)))))
	 (warning "Default environment " env-name " is not defined."))))))

;;; ----------------------------------------------------------------------
;;; 2.0
;;; Parameterize abbreviations that are used in graphical displays 
;;; Following codes are taken from ISO-3166 country codes (apart from
;;; the one for ENglish)...
(defvar *contrastive-labels* 
  '((:BULGARIAN . BG) 
    (:CHINESE . CN)
    (:CZECH . CZ)
    (:DANISH . DK)
    (:DUTCH . NL)
    (:ENGLISH . EN)
    (:FRENCH . FR)
    (:GERMAN . DE)
    (:GREEK . GR)
    (:FINNISH . FI)
    (:ITALIAN . IT)
    (:JAPANESE . JP)
    (:POLISH . PL)
    (:PORTUGUESE . PT)
    (:ROMANIAN . RO)
    (:RUSSIAN . RU)
    (:SPANISH . ES)))

(defmacro DEFINE-LANGUAGE-STANDARD-ABBREVIATION
  (&key (language nil)(abbreviation nil))
  ;; 2.0.27
  (if (and language abbreviation)
      `(pushnew (cons ',language ',abbreviation) *contrastive-labels*
		:test #'equal)
    (warning "Ill-formed standard abbreviation definition!")))

