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

   1 ;;; -*- coding: iso-2022-7bit  -*-
   2 ;;; big5type.el --- conversion between Big5 and Emacs representation(Mainly CNS)
   3
   4 ;; Copyright (C) 1999 Miyashita Hisashi
   5
   6 ;; Keywords: mule, multilingual,
   7 ;;           MULE-UCS, Big5, CNS, Traditional Chinese
   8
   9 ;; This file is part of MULE-UCS
  10
  11 ;; MULE-UCS is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; MULE-UCS is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with this program; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;; Comment:
  27 ;;   This module provides type definition on big5conv.
  28
  29 (require 'mucs)
  30
  31 (mucs-define-type
  32  'big5
  33  'identity
  34  'identity)
  35
  36 (mucs-type-register-serialization
  37  'big5
  38  'big5-be-2-octet
  39  '(quote
  40    (((if (r0 > ?\xA0)
  41          ((r0 = (r0 >8 0))
  42           (write r0 r7))
  43        ((write r0))))))
  44  '(quote
  45    (((read-if (r0 > ?\xA0)
  46               ((read r7)
  47                (r0 = (r0 <8 r7))))))))
  48
  49 (mucs-type-register-serialization
  50  'big5
  51  'big5-be-2-octet-dos
  52  '(quote
  53    (((if (r0 == ?\x0a)
  54          ((write "\x0d\x0a"))
  55        ((if (r0 > ?\xA0)
  56             ((r0 = (r0 >8 0))
  57              (write r0 r7))
  58           ((write r0))))))))
  59  'none)
  60
  61 (defvar char-1-big5-1-first-code
  62   (funcall (mucs-type-get-ccl-representation
  63             'char-1)
  64            (make-char 'chinese-big5-1 33 33)))
  65 (defvar char-1-big5-2-first-code
  66   (funcall (mucs-type-get-ccl-representation
  67             'char-1)
  68            (make-char 'chinese-big5-2 33 33)))
  69 (defvar big5-same-row (+ (- ?\x7F ?\x40)
  70                          (- ?\xFF ?\xA1)))
  71
  72 (defun mucs-ccl-char-1-write-big5-char (dosp)
  73   `((if (r0 <= ?\xFF)
  74         ,(if dosp
  75              '((if (r0 == ?\x0A)
  76                    ((write "\x0d\x0a"))
  77                  ((write r0))))
  78            '((write r0)))
  79       ((if (r0 < ,char-1-big5-2-first-code)
  80            ((r0 -= ,char-1-big5-1-first-code)
  81             (r0 -= ((r0 / 96) * 2))
  82             (write ((r0 / ,big5-same-row) + ?\xA1)))
  83          ((r0 -= ,char-1-big5-2-first-code)
  84           (r0 -= ((r0 / 96) * 2))
  85           (write ((r0 / ,big5-same-row) + ?\xC9))))
  86        (r0 %= ,big5-same-row)
  87        (if (r0 < ?\x3F)
  88            (write (r0 + ?\x40))
  89          (write (r0 + ?\x62)))))))
  90
  91 (defun mucs-ccl-char-1-read-big5-char ()
  92   `((read-if (r0 >= ?\xA1)
  93       ((read-if (r1 < ?\x7F)
  94           ((r1 -= ?\x40))
  95          ((r1 -= ?\x62)))
  96        (if (r0 < ?\xC9)
  97            ((r4 = (((r0 - ?\xA1) * ,big5-same-row) + r1))
  98             (r4 += ((r4 / 94) * 2))
  99             (r0 = (r4 + ,char-1-big5-1-first-code)))
 100          ((r4 = (((r0 - ?\xC9) * ,big5-same-row) + r1))
 101           (r4 += ((r4 / 94) * 2))
 102           (r0 = (r4 + ,char-1-big5-2-first-code))))))))
 103
 104 (mucs-type-register-serialization
 105  'char-1
 106  'big5-char
 107  (quote
 108   `(,(mucs-ccl-char-1-write-big5-char nil)))
 109  (quote
 110   `(,(mucs-ccl-char-1-read-big5-char))))
 111
 112 (mucs-type-register-serialization
 113  'char-1
 114  'big5-char-dos
 115  (quote
 116   `(,(mucs-ccl-char-1-write-big5-char t)))
 117  'none)
 118
 119 (provide 'big5type)
 120
 121