/[emacs]/emacs/lisp/language/chinese.el
ViewVC logotype

Diff of /emacs/lisp/language/chinese.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.27 by lektu, Tue Feb 4 13:11:50 2003 UTC revision 1.27.6.1 by handa, Mon Sep 8 12:53:41 2003 UTC
# Line 1  Line 1 
1  ;;; chinese.el --- support for Chinese -*- coding: iso-2022-7bit; -*-  ;;; chinese.el --- support for Chinese -*- coding: iso-2022-7bit; -*-
2    
3  ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.  ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
4  ;; Licensed to the Free Software Foundation.  ;;   Licensed to the Free Software Foundation.
5    ;; Copyright (C) 2003
6    ;;   National Institute of Advanced Industrial Science and Technology (AIST)
7    ;;   Registration Number H13PRO009
8    
9  ;; Keywords: multilingual, Chinese  ;; Keywords: multilingual, Chinese
10    
# Line 33  Line 36 
36  ;;; Chinese (general)  ;;; Chinese (general)
37  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
38    
39  (make-coding-system  
40   'iso-2022-cn 2 ?C  (define-coding-system 'iso-2022-cn
41   "ISO 2022 based 7bit encoding for Chinese GB and CNS (MIME:ISO-2022-CN)."    "ISO 2022 based 7bit encoding for Chinese GB and CNS (MIME:ISO-2022-CN)."
42   '(ascii    :coding-type 'iso-2022
43     (nil chinese-gb2312 chinese-cns11643-1)    :mnemonic ?C
44     (nil chinese-cns11643-2)    :charset-list '(ascii chinese-gb2312 chinese-cns11643-1 chinese-cns11643-2)
45     nil    :designation [ascii
46     nil ascii-eol ascii-cntl seven locking-shift single-shift nil nil nil                  (nil chinese-gb2312 chinese-cns11643-1)
47     init-bol)                  (nil chinese-cns11643-2)
48   '((safe-charsets ascii chinese-gb2312 chinese-cns11643-1 chinese-cns11643-2)                  nil]
49     (mime-charset . iso-2022-cn)))    :flags '(ascii-at-eol ascii-at-cntl 7-bit
50                            designation locking-shift single-shift init-at-bol)
51      :mime-charset 'iso-2022-cn)
52    
53  (define-coding-system-alias 'chinese-iso-7bit 'iso-2022-cn)  (define-coding-system-alias 'chinese-iso-7bit 'iso-2022-cn)
54    
55  (make-coding-system  (define-coding-system 'iso-2022-cn-ext
56   'iso-2022-cn-ext 2 ?C    "ISO 2022 based 7bit encoding for Chinese GB and CNS (MIME:ISO-2022-CN-EXT)."
57   "ISO 2022 based 7bit encoding for Chinese GB and CNS (MIME:ISO-2022-CN-EXT)."    :coding-type 'iso-2022
58   '(ascii    :mnemonic ?C
59     (nil chinese-gb2312 chinese-cns11643-1)    :charset-list '(ascii
60     (nil chinese-cns11643-2)                    chinese-gb2312 chinese-cns11643-1
61     (nil chinese-cns11643-3 chinese-cns11643-4 chinese-cns11643-5                    chinese-cns11643-2 chinese-cns11643-3 chinese-cns11643-4
62          chinese-cns11643-6 chinese-cns11643-7)                    chinese-cns11643-5 chinese-cns11643-6 chinese-cns11643-7)
63     nil ascii-eol ascii-cntl seven locking-shift single-shift nil nil nil    :designation '[ascii
64     init-bol)                   (nil chinese-gb2312 chinese-cns11643-1)
65   '((safe-charsets ascii chinese-gb2312 chinese-cns11643-1 chinese-cns11643-2                   (nil chinese-cns11643-2)
66                    chinese-cns11643-3 chinese-cns11643-4 chinese-cns11643-5                   (nil chinese-cns11643-3 chinese-cns11643-4 chinese-cns11643-5
67                    chinese-cns11643-6 chinese-cns11643-7)                        chinese-cns11643-6 chinese-cns11643-7)]
68     (mime-charset . iso-2022-cn-ext)))    :flags '(ascii-at-eol ascii-at-cntl 7-bit
69                            designation locking-shift single-shift init-at-bol)
70      :mime-charset 'iso-2022-cn-ext)
71    
72    
73  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
74  ;;; Chinese GB2312 (simplified)  ;;; Chinese GB2312 (simplified)
75  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
76    
77  (make-coding-system  (define-coding-system 'chinese-iso-8bit
78   'chinese-iso-8bit 2 ?c    "ISO 2022 based EUC encoding for Chinese GB2312 (MIME:CN-GB)."
79   "ISO 2022 based EUC encoding for Chinese GB2312 (MIME:GB2312)."    :coding-type 'iso-2022
80   '(ascii chinese-gb2312 nil nil    :mnemonic ?c
81     nil ascii-eol ascii-cntl nil nil nil nil)    :charset-list '(ascii chinese-gb2312)
82   '((safe-charsets ascii chinese-gb2312)    :designation [ascii chinese-gb2312 nil nil]
83     (mime-charset . gb2312)))    :mime-charset 'cn-gb)
84    
85  (define-coding-system-alias 'cn-gb-2312 'chinese-iso-8bit)  (define-coding-system-alias 'cn-gb-2312 'chinese-iso-8bit)
86  (define-coding-system-alias 'euc-china 'chinese-iso-8bit)  (define-coding-system-alias 'euc-china 'chinese-iso-8bit)
# Line 81  Line 88 
88  (define-coding-system-alias 'cn-gb 'chinese-iso-8bit)  (define-coding-system-alias 'cn-gb 'chinese-iso-8bit)
89  (define-coding-system-alias 'gb2312 'chinese-iso-8bit)  (define-coding-system-alias 'gb2312 'chinese-iso-8bit)
90    
91  (make-coding-system  (define-coding-system 'chinese-hz
92   'chinese-hz 0 ?z    "Hz/ZW 7-bit encoding for Chinese GB2312 (MIME:HZ-GB-2312)."
93   "Hz/ZW 7-bit encoding for Chinese GB2312 (MIME:HZ-GB-2312)."    :coding-type 'utf-8
94   nil    :mnemonic ?z
95   '((safe-charsets ascii chinese-gb2312)    :charset-list '(ascii chinese-gb2312)
96     (mime-charset . hz-gb-2312)    :mime-charset 'hz-gb-2312
97     (post-read-conversion . post-read-decode-hz)    :post-read-conversion 'post-read-decode-hz
98     (pre-write-conversion . pre-write-encode-hz)))    :pre-write-conversion 'pre-write-encode-hz)
99    
100  (define-coding-system-alias 'hz-gb-2312 'chinese-hz)  (define-coding-system-alias 'hz-gb-2312 'chinese-hz)
101  (define-coding-system-alias 'hz 'chinese-hz)  (define-coding-system-alias 'hz 'chinese-hz)
102    
 (defun post-read-decode-hz (len)  
   (let ((pos (point))  
         (buffer-modified-p (buffer-modified-p))  
         last-coding-system-used)  
     (prog1  
         (decode-hz-region pos (+ pos len))  
       (set-buffer-modified-p buffer-modified-p))))  
   
 (defun pre-write-encode-hz (from to)  
   (let ((buf (current-buffer)))  
     (set-buffer (generate-new-buffer " *temp*"))  
     (if (stringp from)  
         (insert from)  
       (insert-buffer-substring buf from to))  
     (let (last-coding-system-used)  
       (encode-hz-region 1 (point-max)))  
     nil))  
   
103  (set-language-info-alist  (set-language-info-alist
104   "Chinese-GB" '((charset chinese-gb2312 chinese-sisheng)   "Chinese-GB" '((charset chinese-gb2312 chinese-sisheng)
105                  (coding-system chinese-iso-8bit iso-2022-cn chinese-hz)                  (coding-system chinese-iso-8bit iso-2022-cn chinese-hz)
# Line 125  Line 114 
114  ;; Chinese BIG5 (traditional)  ;; Chinese BIG5 (traditional)
115  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
116    
117  (make-coding-system  (define-coding-system 'chinese-big5
118   'chinese-big5 3 ?B    "BIG5 8-bit encoding for Chinese (MIME:Big5)"
119   "BIG5 8-bit encoding for Chinese (MIME:Big5)."    :coding-type 'charset
120   nil    :mnemonic ?B
121   '((safe-charsets ascii chinese-big5-1 chinese-big5-2)    :charset-list '(ascii big5)
122     (mime-charset . big5)    :mime-charset 'big5)
    (charset-origin-alist (chinese-big5-1  "BIG5" encode-big5-char)  
                          (chinese-big5-2  "BIG5" encode-big5-char))))  
123    
124  (define-coding-system-alias 'big5 'chinese-big5)  (define-coding-system-alias 'big5 'chinese-big5)
125  (define-coding-system-alias 'cn-big5 'chinese-big5)  (define-coding-system-alias 'cn-big5 'chinese-big5)
126    
 ;; Big5 font requires special encoding.  
 (define-ccl-program ccl-encode-big5-font  
   `(0  
     ;; In:  R0:chinese-big5-1 or chinese-big5-2  
     ;;      R1:position code 1  
     ;;      R2:position code 2  
     ;; Out: R1:font code point 1  
     ;;      R2:font code point 2  
     ((r2 = ((((r1 - ?\x21) * 94) + r2) - ?\x21))  
      (if (r0 == ,(charset-id 'chinese-big5-2)) (r2 += 6280))  
      (r1 = ((r2 / 157) + ?\xA1))  
      (r2 %= 157)  
      (if (r2 < ?\x3F) (r2 += ?\x40) (r2 += ?\x62))))  
   "CCL program to encode a Big5 code to code point of Big5 font.")  
   
 (setq font-ccl-encoder-alist  
       (cons (cons "big5" ccl-encode-big5-font) font-ccl-encoder-alist))  
   
127  (set-language-info-alist  (set-language-info-alist
128   "Chinese-BIG5" '((charset chinese-big5-1 chinese-big5-2)   "Chinese-BIG5" '((charset chinese-big5-1 chinese-big5-2)
129                    (coding-system chinese-big5 chinese-iso-7bit)                    (coding-system chinese-big5 chinese-iso-7bit)
# Line 165  Line 134 
134                    (documentation . "Support for Chinese Big5 character set."))                    (documentation . "Support for Chinese Big5 character set."))
135   '("Chinese"))   '("Chinese"))
136    
137    (define-coding-system 'chinese-big5-hkscs
138      "BIG5-HKSCS 8-bit encoding for Chinese, Hong Kong supplement (MIME:Big5-HKSCS)"
139      :coding-type 'charset
140      :mnemonic ?B
141      :charset-list '(ascii big5-hkscs)
142      :mime-charset 'big5-hkscs)
143    (define-coding-system-alias 'big5-hkscs 'chinese-big5-hkscs)
144    (define-coding-system-alias 'cn-big5-hkscs 'chinese-big5-hkscs)
145    
146  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
147  ;; Chinese CNS11643 (traditional)  ;; Chinese CNS11643 (traditional)
148  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
149    
150  (defvar big5-to-cns (make-translation-table)  (define-coding-system 'euc-tw
151    "Translation table for encoding to `euc-tw'.")    "ISO 2022 based EUC encoding for Chinese CNS11643."
152  ;; Could have been done by china-util loaded before.    :coding-type 'iso-2022
153  (unless (get 'big5-to-cns 'translation-table)    :mnemonic ?Z
154    (define-translation-table 'big5-to-cns big5-to-cns))    :charset-list '(ascii
155                      chinese-cns11643-1
156  (define-ccl-program ccl-decode-euc-tw                    chinese-cns11643-2
157    ;; CNS plane 1 needs either two or four bytes in EUC-TW encoding;                    chinese-cns11643-3
158    ;; CNS planes 2 to 7 always need four bytes.  In internal encoding of                    chinese-cns11643-4
159    ;; Emacs, CNS planes 1 and 2 need three bytes, and planes 3 to 7 need                    chinese-cns11643-5
160    ;; four bytes.  Thus a buffer magnification value of 2 (for both                    chinese-cns11643-6
161    ;; encoding and decoding) is sufficient.                    chinese-cns11643-7)
162    `(2    :designation [ascii chinese-cns11643-1 (chinese-cns11643-1
163      ;; we don't have enough registers to hold all charset-ids                                            chinese-cns11643-2
164      ((r4 = ,(charset-id 'chinese-cns11643-1))                                            chinese-cns11643-3
165       (r5 = ,(charset-id 'chinese-cns11643-2))                                            chinese-cns11643-4
166       (r6 = ,(charset-id 'chinese-cns11643-3))                                            chinese-cns11643-5
167       (loop                                            chinese-cns11643-6
168        (read-if (r0 < #x80)                                            chinese-cns11643-7) nil]
169            ;; ASCII    :mime-charset 'euc-tw)
           (write-repeat r0)  
         ;; not ASCII  
         (if (r0 == #x8E)  
             ;; single shift  
             (read-if (r1 < #xA1)  
                 ;; invalid byte  
                 ((write r0)  
                  (write-repeat r1))  
               (if (r1 > #xA7)  
                   ;; invalid plane  
                   ((write r0)  
                    (write-repeat r1))  
                 ;; OK, we have a plane  
                 (read-if (r2 < #xA1)  
                     ;; invalid first byte  
                     ((write r0 r1)  
                      (write-repeat r2))  
                   (read-if (r3 < #xA1)  
                       ;; invalid second byte  
                       ((write r0 r1 r2)  
                        (write-repeat r3))  
                     ;; CNS 1-7, finally  
                     ((branch (r1 - #xA1)  
                       (r1 = r4)  
                       (r1 = r5)  
                       (r1 = r6)  
                       (r1 = ,(charset-id 'chinese-cns11643-4))  
                       (r1 = ,(charset-id 'chinese-cns11643-5))  
                       (r1 = ,(charset-id 'chinese-cns11643-6))  
                       (r1 = ,(charset-id 'chinese-cns11643-7)))  
                      (r2 = ((((r2 - #x80) << 7) + r3) - #x80))  
                      (write-multibyte-character r1 r2)  
                      (repeat))))))  
           ;; standard EUC  
           (if (r0 < #xA1)  
               ;; invalid first byte  
               (write-repeat r0)  
             (read-if (r1 < #xA1)  
                 ;; invalid second byte  
                 ((write r0)  
                  (write-repeat r1))  
               ;; CNS 1, finally  
               ((r1 = ((((r0 - #x80) << 7) + r1) - #x80))  
                (write-multibyte-character r4 r1)  
                (repeat)))))))))  
   "CCL program to decode EUC-TW encoding."  
 )  
   
 (define-ccl-program ccl-encode-euc-tw  
   `(2  
     ;; we don't have enough registers to hold all charset-ids  
     ((r2 = ,(charset-id 'ascii))  
      (r3 = ,(charset-id 'chinese-big5-1))  
      (r4 = ,(charset-id 'chinese-big5-2))  
      (r5 = ,(charset-id 'chinese-cns11643-1))  
      (r6 = ,(charset-id 'chinese-cns11643-2))  
      (loop  
       (read-multibyte-character r0 r1)  
       (if (r0 == r2)  
           (write-repeat r1)  
         (;; Big 5 encoded characters are first translated to CNS  
          (if (r0 == r3)  
              (translate-character big5-to-cns r0 r1)  
            (if (r0 == r4)  
                (translate-character big5-to-cns r0 r1)))  
          (if (r0 == r5)  
              (r0 = #xA1)  
            (if (r0 == r6)  
                (r0 = #xA2)  
              (if (r0 == ,(charset-id 'chinese-cns11643-3))  
                  (r0 = #xA3)  
                (if (r0 == ,(charset-id 'chinese-cns11643-4))  
                    (r0 = #xA4)  
                  (if (r0 == ,(charset-id 'chinese-cns11643-5))  
                      (r0 = #xA5)  
                    (if (r0 == ,(charset-id 'chinese-cns11643-6))  
                        (r0 = #xA6)  
                      (if (r0 == ,(charset-id 'chinese-cns11643-7))  
                          (r0 = #xA7)  
                        ;; not CNS.  We use a dummy character which  
                        ;; can't occur in EUC-TW encoding to indicate  
                        ;; this.  
                        (write-repeat #xFF))))))))))  
       (if (r0 != #xA1)  
           ;; single shift and CNS plane  
           ((write #x8E)  
            (write r0)))  
       (write ((r1 >> 7) + #x80))  
       (write ((r1 % #x80) + #x80))  
       (repeat))))  
   "CCL program to encode EUC-TW encoding."  
 )  
   
 (defun euc-tw-pre-write-conversion (beg end)  
   "Semi-dummy pre-write function effectively to autoload china-util."  
   ;; Ensure translation table is loaded.  
   (require 'china-util)  
   ;; Don't do this again.  
   (coding-system-put 'euc-tw 'pre-write-conversion nil)  
   nil)  
   
 (make-coding-system  
   'euc-tw 4 ?Z  
   "ISO 2022 based EUC encoding for Chinese CNS11643.  
 Big5 encoding is accepted for input also (which is then converted to CNS)."  
   '(ccl-decode-euc-tw . ccl-encode-euc-tw)  
   '((safe-charsets ascii  
                    chinese-big5-1  
                    chinese-big5-2  
                    chinese-cns11643-1  
                    chinese-cns11643-2  
                    chinese-cns11643-3  
                    chinese-cns11643-4  
                    chinese-cns11643-5  
                    chinese-cns11643-6  
                    chinese-cns11643-7)  
     (valid-codes (0 . 255))  
     (pre-write-conversion . euc-tw-pre-write-conversion)))  
170    
171  (define-coding-system-alias 'euc-taiwan 'euc-tw)  (define-coding-system-alias 'euc-taiwan 'euc-tw)
172    
# Line 320  Big5 encoding is accepted for input also Line 180  Big5 encoding is accepted for input also
180                                    chinese-iso-8bit)                                    chinese-iso-8bit)
181                   (features china-util)                   (features china-util)
182                   (input-method . "chinese-cns-quick")                   (input-method . "chinese-cns-quick")
183                     ;; Fixme: presumably it won't accept big5 now.
184                   (documentation . "\                   (documentation . "\
185  Support for Chinese CNS character sets.  Note that the EUC-TW coding system  Support for Chinese CNS character sets.  Note that the EUC-TW coding system
186  accepts Big5 for input also (which is then converted to CNS)."))  accepts Big5 for input also (which is then converted to CNS)."))
# Line 341  the EUC-TW coding system accepts Big5 fo Line 202  the EUC-TW coding system accepts Big5 fo
202  converted to CNS)."))  converted to CNS)."))
203   '("Chinese"))   '("Chinese"))
204    
205    
206    ;;; Chinese GBK
207    
208    (define-coding-system 'chinese-gbk
209      "GBK encoding for Chinese (MIME:GBK)."
210      :coding-type 'charset
211      :mnemonic ?c
212      :charset-list '(chinese-gbk)
213      :mime-charset 'gbk)
214    (define-coding-system-alias 'gbk 'chinese-gbk)
215    (define-coding-system-alias 'cp936 'chinese-gbk)
216    (define-coding-system-alias 'windows-936 'chinese-gbk)
217    
218    (set-language-info-alist
219     "Chinese-GBK" '((charset chinese-gbk)
220                     (coding-system chinese-gbk)
221                     (coding-priority gbk iso-2022-cn chinese-big5
222                                      chinese-iso-8bit) ; fixme?
223                     (input-method . "chinese-py-punct") ; fixme?
224                     (features china-util)
225                     (documentation . "Support for Chinese GBK character set."))
226     '("Chinese"))
227    
228    ;;; Chinese GB18030
229    
230    (define-coding-system 'chinese-gb18030
231      "GB18030 encoding for Chinese (MIME:GB18030)."
232      :coding-type 'charset
233      :mnemonic ?c
234      :charset-list '(gb18030)
235      :mime-charset 'gb18030)
236    
237    (define-coding-system-alias 'gb18030 'chinese-gb18030)
238    
239    (set-language-info-alist
240     "Chinese-GB18030" '((charset gb18030)
241                         (coding-system chinese-gb18030)
242                         (coding-priority gb18030 gbk iso-2022-cn chinese-big5
243                                          chinese-iso-8bit) ; fixme?
244                         (input-method . "chinese-py-punct") ; fixme?
245                         (features china-util)
246                         (documentation
247                          . "Support for Chinese GB18030 character set."))
248     '("Chinese"))
249    
250    ;; Fixme: add HKSCS
251    
252  (provide 'chinese)  (provide 'chinese)
253    
254  ;;; chinese.el ends here  ;;; chinese.el ends here

Legend:
Removed from v.1.27  
changed lines
  Added in v.1.27.6.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26