Mercurial > emacs
comparison leim/quail/lrt.el @ 26881:cd1cb9bf30e1
Rewritten for new composition.
author | Kenichi Handa <handa@m17n.org> |
---|---|
date | Wed, 15 Dec 1999 00:32:16 +0000 |
parents | f245110aa619 |
children | 519983161a46 |
comparison
equal
deleted
inserted
replaced
26880:98564c5250e4 | 26881:cd1cb9bf30e1 |
---|---|
29 | 29 |
30 ;; LRT (Lao Roman Transcription) input method accepts the following | 30 ;; LRT (Lao Roman Transcription) input method accepts the following |
31 ;; key sequence: | 31 ;; key sequence: |
32 ;; consonant [+ semi-vowel-sign-lo ] + vowel [+ maa-sakod ] [+ tone-mark ] | 32 ;; consonant [+ semi-vowel-sign-lo ] + vowel [+ maa-sakod ] [+ tone-mark ] |
33 | 33 |
34 (eval-and-compile | 34 (defun quail-lao-update-translation (control-flag) |
35 (if (integerp control-flag) | |
36 ;; Non-composable character typed. | |
37 (setq quail-current-str | |
38 (buffer-substring (overlay-start quail-overlay) | |
39 (overlay-end quail-overlay)) | |
40 unread-command-events | |
41 (string-to-list | |
42 (substring quail-current-key control-flag))) | |
43 (let ((lao-str (lao-transcribe-roman-to-lao-string quail-current-key))) | |
44 (if (> (aref lao-str 0) 255) | |
45 (setq quail-current-str lao-str) | |
46 (or quail-current-str | |
47 (setq quail-current-str quail-current-key))))) | |
48 control-flag) | |
35 | 49 |
36 ;; Upper vowels and tone-marks are put on the letter. | |
37 ;; Semi-vowel-sign-lo and lower vowels are put under the letter. | |
38 (defconst lrt-single-consonant-table | |
39 `(("k" . ?(1!(B) | |
40 ("kh" . ?(1"(B) | |
41 ("qh" . ?(1$(B) | |
42 ("ng" . ?(1'(B) | |
43 ("j" . ?(1((B) | |
44 ("s" . ?(1J(B) | |
45 ("x" . ?(1*(B) | |
46 ("y" . ?(1-(B) | |
47 ("d" . ?(14(B) | |
48 ("t" . ?(15(B) | |
49 ("th" . ?(16(B) | |
50 ("dh" . ?(17(B) | |
51 ("n" . ?(19(B) | |
52 ("b" . ?(1:(B) | |
53 ("p" . ?(1;(B) | |
54 ("hp" . ?(1<(B) | |
55 ("fh" . ?(1=(B) | |
56 ("ph" . ?(1>(B) | |
57 ("f" . ?(1?(B) | |
58 ("m" . ?(1A(B) | |
59 ("gn" . ?(1B(B) | |
60 ("l" . ?(1E(B) | |
61 ("r" . ?(1C(B) | |
62 ("v" . ?(1G(B) | |
63 ("w" . ?(1G(B) | |
64 ("hh" . ?(1K(B) | |
65 ("O" . ?(1M(B) | |
66 ("h" . ?(1N(B) | |
67 ("nh" . ?(1|(B) | |
68 ("mh" . ?(1}(B) | |
69 ("lh" . "0(1K\(B1") | |
70 )) | |
71 | |
72 ;; Semi-vowel-sign-lo is put under the first letter. | |
73 ;; Lower vowels are put under the last letter. | |
74 ;; Upper vowels and tone-marks are put on the last letter. | |
75 (defconst lrt-double-consonant-table | |
76 '(("ngh" . "(1K'(B") | |
77 ("yh" . "(1K](B") | |
78 ("wh" . "(1KG(B") | |
79 ("hl" . "(1KE(B") | |
80 ("hy" . "(1K-(B") | |
81 ("hn" . "(1K9(B") | |
82 ("hm" . "(1KA(B") | |
83 )) | |
84 | |
85 (defconst lrt-semi-vowel-sign-lo | |
86 '("r" . ?(1\(B)) | |
87 | |
88 (defconst lrt-vowel-table | |
89 '(("a" "(1P(B" (0 ?(1P(B) (0 ?(1Q(B)) | |
90 ("ar" "(1R(B" (0 ?(1R(B)) | |
91 ("i" "(1T(B" (0 ?(1T(B)) | |
92 ("ii" "(1U(B" (0 ?(1U(B)) | |
93 ("eu" "(1V(B" (0 ?(1V(B)) | |
94 ("ur" "(1W(B" (0 ?(1W(B)) | |
95 ("u" "(1X(B" (0 ?(1X(B)) | |
96 ("uu" "(1Y(B" (0 ?(1Y(B)) | |
97 ("e" "(1`(B (1P(B" (?(1`(B 0 ?(1P(B) (?(1`(B 0 ?(1Q(B)) | |
98 ("ee" "(1`(B" (?(1`(B 0)) | |
99 ("ae" "(1a(B (1P(B" (?(1a(B 0 ?(1P(B) (?(1a(B 0 ?(1Q(B)) | |
100 ("aa" "(1a(B" (?(1a(B 0)) | |
101 ("o" "(1b(B (1P(B" (?(1b(B 0 ?(1P(B) (0 ?(1[(B) (?(1-(B ?(1b(B 0 ?(1Q(B) (?(1G(B ?(1b(B 0 ?(1Q(B)) | |
102 ("oo" "(1b(B" (?(1b(B 0)) | |
103 ("oe" "(1`(B (1RP(B" (?(1`(B 0 ?(1R(B ?(1P(B) (0 ?(1Q(B ?(1M(B)) | |
104 ("or" "(1m(B" (0 ?(1m(B) (0 ?(1M(B)) | |
105 ("er" "(1`(B (1T(B" (?(1`(B 0 ?(1T(B)) | |
106 ("ir" "(1`(B (1U(B" (?(1`(B 0 ?(1U(B)) | |
107 ("ua" "(1[GP(B" (0 ?(1[(B ?(1G(B ?(1P(B) (0 ?(1Q(B ?(1G(B)) | |
108 ("uaa" "(1[G(B" (0 ?(1[(B ?(1G(B) (0 ?(1G(B)) | |
109 ("ie" "(1`Q]P(B" (?(1`(B 0 ?(1Q(B ?(1](B ?(1P(B) (0 ?(1Q(B ?(1](B)) | |
110 ("ia" "(1`Q](B" (?(1`(B 0 ?(1Q(B ?(1](B) (0 ?(1](B)) | |
111 ("ea" "(1`VM(B" (?(1`(B 0 ?(1V(B ?(1M(B)) | |
112 ("eaa" "(1`WM(B" (?(1`(B 0 ?(1W(B ?(1M(B)) | |
113 ("ai" "(1d(B" (?(1d(B 0)) | |
114 ("ei" "(1c(B" (?(1c(B 0)) | |
115 ("ao" "(1`[R(B" (?(1`(B 0 ?(1[(B ?(1R(B)) | |
116 ("aM" "(1S(B" (0 ?(1S(B)))) | |
117 | |
118 ;; Maa-sakod is put at the tail. | |
119 (defconst lrt-maa-sakod-table | |
120 '((?k . ?(1!(B) | |
121 (?g . ?(1'(B) | |
122 (?y . ?(1-(B) | |
123 (?d . ?(14(B) | |
124 (?n . ?(19(B) | |
125 (?b . ?(1:(B) | |
126 (?m . ?(1A(B) | |
127 (?v . ?(1G(B) | |
128 (?w . ?(1G(B) | |
129 )) | |
130 | |
131 (defconst lrt-tone-mark-table | |
132 '(("'" . ?(1h(B) | |
133 ("\"" . ?(1i(B) | |
134 ("^" . ?(1j(B) | |
135 ("+" . ?(1k(B) | |
136 ("~" . ?(1l(B))) | |
137 | |
138 ;; Return list of composing patterns for normal (without maa-sakod) | |
139 ;; key sequence and with-maa-sakod key sequence starting with single | |
140 ;; consonant C and optional SEMI-VOWEL. | |
141 (defun lrt-composing-pattern-single-c (c semi-vowel vowel-pattern) | |
142 (let* ((patterns (copy-sequence vowel-pattern)) | |
143 (tail patterns) | |
144 place) | |
145 ;; Embed C and SEMI-VOWEL (if any) at the place of 0. | |
146 (while tail | |
147 ;; At first, make a copy. | |
148 (setcar tail (copy-sequence (car tail))) | |
149 ;; Then, do embedding. | |
150 (setq place (memq 0 (car tail))) | |
151 (setcar place c) | |
152 (if semi-vowel | |
153 (setcdr place (cons semi-vowel (cdr place)))) | |
154 (setq tail (cdr tail))) | |
155 patterns)) | |
156 | |
157 ;; Return list of composing patterns for normal (without maa-sakod) | |
158 ;; key sequence and with-maa-sakod key sequence starting with double | |
159 ;; consonant STR and optional SEMI-VOWEL. | |
160 (defun lrt-composing-pattern-double-c (str semi-vowel vowel-pattern) | |
161 (let* ((patterns (copy-sequence vowel-pattern)) | |
162 (tail patterns) | |
163 (chars (string-to-list | |
164 (if (= (length str) 1) | |
165 (decompose-string str) | |
166 str))) | |
167 place) | |
168 ;; Embed C and SEMI-VOWEL (if any) at the place of 0. | |
169 (while tail | |
170 ;; At first, make a copy. | |
171 (setcar tail (copy-sequence (car tail))) | |
172 ;; Then, do embedding. | |
173 (setq place (memq 0 (car tail))) | |
174 (setcar place (car chars)) | |
175 (setcdr place (cons (nth 1 chars) (cdr place))) | |
176 (if semi-vowel | |
177 ;; Embed SEMI-VOWEL in between CHARS. | |
178 (setcdr place (cons semi-vowel (cdr place)))) | |
179 (setq tail (cdr tail))) | |
180 patterns)) | |
181 | |
182 ;; Return a string made of characters in CHAR-LIST while composing | |
183 ;; such characters as vowel-upper, vowel-lower, semi-vowel(lower), | |
184 ;; and tone-mark with the preceding base character. | |
185 (defun lrt-compose-string (char-list) | |
186 ;; Make a copy because the following work alters it. | |
187 (setq char-list (copy-sequence char-list)) | |
188 (let ((i -1) | |
189 (l char-list)) | |
190 (while l | |
191 (if (memq (get-char-code-property (car l) 'phonetic-type) | |
192 '(vowel-upper vowel-lower semivowel-lower tone)) | |
193 (let (composed-char) | |
194 (if (< i 0) | |
195 ;; No preceding base character. | |
196 (error "Invalid CHAR-LIST: %s" char-list)) | |
197 (setq composed-char | |
198 (string-to-char (compose-chars (nth i char-list) (car l)))) | |
199 (setcar (nthcdr i char-list) composed-char) | |
200 (setq l (cdr l)) | |
201 (setcdr (nthcdr i char-list) l)) | |
202 (setq l (cdr l)) | |
203 (setq i (1+ i)))) | |
204 (concat (apply 'vector char-list)))) | |
205 | |
206 (defun lrt-compose-c-s-v (consonant semi-vowel vowel-pattern) | |
207 (let ((pattern-list | |
208 (if (integerp consonant) | |
209 (lrt-composing-pattern-single-c | |
210 consonant semi-vowel vowel-pattern) | |
211 (lrt-composing-pattern-double-c | |
212 consonant semi-vowel vowel-pattern)))) | |
213 (cons (vector (lrt-compose-string (car pattern-list))) | |
214 (cons t pattern-list)))) | |
215 | |
216 ) | |
217 | |
218 (defun lrt-handle-maa-sakod () | |
219 (interactive) | |
220 (if (or (= (length quail-current-key) 0) | |
221 (not quail-current-data)) | |
222 (quail-self-insert-command) | |
223 (if (not (car quail-current-data)) | |
224 (progn | |
225 (setq quail-current-data nil) | |
226 (setq unread-command-events | |
227 (cons last-command-event unread-command-events)) | |
228 (quail-terminate-translation)) | |
229 (if (not (integerp last-command-event)) | |
230 (error "Bogus calling sequence")) | |
231 (let* ((maa-sakod (cdr (assq last-command-event lrt-maa-sakod-table))) | |
232 (maa-sakod-pattern (append | |
233 (or (cdr (assq maa-sakod | |
234 (nthcdr 3 quail-current-data))) | |
235 (nth 2 quail-current-data) | |
236 (nth 1 quail-current-data)) | |
237 (list maa-sakod)))) | |
238 (quail-delete-region) | |
239 (setq quail-current-str (lrt-compose-string maa-sakod-pattern)) | |
240 (insert quail-current-str) | |
241 (quail-show-translations) | |
242 (setq quail-current-data (list nil maa-sakod-pattern)))))) | |
243 | |
244 (defun lrt-handle-tone-mark () | |
245 (interactive) | |
246 (if (= (length quail-current-key) 0) | |
247 (quail-self-insert-command) | |
248 (if (not quail-current-data) | |
249 (progn | |
250 (setq unread-command-events | |
251 (cons last-command-event unread-command-events)) | |
252 (quail-terminate-translation)) | |
253 (if (not (integerp last-command-event)) | |
254 (error "Bogus calling sequence")) | |
255 (let* ((tone-mark (cdr (assoc (char-to-string last-command-event) | |
256 lrt-tone-mark-table))) | |
257 (tone-mark-pattern | |
258 (if (car quail-current-data) | |
259 (copy-sequence (nth 1 quail-current-data)) | |
260 ;; No need of copy because lrt-handle-maa-sakod should | |
261 ;; have already done it. | |
262 (nth 1 quail-current-data))) | |
263 (tail tone-mark-pattern) | |
264 (double-consonant-keys lrt-double-consonant-table) | |
265 (double-consonant-flag nil) | |
266 place) | |
267 | |
268 ;; Set DOUBLE-CONSONANT-FLAG to t if a user entered a double | |
269 ;; consonant. | |
270 (while (and double-consonant-keys (not double-consonant-flag)) | |
271 (setq double-consonant-flag | |
272 (eq (string-match (car (car double-consonant-keys)) | |
273 quail-current-key) | |
274 0) | |
275 double-consonant-keys (cdr double-consonant-keys))) | |
276 | |
277 ;; Find a place to embed TONE-MARK. It should be after a | |
278 ;; single or double consonant and following upper or lower vowels. | |
279 (while (and tail (not place)) | |
280 (if (and | |
281 (eq (get-char-code-property (car tail) 'phonetic-type) | |
282 'consonant) | |
283 ;; Skip `(1K(B' if it is the first letter of double consonant. | |
284 (or (not double-consonant-flag) | |
285 (/= (car tail) ?(1K(B))) | |
286 (progn | |
287 (setq place tail) | |
288 (setq tail (cdr tail)) | |
289 (while (and tail | |
290 (memq (get-char-code-property (car tail) | |
291 'phonetic-type) | |
292 '(vowel-upper vowel-lower semivowel-lower))) | |
293 (setq place tail tail (cdr tail)))) | |
294 (setq tail (cdr tail)))) | |
295 ;; Embed TONE-MARK. | |
296 (setcdr place (cons tone-mark (cdr place))) | |
297 (quail-delete-region) | |
298 (insert (lrt-compose-string tone-mark-pattern)) | |
299 (setq quail-current-data nil) | |
300 (quail-terminate-translation))))) | |
301 | |
302 (defmacro lrt-generate-quail-map () | |
303 `(quail-install-map | |
304 ',(let ((map (list nil)) | |
305 (semi-vowel-key (car lrt-semi-vowel-sign-lo)) | |
306 (semi-vowel-char (cdr lrt-semi-vowel-sign-lo)) | |
307 l1 e1 l2 e2 pattern key) | |
308 ;; Single consonants. | |
309 (setq l1 lrt-single-consonant-table) | |
310 (while l1 | |
311 (setq e1 (car l1)) | |
312 (quail-defrule-internal (car e1) (vector (cdr e1)) map) | |
313 (quail-defrule-internal | |
314 (concat (car e1) semi-vowel-key) | |
315 (if (stringp (cdr e1)) | |
316 (compose-string (format "%s%c" (cdr e1) semi-vowel-char)) | |
317 (compose-string (format "%c%c" (cdr e1) semi-vowel-char))) | |
318 map) | |
319 (setq l2 lrt-vowel-table) | |
320 (while l2 | |
321 (setq e2 (car l2)) | |
322 (setq key (concat (car e1) (car e2)) | |
323 pattern (lrt-compose-c-s-v (cdr e1) nil (nthcdr 2 e2))) | |
324 (quail-defrule-internal key pattern map) | |
325 (quail-defrule-internal | |
326 (concat key " ") | |
327 (vector (concat (aref (car pattern) 0) " ")) map) | |
328 (setq key (concat (car e1) semi-vowel-key (car e2)) | |
329 pattern (lrt-compose-c-s-v (cdr e1) semi-vowel-char | |
330 (nthcdr 2 e2))) | |
331 (quail-defrule-internal key pattern map) | |
332 (quail-defrule-internal | |
333 (concat key " ") | |
334 (vector (concat (aref (car pattern) 0) " ")) map) | |
335 (setq l2 (cdr l2))) | |
336 (setq l1 (cdr l1))) | |
337 | |
338 ;; Double consonants. | |
339 (setq l1 lrt-double-consonant-table) | |
340 (while l1 | |
341 (setq e1 (car l1)) | |
342 (quail-defrule-internal (car e1) (vector (cdr e1)) map) | |
343 (quail-defrule-internal | |
344 (concat (car e1) semi-vowel-key) | |
345 (vector (concat (compose-string | |
346 (format "%c%c" (aref (cdr e1) 0) semi-vowel-char)) | |
347 (substring (cdr e1) 1))) | |
348 map) | |
349 (setq l2 lrt-vowel-table) | |
350 (while l2 | |
351 (setq e2 (car l2)) | |
352 (setq key (concat (car e1) (car e2)) | |
353 pattern (lrt-compose-c-s-v (cdr e1) nil (nthcdr 2 e2))) | |
354 (quail-defrule-internal key pattern map) | |
355 (quail-defrule-internal | |
356 (concat key " ") | |
357 (vector (concat (aref (car pattern) 0) " ")) map) | |
358 (setq key (concat (car e1) semi-vowel-key (car e2)) | |
359 pattern (lrt-compose-c-s-v (cdr e1) semi-vowel-char | |
360 (nthcdr 2 e2))) | |
361 (quail-defrule-internal key pattern map) | |
362 (quail-defrule-internal | |
363 (concat key " ") | |
364 (vector (concat (aref (car pattern) 0) " ")) map) | |
365 (setq l2 (cdr l2))) | |
366 (setq l1 (cdr l1))) | |
367 | |
368 ;; Vowels. | |
369 (setq l1 lrt-vowel-table) | |
370 (while l1 | |
371 (setq e1 (car l1) l1 (cdr l1)) | |
372 (quail-defrule-internal (car e1) (vector (nth 1 e1)) map)) | |
373 | |
374 ;; Tone-marks. | |
375 (setq l1 lrt-tone-mark-table) | |
376 (while l1 | |
377 (setq e1 (car l1) l1 (cdr l1)) | |
378 (quail-defrule-internal (car e1) (cdr e1) map)) | |
379 | |
380 map))) | |
381 | 50 |
382 (quail-define-package | 51 (quail-define-package |
383 "lao-lrt" "Lao" "(1E(BR" t | 52 "lao-lrt" "Lao" "(1E(BR" t |
384 "Lao input method using LRT (Lao Roman Transcription). | 53 "Lao input method using LRT (Lao Roman Transcription). |
385 `\\' (backslash) + number-key => (1p(B,(1q(B,(1r(B,... LAO DIGIT ZERO, ONE, TWO, ... | 54 `\\' (backslash) + number-key => (1p(B,(1q(B,(1r(B,... LAO DIGIT ZERO, ONE, TWO, ... |
386 `\\' (backslash) + `\\' => (1f(B LAO KO LA (REPETITION) | 55 `\\' (backslash) + `\\' => (1f(B LAO KO LA (REPETITION) |
387 `\\' (backslash) + `$' => (1O(B LAO ELLIPSIS | 56 `\\' (backslash) + `$' => (1O(B LAO ELLIPSIS |
388 " | 57 " |
389 '(("k" . lrt-handle-maa-sakod) | 58 nil 'forget-last-selection 'deterministic 'kbd-translate 'show-layout |
390 ("g" . lrt-handle-maa-sakod) | 59 nil nil nil 'quail-lao-update-translation nil t) |
391 ("y" . lrt-handle-maa-sakod) | |
392 ("d" . lrt-handle-maa-sakod) | |
393 ("n" . lrt-handle-maa-sakod) | |
394 ("b" . lrt-handle-maa-sakod) | |
395 ("m" . lrt-handle-maa-sakod) | |
396 ("v" . lrt-handle-maa-sakod) | |
397 ("w" . lrt-handle-maa-sakod) | |
398 ("'" . lrt-handle-tone-mark) | |
399 ("\"" . lrt-handle-tone-mark) | |
400 ("^" . lrt-handle-tone-mark) | |
401 ("+" . lrt-handle-tone-mark) | |
402 ("~" . lrt-handle-tone-mark)) | |
403 'forget-last-selection 'deterministic 'kbd-translate 'show-layout | |
404 nil nil nil nil nil t) | |
405 | 60 |
406 (lrt-generate-quail-map) | 61 ;; LRT (Lao Roman Transcription) input method accepts the following |
62 ;; key sequence: | |
63 ;; consonant [ semi-vowel-sign-lo ] vowel [ maa-sakod ] [ tone-mark ] | |
407 | 64 |
408 ;; Additional key definitions for Lao digits. | 65 (quail-install-map |
409 | 66 (quail-map-from-table |
410 (quail-defrule "\\0" ?(1p(B) | 67 '((base-state (lao-transcription-consonant-alist . sv-state) |
411 (quail-defrule "\\1" ?(1q(B) | 68 lao-transcription-vowel-alist |
412 (quail-defrule "\\2" ?(1r(B) | 69 lao-transcription-tone-alist) |
413 (quail-defrule "\\3" ?(1s(B) | 70 (sv-state (lao-transcription-semi-vowel-alist . v-state) |
414 (quail-defrule "\\4" ?(1t(B) | 71 (lao-transcription-vowel-alist . mt-state)) |
415 (quail-defrule "\\5" ?(1u(B) | 72 (v-state (lao-transcription-vowel-alist . mt-state)) |
416 (quail-defrule "\\6" ?(1v(B) | 73 (mt-state (lao-transcription-maa-sakod-alist . t-state) |
417 (quail-defrule "\\7" ?(1w(B) | 74 lao-transcription-tone-alist) |
418 (quail-defrule "\\8" ?(1x(B) | 75 (t-state lao-transcription-tone-alist)))) |
419 (quail-defrule "\\9" ?(1y(B) | |
420 (quail-defrule "\\\\" ?(1f(B) | |
421 (quail-defrule "\\$" ?(1O(B) | |
422 | 76 |
423 ;;; quail/lrt.el ends here | 77 ;;; quail/lrt.el ends here |