;;; fsf-compat-unicode.el --- Provide the FSF's Mule UCS subsets in XEmacs. 

;; Copyright (C) 2006 by Free Software Foundation, Inc.

;; Author: Aidan Kehoe <kehoea@parhasard.net>
;; Keywords: Unicode, Mule

;; This file is part of XEmacs.

;; XEmacs is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; XEmacs is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with XEmacs; see the file COPYING.  If not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.

;;; Synched up with: Not in FSF

;;; Commentary:

;;; Code:

;;; Only for 21.5 and newer. Compiles with 21.4 fine. 

(eval-when-compile (require 'ccl))

;; Check at runtime that the Unicode support is available, and that its
;; coverage is good enough.
(unless (and (fboundp 'encode-char) (decode-char 'ucs #x31C)
             (eq #x31C (encode-char (decode-char 'ucs #x31C) 'ucs)))
  (error 'unimplemented
	 "Unicode support or coverage needed not available"))

;; For redisplay of these character sets, provide a CCL program to address
;; iso10646-1 X11 fonts.
(defvar fsf-compat-ccl-program 
  (eval-when-compile
    (let ((pre-existing [1 10 131127 7 98872 65823 147513 8 82009 255 22]))
      (when (and (> emacs-major-version 20) (> emacs-minor-version 4)
                 (featurep 'mule))
        ;; In the event that we're compiling on 21.5, check that the
        ;; pre-existing constant reflects the intended CCL
        ;; program. Otherwise, just go ahead and use it.
        (assert (equal pre-existing
                       (ccl-compile
                        `(1 
                          ((r1 = (r1 << 7)) 
                           (r1 = (r1 | r2)) 
                           (mule-to-unicode r0 r1) 
                           (r1 = (r0 >> 8)) 
                           (r2 = (r0 & #xFF))))))
                nil 
                "The pre-compiled CCL program appears broken. "))
      pre-existing))
  "CCL program required by `fsf-compat-init-mule-unicode-charsets'.")

;;;###autoload
(defun fsf-compat-init-mule-unicode-charsets ()
  "Make some Mule character sets that the FSF uses available in XEmacs.

These character sets cover some Unicode code space explicitly; we use a
different solution to the same problem, so you should only need these
character sets if you're editing FSF source.  "
  (let (charset-symbol)
    (loop
      for (first-ucs last-ucs final) in '((#x0100 #x24FF ?1)
					  (#x2500 #x33ff ?2)
					  (#xE000 #xFFFF ?3))
      do 
      (setq charset-symbol 
	    (intern (format "mule-unicode-%04x-%04x"
			    first-ucs last-ucs)))
      (make-charset charset-symbol
		    (format 
		     "Unicode subset (U+%04X..U+%04X) for FSF compatibility."
		     first-ucs last-ucs)
		    `(dimension 2 
                      registries ["iso10646-1"]
                      chars 96
                      columns 1
                      direction l2r
                      final ,final
                      graphic 0
                      short-name ,(format "Unicode subset U+%04X" first-ucs)
                      long-name ,(format "Unicode subset (U+%04X..U+%04X)"
                                         first-ucs last-ucs)
                      ccl-program ,fsf-compat-ccl-program))
      ;; The names of the character sets lie, at least as of GNU Emacs
      ;; 22.0.50.3. The difference appears to be that they keep assigning
      ;; code points until the end of the 96x96 space of the character sets.
      (loop for ku from 32 to 127 do
	(loop for ten from 32 to 127 do 
	  (set-unicode-conversion (make-char charset-symbol ku ten) first-ucs)
	  (incf first-ucs))))))

;; The following code creates a form, which, when evaluated in GNU Emacs,
;; checks our compatibility with their three character sets.

; (progn
;   (insert "(require 'cl)\n\n(assert\n (and\n")
;   (loop
;     for charset-symbol in '(mule-unicode-2500-33ff
; 			    mule-unicode-e000-ffff
; 			    mule-unicode-0100-24ff)
;     do
;     (loop for ku from 32 to 127 do
;       (loop for ten from 32 to 127 do
; 	(insert (format
; 		 "  (eq (encode-char (make-char '%s %d %d) 'ucs) #x%04X)\n" 
; 		 charset-symbol ku ten 
; 		 (encode-char (make-char charset-symbol ku ten) 'ucs))))))
;   (insert "  ) nil \"We're incompatible with the FSF!\")"))
;;; end fsf-compat-unicode.el