1 ;;; tibet-util.el --- Support for inputting Tibetan characters
3 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
4 ;; Licensed to the Free Software Foundation.
6 ;; Keywords: multilingual, 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)
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.
25 ;; Author: Toru TOMABECHI, <Toru.Tomabechi@orient.unil.ch>
27 ;; Created: Feb. 17. 1997
30 ;; 1997.03.13 Modification in treatment of text properties;
31 ;; Support for some special signs and punctuations.
36 (defun setup-tibetan-environment ()
38 (setup-english-environment)
39 (setq coding-category-iso-8-2 'tibetan)
41 (setq-default buffer-file-coding-system 'iso-2022-7)
43 (setq default-input-method "quail-tibetan-wylie")
45 (setq sendmail-coding-system 'iso-2022-7
46 rmail-file-coding-system 'iso-2022-7))
48 ;;; This function makes a transcription string for
49 ;;; re-composing a character.
52 (defun tibetan-tibetan-to-transcription (ch)
53 "Return a transcription string of Tibetan character CH"
55 (l (append tibetan-consonant-transcription-alist
56 tibetan-vowel-transcription-alist
57 tibetan-precomposed-transcription-alist
58 tibetan-subjoined-transcription-alist))
59 decomp-l t-char trans str result)
60 (if (eq (char-charset char) 'composition)
61 (setq decomp-l (decompose-composite-char char 'list nil))
62 (setq decomp-l (cons char nil)))
65 (setq t-char (char-to-string (car decomp-l)))
66 (setq trans (car (rassoc t-char l)))
67 (setq str (concat str trans))
68 (setq decomp-l (cdr decomp-l)))
71 ;;; This function translates transcription string into a string of
72 ;;; Tibetan characters.
75 (defun tibetan-transcription-to-tibetan (transcription)
76 "Translate Roman transcription into a sequence of Tibetan components."
77 (let ((trans transcription)
78 (lp tibetan-precomposed-transcription-alist)
79 (l (append tibetan-consonant-transcription-alist
80 tibetan-vowel-transcription-alist
81 tibetan-subjoined-transcription-alist))
82 (case-fold-search nil)
83 substr t-char p-str t-str result)
87 (cond ((string-match tibetan-precomposed-regexp trans)
88 (setq substr (substring trans (match-beginning 0) (match-end 0)))
89 (setq trans (substring trans (match-end 0)))
90 (setq t-char (cdr (assoc substr lp)))
92 (while (string-match tibetan-regexp trans)
93 (setq substr (substring trans (match-beginning 0) (match-end 0)))
94 (setq trans (substring trans 0 (match-beginning 0)))
96 (cdr (assoc substr l)))
97 (setq t-str (concat t-char t-str)))
98 (setq result (concat p-str t-str))))
102 ;;; Functions for composing Tibetan character.
104 ;;; A Tibetan syllable is typically structured as follows:
106 ;;; [Prefix] C [C+] V [M] [Suffix [Post suffix]]
108 ;;; where C's are all vertically stacked, V appears below or above
109 ;;; consonant cluster and M is always put above the C[C+]V combination.
110 ;;; (Sanskrit visarga, though it is a vowel modifier, is considered
111 ;;; to be a punctuation.)
113 ;;; Here are examples of the words "bsgrubs" and "h'uM"
115 ;;;
\e$(7"7
\e2%q`"U
\e1"7"G
\e(B
\e2
\e$(7"H`#A`"U0"_
\e1
\e(B
123 ;;; Consonants ''', 'w', 'y', 'r' take special forms when they are used
124 ;;; as subjoined consonant. Consonant 'r' takes another special form
125 ;;; when used as superjoined as in "rka", and so on, while it does not
126 ;;; change its form when conjoined with subjoined ''', 'w' or 'y'
127 ;;; as in "rwa", "rya".
130 ;;; As a Tibetan input method should avoid using conversion key,
131 ;;; we use a "Tibetan glyph -> transcription -> Tibetan glyph"
132 ;;; translation at each key input.
134 ;;; 1st stage - Check the preceding char.
135 ;;; If the preceding char is Tibetan and composable, then
137 ;;; 2nd stage - Translate the preceding char into transcription
139 ;;; 3rd stage - Concatenate the transcription of preceding char
140 ;;; and the current input key.
142 ;;; 4th stage - Re-translate the concatenated transcription into
143 ;;; a sequence of Tibetan letters.
145 ;;; 5th stage - Convert leading consonants into one single precomposed char
148 ;;; 6th stage - Compose the consonants into one composite glyph.
150 ;;; (If the current input is a vowel sign or a vowel modifier,
151 ;;; then it is composed with preceding char without checking
152 ;;; except when the preceding char is a punctuation or a digit.)
156 ;;; This function is used to avoid composition
157 ;;; between Tibetan and non-Tibetan chars.
160 (defun tibetan-char-examin (ch)
161 "Check if char CH is Tibetan character.
162 Returns non-nil if CH is Tibetan. Otherwise, returns nil."
164 (if (eq (char-charset chr) 'composition)
165 (string-match "\\cq+" (decompose-composite-char chr))
166 (string-match "\\cq" (char-to-string chr)))))
168 ;;; This is used to avoid composition between digits, signs, punctuations
169 ;;; and word constituents.
172 (defun tibetan-composable-examin (ch)
173 "Check if Tibetan char CH is composable.
174 Returns t if CH is a composable char \(i.e. neither punctuation nor digit)."
177 (if (eq (char-charset chr) 'composition)
178 (setq chstr (decompose-composite-char chr))
179 (setq chstr (char-to-string chr)))
180 (not (string-match "[
\e$(7!1
\e(B-
\e$(7!o"f
\e$(8!;!=!?!@!A!D"`
\e(B]" chstr))))
183 ;;; This checks if a character to be composed contains already
184 ;;; one or more vowels / vowel modifiers. If the character contains
185 ;;; them, then no more consonant should be added.
188 (defun tibetan-complete-char-examin (ch)
189 "Check if composite char CH contains one or more vowel/vowel modifiers.
190 Returns non-nil, if CH contains vowel/vowel modifiers."
193 (if (eq (char-charset chr) 'composition)
194 (setq chstr (decompose-composite-char chr))
195 (setq chstr (char-to-string chr)))
196 (string-match "[
\e$(7!g!e"Q
\e(B-
\e$(7"^"_
\e(B-
\e$(7"l
\e(B]" chstr)))
198 ;;; This function makes a composite character consisting of two characters
199 ;;; vertically stacked.
202 (defun tibetan-vertical-stacking (first second upward)
203 "Return a vertically stacked composite char consisting of FIRST and SECOND.
204 If UPWARD is non-nil, then SECOND is put above FIRST."
206 (compose-chars first '(tc . bc) second)
207 (compose-chars first '(bc . tc) second)))
209 ;;; This function makes a composite char from a string.
210 ;;; Note that this function returns a string, not a char.
213 (defun tibetan-compose-string (str)
214 "Compose a sequence of Tibetan character components into a composite character.
215 Returns a string containing a composite character."
217 f-str s-str f-ch s-ch rest composed result)
218 ;;Make sure no redundant vowel sign is present.
220 "^\\(.+\\)\\(
\e$(7"Q
\e(B\\)\\([
\e$(7!I!g!e"Q
\e(B-
\e$(7"^"_
\e(B-
\e$(7"l
\e(B]\\)" t-str)
222 (match-string 1 t-str)
223 (match-string 3 t-str))))
225 "^\\(.+\\)\\([
\e$(7!I!g!e"Q
\e(B-
\e$(7"^"_
\e(B-
\e$(7"l
\e(B]\\)\\(
\e$(7"Q
\e(B\\)" t-str)
227 (match-string 1 t-str)
228 (match-string 2 t-str))))
231 ;; Consecutive base/precomposed consonants are reduced to the last one.
232 (while (string-match "^\\([
\e$(7"!
\e(B-
\e$(7"J$!
\e(B-
\e$(7%u
\e(B]\\)\\([
\e$(7"!
\e(B-
\e$(7"@"B
\e(B-
\e$(7"J$!
\e(B-
\e$(7%u
\e(B].*\\)" t-str)
233 (setq result (concat result (match-string 1 t-str)))
234 (setq t-str (match-string 2 t-str)))
235 ;; Vowel/vowel modifier, subjoined consonants are added one by one
236 ;; to the preceding element.
238 (string-match "^\\(.\\)\\([
\e$(7"A#!
\e(B-
\e$(7#J!I!g!e"Q
\e(B-
\e$(7"^"_
\e(B-
\e$(7"l
\e(B]\\)\\(.*\\)" t-str)
239 (setq f-str (match-string 1 t-str))
240 (setq f-ch (string-to-char f-str))
241 (setq s-str (match-string 2 t-str))
242 ;;Special treatment for 'a chung.
243 ;;If 'a follows a consonant, then turned into its subjoined form.
244 (if (and (string-match "
\e$(7"A
\e(B" s-str)
245 (not (tibetan-complete-char-examin f-ch)))
246 (setq s-str "
\e$(7#A
\e(B"))
247 (setq s-ch (string-to-char s-str))
248 (setq rest (match-string 3 t-str))
249 (cond ((string-match "\\c2" s-str);; upper vowel sign
251 (tibetan-vertical-stacking f-ch s-ch t)))
252 ((string-match "\\c3" s-str);; lower vowel sign
254 (tibetan-vertical-stacking f-ch s-ch nil)))
255 ;;Automatic conversion of ra-mgo (superscribed r).
256 ;;'r' is converted if followed by a subjoined consonant
257 ;;other than w, ', y, r.
258 ((and (string-match "
\e$(7"C
\e(B" f-str)
259 (not (string-match "[
\e$(7#>#A#B#C
\e(B]" s-str)))
260 (setq f-ch ?
\e$(7#P
\e(B)
262 (tibetan-vertical-stacking f-ch s-ch nil)))
263 ((not (tibetan-complete-char-examin f-ch))
264 ;;Initial base consonant is tranformed, if followed by
265 ;;a subjoined consonant, except when it is followed
266 ;;by a subscribed 'a.
267 (if (and (string-match "[
\e$(7"!
\e(B-
\e$(7"="?"@"D
\e(B-
\e$(7"J
\e(B]" f-str)
268 (not (string-match "
\e$(7#A
\e(B" s-str)))
271 (cdr (assoc f-str tibetan-base-to-subjoined-alist)))))
273 (tibetan-vertical-stacking f-ch s-ch nil)))
275 (setq composed s-str)
276 (setq result (concat result f-str))))
277 (setq t-str (concat composed rest)))
278 (setq result (concat result t-str))))
280 ;;; quail <-> conversion interface.
282 (defun tibetan-composition (pc key)
283 "Interface to quail input method.
284 Takes two arguments: char PC and string KEY, where PC is the preceding
285 character to be composed with current input KEY.
286 Returns a string which is the result of composition."
287 (let (trans cur-ch t-str result)
288 ;; Make a tibetan character corresponding to current input key.
289 (setq cur-ch (tibetan-transcription-to-tibetan key))
290 ;; Check if the preceding character is Tibetan and composable.
291 (cond ((and (tibetan-char-examin pc)
292 (tibetan-composable-examin pc))
293 ;;If Tibetan char corresponding to the current input key exists,
296 ;; Convert the preceding character into transcription,
297 ;; and concatenate it with the current input key,
298 (setq trans (tibetan-tibetan-to-transcription pc))
299 (setq trans (concat trans key))
300 ;; Concatenated transcription is converted to
301 ;; a sequence of Tibetan characters,
302 (setq t-str (tibetan-transcription-to-tibetan trans))
303 ;; And it is composed into a composite character.
304 (setq result (tibetan-compose-string t-str)))
307 ;; Simply concatenate the preceding character and
308 ;; the current input key.
309 (setq result (char-to-string pc))
310 (setq result (concat result key)))))
311 ;; If the preceding char is not Tibetan or not composable,
313 ;; pc = 0 means the point is at the beginning of buffer.
315 (setq result (char-to-string pc)))
317 (setq result (concat result cur-ch))
318 (setq result (concat result key))))
323 (defun tibetan-decompose-region (beg end)
324 "Decompose Tibetan characters in the region BEG END into their components.
325 Components are: base and subjoined consonants, vowel signs, vowel modifiers.
326 One column punctuations are converted to their 2 column equivalents."
328 (let (ch-str ch-beg ch-end)
331 (narrow-to-region beg end)
332 (goto-char (point-min))
333 ;; \\cq = Tibetan character
334 (while (re-search-forward "\\cq" nil t)
335 (setq ch-str (buffer-substring-no-properties
336 (match-beginning 0) (match-end 0)))
337 ;; Save the points. Maybe, using save-match-data is preferable.
338 ;; But in order not to lose the trace(because the body is too long),
339 ;; we save the points in variables.
340 (setq ch-beg (match-beginning 0))
341 (setq ch-end (match-end 0))
342 ;; Here starts the decomposition.
344 ;; 1 column punctuations -> 2 column equivalent
345 ((string-match "[
\e$(8!D!;!=!?!@!A"`
\e(B]" ch-str)
347 (car (rassoc ch-str tibetan-precomposition-rule-alist))))
348 ;; Decomposition of composite character.
349 ((eq (char-charset (string-to-char ch-str)) 'composition)
350 ;; Make a string which consists of a sequence of
352 (setq ch-str (decompose-composite-char (string-to-char ch-str)))
353 ;; Converts nyi zla into base elements.
354 (cond ((string= ch-str "
\e$(7#R#S#S#S
\e(B")
355 (setq ch-str "
\e$(7!4!5!5
\e(B"))
356 ((string= ch-str "
\e$(7#R#S#S
\e(B")
357 (setq ch-str "
\e$(7!4!5
\e(B"))
358 ((string= ch-str "
\e$(7#R#S!I
\e(B")
359 (setq ch-str "
\e$(7!6
\e(B"))
360 ((string= ch-str "
\e$(7#R#S
\e(B")
361 (setq ch-str "
\e$(7!4
\e(B")))))
362 ;; If the sequence of components starts with a subjoined consonants,
363 (if (string-match "^\\([
\e$(7#!
\e(B-
\e$(7#J
\e(B]\\)\\(.*\\)$" ch-str)
364 ;; then the first components is converted to its base form.
366 (concat (car (rassoc (match-string 1 ch-str)
367 tibetan-base-to-subjoined-alist))
368 (match-string 2 ch-str))))
369 ;; If the sequence of components starts with a precomposed character,
370 (if (string-match "^\\([
\e$(7$!
\e(B-
\e$(7%u
\e(B]\\)\\(.*\\)$" ch-str)
371 ;; then it is converted into a sequence of components.
373 (concat (car (rassoc (match-string 1 ch-str)
374 tibetan-precomposition-rule-alist))
375 (match-string 2 ch-str))))
376 ;; Special treatment for superscribed r.
377 (if (string-match "^
\e$(7#P
\e(B\\(.*\\)$" ch-str)
378 (setq ch-str (concat "
\e$(7"C
\e(B" (match-string 1 ch-str))))
379 ;; Finally, the result of decomposition is inserted, and
380 ;; the composite character is deleted.
381 (insert-and-inherit ch-str)
382 (delete-region ch-beg ch-end))))))
385 (defun tibetan-compose-region (beg end)
386 "Make composite chars from Tibetan character components in the region BEG END.
387 Two column punctuations are converted to their 1 column equivalents."
392 (narrow-to-region beg end)
393 (goto-char (point-min))
394 ;; First, sequence of components which has a precomposed equivalent
396 (while (re-search-forward
397 tibetan-precomposition-rule-regexp nil t)
398 (setq str (buffer-substring-no-properties
399 (match-beginning 0) (match-end 0)))
402 (cdr (assoc str tibetan-precomposition-rule-alist))))
403 (delete-region (match-beginning 0) (match-end 0)))
404 (goto-char (point-min))
405 ;; Then, composable elements are put into a composite character.
406 (while (re-search-forward
407 "[
\e$(7"!
\e(B-
\e$(7"J$!
\e(B-
\e$(7%u
\e(B]+[
\e$(7#!
\e(B-
\e$(7#J!I!g!e"Q
\e(B-
\e$(7"^"_
\e(B-
\e$(7"l
\e(B]+"
409 (setq str (buffer-substring-no-properties
410 (match-beginning 0) (match-end 0)))
412 (setq result (tibetan-compose-string str))
413 (insert-and-inherit result))
414 (delete-region (match-beginning 0) (match-end 0)))))))
417 ;;; This variable is used to avoid repeated decomposition.
419 (setq-default tibetan-decomposed nil)
422 (defun tibetan-decompose-buffer ()
423 "Decomposes Tibetan characters in the buffer into their components.
424 See also docstring of the function tibetan-decompose-region."
426 (make-local-variable 'tibetan-decomposed)
427 (cond ((not tibetan-decomposed)
428 (tibetan-decompose-region (point-min) (point-max))
429 (setq tibetan-decomposed t))))
432 (defun tibetan-compose-buffer ()
433 "Composes Tibetan character components in the buffer.
434 See also docstring of the function tibetan-compose-region."
436 (make-local-variable 'tibetan-decomposed)
437 (tibetan-compose-region (point-min) (point-max))
438 (setq tibetan-decomposed nil))
441 (defun tibetan-post-read-conversion (len)
444 (let ((buffer-modified-p (buffer-modified-p)))
445 (narrow-to-region (point) (+ (point) len))
446 (tibetan-compose-region (point-min) (point-max))
447 (set-buffer-modified-p buffer-modified-p)
449 (make-local-variable 'tibetan-decomposed)
450 (setq tibetan-decomposed nil))
454 (defun tibetan-pre-write-conversion (from to)
455 (setq tibetan-decomposed-temp tibetan-decomposed)
456 (let ((old-buf (current-buffer))
457 (work-buf (get-buffer-create " *tibetan-work*")))
458 (set-buffer work-buf)
462 (insert-buffer-substring old-buf from to))
463 (if (not tibetan-decomposed-temp)
464 (tibetan-decompose-region (point-min) (point-max)))
465 ;; Should return nil as annotations.
468 (provide 'tibet-util)
470 ;;; language/tibet-util.el ends here.