cgit.sxemacs.org Git - packages/blob - mule-packages/mule-ucs/lisp/un-supple.el

   1 ;;; -*- byte-compile-dynamic: t;coding: iso-2022-7bit -*-
   2 ;;; un-supple.el --- Supplemental translation rules for
   3 ;;;                  other conversions than Unicode Consortium's definition.
   4
   5 ;; Copyright (C) 2000 Miyashita Hisashi
   6
   7 ;; Keywords: mule, multilingual,
   8 ;;           character set, coding-system, ISO/IEC 10646,
   9 ;;           Unicode, JIS X 0221, JDK, Japanese-EUC, Windows.
  10
  11 ;; This file is part of Mule-UCS
  12
  13 ;; Mule-UCS is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17
  18 ;; Mule-UCS is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with this program; see the file COPYING.  If not, write to the
  25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26 ;; Boston, MA 02111-1307, USA.
  27
  28 ;;; Comment:
  29
  30 ;; There should be no need for this file, as opposed to un-define.el, to
  31 ;; ever be loaded by a 21.5 XEmacs, which is why we don't provide the
  32 ;; mucs-ignore-version-incompatiblities workaround to suppress this error.
  33 (if (fboundp 'unicode-precedence-list)
  34     (error "Your XEmacs version is incompatible with Mule-UCS; not loaded."))
  35
  36 (let ((mucs-ignore-version-incompatibilities t))
  37   (require 'un-define))
  38
  39 (defvar un-supple-current-translation-rule nil)
  40
  41 (eval-when-compile
  42   (mucs-require-data 'usupple))
  43
  44 (eval-and-compile
  45   (require 'tae)
  46
  47   (defvar un-supple-translation-rule-alist
  48     '((jisx0221 . unicode-translation-rule-for-jisx0221)
  49       (jdk . unicode-translation-rule-for-jdk)
  50       (windows . unicode-translation-rule-for-windows)))
  51
  52   (defun un-supple-reconstruct-tr-def (tr-def sup-tr-rule)
  53     (let* ((tr1 (copy-sequence tr-def))
  54            (tr2 tr1)
  55            (alist (cons
  56                    (cons 'ascii
  57                          (unicode-get-translation-rule-from-charset
  58                           'ascii))
  59                    un-supple-translation-rule-alist))
  60            ins slot)
  61       (if (memq sup-tr-rule
  62                 '(unicode-translation-rule-for-fullwidth-or-halfwidth-normalization))
  63           (if (mucs-ccl-inspect-facility 'valid-map-multiple)
  64               (list 'c
  65                     tr1
  66                     sup-tr-rule)
  67             tr1)
  68         (while tr2
  69           (if (setq ins (rassq (car tr2) alist))
  70               (setq slot tr2
  71                     tr2 nil)
  72             (setq tr2 (cdr tr2))))
  73         (if (null slot)
  74             (error "Cannot find out apropriate location in %S"
  75                    tr-def))
  76         (cond ((eq (car ins) 'ascii)
  77                (if sup-tr-rule
  78                    (setcdr slot (cons sup-tr-rule
  79                                       (cdr slot)))))
  80               ((null sup-tr-rule)
  81                (setq tr1 (delq (cdr ins) tr1)))
  82               (t
  83                (setcar slot sup-tr-rule)))
  84         tr1)))
  85
  86   (defmacro un-supple-embed-translation-macro (tr)
  87     `(tae-embed-for-dynamic-modification
  88       'unicode-basic-translation-rule
  89       (un-supple-reconstruct-tr-def
  90        (tae-get-translation-definition
  91         'unicode-basic-translation-rule)
  92        (quote ,tr)))))
  93
  94 (mucs-define-package
  95  un-supple
  96  (mucs-import-package un-define)
  97  (un-supple-embed-translation-macro
  98   unicode-translation-rule-for-jisx0221)
  99  (un-supple-embed-translation-macro
 100   unicode-translation-rule-for-jdk)
 101  (un-supple-embed-translation-macro
 102   unicode-translation-rule-for-windows)
 103  (un-supple-embed-translation-macro
 104   unicode-translation-rule-for-fullwidth-or-halfwidth-normalization))
 105
 106 ;; interface functions
 107
 108 (defun un-supple-modify-translation-rule (sup-tr base-tr)
 109   (tae-modify-translation
 110    base-tr
 111    (un-supple-reconstruct-tr-def
 112     (tae-get-translation-definition base-tr)
 113     sup-tr)))
 114
 115 (defun un-supple-enable (sup)
 116   (let (tr)
 117     (if sup
 118         (progn
 119           (setq tr
 120                 (cdr (assq sup
 121                            un-supple-translation-rule-alist)))
 122           (if (null tr)
 123               (error "Unknown supplemental translation for %S" sup))))
 124     (un-supple-modify-translation-rule
 125      tr 'unicode-basic-translation-rule)))
 126
 127 (provide 'un-supple)
 128
 129 ;;; un-supple ends here.