1 ;;; quail/lrt.el --- Quail package for inputting Lao characters by LRT method
3 ;; Copyright (C) 1997 Electrotechnical Laboratory, JAPAN.
4 ;; Licensed to the Free Software Foundation.
6 ;; Keywords: multilingual, input method, Lao, LRT.
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
30 ;; LRT (Lao Roman Transcription) input method accepts the following
32 ;; consonant [+ semi-vowel-sign-lo ] + vowel [+ maa-sakod ] [+ tone-mark ]
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
69 ("lh" . "
\e0
\e(1K\
\e1
\e(B")
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" . "
\e(1K'
\e(B")
85 (defconst lrt-semi-vowel-sign-lo
88 (defconst lrt-vowel-table
89 '(("a" "
\e(1P
\e(B" (0 ?
\e(1P
\e(B) (0 ?
\e(1Q
\e(B))
90 ("ar" "
\e(1R
\e(B" (0 ?
\e(1R
\e(B))
91 ("i" "
\e(1T
\e(B" (0 ?
\e(1T
\e(B))
92 ("ii" "
\e(1U
\e(B" (0 ?
\e(1U
\e(B))
93 ("eu" "
\e(1V
\e(B" (0 ?
\e(1V
\e(B))
94 ("ur" "
\e(1W
\e(B" (0 ?
\e(1W
\e(B))
95 ("u" "
\e(1X
\e(B" (0 ?
\e(1X
\e(B))
96 ("uu" "
\e(1Y
\e(B" (0 ?
\e(1Y
\e(B))
97 ("e" "
\e(1`
\e(B
\e(1P
\e(B" (?
\e(1`
\e(B 0 ?
\e(1P
\e(B) (?
\e(1`
\e(B 0 ?
\e(1Q
\e(B))
98 ("ee" "
\e(1`
\e(B" (?
\e(1`
\e(B 0))
99 ("ae" "
\e(1a
\e(B
\e(1P
\e(B" (?
\e(1a
\e(B 0 ?
\e(1P
\e(B) (?
\e(1a
\e(B 0 ?
\e(1Q
\e(B))
100 ("aa" "
\e(1a
\e(B" (?
\e(1a
\e(B 0))
101 ("o" "
\e(1b
\e(B
\e(1P
\e(B" (?
\e(1b
\e(B 0 ?
\e(1P
\e(B) (0 ?
\e(1[
\e(B) (?
\e(1-
\e(B ?
\e(1b
\e(B 0 ?
\e(1Q
\e(B) (?
\e(1G
\e(B ?
\e(1b
\e(B 0 ?
\e(1Q
\e(B))
102 ("oo" "
\e(1b
\e(B" (?
\e(1b
\e(B 0))
103 ("oe" "
\e(1`
\e(B
\e(1RP
\e(B" (?
\e(1`
\e(B 0 ?
\e(1R
\e(B ?
\e(1P
\e(B) (0 ?
\e(1Q
\e(B ?
\e(1M
\e(B))
104 ("or" "
\e(1m
\e(B" (0 ?
\e(1m
\e(B) (0 ?
\e(1M
\e(B))
105 ("er" "
\e(1`
\e(B
\e(1T
\e(B" (?
\e(1`
\e(B 0 ?
\e(1T
\e(B))
106 ("ir" "
\e(1`
\e(B
\e(1U
\e(B" (?
\e(1`
\e(B 0 ?
\e(1U
\e(B))
107 ("ua" "
\e(1[GP
\e(B" (0 ?
\e(1[
\e(B ?
\e(1G
\e(B ?
\e(1P
\e(B) (0 ?
\e(1Q
\e(B ?
\e(1G
\e(B))
108 ("uaa" "
\e(1[G
\e(B" (0 ?
\e(1[
\e(B ?
\e(1G
\e(B) (0 ?
\e(1G
\e(B))
109 ("ie" "
\e(1`Q]P
\e(B" (?
\e(1`
\e(B 0 ?
\e(1Q
\e(B ?
\e(1]
\e(B ?
\e(1P
\e(B) (0 ?
\e(1Q
\e(B ?
\e(1]
\e(B))
110 ("ia" "
\e(1`Q]
\e(B" (?
\e(1`
\e(B 0 ?
\e(1Q
\e(B ?
\e(1]
\e(B) (0 ?
\e(1]
\e(B))
111 ("ea" "
\e(1`VM
\e(B" (?
\e(1`
\e(B 0 ?
\e(1V
\e(B ?
\e(1M
\e(B))
112 ("eaa" "
\e(1`WM
\e(B" (?
\e(1`
\e(B 0 ?
\e(1W
\e(B ?
\e(1M
\e(B))
113 ("ai" "
\e(1d
\e(B" (?
\e(1d
\e(B 0))
114 ("ei" "
\e(1c
\e(B" (?
\e(1c
\e(B 0))
115 ("ao" "
\e(1`[R
\e(B" (?
\e(1`
\e(B 0 ?
\e(1[
\e(B ?
\e(1R
\e(B))
116 ("aM" "
\e(1S
\e(B" (0 ?
\e(1S
\e(B))))
118 ;; Maa-sakod is put at the tail.
119 (defconst lrt-maa-sakod-table
131 (defconst lrt-tone-mark-table
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))
145 ;; Embed C and SEMI-VOWEL (if any) at the place of 0.
147 ;; At first, make a copy.
148 (setcar tail (copy-sequence (car tail)))
149 ;; Then, do embedding.
150 (setq place (memq 0 (car tail)))
153 (setcdr place (cons semi-vowel (cdr place))))
154 (setq tail (cdr tail)))
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))
163 (chars (string-to-list
164 (if (= (chars-in-string str) 1)
165 (decompose-string str)
168 ;; Embed C and SEMI-VOWEL (if any) at the place of 0.
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)))
177 ;; Embed SEMI-VOWEL in between CHARS.
178 (setcdr place (cons semi-vowel (cdr place))))
179 (setq tail (cdr tail)))
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))
191 (if (memq (get-char-code-property (car l) 'phonetic-type)
192 '(vowel-upper vowel-lower semivowel-lower tone))
195 ;; No preceding base character.
196 (error "Invalid CHAR-LIST: %s" char-list))
198 (string-to-char (compose-chars (nth i char-list) (car l))))
199 (setcar (nthcdr i char-list) composed-char)
201 (setcdr (nthcdr i char-list) l))
204 (concat (apply 'vector char-list))))
206 (defun lrt-compose-c-s-v (consonant semi-vowel vowel-pattern)
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))))
218 (defun lrt-handle-maa-sakod ()
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))
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))
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))))))
244 (defun lrt-handle-tone-mark ()
246 (if (= (length quail-current-key) 0)
247 (quail-self-insert-command)
248 (if (not quail-current-data)
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)))
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)
268 ;; Set DOUBLE-CONSONANT-FLAG to t if a user entered a double
270 (while (and double-consonant-keys (not double-consonant-flag))
271 (setq double-consonant-flag
272 (eq (string-match (car (car double-consonant-keys))
275 double-consonant-keys (cdr double-consonant-keys)))
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))
281 (eq (get-char-code-property (car tail) 'phonetic-type)
283 ;; Skip `
\e(1K
\e(B' if it is the first letter of double consonant.
284 (or (not double-consonant-flag)
285 (/= (car tail) ?
\e(1K
\e(B)))
288 (setq tail (cdr tail))
290 (memq (get-char-code-property (car tail)
292 '(vowel-upper vowel-lower semivowel-lower)))
293 (setq place tail tail (cdr tail))))
294 (setq tail (cdr tail))))
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)))))
302 (defmacro lrt-generate-quail-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)
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)))
319 (setq l2 lrt-vowel-table)
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
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
331 (quail-defrule-internal key pattern map)
332 (quail-defrule-internal
334 (vector (concat (aref (car pattern) 0) " ")) map)
338 ;; Double consonants.
339 (setq l1 lrt-double-consonant-table)
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" (sref (cdr e1) 0) semi-vowel-char))
347 (substring (cdr e1) (charset-bytes 'lao))))
349 (setq l2 lrt-vowel-table)
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
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
361 (quail-defrule-internal key pattern map)
362 (quail-defrule-internal
364 (vector (concat (aref (car pattern) 0) " ")) map)
369 (setq l1 lrt-vowel-table)
371 (setq e1 (car l1) l1 (cdr l1))
372 (quail-defrule-internal (car e1) (vector (nth 1 e1)) map))
375 (setq l1 lrt-tone-mark-table)
377 (setq e1 (car l1) l1 (cdr l1))
378 (quail-defrule-internal (car e1) (cdr e1) map))
382 (quail-define-package
383 "lao-lrt" "Lao" "
\e(1E
\e(BR" t
384 "Lao input method using LRT (Lao Roman Transcription).
385 `\\' (backslash) + number-key =>
\e(1p
\e(B,
\e(1q
\e(B,
\e(1r
\e(B,... LAO DIGIT ZERO, ONE, TWO, ...
386 `\\' (backslash) + `\\' =>
\e(1f
\e(B LAO KO LA (REPETITION)
387 `\\' (backslash) + `$' =>
\e(1O
\e(B LAO ELLIPSIS
389 '(("k" . lrt-handle-maa-sakod)
390 ("g" . lrt-handle-maa-sakod)
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)
405 (lrt-generate-quail-map)
407 ;; Additional key definitions for Lao digits.
409 (quail-defrule "\\0" ?
\e(1p
\e(B)
410 (quail-defrule "\\1" ?
\e(1q
\e(B)
411 (quail-defrule "\\2" ?
\e(1r
\e(B)
412 (quail-defrule "\\3" ?
\e(1s
\e(B)
413 (quail-defrule "\\4" ?
\e(1t
\e(B)
414 (quail-defrule "\\5" ?
\e(1u
\e(B)
415 (quail-defrule "\\6" ?
\e(1v
\e(B)
416 (quail-defrule "\\7" ?
\e(1w
\e(B)
417 (quail-defrule "\\8" ?
\e(1x
\e(B)
418 (quail-defrule "\\9" ?
\e(1y
\e(B)
419 (quail-defrule "\\\\" ?
\e(1f
\e(B)
420 (quail-defrule "\\$" ?
\e(1O
\e(B)
422 ;;; quail/lrt.el ends here