Mercurial > hg > xemacs-beta

comparison lisp/mule/thai-xtis.el @ 412:697ef44129c6 r21-2-14

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