(in-package "KPML")

;;; File: config.lisp
;;; Origin: John:Stirling:Oct97
;;; Added in at: KPML 1.1

;;; Here we add the possibility of configuring KPML by preloading
;;; a configure file that allows the setting of internal flags,
;;; directories to be used, etc. This is particularly intended for
;;; use with Runtime applications where the user does not have the
;;; possibility of running arbitrary Lisp. It also allows single
;;; images to be relocated more smoothly, e.g., by resetting the
;;; directories to be used for KPML, for patches, for resources,
;;; for temp files, etc.
;;;
;;; Change for KPML4 at Sep04. Some starting defaults are changed
;;;    so that the behaviour of a standalone image is not to 
;;;    complain when C:\tmp or some patches are not to be found.
;;;    The default assumption will be that if someone is using
;;;    the standalone image, then they will not necessarily know
;;;    that they need such things (nor a configuration file!), so
;;;    the image should behave itself in this case. Once the user
;;;    knows more, they can activate these options using a configuration
;;;    file as required.

(defvar *verbose-configuring* T "Reports on flags set during preconfigure")

;;; ----------------------------------------------------------------------
;;; The following function loads a configuration file and interprets
;;; its contents. It is called as the first action on starting up
;;; KPML from an image. The configuration file takes its name from
;;; a global environment variable $KPMLCONFILE if present, else
;;; its name is kpmlconf. The environment variable should contains a complete
;;; path. If no variable is set, KPML looks for a kpmlconf.lisp file
;;; in the following places, and in the following order (taking the
;;; first one it finds):
;;;  on a PC diskette on the A drive (when a PC!)
;;;  in the user's home directory (if defined)
;;;  in the same directory that kpml is started (if defined)
;;;  in a directory set as the value of the environment variable $KPMLROOT
;;;  in the *default-pathname-defaults* directory (when KPMLROOT is unset)
;;;  in the existing value of the Lisp variable common-lisp-user::*root-of-kpml*
;;;
;;; In addition, a few special flags may be set:
;;; *load-patches*         nil/T/pathname for selecting if and where
;;;                        patches are to be loaded from.
;;; *load-site-specifics*  nil/T/pathname for selecting if and where
;;;                        site specific info is to be loaded from
;;; *load-user-specifics*  nil/T/pathname for selecting if and where
;;;                        user specifics are to be loaded from
;;; *monochrome*           :color/:mono for presetting the default
;;;                        window startup (if :unspecified, get a dialog box on
;;;                        startup of interface)
;;; *all-languages*        sets the all_languages variable
;;; *curlan*               sets the curlan variable.
;;; *versioning*           T/nil sets the initial versioning of resources
;;;                        on or off.
;;; *startup-windows*      :root/:development/:all/:conditional
;;;                        configures which windows
;;;                        are brought up when starting the KPML interface.
;;;
;;; N.B. NOT ALL OF THESE ARE VARIABLES: SOME ARE INTERPRETED SPECIALLY
;;;      SO THAT THEY EFFECT THE REQUISITE VARIABLES...
;;;
(defvar *load-patches* nil)             ;; default is now OFF (KPML4, Sep04)
(defvar *load-site-specifics* nil)      ;; default is now OFF
(defvar *load-user-specifics* nil)      ;; default is now OFF
(defvar *monochrome* :unspecified)
(defvar *configure-file-name* "kpmlconf")
;;;

  ;; --------------------------------------------------------------------
  ;; 3.2.4 
  ;;       added a few more places where KPML will search for a configuration
  ;;       file!
  ;;        (i)   added back the floppy iff an environment variable called
  ;;              KPMLDISK is set; should always have control of whether
  ;;              environment variables are set!
  ;;        (ii)  added the directory that is given in an environment 
  ;;              variable TEMP if that exists.
  ;;        (iii) and as absolutely last try, it looks to see if the configure
  ;;              file variable finds something on its own (e.g., it is set to
  ;;              a full path).
  ;;
  ;; 3.2.34 Further change in reporting and looking...
  ;; 4.0    Also look in the default temporary directory
  ;;
  ;;    Some horrible PC editors make it difficult for naive users by always
  ;; insisting on putting .txt or some such nonsense as an extension (even
  ;; when a different extension is already in the file name). We try to
  ;; accomodate this by allowing any configuration file to have a .txt
  ;; extension: thus the name A and A.txt should always now have the
  ;; same effect. This is undocumented as it should not be done on
  ;; purpose.
  ;; --------------------------------------------------------------------

(defun LOAD-KPML-CONFIGURATION-FILE ()
  (let* ((disk (if (env-var-set-p "KPMLDISK")
		   (pathname "A:\\")
		 nil))
	 (homedir (coerce-directory (user-homedir-pathname)))
	 (curdir  (coerce-directory (current-directory)))
	 (envar   (coerce-directory (getenv "KPMLROOT")))
	 (tmpdir  (coerce-directory *BASE-DEFAULT-DIRECTORY*))        ;; 4.0
	 (tempdir (coerce-directory (getenv "TEMP")))
	 (configfile (if (string= (getenv "KPMLCONFILE") "")
			 *configure-file-name*
		       (coerce-directory (getenv "KPMLCONFILE"))))
	 (configfile.txt (concatenate 'string configfile ".txt"))     ;; 4.0
	 (config-path
	  (list 
	   disk envar tmpdir tempdir curdir homedir cl-user::*root-of-kpml*)))
    
    (format *trace-output* "~%;;; KPML configuration file name: ~S" 
	    configfile)
    (format *trace-output* "~%;;;  ... searching: ~S" config-path)
    
    (cond ((and disk
		(probe-file (merge-pathnames disk configfile)))
	   (process-configuration-file (merge-pathnames disk configfile)))
	  ((and disk
		(probe-file (merge-pathnames disk configfile.txt)))
	   (process-configuration-file (merge-pathnames disk configfile.txt)))

	  ;; following is really only for a really messed up writing out
	  ;; of a configuration file but someone who has loaded it
	  ;; into Word and written it out without knowing what they
	  ;; were doing!
	  ((probe-file "kpmlconf_novice.txt")
	   (process-configuration-file "kpmlconf_novice.txt"))
	  
	  ((probe-file configfile)
	   (process-configuration-file configfile))
	  ((probe-file configfile.txt)
	   (process-configuration-file configfile.txt))
	  (t

	   (loop for path in config-path
		 as file = (or (if path
				   (probe-file 
				    (merge-pathnames path configfile))
				 nil)
			       (if path
				   (probe-file 
				    (merge-pathnames path configfile.txt))
				 nil))
		 when file
		 do 
		 (process-configuration-file file)
		 (return-from LOAD-KPML-CONFIGURATION-FILE T)
		 )))))

;; ----------------------------------------------------------------------
;; 3.2.69
;; Was not picking up required color option from the configuration
;; file correctly.
;; ----------------------------------------------------------------------

(defun PROCESS-CONFIGURATION-FILE (filename)
  (let ((inputline nil)
	(value nil)
	(*package* (find-package "KPML")))
    (format *trace-output* 
	    "~%;;; KPML configuration file found.")
    (format *trace-output* 
	    "~%;;;  ... configuring from '~A' (~S)." 
	    filename (truename filename))
    (with-open-file 
     (stream filename :direction :input :if-does-not-exist nil)
     (when (streamp stream)
	   (loop for inputline = (read-line stream nil nil)
		 unless inputline 
		 do (return-from PROCESS-CONFIGURATION-FILE T)
		 else
		 unless (or (< (length inputline) 3)
			    (char= (char inputline 0) #\;))
		 do
		 (multiple-value-bind
		  (flag endpt)(read-from-string inputline nil nil)
		  (if endpt
			 (setf value 
			       (read-from-string 
				(subseq inputline endpt) nil nil))
		       (setf value nil))
		     (when (and flag 
				(symbolp flag))
			   (case flag
				 (*ALL-LANGUAGES* (setf all_languages value))
				 (*CURLAN*        (setf curlan value))
				 (*ROOT-OF-RESOURCES* 
				  (setf kpml::*root-of-resources* value)
				  (setf common-lisp-user::*root-of-resources* value))
				 (*ROOT-OF-KPML*
				  (setf common-lisp-user::*root-of-kpml* value))
				 (*VERSIONING*
				  (if value
				      (pushnew :resource-patches 
					       kpml::*loading-saving-profile*)
				    (remove :resource-patches
					    kpml::*loading-saving-profile*)))
				 ;; 3.2.69 was incorrect....
                                 (*MONOCHROME*
                                  (when (eq  value :colour) (setf value :color))
                                  (setf kpml::*monochrome* value))
				 (otherwise
				  (set flag value)))
			   (when *verbose-configuring*
				 (format *trace-output* 
					 "~%;;; Setting: ~S to: ~S" 
					 flag value)))))))))




		   
	     
	     
	    
	  
	