cgit.sxemacs.org Git - packages/blob - mule-packages/mule-ucs/lisp/jisx0213/x0213-sjis.el

   1 ;;; x0213-sjis.el --- Shift-JIS encoder and decoder for JIS X 0213.
   2
   3 ;; Copyright (C) 2000 Miyashita Hisashi
   4
   5 ;; Keywords: mule, multilingual,
   6 ;;           character set, coding-system, JIS X 0213
   7 ;;           Shift-JIS
   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 (require 'mucs)
  27 (require 'x0213-cdef)
  28
  29 ;;; In JIS X 0213 plain 2, mapping between row and SJIS S1.
  30 ;; row 1 -> F0
  31 ;; row 3 -> F1
  32 ;; row 4 -> F1
  33 ;; row 5 -> F2
  34 ;; row 8 -> F0
  35 ;; row 12 -> F2
  36 ;; row 13 -> F3
  37 ;; row 14 -> F3
  38 ;; row 15 -> F4
  39 ;; row 78 -> F4
  40 ;; row 79 -> F5
  41 ;; row 80 -> F5
  42 ;; row 81 -> F6
  43 ;; row 82 -> F6
  44 ;; row 83 -> F7
  45 ;; row 84 -> F7
  46 ;; row 85 -> F8
  47 ;; row 86 -> F8
  48 ;; row 87 -> F9
  49 ;; row 88 -> F9
  50 ;; row 89 -> FA
  51 ;; row 90 -> FA
  52 ;; row 91 -> FB
  53 ;; row 92 -> FB
  54 ;; row 93 -> FC
  55 ;; row 94 -> FC
  56
  57 (mucs-define-type
  58  'char-2
  59  'identity
  60  'identity)
  61
  62 (mucs-type-register-serialization
  63  'char-2
  64  'emacs-mule
  65  '(quote (((write-multibyte-character r1 r0))))
  66  '(quote (((read-multibyte-character r1 r0)))))
  67
  68 (defun mucs-ccl-write-char-2-dos ()
  69   `((if (r0 == ?\x0d)
  70         ((if ,(mucs-ccl-check-internal-state 'previous-cr-p)
  71              ((write ?\x0d))
  72            ,(mucs-ccl-set-internal-state 'previous-cr-p t)))
  73       ((r4 = (r0 != ?\x0a))
  74        (if (,(mucs-ccl-check-internal-state 'previous-cr-p) & r4)
  75            ((write ?\x0d)))
  76        ,@(mucs-ccl-set-internal-state 'previous-cr-p nil)
  77        (write-multibyte-character r1 r0)))))
  78
  79 (mucs-type-register-serialization
  80  'char-2
  81  'emacs-mule-dos
  82  (quote `(,(mucs-ccl-write-char-2-dos)))
  83  'none)
  84
  85 (defvar jisx0213-shift-jis-plain-2-encode-table
  86   (let ((result (make-vector 128 0))
  87         (alist '((1 . ?\xF0) (3 . ?\xF1) (4 . ?\xF1) (5 . ?\xF2) (8 . ?\xF0)
  88                  (12 . ?\xF2) (13 . ?\xF3) (14 . ?\xF3) (15 . ?\xF4)
  89                  (78 . ?\xF4) (79 . ?\xF5) (80 . ?\xF5) (81 . ?\xF6)
  90                  (82 . ?\xF6) (83 . ?\xF7) (84 . ?\xF7) (85 . ?\xF8)
  91                  (86 . ?\xF8) (87 . ?\xF9) (88 . ?\xF9) (89 . ?\xFA)
  92                  (90 . ?\xFA) (91 . ?\xFB) (92 . ?\xFB) (93 . ?\xFC)
  93                  (94 . ?\xFC)))
  94         (i 0) elem)
  95     (while alist
  96       (setq elem (car alist)
  97             alist (cdr alist)
  98             i (+ (car elem) 32))
  99       (aset result i (cdr elem)))
 100     result))
 101
 102 (defun mucs-ccl-char-2-write-shift-jisx0213-char (dosp)
 103   `((if (r1 == ,(charset-id 'ascii))
 104        ,(if dosp
 105             '((if (r0 == ?\x0A)
 106                   ((write "\x0d\x0a"))
 107                 ((write r0))))
 108           '((write r0)))
 109      ((if (r1 == ,(charset-id 'japanese-jisx0213-1))
 110           ((r1 = (r0 >> 7))
 111            (r0 &= ?\x7F)
 112            (r0 = (r1 en-sjis r0))
 113            (write r0 r7))
 114         ((if (r1 == ,(charset-id 'japanese-jisx0213-2))
 115              ((r1 = (r0 >> 7))
 116               (r0 &= ?\x7F)
 117               (r0 = (r1 en-sjis r0))
 118               (r0 = r1 ,jisx0213-shift-jis-plain-2-encode-table)
 119               (write r0 r7))
 120            ;;; katakana-jisx0201
 121            ((write (r0 + ,(- ?\xA1 33)))))))))))
 122
 123 (defun mucs-ccl-char-2-read-shift-jisx0213-char ()
 124   `((r1 = 0)
 125     (read-if (r0 >= ?\x81)
 126       ((r1 = (r0 <= ?\x9F))
 127        (r1 |= (r0 >= ?\xE0))
 128        (if r1
 129            ((read r1)
 130             (if (r0 >= ?\xF0)
 131                 ;; JIS X 0213 plain 2
 132                 ((r4 = (r0 de-sjis r1))
 133                  (r4 = r7)
 134                  (if (r1 >= ?\x9F)
 135                      ((map-single r7 r0
 136                                   jisx0213-shift-jis-plain-2-even-decode-map))
 137                    ((map-single r7 r0
 138                                 jisx0213-shift-jis-plain-2-odd-decode-map)))
 139                  (r0 <<= 7) (r0 += r4)
 140                  (r1 = ,(charset-id 'japanese-jisx0213-2)))
 141               ;; JIS X 0213 plain 1.
 142               ((r1 = (r0 de-sjis r1))
 143                (r0 = (r1 << 7)) (r0 += r7)
 144                (r1 = ,(charset-id 'japanese-jisx0213-1)))))
 145          ((r1 = ,(charset-id 'katakana-jisx0201))
 146           (r0 -= ,(- ?\xA1 33))))))))
 147
 148 (mucs-type-register-serialization
 149  'char-2
 150  'shift-jis
 151  (quote `(,(mucs-ccl-char-2-write-shift-jisx0213-char nil)))
 152  (quote `(,(mucs-ccl-char-2-read-shift-jisx0213-char))))
 153
 154 (mucs-type-register-serialization
 155  'char-2
 156  'shift-jis-dos
 157  (quote `(,(mucs-ccl-char-2-write-shift-jisx0213-char t)))
 158  'none)
 159
 160 (provide 'x0213-sjis)