(in-package "COMMON-LISP-USER")

;;; File: system-flag-defs.lisp

;;; Some flags can be set usefully by users, but this is done
;;; generally by setting them upstream of this file so that 
;;; the defvar's here have no effect. It is not foreseen that
;;; values be set directly by users in this file.

;;;--------------------------------------------------------------
;;;
;;; Function for configuring the KPML system during loading by
;;; setting a variety of configuration flags.
;;; From 0.9 these flags are all moved to the common-lisp-user
;;; package.
;;; 
;;; 2.0 certain older options are no longer supported: there is
;;;     only the new-style of interface (Penman-style no longer
;;;     supported: Chapter 8 in documentation of 1.0) with only
;;;     the extended development frames with menus on each window,
;;;     no option for running non-multilingually, morphology activation
;;;     is defined for each language variety separately, etc.
;;;
;;;     Older variants are no longer available and are not included in
;;;     the source code release.
;;;
;;; 2.1 adds an addition environment that allows chunks of compilation
;;;     etc. to be done without warnings across different Lisps...
;;;
;;; 3.0 adds a query concerning the server-client code: this is
;;;     currently only supported in any case for Allegro Common Lisp
;;;     and appears not to be automatically loaded in a vanilla
;;;     ACL5.0 installation. An explicit configuration question
;;;     brings this to the attention of the user so that appropriate
;;;     action can be taken.
;;;
;;; 4.0 dialog box added for configuration setting under LWW and Windows.
;;;     Conditionalized by existence of :capi on feature list.
;;;     Dec04: KR system loading made optional (default NIL to
;;;            make sure the user thinks about it).
;;;--------------------------------------------------------------

;;; the following variables set the configuration to be 
;;; loaded... Certain additional variables are also set
;;; as can be seen in the function definition...

(defvar *multilinguality-required?* T)
(defvar *load-linguistic-resources?* nil)
(defvar *window-interface-required?* nil)
(defvar *upper-model-required?* nil)
(defvar *inquiry-impls-required?* nil)
(defvar *non-incremental-compile?* nil)
(defvar *new-style-interface?* T)
(defvar *extended-development-frame* T)
(defvar *curlan* nil)
(defvar *acl-ipc-required?* nil)
(defvar *cl-xml-required?* nil)
(defvar *load-kr-system?* NIL)

;;; 4.0 following added so that it can be defvared before loading KPML
;;;     in no-questions mode, for example, when making images for
;;;     standalones, blackboxes, or servers. 
(defvar *gui-onboard?* T)

#+(and acl3.0 aclpc)
(eval-when 
 (:execute :compile :load-toplevel :compile-toplevel)
 (defvar *lg-dialog-1* nil)
 (defvar *lg-selected* nil))

;;; ----------------------------------------------------------------------
;;; These variables are set to harmless general values in case no
;;; one has decided to set them otherwise up to now...
;;; ----------------------------------------------------------------------

(defvar *kpml-initial-resources* :ml-baseline
  "Resource set to use when resource loading at load-time")
(defvar *kpml-general-resources* :general
  "Resource set to use when loading upper model or general inquiries")
(defvar *configuration-all-languages* nil
  "Initial language configuration")

#-kpml-level>=
(setf *features*
      (append 
       '(:kpml-level>= :kpml-l0 :kpml-l1 :kpml-l2 :kpml-l3 :kpml-unrestricted)
       *features*))

;;; ----------------------------------------------------------------------
;;; 3.0 check that basic functionality is in the Lisp image when
;;;     asked to configure in various ways...
;;; ----------------------------------------------------------------------

;;; ----------------------------------------------------------------------
;;; Compilation and loading configurations...
;;; 3.0 extensions in: Dec99
;;; ----------------------------------------------------------------------

(defvar *kpml-comp-configuration-mod*
  '("Welcome to KPML."
    "The following dialogue configures the functionality that is to be"
    "installed for KPML. The necessary files are then compiled. After"
    "compilation, you will be asked if you want to load these compiled"
    "files: this is necessary before you can work with KPML."
    ""
    "Some functionality requires that optional components are already"
    "present in your Lisp system. For example, the KPML graphical user"
    "interface requires that CLIM has been loaded. For some Lisps, you"
    "need to do this explicitly yourself, before starting KPML installation."
    ""
    "For Franz Allegro Common Lisp (5.0 and above), CLIM can be loaded (if"
    "you have bought it!) with the file code/climxm.fasl or code/climnt.fasl etc."
    "Similarly, IPC (for interprocess communication with Allegro sockets) can be"
    "loaded from the file code/ipc.fasl. Some other Lisps require the latest"
    "Lisp patches in order to function appropriately: for example, Harlequin"
    "Lispworks for the PC requires several patches in order to handle non-Latin"
    "fonts freely in CLIM: check with your supplier or with the KPML documentation"
    "for further information."
    ""
    "===================================================================="
    "     CONFIGURING KPML COMPILATION"
    "===================================================================="
    ))

(defun CONFIGURE-KPML-COMPILATION (&optional (questions T))
  (if questions 
	#+(and CAPI (not :dump-kpml))(configure-kpml-compilation-with-questions-capi)
	#-(and CAPI (not :dump-kpml))(configure-kpml-compilation-with-questions)
    (configure-kpml-compilation-no-questions)))

(defun CONFIGURE-KPML (&optional (questions T))
  (if questions 
	#+(and CAPI (not :dump-kpml))(configure-kpml-load-with-questions-capi)
	#-(and CAPI (not :dump-kpml))(configure-kpml-load-with-questions)
    (configure-kpml-load-no-questions)))

(defun CONFIGURE-KPML-COMPILATION-WITH-QUESTIONS ()
  (format t "~%")
  (loop for m in *kpml-comp-configuration-mod* do (format t "~%~A" m))
  (format t "~%")
  
  (setf *multilinguality-required?* T       ;; no option here anymore
	*window-interface-required?* 
	(y-or-n-p 
	 "Is the  window interface (requires CLIM) to be compiled?: ")
	)
  (when *window-interface-required?* (check-package-present "CLIM"))

  ;; For Lispworks, postscript only works for LWW4.1 or better...
  ;; KPML4: after LWW4.4+, different load method.
  ;; For Allegro under Windows, prefer ACL5 or better...
  #+lispworks
  (:version-case (":LISPWORKS") 
		 (("4.0" "4.1") 
		  (when *window-interface-required?*
		    (system::load-clim-postscript-module)))
		 ((+ "4.1")
		  (when *window-interface-required?*
		    (require "clim-postscript"))))
  
  #+(:and :allegro :mswindows (not :ALLEGRO-CL-TRIAL))
  (:version-case (":ALLEGRO-V")
		 ((+ "4.4")
		  (require :climps)))

  #+allegro 
  (:version-case (":ALLEGRO-V")
		 ((- "4.3.2")                               ;; prior to 4.3.1 ipc was
		  (setf *acl-ipc-required?* T))             ;; always present
		 ((+ "4.3.1")                               ;; in ACL5.0 it is no longer
		  (setf *acl-ipc-required?*
			(y-or-n-p 
			 "Is the Allegro socket server-client functionality to be used?: ")
			)))
  #+allegro (when *acl-ipc-required?* (check-package-present "IPC"))
  (setf *cl-xml-required?*
	(y-or-n-p 
	 "Are linguistic resources in XML form to be used for input?: "))
  (when *cl-xml-required?* (check-package-present "XMLS"))

  (setf *load-kr-system?*
	(y-or-n-p "Include the specified KR system?: "))

  (setf *non-incremental-compile?*
	(y-or-n-p "Compile everything from scratch?: "))

  (setf *new-style-interface?* *window-interface-required?*) ;; no option here either
  (setf *extended-development-frame* T)                      ;; or here...
  #+ignore(y-or-n-p "Use extended development frame (single window)?: ")
  ;;; above is no longer an option in KPML 2.0, the old style
  ;;; multiple windows are no longer supported.

  (format t "~%Configuration for compilation complete...~%====================================================================~2%"))


(defun CONFIGURE-KPML-COMPILATION-NO-QUESTIONS ()
  (format t "KPML compilation standard configuration...~%====================================================================~2%")
  (setf *multilinguality-required?*  T
	*window-interface-required?* *gui-onboard?*
	*non-incremental-compile?*   T
	*new-style-interface?*       *gui-onboard?*
	*extended-development-frame* T
	)
  (when *window-interface-required?*
    (check-package-present "CLIM"))

  ;; postscript only works for LWW4.1 or better...
  #+lispworks
  (:version-case (":LISPWORKS") 
		 (("4.0" "4.1") 
		  (when *window-interface-required?*
		    (system::load-clim-postscript-module)))
		 ((+ "4.1")
		  (when *window-interface-required?*
		    (require "clim-postscript"))))
  #+allegro 
  (:version-case (":ALLEGRO-V")
		 ((- "4.3.2")                     ;; prior to 4.3.1 ipc was
		  (setf *acl-ipc-required?* T))   ;; always present
		 ((+ "4.3.1")                     ;; in ACL5.0 it is no longer
		  (setf *acl-ipc-required?* nil)))
  
  (format t "KPML compilation configuration set...~%====================================================================~2%"))

;;; ----------------------------------------------------------------------
;;; The generic configuration for loading...
;;; ----------------------------------------------------------------------

(defun CONFIGURE-KPML-LOAD-WITH-QUESTIONS ()
  (format t "~2%====================================================================~%   CONFIGURING THE KPML LOAD IMAGE INTERACTIVELY~%====================================================================~2%")
  (setf *multilinguality-required?* 
	T
	*window-interface-required?*
	(y-or-n-p "Load the window interface (requires CLIM)?: "))
  (when *window-interface-required?* (check-package-present "CLIM"))
  
  ;; postscript only works for LWW4.1 or better...
  #+lispworks
    (:version-case (":LISPWORKS") 
		 (("4.0" "4.1") 
		  (when *window-interface-required?*
		    (system::load-clim-postscript-module)))
		 ((+ "4.1")
		  (when *window-interface-required?*
		    (require "clim-postscript"))))
  #+allegro 
  (:version-case (":ALLEGRO-V")
		 ((- "4.3.2")                               ;; prior to 4.3.1 ipc was
		  (setf *acl-ipc-required?* T))             ;; always present
		 ((+ "4.3.1")                               ;; in ACL5.0 it is no longer
		  (setf *acl-ipc-required?*
			(y-or-n-p 
			 "Is the Allegro socket server-client functionality to be used?: ")
			)))
  #+allegro (when *acl-ipc-required?* (check-package-present "IPC"))
  (setf *cl-xml-required?*
	(y-or-n-p 
	 "Are linguistic resources in XML form to be used for input?: "))
  (when *cl-xml-required?* (check-package-present "XMLS"))

  (setf *load-kr-system?*
	(y-or-n-p "Include the specified KR system?: "))

  (setf *new-style-interface?* *window-interface-required?*)
  (setf *extended-development-frame*
    T
    ;;; no longer supported:
    ;;; (y-or-n-p "Use extended development frame (single window)?: ")
    )
  (setf *load-linguistic-resources?* 
    (y-or-n-p "Load linguistic resources?: "))

  (unless *load-linguistic-resources?*
    (when *load-kr-system?*
      (setf *upper-model-required?* 
	    (y-or-n-p "Load general upper model?: ")))
    (setf *inquiry-impls-required?*
      (y-or-n-p "Load general inquiry implementations?: ")))

  (when *multilinguality-required?*
	#-(and acl3.0 aclpc)
	(progn
          (unless (boundp '*configuration-all-languages*)
	    (format 
	     t "~% What is the range of languages to be maintained initially?~%  (This should be a list, e.g., (:english :german), the first language~%        is then taken as the current language; nil defaults to (:english).)?~%: ")
	    (setf *configuration-all-languages* (read))))
	#+(and acl3.0 aclpc) (aclpc-language-required-setter)

	(unless *configuration-all-languages*
	  (setf *configuration-all-languages* '(:english)))
	(setf *curlan* (first *configuration-all-languages*))
	(format t "Languages to be maintained: ~A; ~% Current language: ~A~2%"
		*configuration-all-languages* *curlan*))
  
  (format t "Configuration complete...~%====================================================================~2%"))

;;; ----------------------------------------------------------------------
;;; 3.0 as above, but without asking any questions: for the simplest
;;; and most common kind of load scenario...
;;; ----------------------------------------------------------------------

(defun CONFIGURE-KPML-LOAD-NO-QUESTIONS ()
  (format t "~2%====================================================================~%   CONFIGURING THE KPML LOAD IMAGE~%====================================================================~2%")
  
  (setf *multilinguality-required?*     T
	*window-interface-required?*    *gui-onboard?*
	*new-style-interface?*          *gui-onboard?*
	*extended-development-frame*    T
	*load-linguistic-resources?*    nil
	*upper-model-required?*         *load-general-upper-model*
        *load-kr-system?*               *load-general-upper-model*
	*configuration-all-languages* '(:english)
	*curlan* (first *configuration-all-languages*)
	)
  (when *window-interface-required?*
    (check-package-present "CLIM"))
  ;; postscript only works for LWW4.1 or better...
  #+lispworks
    (:version-case (":LISPWORKS") 
		 (("4.0" "4.1") 
		  (when *window-interface-required?*
		    (system::load-clim-postscript-module)))
		 ((+ "4.1")
		  (when *window-interface-required?*
		    (require "clim-postscript"))))
  #+allegro 
  (:version-case (":ALLEGRO-V")
		 ((- "4.3.2")                     ;; prior to 4.3.1 ipc was
		  (setf *acl-ipc-required?* T))   ;; always present
		 ((+ "4.3.1")                     ;; in ACL5.0 it is no longer
		  (setf *acl-ipc-required?* nil)))
  (unless (and (boundp '*kpml-binaries-root*)
	       *kpml-binaries-root*)
    (setf *kpml-binaries-root* *root-of-kpml*))

  (format t "Initial languages: ~A; ~% Current language: ~A~2%"
	  *configuration-all-languages* *curlan*)
  
  (format t "Configuration complete...~%====================================================================~2%"))

;;; ----------------------------------------------------------------------
;;; General redefinition warning muffler...
;;; 4.0
;;; In higher ACLs this is also present, and in a locked package
;;; what is more; so only define if not already there...
;;; ----------------------------------------------------------------------

(eval-when 
 (:execute :load-toplevel :compile-toplevel)
(unless (and (find-symbol "WITHOUT-REDEFINITION-WARNINGS")
	     (fboundp 'WITHOUT-REDEFINITION-WARNINGS))
  (defmacro WITHOUT-REDEFINITION-WARNINGS (&body body)
    `(let (
	   (no-warnings T)
	   #+(and acl3.0 aclpc)
	   (acl::*warn-on-redefinition* nil)
	   #+(and acl3.0 aclpc)
	   (acl::*warn-on-protected-function-redefinition* nil)
	   #+excl
	   (excl:*redefinition-warnings* nil)
	   )
       ,@body))
  ))


;;; ----------------------------------------------------------------------
;;; PLATFORM SPECIFIC CONFIGURATION FUNCTIONS...
;;; ----------------------------------------------------------------------

;;; ----------------------------------------------------------------------
;;;  4.0 Dialog boxes for Lispworks under Windows...
;;;
;;; Following provides a box dialog for configuration KPML compilation
;;; options under LWW using its own internal CAPI windowing system.
;;; Therefore works whenever there is a LWW running (at least under
;;; Windows) and can be included regardless of CLIM. 
;;; ----------------------------------------------------------------------

(defvar *kpml-config-options*
  `((*window-interface-required?* 
     "Compile window interface (requires CLIM)" T)
    #+allegro
    (*acl-ipc-required?*
     "Is the Allegro socket server-client functionality to be used? " nil)
    (*cl-xml-required?*
     "Are linguistic resources in XML form to be used for input? " nil)
    (*load-kr-system?*
     "Include the specified KR system? " nil)
    (*non-incremental-compile?*
     "Compile everything from scratch " 
     nil)))

(defvar *kpml-load-options*
  '((*window-interface-required?*
    "Load the window interface (requires CLIM)? "
    T)
   (*cl-xml-required?*
    "Are linguistic resources in XML form to be used for input? "
    NIL)
   (*load-kr-system?*
    "Include the specified KR system? " nil)
   (*load-linguistic-resources?* 
    "Load linguistic resources? "
    NIL)
   (*upper-model-required?* 
    "Load general upper model? "
    T)
   (*inquiry-impls-required?*
    "Load general inquiry implementations? "
    NIL)))



;;; ......................................................................
;;; Now the individual versions of the configuration
;;; functions for compiling and loading respectively...
;;; ......................................................................

(defun CONFIGURE-KPML-COMPILATION-WITH-QUESTIONS-CAPI ()
  (format t "~%")
  (loop for m in *kpml-comp-configuration-mod* do (format t "~%~A" m))
  (format t "~%")

  (configure-kpml-options-capi
   "Choose KPML compilation options"
   *kpml-config-options*
   '((*multilinguality-required?*  T)       
     (*new-style-interface?*       *window-interface-required?*)
     (*extended-development-frame* T)))

  (when *window-interface-required?* (check-package-present "CLIM"))
  
  ;; For Lispworks, postscript only works for LWW4.1 or better...
  ;; For Allegro under Windows, prefer ACL5 or better but then
  ;; we are not in this function so can ignore!
  #+lispworks
    (:version-case (":LISPWORKS") 
		 (("4.0" "4.1") 
		  (when *window-interface-required?*
		    (system::load-clim-postscript-module)))
		 ((+ "4.1")
		  (when *window-interface-required?*
		    (require "clim-postscript"))))
  
  (when *cl-xml-required?* (check-package-present "XMLS"))

  (format t "~%Configuration for compilation complete...~%====================================================================~2%")

  )

	 
(defun CONFIGURE-KPML-LOAD-WITH-QUESTIONS-CAPI ()
  (format t "~2%====================================================================~%   CONFIGURING THE KPML LOAD IMAGE INTERACTIVELY~%====================================================================~2%")
  
  (configure-kpml-options-capi
   "Choose KPML load options"
   *kpml-load-options*
   '((*multilinguality-required?*  T)       
     (*new-style-interface?*       *window-interface-required?*)
     (*extended-development-frame* T)))

  (when *window-interface-required?* (check-package-present "CLIM"))
  (when *cl-xml-required?* (check-package-present "XMLS"))
  
  ;; postscript only works for LWW4.1 or better...
  #+lispworks
    (:version-case (":LISPWORKS") 
		 (("4.0" "4.1") 
		  (when *window-interface-required?*
		    (system::load-clim-postscript-module)))
		 ((+ "4.1")
		  (when *window-interface-required?*
		    (require "clim-postscript"))))

  (unless *configuration-all-languages*
    (setf *configuration-all-languages* '(:english)))
  (setf *curlan* (first *configuration-all-languages*))

  (format t "Languages to be maintained: ~A; ~% Current language: ~A~2%"
	  *configuration-all-languages* *curlan*)
  
  (format t "Configuration complete...~%====================================================================~2%"))
   
(defun CONFIGURE-KPML-OPTIONS-CAPI 
  (dialog-title configuration-options presets)
  (when (and (member :CAPI *features*) #+CAPI (capi:screens)))
  #+CAPI
  (let ((count -1)
	(options '())
	(selection '()))
    (loop for (var message default) in configuration-options
	  do
	  (set var default)
	  (push (cons var message) options)
	  (if default
	      (push (incf count) selection)
	    (incf count)))
    (setq options (nreverse options)
	  selection (nreverse selection))
    (when options
      (let ((list (make-instance 'capi:check-button-panel
				 :items options
				 :selection selection
				 :print-function 'cdr
				 :layout-class 'capi:column-layout
				 :visible-border t)))
	(if (capi:popup-confirmer list dialog-title)
	    (let ((on-options (capi:choice-selected-items list)))
	      (loop for (var message default) in configuration-options 
		    if (assoc var on-options)
		    do (set var T)
		    else
		    do (set var nil)))))))

  ;; do the things which are just obligatory ...
  (loop for (var val) 
	in presets
	do (set var (symbol-value val)))
)

;;; ----------------------------------------------------------------------
;;; This is  the old code for loading up with
;;; ACL3.0 for PC Windows. This is not really supported anymore, and ACL3.0
;;; is not provided by Franz anymore, but the code remains here just
;;; in case...
;;; ----------------------------------------------------------------------

#+(and acl3.0 aclpc)
(eval-when 
 (:execute :compile :load-toplevel :compile-toplevel)

 (defun ACLPC-LANGUAGE-REQUIRED-SETTER ()
  (lg-dialog-1)
  (loop until *lg-selected* do (sleep 5))
  (setf *lg-selected* nil)
  (cg:user-close-top-level-window *lg-dialog-1*))

;; Return the window, creating it the first time or when it's closed.
;; Use only this function if you need only one instance.
 (defun LG-DIALOG-1 ()
   (if (windowp *lg-dialog-1*) *lg-dialog-1* 
     (setq *lg-dialog-1* (make-lg-dialog-1))))
 
;; Create an instance of the window.
;; Use this if you need more than one instance.
 (defun MAKE-LG-DIALOG-1 (&key (parent *lisp-main-window*) 
			       (window-interior (make-box 203 343 606 597)) 
			       (name :lg-dialog-1) 
			       (title "Maintained Languages Setup"))
   (setq *loaded-but-uncreated-windows* 
	 (delete 'lg-dialog-1 *loaded-but-uncreated-windows*))
   (let (window-0 window-1 window-2 window-3 window-4)
     (setq window-0 
	   (open-dialog 
            (list 
               (make-dialog-item 
                  :widget 'static-text 
                  :name :static-text-3 
                  :title (delete #\Newline "Static Text 3") 
                  :value 
		  "What is the range of languages to be maintained?

This should be a list, e.g., (:english :german). The first language is then
taken as the current language. Nil defaults to :english."
                  :box (make-box 11 22 381 108) 
                  :tabstop nil 
                  :groupstart t 
                  :font (make-font-ex nil :arial 13 '(:bold)))
               (make-dialog-item 
                  :widget 'multi-line-lisp-text 
                  :name :multi-line-lisp-text-1 
                  :title (delete #\Newline "Multi Line Lisp Text 1") 
                  :value (list :english) 
                  :box (make-box 37 126 349 198) 
                  :tabstop t 
                  :groupstart t 
                  :set-value-fn 'maintained-languages-setup-fn 
                  :scrollable :vertical 
                  :font (make-font-ex nil :courier 13 nil))
               (make-dialog-item 
                  :widget 'button 
                  :name :button-1 
                  :title (delete #\Newline "Done") 
                  :box (make-box 312 218 388 240) 
                  :tabstop nil 
                  :groupstart nil 
                  :background-color 
                  (make-rgb :red 0 :green 255 :blue 64) 
                  :set-value-fn 'language-selected-fn 
                  :font (make-font-ex nil :arial 13 '(:bold))))
            'dialog parent 
            :name name 
            :title title 
            :font (make-font :swiss :system 16 '(:bold)) 
            :window-state :shrunk 
            :window-border :frame 
            :left-attachment nil 
            :top-attachment nil 
            :right-attachment nil 
            :bottom-attachment nil 
            :user-movable t 
            :user-resizable nil 
            :user-closable nil 
            :user-shrinkable nil 
            :user-scrollable nil 
            :overlapped nil 
            :background-color light-gray 
            :pop-up-p T
            :window-interior window-interior))
      (setf (window-editable-p window-0) nil)
      (setf (getf (stream-plist window-0) :path) "")
      (setf (getf (stream-plist window-0) :startup-state) nil)
      (setf (getf (stream-plist window-0) :top-level-p) nil)
      (setf (help-string window-0) (delete #\Newline nil))
      (setf (getf (stream-plist window-0) :package) nil)
      nil
      (let* ((box (getf *window-exteriors* (object-name window-0))))
         (when box (reshape-window-exterior window-0 box)))
      (show-window window-0 nil)
      window-0))

 (unless (windowp *lg-dialog-1*) 
	 (pushnew 'lg-dialog-1 *loaded-but-uncreated-windows*))
 
 (defun maintained-languages-setup-fn (widget new-value old-value)
   (setf *configuration-all-languages* new-value)
	     (values t ;; Accept the new value
		     nil))  ;; Don't exit the dialog (if a pop-up)

 (defun language-selected-fn (widget new-value old-value)
   (setf *lg-selected* T)
   (values t ;; Accept the new value
	   nil))  ;; Don't exit the dialog (if a pop-up)

)





