(in-package "KPML")

;;; File: code-page-setter.lisp
;;; John, Bremen, March2000
;;;
;;; Combines the results of the Agile experiences with using various
;;; fonts and code pages so that it becomes a more transparent and
;;; integral part of using KPML on PCs with code-pages that do not set
;;; themselves...
;;;
;;; Languages may be associated with particular code pages, these code
;;; pages are then set before loading in any resources for that
;;; language (particularly lexicons) and are added to the font control
;;; when printing results out.  Since the code-page is looked at
;;; apparently when reading in strings and when printing and "foreign
;;; characters". But once the strings are in ok, then display is not
;;; so problematic it seems. So, for present, set the code page while
;;; reading in resources... The treatment appears quite stable under
;;; LW4.0, but as yet ineffective under LW4.1. It in any case relies
;;; on the Agile private patches from Harlequin received for LW4.0 and
;;; 4.1 in 1999.
;;;
;;; Added tracing...
;;; (after 3.2.24, following flag reset to NIL as it appears stable)
;;  3.2.60 nothing happens to the code page if we set the font to
;;         be Unicode. I don't know if this is good or bad... presumably
;;         if we are using Unicode then many of the particular changes
;;         necessary in other cases happen by themselves... 

(defparameter *TRACE-CODE-PAGE-CHANGES* nil)

(defvar *CODE-PAGE-LANGUAGE-ASSOCIATIONS*
  '((:bulgarian 1251)
    (:russian 1251)
    (:english 1252)
    (:czech 1250)
    (:greek 1253)))

(defvar *DEFAULT-CODE-PAGE-LANGUAGE* :english)

;;; 4.0 problem is that the more advanced and varied character settings
;;;     mess up the normal Lisp Listener and Editor windows with 
;;;     Lispworks. The font becomes a proportional font which these
;;;     windows apparent cannot deal with (under LWW4.1.19 at least).
;;;     This detracts a lot from ease of development, so we make these
;;;     code page settings rather more conditionalized: they are then
;;;     not the default mode of use for KPML. An additional flag (whoopie...
;;;     yes *another* one, after the first 1000 why not another?...)
;;;     turns this behaviour on and off. The easiest way of controlling
;;;     this is to make sure that the function code-page-for-lg
;;;     never returns a non-NIL value. 

(defvar *ACTIVATE-CODE-PAGE-SETTINGS* NIL)

(defun CODE-PAGE-FOR-LG (lg &key (force-p nil))
  (if (or force-p *activate-code-page-settings*)
      (let* ((code-page-0 
	      (second (assoc lg *code-page-language-associations*)))
	     (code-page-1
	      (if code-page-0
		  code-page-0
		(second 
		 (assoc *default-code-page-language* 
			*code-page-language-associations*))))
	     (code-page (if code-page-1 code-page-1 1252)))
	code-page)
    nil))

;;; In the following lw::simple-char seems to be a clear favourite of LW4.0
;;; And without it LW4.1 cannot handle Unicode. So... This is also necessary
;;; now in general because KPML4 tries to check whether or not it has to
;;; real files in Unicode, and to do that it opens a file in Unicode mode,
;;; which will only work with simple-chars not base-chars.
#+lispworks
(lw::SET-DEFAULT-CHARACTER-ELEMENT-TYPE 'lw::simple-CHAR) ;; simple-char

;;; ----------------------------------------------------------------------
;;; :KPML-3.2.7 "PC code page variable still used in wrong package"
;;; ----------------------------------------------------------------------

#-(and lispworks win32)
(defun SET-CODE-PAGE-SETTINGS (lg) 
  (when *trace-code-page-changes* 
    (format t "~%Code change: not defined outside of Lispworks.")))

#+(and lispworks win32)
(defun SET-CODE-PAGE-SETTINGS (lg)
  (let ((code-page (code-page-for-lg lg)))          
    (unless (or (null code-page)
		(equal code-page :unicode))
      (setf (editor:variable-value "Input Format Default")
	    `(win32:code-page :id ,code-page :eol-style :crlf))        ;; 850
      (setf (editor:variable-value "Output Format Default")
	    `(win32:code-page :id ,code-page))                         ;; 850
    
      ;; (in-package "CAPI")
      (gp:define-font-alias :editor-pane-default-font
			    (gp:gf nil "Times New Roman" nil nil nil))

      (setf sys:*file-encoding-detection-algorithm* 
	    (list #'(lambda (&rest args) 
		      (declare (ignore args))
		      `(win32:code-page :id ,code-page)))) ;; 850
    
      (setf win32::*multibyte-code-page-ef* 
	    `(win32::code-page :id ,code-page)))
    
    (when *trace-code-page-changes*
      (if *activate-code-page-settings*
	  (format t
		  "~%Codepage being set.
Language given as: ~S; code page chosen is: ~S
sys:*file-encoding-detection-algorithm* is now: ~S
win32::*multibyte-code-page-ef* is now: ~S"
		  lg code-page
		  sys:*file-encoding-detection-algorithm*
		  win32::*multibyte-code-page-ef*)
	(format t "~%Codepage setting disenabled (language: ~S)" 
		lg)))
    ))


  ;; ----------------------------------------------------------------------
  ;; 3.2.60: "Extension for resources specifying Unicode as their font"
  ;;
  ;; The following needs to replace every instance where there 
  ;; a file is created or read and this may need to address
  ;; other character sets. The value returned is then used
  ;; as the :external-format value for the with-open-stream
  ;; and so on with Lispworks. It should only be used in 
  ;; Lispworks (PC Lispworks at that). 
  ;;
  ;; 4.0 use an extra parameter for forcing something sensible to
  ;;     be returned in this case...
  ;; ----------------------------------------------------------------------

#+(and lispworks win32)
(defun FILE-ENCODING (lg)
  (if (equal (kpml::code-page-for-lg lg) :unicode)
      :unicode       
    `(WIN32:CODE-PAGE :ID ,(kpml::code-page-for-lg kpml::curlan :force-p T))))

#-(and lispworks win32)
(defun FILE-ENCODING (lg) nil)





