code.delx.au - gnu-emacs/blob - lisp/language/china-util.el

   1 ;;; china-util.el --- utilities for Chinese  -*- coding: iso-2022-7bit -*-
   2
   3 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
   4 ;; Licensed to the Free Software Foundation.
   5 ;; Copyright (C) 1995, 2001 Free Software Foundation, Inc.
   6
   7 ;; Keywords: mule, multilingual, Chinese
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs 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 ;; GNU Emacs 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 GNU Emacs; 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 ;;; Commentary:
  27
  28 ;;; Code:
  29
  30 ;; Hz/ZW/EUC-TW encoding stuff
  31
  32 ;; HZ is an encoding method for Chinese character set GB2312 used
  33 ;; widely in Internet.  It is very similar to 7-bit environment of
  34 ;; ISO-2022.  The difference is that HZ uses the sequence "~{" and
  35 ;; "~}" for designating GB2312 and ASCII respectively, hence, it
  36 ;; doesn't uses ESC (0x1B) code.
  37
  38 ;; ZW is another encoding method for Chinese character set GB2312.  It
  39 ;; encodes Chinese characters line by line by starting each line with
  40 ;; the sequence "zW".  It also uses only 7-bit as HZ.
  41
  42 ;; EUC-TW is similar to EUC-KS or EUC-JP.  Its main character set is
  43 ;; plane 1 of CNS 11643; characters of planes 2 to 7 are accessed with
  44 ;; a single shift escape followed by three bytes: the first gives the
  45 ;; plane, the second and third the character code.  Note that characters
  46 ;; of plane 1 are (redundantly) accessible with a single shift escape
  47 ;; also.
  48
  49 ;; ISO-2022 escape sequence to designate GB2312.
  50 (defvar iso2022-gb-designation "\e$A")
  51 ;; HZ escape sequence to designate GB2312.
  52 (defvar hz-gb-designnation "~{")
  53 ;; ISO-2022 escape sequence to designate ASCII.
  54 (defvar iso2022-ascii-designation "\e(B")
  55 ;; HZ escape sequence to designate ASCII.
  56 (defvar hz-ascii-designnation "~}")
  57 ;; Regexp of ZW sequence to start GB2312.
  58 (defvar zw-start-gb "^zW")
  59 ;; Regexp for start of GB2312 in an encoding mixture of HZ and ZW.
  60 (defvar hz/zw-start-gb
  61   (concat hz-gb-designnation "\\|" zw-start-gb "\\|[^\0-\177]"))
  62
  63 (defvar decode-hz-line-continuation nil
  64   "Flag to tell if we should care line continuation convention of Hz.")
  65
  66 (defconst hz-set-msb-table
  67   (let ((str (make-string 127 0))
  68         (i 0))
  69     (while (< i 33)
  70       (aset str i i)
  71       (setq i (1+ i)))
  72     (while (< i 127)
  73       (aset str i (+ i 128))
  74       (setq i (1+ i)))
  75     str))
  76
  77 ;;;###autoload
  78 (defun decode-hz-region (beg end)
  79   "Decode HZ/ZW encoded text in the current region.
  80 Return the length of resulting text."
  81   (interactive "r")
  82   (save-excursion
  83     (save-restriction
  84       (let (pos ch)
  85         (narrow-to-region beg end)
  86
  87         ;; We, at first, convert HZ/ZW to `euc-china',
  88         ;; then decode it.
  89
  90         ;; "~\n" -> "\n", "~~" -> "~"
  91         (goto-char (point-min))
  92         (while (search-forward "~" nil t)
  93           (setq ch (following-char))
  94           (if (or (= ch ?\n) (= ch ?~)) (delete-char -1)))
  95
  96         ;; "^zW...\n" -> Chinese GB2312
  97         ;; "~{...~}"  -> Chinese GB2312
  98         (goto-char (point-min))
  99         (setq beg nil)
 100         (while (re-search-forward hz/zw-start-gb nil t)
 101           (setq pos (match-beginning 0)
 102                 ch (char-after pos))
 103           ;; Record the first position to start conversion.
 104           (or beg (setq beg pos))
 105           (end-of-line)
 106           (setq end (point))
 107           (if (>= ch 128)               ; 8bit GB2312
 108               nil
 109             (goto-char pos)
 110             (delete-char 2)
 111             (setq end (- end 2))
 112             (if (= ch ?z)                       ; ZW -> euc-china
 113                 (progn
 114                   (translate-region (point) end hz-set-msb-table)
 115                   (goto-char end))
 116               (if (search-forward hz-ascii-designnation
 117                                   (if decode-hz-line-continuation nil end)
 118                                   t)
 119                   (delete-char -2))
 120               (setq end (point))
 121               (translate-region pos (point) hz-set-msb-table))))
 122         (if beg
 123             (decode-coding-region beg end 'euc-china)))
 124       (- (point-max) (point-min)))))
 125
 126 ;;;###autoload
 127 (defun decode-hz-buffer ()
 128   "Decode HZ/ZW encoded text in the current buffer."
 129   (interactive)
 130   (decode-hz-region (point-min) (point-max)))
 131
 132 ;;;###autoload
 133 (defun encode-hz-region (beg end)
 134   "Encode the text in the current region to HZ.
 135 Return the length of resulting text."
 136   (interactive "r")
 137   (save-excursion
 138     (save-restriction
 139       (narrow-to-region beg end)
 140
 141       ;; "~" -> "~~"
 142       (goto-char (point-min))
 143       (while (search-forward "~" nil t) (insert ?~))
 144
 145       ;; Chinese GB2312 -> "~{...~}"
 146       (goto-char (point-min))
 147       (if (re-search-forward "\\cc" nil t)
 148           (let (pos)
 149             (goto-char (setq pos (match-beginning 0)))
 150             (encode-coding-region pos (point-max) 'iso-2022-7bit)
 151             (goto-char pos)
 152             (while (search-forward iso2022-gb-designation nil t)
 153               (delete-char -3)
 154               (insert hz-gb-designnation))
 155             (goto-char pos)
 156             (while (search-forward iso2022-ascii-designation nil t)
 157               (delete-char -3)
 158               (insert hz-ascii-designnation))))
 159       (- (point-max) (point-min)))))
 160
 161 ;;;###autoload
 162 (defun encode-hz-buffer ()
 163   "Encode the text in the current buffer to HZ."
 164   (interactive)
 165   (encode-hz-region (point-min) (point-max)))
 166
 167 ;; The following sets up a translation table (big5-to-cns) from Big 5
 168 ;; to CNS encoding, using some auxiliary functions to make the code
 169 ;; more readable.
 170
 171 ;; Many kudos to Himi!  The used code has been adapted from his
 172 ;; mule-ucs package.
 173
 174 (defun big5-to-flat-code (num)
 175   "Convert NUM in Big 5 encoding to a `flat code'.
 176 0xA140 will be mapped to position 0, 0xA141 to position 1, etc.
 177 There are no gaps in the flat code."
 178
 179   (let ((hi (/ num 256))
 180         (lo (% num 256)))
 181     (+ (* 157 (- hi #xa1))
 182        (- lo (if (>= lo #xa1) 98 64)))))
 183
 184 (defun flat-code-to-big5 (num)
 185   "Convert NUM from a `flat code' to Big 5 encoding.
 186 This is the inverse function of `big5-to-flat-code'."
 187
 188   (let ((hi (/ num 157))
 189         (lo (% num 157)))
 190     (+ (* 256 (+ hi #xa1))
 191        (+ lo (if (< lo 63) 64 98)))))
 192
 193 (defun euc-to-flat-code (num)
 194   "Convert NUM in EUC encoding (in GL representation) to a `flat code'.
 195 0x2121 will be mapped to position 0, 0x2122 to position 1, etc.
 196 There are no gaps in the flat code."
 197
 198   (let ((hi (/ num 256))
 199         (lo (% num 256)))
 200     (+ (* 94 (- hi #x21))
 201        (- lo #x21))))
 202
 203 (defun flat-code-to-euc (num)
 204   "Convert NUM from a `flat code' to EUC encoding (in GL representation).
 205 The inverse function of `euc-to-flat-code'.  The high and low bytes are
 206 returned in a list."
 207
 208   (let ((hi (/ num 94))
 209         (lo (% num 94)))
 210     (list (+ hi #x21) (+ lo #x21))))
 211
 212 (defun expand-euc-big5-alist (alist)
 213   "Create a translation table and fills it with data given in ALIST.
 214 Elements of ALIST can be either given as
 215
 216   ((euc-charset . startchar) . (big5-range-begin . big5-range-end))
 217
 218 or as
 219
 220   (euc-character . big5-charcode)
 221
 222 The former maps a range of glyphs in an EUC charset (where STARTCHAR
 223 is in GL representation) to a certain range of Big 5 encoded
 224 characters, the latter maps a single glyph.  Glyphs which can't be
 225 mapped will be represented with the byte 0xFF.
 226
 227 The return value is the filled translation table."
 228
 229   (let (chartable
 230         elem
 231         result
 232         char
 233         big5
 234         i
 235         end
 236         codepoint
 237         charset)
 238     (setq chartable (make-char-table 'translation-table #xFF))
 239     (while alist
 240       (setq elem (car alist)
 241             char (car elem)
 242             big5 (cdr elem)
 243             alist (cdr alist))
 244       (cond ((and (consp char)
 245                   (consp big5))
 246                (setq i (big5-to-flat-code (car big5))
 247                      end (big5-to-flat-code (cdr big5))
 248                      codepoint (euc-to-flat-code (cdr char))
 249                      charset (car char))
 250                (while (>= end i)
 251                  (aset chartable
 252                        (decode-big5-char (flat-code-to-big5 i))
 253                        (apply (function make-char)
 254                               charset
 255                               (flat-code-to-euc codepoint)))
 256                  (setq i (1+ i)
 257                        codepoint (1+ codepoint)))
 258             )
 259             ((and (char-valid-p char)
 260                   (numberp big5))
 261                (setq i (decode-big5-char big5))
 262                (aset chartable i char)
 263             )
 264             (t
 265              (error "Unknown slot type: %S" elem)
 266             )
 267       )
 268     )
 269     ;; the return value
 270     chartable
 271   )
 272 )
 273
 274 ;; All non-CNS encodings are commented out.
 275
 276 (define-translation-table 'big5-to-cns
 277   (expand-euc-big5-alist
 278    '(
 279      ;; Symbols
 280      ((chinese-cns11643-1 . #x2121) . (#xA140 . #xA1F5))
 281      (?\e$(G"X\e(B . #xA1F6)
 282      (?\e$(G"W\e(B . #xA1F7)
 283      ((chinese-cns11643-1 . #x2259) . (#xA1F8 . #xA2AE))
 284      ((chinese-cns11643-1 . #x2421) . (#xA2AF . #xA3BF))
 285      ;; Control codes (vendor dependent)
 286      ((chinese-cns11643-1 . #x4221) . (#xA3C0 . #xA3E0))
 287      ;; Level 1 Ideographs
 288      ((chinese-cns11643-1 . #x4421) . (#xA440 . #xACFD))
 289      (?\e$(GWS\e(B . #xACFE)
 290      ((chinese-cns11643-1 . #x5323) . (#xAD40 . #xAFCF))
 291      ((chinese-cns11643-1 . #x5754) . (#xAFD0 . #xBBC7))
 292      ((chinese-cns11643-1 . #x6B51) . (#xBBC8 . #xBE51))
 293      (?\e$(GkP\e(B . #xBE52)
 294      ((chinese-cns11643-1 . #x6F5C) . (#xBE53 . #xC1AA))
 295      ((chinese-cns11643-1 . #x7536) . (#xC1AB . #xC2CA))
 296      (?\e$(Gu5\e(B . #xC2CB)
 297      ((chinese-cns11643-1 . #x7737) . (#xC2CC . #xC360))
 298      ((chinese-cns11643-1 . #x782E) . (#xC361 . #xC3B8))
 299      (?\e$(Gxe\e(B . #xC3B9)
 300      (?\e$(Gxd\e(B . #xC3BA)
 301      ((chinese-cns11643-1 . #x7866) . (#xC3BB . #xC455))
 302      (?\e$(Gx-\e(B . #xC456)
 303      ((chinese-cns11643-1 . #x7962) . (#xC457 . #xC67E))
 304      ;; Symbols
 305      ((chinese-cns11643-1 . #x2621) . (#xC6A1 . #xC6BE))
 306      ;; Radicals
 307      (?\e$(G'#\e(B . #xC6BF)
 308      (?\e$(G'$\e(B . #xC6C0)
 309      (?\e$(G'&\e(B . #xC6C1)
 310      (?\e$(G'(\e(B . #xC6C2)
 311      (?\e$(G'-\e(B . #xC6C3)
 312      (?\e$(G'.\e(B . #xC6C4)
 313      (?\e$(G'/\e(B . #xC6C5)
 314      (?\e$(G'4\e(B . #xC6C6)
 315      (?\e$(G'7\e(B . #xC6C7)
 316      (?\e$(G':\e(B . #xC6C8)
 317      (?\e$(G'<\e(B . #xC6C9)
 318      (?\e$(G'B\e(B . #xC6CA)
 319      (?\e$(G'G\e(B . #xC6CB)
 320      (?\e$(G'N\e(B . #xC6CC)
 321      (?\e$(G'S\e(B . #xC6CD)
 322      (?\e$(G'T\e(B . #xC6CE)
 323      (?\e$(G'U\e(B . #xC6CF)
 324      (?\e$(G'Y\e(B . #xC6D0)
 325      (?\e$(G'Z\e(B . #xC6D1)
 326      (?\e$(G'a\e(B . #xC6D2)
 327      (?\e$(G'f\e(B . #xC6D3)
 328      (?\e$(G()\e(B . #xC6D4)
 329      (?\e$(G(*\e(B . #xC6D5)
 330      (?\e$(G(c\e(B . #xC6D6)
 331      (?\e$(G(l\e(B . #xC6D7)
 332      ;; Diacritical Marks
 333      ; ((japanese-jisx0208 . #x212F) . (#xC6D8 . #xC6D9))
 334      ;; Japanese Kana Supplement
 335      ; ((japanese-jisx0208 . #x2133) . (#xC6DA . #xC6E3))
 336      ;; Japanese Hiragana
 337      ; ((japanese-jisx0208 . #x2421) . (#xC6E7 . #xC77A))
 338      ;; Japanese Katakana
 339      ; ((japanese-jisx0208 . #x2521) . (#xC77B . #xC7F2))
 340      ;; Cyrillic Characters
 341      ; ((japanese-jisx0208 . #x2721) . (#xC7F3 . #xC854))
 342      ; ((japanese-jisx0208 . #x2751) . (#xC855 . #xC875))
 343      ;; Special Chinese Characters
 344      (?\e$(J!#\e(B . #xC879)
 345      (?\e$(J!$\e(B . #xC87B)
 346      (?\e$(J!*\e(B . #xC87D)
 347      (?\e$(J!R\e(B . #xC8A2)
 348
 349      ;; JIS X 0208 NOT SIGN (cf. U+00AC)
 350      ; (?\e$B"L\e(B . #xC8CD)
 351      ;; JIS X 0212 BROKEN BAR (cf. U+00A6)
 352      ; (?\e$(D"C\e(B . #xC8CE)
 353
 354      ;; GB 2312 characters
 355      ; (?\e$A!d\e(B . #xC8CF)
 356      ; (?\e$A!e\e(B . #xC8D0)
 357         ;;;;; C8D1 - Japanese `(\e$B3t\e(B)'
 358      ; (?\e$A!m\e(B . #xC8D2)
 359         ;;;;; C8D2 - Tel.
 360
 361      ;; Level 2 Ideographs
 362      ((chinese-cns11643-2 . #x2121) . (#xC940 . #xC949))
 363      (?\e$(GDB\e(B . #xC94A);; a duplicate of #xA461
 364      ((chinese-cns11643-2 . #x212B) . (#xC94B . #xC96B))
 365      ((chinese-cns11643-2 . #x214D) . (#xC96C . #xC9BD))
 366      (?\e$(H!L\e(B . #xC9BE)
 367      ((chinese-cns11643-2 . #x217D) . (#xC9BF . #xC9EC))
 368      ((chinese-cns11643-2 . #x224E) . (#xC9ED . #xCAF6))
 369      (?\e$(H"M\e(B . #xCAF7)
 370      ((chinese-cns11643-2 . #x2439) . (#xCAF8 . #xD6CB))
 371      (?\e$(H>c\e(B . #xD6CC)
 372      ((chinese-cns11643-2 . #x3770) . (#xD6CD . #xD779))
 373      (?\e$(H?j\e(B . #xD77A)
 374      ((chinese-cns11643-2 . #x387E) . (#xD77B . #xDADE))
 375      (?\e$(H7o\e(B . #xDADF)
 376      ((chinese-cns11643-2 . #x3E64) . (#xDAE0 . #xDBA6))
 377      ((chinese-cns11643-2 . #x3F6B) . (#xDBA7 . #xDDFB))
 378      (?\e$(HAv\e(B . #xDDFC);; a duplicate of #xDCD1
 379      ((chinese-cns11643-2 . #x4424) . (#xDDFD . #xE8A2))
 380      ((chinese-cns11643-2 . #x554C) . (#xE8A3 . #xE975))
 381      ((chinese-cns11643-2 . #x5723) . (#xE976 . #xEB5A))
 382      ((chinese-cns11643-2 . #x5A29) . (#xEB5B . #xEBF0))
 383      (?\e$(HUK\e(B . #xEBF1)
 384      ((chinese-cns11643-2 . #x5B3F) . (#xEBF2 . #xECDD))
 385      (?\e$(HW"\e(B . #xECDE)
 386      ((chinese-cns11643-2 . #x5C6A) . (#xECDF . #xEDA9))
 387      ((chinese-cns11643-2 . #x5D75) . (#xEDAA . #xEEEA))
 388      (?\e$(Hd/\e(B . #xEEEB)
 389      ((chinese-cns11643-2 . #x6039) . (#xEEEC . #xF055))
 390      (?\e$(H]t\e(B . #xF056)
 391      ((chinese-cns11643-2 . #x6243) . (#xF057 . #xF0CA))
 392      (?\e$(HZ(\e(B . #xF0CB)
 393      ((chinese-cns11643-2 . #x6337) . (#xF0CC . #xF162))
 394      ((chinese-cns11643-2 . #x6430) . (#xF163 . #xF16A))
 395      (?\e$(Hga\e(B . #xF16B)
 396      ((chinese-cns11643-2 . #x6438) . (#xF16C . #xF267))
 397      (?\e$(Hi4\e(B . #xF268)
 398      ((chinese-cns11643-2 . #x6573) . (#xF269 . #xF2C2))
 399      ((chinese-cns11643-2 . #x664E) . (#xF2C3 . #xF374))
 400      ((chinese-cns11643-2 . #x6762) . (#xF375 . #xF465))
 401      ((chinese-cns11643-2 . #x6935) . (#xF466 . #xF4B4))
 402      (?\e$(HfM\e(B . #xF4B5)
 403      ((chinese-cns11643-2 . #x6962) . (#xF4B6 . #xF4FC))
 404      ((chinese-cns11643-2 . #x6A4C) . (#xF4FD . #xF662))
 405      (?\e$(HjK\e(B . #xF663)
 406      ((chinese-cns11643-2 . #x6C52) . (#xF664 . #xF976))
 407      ((chinese-cns11643-2 . #x7167) . (#xF977 . #xF9C3))
 408      (?\e$(Hqf\e(B . #xF9C4)
 409      (?\e$(Hr4\e(B . #xF9C5)
 410      (?\e$(Hr@\e(B . #xF9C6)
 411      ((chinese-cns11643-2 . #x7235) . (#xF9C7 . #xF9D1))
 412      ((chinese-cns11643-2 . #x7241) . (#xF9D2 . #xF9D5))
 413
 414      ;; Additional Ideographs
 415      (?\e$(IC7\e(B . #xF9D6)
 416      (?\e$(IOP\e(B . #xF9D7)
 417      (?\e$(IDN\e(B . #xF9D8)
 418      (?\e$(IPJ\e(B . #xF9D9)
 419      (?\e$(I,]\e(B . #xF9DA)
 420      (?\e$(I=~\e(B . #xF9DB)
 421      (?\e$(IK\\e(B . #xF9DC)
 422     )
 423   )
 424 )
 425
 426 ;;
 427 (provide 'china-util)
 428
 429 ;;; china-util.el ends here