mule-base / fsf-compat-unicode.el

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

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

;; Author: Aidan Kehoe <>
;; 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
;; 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. 
(unless (and (fboundp 'encode-char)
             (eq #x31C (with-fboundp '(encode-char decode-char)
                     (encode-char (decode-char 'ucs #x31C) 'ucs))))
  (error "Unicode support needed for this file not available!"))

(if (eval-when-compile
      (and (> emacs-major-version 20)  
	   (> emacs-minor-version 4)
	   (featurep 'mule)))

    ;; If we're being compiled by 21.5, use the actual define-ccl-program
    ;; macro, but evaluated at runtime. 
    ;; Having this as 
    ;;   (eval-when-compile (and (featurep 'mule) (macroexpand
    ;;   '(define-ccl-program ...))
    ;; in order to have the macro evaluated at compile time, results
    ;; in the statement being empty in the compiled file, which as I
    ;; understand it is a bug.

     '(define-ccl-program fsf-compat-ccl-encode-to-ucs-2 
	 ((r1 = (r1 << 8)) 
	  (r1 = (r1 | r2)) 
	  (mule-to-unicode r0 r1) 
	  (r1 = (r0 >> 8)) 
	  (r2 = (r0 & 255)))) 
       "CCL program to transform Mule characters to UCS-2."))

  ;; Pre-expand the macro for 21.4. 21.4 will error on loading this file, but 
  ;; it may compile it. define-ccl-program should not be a macro, but that's 
  ;; by the way. 
  (let ((prog [1 10 131127 8 98872 65823 147513 8 82009 255 22])) 
    (defconst fsf-compat-ccl-encode-to-ucs-2 prog 
      "CCL program to transform Mule characters to UCS-2.") 
    (put (quote fsf-compat-ccl-encode-to-ucs-2) 
	 (quote ccl-program-idx) 
	 (register-ccl-program (quote fsf-compat-ccl-encode-to-ucs-2) prog))  

(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)
      for (first-ucs last-ucs final) in '((#x0100 #x24FF ?1)
					  (#x2500 #x33ff ?2)
					  (#xE000 #xFFFF ?3))
      (setq charset-symbol 
	    (intern (format "mule-unicode-%04x-%04x"
			    first-ucs last-ucs)))
      (make-charset charset-symbol
		     "Unicode subset (U+%04X..U+%04X) for FSF compatibility."
		     first-ucs last-ucs)
		    (list 'dimension 2 
			  'registries ["iso10646-1"]
			  'chars 96
			  'columns 1
			  'direction 'l2r
			  'final final
			  'graphic 0
			  'short-name (format "Unicode subset %c" final)
			  'long-name (format "Unicode subset (U+%04X..U+%04X)"
					     first-ucs last-ucs)
			  'ccl-program 'fsf-compat-ccl-encode-to-ucs-2))
      ;; The names of the character sets lie, at least as of GNU Emacs
      ;; 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