diff leim/quail/lrt.el @ 26881:cd1cb9bf30e1

Rewritten for new composition.

--- a/leim/quail/lrt.el	Wed Dec 15 00:28:11 1999 +0000
+++ b/leim/quail/lrt.el	Wed Dec 15 00:32:16 1999 +0000
@@ -31,353 +31,22 @@
 ;; key sequence:
 ;;	consonant [+ semi-vowel-sign-lo ] + vowel [+ maa-sakod ] [+ tone-mark ]
 
-(eval-and-compile
-
-;; Upper vowels and tone-marks are put on the letter.
-;; Semi-vowel-sign-lo and lower vowels are put under the letter.
-(defconst lrt-single-consonant-table
-  `(("k" . ?(1!(B)
-    ("kh" . ?(1"(B)
-    ("qh" . ?(1$(B)
-    ("ng" . ?(1'(B)
-    ("j" . ?(1((B)
-    ("s" . ?(1J(B)
-    ("x" . ?(1*(B)
-    ("y" . ?(1-(B)
-    ("d" . ?(14(B)
-    ("t" . ?(15(B)
-    ("th" . ?(16(B)
-    ("dh" . ?(17(B)
-    ("n" . ?(19(B)
-    ("b" . ?(1:(B)
-    ("p" . ?(1;(B)
-    ("hp" . ?(1<(B)
-    ("fh" . ?(1=(B)
-    ("ph" . ?(1>(B)
-    ("f" . ?(1?(B)
-    ("m" . ?(1A(B)
-    ("gn" . ?(1B(B)
-    ("l" . ?(1E(B)
-    ("r" . ?(1C(B)
-    ("v" . ?(1G(B)
-    ("w" . ?(1G(B)
-    ("hh" . ?(1K(B)
-    ("O" . ?(1M(B)
-    ("h" . ?(1N(B)
-    ("nh" . ?(1|(B)
-    ("mh" . ?(1}(B)
-    ("lh" . "0(1K\(B1")
-    ))
-
-;; Semi-vowel-sign-lo is put under the first letter.
-;; Lower vowels are put under the last letter.
-;; Upper vowels and tone-marks are put on the last letter.
-(defconst lrt-double-consonant-table
-  '(("ngh" . "(1K'(B")
-    ("yh" . "(1K](B")
-    ("wh" . "(1KG(B")
-    ("hl" . "(1KE(B")
-    ("hy" . "(1K-(B")         
-    ("hn" . "(1K9(B")
-    ("hm" . "(1KA(B")
-    ))
-
-(defconst lrt-semi-vowel-sign-lo
-  '("r" . ?(1\(B))
-
-(defconst lrt-vowel-table
-  '(("a" "(1P(B" (0 ?(1P(B) (0 ?(1Q(B))
-    ("ar" "(1R(B" (0 ?(1R(B))
-    ("i" "(1T(B" (0 ?(1T(B))
-    ("ii" "(1U(B" (0 ?(1U(B))
-    ("eu" "(1V(B" (0 ?(1V(B))
-    ("ur" "(1W(B" (0 ?(1W(B))
-    ("u" "(1X(B" (0 ?(1X(B))
-    ("uu" "(1Y(B" (0 ?(1Y(B))
-    ("e" "(1`(B (1P(B" (?(1`(B 0 ?(1P(B) (?(1`(B 0 ?(1Q(B))
-    ("ee" "(1`(B" (?(1`(B 0))
-    ("ae" "(1a(B (1P(B" (?(1a(B 0 ?(1P(B) (?(1a(B 0 ?(1Q(B))
-    ("aa" "(1a(B" (?(1a(B 0))
-    ("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))
-    ("oo" "(1b(B" (?(1b(B 0))
-    ("oe" "(1`(B (1RP(B" (?(1`(B 0 ?(1R(B ?(1P(B) (0 ?(1Q(B ?(1M(B))
-    ("or" "(1m(B" (0 ?(1m(B) (0 ?(1M(B))
-    ("er" "(1`(B (1T(B" (?(1`(B 0 ?(1T(B))
-    ("ir" "(1`(B (1U(B" (?(1`(B 0 ?(1U(B))
-    ("ua" "(1[GP(B" (0 ?(1[(B ?(1G(B ?(1P(B) (0 ?(1Q(B ?(1G(B))
-    ("uaa" "(1[G(B" (0 ?(1[(B ?(1G(B) (0 ?(1G(B))
-    ("ie" "(1`Q]P(B" (?(1`(B 0 ?(1Q(B ?(1](B ?(1P(B) (0 ?(1Q(B ?(1](B))
-    ("ia" "(1`Q](B" (?(1`(B 0 ?(1Q(B ?(1](B) (0 ?(1](B))
-    ("ea" "(1`VM(B" (?(1`(B 0 ?(1V(B ?(1M(B))
-    ("eaa" "(1`WM(B" (?(1`(B 0 ?(1W(B ?(1M(B))
-    ("ai" "(1d(B" (?(1d(B 0))
-    ("ei" "(1c(B" (?(1c(B 0))
-    ("ao" "(1`[R(B" (?(1`(B 0 ?(1[(B ?(1R(B))
-    ("aM" "(1S(B" (0 ?(1S(B))))
-
-;; Maa-sakod is put at the tail.
-(defconst lrt-maa-sakod-table
-  '((?k . ?(1!(B)
-    (?g . ?(1'(B)
-    (?y . ?(1-(B)
-    (?d . ?(14(B)
-    (?n . ?(19(B)
-    (?b . ?(1:(B)
-    (?m . ?(1A(B)
-    (?v . ?(1G(B)
-    (?w . ?(1G(B)
-    ))
-
-(defconst lrt-tone-mark-table
-  '(("'" . ?(1h(B)
-    ("\"" . ?(1i(B)
-    ("^" . ?(1j(B)
-    ("+" . ?(1k(B)
-    ("~" . ?(1l(B)))
-
-;; Return list of composing patterns for normal (without maa-sakod)
-;; key sequence and with-maa-sakod key sequence starting with single
-;; consonant C and optional SEMI-VOWEL.
-(defun lrt-composing-pattern-single-c (c semi-vowel vowel-pattern)
-  (let* ((patterns (copy-sequence vowel-pattern))
-	 (tail patterns)
-	 place)
-    ;; Embed C and SEMI-VOWEL (if any) at the place of 0.
-    (while tail
-      ;; At first, make a copy.
-      (setcar tail (copy-sequence (car tail)))
-      ;; Then, do embedding.
-      (setq place (memq 0 (car tail)))
-      (setcar place c)
-      (if semi-vowel
-	  (setcdr place (cons semi-vowel (cdr place))))
-      (setq tail (cdr tail)))
-    patterns))
-
-;; Return list of composing patterns for normal (without maa-sakod)
-;; key sequence and with-maa-sakod key sequence starting with double
-;; consonant STR and optional SEMI-VOWEL.
-(defun lrt-composing-pattern-double-c (str semi-vowel vowel-pattern)
-  (let* ((patterns (copy-sequence vowel-pattern))
-	 (tail patterns)
-	 (chars (string-to-list
-		 (if (= (length str) 1)
-		     (decompose-string str)
-		   str)))
-	 place)
-    ;; Embed C and SEMI-VOWEL (if any) at the place of 0.
-    (while tail
-      ;; At first, make a copy.
-      (setcar tail (copy-sequence (car tail)))
-      ;; Then, do embedding.
-      (setq place (memq 0 (car tail)))
-      (setcar place (car chars))
-      (setcdr place (cons (nth 1 chars) (cdr place)))
-      (if semi-vowel
-	  ;; Embed SEMI-VOWEL in between CHARS.
-	  (setcdr place (cons semi-vowel (cdr place))))
-      (setq tail (cdr tail)))
-    patterns))
-
-;; Return a string made of characters in CHAR-LIST while composing
-;; such characters as vowel-upper, vowel-lower, semi-vowel(lower),
-;; and tone-mark with the preceding base character.
-(defun lrt-compose-string (char-list)
-  ;; Make a copy because the following work alters it.
-  (setq char-list (copy-sequence char-list))
-  (let ((i -1)
-	(l char-list))
-    (while l
-      (if (memq (get-char-code-property (car l) 'phonetic-type)
-		'(vowel-upper vowel-lower semivowel-lower tone))
-	  (let (composed-char)
-	    (if (< i 0)
-		;; No preceding base character.
-		(error "Invalid CHAR-LIST: %s" char-list))
-	    (setq composed-char
-		  (string-to-char (compose-chars (nth i char-list) (car l))))
-	    (setcar (nthcdr i char-list) composed-char)
-	    (setq l (cdr l))
-	    (setcdr (nthcdr i char-list) l))
-	(setq l (cdr l))
-	(setq i (1+ i))))
-    (concat (apply 'vector char-list))))
+(defun quail-lao-update-translation (control-flag)
+  (if (integerp control-flag)
+      ;; Non-composable character typed.
+      (setq quail-current-str
+	    (buffer-substring (overlay-start quail-overlay)
+			      (overlay-end quail-overlay))
+	    unread-command-events
+	    (string-to-list
+	     (substring quail-current-key control-flag)))
+    (let ((lao-str (lao-transcribe-roman-to-lao-string quail-current-key)))
+      (if (> (aref lao-str 0) 255)
+	  (setq quail-current-str lao-str)
+	(or quail-current-str
+	    (setq quail-current-str quail-current-key)))))
+  control-flag)
 
-(defun lrt-compose-c-s-v (consonant semi-vowel vowel-pattern)
-  (let ((pattern-list
-	 (if (integerp consonant)
-	     (lrt-composing-pattern-single-c
-	      consonant semi-vowel vowel-pattern)
-	   (lrt-composing-pattern-double-c
-	    consonant semi-vowel vowel-pattern))))
-    (cons (vector (lrt-compose-string (car pattern-list)))
-	  (cons t pattern-list))))
-
-)
-
-(defun lrt-handle-maa-sakod ()
-  (interactive)
-  (if (or (= (length quail-current-key) 0)
-	  (not quail-current-data))
-      (quail-self-insert-command)
-    (if (not (car quail-current-data))
-	(progn
-	  (setq quail-current-data nil)
-	  (setq unread-command-events
-		(cons last-command-event unread-command-events))
-	  (quail-terminate-translation))
-      (if (not (integerp last-command-event))
-	  (error "Bogus calling sequence"))
-      (let* ((maa-sakod (cdr (assq last-command-event lrt-maa-sakod-table)))
-	     (maa-sakod-pattern (append
-				 (or (cdr (assq maa-sakod
-						(nthcdr 3 quail-current-data)))
-				     (nth 2 quail-current-data)
-				     (nth 1 quail-current-data))
-				 (list maa-sakod))))
-	(quail-delete-region)
-	(setq quail-current-str (lrt-compose-string maa-sakod-pattern))
-	(insert quail-current-str)
-	(quail-show-translations)
-	(setq quail-current-data (list nil maa-sakod-pattern))))))
-
-(defun lrt-handle-tone-mark ()
-  (interactive)
-  (if (= (length quail-current-key) 0)
-      (quail-self-insert-command)
-    (if (not quail-current-data)
-	(progn
-	  (setq unread-command-events
-		(cons last-command-event unread-command-events))
-	  (quail-terminate-translation))
-      (if (not (integerp last-command-event))
-	  (error "Bogus calling sequence"))
-      (let* ((tone-mark (cdr (assoc (char-to-string last-command-event)
-				    lrt-tone-mark-table)))
-	     (tone-mark-pattern
-	      (if (car quail-current-data)
-		  (copy-sequence (nth 1 quail-current-data))
-		;; No need of copy because lrt-handle-maa-sakod should
-		;; have already done it.
-		(nth 1 quail-current-data)))
-	     (tail tone-mark-pattern)
-	     (double-consonant-keys lrt-double-consonant-table)
-	     (double-consonant-flag nil)
-	     place)
-
-	;; Set DOUBLE-CONSONANT-FLAG to t if a user entered a double
-	;; consonant.
-	(while (and double-consonant-keys (not double-consonant-flag))
-	  (setq double-consonant-flag
-		(eq (string-match (car (car double-consonant-keys))
-				  quail-current-key)
-		    0)
-		double-consonant-keys (cdr double-consonant-keys)))
-
-	;; Find a place to embed TONE-MARK.  It should be after a
-	;; single or double consonant and following upper or lower vowels.
-	(while (and tail (not place))
-	  (if (and
-	       (eq (get-char-code-property (car tail) 'phonetic-type)
-		   'consonant)
-	       ;; Skip `(1K(B' if it is the first letter of double consonant.
-	       (or (not double-consonant-flag)
-		   (/= (car tail) ?(1K(B)))
-	      (progn
-		(setq place tail)
-		(setq tail (cdr tail))
-		(while (and tail
-			    (memq (get-char-code-property (car tail)
-							  'phonetic-type)
-				  '(vowel-upper vowel-lower semivowel-lower)))
-		  (setq place tail tail (cdr tail))))
-	    (setq tail (cdr tail))))
-	;; Embed TONE-MARK.
-	(setcdr place (cons tone-mark (cdr place)))
-	(quail-delete-region)
-	(insert (lrt-compose-string tone-mark-pattern))
-	(setq quail-current-data nil)
-	(quail-terminate-translation)))))
-
-(defmacro lrt-generate-quail-map ()
-  `(quail-install-map
-    ',(let ((map (list nil))
-	    (semi-vowel-key (car lrt-semi-vowel-sign-lo))
-	    (semi-vowel-char (cdr lrt-semi-vowel-sign-lo))
-	    l1 e1 l2 e2 pattern key)
-	;; Single consonants.
-	(setq l1 lrt-single-consonant-table)
-	(while l1
-	  (setq e1 (car l1))
-	  (quail-defrule-internal (car e1) (vector (cdr e1)) map)
-	  (quail-defrule-internal
-	   (concat (car e1) semi-vowel-key)
-	   (if (stringp (cdr e1))
-	       (compose-string (format "%s%c" (cdr e1) semi-vowel-char))
-	     (compose-string (format "%c%c" (cdr e1) semi-vowel-char)))
-	   map)
-	  (setq l2 lrt-vowel-table)
-	  (while l2
-	    (setq e2 (car l2))
-	    (setq key (concat (car e1) (car e2))
-		  pattern (lrt-compose-c-s-v (cdr e1) nil (nthcdr 2 e2)))
-	    (quail-defrule-internal key pattern map)
-	    (quail-defrule-internal
-	     (concat key " ")
-	     (vector (concat (aref (car pattern) 0) " "))  map)
-	    (setq key (concat (car e1) semi-vowel-key (car e2))
-		  pattern (lrt-compose-c-s-v (cdr e1) semi-vowel-char
-					     (nthcdr 2 e2)))
-	    (quail-defrule-internal key pattern map)
-	    (quail-defrule-internal
-	     (concat key " ")
-	     (vector (concat (aref (car pattern) 0) " "))  map)
-	    (setq l2 (cdr l2)))
-	  (setq l1 (cdr l1)))
-
-	;; Double consonants.
-	(setq l1 lrt-double-consonant-table)
-	(while l1
-	  (setq e1 (car l1))
-	  (quail-defrule-internal (car e1) (vector (cdr e1)) map)
-	  (quail-defrule-internal
-	   (concat (car e1) semi-vowel-key)
-	   (vector (concat (compose-string
-			    (format "%c%c" (aref (cdr e1) 0) semi-vowel-char))
-			   (substring (cdr e1) 1)))
-	   map)
-	  (setq l2 lrt-vowel-table)
-	  (while l2
-	    (setq e2 (car l2))
-	    (setq key (concat (car e1) (car e2))
-		  pattern (lrt-compose-c-s-v (cdr e1) nil (nthcdr 2 e2)))
-	    (quail-defrule-internal key pattern map)
-	    (quail-defrule-internal
-	     (concat key " ")
-	     (vector (concat (aref (car pattern) 0) " "))  map)
-	    (setq key (concat (car e1) semi-vowel-key (car e2))
-		  pattern (lrt-compose-c-s-v (cdr e1) semi-vowel-char
-					     (nthcdr 2 e2)))
-	    (quail-defrule-internal key pattern map)
-	    (quail-defrule-internal
-	     (concat key " ")
-	     (vector (concat (aref (car pattern) 0) " "))  map)
-	    (setq l2 (cdr l2)))
-	  (setq l1 (cdr l1)))
-
-	;; Vowels.
-	(setq l1 lrt-vowel-table)
-	(while l1
-	  (setq e1 (car l1) l1 (cdr l1))
-	  (quail-defrule-internal (car e1) (vector (nth 1 e1)) map))
-
-	;; Tone-marks.
-	(setq l1 lrt-tone-mark-table)
-	(while l1
-	  (setq e1 (car l1) l1 (cdr l1))
-	  (quail-defrule-internal (car e1) (cdr e1) map))
-
-	map)))
 
 (quail-define-package
  "lao-lrt" "Lao" "(1E(BR" t
@@ -386,38 +55,23 @@
 `\\' (backslash) + `\\'		=> (1f(B		LAO KO LA (REPETITION)
 `\\' (backslash) + `$'		=> (1O(B		LAO ELLIPSIS
 "
- '(("k" . lrt-handle-maa-sakod)
-   ("g" . lrt-handle-maa-sakod)
-   ("y" . lrt-handle-maa-sakod)
-   ("d" . lrt-handle-maa-sakod)
-   ("n" . lrt-handle-maa-sakod)
-   ("b" . lrt-handle-maa-sakod)
-   ("m" . lrt-handle-maa-sakod)
-   ("v" . lrt-handle-maa-sakod)
-   ("w" . lrt-handle-maa-sakod)
-   ("'" . lrt-handle-tone-mark)
-   ("\"" . lrt-handle-tone-mark)
-   ("^" . lrt-handle-tone-mark)
-   ("+" . lrt-handle-tone-mark)
-   ("~" . lrt-handle-tone-mark))
- 'forget-last-selection 'deterministic 'kbd-translate 'show-layout
-  nil nil nil nil nil t)
+ nil 'forget-last-selection 'deterministic 'kbd-translate 'show-layout
+  nil nil nil 'quail-lao-update-translation nil t)
+
+;; LRT (Lao Roman Transcription) input method accepts the following
+;; key sequence:
+;;	consonant [ semi-vowel-sign-lo ] vowel [ maa-sakod ] [ tone-mark ]
 
-(lrt-generate-quail-map)
-
-;; Additional key definitions for Lao digits.
-
-(quail-defrule "\\0" ?(1p(B)
-(quail-defrule "\\1" ?(1q(B)
-(quail-defrule "\\2" ?(1r(B)
-(quail-defrule "\\3" ?(1s(B)
-(quail-defrule "\\4" ?(1t(B)
-(quail-defrule "\\5" ?(1u(B)
-(quail-defrule "\\6" ?(1v(B)
-(quail-defrule "\\7" ?(1w(B)
-(quail-defrule "\\8" ?(1x(B)
-(quail-defrule "\\9" ?(1y(B)
-(quail-defrule "\\\\" ?(1f(B)
-(quail-defrule "\\$" ?(1O(B)
+(quail-install-map
+ (quail-map-from-table
+  '((base-state (lao-transcription-consonant-alist . sv-state)
+		lao-transcription-vowel-alist
+		lao-transcription-tone-alist)
+    (sv-state (lao-transcription-semi-vowel-alist . v-state) 
+	      (lao-transcription-vowel-alist . mt-state))
+    (v-state (lao-transcription-vowel-alist . mt-state))
+    (mt-state (lao-transcription-maa-sakod-alist . t-state) 
+	      lao-transcription-tone-alist)
+    (t-state lao-transcription-tone-alist))))
 
 ;;; quail/lrt.el ends here