Mercurial > hg > xemacs-beta
annotate lisp/mule/lao-util.el @ 5611:d489e88450aa
Correct the docstring for posix-charset-to-coding-system-hash, mule-cmds.el
lisp/ChangeLog addition:
2011-12-10 Aidan Kehoe <kehoea@parhasard.net>
* mule/mule-cmds.el (posix-charset-to-coding-system-hash):
Correct the docstring for this variable.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Sat, 10 Dec 2011 16:19:16 +0000 |
parents | 4dee0387b9de |
children |
rev | line source |
---|---|
771 | 1 ;;; lao-util.el --- utilities for Lao -*- coding: iso-2022-7bit; -*- |
2 | |
3 ;; Copyright (C) 1997 Electrotechnical Laboratory, JAPAN. | |
4 ;; Licensed to the Free Software Foundation. | |
5 | |
6 ;; Keywords: multilingual, Lao | |
7 | |
8 ;; This file is part of XEmacs. | |
9 | |
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
1769
diff
changeset
|
10 ;; XEmacs is free software: you can redistribute it and/or modify it |
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
1769
diff
changeset
|
11 ;; under the terms of the GNU General Public License as published by the |
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
1769
diff
changeset
|
12 ;; Free Software Foundation, either version 3 of the License, or (at your |
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
1769
diff
changeset
|
13 ;; option) any later version. |
771 | 14 |
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
1769
diff
changeset
|
15 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
1769
diff
changeset
|
16 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
1769
diff
changeset
|
17 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
1769
diff
changeset
|
18 ;; for more details. |
771 | 19 |
20 ;; You should have received a copy of the GNU General Public License | |
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
1769
diff
changeset
|
21 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
771 | 22 |
778 | 23 ;;; Synched up with: Emacs 21.1 (language/lao-util.el). |
24 | |
25 ;;; Commentary: | |
771 | 26 |
27 ;;; Code: | |
28 | |
29 ;; Setting information of Thai characters. | |
30 | |
31 (defconst lao-category-table (make-category-table)) | |
32 (define-category ?c "Lao consonant" lao-category-table) | |
33 (define-category ?s "Lao semi-vowel" lao-category-table) | |
34 (define-category ?v "Lao upper/lower vowel" lao-category-table) | |
35 (define-category ?t "Lao tone" lao-category-table) | |
36 | |
37 (let ((l '((?(1!(B consonant "LETTER KOR KAI'" "CHICKEN") | |
38 (?(1"(B consonant "LETTER KHOR KHAI'" "EGG") | |
39 (?(1#(B invalid nil) | |
40 (?(1$(B consonant "LETTER QHOR QHWARGN" "BUFFALO") | |
41 (?(1%(B invalid nil) | |
42 (? invalid nil) | |
43 (?(1'(B consonant "LETTER NGOR NGUU" "SNAKE") | |
44 (?(1((B consonant "LETTER JOR JUA" "BUDDHIST NOVICE") | |
45 (?(1)(B invalid nil) | |
46 (?(1*(B consonant "LETTER XOR X\"ARNG" "ELEPHANT") | |
47 (?(1+(B invalid nil) | |
48 (?(1,(B invalid nil) | |
49 (?(1-(B consonant "LETTER YOR YUNG" "MOSQUITO") | |
50 (?(1.(B invalid nil) | |
51 (?(1.(B invalid nil) | |
52 (?(1.(B invalid nil) | |
53 (?(1.(B invalid nil) | |
54 (?(1.(B invalid nil) | |
55 (?(1.(B invalid nil) | |
56 (?(14(B consonant "LETTER DOR DANG" "NOSE") | |
57 (?(15(B consonant "LETTER TOR TAR" "EYE") | |
58 (?(16(B consonant "LETTER THOR THUNG" "TO ASK,QUESTION") | |
59 (?(17(B consonant "LETTER DHOR DHARM" "FLAG") | |
60 (?(18(B invalid nil) | |
61 (?(19(B consonant "LETTER NOR NOK" "BIRD") | |
62 (?(1:(B consonant "LETTER BOR BED" "FISHHOOK") | |
63 (?(1;(B consonant "LETTER POR PAR" "FISH") | |
64 (?(1<(B consonant "LETTER HPOR HPER\"" "BEE") | |
65 (?(1=(B consonant "LETTER FHOR FHAR" "WALL") | |
66 (?(1>(B consonant "LETTER PHOR PHUU" "MOUNTAIN") | |
67 (?(1?(B consonant "LETTER FOR FAI" "FIRE") | |
68 (?(1@(B invalid nil) | |
69 (?(1A(B consonant "LETTER MOR MAR\"" "HORSE") | |
70 (?(1B(B consonant "LETTER GNOR GNAR" "MEDICINE") | |
71 (?(1C(B consonant "LETTER ROR ROD" "CAR") | |
72 (?(1D(B invalid nil) | |
73 (?(1E(B consonant "LETTER LOR LIING" "MONKEY") | |
74 (?(1F(B invalid nil) | |
75 (?(1G(B consonant "LETTER WOR WII" "HAND FAN") | |
76 (?(1H(B invalid nil) | |
77 (?(1I(B invalid nil) | |
78 (?(1J(B consonant "LETTER SOR SEA" "TIGER") | |
79 (?(1K(B consonant "LETTER HHOR HHAI" "JAR") | |
80 (?(1L(B invalid nil) | |
81 (?(1M(B consonant "LETTER OR OOW" "TAKE") | |
82 (?(1N(B consonant "LETTER HOR HEA" "BOAT") | |
83 (?(1O(B special "ELLIPSIS") | |
84 (?(1P(B vowel-base "VOWEL SIGN SARA A") | |
85 (?(1Q(B vowel-upper "VOWEL SIGN MAI KAN") | |
86 (?(1R(B vowel-base "VOWEL SIGN SARA AR") | |
87 (?(1S(B vowel-base "VOWEL SIGN SARA AM") | |
88 (?(1T(B vowel-upper "VOWEL SIGN SARA I") | |
89 (?(1U(B vowel-upper "VOWEL SIGN SARA II") | |
90 (?(1V(B vowel-upper "VOWEL SIGN SARA EU") | |
91 (?(1W(B vowel-upper "VOWEL SIGN SARA UR") | |
92 (?(1X(B vowel-lower "VOWEL SIGN SARA U") | |
93 (?(1Y(B vowel-lower "VOWEL SIGN SARA UU") | |
94 (?(1Z(B invalid nil) | |
95 (?(1[(B vowel-upper "VOWEL SIGN MAI KONG") | |
96 (?(1\(B semivowel-lower "SEMIVOWEL SIGN LO") | |
97 (?(1](B vowel-base "SEMIVOWEL SIGN SARA IA") | |
98 (?(1^(B invalid nil) | |
99 (?(1_(B invalid nil) | |
100 (?(1`(B vowel-base "VOWEL SIGN SARA EE") | |
101 (?(1a(B vowel-base "VOWEL SIGN SARA AA") | |
102 (?(1b(B vowel-base "VOWEL SIGN SARA OO") | |
103 (?(1c(B vowel-base "VOWEL SIGN SARA EI MAI MUAN\"") | |
104 (?(1d(B vowel-base "VOWEL SIGN SARA AI MAI MAY") | |
105 (?(1e(B invalid nil) | |
106 (?(1f(B special "KO LA (REPETITION)") | |
107 (?(1g(B invalid nil) | |
108 (?(1h(B tone "TONE MAI EK") | |
109 (?(1i(B tone "TONE MAI THO") | |
110 (?(1j(B tone "TONE MAI TI") | |
111 (?(1k(B tone "TONE MAI JADTAWAR") | |
112 (?(1l(B tone "CANCELLATION MARK") | |
113 (?(1m(B vowel-upper "VOWEL SIGN SARA OR") | |
114 (?(1n(B invalid nil) | |
115 (?(1o(B invalid nil) | |
116 (?(1p(B special "DIGIT ZERO") | |
117 (?(1q(B special "DIGIT ONE") | |
118 (?(1r(B special "DIGIT TWO") | |
119 (?(1s(B special "DIGIT THREE") | |
120 (?(1t(B special "DIGIT FOUR") | |
121 (?(1u(B special "DIGIT FIVE") | |
122 (?(1v(B special "DIGIT SIX") | |
123 (?(1w(B special "DIGIT SEVEN") | |
124 (?(1x(B special "DIGIT EIGHT") | |
125 (?(1y(B special "DIGIT NINE") | |
126 (?(1z(B invalid nil) | |
127 (?(1{(B invalid nil) | |
128 (?(1|(B consonant "LETTER NHOR NHUU" "MOUSE") | |
129 (?(1}(B consonant "LETTER MHOR MHAR" "DOG") | |
130 (?(1~(B invalid nil) | |
131 )) | |
132 elm) | |
133 (while l | |
134 (setq elm (car l) l (cdr l)) | |
135 (let ((char (car elm)) | |
136 (ptype (nth 1 elm))) | |
137 (cond ((eq ptype 'consonant) | |
138 (modify-category-entry char ?c lao-category-table)) | |
139 ((memq ptype '(vowel-upper vowel-lower)) | |
140 (modify-category-entry char ?v lao-category-table)) | |
141 ((eq ptype 'semivowel-lower) | |
142 (modify-category-entry char ?s lao-category-table)) | |
143 ((eq ptype 'tone) | |
144 (modify-category-entry char ?t lao-category-table))) | |
145 (put-char-code-property char 'phonetic-type ptype) | |
146 (put-char-code-property char 'name (nth 2 elm)) | |
147 (put-char-code-property char 'meaning (nth 3 elm))))) | |
148 | |
149 ;; The general composing rules are as follows: | |
150 ;; | |
151 ;; T | |
152 ;; V T V T | |
153 ;; CV -> C, CT -> C, CVT -> C, Cv -> C, CvT -> C | |
154 ;; v v | |
155 ;; T | |
156 ;; V T V T | |
157 ;; CsV -> C, CsT -> C, CsVT -> C, Csv -> C, CvT -> C | |
158 ;; s s s s s | |
159 ;; v v | |
160 | |
161 | |
162 ;; where C: consonant, V: vowel upper, v: vowel lower, | |
163 ;; T: tone mark, s: semivowel lower | |
164 | |
165 (defvar lao-composition-pattern | |
166 "\\cc\\(\\ct\\|\\cv\\ct?\\|\\cs\\(\\ct\\|\\cv\\ct?\\)?\\)" | |
167 "Regular expression matching a Lao composite sequence.") | |
168 | |
169 ;;;###autoload | |
170 (defun lao-compose-string (str) | |
171 (with-category-table lao-category-table | |
172 (let ((idx 0)) | |
173 (while (setq idx (string-match lao-composition-pattern str idx)) | |
174 (compose-string str idx (match-end 0)) | |
175 (setq idx (match-end 0)))) | |
176 str)) | |
177 | |
178 ;;; LRT: Lao <-> Roman Transcription | |
179 | |
180 ;; Upper vowels and tone-marks are put on the letter. | |
181 ;; Semi-vowel-sign-lo and lower vowels are put under the letter. | |
182 | |
183 (defconst lao-transcription-consonant-alist | |
184 (sort '(;; single consonants | |
185 ("k" . "(1!(B") | |
186 ("kh" . "(1"(B") | |
187 ("qh" . "(1$(B") | |
188 ("ng" . "(1'(B") | |
189 ("j" . "(1((B") | |
190 ("s" . "(1J(B") | |
191 ("x" . "(1*(B") | |
192 ("y" . "(1-(B") | |
193 ("d" . "(14(B") | |
194 ("t" . "(15(B") | |
195 ("th" . "(16(B") | |
196 ("dh" . "(17(B") | |
197 ("n" . "(19(B") | |
198 ("b" . "(1:(B") | |
199 ("p" . "(1;(B") | |
200 ("hp" . "(1<(B") | |
201 ("fh" . "(1=(B") | |
202 ("ph" . "(1>(B") | |
203 ("f" . "(1?(B") | |
204 ("m" . "(1A(B") | |
205 ("gn" . "(1B(B") | |
206 ("l" . "(1E(B") | |
207 ("r" . "(1C(B") | |
208 ("v" . "(1G(B") | |
209 ("w" . "(1G(B") | |
210 ("hh" . "(1K(B") | |
211 ("O" . "(1M(B") | |
212 ("h" . "(1N(B") | |
213 ("nh" . "(1|(B") | |
214 ("mh" . "(1}(B") | |
215 ("lh" . ["(1K\(B"]) | |
216 ;; double consonants | |
217 ("ngh" . ["(1K'(B"]) | |
218 ("yh" . ["(1K](B"]) | |
219 ("wh" . ["(1KG(B"]) | |
220 ("hl" . ["(1KE(B"]) | |
221 ("hy" . ["(1K-(B"]) | |
222 ("hn" . ["(1K9(B"]) | |
223 ("hm" . ["(1KA(B"]) | |
224 ) | |
225 (function (lambda (x y) (> (length (car x)) (length (car y))))))) | |
226 | |
227 (defconst lao-transcription-semi-vowel-alist | |
228 '(("r" . "(1\(B"))) | |
229 | |
230 (defconst lao-transcription-vowel-alist | |
231 (sort '(("a" . "(1P(B") | |
232 ("ar" . "(1R(B") | |
233 ("i" . "(1T(B") | |
234 ("ii" . "(1U(B") | |
235 ("eu" . "(1V(B") | |
236 ("ur" . "(1W(B") | |
237 ("u" . "(1X(B") | |
238 ("uu" . "(1Y(B") | |
239 ("e" . ["(1`P(B"]) | |
240 ("ee" . "(1`(B") | |
241 ("ae" . ["(1aP(B"]) | |
242 ("aa" . "(1a(B") | |
243 ("o" . ["(1bP(B"]) | |
244 ("oo" . "(1b(B") | |
245 ("oe" . ["(1`RP(B"]) | |
246 ("or" . "(1m(B") | |
247 ("er" . ["(1`T(B"]) | |
248 ("ir" . ["(1`U(B"]) | |
249 ("ua" . ["(1[GP(B"]) | |
250 ("uaa" . ["(1[G(B"]) | |
251 ("ie" . ["(1`Q]P(B"]) | |
252 ("ia" . ["(1`Q](B"]) | |
253 ("ea" . ["(1`VM(B"]) | |
254 ("eaa" . ["(1`WM(B"]) | |
255 ("ai" . "(1d(B") | |
256 ("ei" . "(1c(B") | |
257 ("ao" . ["(1`[R(B"]) | |
258 ("aM" . "(1S(B")) | |
259 (function (lambda (x y) (> (length (car x)) (length (car y))))))) | |
260 | |
261 ;; Maa-sakod is put at the tail. | |
262 (defconst lao-transcription-maa-sakod-alist | |
263 '(("k" . "(1!(B") | |
264 ("g" . "(1'(B") | |
265 ("y" . "(1-(B") | |
266 ("d" . "(14(B") | |
267 ("n" . "(19(B") | |
268 ("b" . "(1:(B") | |
269 ("m" . "(1A(B") | |
270 ("v" . "(1G(B") | |
271 ("w" . "(1G(B") | |
272 )) | |
273 | |
274 (defconst lao-transcription-tone-alist | |
275 '(("'" . "(1h(B") | |
276 ("\"" . "(1i(B") | |
277 ("^" . "(1j(B") | |
278 ("+" . "(1k(B") | |
279 ("~" . "(1l(B"))) | |
280 | |
281 (defconst lao-transcription-punctuation-alist | |
282 '(("\\0" . "(1p(B") | |
283 ("\\1" . "(1q(B") | |
284 ("\\2" . "(1r(B") | |
285 ("\\3" . "(1s(B") | |
286 ("\\4" . "(1t(B") | |
287 ("\\5" . "(1u(B") | |
288 ("\\6" . "(1v(B") | |
289 ("\\7" . "(1w(B") | |
290 ("\\8" . "(1x(B") | |
291 ("\\9" . "(1y(B") | |
292 ("\\\\" . "(1f(B") | |
293 ("\\$" . "(1O(B"))) | |
294 | |
295 (defconst lao-transcription-pattern | |
296 (concat | |
297 "\\(" | |
298 (mapconcat 'car lao-transcription-consonant-alist "\\|") | |
299 "\\)\\(" | |
300 (mapconcat 'car lao-transcription-semi-vowel-alist "\\|") | |
301 "\\)?\\(\\(" | |
302 (mapconcat 'car lao-transcription-vowel-alist "\\|") | |
303 "\\)\\(" | |
304 (mapconcat 'car lao-transcription-maa-sakod-alist "\\|") | |
305 "\\)?\\(" | |
306 (mapconcat (lambda (x) (regexp-quote (car x))) | |
307 lao-transcription-tone-alist "\\|") | |
308 "\\)?\\)?\\|" | |
309 (mapconcat (lambda (x) (regexp-quote (car x))) | |
310 lao-transcription-punctuation-alist "\\|") | |
311 ) | |
312 "Regexp of Roman transcription pattern for one Lao syllable.") | |
313 | |
1769 | 314 ;; regexp-opt is in packages... |
315 ;(defconst lao-transcription-pattern | |
316 ; (concat | |
317 ; "\\(" | |
318 ; (regexp-opt (mapcar 'car lao-transcription-consonant-alist)) | |
319 ; "\\)\\(" | |
320 ; (regexp-opt (mapcar 'car lao-transcription-semi-vowel-alist)) | |
321 ; "\\)?\\(\\(" | |
322 ; (regexp-opt (mapcar 'car lao-transcription-vowel-alist)) | |
323 ; "\\)\\(" | |
324 ; (regexp-opt (mapcar 'car lao-transcription-maa-sakod-alist)) | |
325 ; "\\)?\\(" | |
326 ; (regexp-opt (mapcar 'car lao-transcription-tone-alist)) | |
327 ; "\\)?\\)?\\|" | |
328 ; (regexp-opt (mapcar 'car lao-transcription-punctuation-alist)) | |
329 ; ) | |
330 ; "Regexp of Roman transcription pattern for one Lao syllable.") | |
771 | 331 |
332 (defconst lao-vowel-reordering-rule | |
333 '(("(1P(B" (0 ?(1P(B) (0 ?(1Q(B)) | |
334 ("(1R(B" (0 ?(1R(B)) | |
335 ("(1T(B" (0 ?(1U(B)) | |
336 ("(1U(B" (0 ?(1U(B)) | |
337 ("(1V(B" (0 ?(1V(B)) | |
338 ("(1W(B" (0 ?(1W(B)) | |
339 ("(1X(B" (0 ?(1X(B)) | |
340 ("(1Y(B" (0 ?(1Y(B)) | |
341 ("(1`P(B" (?(1`(B 0 ?(1P(B) (?(1`(B 0 ?(1Q(B)) | |
342 ("(1`(B" (?(1`(B 0)) | |
343 ("(1aP(B" (?(1a(B 0 ?(1P(B) (?(1a(B 0 ?(1Q(B)) | |
344 ("(1a(B" (?(1a(B 0)) | |
345 ("(1bP(B" (?(1b(B 0 ?(1P(B) (0 ?(1[(B) (?(1-(B ?(1b(B 0 ?(1Q(B) (?(1G(B ?(1b(B 0 ?(1Q(B)) | |
346 ("(1b(B" (?(1b(B 0)) | |
347 ("(1`RP(B" (?(1`(B 0 ?(1R(B ?(1P(B) (0 ?(1Q(B ?(1M(B)) | |
348 ("(1m(B" (0 ?(1m(B) (0 ?(1M(B)) | |
349 ("(1`T(B" (?(1`(B 0 ?(1T(B)) | |
350 ("(1`U(B" (?(1`(B 0 ?(1U(B)) | |
351 ("(1[GP(B" (0 ?(1[(B ?(1G(B ?(1P(B) (0 ?(1Q(B ?(1G(B)) | |
352 ("(1[G(B" (0 ?(1[(B ?(1G(B) (0 ?(1G(B)) | |
353 ("(1`Q]P(B" (?(1`(B 0 ?(1Q(B ?(1](B ?(1P(B) (0 ?(1Q(B ?(1](B)) | |
354 ("(1`Q](B" (?(1`(B 0 ?(1Q(B ?(1](B) (0 ?(1](B)) | |
355 ("(1`VM(B" (?(1`(B 0 ?(1V(B ?(1M(B)) | |
356 ("(1`WM(B" (?(1`(B 0 ?(1W(B ?(1M(B)) | |
357 ("(1d(B" (?(1d(B 0)) | |
358 ("(1c(B" (?(1c(B 0)) | |
359 ("(1`[R(B" (?(1`(B 0 ?(1[(B ?(1R(B)) | |
360 ("(1S(B" (0 ?(1S(B))) | |
361 "Alist of Lao vowel string vs the corresponding re-ordering rule. | |
362 Each element has this form: | |
363 (VOWEL NO-MAA-SAKOD-RULE WITH-MAA-SAKOD-RULE (MAA-SAKOD-0 RULE-0) ...) | |
364 | |
365 VOWEL is a vowel string (e.g. \"(1`Q]P(B\"). | |
366 | |
367 NO-MAA-SAKOD-RULE is a rule to re-order and modify VOWEL following a | |
368 consonant. It is a list vowel characters or 0. The element 0 | |
369 indicate the place to embed a consonant. | |
370 | |
371 Optional WITH-MAA-SAKOD-RULE is a rule to re-order and modify VOWEL | |
5384
3889ef128488
Fix misspelled words, and some grammar, across the entire source tree.
Jerry James <james@xemacs.org>
parents:
1769
diff
changeset
|
372 following a consonant and preceding a maa-sakod character. If it is |
3889ef128488
Fix misspelled words, and some grammar, across the entire source tree.
Jerry James <james@xemacs.org>
parents:
1769
diff
changeset
|
373 nil, NO-MAA-SAKOD-RULE is used. The maa-sakod character is always |
771 | 374 appended at the tail. |
375 | |
376 For instance, rule `(\"(1`WM(B\" (?(1`(B t ?(1W(B ?(1M(B))' tells that this vowel | |
377 string following a consonant `(1!(B' should be re-ordered as \"(1`!WM(B\". | |
378 | |
379 Optional (MAA-SAKOD-n RULE-n) are rules specially applied to maa-sakod | |
380 character MAA-SAKOD-n.") | |
381 | |
382 ;;;###autoload | |
383 (defun lao-transcribe-single-roman-syllable-to-lao (from to &optional str) | |
384 "Transcribe a Romanized Lao syllable in the region FROM and TO to Lao string. | |
385 Only the first syllable is transcribed. | |
386 The value has the form: (START END LAO-STRING), where | |
5384
3889ef128488
Fix misspelled words, and some grammar, across the entire source tree.
Jerry James <james@xemacs.org>
parents:
1769
diff
changeset
|
387 START and END are the beginning and end positions of the Roman Lao syllable, |
771 | 388 LAO-STRING is the Lao character transcription of it. |
389 | |
390 Optional 3rd arg STR, if non-nil, is a string to search for Roman Lao | |
391 syllable. In that case, FROM and TO are indexes to STR." | |
392 (if str | |
393 (if (setq from (string-match lao-transcription-pattern str from)) | |
394 (progn | |
395 (if (>= from to) | |
396 (setq from nil) | |
397 (setq to (match-end 0))))) | |
398 (save-excursion | |
399 (goto-char from) | |
400 (if (setq to (re-search-forward lao-transcription-pattern to t)) | |
401 (setq from (match-beginning 0)) | |
402 (setq from nil)))) | |
403 (if from | |
404 (let* ((consonant (match-string 1 str)) | |
405 (semivowel (match-string 3 str)) | |
406 (vowel (match-string 5 str)) | |
407 (maa-sakod (match-string 8 str)) | |
408 (tone (match-string 9 str)) | |
409 lao-consonant lao-semivowel lao-vowel lao-maa-sakod lao-tone | |
410 clen cidx) | |
411 (setq to (match-end 0)) | |
412 (if (not consonant) | |
413 (setq str (cdr (assoc (match-string 0 str) | |
414 lao-transcription-punctuation-alist))) | |
415 (setq lao-consonant | |
416 (cdr (assoc consonant lao-transcription-consonant-alist))) | |
417 (if (vectorp lao-consonant) | |
418 (setq lao-consonant (aref lao-consonant 0))) | |
419 (setq clen (length lao-consonant)) | |
420 (if semivowel | |
421 ;; Include semivowel in STR. | |
422 (setq lao-semivowel | |
423 (cdr (assoc semivowel lao-transcription-semi-vowel-alist)) | |
424 str (if (= clen 1) | |
425 (concat lao-consonant lao-semivowel) | |
426 (concat (substring lao-consonant 0 1) lao-semivowel | |
427 (substring lao-consonant 1)))) | |
428 (setq str lao-consonant)) | |
429 (if vowel | |
430 (let (rule) | |
431 (setq lao-vowel | |
432 (cdr (assoc vowel lao-transcription-vowel-alist))) | |
433 (if (vectorp lao-vowel) | |
434 (setq lao-vowel (aref lao-vowel 0))) | |
435 (setq rule (assoc lao-vowel lao-vowel-reordering-rule)) | |
436 (if (null maa-sakod) | |
437 (setq rule (nth 1 rule)) | |
438 (setq lao-maa-sakod | |
439 (cdr (assoc maa-sakod lao-transcription-maa-sakod-alist)) | |
440 rule | |
441 (or (cdr (assq (aref lao-maa-sakod 0) (nthcdr 2 rule))) | |
442 (nth 2 rule) | |
443 (nth 1 rule)))) | |
444 (or rule | |
445 (error "Lao vowel %S has no re-ordering rule" lao-vowel)) | |
446 (setq lao-consonant str str "") | |
447 (while rule | |
448 (if (= (car rule) 0) | |
449 (setq str (concat str lao-consonant) | |
450 cidx (length str)) | |
451 (setq str (concat str (list (car rule))))) | |
452 (setq rule (cdr rule))) | |
453 (or cidx | |
454 (error "Lao vowel %S has malformed re-ordering rule" vowel)) | |
455 ;; Set CIDX to after upper or lower vowel if any. | |
456 (let ((len (length str))) | |
457 (while (and (< cidx len) | |
458 (memq (get-char-code-property (aref str cidx) | |
459 'phonetic-type) | |
460 '(vowel-lower vowel-upper))) | |
461 (setq cidx (1+ cidx)))) | |
462 (if lao-maa-sakod | |
463 (setq str (concat str lao-maa-sakod))) | |
464 (if tone | |
465 (setq lao-tone | |
466 (cdr (assoc tone lao-transcription-tone-alist)) | |
467 str (concat (substring str 0 cidx) lao-tone | |
468 (substring str cidx))))))) | |
469 (list from to (lao-compose-string str))))) | |
470 | |
471 ;;;###autoload | |
472 (defun lao-transcribe-roman-to-lao-string (str) | |
473 "Transcribe Romanized Lao string STR to Lao character string." | |
474 (let ((from 0) | |
475 (to (length str)) | |
476 (lao-str "") | |
477 val) | |
478 (while (setq val (lao-transcribe-single-roman-syllable-to-lao from to str)) | |
479 (let ((start (car val)) | |
480 (end (nth 1 val)) | |
481 (lao (nth 2 val))) | |
482 (if (> start from) | |
483 (setq lao-str (concat lao-str (substring str from start) lao)) | |
484 (setq lao-str (concat lao-str lao))) | |
485 (setq from end))) | |
486 (if (< from to) | |
487 (concat lao-str (substring str from to)) | |
488 lao-str))) | |
489 | |
490 ;;;###autoload | |
491 (defun lao-composition-function (from to pattern &optional string) | |
492 "Compose Lao text in the region FROM and TO. | |
493 The text matches the regular expression PATTERN. | |
494 Optional 4th argument STRING, if non-nil, is a string containing text | |
495 to compose. | |
496 | |
497 The return value is number of composed characters." | |
498 (if (< (1+ from) to) | |
499 (prog1 (- to from) | |
500 (if string | |
501 (compose-string string from to) | |
502 (compose-region from to)) | |
503 (- to from)))) | |
504 | |
505 ;;;###autoload | |
506 (defun lao-compose-region (from to) | |
507 (interactive "r") | |
508 (save-restriction | |
509 (narrow-to-region from to) | |
510 (goto-char (point-min)) | |
511 (with-category-table lao-category-table | |
512 (while (re-search-forward lao-composition-pattern nil t) | |
513 (compose-region (match-beginning 0) (point)))))) | |
514 | |
515 ;; | |
516 (provide 'lao-util) | |
517 | |
518 ;;; lao-util.el ends here |