git.chise.org Git - chise/xemacs-chise.git.1/blob - lisp/mule/thai-xtis.el

   1 ;;; thai-xtis.el --- Support for Thai (XTIS) -*- coding: iso-2022-7bit; -*-
   2
   3 ;; Copyright (C) 1999 Electrotechnical Laboratory, JAPAN.
   4 ;; Licensed to the Free Software Foundation.
   5
   6 ;; Author: TAKAHASHI Naoto <ntakahas@etl.go.jp>
   7 ;;         MORIOKA Tomohiko <tomo@etl.go.jp>
   8 ;; Created: 1998-03-27 for Emacs-20.3 by TAKAHASHI Naoto
   9 ;;          1999-03-29 imported and modified for XEmacs by MORIOKA Tomohiko
  10
  11 ;; Keywords: mule, multilingual, Thai, XTIS
  12
  13 ;; This file is part of XEmacs.
  14
  15 ;; XEmacs is free software; you can redistribute it and/or modify it
  16 ;; under the terms of the GNU General Public License as published by
  17 ;; the Free Software Foundation; either version 2, or (at your option)
  18 ;; any later version.
  19
  20 ;; XEmacs is distributed in the hope that it will be useful, but
  21 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  23 ;; General Public License for more details.
  24
  25 ;; You should have received a copy of the GNU General Public License
  26 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  27 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  28 ;; 02111-1307, USA.
  29
  30 ;;; Commentary:
  31
  32 ;; For Thai, the pre-composed character set proposed by
  33 ;; Virach Sornlertlamvanich <virach@links.nectec.or.th> is supported.
  34
  35 ;;; Code:
  36
  37 (when (featurep 'xemacs)
  38   (let ((deflist        '(;; chars      syntax
  39                           ("\e$(?!0\e(B-\e$(?NxP0R0S0`0\e(B-\e$(?e0\e(B"      "w")
  40                           ("\e$(?p0\e(B-\e$(?y0\e(B"        "w")
  41                           ("\e$(?O0f0_0o0z0{0\e(B"        "_")
  42                           ))
  43         elm chars len syntax to ch i)
  44     (while deflist
  45       (setq elm (car deflist))
  46       (setq chars (car elm)
  47             len (length chars)
  48             syntax (nth 1 elm)
  49             i 0)
  50       (while (< i len)
  51         (if (= (aref chars i) ?-)
  52             (setq i (1+ i)
  53                   to (nth 1 (split-char (aref chars i))))
  54           (setq ch (nth 1 (split-char (aref chars i)))
  55                 to ch))
  56         (while (<= ch to)
  57           (modify-syntax-entry (vector 'thai-xtis ch) syntax)
  58           (setq ch (1+ ch)))
  59         (setq i (1+ i)))
  60       (setq deflist (cdr deflist))))
  61
  62   (put-charset-property 'thai-xtis 'preferred-coding-system 'tis-620)
  63   )
  64
  65 ;; This is the ccl-decode-thai-xtis automaton.
  66 ;;
  67 ;; "WRITE x y" == (insert (make-char 'thai-xtis x y))
  68 ;; "write x" == (insert x)
  69 ;; rx' == (tis620-to-thai-xtis-second-byte-bitpattern rx)
  70 ;; r3 == "no vower nor tone"
  71 ;; r4 == (charset-id 'thai-xtis)
  72 ;;
  73 ;;          |               input (= r0)
  74 ;;   state  |--------------------------------------------
  75 ;;          |  consonant  |    vowel    |    tone
  76 ;; ---------+-------------+-------------+----------------
  77 ;;  r1 == 0 | r1 = r0     | WRITE r0,r3 | WRITE r0,r3
  78 ;;  r2 == 0 |             |             |
  79 ;; ---------+-------------+-------------+----------------
  80 ;;  r1 == C | WRITE r1,r3 | r2 = r0'    | WRITE r1,r3|r0'
  81 ;;  r2 == 0 | r1 = r0     |             | r1 = 0
  82 ;; ---------+-------------+-------------+----------------
  83 ;;  r1 == C | WRITE r1,r2 | WRITE r1,r2 | WRITE r1,r2|r0'
  84 ;;  r2 == V | r1 = r0     | WRITE r0,r3 | r1 = r2 = 0
  85 ;;          | r2 = 0      | r1 = r2 = 0 |
  86 ;;
  87 ;;
  88 ;;          |               input (= r0)
  89 ;;   state  |-----------------------------------------
  90 ;;          |    symbol   |    ASCII    |     EOF
  91 ;; ---------+-------------+-------------+-------------
  92 ;;  r1 == 0 | WRITE r0,r3 | write r0    |
  93 ;;  r2 == 0 |             |             |
  94 ;; ---------+-------------+-------------+-------------
  95 ;;  r1 == C | WRITE r1,r3 | WRITE r1,r3 | WRITE r1,r3
  96 ;;  r2 == 0 | WRITE r0,r3 | write r0    |
  97 ;;          | r1 = 0      | r1 = 0      |
  98 ;; ---------+-------------+-------------+-------------
  99 ;;  r1 == C | WRITE r1,r2 | WRITE r1,r2 | WRITE r1,r2
 100 ;;  r2 == V | WRITE r0,r3 | write r0    |
 101 ;;          | r1 = r2 = 0 | r1 = r2 = 0 |
 102
 103
 104 (eval-and-compile
 105
 106 ;; input  : r5 = 1st byte, r6 = 2nd byte
 107 ;; Their values will be destroyed.
 108 (define-ccl-program ccl-thai-xtis-write
 109   '(0
 110     ((r5 = ((r5 & #x7F) << 7))
 111      (r6 = ((r6 & #x7F) | r5))
 112      (write-multibyte-character r4 r6))))
 113
 114 (define-ccl-program ccl-thai-xtis-consonant
 115   '(0
 116     (if (r1 == 0)
 117         (r1 = r0)
 118       (if (r2 == 0)
 119           ((r5 = r1) (r6 = r3) (call ccl-thai-xtis-write)
 120            (r1 = r0))
 121         ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write)
 122          (r1 = r0)
 123          (r2 = 0))))))
 124
 125 (define-ccl-program ccl-thai-xtis-vowel
 126   '(0
 127     ((if (r1 == 0)
 128          ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write))
 129        ((if (r2 == 0)
 130             (r2 = ((r0 - 204) << 3))
 131           ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write)
 132            (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)
 133            (r1 = 0)
 134            (r2 = 0))))))))
 135
 136 (define-ccl-program ccl-thai-xtis-vowel-d1
 137   '(0
 138     ((if (r1 == 0)
 139          ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write))
 140        ((if (r2 == 0)
 141             (r2 = #x38)
 142           ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write)
 143            (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)
 144            (r1 = 0)
 145            (r2 = 0))))))))
 146
 147 (define-ccl-program ccl-thai-xtis-vowel-ee
 148   '(0
 149     ((if (r1 == 0)
 150          ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write))
 151        ((if (r2 == 0)
 152             (r2 = #x78)
 153           ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write)
 154            (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)
 155            (r1 = 0)
 156            (r2 = 0))))))))
 157
 158 (define-ccl-program ccl-thai-xtis-tone
 159   '(0
 160     (if (r1 == 0)
 161         ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write))
 162       (if (r2 == 0)
 163           ((r5 = r1) (r6 = ((r0 - #xE6) | r3)) (call ccl-thai-xtis-write)
 164            (r1 = 0))
 165         ((r5 = r1) (r6 = ((r0 - #xE6) | r2)) (call ccl-thai-xtis-write)
 166          (r1 = 0)
 167          (r2 = 0))))))
 168
 169 (define-ccl-program ccl-thai-xtis-symbol
 170   '(0
 171     (if (r1 == 0)
 172         ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write))
 173       (if (r2 == 0)
 174           ((r5 = r1) (r6 = r3) (call ccl-thai-xtis-write)
 175            (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)
 176            (r1 = 0))
 177         ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write)
 178          (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)
 179          (r1 = 0)
 180          (r2 = 0))))))
 181
 182 (define-ccl-program ccl-thai-xtis-ascii
 183   '(0
 184     (if (r1 == 0)
 185         (write r0)
 186       (if (r2 == 0)
 187           ((r5 = r1) (r6 = r3) (call ccl-thai-xtis-write)
 188            (write r0)
 189            (r1 = 0))
 190         ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write)
 191          (write r0)
 192          (r1 = 0)
 193          (r2 = 0))))))
 194
 195 (define-ccl-program ccl-thai-xtis-eof
 196   '(0
 197     (if (r1 != 0)
 198         (if (r2 == 0)
 199             ((r5 = r1) (r6 = r3) (call ccl-thai-xtis-write))
 200           ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write))))))
 201
 202 (define-ccl-program ccl-decode-thai-xtis
 203   `(4
 204     ((read r0)
 205      (r1 = 0)
 206      (r2 = 0)
 207      (r3 = #x30)
 208      (r4 = ,(charset-id 'thai-xtis))
 209      (loop
 210       (if (r0 < 161)
 211           (call ccl-thai-xtis-ascii)
 212         (branch (r0 - 161)
 213                 (call ccl-thai-xtis-consonant)
 214                 (call ccl-thai-xtis-consonant)
 215                 (call ccl-thai-xtis-consonant)
 216                 (call ccl-thai-xtis-consonant)
 217                 (call ccl-thai-xtis-consonant)
 218                 (call ccl-thai-xtis-consonant)
 219                 (call ccl-thai-xtis-consonant)
 220                 (call ccl-thai-xtis-consonant)
 221                 (call ccl-thai-xtis-consonant)
 222                 (call ccl-thai-xtis-consonant)
 223                 (call ccl-thai-xtis-consonant)
 224                 (call ccl-thai-xtis-consonant)
 225                 (call ccl-thai-xtis-consonant)
 226                 (call ccl-thai-xtis-consonant)
 227                 (call ccl-thai-xtis-consonant)
 228                 (call ccl-thai-xtis-consonant)
 229                 (call ccl-thai-xtis-consonant)
 230                 (call ccl-thai-xtis-consonant)
 231                 (call ccl-thai-xtis-consonant)
 232                 (call ccl-thai-xtis-consonant)
 233                 (call ccl-thai-xtis-consonant)
 234                 (call ccl-thai-xtis-consonant)
 235                 (call ccl-thai-xtis-consonant)
 236                 (call ccl-thai-xtis-consonant)
 237                 (call ccl-thai-xtis-consonant)
 238                 (call ccl-thai-xtis-consonant)
 239                 (call ccl-thai-xtis-consonant)
 240                 (call ccl-thai-xtis-consonant)
 241                 (call ccl-thai-xtis-consonant)
 242                 (call ccl-thai-xtis-consonant)
 243                 (call ccl-thai-xtis-consonant)
 244                 (call ccl-thai-xtis-consonant)
 245                 (call ccl-thai-xtis-consonant)
 246                 (call ccl-thai-xtis-consonant)
 247                 (call ccl-thai-xtis-consonant)
 248                 (call ccl-thai-xtis-symbol)
 249                 (call ccl-thai-xtis-consonant)
 250                 (call ccl-thai-xtis-symbol)
 251                 (call ccl-thai-xtis-consonant)
 252                 (call ccl-thai-xtis-consonant)
 253                 (call ccl-thai-xtis-consonant)
 254                 (call ccl-thai-xtis-consonant)
 255                 (call ccl-thai-xtis-consonant)
 256                 (call ccl-thai-xtis-consonant)
 257                 (call ccl-thai-xtis-consonant)
 258                 (call ccl-thai-xtis-consonant)
 259                 (call ccl-thai-xtis-symbol)
 260                 (call ccl-thai-xtis-symbol)
 261                 (call ccl-thai-xtis-vowel-d1)
 262                 (call ccl-thai-xtis-symbol)
 263                 (call ccl-thai-xtis-symbol)
 264                 (call ccl-thai-xtis-vowel)
 265                 (call ccl-thai-xtis-vowel)
 266                 (call ccl-thai-xtis-vowel)
 267                 (call ccl-thai-xtis-vowel)
 268                 (call ccl-thai-xtis-vowel)
 269                 (call ccl-thai-xtis-vowel)
 270                 (call ccl-thai-xtis-vowel)
 271                 nil
 272                 nil
 273                 nil
 274                 nil
 275                 (call ccl-thai-xtis-symbol)
 276                 (call ccl-thai-xtis-symbol)
 277                 (call ccl-thai-xtis-symbol)
 278                 (call ccl-thai-xtis-symbol)
 279                 (call ccl-thai-xtis-symbol)
 280                 (call ccl-thai-xtis-symbol)
 281                 (call ccl-thai-xtis-symbol)
 282                 (call ccl-thai-xtis-symbol)
 283                 (call ccl-thai-xtis-tone)
 284                 (call ccl-thai-xtis-tone)
 285                 (call ccl-thai-xtis-tone)
 286                 (call ccl-thai-xtis-tone)
 287                 (call ccl-thai-xtis-tone)
 288                 (call ccl-thai-xtis-tone)
 289                 (call ccl-thai-xtis-tone)
 290                 (call ccl-thai-xtis-vowel-ee)
 291                 (call ccl-thai-xtis-symbol)
 292                 (call ccl-thai-xtis-symbol)
 293                 (call ccl-thai-xtis-symbol)
 294                 (call ccl-thai-xtis-symbol)
 295                 (call ccl-thai-xtis-symbol)
 296                 (call ccl-thai-xtis-symbol)
 297                 (call ccl-thai-xtis-symbol)
 298                 (call ccl-thai-xtis-symbol)
 299                 (call ccl-thai-xtis-symbol)
 300                 (call ccl-thai-xtis-symbol)
 301                 (call ccl-thai-xtis-symbol)
 302                 (call ccl-thai-xtis-symbol)
 303                 (call ccl-thai-xtis-symbol)
 304                 nil
 305                 nil
 306                 nil))
 307       (read r0)
 308       (repeat)))
 309
 310     (call ccl-thai-xtis-eof)))
 311
 312 )
 313
 314 (defconst leading-code-private-21 #x9F)
 315
 316 (define-ccl-program ccl-encode-thai-xtis
 317   `(1
 318     ((read r0)
 319      (loop
 320       (if (r0 == ,leading-code-private-21)
 321           ((read r1)
 322            (if (r1 == ,(charset-id 'thai-xtis))
 323                ((read r0)
 324                 (write r0)
 325                 (read r0)
 326                 (r1 = (r0 & 7))
 327                 (r0 = ((r0 - #xB0) >> 3))
 328                 (if (r0 != 0)
 329                     (write r0 [0 209 212 213 214 215 216 217 218 238]))
 330                 (if (r1 != 0)
 331                     (write r1 [0 231 232 233 234 235 236 237]))
 332                 (read r0)
 333                 (repeat))
 334              ((write r0 r1)
 335               (read r0)
 336               (repeat))))
 337         (write-read-repeat r0))))))
 338
 339 (if (featurep 'xemacs)
 340     (progn
 341       (make-coding-system
 342        'tis-620 'ccl
 343        "external=tis620, internal=thai-xtis"
 344        `(mnemonic "TIS620"
 345                   decode ccl-decode-thai-xtis
 346                   encode ccl-encode-thai-xtis))
 347       (coding-system-put 'tis-620 'category 'iso-8-1))
 348   (make-coding-system
 349    'tis-620 4 ?T "external=tis620, internal=thai-xtis"
 350    '(ccl-decode-thai-xtis . ccl-encode-thai-xtis)
 351    '((safe-charsets . t)))
 352   )
 353
 354
 355 (set-language-info-alist
 356  "Thai-XTIS"
 357  '((charset thai-xtis)
 358    (coding-system tis-620 iso-2022-7bit)
 359    (tutorial . "TUTORIAL.th")
 360    (tutorial-coding-system . tis-620)
 361    (coding-priority tis-620 iso-2022-7bit)
 362    (sample-text . "\e$(?!:\e(B")
 363    (documentation . t)))
 364
 365 ;; thai-xtis.el ends here.