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