(lisp, shortlisp): byte-run, float-sup, map-ynp, and
[emacs.git] / leim / quail / tibetan.el
blob2bca014a7f8a498682406c55a8597fc9ba546cf5
1 ;;; tibetan.el --- Quail package for inputting Tibetan characters
3 ;; Copyright (C) 1995 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
6 ;; Keywords: multilingual, input method, Tibetan
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)
13 ;; any later version.
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
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
24 ;; Author: Toru TOMABECHI, <Toru.Tomabechi@orient.unil.ch>
26 ;; Created: Feb. 17. 1997
28 ;; History:
29 ;; 1997.03.13 Support for inputting special signs and punctuations added.
30 ;; (Only Ext. Wylie input)
32 ;;; Commentary:
34 ;;; Code:
36 (require 'quail)
37 (require 'tibet-util)
39 ;; Now quail-current-key is set to Tibetan-Roman transcription. We
40 ;; set quail-current-str to the corresponding Tibetan string (composed
41 ;; if necessary). Both Wylie and TibKey input methods use this
42 ;; function.
44 (defun quail-tibetan-update-translation (control-flag)
45 (if (numberp control-flag)
46 ;; Non-composable-character typed.
47 (setq quail-current-str
48 (buffer-substring (overlay-start quail-overlay)
49 (overlay-end quail-overlay))
50 unread-command-events
51 (string-to-list
52 (substring quail-current-key control-flag)))
53 ;; Special treatment of "-d..." and "-y...".
54 (if (string-match "^-[dy]" quail-current-key)
55 (setq quail-current-key (substring quail-current-key 1)))
56 (let ((str (tibetan-transcription-to-tibetan quail-current-key)))
57 ;; If quail-current-key is for punctuations, it can't be
58 ;; transcribed by tibetan-transcription-to-tibetan, thus STR
59 ;; contains ASCII string now. In that case, use the current
60 ;; characters set in quail-current-str.
61 (if (> (aref str 0) 255)
62 (setq quail-current-str (tibetan-compose-string str))
63 (or quail-current-str
64 (setq quail-current-str quail-current-key)))))
65 control-flag)
67 ;;; Wylie transcription based input methods.
69 ;; Special alist for `\e$(7"A\e(B'. It must be treated as a subjoined
70 ;; consonant if it follows a consonant.
71 ;; * Removed by Tomabechi 2000/06/10 *
72 ;; 'a chung must be explicitly typed as a vowel ("fa")
73 ;; \e$(7"A\e(B is now treated as normal base consonants
74 ;; (defconst tibetan-wylie-quote-alist '(("'" . ?\e$(7"A\e(B)))
76 ;; Special alist to avoid default stacking.
77 (defconst tibetan-wylie-non-stacking-alist
78 '(("-d" . "\e$(7"2\e(B")
79 ("-y" . "\e$(7"B\e(B")))
81 ;; Punctuations are not transcribed.
83 (defconst tibetan-wylie-punctuation-alist
84 '(("." . " ")
85 (":" . "\e$(7"`\e(B")
86 (" " . "\e$(7!;\e(B")
87 ("/" . "\e$(7!=\e(B")
88 ("//" . "\e$(7!>\e(B")
89 ("////" . ["\e$(7!>\e(B \e$(7!>\e(B"])
90 ("$" . "\e$(7!?\e(B")
91 ("/\"" . "\e$(7!@\e(B") ; Not defined in Ext. Wylie.
92 ("&" . "\e$(7!@\e(B")
93 (";" . "\e$(7!A\e(B")
94 ("%" . "\e$(7!D\e(B")
95 ("!" . "\e$(7!8\e(B")
96 ("<" . "\e$(7!l\e(B")
97 (">" . "\e$(7!m\e(B")
98 ("@" . "\e$(7"f\e(B")
99 ("*" . ["\e$(7!4!5\e(B"])
100 ("#" . ["\e$(7!4!5!5\e(B"])
101 ("^" . "\e$(7!6\e(B")
102 ("0" . "\e$(7!P\e(B")
103 ("1" . "\e$(7!Q\e(B")
104 ("2" . "\e$(7!R\e(B")
105 ("3" . "\e$(7!S\e(B")
106 ("4" . "\e$(7!T\e(B")
107 ("5" . "\e$(7!U\e(B")
108 ("6" . "\e$(7!V\e(B")
109 ("7" . "\e$(7!W\e(B")
110 ("8" . "\e$(7!X\e(B")
111 ("9" . "\e$(7!Y\e(B")
112 ("-0" . "\e$(7!c\e(B")
113 ("-1" . "\e$(7!Z\e(B")
114 ("-2" . "\e$(7![\e(B")
115 ("-3" . "\e$(7!\\e(B")
116 ("-4" . "\e$(7!]\e(B")
117 ("-5" . "\e$(7!^\e(B")
118 ("-6" . "\e$(7!_\e(B")
119 ("-7" . "\e$(7!`\e(B")
120 ("-8" . "\e$(7!a\e(B")
121 ("-9" . "\e$(7!b\e(B")
122 ("|" . "\e$(7!0!1!2!3!7!9!:!B!C!E!F!G!H!I!J!K!L!M!N!O!d!f!h!j!k!n!o#O#P#Q#R#S#T#U#V#W#X#Y#Z#[#\#]#`\e(B")))
124 (quail-define-package "tibetan-wylie" "Tibetan" "TIBw" t
125 "Tibetan character input by Extended Wylie key assignment.
127 +-------------------------------------+
128 |\e$(7"!!;\e(B k |\e$(7""!;\e(B kh |\e$(7"#!;\e(B g |\e$(7"$!;\e(B gh |\e$(7"%!;\e(B ng| \e$(7"S\e(B i \e$(7!=\e(B /
129 |\e$(7"&!;\e(B c |\e$(7"'!;\e(B ch |\e$(7"(!;\e(B j | |\e$(7"*!;\e(B ny| \e$(7"U\e(B u \e$(7!>\e(B //
130 |\e$(7"+!;\e(B T |\e$(7",!;\e(B TH |\e$(7"-!;\e(B D |\e$(7".!;\e(B DH |\e$(7"/!;\e(B N | \e$(7"[\e(B e \e$(7!>\e(B \e$(7!>\e(B ////
131 |\e$(7"0!;\e(B t |\e$(7"1!;\e(B th |\e$(7"2!;\e(B d |\e$(7"3!;\e(B dh |\e$(7"4!;\e(B n | \e$(7"]\e(B o \e$(7!A\e(B ;
132 |\e$(7"5!;\e(B p |\e$(7"6!;\e(B ph |\e$(7"7!;\e(B b |\e$(7"8!;\e(B bh |\e$(7"9!;\e(B m | \e$(7"\\e(B ai (ee, E) \e$(7!?\e(B $
133 |\e$(7":!;\e(B ts|\e$(7";!;\e(B tsh|\e$(7"<!;\e(B dz |\e$(7"=!;\e(B dzh|\e$(7">!;\e(B w | \e$(7"^\e(B au (oo, O) \e$(7!@\e(B &
134 |\e$(7"?!;\e(B zh|\e$(7"@!;\e(B z |\e$(7"A!;\e(B ' | |\e$(7"B!;\e(B y | \e$(7"a\e(B I \e$(7!4!5\e(B *
135 |\e$(7"C!;\e(B r |\e$(7"D!;\e(B l |\e$(7"E!;\e(B sh |\e$(7"F!;\e(B SH |\e$(7"G!;\e(B s | \e$(7"`\e(B : \e$(7!4!5!5\e(B #
136 |\e$(7"H!;\e(B h |\e$(7"I!;\e(B A |\e$(7"J!;\e(B kSH| | | \e$(7"_\e(B M \e$(7!l\e(B \e$(7!m\e(B < >
137 +-------------------------------------+ \e$(7!D\e(B %
138 (The consonant \e$(7"I!;\e(B must be typed explicitly.)
140 NOT SPECIFIED IN EXT. WYLIE:
141 +--------------------------------------------------------+
142 |\e$(7"c\e(B = ~ |\e$(7"d\e(B = ` |\e$(7"e\e(B = , |\e$(7"f\e(B = @ |\e$(7!g\e(B = _o|\e$(7!e\e(B = _O|\e$(7!6\e(B = ^|
143 +--------------------------------------------------------+
144 |\e$(7"i\e(B = x |\e$(7"j\e(B = X |\e$(7"g\e(B = v |\e$(7"h\e(B = V |\e$(7"k\e(B = q |\e$(7"l\e(B = Q |
145 +-----------------------------------------------+
147 SPECIAL KEYS
148 + : Consonant Stacking
149 \(Consonant stacking for ordinary Tibetan is done automatically)
150 - : No Consonant Stacking
151 \(To suppress automatic stacking for \"g-y\",
152 and to get da-drag in -r-d, -l-d .)
153 | : Special signs.
155 Tsheg is assigned to SPC. Space is assigned to period '.'.
157 nil nil nil nil nil nil nil nil
158 'quail-tibetan-update-translation)
160 ;; Here we build up a Quail map for a Tibtan sequence the whole of
161 ;; which can be one composition.
163 ;; A Tibetan syllable is typically structured as follows:
164 ;; [P] C [c+] V [M] [S [s]]
165 ;; ^^^^^^^^^^^^
166 ;; where P:prefix, C:base consonant, c:subjoined consonant,
167 ;; V:vowel, M:vowel modifier, S:suffix, s:post suffix.
168 ;; In this pattern, the part indicated by "^^^" can be one composition.
170 ;;; modified by Tomabechi 1999/12/10
171 ;;; modified by Tomabechi 2000/06/08
172 ;;; Allows infinite addition of vowels/modifiers
173 ;;; as specified in Unicode v.3
174 (quail-install-map
175 (quail-map-from-table
176 '((base-state (tibetan-consonant-transcription-alist . svm-state)
177 (tibetan-precomposed-transcription-alist . svm-state)
178 (tibetan-wylie-non-stacking-alist . svm-state)
179 tibetan-subjoined-transcription-alist
180 tibetan-vowel-transcription-alist
181 tibetan-modifier-transcription-alist
182 tibetan-wylie-punctuation-alist)
183 (svm-state ;;(tibetan-wylie-quote-alist . vm-state)
184 (tibetan-vowel-transcription-alist . vm-state)
185 (tibetan-subjoined-transcription-alist . svm-state)
186 (tibetan-modifier-transcription-alist . m-state))
187 (vm-state (tibetan-vowel-transcription-alist . vm-state)
188 (tibetan-modifier-transcription-alist . m-state))
189 (m-state (tibetan-modifier-transcription-alist . m-state)))))
192 ;;; TibKey key alignment based input method
195 (defconst tibetan-tibkey-to-transcription-alist
196 '(;; consonant
197 ("`" . "`") ; sna ldan
198 ("~" . "~") ; sna ldan + nada
199 ("q" . "k") ; ka
200 ("Q" ."kSH") ; kSHa
201 ("w" . "kh") ; kha
202 ("e" . "g") ; ga
203 ("r" . "ng") ; nga
204 ("t" . "c") ; ca
205 ("T" . "I") ; gi gu log
206 ("y" . "ch") ; cha
207 ("u" . "j") ; ja
208 ("i" . "ny") ; nya
209 ("o" . "t") ; ta
210 ("O" . "T") ; Ta
211 ("p" . "th") ; tha
212 ("P" . "TH") ; THa
213 ("[" . "d") ; da
214 ("{" . "D") ; Da
215 ("]" . "n") ; na
216 ("}" . "N") ; Na
217 ("a" . "p") ; pa
218 ("A" . "a") ; Vowel a (not used in original TibKey)
219 ("s" . "ph") ; pha
220 ("d" . "b") ; ba
221 ("f" . "m") ; ma
222 ("F" . "M") ; anusvara
223 ("g" . "u") ; zhabs kyu
224 ("G" . "i") ; gi gu
225 ("H" . ",") ; viraama
226 ("j" . "o") ; naro
227 ("J" . "e") ; 'greng bu
228 ("k" . "ts") ; tsa
229 ("l" . "tsh") ; tsha
230 (";" . "dz") ; dza
231 ("'" . "w") ; wa
232 ("\"" . "+w") ; wa zur
233 ("z" . "zh") ; zha
234 ("x" . "z") ; za
235 ("c" . "'") ; 'a
236 ("C" . "+'") ; 'a chung
237 ("v" . "y") ; ya
238 ("V" . "+y") ; ya btags
239 ("b" . "r") ; ra
240 ("B" . "+r") ; ra btags
241 ("n" . "l") ; la
242 ("N" . "+l") ; la btags
243 ("m" . "sh") ; sha
244 ("M" . "SH") ; SHa
245 ("," . "s") ; sa
246 ("." . "h") ; ha
247 ("/" . "A") ; Aa
248 ;; subjoined
249 ("hq" . "+k") ; ka
250 ("hQ" ."+kSH") ; kSHa
251 ("hw" . "+kh") ; kha
252 ("he" . "+g") ; ga
253 ("hr" . "+ng") ; nga
254 ("ht" . "+c") ; ca
255 ("hy" . "+ch") ; cha
256 ("hu" . "+j") ; ja
257 ("hi" . "+ny") ; nya
258 ("ho" . "+t") ; ta
259 ("hO" . "+T") ; Ta
260 ("hp" . "+th") ; tha
261 ("hP" . "+TH") ; THa
262 ("h[" . "+d") ; da
263 ("h{" . "+D") ; Da
264 ("h]" . "+n") ; na
265 ("h}" . "+N") ; Na
266 ("ha" . "+p") ; pa
267 ("hs" . "+ph") ; pha
268 ("hd" . "+b") ; ba
269 ("hf" . "+m") ; ma
270 ("hk" . "+ts") ; tsa
271 ("hl" . "+tsh") ; tsha
272 ("h;" . "+dz") ; dza
273 ("h'" . "+w") ; wa
274 ("hz" . "+zh") ; zha
275 ("hx" . "+z") ; za
276 ("hc" . "+'") ; 'a
277 ("hv" . "+y") ; ya
278 ("hb" . "+r") ; ra
279 ("hn" . "+l") ; la
280 ("hm" . "+sh") ; sha
281 ("hM" . "+SH") ; SHa
282 ("h," . "+s") ; sa
283 ("h." . "+h") ; ha
284 ("h/" . "+A") ; Aa
285 ;; Special rule for `\e$(7"B\e(B' to avoid stacking.
286 ("E" . "-y")
289 (defconst tibetan-consonant-tibkey-alist nil)
290 (defconst tibetan-subjoined-tibkey-alist nil)
291 (defconst tibetan-vowel-tibkey-alist nil)
292 (defconst tibetan-modifier-tibkey-alist nil)
293 (defconst tibetan-non-stacking-tibkey-alist nil)
295 (let ((type-list '("consonant" "subjoined" "vowel" "modifier" "non-stacking"))
296 (tail tibetan-tibkey-to-transcription-alist)
297 elt)
298 (while tail
299 (setq elt (car tail) tail (cdr tail))
300 (let ((types type-list)
301 type transcription trans-alist tibkey-alist)
302 (while types
303 (setq type (car types) types (cdr types))
304 (setq trans-alist
305 (if (string= type "non-stacking")
306 'tibetan-wylie-non-stacking-alist
307 (intern (format "tibetan-%s-transcription-alist" type)))
308 transcription
309 (cdr (assoc (cdr elt) (symbol-value trans-alist))))
310 (when transcription
311 (setq tibkey-alist (intern (format "tibetan-%s-tibkey-alist" type)))
312 (set tibkey-alist
313 (cons (cons (car elt) transcription)
314 (symbol-value tibkey-alist)))))
315 (or tibkey-alist
316 (error "No Tibetan transcription for %s" (cdr elt))))))
318 (defconst tibetan-punctuation-tibkey-alist
319 '(("1" . "\e$(7!Q\e(B")
320 ("!" . "\e$(7!4\e(B") ; nyi zla long
321 ("2" . "\e$(7!R\e(B")
322 ("@" . "\e$(7!5\e(B") ; nyi zla simple
323 ("3" . "\e$(7!S\e(B")
324 ;;; ("#" )
325 ("4" . "\e$(7!T\e(B")
326 ;;; ("$" )
327 ("5" . "\e$(7!U\e(B")
328 ("%" . "\e$(7!D\e(B")
329 ("6" . "\e$(7!V\e(B")
330 ("^" . "\e$(7!1\e(B")
331 ("7" . "\e$(7!W\e(B")
332 ("8" . "\e$(7!X\e(B")
333 ;;; ("*" ) ; avagraha, not supported yet
334 ("9" . "\e$(7!Y\e(B")
335 ("(" . "\e$(7!l\e(B")
336 ("0" . "\e$(7!P\e(B")
337 (")" . "\e$(7!m\e(B")
338 ;;; ("-" ) ; enphatic, not yet supported
339 ;;; ("_" ) ; id.
340 ;;; ("=" ) ; special sign, not yet supported
341 ("+" . "\e$(7!A\e(B")
342 ("\\" . "\e$(7!?\e(B")
343 ("|" . "\e$(7!8\e(B")
344 ("I" . "\e$(7"f\e(B") ; avagraha
345 (":" . "\e$(7"`\e(B")
346 ;;; (">" ?\e$(7!;\e(B) ; to be assigned to SPC
347 (">" . " ")
348 ("?" . "\e$(7!=\e(B")
349 ("??" . "\e$(7!>\e(B")
350 ("????" . ["\e$(7!>\e(B \e$(7!>\e(B"])
351 (" " . "\e$(7!;\e(B")
354 ;; Convert TibKey string to Tibetan-Roman transcription string.
355 ;; If there's no proper conversion, return nil.
356 (defun quail-tibkey-to-transcription (tibkey)
357 (let ((len (length tibkey))
358 (i 0)
359 (trans-list nil))
360 (while (< i len)
361 (let ((last len)
362 trans)
363 (while (and (not trans) (> last i))
364 (or (setq trans (cdr (assoc (substring tibkey i last)
365 tibetan-tibkey-to-transcription-alist)))
366 (setq last (1- last))))
367 (if trans
368 (setq trans-list (cons trans trans-list)
369 i last)
370 (setq trans-list nil i len))))
371 (apply 'concat (nreverse trans-list))))
373 (defvar quail-tibkey-characters nil)
375 (defun quail-tibkey-update-translation (control-flag)
376 (if (integerp control-flag)
377 ;; Non-composable-character typed.
378 (setq quail-current-str
379 (buffer-substring (overlay-start quail-overlay)
380 (overlay-end quail-overlay))
381 unread-command-events
382 (string-to-list
383 (substring quail-current-key control-flag)))
384 (let ((transcription (quail-tibkey-to-transcription quail-current-key)))
385 (if (> (length transcription) 0)
386 (let ((quail-current-key transcription))
387 (setq control-flag
388 (quail-tibetan-update-translation control-flag)))
389 (or quail-current-str
390 (setq quail-current-str quail-current-key)))))
391 control-flag)
393 (quail-define-package "tibetan-tibkey" "Tibetan" "TIBt" t
394 "Tibetan character input by TibKey key assignment.
396 \(This implementation is still incomplete.
397 Therefore, the following key assignment is a provisional one.)
399 [NOT SHIFTED]
401 +-------------------------------------------------------+
402 |`\e$(7"d\e(B|1\e$(7!Q\e(B|2\e$(7!R\e(B|3\e$(7!S\e(B|4\e$(7!T\e(B|5\e$(7!U\e(B|6\e$(7!V\e(B|7\e$(7!W\e(B|8\e$(7!X\e(B|9\e$(7!Y\e(B|0\e$(7!P\e(B|- |= |\\\e$(7!8\e(B|
403 +-------------------------------------------------------+
404 |q\e$(7"!\e(B|w\e$(7""\e(B|e\e$(7"#\e(B|r\e$(7"%\e(B|t\e$(7"&\e(B|y\e$(7"'\e(B|u\e$(7"(\e(B|i\e$(7"*\e(B|o\e$(7"0\e(B|p\e$(7"1\e(B|[\e$(7"2\e(B|]\e$(7"4\e(B|
405 +-----------------------------------------------+
406 |a\e$(7"5\e(B| s\e$(7"6\e(B| d\e$(7"7\e(B|f\e$(7"9\e(B|g\e$(7"U\e(B|h |j\e$(7"]\e(B|k\e$(7":\e(B|l\e$(7";\e(B|;\e$(7"<\e(B|'\e$(7">\e(B|
407 +---------------------------------------------+
408 |z\e$(7"?\e(B|x\e$(7"@\e(B|c\e$(7"A\e(B|v\e$(7"B\e(B|b\e$(7"C\e(B|n\e$(7"D\e(B|m\e$(7"E\e(B|,\e$(7"G\e(B|.\e$(7"H\e(B|/\e$(7"I\e(B|
409 +---------------------------------------+
410 The key 'h' is used for consonant stacking.
412 [SHIFTED]
414 +----------------------------------------------------------+
415 |~\e$(7"c\e(B|!\e$(7!4\e(B|@\e$(7!5\e(B|# |$ |%\e$(7!D\e(B |^\e$(7!1\e(B|& |* |(\e$(7!l\e(B|)\e$(7!m\e(B|_ |+\e$(7!A\e(B| |\e$(7!8\e(B|
416 +----------------------------------------------------------+
417 |Q\e$(7"J\e(B|W |E |R |T\e$(7"a\e(B|Y |U |I\e$(7"f\e(B|O\e$(7"+\e(B|P\e$(7",\e(B|{\e$(7"-\e(B|}\e$(7"/\e(B|
418 +-----------------------------------------------+
419 |A |S |D |F\e$(7"_\e(B|G\e$(7"S\e(B|H\e$(7"e\e(B|J\e$(7"[\e(B|K |L |:\e$(7"`\e(B|\"\e$(7#>\e(B|
420 +-------------------------------------------+
421 |Z |X |C\e$(7"R\e(B|V\e$(7#B\e(B|B\e$(7#C\e(B|N\e$(7#D\e(B|M\e$(7"F\e(B|< |> |?\e$(7!=\e(B |
422 +---------------------------------------+
424 DIFFERENCE FROM THE ORIGINAL TIBKEY:
426 1. Vowel 'a' should be typed explicitly by the key 'A'.
427 This is really inconvenient. But to make the coding
428 scheme clear, it is desirable to have an explicite
429 vowel sign for 'a'.
430 2. Tsheg is assigned to SPC key. You can input a space
431 by typing '>'.
432 4. To avoid the default stacking \e$(7$B\e(B and to obtain \e$(7"#"B\e(B,
433 type 'E' instead of 'v' (=\e$(7"B\e(B).
434 3. There are many characters that are not supported in the
435 current implementation (especially special signs). I hope
436 I'll complete in a future revision.
438 nil nil nil nil nil nil nil nil
439 'quail-tibkey-update-translation)
441 (quail-install-map
442 (quail-map-from-table
443 '((base-state (tibetan-consonant-tibkey-alist . s-state)
444 (tibetan-non-stacking-tibkey-alist . s-state)
445 tibetan-subjoined-tibkey-alist
446 tibetan-vowel-tibkey-alist
447 tibetan-modifier-tibkey-alist
448 tibetan-punctuation-tibkey-alist)
449 (s-state (tibetan-subjoined-tibkey-alist . s-state)
450 (tibetan-vowel-tibkey-alist . m-state))
451 (m-state tibetan-modifier-tibkey-alist))))
453 ;;; tibetan.el ends here