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 ("oua" "
\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 ("ua" "
\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 ("eua" "
\e(1`VM
\e(B" (?
\e(1`
\e(B 0 ?
\e(1V
\e(B ?
\e(1M
\e(B))
112 ("ea" "
\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 ("arm" "
\e(1S
\e(B" (?
\e(1S
\e(B 0))))
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 str))
165 ;; Embed C and SEMI-VOWEL (if any) at the place of 0.
167 ;; At first, make a copy.
168 (setcar tail (copy-sequence (car tail)))
169 ;; Then, do embedding.
170 (setq place (memq 0 (car tail)))
171 (setcar place (car chars))
172 (setcdr place (cons (nth 1 chars) (cdr place)))
174 ;; Embed SEMI-VOWEL in between CHARS.
175 (setcdr place (cons semi-vowel (cdr place))))
176 (setq tail (cdr tail)))
179 ;; Return a string made of characters in CHAR-LIST while composing
180 ;; such characters as vowel-upper, vowel-lower, semi-vowel(lower),
181 ;; and tone-mark with the preceding base character.
182 (defun lrt-compose-string (char-list)
183 ;; Make a copy because the following work alters it.
184 (setq char-list (copy-sequence char-list))
188 (if (memq (get-char-code-property (car l) 'phonetic-type)
189 '(vowel-upper vowel-lower semivowel-lower tone))
192 ;; No preceding base character.
193 (error "Invalid CHAR-LIST: %s" char-list))
195 (string-to-char (compose-chars (nth i char-list) (car l))))
196 (setcar (nthcdr i char-list) composed-char)
198 (setcdr (nthcdr i char-list) l))
201 (concat (apply 'vector char-list))))
203 (defun lrt-compose-c-s-v (consonant semi-vowel vowel-pattern)
205 (if (integerp consonant)
206 (lrt-composing-pattern-single-c
207 consonant semi-vowel vowel-pattern)
208 (lrt-composing-pattern-double-c
209 consonant semi-vowel vowel-pattern))))
210 (cons (vector (lrt-compose-string (car pattern-list)))
211 (cons t pattern-list))))
215 (defun lrt-handle-maa-sakod ()
217 (if (or (= (length quail-current-key) 0)
218 (not quail-current-data))
219 (quail-self-insert-command)
220 (if (not (car quail-current-data))
222 (setq quail-current-data nil)
223 (setq unread-command-events
224 (cons last-command-event unread-command-events))
225 (quail-terminate-translation))
226 (if (not (integerp last-command-event))
227 (error "Bogus calling sequence"))
228 (let* ((maa-sakod (cdr (assq last-command-event lrt-maa-sakod-table)))
229 (maa-sakod-pattern (append
230 (or (cdr (assq maa-sakod
231 (nthcdr 3 quail-current-data)))
232 (nth 2 quail-current-data)
233 (nth 1 quail-current-data))
235 (quail-delete-region)
236 (setq quail-current-str (lrt-compose-string maa-sakod-pattern))
237 (insert quail-current-str)
238 (setq quail-current-key " ")
239 (quail-show-translations)
240 (setq quail-current-data (list nil maa-sakod-pattern))))))
242 (defun lrt-handle-tone-mark ()
244 (if (= (length quail-current-key) 0)
245 (quail-self-insert-command)
246 (if (not quail-current-data)
248 (setq unread-command-events
249 (cons last-command-event unread-command-events))
250 (quail-terminate-translation))
251 (if (not (integerp last-command-event))
252 (error "Bogus calling sequence"))
253 (let* ((tone-mark (cdr (assoc (char-to-string last-command-event)
254 lrt-tone-mark-table)))
256 (if (car quail-current-data)
257 (copy-sequence (nth 1 quail-current-data))
258 ;; No need of copy because lrt-handle-maa-sakod should
259 ;; have already done it.
260 (nth 1 quail-current-data)))
261 (tail tone-mark-pattern)
262 (double-consonant-tail '(?
\e(1'
\e(B ?
\e(1]
\e(B ?
\e(1G
\e(B ?
\e(1E
\e(B ?
\e(1-
\e(B ?
\e(19
\e(B ?
\e(1A
\e(B))
264 ;; Find a place to embed TONE-MARK. It should be after a
265 ;; single or double consonant and following vowels.
266 (while (and tail (not place))
268 (eq (get-char-code-property (car tail) 'phonetic-type)
270 ;; Skip `
\e(1K
\e(B' if it is the first letter of double consonant.
271 (or (/= (car tail) ?
\e(1K
\e(B)
274 (if (= (car (cdr tail)) ?
\e(1\
\e(B)
275 (and (cdr (cdr tail))
276 (memq (car (cdr (cdr tail))) double-consonant-tail))
277 (memq (car (cdr tail)) double-consonant-tail)))))
280 (setq tail (cdr tail))
282 (memq (get-char-code-property (car tail)
284 '(vowel-upper vowel-lower semivowel-lower)))
285 (setq place tail tail (cdr tail))))
286 (setq tail (cdr tail))))
288 (setcdr place (cons tone-mark (cdr place)))
289 (quail-delete-region)
290 (insert (lrt-compose-string tone-mark-pattern))
291 (setq quail-current-data nil)
292 (quail-terminate-translation)))))
294 (defmacro lrt-generate-quail-map ()
296 ',(let ((map (list nil))
297 (semi-vowel-key (car lrt-semi-vowel-sign-lo))
298 (semi-vowel-char (cdr lrt-semi-vowel-sign-lo))
299 l1 e1 l2 e2 pattern key)
300 ;; Single consonants.
301 (setq l1 lrt-single-consonant-table)
304 (quail-defrule-internal (car e1) (cdr e1) map)
305 (quail-defrule-internal
306 (concat (car e1) semi-vowel-key)
307 (compose-string (format "%c%c" (cdr e1) semi-vowel-char))
309 (setq l2 lrt-vowel-table)
312 (setq key (concat (car e1) (car e2))
313 pattern (lrt-compose-c-s-v (cdr e1) nil (nthcdr 2 e2)))
314 (quail-defrule-internal key pattern map)
315 (quail-defrule-internal
317 (vector (concat (aref (car pattern) 0) " ")) map)
318 (setq key (concat (car e1) semi-vowel-key (car e2))
319 pattern (lrt-compose-c-s-v (cdr e1) semi-vowel-char
321 (quail-defrule-internal key pattern map)
322 (quail-defrule-internal
324 (vector (concat (aref (car pattern) 0) " ")) map)
328 ;; Double consonants.
329 (setq l1 lrt-double-consonant-table)
332 (quail-defrule-internal (car e1) (vector (cdr e1)) map)
333 (quail-defrule-internal
334 (concat (car e1) semi-vowel-key)
335 (vector (concat (compose-string
336 (format "%c%c" (sref (cdr e1) 0) semi-vowel-char))
337 (substring (cdr e1) (charset-bytes 'lao))))
339 (setq l2 lrt-vowel-table)
342 (setq key (concat (car e1) (car e2))
343 pattern (lrt-compose-c-s-v (cdr e1) nil (nthcdr 2 e2)))
344 (quail-defrule-internal key pattern map)
345 (quail-defrule-internal
347 (vector (concat (aref (car pattern) 0) " ")) map)
348 (setq key (concat (car e1) semi-vowel-key (car e2))
349 pattern (lrt-compose-c-s-v (cdr e1) semi-vowel-char
351 (quail-defrule-internal key pattern map)
352 (quail-defrule-internal
354 (vector (concat (aref (car pattern) 0) " ")) map)
359 (setq l1 lrt-vowel-table)
361 (setq e1 (car l1) l1 (cdr l1))
362 (quail-defrule-internal (car e1) (vector (nth 1 e1)) map))
365 (setq l1 lrt-tone-mark-table)
367 (setq e1 (car l1) l1 (cdr l1))
368 (quail-defrule-internal (car e1) (cdr e1) map))
372 (quail-define-package
373 "lao-lrt" "Lao" "
\e(1"
\e(BR" t
374 "Lao input method using LRT (Lao Roman Transcription)"
375 '(("k" . lrt-handle-maa-sakod)
376 ("g" . lrt-handle-maa-sakod)
377 ("y" . lrt-handle-maa-sakod)
378 ("d" . lrt-handle-maa-sakod)
379 ("n" . lrt-handle-maa-sakod)
380 ("b" . lrt-handle-maa-sakod)
381 ("m" . lrt-handle-maa-sakod)
382 ("v" . lrt-handle-maa-sakod)
383 ("w" . lrt-handle-maa-sakod)
384 ("'" . lrt-handle-tone-mark)
385 ("\"" . lrt-handle-tone-mark)
386 ("^" . lrt-handle-tone-mark)
387 ("+" . lrt-handle-tone-mark)
388 ("~" . lrt-handle-tone-mark))
389 'forget-last-selection 'deterministic 'kbd-translate 'show-layout)
391 (lrt-generate-quail-map)