lisp/language/chinese.el

   1 ;;; chinese.el --- support for Chinese -*- coding: iso-2022-7bit; -*-
   2
   3 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
   4 ;; Licensed to the Free Software Foundation.
   5
   6 ;; Keywords: multilingual, Chinese
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it 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 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; For Chinese, three character sets GB2312, BIG5, and CNS11643 are
  28 ;; supported.
  29
  30 ;;; Code:
  31
  32 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  33 ;;; Chinese (general)
  34 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  35
  36 (make-coding-system
  37  'iso-2022-cn 2 ?C
  38  "ISO 2022 based 7bit encoding for Chinese GB and CNS (MIME:ISO-2022-CN)."
  39  '(ascii
  40    (nil chinese-gb2312 chinese-cns11643-1)
  41    (nil chinese-cns11643-2)
  42    nil
  43    nil ascii-eol ascii-cntl seven locking-shift single-shift nil nil nil
  44    init-bol)
  45  '((safe-charsets ascii chinese-gb2312 chinese-cns11643-1 chinese-cns11643-2)
  46    (mime-charset . iso-2022-cn)))
  47
  48 (define-coding-system-alias 'chinese-iso-7bit 'iso-2022-cn)
  49
  50 (make-coding-system
  51  'iso-2022-cn-ext 2 ?C
  52  "ISO 2022 based 7bit encoding for Chinese GB and CNS (MIME:ISO-2022-CN-EXT)."
  53  '(ascii
  54    (nil chinese-gb2312 chinese-cns11643-1)
  55    (nil chinese-cns11643-2)
  56    (nil chinese-cns11643-3 chinese-cns11643-4 chinese-cns11643-5
  57         chinese-cns11643-6 chinese-cns11643-7)
  58    nil ascii-eol ascii-cntl seven locking-shift single-shift nil nil nil
  59    init-bol)
  60  '((safe-charsets ascii chinese-gb2312 chinese-cns11643-1 chinese-cns11643-2
  61                   chinese-cns11643-3 chinese-cns11643-4 chinese-cns11643-5
  62                   chinese-cns11643-6 chinese-cns11643-7)
  63    (mime-charset . iso-2022-cn-ext)))
  64
  65 \f
  66 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  67 ;;; Chinese GB2312 (simplified)
  68 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  69
  70 (make-coding-system
  71  'chinese-iso-8bit 2 ?c
  72  "ISO 2022 based EUC encoding for Chinese GB2312 (MIME:GB2312)."
  73  '(ascii chinese-gb2312 nil nil
  74    nil ascii-eol ascii-cntl nil nil nil nil)
  75  '((safe-charsets ascii chinese-gb2312)
  76    (mime-charset . gb2312)))
  77
  78 (define-coding-system-alias 'cn-gb-2312 'chinese-iso-8bit)
  79 (define-coding-system-alias 'euc-china 'chinese-iso-8bit)
  80 (define-coding-system-alias 'euc-cn 'chinese-iso-8bit)
  81 (define-coding-system-alias 'cn-gb 'chinese-iso-8bit)
  82 (define-coding-system-alias 'gb2312 'chinese-iso-8bit)
  83
  84 (make-coding-system
  85  'chinese-hz 0 ?z
  86  "Hz/ZW 7-bit encoding for Chinese GB2312 (MIME:HZ-GB-2312)."
  87  nil
  88  '((safe-charsets ascii chinese-gb2312)
  89    (mime-charset . hz-gb-2312)
  90    (post-read-conversion . post-read-decode-hz)
  91    (pre-write-conversion . pre-write-encode-hz)))
  92
  93 (define-coding-system-alias 'hz-gb-2312 'chinese-hz)
  94 (define-coding-system-alias 'hz 'chinese-hz)
  95
  96 (defun post-read-decode-hz (len)
  97   (let ((pos (point))
  98         (buffer-modified-p (buffer-modified-p))
  99         last-coding-system-used)
 100     (prog1
 101         (decode-hz-region pos (+ pos len))
 102       (set-buffer-modified-p buffer-modified-p))))
 103
 104 (defun pre-write-encode-hz (from to)
 105   (let ((buf (current-buffer)))
 106     (set-buffer (generate-new-buffer " *temp*"))
 107     (if (stringp from)
 108         (insert from)
 109       (insert-buffer-substring buf from to))
 110     (let (last-coding-system-used)
 111       (encode-hz-region 1 (point-max)))
 112     nil))
 113
 114 (set-language-info-alist
 115  "Chinese-GB" '((charset chinese-gb2312 chinese-sisheng)
 116                 (coding-system chinese-iso-8bit iso-2022-cn chinese-hz)
 117                 (coding-priority chinese-iso-8bit chinese-big5 iso-2022-cn)
 118                 (input-method . "chinese-py-punct")
 119                 (features china-util)
 120                 (sample-text . "Chinese (\e$AVPND\e(B,\e$AFUM(;0\e(B,\e$A::So\e(B)    \e$ADc:C\e(B")
 121                 (documentation . "Support for Chinese GB2312 character set.")
 122                 (tutorial . "TUTORIAL.cn"))
 123  '("Chinese"))
 124
 125 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 126 ;; Chinese BIG5 (traditional)
 127 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 128
 129 (make-coding-system
 130  'chinese-big5 3 ?B
 131  "BIG5 8-bit encoding for Chinese (MIME:Big5)."
 132  nil
 133  '((safe-charsets ascii chinese-big5-1 chinese-big5-2)
 134    (mime-charset . big5)
 135    (charset-origin-alist (chinese-big5-1  "BIG5" encode-big5-char)
 136                          (chinese-big5-2  "BIG5" encode-big5-char))))
 137
 138 (define-coding-system-alias 'big5 'chinese-big5)
 139 (define-coding-system-alias 'cn-big5 'chinese-big5)
 140
 141 ;; Big5 font requires special encoding.
 142 (define-ccl-program ccl-encode-big5-font
 143   `(0
 144     ;; In:  R0:chinese-big5-1 or chinese-big5-2
 145     ;;      R1:position code 1
 146     ;;      R2:position code 2
 147     ;; Out: R1:font code point 1
 148     ;;      R2:font code point 2
 149     ((r2 = ((((r1 - ?\x21) * 94) + r2) - ?\x21))
 150      (if (r0 == ,(charset-id 'chinese-big5-2)) (r2 += 6280))
 151      (r1 = ((r2 / 157) + ?\xA1))
 152      (r2 %= 157)
 153      (if (r2 < ?\x3F) (r2 += ?\x40) (r2 += ?\x62))))
 154   "CCL program to encode a Big5 code to code point of Big5 font.")
 155
 156 (setq font-ccl-encoder-alist
 157       (cons (cons "big5" ccl-encode-big5-font) font-ccl-encoder-alist))
 158
 159 (set-language-info-alist
 160  "Chinese-BIG5" '((charset chinese-big5-1 chinese-big5-2)
 161                   (coding-system chinese-big5 chinese-iso-7bit)
 162                   (coding-priority chinese-big5 iso-2022-cn chinese-iso-8bit)
 163                   (input-method . "chinese-py-punct-b5")
 164                   (features china-util)
 165                   (sample-text . "Cantonese (\e$(0GnM$\e(B,\e$(0N]0*Hd\e(B) \e$(0*/=(\e(B, \e$(0+$)p\e(B")
 166                   (documentation . "Support for Chinese Big5 character set.")
 167                   (tutorial . "TUTORIAL.zh"))
 168  '("Chinese"))
 169
 170 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 171 ;; Chinese CNS11643 (traditional)
 172 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 173
 174 (defvar big5-to-cns (make-translation-table)
 175   "Translation table for encoding to `euc-tw'.")
 176 ;; Could have been done by china-util loaded before.
 177 (unless (get 'big5-to-cns 'translation-table)
 178   (define-translation-table 'big5-to-cns big5-to-cns))
 179
 180 (define-ccl-program ccl-decode-euc-tw
 181   ;; CNS plane 1 needs either two or four bytes in EUC-TW encoding;
 182   ;; CNS planes 2 to 7 always need four bytes.  In internal encoding of
 183   ;; Emacs, CNS planes 1 and 2 need three bytes, and planes 3 to 7 need
 184   ;; four bytes.  Thus a buffer magnification value of 2 (for both
 185   ;; encoding and decoding) is sufficient.
 186   `(2
 187     ;; we don't have enough registers to hold all charset-ids
 188     ((r4 = ,(charset-id 'chinese-cns11643-1))
 189      (r5 = ,(charset-id 'chinese-cns11643-2))
 190      (r6 = ,(charset-id 'chinese-cns11643-3))
 191      (loop
 192       (read-if (r0 < #x80)
 193           ;; ASCII
 194           (write-repeat r0)
 195         ;; not ASCII
 196         (if (r0 == #x8E)
 197             ;; single shift
 198             (read-if (r1 < #xA1)
 199                 ;; invalid byte
 200                 ((write r0)
 201                  (write-repeat r1))
 202               (if (r1 > #xA7)
 203                   ;; invalid plane
 204                   ((write r0)
 205                    (write-repeat r1))
 206                 ;; OK, we have a plane
 207                 (read-if (r2 < #xA1)
 208                     ;; invalid first byte
 209                     ((write r0 r1)
 210                      (write-repeat r2))
 211                   (read-if (r3 < #xA1)
 212                       ;; invalid second byte
 213                       ((write r0 r1 r2)
 214                        (write-repeat r3))
 215                     ;; CNS 1-7, finally
 216                     ((branch (r1 - #xA1)
 217                       (r1 = r4)
 218                       (r1 = r5)
 219                       (r1 = r6)
 220                       (r1 = ,(charset-id 'chinese-cns11643-4))
 221                       (r1 = ,(charset-id 'chinese-cns11643-5))
 222                       (r1 = ,(charset-id 'chinese-cns11643-6))
 223                       (r1 = ,(charset-id 'chinese-cns11643-7)))
 224                      (r2 = ((((r2 - #x80) << 7) + r3) - #x80))
 225                      (write-multibyte-character r1 r2)
 226                      (repeat))))))
 227           ;; standard EUC
 228           (if (r0 < #xA1)
 229               ;; invalid first byte
 230               (write-repeat r0)
 231             (read-if (r1 < #xA1)
 232                 ;; invalid second byte
 233                 ((write r0)
 234                  (write-repeat r1))
 235               ;; CNS 1, finally
 236               ((r1 = ((((r0 - #x80) << 7) + r1) - #x80))
 237                (write-multibyte-character r4 r1)
 238                (repeat)))))))))
 239   "CCL program to decode EUC-TW encoding."
 240 )
 241
 242 (define-ccl-program ccl-encode-euc-tw
 243   `(2
 244     ;; we don't have enough registers to hold all charset-ids
 245     ((r2 = ,(charset-id 'ascii))
 246      (r3 = ,(charset-id 'chinese-big5-1))
 247      (r4 = ,(charset-id 'chinese-big5-2))
 248      (r5 = ,(charset-id 'chinese-cns11643-1))
 249      (r6 = ,(charset-id 'chinese-cns11643-2))
 250      (loop
 251       (read-multibyte-character r0 r1)
 252       (if (r0 == r2)
 253           (write-repeat r1)
 254         (;; Big 5 encoded characters are first translated to CNS
 255          (if (r0 == r3)
 256              (translate-character big5-to-cns r0 r1)
 257            (if (r0 == r4)
 258                (translate-character big5-to-cns r0 r1)))
 259          (if (r0 == r5)
 260              (r0 = #xA1)
 261            (if (r0 == r6)
 262                (r0 = #xA2)
 263              (if (r0 == ,(charset-id 'chinese-cns11643-3))
 264                  (r0 = #xA3)
 265                (if (r0 == ,(charset-id 'chinese-cns11643-4))
 266                    (r0 = #xA4)
 267                  (if (r0 == ,(charset-id 'chinese-cns11643-5))
 268                      (r0 = #xA5)
 269                    (if (r0 == ,(charset-id 'chinese-cns11643-6))
 270                        (r0 = #xA6)
 271                      (if (r0 == ,(charset-id 'chinese-cns11643-7))
 272                          (r0 = #xA7)
 273                        ;; not CNS.  We use a dummy character which
 274                        ;; can't occur in EUC-TW encoding to indicate
 275                        ;; this.
 276                        (write-repeat #xFF))))))))))
 277       (if (r0 != #xA1)
 278           ;; single shift and CNS plane
 279           ((write #x8E)
 280            (write r0)))
 281       (write ((r1 >> 7) + #x80))
 282       (write ((r1 % #x80) + #x80))
 283       (repeat))))
 284   "CCL program to encode EUC-TW encoding."
 285 )
 286
 287 (defun euc-tw-pre-write-conversion (beg end)
 288   "Semi-dummy pre-write function effectively to autoload china-util."
 289   ;; Ensure translation table is loaded.
 290   (require 'china-util)
 291   ;; Don't do this again.
 292   (coding-system-put 'euc-tw 'pre-write-conversion nil)
 293   nil)
 294
 295 (make-coding-system
 296   'euc-tw 4 ?Z
 297   "ISO 2022 based EUC encoding for Chinese CNS11643.
 298 Big5 encoding is accepted for input also (which is then converted to CNS)."
 299   '(ccl-decode-euc-tw . ccl-encode-euc-tw)
 300   '((safe-charsets ascii
 301                    chinese-big5-1
 302                    chinese-big5-2
 303                    chinese-cns11643-1
 304                    chinese-cns11643-2
 305                    chinese-cns11643-3
 306                    chinese-cns11643-4
 307                    chinese-cns11643-5
 308                    chinese-cns11643-6
 309                    chinese-cns11643-7)
 310     (valid-codes (0 . 255))
 311     (pre-write-conversion . euc-tw-pre-write-conversion)))
 312
 313 (define-coding-system-alias 'euc-taiwan 'euc-tw)
 314
 315 (set-language-info-alist
 316  "Chinese-CNS" '((charset chinese-cns11643-1 chinese-cns11643-2
 317                           chinese-cns11643-3 chinese-cns11643-4
 318                           chinese-cns11643-5 chinese-cns11643-6
 319                           chinese-cns11643-7)
 320                  (coding-system iso-2022-cn euc-tw)
 321                  (coding-priority iso-2022-cn euc-tw chinese-big5
 322                                   chinese-iso-8bit)
 323                  (features china-util)
 324                  (input-method . "chinese-cns-quick")
 325                  (documentation . "\
 326 Support for Chinese CNS character sets.  Note that the EUC-TW coding system
 327 accepts Big5 for input also (which is then converted to CNS)."))
 328  '("Chinese"))
 329
 330 (set-language-info-alist
 331  "Chinese-EUC-TW" '((charset chinese-cns11643-1 chinese-cns11643-2
 332                              chinese-cns11643-3 chinese-cns11643-4
 333                              chinese-cns11643-5 chinese-cns11643-6
 334                              chinese-cns11643-7 chinese-big5-1 chinese-big5-2)
 335                     (coding-system euc-tw iso-2022-cn)
 336                     (coding-priority euc-tw chinese-big5 iso-2022-cn
 337                                      chinese-iso-8bit)
 338                     (features china-util)
 339                     (input-method . "chinese-cns-quick")
 340                     (documentation . "\
 341 Support for Chinese, prefering the EUC-TW character set.  Note that
 342 the EUC-TW coding system accepts Big5 for input also (which is then
 343 converted to CNS)."))
 344  '("Chinese"))
 345
 346 (provide 'chinese)
 347
 348 ;;; arch-tag: b82fcf7a-84f6-4e0b-b38c-1742dac0e09f
 349 ;;; chinese.el ends here