Skip to content

GitLab

Commit 653b6bad authored by Kenichi Handa's avatar Kenichi Handa
Browse files
Options

Rewritten for new composition.

parent c674f351
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 513 additions and 1290 deletions
leim/quail/lao.el
View file @ 653b6bad
......@@ -27,240 +27,172 @@
(require 'quail)
(require 'lao-util)
(eval-and-compile
(defconst lao-keyboard-mapping
[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ; control codes
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ; control codes
0 "1" "=" "3" "4" "(1l(B" "5" "(1'(B" ; SPC .. '
"7" "8" "6" "(1mh(B" "(1A(B" "(1*(B" "(1c(B" "(1=(B" ; ( .. /
"(1"(B" "(1B(B" "(1?(B" "(1b(B" "(16(B" "(1X(B" "(1Y(B" "(1$(B" ; 0 .. 7
"(15(B" "(1((B" "%" "(1G(B" "(1}(B" "(1m(B" "$" "\)" ; 8 .. ?
"2" "(1Qi(B" "(1Vi(B" "(1O(B" "." "(1Si(B" "," ":" ; @ .. G
"(1j(B" "(1N(B" "(1k(B" "!" "?" "(1f(B" "(1Wi(B" "(1|(B" ; H .. O
"(1](B" "(1[i(B" "_" ";" "+" "(1Ui(B" "x" "0" ; P .. W
"\(" "(1Ti(B" "\"" "(1:(B" 0 "(1E(B" "(1\(B" "9" ; X .. _
"(1'(B" "(1Q(B" "(1V(B" "(1a(B" "(1!(B" "(1S(B" "(14(B" "(1`(B" ; ` .. g
"(1i(B" "(1C(B" "(1h(B" "(1R(B" "(1J(B" "(17(B" "(1W(B" "(19(B" ; h .. o
"(1-(B" "(1[(B" "(1>(B" "(1K(B" "(1P(B" "(1U(B" "(1M(B" "(1d(B" ; p .. w
"(1;(B" "(1T(B" "(1<(B" "-" "(1K\(B" "/" "~" 0] ; x .. DEL
"A table which maps ASCII key codes to corresponding Lao characters."
)
)
;; Template of a cdr part of a Quail map when a consonant is entered.
(defvar lao-consonant-alist nil)
;; Template of a cdr part of a Quail map when a vowel upper is entered.
(defvar lao-vowel-upper-alist nil)
;; Template of a cdr part of a Quail map when a vowel lower is entered.
(defvar lao-vowel-lower-alist nil)
;; Template of a cdr part of a Quail map when a semivowel lower is entered.
(defvar lao-semivowel-lower-alist nil)
;; Return a Quail map corresponding to KEY of length LEN.
;; The car part of the map is a translation generated automatically.
;; The cdr part of the map is a copy of ALIST.
(defun lao-generate-quail-map (key len alist)
(let ((str "")
(idx 0))
(while (< idx len)
(setq str (concat str (aref lao-keyboard-mapping (aref key idx)))
idx (1+ idx)))
(cons (string-to-char (compose-string str)) (copy-alist alist))))
;; Return a Quail map corresponding to KEY of length LEN when Lao
;; tone mark is entered.
(defun lao-tone-input (key len)
(lao-generate-quail-map key len nil))
;; Return a Quail map corresponding to KEY of length LEN when Lao
;; vowel upper is entered.
(defun lao-vowel-upper-input (key len)
(lao-generate-quail-map key len lao-vowel-upper-alist))
;; Return a Quail map corresponding to KEY of length LEN when Lao
;; vowel lower is entered.
(defun lao-vowel-lower-input (key len)
(lao-generate-quail-map key len lao-vowel-lower-alist))
;; Return a Quail map corresponding to KEY of length LEN when Lao
;; semivowel lower is entered.
(defun lao-semivowel-lower-input (key len)
(lao-generate-quail-map key len lao-semivowel-lower-alist))
;; Return an alist which can be a cdr part of a Quail map
;; corresponding to the current key when Lao consonant is entered.
(defun lao-consonant-input (key len)
(copy-alist lao-consonant-alist))
(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)))
(setq quail-current-str
(compose-string (quail-lookup-map-and-concat quail-current-key))))
control-flag)
(defconst lao-key-alist
'(("!" . "1")
("\"" . "=")
("#" . "3")
("$" . "4")
("&" . "5")
("%" . "(1l(B")
("'" . "(1'(B")
("(" . "7")
(")" . "8")
("*" . "6")
("+" . ["(1mh(B"])
("," . "(1A(B")
("-" . "(1*(B")
("." . "(1c(B")
("/" . "(1=(B")
("0" . "(1"(B")
("1" . "(1B(B")
("2" . "(1?(B")
("3" . "(1b(B")
("4" . "(16(B")
("5" . "(1X(B")
("6" . "(1Y(B")
("7" . "(1$(B")
("8" . "(15(B")
("9" . "(1((B")
(":" . "%")
(";" . "(1G(B")
("<" . "(1}(B")
("=" . "(1m(B")
(">" . "$")
("?" . ")")
("@" . "2")
("A" . ["(1Qi(B"])
("B" . ["(1Vi(B"])
("C" . "(1O(B")
("D" . ".")
("E" . ["(1Si(B"])
("F" . ",")
("G" . ":")
("H" . "(1j(B")
("I" . "(1N(B")
("J" . "(1k(B")
("K" . "!")
("L" . "?")
("M" . "(1f(B")
("N" . ["(1Wi(B"])
("O" . "(1|(B")
("P" . "(1](B")
("Q" . ["(1[i(B"])
("R" . "_")
("S" . ";")
("T" . "+")
("U" . ["(1Ui(B"])
("V" . "x")
("W" . "0")
("X" . "(")
("Y" . ["(1Ti(B"])
("Z" . "\"")
("[" . "(1:(B")
("]" . "(1E(B")
("^" . "(1\(B")
("_" . "9")
("`" . "(1'(B")
("a" . "(1Q(B")
("b" . "(1V(B")
("c" . "(1a(B")
("d" . "(1!(B")
("e" . "(1S(B")
("f" . "(14(B")
("g" . "(1`(B")
("h" . "(1i(B")
("i" . "(1C(B")
("j" . "(1h(B")
("k" . "(1R(B")
("l" . "(1J(B")
("m" . "(17(B")
("n" . "(1W(B")
("o" . "(19(B")
("p" . "(1-(B")
("q" . "(1[(B")
("r" . "(1>(B")
("s" . "(1K(B")
("t" . "(1P(B")
("u" . "(1U(B")
("v" . "(1M(B")
("w" . "(1d(B")
("x" . "(1;(B")
("y" . "(1T(B")
("z" . "(1<(B")
("{" . "-")
("|" . ["(1K\(B"])
("}" . "/")
("~" . "(1l(B")
("\\0" . "(1p(B")
("\\1" . "(1q(B")
("\\2" . "(1r(B")
("\\3" . "(1s(B")
("\\4" . "(1t(B")
("\\5" . "(1u(B")
("\\6" . "(1v(B")
("\\7" . "(1w(B")
("\\8" . "(1x(B")
("\\9" . "(1y(B")
))
(defconst lao-consonant-key-alist nil)
(defconst lao-semivowel-key-alist nil)
(defconst lao-vowel-key-alist nil)
(defconst lao-voweltone-key-alist nil)
(defconst lao-tone-key-alist nil)
(defconst lao-other-key-alist nil)
(let ((tail lao-key-alist)
elt phonetic-type)
(while tail
(setq elt (car tail) tail (cdr tail))
(if (stringp (cdr elt))
(setq phonetic-type (get-char-code-property (aref (cdr elt) 0)
'phonetic-type))
(setq phonetic-type (get-char-code-property (aref (aref (cdr elt) 0) 0)
'phonetic-type))
(aset (cdr elt) 0 (compose-string (aref (cdr elt) 0))))
(cond ((eq phonetic-type 'consonant)
(setq lao-consonant-key-alist (cons elt lao-consonant-key-alist)))
((memq phonetic-type '(vowel-upper vowel-lower))
(if (stringp (cdr elt))
(setq lao-vowel-key-alist (cons elt lao-vowel-key-alist))
(setq lao-voweltone-key-alist
(cons elt lao-voweltone-key-alist))))
((eq phonetic-type 'tone)
(setq lao-tone-key-alist (cons elt lao-tone-key-alist)))
((eq phonetic-type 'semivowel-lower)
(setq lao-semivowel-key-alist (cons elt lao-semivowel-key-alist)))
(t
(setq lao-other-key-alist (cons elt lao-other-key-alist))))))
(quail-define-package
"lao" "Lao" "(1E(B" t
"Lao input method simulating Lao keyboard layout based on Thai TIS620"
nil t t t t nil nil nil nil nil t)
(defmacro lao-quail-define-rules (&rest rules)
(let ((l rules)
consonant-alist
vowel-upper-alist
vowel-lower-alist
semivowel-lower-alist
rule trans ch c-set)
(while l
(setq rule (car l))
(setq trans (nth 1 rule))
(if (consp trans)
(setq trans (car trans)))
(setq c-set (char-category-set (string-to-char trans)))
(cond ((aref c-set ?2) ; vowel upper
(setq consonant-alist
(cons (cons (string-to-char (car rule))
'lao-vowel-upper-input)
consonant-alist)))
((aref c-set ?3) ; vowel lower
(setq consonant-alist
(cons (cons (string-to-char (car rule))
'lao-vowel-lower-input)
consonant-alist)
semivowel-lower-alist
(cons (cons (string-to-char (car rule))
'lao-vowel-lower-input)
semivowel-lower-alist)))
((aref c-set ?4) ; tone
(setq consonant-alist
(cons (cons (string-to-char (car rule))
'lao-tone-input)
consonant-alist)
vowel-upper-alist
(cons (cons (string-to-char (car rule))
'lao-tone-input)
vowel-upper-alist)
vowel-lower-alist
(cons (cons (string-to-char (car rule))
'lao-tone-input)
vowel-lower-alist)))
((aref c-set ?9) ; semivowel lower
(setq consonant-alist
(cons (cons (string-to-char (car rule))
'lao-semivowel-lower-input)
consonant-alist)
vowel-upper-alist
(cons (cons (string-to-char (car rule))
'lao-semivowel-lower-input)
vowel-upper-alist))))
(setq l (cdr l)))
(list 'progn
(cons 'quail-define-rules rules)
`(setq lao-consonant-alist ',consonant-alist
lao-vowel-upper-alist ',vowel-upper-alist
lao-vowel-lower-alist ',vowel-lower-alist
lao-semivowel-lower-alist ',semivowel-lower-alist))))
(lao-quail-define-rules
("!" "1")
("\"" "=")
("#" "3")
("$" "4")
("&" "5")
("%" "(1l(B")
("'" ("(1'(B" . lao-consonant-input))
("(" "7")
(")" "8")
("*" "6")
("+" "0(1mh1(B")
("," ("(1A(B" . lao-consonant-input))
("-" ("(1*(B" . lao-consonant-input))
("." "(1c(B")
("/" ("(1=(B" . lao-consonant-input))
("0" ("(1"(B" . lao-consonant-input))
("1" ("(1B(B" . lao-consonant-input))
("2" ("(1?(B" . lao-consonant-input))
("3" "(1b(B")
("4" ("(16(B" . lao-consonant-input))
("5" "(1X(B")
("6" "(1Y(B")
("7" ("(1$(B" . lao-consonant-input))
("8" ("(15(B" . lao-consonant-input))
("9" ("(1((B" . lao-consonant-input))
(":" "%")
(";" ("(1G(B" . lao-consonant-input))
("<" ("(1}(B" . lao-consonant-input))
("=" "(1m(B")
(">" "$")
("?" ")")
("@" "2")
("A" "0(1Qi1(B")
("B" "0(1Vi1(B")
("C" "(1O(B")
("D" ".")
("E" "0(1Si1(B")
("F" ",")
("G" ":")
("H" "(1j(B")
("I" ("(1N(B" . lao-consonant-input))
("J" "(1k(B")
("K" "!")
("L" "?")
("M" "(1f(B")
("N" "0(1Wi1(B")
("O" ("(1|(B" . lao-consonant-input))
("P" "(1](B")
("Q" "0(1[i1(B")
("R" "_")
("S" ";")
("T" "+")
("U" "0(1Ui1(B")
("V" "x")
("W" "0")
("X" "(")
("Y" "0(1Ti1(B")
("Z" "\"")
("[" ("(1:(B" . lao-consonant-input))
("]" ("(1E(B" . lao-consonant-input))
("^" "(1\(B")
("_" "9")
("`" ("(1'(B" . lao-consonant-input))
("a" "(1Q(B")
("b" "(1V(B")
("c" "(1a(B")
("d" ("(1!(B" . lao-consonant-input))
("e" "(1S(B")
("f" ("(14(B" . lao-consonant-input))
("g" "(1`(B")
("h" "(1i(B")
("i" ("(1C(B" . lao-consonant-input))
("j" "(1h(B")
("k" "(1R(B")
("l" ("(1J(B" . lao-consonant-input))
("m" ("(17(B" . lao-consonant-input))
("n" "(1W(B")
("o" ("(19(B" . lao-consonant-input))
("p" ("(1-(B" . lao-consonant-input))
("q" "(1[(B")
("r" ("(1>(B" . lao-consonant-input))
("s" ("(1K(B" . lao-consonant-input))
("t" "(1P(B")
("u" "(1U(B")
("v" ("(1M(B" . lao-consonant-input))
("w" "(1d(B")
("x" ("(1;(B" . lao-consonant-input))
("y" "(1T(B")
("z" ("(1<(B" . lao-consonant-input))
("{" "-")
("|" ("0(1K\1(B" . lao-consonant-input))
("}" "/")
("~" "(1l(B")
("\\0" "(1p(B")
("\\1" "(1q(B")
("\\2" "(1r(B")
("\\3" "(1s(B")
("\\4" "(1t(B")
("\\5" "(1u(B")
("\\6" "(1v(B")
("\\7" "(1w(B")
("\\8" "(1x(B")
("\\9" "(1y(B")
)
nil t t t t nil nil nil 'quail-lao-update-translation nil t)
(quail-install-map
(quail-map-from-table
'((base-state (lao-consonant-key-alist . svt-state)
lao-vowel-key-alist
lao-voweltone-key-alist
lao-tone-key-alist
lao-other-key-alist)
(svt-state (lao-semivowel-key-alist . v-state)
(lao-vowel-key-alist . t-state)
lao-voweltone-key-alist)
(v-state (lao-vowel-key-alist . t-state))
(t-state lao-tone-key-alist))))
;;; quail/lao.el ends here
leim/quail/lrt.el
View file @ 653b6bad
......@@ -31,353 +31,22 @@
;; key sequence:
;; consonant [+ semi-vowel-sign-lo ] + vowel [+ maa-sakod ] [+ tone-mark ]
(eval-and-compile
(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)
;; 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 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))))