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

   1 ;;; -*- coding: iso-2022-7bit  -*-
   2 ;;; big5conv.el --- conversion between Big5 and Emacs representation(Mainly CNS)
   3
   4 ;; Copyright (C) 1997, 1998 Kawabata Taichi
   5 ;;               1999       Miyashita Hisashi
   6
   7 ;; Keywords: mule, multilingual,
   8 ;;           MULE-UCS, Big5, CNS, Traditional Chinese, RFC1922
   9
  10 ;; This file is part of MULE-UCS
  11
  12 ;; MULE-UCS is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; MULE-UCS is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with this program; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27 ;; Comment:
  28
  29 ; (defvar big5conv-ccl-big5-to-abs
  30 ;   '((r0 = (r0 >8 0))
  31 ;     (if (r7 >= ?\xa1)
  32 ;       ((r4 = (r7 - 98)))
  33 ;       ((r4 = (r7 - 64))))
  34 ;     (r0 = (((r0 - ?\xa1) * 157) - r4))))
  35
  36 (require 'mucs)
  37 (require 'tae)
  38 (mucs-require-supplement 'big5type 'big5conv)
  39
  40 (defconst big5conv-encode-buffer-magnification 2) ;; LF -> CR+LF
  41 (defconst big5conv-decode-buffer-magnification 2)
  42
  43 (defun big5conv-big5-to-flat-code (num)
  44   (let ((hi (/ num 256))
  45         (lo (% num 256)))
  46     (+ (* 157 (- hi ?\xa1))
  47        (- lo (if (>= lo ?\xa1) 98 64)))))
  48
  49 (defun big5conv-char-to-flat-code (num)
  50   (let ((hi (/ num 256))
  51         (lo (% num 256)))
  52     (+ (* 94 (- hi ?\x21))
  53        (- lo ?\x21))))
  54
  55 (defun big5conv-flat-code-to-big5 (num)
  56   (let ((hi (/ num 157))
  57         (lo (% num 157)))
  58     (+ (* 256 (+ hi ?\xa1))
  59        (+ lo (if (< lo 63) 64 98)))))
  60
  61 (defun big5conv-flat-code-to-char (num)
  62   (let ((hi (/ num 94))
  63         (lo (% num 94)))
  64     (list (+ hi ?\x21) (+ lo ?\x21))))
  65
  66 (defun big5conv-expand-alist (alist)
  67   (let (elem result char big5
  68              i end codepoint charset)
  69     (while alist
  70       (setq elem (car alist)
  71             char (car elem)
  72             big5 (cdr elem)
  73             alist (cdr alist))
  74
  75       (cond ((and (consp char)
  76                   (consp big5))
  77              ;; convert strings described in C-style to numbers.
  78              (if (stringp (car big5))
  79                  (setcar big5 (c-notated-string-to-number (car big5))))
  80              (if (stringp (cdr big5))
  81                  (setcdr big5 (c-notated-string-to-number (cdr big5))))
  82              (if (stringp (cdr char))
  83                  (setcdr char (c-notated-string-to-number (cdr char))))
  84
  85              (setq i (big5conv-big5-to-flat-code (car big5))
  86                    end (big5conv-big5-to-flat-code (cdr big5))
  87                    codepoint (big5conv-char-to-flat-code (cdr char))
  88                    charset (car char))
  89              (while (>= end i)
  90                (setq result (cons
  91                              (cons
  92                               (apply (function make-char)
  93                                      charset
  94                                      (big5conv-flat-code-to-char codepoint))
  95                               (big5conv-flat-code-to-big5 i))
  96                              result)
  97                      i (1+ i)
  98                      codepoint (1+ codepoint))
  99              ))
 100             ((and (trans-util-charp char)
 101                   (or (numberp big5)
 102                       (stringp big5)))
 103              (if (stringp big5)
 104                  (setq big5 (c-notated-string-to-number big5)))
 105              (setq result (cons (cons char big5)
 106                                 result)))
 107             (t
 108              (error "Unkown slot type:%S" elem))))
 109       (nreverse result)))
 110
 111 (defvar big5conv-ascii-assoc
 112   (list 'assoc
 113         '(char-1 . big5)
 114         (let ((i 0) result)
 115           (while (< i 128)
 116             (setq result
 117                   (nconc result
 118                          (list (cons (make-char 'ascii i) i)))
 119                   i (1+ i)))
 120           result))
 121   "US-ASCII part of BIG5 translation rule")
 122
 123 (defvar big5conv-emacs-char-1-vs-big5-assoc
 124   `(assoc
 125     (char-1 . big5)
 126     ,(nconc
 127       (big5conv-expand-alist
 128        '(
 129          ;; Symbols
 130          ((chinese-cns11643-1 . "0x2121") . ("0xA140" . "0xA1F5"))
 131          (?\e$(G"X\e(B . "0xA1F6")
 132          (?\e$(G"W\e(B . "0xA1F7")
 133          ((chinese-cns11643-1 . "0x2259") . ("0xA1F8" . "0xA2AE"))
 134          ((chinese-cns11643-1 . "0x2421") . ("0xA2AF" . "0xA3BF"))
 135          ;; Control code (vender dependant)
 136          ((chinese-cns11643-1 . "0x4221") . ("0xA3C0" . "0xA3E0"))
 137          ;; Level 1 Ideograhs
 138          ((chinese-cns11643-1 . "0x4421") . ("0xA440" . "0xACFD"))
 139          (?\e$(GWS\e(B . "0xACFE")
 140          ((chinese-cns11643-1 . "0x5323") . ("0xAD40" . "0xAFCF"))
 141          ((chinese-cns11643-1 . "0x5754") . ("0xAFD0" . "0xBBC7"))
 142          ((chinese-cns11643-1 . "0x6B51") . ("0xBBC8" . "0xBE51"))
 143          (?\e$(GkP\e(B . "0xBE52")
 144          ((chinese-cns11643-1 . "0x6F5C") . ("0xBE53" . "0xC1AA"))
 145          ((chinese-cns11643-1 . "0x7536") . ("0xC1AB" . "0xC2CA"))
 146          (?\e$(Gu5\e(B . "0xC2CB")
 147          ((chinese-cns11643-1 . "0x7737") . ("0xC2CC" . "0xC360"))
 148          ((chinese-cns11643-1 . "0x782E") . ("0xC361" . "0xC3B8"))
 149          (?\e$(Gxe\e(B . "0xC3B9")
 150          (?\e$(Gxd\e(B . "0xC3BA")
 151          ((chinese-cns11643-1 . "0x7866") . ("0xC3BB" . "0xC455"))
 152          (?\e$(Gx-\e(B . "0xC456")
 153          ((chinese-cns11643-1 . "0x7962") . ("0xC457" . "0xC67E"))
 154          ;; Symbols
 155          ((chinese-cns11643-1 . "0x2621") . ("0xC6A1" . "0xC6BE"))
 156          ;; Radicals
 157          (?\e$(G'#\e(B . "0xC6BF")
 158          (?\e$(G'$\e(B . "0xC6C0")
 159          (?\e$(G'&\e(B . "0xC6C1")
 160          (?\e$(G'(\e(B . "0xC6C2")
 161          (?\e$(G'-\e(B . "0xC6C3")
 162          (?\e$(G'.\e(B . "0xC6C4")
 163          (?\e$(G'/\e(B . "0xC6C5")
 164          (?\e$(G'4\e(B . "0xC6C6")
 165          (?\e$(G'7\e(B . "0xC6C7")
 166          (?\e$(G':\e(B . "0xC6C8")
 167          (?\e$(G'<\e(B . "0xC6C9")
 168          (?\e$(G'B\e(B . "0xC6CA")
 169          (?\e$(G'G\e(B . "0xC6CB")
 170          (?\e$(G'N\e(B . "0xC6CC")
 171          (?\e$(G'S\e(B . "0xC6CD")
 172          (?\e$(G'T\e(B . "0xC6CE")
 173          (?\e$(G'U\e(B . "0xC6CF")
 174          (?\e$(G'Y\e(B . "0xC6D0")
 175          (?\e$(G'Z\e(B . "0xC6D1")
 176          (?\e$(G'a\e(B . "0xC6D2")
 177          (?\e$(G'f\e(B . "0xC6D3")
 178          (?\e$(G()\e(B . "0xC6D4")
 179          (?\e$(G(*\e(B . "0xC6D5")
 180          (?\e$(G(c\e(B . "0xC6D6")
 181          (?\e$(G(l\e(B . "0xC6D7")
 182          ;; Diacritical Marks
 183          ((japanese-jisx0208 . "0x212F") . ("0xC6D8" . "0xC6D9"))
 184          ;; Japanese Kana Supplement
 185          ((japanese-jisx0208 . "0x2133") . ("0xC6DA" . "0xC6E3"))
 186          ;; Japanese Hiragana
 187          ((japanese-jisx0208 . "0x2421") . ("0xC6E7" . "0xC77A"))
 188          ;; Japanese Katakana
 189          ((japanese-jisx0208 . "0x2521") . ("0xC77B" . "0xC7F2"))
 190          ;; Cyrillic Characters
 191          ((japanese-jisx0208 . "0x2721") . ("0xC7F3" . "0xC854"))
 192          ((japanese-jisx0208 . "0x2751") . ("0xC855" . "0xC875"))
 193          ;; Special Chinese Characters
 194          (?\e$(J!#\e(B . "0xC879")
 195          (?\e$(J!$\e(B . "0xC87B")
 196          (?\e$(J!*\e(B . "0xC87D")
 197          (?\e$(J!R\e(B . "0xC8A2")
 198
 199          ;; JIS X 0208 NOT SIGN (cf. U+00AC)
 200          (?\e$B"L\e(B . "0xC8CD")
 201          ;; JIS X 0212 BROKEN BAR (cf. U+00A6)
 202          (?\e$(D"C\e(B . "0xC8CE")
 203
 204          ;; GB 2312 characters
 205          (?\e$A!d\e(B . "0xC8CF")
 206          (?\e$A!e\e(B . "0xC8D0")
 207         ;;;;; C8D1 - Japanese `(\e$B3t\e(B)'
 208          (?\e$A!m\e(B . "0xC8D2")
 209         ;;;;; C8D2 - Tel.
 210
 211          ;; Level 2 Ideographs
 212          ((chinese-cns11643-2 . "0x2121") . ("0xC940" . "0xC949"))
 213          (?\e$(GDB\e(B . "0xC94A");; duplicates to "0xA461"
 214          ((chinese-cns11643-2 . "0x212B") . ("0xC94B" . "0xC96B"))
 215          ((chinese-cns11643-2 . "0x214D") . ("0xC96C" . "0xC9BD"))
 216          (?\e$(H!L\e(B . "0xC9BE")
 217          ((chinese-cns11643-2 . "0x217D") . ("0xC9BF" . "0xC9EC"))
 218          ((chinese-cns11643-2 . "0x224E") . ("0xC9ED" . "0xCAF6"))
 219          (?\e$(H"M\e(B . "0xCAF7")
 220          ((chinese-cns11643-2 . "0x2439") . ("0xCAF8" . "0xD6CB"))
 221          (?\e$(H>c\e(B . "0xD6CC")
 222          ((chinese-cns11643-2 . "0x3770") . ("0xD6CD" . "0xD779"))
 223          (?\e$(H?j\e(B . "0xD77A")
 224          ((chinese-cns11643-2 . "0x387E") . ("0xD77B" . "0xDADE"))
 225          (?\e$(H7o\e(B . "0xDADF")
 226          ((chinese-cns11643-2 . "0x3E64") . ("0xDAE0" . "0xDBA6"))
 227          ((chinese-cns11643-2 . "0x3F6B") . ("0xDBA7" . "0xDDFB"))
 228          (?\e$(HAv\e(B . "0xDDFC");; duplicates to "0xDCD1"
 229          ((chinese-cns11643-2 . "0x4424") . ("0xDDFD" . "0xE8A2"))
 230          ((chinese-cns11643-2 . "0x554C") . ("0xE8A3" . "0xE975"))
 231          ((chinese-cns11643-2 . "0x5723") . ("0xE976" . "0xEB5A"))
 232          ((chinese-cns11643-2 . "0x5A29") . ("0xEB5B" . "0xEBF0"))
 233          (?\e$(HUK\e(B . "0xEBF1")
 234          ((chinese-cns11643-2 . "0x5B3F") . ("0xEBF2" . "0xECDD"))
 235          (?\e$(HW"\e(B . "0xECDE")
 236          ((chinese-cns11643-2 . "0x5C6A") . ("0xECDF" . "0xEDA9"))
 237          ((chinese-cns11643-2 . "0x5D75") . ("0xEDAA" . "0xEEEA"))
 238          (?\e$(Hd/\e(B . "0xEEEB")
 239          ((chinese-cns11643-2 . "0x6039") . ("0xEEEC" . "0xF055"))
 240          (?\e$(H]t\e(B . "0xF056")
 241          ((chinese-cns11643-2 . "0x6243") . ("0xF057" . "0xF0CA"))
 242          (?\e$(HZ(\e(B . "0xF0CB")
 243          ((chinese-cns11643-2 . "0x6337") . ("0xF0CC" . "0xF162"))
 244          ((chinese-cns11643-2 . "0x6430") . ("0xF163" . "0xF16A"))
 245          (?\e$(Hga\e(B . "0xF16B")
 246          ((chinese-cns11643-2 . "0x6438") . ("0xF16C" . "0xF267"))
 247          (?\e$(Hi4\e(B . "0xF268")
 248          ((chinese-cns11643-2 . "0x6573") . ("0xF269" . "0xF2C2"))
 249          ((chinese-cns11643-2 . "0x664E") . ("0xF2C3" . "0xF374"))
 250          ((chinese-cns11643-2 . "0x6762") . ("0xF375" . "0xF465"))
 251          ((chinese-cns11643-2 . "0x6935") . ("0xF466" . "0xF4B4"))
 252          (?\e$(HfM\e(B . "0xF4B5")
 253          ((chinese-cns11643-2 . "0x6962") . ("0xF4B6" . "0xF4FC"))
 254          ((chinese-cns11643-2 . "0x6A4C") . ("0xF4FD" . "0xF662"))
 255          (?\e$(HjK\e(B . "0xF663")
 256          ((chinese-cns11643-2 . "0x6C52") . ("0xF664" . "0xF976"))
 257          ((chinese-cns11643-2 . "0x7167") . ("0xF977" . "0xF9C3"))
 258          (?\e$(Hqf\e(B . "0xF9C4")
 259          (?\e$(Hr4\e(B . "0xF9C5")
 260          (?\e$(Hr@\e(B . "0xF9C6")
 261          ((chinese-cns11643-2 . "0x7235") . ("0xF9C7" . "0xF9D1"))
 262          ((chinese-cns11643-2 . "0x7241") . ("0xF9D2" . "0xF9D5"))
 263
 264          ;; Additional Ideographs
 265          (?\e$(IC7\e(B . "0xF9D6")
 266          (?\e$(IOP\e(B . "0xF9D7")
 267          (?\e$(IDN\e(B . "0xF9D8")
 268          (?\e$(IPJ\e(B . "0xF9D9")
 269          (?\e$(I,]\e(B . "0xF9DA")
 270          (?\e$(I=~\e(B . "0xF9DB")
 271          (?\e$(IK\\e(B . "0xF9DC")
 272          ))
 273      '((all . invalid))
 274      )))
 275
 276 (provide 'big5conv)
 277