Mercurial > emacs
annotate lisp/language/tibet-util.el @ 91962:37c6e66c7e57
*** empty log message ***
author | Michael Albinus <michael.albinus@gmx.de> |
---|---|
date | Tue, 19 Feb 2008 19:23:19 +0000 |
parents | 606f2d163a64 |
children | 865352429518 |
rev | line source |
---|---|
36685 | 1 ;;; tibet-util.el --- utilities for Tibetan -*- coding: iso-2022-7bit; -*- |
17301 | 2 |
79711 | 3 ;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 |
74544 | 4 ;; Free Software Foundation, Inc. |
74605
6ee41fdd69ff
Update AIST copyright years.
Kenichi Handa <handa@m17n.org>
parents:
74544
diff
changeset
|
5 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
79711 | 6 ;; 2005, 2006, 2007, 2008 |
62396 | 7 ;; National Institute of Advanced Industrial Science and Technology (AIST) |
8 ;; Registration Number H14PRO021 | |
17301 | 9 |
10 ;; Keywords: multilingual, Tibetan | |
11 | |
12 ;; This file is part of GNU Emacs. | |
13 | |
14 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
15 ;; it under the terms of the GNU General Public License as published by | |
78309
0938de05f510
Restore comma mistakenly removed in last change.
Glenn Morris <rgm@gnu.org>
parents:
78300
diff
changeset
|
16 ;; the Free Software Foundation; either version 3, or (at your option) |
17301 | 17 ;; any later version. |
18 | |
19 ;; GNU Emacs is distributed in the hope that it will be useful, | |
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
22 ;; GNU General Public License for more details. | |
23 | |
24 ;; You should have received a copy of the GNU General Public License | |
25 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
64085 | 26 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
27 ;; Boston, MA 02110-1301, USA. | |
17301 | 28 |
29 ;; Author: Toru TOMABECHI, <Toru.Tomabechi@orient.unil.ch> | |
30 | |
31 ;; Created: Feb. 17. 1997 | |
32 | |
38436
b174db545cfd
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
36685
diff
changeset
|
33 ;;; History: |
17301 | 34 ;; 1997.03.13 Modification in treatment of text properties; |
35 ;; Support for some special signs and punctuations. | |
26896 | 36 ;; 1999.10.25 Modification for a new composition way by K.Handa. |
17301 | 37 |
38436
b174db545cfd
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
36685
diff
changeset
|
38 ;;; Commentary: |
b174db545cfd
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
36685
diff
changeset
|
39 |
17301 | 40 ;;; Code: |
41 | |
45032
29a7076e3736
(tibetan-obsolete-glyphs): From tibetan.el.
Richard M. Stallman <rms@gnu.org>
parents:
42839
diff
changeset
|
42 (defconst tibetan-obsolete-glyphs |
89483 | 43 `(("$(7!=(B" . "$(7!=(B") ; 2 col <-> 1 col |
44 ("$(7!?(B" . "$(7!?(B") | |
45 ("$(7!@(B" . "$(7!@(B") | |
46 ("$(7!A(B" . "$(7!A(B") | |
47 ("$(7"`(B" . "$(7"`(B") | |
48 ("$(7!;(B" . "$(7!;(B") | |
49 ("$(7!D(B" . "$(7!D(B") | |
45032
29a7076e3736
(tibetan-obsolete-glyphs): From tibetan.el.
Richard M. Stallman <rms@gnu.org>
parents:
42839
diff
changeset
|
50 ;; Yes these are dirty. But ... |
29a7076e3736
(tibetan-obsolete-glyphs): From tibetan.el.
Richard M. Stallman <rms@gnu.org>
parents:
42839
diff
changeset
|
51 ("$(7!>(B $(7!>(B" . ,(compose-string "$(7!>(B $(7!>(B" 0 3 [?$(7!>(B (Br . Bl) ? (Br . Bl) ?$(7!>(B])) |
29a7076e3736
(tibetan-obsolete-glyphs): From tibetan.el.
Richard M. Stallman <rms@gnu.org>
parents:
42839
diff
changeset
|
52 ("$(7!4!5!5(B" . ,(compose-string |
29a7076e3736
(tibetan-obsolete-glyphs): From tibetan.el.
Richard M. Stallman <rms@gnu.org>
parents:
42839
diff
changeset
|
53 "$(7#R#S#S#S(B" 0 4 |
29a7076e3736
(tibetan-obsolete-glyphs): From tibetan.el.
Richard M. Stallman <rms@gnu.org>
parents:
42839
diff
changeset
|
54 [?$(7#R(B (Br . Bl) ?$(7#S(B (Br . Bl) ?$(7#S(B (Br . Bl) ?$(7#S(B])) |
29a7076e3736
(tibetan-obsolete-glyphs): From tibetan.el.
Richard M. Stallman <rms@gnu.org>
parents:
42839
diff
changeset
|
55 ("$(7!4!5(B" . ,(compose-string "$(7#R#S#S(B" 0 3 [?$(7#R(B (Br . Bl) ?$(7#S(B (Br . Bl) ?$(7#S(B])) |
29a7076e3736
(tibetan-obsolete-glyphs): From tibetan.el.
Richard M. Stallman <rms@gnu.org>
parents:
42839
diff
changeset
|
56 ("$(7!6(B" . ,(compose-string "$(7#R#S!I(B" 0 3 [?$(7#R(B (Br . Bl) ?$(7#S(B (br . tr) ?$(7!I(B])) |
29a7076e3736
(tibetan-obsolete-glyphs): From tibetan.el.
Richard M. Stallman <rms@gnu.org>
parents:
42839
diff
changeset
|
57 ("$(7!4(B" . ,(compose-string "$(7#R#S(B" 0 2 [?$(7#R(B (Br . Bl) ?$(7#S(B])))) |
29a7076e3736
(tibetan-obsolete-glyphs): From tibetan.el.
Richard M. Stallman <rms@gnu.org>
parents:
42839
diff
changeset
|
58 |
17993
73869115ae0a
Most of setup-LANGUAGE-environment functions are
Kenichi Handa <handa@m17n.org>
parents:
17776
diff
changeset
|
59 ;;;###autoload |
26896 | 60 (defun tibetan-char-p (ch) |
61 "Check if char CH is Tibetan character. | |
62 Returns non-nil if CH is Tibetan. Otherwise, returns nil." | |
63 (memq (char-charset ch) '(tibetan tibetan-1-column))) | |
64 | |
65 ;;; Functions for Tibetan <-> Tibetan-transcription. | |
17301 | 66 |
67 ;;;###autoload | |
26896 | 68 (defun tibetan-tibetan-to-transcription (str) |
69 "Transcribe Tibetan string STR and return the corresponding Roman string." | |
70 (let (;; Accumulate transcriptions here in reverse order. | |
71 (trans nil) | |
72 (len (length str)) | |
73 (i 0) | |
74 ch this-trans) | |
75 (while (< i len) | |
29828 | 76 (let ((idx (string-match tibetan-precomposition-rule-regexp str i))) |
26896 | 77 (if (eq idx i) |
78 ;; Ith character and the followings matches precomposable | |
79 ;; Tibetan sequence. | |
80 (setq i (match-end 0) | |
81 this-trans | |
82 (car (rassoc | |
83 (cdr (assoc (match-string 0 str) | |
84 tibetan-precomposition-rule-alist)) | |
85 tibetan-precomposed-transcription-alist))) | |
86 (setq ch (substring str i (1+ i)) | |
87 i (1+ i) | |
88 this-trans | |
89 (car (or (rassoc ch tibetan-consonant-transcription-alist) | |
90 (rassoc ch tibetan-vowel-transcription-alist) | |
91 (rassoc ch tibetan-subjoined-transcription-alist))))) | |
92 (setq trans (cons this-trans trans)))) | |
93 (apply 'concat (nreverse trans)))) | |
17301 | 94 |
95 ;;;###autoload | |
26896 | 96 (defun tibetan-transcription-to-tibetan (str) |
97 "Convert Tibetan Roman string STR to Tibetan character string. | |
98 The returned string has no composition information." | |
99 (let (;; Case is significant. | |
17301 | 100 (case-fold-search nil) |
26896 | 101 (idx 0) |
102 ;; Accumulate Tibetan strings here in reverse order. | |
103 (t-str-list nil) | |
104 i subtrans) | |
105 (while (setq i (string-match tibetan-regexp str idx)) | |
106 (if (< idx i) | |
107 ;; STR contains a pattern that doesn't match Tibetan | |
108 ;; transcription. Include the pattern as is. | |
109 (setq t-str-list (cons (substring str idx i) t-str-list))) | |
110 (setq subtrans (match-string 0 str) | |
111 idx (match-end 0)) | |
112 (let ((t-char (cdr (assoc subtrans | |
113 tibetan-precomposed-transcription-alist)))) | |
114 (if t-char | |
115 ;; SUBTRANS corresponds to a transcription for | |
116 ;; precomposable Tibetan sequence. | |
117 (setq t-char (car (rassoc t-char | |
118 tibetan-precomposition-rule-alist))) | |
119 (setq t-char | |
120 (cdr | |
121 (or (assoc subtrans tibetan-consonant-transcription-alist) | |
122 (assoc subtrans tibetan-vowel-transcription-alist) | |
123 (assoc subtrans tibetan-modifier-transcription-alist) | |
124 (assoc subtrans tibetan-subjoined-transcription-alist))))) | |
125 (setq t-str-list (cons t-char t-str-list)))) | |
126 (if (< idx (length str)) | |
127 (setq t-str-list (cons (substring str idx) t-str-list))) | |
128 (apply 'concat (nreverse t-str-list)))) | |
17301 | 129 |
130 ;;; | |
26896 | 131 ;;; Functions for composing/decomposing Tibetan sequence. |
17301 | 132 ;;; |
133 ;;; A Tibetan syllable is typically structured as follows: | |
134 ;;; | |
135 ;;; [Prefix] C [C+] V [M] [Suffix [Post suffix]] | |
136 ;;; | |
137 ;;; where C's are all vertically stacked, V appears below or above | |
138 ;;; consonant cluster and M is always put above the C[C+]V combination. | |
139 ;;; (Sanskrit visarga, though it is a vowel modifier, is considered | |
140 ;;; to be a punctuation.) | |
141 ;;; | |
29828 | 142 ;;; Here are examples of the words "bsgrubs" and "hfauM" |
17301 | 143 ;;; |
89304
5b82d8f14d06
(tibetan-composition-function): Change
Kenichi Handa <handa@m17n.org>
parents:
42839
diff
changeset
|
144 ;;; $(7"7"G###C"U"7"G(B $(7"H"R"U"_(B |
17301 | 145 ;;; |
146 ;;; M | |
147 ;;; b s b s h | |
29828 | 148 ;;; g fa |
17301 | 149 ;;; r u |
150 ;;; u | |
151 ;;; | |
26896 | 152 ;;; Consonants `'' ($(7"A(B), `w' ($(7">(B), `y' ($(7"B(B), `r' ($(7"C(B) take special |
153 ;;; forms when they are used as subjoined consonant. Consonant `r' | |
154 ;;; takes another special form when used as superjoined in such a case | |
155 ;;; as "rka", while it does not change its form when conjoined with | |
156 ;;; subjoined `'', `w' or `y' as in "rwa", "rya". | |
157 | |
158 ;; Append a proper composition rule and glyph to COMPONENTS to compose | |
159 ;; CHAR with a composition that has COMPONENTS. | |
17301 | 160 |
26896 | 161 (defun tibetan-add-components (components char) |
162 (let ((last (last components)) | |
163 (stack-upper '(tc . bc)) | |
164 (stack-under '(bc . tc)) | |
29596
c3845ffcb423
Convert all tibetan-1-column characters
Kenichi Handa <handa@m17n.org>
parents:
29363
diff
changeset
|
165 rule comp-vowel tmp) |
26896 | 166 ;; Special treatment for 'a chung. |
167 ;; If 'a follows a consonant, turn it into the subjoined form. | |
29596
c3845ffcb423
Convert all tibetan-1-column characters
Kenichi Handa <handa@m17n.org>
parents:
29363
diff
changeset
|
168 ;; * Disabled by Tomabechi 2000/06/09 * |
c3845ffcb423
Convert all tibetan-1-column characters
Kenichi Handa <handa@m17n.org>
parents:
29363
diff
changeset
|
169 ;; Because in Unicode, $(7"A(B may follow directly a consonant without |
89483 | 170 ;; any intervening vowel, as in $(7"9"""Q"A!;(B=$(7"9(B $(7""(B $(7"A(B not $(7"9(B $(7""(B $(7"Q(B $(7"A(B |
29596
c3845ffcb423
Convert all tibetan-1-column characters
Kenichi Handa <handa@m17n.org>
parents:
29363
diff
changeset
|
171 ;;(if (and (= char ?$(7"A(B) |
c3845ffcb423
Convert all tibetan-1-column characters
Kenichi Handa <handa@m17n.org>
parents:
29363
diff
changeset
|
172 ;; (aref (char-category-set (car last)) ?0)) |
c3845ffcb423
Convert all tibetan-1-column characters
Kenichi Handa <handa@m17n.org>
parents:
29363
diff
changeset
|
173 ;; (setq char ?$(7"R(B)) ;; modified for new font by Tomabechi 1999/12/10 |
17301 | 174 |
29596
c3845ffcb423
Convert all tibetan-1-column characters
Kenichi Handa <handa@m17n.org>
parents:
29363
diff
changeset
|
175 ;; Composite vowel signs are decomposed before being added |
c3845ffcb423
Convert all tibetan-1-column characters
Kenichi Handa <handa@m17n.org>
parents:
29363
diff
changeset
|
176 ;; Added by Tomabechi 2000/06/08 |
c3845ffcb423
Convert all tibetan-1-column characters
Kenichi Handa <handa@m17n.org>
parents:
29363
diff
changeset
|
177 (if (memq char '(?$(7"T(B ?$(7"V(B ?$(7"W(B ?$(7"X(B ?$(7"Y(B ?$(7"Z(B ?$(7"b(B)) |
c3845ffcb423
Convert all tibetan-1-column characters
Kenichi Handa <handa@m17n.org>
parents:
29363
diff
changeset
|
178 (setq comp-vowel |
29828 | 179 (copy-sequence |
180 (cddr (assoc (char-to-string char) | |
181 tibetan-composite-vowel-alist))) | |
29596
c3845ffcb423
Convert all tibetan-1-column characters
Kenichi Handa <handa@m17n.org>
parents:
29363
diff
changeset
|
182 char |
c3845ffcb423
Convert all tibetan-1-column characters
Kenichi Handa <handa@m17n.org>
parents:
29363
diff
changeset
|
183 (cadr (assoc (char-to-string char) |
c3845ffcb423
Convert all tibetan-1-column characters
Kenichi Handa <handa@m17n.org>
parents:
29363
diff
changeset
|
184 tibetan-composite-vowel-alist)))) |
26896 | 185 (cond |
186 ;; Compose upper vowel sign vertically over. | |
187 ((aref (char-category-set char) ?2) | |
188 (setq rule stack-upper)) | |
17301 | 189 |
26896 | 190 ;; Compose lower vowel sign vertically under. |
191 ((aref (char-category-set char) ?3) | |
89483 | 192 (if (or (eq char ?$(7"Q(B) ;; `$(7"Q(B' and `$,1FP(B' should not visible when composed. |
193 (eq char #xF70)) | |
29363
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
194 (setq rule nil) |
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
195 (setq rule stack-under))) |
26896 | 196 ;; Transform ra-mgo (superscribed r) if followed by a subjoined |
197 ;; consonant other than w, ', y, r. | |
198 ((and (= (car last) ?$(7"C(B) | |
29363
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
199 (not (memq char '(?$(7#>(B ?$(7"R(B ?$(7#B(B ?$(7#C(B)))) |
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
200 (setcar last ?$(7!"(B) ;; modified for newfont by Tomabechi 1999/12/10 |
26896 | 201 (setq rule stack-under)) |
202 ;; Transform initial base consonant if followed by a subjoined | |
203 ;; consonant but 'a. | |
204 (t | |
205 (let ((laststr (char-to-string (car last)))) | |
29363
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
206 (if (and (/= char ?$(7"R(B) ;; modified for new font by Tomabechi |
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
207 (string-match "[$(7"!(B-$(7"="?"@"D(B-$(7"J"K(B]" laststr)) |
26896 | 208 (setcar last (string-to-char |
209 (cdr (assoc (char-to-string (car last)) | |
210 tibetan-base-to-subjoined-alist))))) | |
211 (setq rule stack-under)))) | |
17301 | 212 |
29363
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
213 (if rule |
29596
c3845ffcb423
Convert all tibetan-1-column characters
Kenichi Handa <handa@m17n.org>
parents:
29363
diff
changeset
|
214 (setcdr last (list rule char))) |
c3845ffcb423
Convert all tibetan-1-column characters
Kenichi Handa <handa@m17n.org>
parents:
29363
diff
changeset
|
215 ;; Added by Tomabechi 2000/06/08 |
c3845ffcb423
Convert all tibetan-1-column characters
Kenichi Handa <handa@m17n.org>
parents:
29363
diff
changeset
|
216 (if comp-vowel |
c3845ffcb423
Convert all tibetan-1-column characters
Kenichi Handa <handa@m17n.org>
parents:
29363
diff
changeset
|
217 (nconc last comp-vowel)) |
c3845ffcb423
Convert all tibetan-1-column characters
Kenichi Handa <handa@m17n.org>
parents:
29363
diff
changeset
|
218 )) |
17301 | 219 |
220 ;;;###autoload | |
221 (defun tibetan-compose-string (str) | |
26896 | 222 "Compose Tibetan string STR." |
223 (let ((idx 0)) | |
224 ;; `$(7"A(B' is included in the pattern for subjoined consonants | |
225 ;; because we treat it specially in tibetan-add-components. | |
29596
c3845ffcb423
Convert all tibetan-1-column characters
Kenichi Handa <handa@m17n.org>
parents:
29363
diff
changeset
|
226 ;; (This feature is removed by Tomabechi 2000/06/08) |
26896 | 227 (while (setq idx (string-match tibetan-composable-pattern str idx)) |
228 (let ((from idx) | |
229 (to (match-end 0)) | |
230 components) | |
231 (if (eq (string-match tibetan-precomposition-rule-regexp str idx) idx) | |
232 (setq idx (match-end 0) | |
233 components | |
234 (list (string-to-char | |
235 (cdr | |
236 (assoc (match-string 0 str) | |
237 tibetan-precomposition-rule-alist))))) | |
238 (setq components (list (aref str idx)) | |
239 idx (1+ idx))) | |
240 (while (< idx to) | |
241 (tibetan-add-components components (aref str idx)) | |
242 (setq idx (1+ idx))) | |
243 (compose-string str from to components)))) | |
244 str) | |
17301 | 245 |
19553
e63ba5228950
(tibetan-composition): Add autoload cookies.
Kenichi Handa <handa@m17n.org>
parents:
19366
diff
changeset
|
246 ;;;###autoload |
26896 | 247 (defun tibetan-compose-region (beg end) |
248 "Compose Tibetan text the region BEG and END." | |
17301 | 249 (interactive "r") |
26896 | 250 (let (str result chars) |
17301 | 251 (save-excursion |
252 (save-restriction | |
253 (narrow-to-region beg end) | |
254 (goto-char (point-min)) | |
26896 | 255 ;; `$(7"A(B' is included in the pattern for subjoined consonants |
256 ;; because we treat it specially in tibetan-add-components. | |
29596
c3845ffcb423
Convert all tibetan-1-column characters
Kenichi Handa <handa@m17n.org>
parents:
29363
diff
changeset
|
257 ;; (This feature is removed by Tomabechi 2000/06/08) |
26896 | 258 (while (re-search-forward tibetan-composable-pattern nil t) |
259 (let ((from (match-beginning 0)) | |
260 (to (match-end 0)) | |
261 components) | |
262 (goto-char from) | |
263 (if (looking-at tibetan-precomposition-rule-regexp) | |
264 (progn | |
265 (setq components | |
266 (list (string-to-char | |
267 (cdr | |
268 (assoc (match-string 0) | |
269 tibetan-precomposition-rule-alist))))) | |
270 (goto-char (match-end 0))) | |
271 (setq components (list (char-after from))) | |
272 (forward-char 1)) | |
273 (while (< (point) to) | |
274 (tibetan-add-components components (following-char)) | |
275 (forward-char 1)) | |
276 (compose-region from to components))))))) | |
17301 | 277 |
29363
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
278 (defvar tibetan-decompose-precomposition-alist |
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
279 (mapcar (function (lambda (x) (cons (string-to-char (cdr x)) (car x)))) |
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
280 tibetan-precomposition-rule-alist)) |
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
281 |
17301 | 282 ;;;###autoload |
29363
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
283 (defun tibetan-decompose-region (from to) |
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
284 "Decompose Tibetan text in the region FROM and TO. |
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
285 This is different from decompose-region because precomposed Tibetan characters |
42839 | 286 are decomposed into normal Tibetan character sequences." |
29363
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
287 (interactive "r") |
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
288 (save-restriction |
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
289 (narrow-to-region from to) |
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
290 (decompose-region from to) |
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
291 (goto-char from) |
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
292 (while (not (eobp)) |
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
293 (let* ((char (following-char)) |
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
294 (slot (assq char tibetan-decompose-precomposition-alist))) |
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
295 (if slot |
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
296 (progn |
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
297 (delete-char 1) |
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
298 (insert (cdr slot))) |
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
299 (forward-char 1)))))) |
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
300 |
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
301 |
26896 | 302 ;;;###autoload |
29363
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
303 (defun tibetan-decompose-string (str) |
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
304 "Decompose Tibetan string STR. |
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
305 This is different from decompose-string because precomposed Tibetan characters |
42839 | 306 are decomposed into normal Tibetan character sequences." |
29363
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
307 (let ((new "") |
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
308 (len (length str)) |
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
309 (idx 0) |
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
310 char slot) |
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
311 (while (< idx len) |
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
312 (setq char (aref str idx) |
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
313 slot (assq (aref str idx) tibetan-decompose-precomposition-alist) |
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
314 new (concat new (if slot (cdr slot) (char-to-string char))) |
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
315 idx (1+ idx))) |
1ebd8db9c3dc
(tibetan-add-components): Fixes for new
Kenichi Handa <handa@m17n.org>
parents:
28906
diff
changeset
|
316 new)) |
26896 | 317 |
318 ;;;###autoload | |
89304
5b82d8f14d06
(tibetan-composition-function): Change
Kenichi Handa <handa@m17n.org>
parents:
42839
diff
changeset
|
319 (defun tibetan-composition-function (pos &optional string) |
26896 | 320 (if string |
91202
018583232611
(tibetan-composition-function): Use
Kenichi Handa <handa@m17n.org>
parents:
90996
diff
changeset
|
321 (if auto-compose-current-font |
018583232611
(tibetan-composition-function): Use
Kenichi Handa <handa@m17n.org>
parents:
90996
diff
changeset
|
322 (if (eq (string-match "[$(7!0(B-$,1GQ(B]+" pos) pos) |
018583232611
(tibetan-composition-function): Use
Kenichi Handa <handa@m17n.org>
parents:
90996
diff
changeset
|
323 (or (font-shape-text 0 (match-end 0) auto-compose-current-font |
018583232611
(tibetan-composition-function): Use
Kenichi Handa <handa@m17n.org>
parents:
90996
diff
changeset
|
324 string) |
018583232611
(tibetan-composition-function): Use
Kenichi Handa <handa@m17n.org>
parents:
90996
diff
changeset
|
325 pos))) |
018583232611
(tibetan-composition-function): Use
Kenichi Handa <handa@m17n.org>
parents:
90996
diff
changeset
|
326 (goto-char pos) |
018583232611
(tibetan-composition-function): Use
Kenichi Handa <handa@m17n.org>
parents:
90996
diff
changeset
|
327 (if auto-compose-current-font |
018583232611
(tibetan-composition-function): Use
Kenichi Handa <handa@m17n.org>
parents:
90996
diff
changeset
|
328 (if (looking-at "[$(7!0(B-$,1GQ(B]+") |
018583232611
(tibetan-composition-function): Use
Kenichi Handa <handa@m17n.org>
parents:
90996
diff
changeset
|
329 (or (font-shape-text pos (match-end 0) auto-compose-current-font) |
018583232611
(tibetan-composition-function): Use
Kenichi Handa <handa@m17n.org>
parents:
90996
diff
changeset
|
330 pos) |
89304
5b82d8f14d06
(tibetan-composition-function): Change
Kenichi Handa <handa@m17n.org>
parents:
42839
diff
changeset
|
331 (if (looking-at tibetan-composable-pattern) |
5b82d8f14d06
(tibetan-composition-function): Change
Kenichi Handa <handa@m17n.org>
parents:
42839
diff
changeset
|
332 (prog1 (match-end 0) |
5b82d8f14d06
(tibetan-composition-function): Change
Kenichi Handa <handa@m17n.org>
parents:
42839
diff
changeset
|
333 (tibetan-compose-region pos (match-end 0)))))))) |
17301 | 334 |
335 ;;; | |
336 ;;; This variable is used to avoid repeated decomposition. | |
337 ;;; | |
338 (setq-default tibetan-decomposed nil) | |
339 | |
340 ;;;###autoload | |
341 (defun tibetan-decompose-buffer () | |
342 "Decomposes Tibetan characters in the buffer into their components. | |
26896 | 343 See also the documentation of the function `tibetan-decompose-region'." |
17301 | 344 (interactive) |
345 (make-local-variable 'tibetan-decomposed) | |
346 (cond ((not tibetan-decomposed) | |
347 (tibetan-decompose-region (point-min) (point-max)) | |
348 (setq tibetan-decomposed t)))) | |
349 | |
350 ;;;###autoload | |
351 (defun tibetan-compose-buffer () | |
352 "Composes Tibetan character components in the buffer. | |
353 See also docstring of the function tibetan-compose-region." | |
354 (interactive) | |
355 (make-local-variable 'tibetan-decomposed) | |
356 (tibetan-compose-region (point-min) (point-max)) | |
357 (setq tibetan-decomposed nil)) | |
358 | |
359 ;;;###autoload | |
360 (defun tibetan-post-read-conversion (len) | |
361 (save-excursion | |
362 (save-restriction | |
363 (let ((buffer-modified-p (buffer-modified-p))) | |
364 (narrow-to-region (point) (+ (point) len)) | |
365 (tibetan-compose-region (point-min) (point-max)) | |
366 (set-buffer-modified-p buffer-modified-p) | |
20107
4595a463b105
(tibetan-post-read-conversion): Return
Kenichi Handa <handa@m17n.org>
parents:
19553
diff
changeset
|
367 (make-local-variable 'tibetan-decomposed) |
4595a463b105
(tibetan-post-read-conversion): Return
Kenichi Handa <handa@m17n.org>
parents:
19553
diff
changeset
|
368 (setq tibetan-decomposed nil) |
4595a463b105
(tibetan-post-read-conversion): Return
Kenichi Handa <handa@m17n.org>
parents:
19553
diff
changeset
|
369 (- (point-max) (point-min)))))) |
17301 | 370 |
371 | |
372 ;;;###autoload | |
373 (defun tibetan-pre-write-conversion (from to) | |
374 (setq tibetan-decomposed-temp tibetan-decomposed) | |
23522
0f86fe9632e0
(tibetan-pre-write-conversion): Use with-temp-buffer.
Kenichi Handa <handa@m17n.org>
parents:
22987
diff
changeset
|
375 (let ((old-buf (current-buffer))) |
23545
0d25c6f765ab
(tibetan-pre-write-conversion): Cancel previous
Kenichi Handa <handa@m17n.org>
parents:
23522
diff
changeset
|
376 (set-buffer (generate-new-buffer " *temp*")) |
0d25c6f765ab
(tibetan-pre-write-conversion): Cancel previous
Kenichi Handa <handa@m17n.org>
parents:
23522
diff
changeset
|
377 (if (stringp from) |
0d25c6f765ab
(tibetan-pre-write-conversion): Cancel previous
Kenichi Handa <handa@m17n.org>
parents:
23522
diff
changeset
|
378 (insert from) |
0d25c6f765ab
(tibetan-pre-write-conversion): Cancel previous
Kenichi Handa <handa@m17n.org>
parents:
23522
diff
changeset
|
379 (insert-buffer-substring old-buf from to)) |
0d25c6f765ab
(tibetan-pre-write-conversion): Cancel previous
Kenichi Handa <handa@m17n.org>
parents:
23522
diff
changeset
|
380 (if (not tibetan-decomposed-temp) |
0d25c6f765ab
(tibetan-pre-write-conversion): Cancel previous
Kenichi Handa <handa@m17n.org>
parents:
23522
diff
changeset
|
381 (tibetan-decompose-region (point-min) (point-max))) |
17776
ece62fdeeebb
(tibetan-pre-write-conversion): Make it work
Kenichi Handa <handa@m17n.org>
parents:
17315
diff
changeset
|
382 ;; Should return nil as annotations. |
ece62fdeeebb
(tibetan-pre-write-conversion): Make it work
Kenichi Handa <handa@m17n.org>
parents:
17315
diff
changeset
|
383 nil)) |
17301 | 384 |
45174
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
385 |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
386 ;;; |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
387 ;;; Unicode-related definitions. |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
45174
diff
changeset
|
388 ;;; |
45174
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
389 |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
390 (defvar tibetan-canonicalize-for-unicode-alist |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
391 '(("$(7"Q(B" . "") ;; remove vowel a |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
392 ("$(7"T(B" . "$(7"R"S(B") ;; decompose vowels whose use is ``discouraged'' in Unicode 3.0 |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
393 ("$(7"V(B" . "$(7"R"U(B") |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
394 ("$(7"W(B" . "$(7#C"a(B") |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
395 ("$(7"X(B" . "$(7#C"R"a(B") |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
396 ("$(7"Y(B" . "$(7#D"a(B") |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
397 ("$(7"Z(B" . "$(7#D"R"a(B") |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
398 ("$(7"b(B" . "$(7"R"a(B")) |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
399 "Rules for canonicalizing Tibetan vowels for Unicode.") |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
400 |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
401 (defvar tibetan-canonicalize-for-unicode-regexp |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
402 "[$(7"Q"T"V"W"X"Y"Z"b(B]" |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
403 "Regexp for Tibetan vowels to be canonicalized in Unicode.") |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
404 |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
405 (defun tibetan-canonicalize-for-unicode-region (from to) |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
406 (save-restriction |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
407 (narrow-to-region from to) |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
408 (goto-char from) |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
409 (while (re-search-forward tibetan-canonicalize-for-unicode-regexp nil t) |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
410 (let ( |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
411 ;;(from (match-beginning 0)) |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
412 ;;(to (match-end 0)) |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
413 (canonical-form |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
414 (cdr (assoc (match-string 0) |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
415 tibetan-canonicalize-for-unicode-alist)))) |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
416 ;;(goto-char from) |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
417 ;;(delete-region from to) |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
418 ;;(insert canonical-form) |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
419 (replace-match canonical-form) |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
420 )))) |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
421 |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
422 (defvar tibetan-strict-unicode t |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
423 "*Flag to control Tibetan canonicalizing for Unicode. |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
424 |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
425 If non-nil, the vowel a is removed and composite vowels are decomposed |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
426 before writing buffer in Unicode. See also |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
427 `tibetan-canonicalize-for-unicode-regexp' and |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
428 `tibetan-canonicalize-for-unicode-alist'.") |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
429 |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
430 ;;;###autoload |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
431 (defun tibetan-pre-write-canonicalize-for-unicode (from to) |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
432 (let ((old-buf (current-buffer)) |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
433 (strict-unicode tibetan-strict-unicode)) |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
434 (set-buffer (generate-new-buffer " *temp*")) |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
435 (if (stringp from) |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
436 (insert from) |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
437 (insert-buffer-substring old-buf from to)) |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
438 (if strict-unicode |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
439 (tibetan-canonicalize-for-unicode-region (point-min) (point-max))) |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
440 ;; Should return nil as annotations. |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
441 nil)) |
15af34d3b6f7
(tibetan-canonicalize-for-unicode-alist)
Kenichi Handa <handa@m17n.org>
parents:
45032
diff
changeset
|
442 |
18309
bd8b521f5218
Provide XXX-util instead of
Kenichi Handa <handa@m17n.org>
parents:
17993
diff
changeset
|
443 (provide 'tibet-util) |
17301 | 444 |
52401 | 445 ;;; arch-tag: 7a7333e8-1584-446c-b39c-a02b9def265d |
38436
b174db545cfd
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
36685
diff
changeset
|
446 ;;; tibet-util.el ends here |