Mercurial > hg > xemacs-beta

comparison lisp/mule/thai-xtis.el @ 422:95016f13131a r21-2-19

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-19
author cvs
date Mon, 13 Aug 2007 11:25:01 +0200
parents e804706bfb8c
children
comparison
equal deleted inserted replaced
421:fff06e11db74 422:95016f13131a
1 ;;; thai-xtis.el --- Thai support for pre-composed font (for XTIS). 1 ;;; thai-xtis.el --- Support for Thai (XTIS) -*- coding: iso-2022-7bit; -*-
2 2
3 ;; Copyright (C) 1999 Electrotechnical Laboratory, JAPAN. 3 ;; Copyright (C) 1999 Electrotechnical Laboratory, JAPAN.
4 ;; Licensed to the Free Software Foundation. 4 ;; Licensed to the Free Software Foundation.
5 5
6 ;; Author: TAKAHASHI Naoto <ntakahas@etl.go.jp> 6 ;; Author: TAKAHASHI Naoto <ntakahas@etl.go.jp>
33 ;; Virach Sornlertlamvanich <virach@links.nectec.or.th> is supported. 33 ;; Virach Sornlertlamvanich <virach@links.nectec.or.th> is supported.
34 34
35 ;;; Code: 35 ;;; Code:
36 36
37 (when (featurep 'xemacs) 37 (when (featurep 'xemacs)
38 (make-charset 'thai-xtis "Precomposed Thai (XTIS by Virach)." 38 (let ((deflist '(;; chars syntax
39 '(registry "xtis-0" 39 ("$(?!0(B-$(?NxP0R0S0`0(B-$(?e0(B" "w")
40 dimension 2 40 ("$(?p0(B-$(?y0(B" "w")
41 columns 1 41 ("$(?O0f0_0o0z0{0(B" "_")
42 chars 94 42 ))
43 final ?? 43 elm chars len syntax to ch i)
44 graphic 0)) 44 (while deflist
45 45 (setq elm (car deflist))
46 (modify-syntax-entry 'thai-xtis "w") 46 (setq chars (car elm)
47 47 len (length chars)
48 (define-category ?T "Precomposed Thai character.") 48 syntax (nth 1 elm)
49 (modify-category-entry 'thai-xtis ?T) 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)
50 ) 63 )
51 64
52 65 ;; This is the ccl-decode-thai-xtis automaton.
53 (defvar leading-code-private-21 #x9F) 66 ;;
54 67 ;; "WRITE x y" == (insert (make-char 'thai-xtis x y))
55 (defconst thai-xtis-leading-code 68 ;; "write x" == (insert x)
56 (concat (char-to-string leading-code-private-21) 69 ;; rx' == (tis620-to-thai-xtis-second-byte-bitpattern rx)
57 (char-to-string (charset-id 'thai-xtis)))) 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))))
58 113
59 (define-ccl-program ccl-thai-xtis-consonant 114 (define-ccl-program ccl-thai-xtis-consonant
60 `(0 115 '(0
61 (if (r1 == 0) 116 (if (r1 == 0)
62 ((write ,thai-xtis-leading-code) 117 (r1 = r0)
63 (write r0) 118 (if (r2 == 0)
64 (r1 = r2)) 119 ((r5 = r1) (r6 = r3) (call ccl-thai-xtis-write)
65 (if (r1 == r2) 120 (r1 = r0))
66 ((write r1) 121 ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write)
67 (write ,thai-xtis-leading-code) 122 (r1 = r0)
68 (write r0)) 123 (r2 = 0))))))
69 ((write r1) 124
70 (write ,thai-xtis-leading-code) 125 (define-ccl-program ccl-thai-xtis-vowel
71 (write r0) 126 '(0
72 (r1 = r2)))))) 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))))))))
73 135
74 (define-ccl-program ccl-thai-xtis-vowel-d1 136 (define-ccl-program ccl-thai-xtis-vowel-d1
75 `(0 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
76 (if (r1 == 0) 160 (if (r1 == 0)
77 ((write ,thai-xtis-leading-code) 161 ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write))
78 (write r0 r2)) 162 (if (r2 == 0)
79 (if (r1 == r2) 163 ((r5 = r1) (r6 = ((r0 - #xE6) | r3)) (call ccl-thai-xtis-write)
80 (r1 = ?\xb8) 164 (r1 = 0))
81 ((write r1) 165 ((r5 = r1) (r6 = ((r0 - #xE6) | r2)) (call ccl-thai-xtis-write)
82 (write ,thai-xtis-leading-code) 166 (r1 = 0)
83 (write r0 r2) 167 (r2 = 0))))))
84 (r1 = 0)))))) 168
85 169 (define-ccl-program ccl-thai-xtis-symbol
86 (define-ccl-program ccl-thai-xtis-vowel 170 '(0
87 `(0
88 (if (r1 == 0) 171 (if (r1 == 0)
89 ((write ,thai-xtis-leading-code) 172 ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write))
90 (write r0 r2)) 173 (if (r2 == 0)
91 (if (r1 == r2) 174 ((r5 = r1) (r6 = r3) (call ccl-thai-xtis-write)
92 (r1 = ((r0 - 188) << 3)) 175 (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)
93 ((write r1) 176 (r1 = 0))
94 (write ,thai-xtis-leading-code) 177 ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write)
95 (write r0 r2) 178 (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)
96 (r1 = 0)))))) 179 (r1 = 0)
97 180 (r2 = 0))))))
98 (define-ccl-program ccl-thai-xtis-vowel-ee 181
99 `(0 182 (define-ccl-program ccl-thai-xtis-ascii
183 '(0
100 (if (r1 == 0) 184 (if (r1 == 0)
101 ((write ,thai-xtis-leading-code) 185 (write r0)
102 (write r0 r2)) 186 (if (r2 == 0)
103 (if (r1 == r2) 187 ((r5 = r1) (r6 = r3) (call ccl-thai-xtis-write)
104 (r1 = ?\xf8)
105 ((write r1)
106 (write ,thai-xtis-leading-code)
107 (write r0 r2)
108 (r1 = 0))))))
109
110 (define-ccl-program ccl-thai-xtis-tone
111 `(0
112 (if (r1 == 0)
113 ((write ,thai-xtis-leading-code)
114 (write r0 r2))
115 (if (r1 == r2)
116 ((r0 -= 54)
117 (write r0) 188 (write r0)
118 (r1 = 0)) 189 (r1 = 0))
119 ((r1 += (r0 - ?\xe6)) 190 ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write)
120 (write r1) 191 (write r0)
121 (r1 = 0)))))) 192 (r1 = 0)
122 193 (r2 = 0))))))
123 (define-ccl-program ccl-thai-xtis-symbol 194
124 `(0 195 (define-ccl-program ccl-thai-xtis-eof
125 (if (r1 == 0) 196 '(0
126 ((write ,thai-xtis-leading-code) 197 (if (r1 != 0)
127 (write r0 r2)) 198 (if (r2 == 0)
128 (if (r1 == r2) 199 ((r5 = r1) (r6 = r3) (call ccl-thai-xtis-write))
129 ((write r2) 200 ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write))))))
130 (write ,thai-xtis-leading-code)
131 (write r0 r2)
132 (r1 = 0))
133 ((write r1)
134 (write ,thai-xtis-leading-code)
135 (write r0 r2)
136 (r1 = 0))))))
137 201
138 (define-ccl-program ccl-decode-thai-xtis 202 (define-ccl-program ccl-decode-thai-xtis
139 `(4 203 `(4
140 ((read r0) 204 ((read r0)
141 (r1 = 0) 205 (r1 = 0)
142 (r2 = ?\xb0) 206 (r2 = 0)
207 (r3 = #x30)
208 (r4 = ,(charset-id 'thai-xtis))
143 (loop 209 (loop
144 (if (r0 < 161) 210 (if (r0 < 161)
145 (if (r1 == 0) 211 (call ccl-thai-xtis-ascii)
146 (write r0)
147 (if (r1 == r2)
148 ((write r2 r0)
149 (r1 = 0))
150 ((write r1 r0)
151 (r1 = 0))))
152 (branch (r0 - 161) 212 (branch (r0 - 161)
153 (call ccl-thai-xtis-consonant) 213 (call ccl-thai-xtis-consonant)
154 (call ccl-thai-xtis-consonant) 214 (call ccl-thai-xtis-consonant)
155 (call ccl-thai-xtis-consonant) 215 (call ccl-thai-xtis-consonant)
156 (call ccl-thai-xtis-consonant) 216 (call ccl-thai-xtis-consonant)
245 nil 305 nil
246 nil)) 306 nil))
247 (read r0) 307 (read r0)
248 (repeat))) 308 (repeat)))
249 309
250 (if (r1 != 0) 310 (call ccl-thai-xtis-eof)))
251 (write r1) 311
252 nil))) 312 )
313
314 (defconst leading-code-private-21 #x9F)
253 315
254 (define-ccl-program ccl-encode-thai-xtis 316 (define-ccl-program ccl-encode-thai-xtis
255 `(1 317 `(1
256 ((read r0) 318 ((read r0)
257 (loop 319 (loop
260 (if (r1 == ,(charset-id 'thai-xtis)) 322 (if (r1 == ,(charset-id 'thai-xtis))
261 ((read r0) 323 ((read r0)
262 (write r0) 324 (write r0)
263 (read r0) 325 (read r0)
264 (r1 = (r0 & 7)) 326 (r1 = (r0 & 7))
265 (r0 = ((r0 - ?\xb0) >> 3)) 327 (r0 = ((r0 - #xB0) >> 3))
266 (if (r0 != 0) 328 (if (r0 != 0)
267 (write r0 [0 209 212 213 214 215 216 217 218 238])) 329 (write r0 [0 209 212 213 214 215 216 217 218 238]))
268 (if (r1 != 0) 330 (if (r1 != 0)
269 (write r1 [0 231 232 233 234 235 236 237])) 331 (write r1 [0 231 232 233 234 235 236 237]))
270 (read r0) 332 (read r0)
273 (read r0) 335 (read r0)
274 (repeat)))) 336 (repeat))))
275 (write-read-repeat r0)))))) 337 (write-read-repeat r0))))))
276 338
277 (if (featurep 'xemacs) 339 (if (featurep 'xemacs)
278 (make-coding-system 340 (progn
279 'tis-620 'ccl 341 (make-coding-system
280 "external=tis620, internal=thai-xtis" 342 'tis-620 'ccl
281 `(mnemonic "TIS620" 343 "external=tis620, internal=thai-xtis"
282 decode ,ccl-decode-thai-xtis 344 `(mnemonic "TIS620"
283 encode ,ccl-encode-thai-xtis)) 345 decode ,ccl-decode-thai-xtis
346 encode ,ccl-encode-thai-xtis))
347 (coding-system-put 'tis-620 'category 'iso-8-1))
284 (make-coding-system 348 (make-coding-system
285 'tis-620 4 ?T "external=tis620, internal=thai-xtis" 349 'tis-620 4 ?T "external=tis620, internal=thai-xtis"
286 '(ccl-decode-thai-xtis . ccl-encode-thai-xtis) 350 '(ccl-decode-thai-xtis . ccl-encode-thai-xtis)
287 '((safe-charsets . t))) 351 '((safe-charsets . t)))
288 ) 352 )
289 353
290 354
291 (set-language-info-alist 355 (set-language-info-alist
292 "Thai-XTIS" 356 "Thai-XTIS"
293 '((setup-function . setup-thai-xtis-environment) 357 '((charset thai-xtis)
294 (exit-function . exit-thai-xtis-environment)
295 (charset thai-xtis)
296 (coding-system tis-620 iso-2022-7bit) 358 (coding-system tis-620 iso-2022-7bit)
359 (tutorial . "TUTORIAL.th")
360 (tutorial-coding-system . tis-620)
297 (coding-priority tis-620 iso-2022-7bit) 361 (coding-priority tis-620 iso-2022-7bit)
298 (sample-text . "$(?!:(B") 362 (sample-text . "$(?!:(B")
299 (documentation . t))) 363 (documentation . t)))
300 364
301 ;; thai-xtis.el ends here. 365 ;; thai-xtis.el ends here.