cgit.sxemacs.org Git - packages/blob - mule-packages/mule-base/fsf-compat-unicode.el

   1 ;;; fsf-compat-unicode.el --- Provide the FSF's Mule UCS subsets in XEmacs.
   2
   3 ;; Copyright (C) 2006 by Free Software Foundation, Inc.
   4
   5 ;; Author: Aidan Kehoe <kehoea@parhasard.net>
   6 ;; Keywords: Unicode, Mule
   7
   8 ;; This file is part of XEmacs.
   9
  10 ;; XEmacs is free software; you can redistribute it and/or modify it
  11 ;; under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; XEmacs is distributed in the hope that it will be useful, but
  16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18 ;; General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  23 ;; 02111-1307, USA.
  24
  25 ;;; Synched up with: Not in FSF
  26
  27 ;;; Commentary:
  28
  29 ;;; Code:
  30
  31 ;;; Only for 21.5 and newer. Compiles with 21.4 fine.
  32
  33 (eval-when-compile (require 'ccl))
  34
  35 ;; Check at runtime that the Unicode support is available, and that its
  36 ;; coverage is good enough.
  37 (unless (and (fboundp 'encode-char) (decode-char 'ucs #x31C)
  38              (eq #x31C (encode-char (decode-char 'ucs #x31C) 'ucs)))
  39   (error 'unimplemented
  40          "Unicode support or coverage needed not available"))
  41
  42 ;; For redisplay of these character sets, provide a CCL program to address
  43 ;; iso10646-1 X11 fonts.
  44 (defvar fsf-compat-ccl-program
  45   (eval-when-compile
  46     (let ((pre-existing [1 10 131127 7 98872 65823 147513 8 82009 255 22]))
  47       (when (and (> emacs-major-version 20) (> emacs-minor-version 4)
  48                  (featurep 'mule))
  49         ;; In the event that we're compiling on 21.5, check that the
  50         ;; pre-existing constant reflects the intended CCL
  51         ;; program. Otherwise, just go ahead and use it.
  52         (assert (equal pre-existing
  53                        (ccl-compile
  54                         `(1
  55                           ((r1 = (r1 << 7))
  56                            (r1 = (r1 | r2))
  57                            (mule-to-unicode r0 r1)
  58                            (r1 = (r0 >> 8))
  59                            (r2 = (r0 & #xFF))))))
  60                 nil
  61                 "The pre-compiled CCL program appears broken. "))
  62       pre-existing))
  63   "CCL program required by `fsf-compat-init-mule-unicode-charsets'.")
  64
  65 ;;;###autoload
  66 (defun fsf-compat-init-mule-unicode-charsets ()
  67   "Make some Mule character sets that the FSF uses available in XEmacs.
  68
  69 These character sets cover some Unicode code space explicitly; we use a
  70 different solution to the same problem, so you should only need these
  71 character sets if you're editing FSF source.  "
  72   (let (charset-symbol)
  73     (loop
  74       for (first-ucs last-ucs final) in '((#x0100 #x24FF ?1)
  75                                           (#x2500 #x33ff ?2)
  76                                           (#xE000 #xFFFF ?3))
  77       do
  78       (setq charset-symbol
  79             (intern (format "mule-unicode-%04x-%04x"
  80                             first-ucs last-ucs)))
  81       (make-charset charset-symbol
  82                     (format
  83                      "Unicode subset (U+%04X..U+%04X) for FSF compatibility."
  84                      first-ucs last-ucs)
  85                     `(dimension 2
  86                       registries ["iso10646-1"]
  87                       chars 96
  88                       columns 1
  89                       direction l2r
  90                       final ,final
  91                       graphic 0
  92                       short-name ,(format "Unicode subset U+%04X" first-ucs)
  93                       long-name ,(format "Unicode subset (U+%04X..U+%04X)"
  94                                          first-ucs last-ucs)
  95                       ccl-program ,fsf-compat-ccl-program))
  96       ;; The names of the character sets lie, at least as of GNU Emacs
  97       ;; 22.0.50.3. The difference appears to be that they keep assigning
  98       ;; code points until the end of the 96x96 space of the character sets.
  99       (loop for ku from 32 to 127 do
 100         (loop for ten from 32 to 127 do
 101           (set-unicode-conversion (make-char charset-symbol ku ten) first-ucs)
 102           (incf first-ucs))))))
 103
 104 ;; The following code creates a form, which, when evaluated in GNU Emacs,
 105 ;; checks our compatibility with their three character sets.
 106
 107 ; (progn
 108 ;   (insert "(require 'cl)\n\n(assert\n (and\n")
 109 ;   (loop
 110 ;     for charset-symbol in '(mule-unicode-2500-33ff
 111 ;                           mule-unicode-e000-ffff
 112 ;                           mule-unicode-0100-24ff)
 113 ;     do
 114 ;     (loop for ku from 32 to 127 do
 115 ;       (loop for ten from 32 to 127 do
 116 ;       (insert (format
 117 ;                "  (eq (encode-char (make-char '%s %d %d) 'ucs) #x%04X)\n"
 118 ;                charset-symbol ku ten
 119 ;                (encode-char (make-char charset-symbol ku ten) 'ucs))))))
 120 ;   (insert "  ) nil \"We're incompatible with the FSF!\")"))
 121 ;;; end fsf-compat-unicode.el