devan-util.el

Revision 4220, 20.9 kB (checked in by miyoshi, 9 months ago)
Sync up with Emacs22.2.
Property svn:eol-style set to `LF`

Line
1	;;; devan-util.el --- Support for composing Devanagari characters
2
3	;; Copyright (C) 1997, 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
4	;; Free Software Foundation, Inc.
5	;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
6	;; 2007, 2008
7	;; National Institute of Advanced Industrial Science and Technology (AIST)
8	;; Registration Number H14PRO021
9
10	;; Maintainer: KAWABATA, Taichi <kawabata@m17n.org>
11	;; Keywords: multilingual, Devanagari
12
13	;; This file is part of GNU Emacs.
14
15	;; GNU Emacs is free software; you can redistribute it and/or modify
16	;; it under the terms of the GNU General Public License as published by
17	;; the Free Software Foundation; either version 3, or (at your option)
18	;; any later version.
19
20	;; GNU Emacs is distributed in the hope that it will be useful,
21	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
22	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23	;; GNU General Public License for more details.
24
25	;; You should have received a copy of the GNU General Public License
26	;; along with GNU Emacs; see the file COPYING. If not, write to the
27	;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
28	;; Boston, MA 02110-1301, USA.
29
30	;; Created: Feb. 17. 2001
31
32	;;; Commentary:
33
34	;; This file provides character(Unicode) to glyph(CDAC) conversion and
35	;; composition of Devanagari script characters.
36
37	;;; Code:
38
39	;;;###autoload
40
41	;; Devanagari Composable Pattern
42	;; C .. Consonants
43	;; V .. Vowel
44	;; H .. Halant
45	;; M .. Matra
46	;; V .. Vowel
47	;; A .. Anuswar
48	;; D .. Chandrabindu
49	;; (N .. Zerowidth Non Joiner)
50	;; (J .. Zerowidth Joiner. )
51	;; 1. vowel
52	;; V(A/D)?
53	;; 2. syllable : maximum of 5 consecutive consonants. (e.g. kartsnya)
54	;; ((CH)?(CH)?(CH)?CH)?C(H\|M?(A\|D)?)?
55
56	(defconst devanagari-consonant
57	"[$,15U(B-$,15y68(B-$,16?(B]")
58
59	(defconst devanagari-composable-pattern
60	(concat
61	"\$[$,15E(B-$,15T6@6A(B][$,15A5B(B]?\$\\\|[$,15C6D(B]"
62	"\\\|\\("
63	"\$?:\\(?:[$,15U(B-$,15y68(B-$,16?(B]$,16-(B\$?\$?:[$,15U(B-$,15y68(B-$,16?(B]$,16-(B\$?\$?:[$,15U(B-$,15y68(B-$,16?(B]$,16-(B\$?[$,15U(B-$,15y68(B-$,16?(B]$,16-(B\\)?"
64	"[$,15U(B-$,15y68(B-$,16?(B]\$?:$,16-(B\\\|[$,15~(B-$,16-6B6C(B]?[$,15B5A(B]?\$?"
65	"\\)")
66	"Regexp matching a composable sequence of Devanagari characters.")
67
68	;;;###autoload
69	(defun devanagari-compose-region (from to)
70	(interactive "r")
71	(save-excursion
72	(save-restriction
73	(narrow-to-region from to)
74	(goto-char (point-min))
75	(while (re-search-forward devanagari-composable-pattern nil t)
76	(devanagari-compose-syllable-region (match-beginning 0)
77	(match-end 0))))))
78	(defun devanagari-compose-string (string)
79	(with-temp-buffer
80	(insert (decompose-string string))
81	(devanagari-compose-region (point-min) (point-max))
82	(buffer-string)))
83
84	;;;###autoload
85	(defun devanagari-post-read-conversion (len)
86	(save-excursion
87	(save-restriction
88	(let ((buffer-modified-p (buffer-modified-p)))
89	(narrow-to-region (point) (+ (point) len))
90	(devanagari-compose-region (point-min) (point-max))
91	(set-buffer-modified-p buffer-modified-p)
92	(- (point-max) (point-min))))))
93
94	(defun devanagari-range (from to)
95	"Make the list of the integers of range FROM to TO."
96	(let (result)
97	(while (<= from to) (setq result (cons to result) to (1- to))) result))
98
99	(defun devanagari-regexp-of-hashtbl-keys (hashtbl)
100	"Return a regular expression that matches all keys in hashtable HASHTBL."
101	(let ((max-specpdl-size 1000))
102	(regexp-opt
103	(sort
104	(let (dummy)
105	(maphash (function (lambda (key val) (setq dummy (cons key dummy)))) hashtbl)
106	dummy)
107	(function (lambda (x y) (> (length x) (length y))))))))
108
109	(defun devanagari-composition-function (from to pattern &optional string)
110	"Compose Devanagari characters in REGION, or STRING if specified.
111	Assume that the REGION or STRING must fully match the composable
112	PATTERN regexp."
113	(if string (devanagari-compose-syllable-string string)
114	(devanagari-compose-syllable-region from to))
115	(- to from))
116
117	;; Register a function to compose Devanagari characters.
118	(mapc
119	(function (lambda (ucs)
120	(aset composition-function-table (decode-char 'ucs ucs)
121	(list (cons devanagari-composable-pattern
122	'devanagari-composition-function)))))
123	(nconc '(#x0903) (devanagari-range #x0905 #x0939) (devanagari-range #x0958 #x0961)))
124
125	;; Notes on conversion steps.
126
127	;; 1. chars to glyphs
128	;;
129	;; Rules will not be applied to the halant appeared at the end of the
130	;; text. Also, the preceding/following "r" will be treated as special case.
131
132	;; 2. glyphs reordering.
133	;;
134	;; The glyphs are split by halant, and each glyph groups are
135	;; re-ordered in the following order.
136	;;
137	;; Note that `consonant-glyph' mentioned here does not contain the
138	;; vertical bar (right modifier) attached at the right of the
139	;; consonant.
140	;;
141	;; If the glyph-group contains right modifier,
142	;; (1) consonant-glyphs/vowels, with nukta sign
143	;; (2) spacing
144	;; (3) right modifier (may be matra)
145	;; (4) top matra
146	;; (5) preceding "r"
147	;; (6) anuswar
148	;; (7) following "r"
149	;; (8) bottom matra or halant.
150	;;
151	;; Otherwise,
152	;; (1) consonant-glyph/vowels, with nukta sign
153	;; (3) left matra
154	;; (4) top matra
155	;; (5) preceding "r"
156	;; (6) anuswar
157	;; (7) following "r"
158	;; (8) bottom matra or halant.
159	;; (2) spacing
160
161	;; 3. glyph to glyph
162	;;
163	;; For better display, some glyph display would be tuned.
164
165	;; 4. Composition.
166	;;
167	;; left modifiers will be attached at the left.
168	;; others will be attached right.
169
170	;; Problem::
171	;; Can we generalize this methods to other Indian scripts?
172
173	(defvar dev-char-glyph
174	'(("$,15E(B" . "$,4 K(B")
175	("$,15F(B" . "$,4 K")(B")
176	("$,15~(B" . "$,4")(B")
177	("$,15G(B" . "$,4 \(B")
178	("$,15(B" . "$,4"*(B")
179	("$,155A(B" . "$,4"*(B\$,4"&(B")
180	("$,15H(B" . "$,4 \"'(B")
181	("$,15H5A(B" . "$,4 \"'"&(B")
182	("$,16 (B" . "$,4"2(B")
183	("$,16 5A(B" . "$,4"2"&(B")
184	("$,15I(B" . "$,4 ](B")
185	("$,16!(B" . "$,4"6(B")
186	("$,15J(B" . "$,4 ^"P(B")
187	("$,16"(B" . "$,4":(B")
188	("$,15K(B" . "$,4 `"Q(B")
189	("$,16#(B" . "$,4">(B")
190	;;("$,15L(B" . nil) ; not implemented.
191	("$,16$(B" . "$,4"?(B")
192	("$,15M(B" . "$,4 b"L(B")
193	("$,15M5A(B" . "$,4 b"$(B")
194	("$,15M5B(B" . "$,4 b"$(B")
195	("$,16%(B" . "\$,4"L(B")
196	("$,15N(B" . "$,4 b"@(B")
197	("$,15N5A(B" . "$,4 b"@"&(B")
198	("$,16&(B" . "\$,4"@(B")
199	("$,16&5A(B" . "\$,4"@(B\$,4"&(B")
200	("$,15O(B" . "$,4 b(B")
201	("$,16'(B" . "\$,4"D(B")
202	("$,16'5A(B" . "\$,4"D(B\$,4"&(B")
203	("$,15P(B" . "$,4 b"D(B")
204	("$,15P5A(B" . "$,4 b"D"&(B")
205	("$,16((B" . "\$,4"H(B")
206	("$,16(5A(B" . "\$,4"H(B\$,4"&(B")
207	("$,15Q(B" . "$,4 K")"L(B") ;; special rule for reodering.
208	("$,15Q5A(B" . "$,4 K")"$(B")
209	("$,15Q5B(B" . "$,4 K")"$(B")
210	("$,16)(B" . "\$,4")"L(B")
211	("$,16)5A(B" . "\$,4")"$(B")
212	("$,16)5B(B" . "\$,4")"$(B")
213	("$,15R(B" . "$,4 K")"@(B")
214	("$,15R5A(B" . "$,4 K")"@"&(B")
215	("$,16*(B" . "\$,4")"@(B")
216	("$,165A(B" . "\$,4")"@"&(B"*)
217	("$,15S(B" . "$,4 K")"D(B")
218	("$,15S5A(B" . "$,4 K")"D"&(B")
219	("$,16+(B" . "\$,4")"D(B")
220	("$,16+5A(B" . "\$,4")"D"&(B")
221	("$,15T(B" . "$,4 K")"H(B")
222	("$,15T5A(B" . "$,4 K")"H"&(B")
223	("$,16,(B" . "\$,4")"H(B")
224	("$,16,5A(B" . "\$,4")"H"&(B")
225	("$,16@(B" . "$,4 a"Q(B")
226	;;("$,16B(B" . nil)
227	;;("$,16A(B" . nil)
228	;;("$,16C(B" . nil)
229
230	;; GRUTTALS
231	("$,15U(B" . "$,4 e"R(B")
232	("$,15U6-(B" . "$,4 c(B")
233	("$,15U6-5p(B" . "$,4 g"R(B")
234	("$,15U6-5d(B" . "$,4 h"R(B")
235	("$,15U6-5w(B" . "$,4 i")(B")
236	("$,15U6-5w6-(B" . "$,4 i(B")
237
238	("$,15V(B" . "$,4 j")(B")
239	("$,15V6-(B" . "$,4 j(B")
240	("$,15V6-5p(B" . "$,4 l")(B")
241	("$,15V6-5p6-(B" . "$,4 l(B")
242
243	("$,15W(B" . "$,4 m")(B")
244	("$,15W6-(B" . "$,4 m(B")
245	("$,15W6-5p(B" . "$,4 o")(B")
246	("$,15W6-5p6-(B" . "$,4 o(B")
247
248	("$,15X(B" . "$,4 p")(B")
249	("$,15X6-(B" . "$,4 p(B")
250	("$,15X6-5p(B" . "$,4 q")(B")
251	("$,15X6-5p6-(B" . "$,4 q(B")
252
253	("$,15Y(B" . "$,4 r"S(B")
254	;; PALATALS
255	("$,15Z(B" . "$,4 s")(B")
256	("$,15Z6-(B" . "$,4 s(B")
257	("$,15Z6-5p(B" . "$,4 t")(B")
258	("$,15Z6-5p6-(B" . "$,4 t(B")
259
260	("$,15[(B" . "$,4 u"T(B")
261
262	("$,15\(B" . "$,4 v")(B")
263	("$,15\6-(B" . "$,4 v(B")
264	("$,15\6-5p(B" . "$,4 x")(B")
265	("$,15\6-5p6-(B" . "$,4 x(B")
266	("$,15\6-5^(B" . "$,4 y")(B")
267	("$,15\6-5^6-(B" . "$,4 y(B")
268
269	("$,15](B" . "$,4 z")(B")
270	("$,15]6-(B" . "$,4 z(B")
271	("$,15]6-5p(B" . "$,4 {")(B")
272	("$,15]6-5p6-(B" . "$,4 {(B")
273
274	("$,15^(B" . "$,4 \|")(B")
275	("$,15^6-(B" . "$,4 \|(B")
276	;; CEREBRALS
277	("$,15_(B" . "$,4 }"U(B")
278	("$,15_6-5_(B" . "$,4 ~"U(B")
279	("$,15_6-5`(B" . "$,4 "U(B")
280
281	("$,15`(B" . "$,4! "V(B")
282	("$,15`6-5`(B" . "$,4!!"V(B")
283
284	("$,15a(B" . "$,4!""W(B")
285	("$,15a6-5a(B" . "$,4!$"W(B")
286	("$,15a6-5b(B" . "$,4!%"W(B")
287
288	("$,15b(B" . "$,4!&"X(B")
289
290	("$,15c(B" . "$,4!(")(B")
291	("$,15c6-(B" . "$,4!((B")
292	;; DENTALS
293	("$,15d(B" . "$,4!)")(B")
294	("$,15d6-(B" . "$,4!)(B")
295	("$,15d6-5p(B" . "$,4!*")(B")
296	("$,15d6-5p6-(B" . *"$,4!(B"**)
297	("$,15d6-5d(B" . "$,4!+")(B")
298	("$,15d6-5d6-(B" . "$,4!+(B")
299
300	("$,15e(B" . "$,4!,")(B")
301	("$,15e6-(B" . "$,4!,(B")
302	("$,15e6-5p(B" . "$,4!-")(B")
303	("$,15e6-5p6-(B" . "$,4!-(B")
304
305	("$,15f(B" . "$,4!."Y(B")
306	("$,15f6#(B" . "$,4!/"Y(B")
307	("$,15f6-5p(B" . "$,4!0"Y(B")
308	("$,15f6-5f(B" . "$,4!1"Y(B")
309	("$,15f6-5g(B" . "$,4!2"Y(B")
310	("$,15f6-5n(B" . "$,4!3(B")
311	("$,15f6-5o(B" . "$,4!4(B")
312	("$,15f6-5u(B" . "$,4!5"Y(B")
313
314	("$,15g(B" . "$,4!6")(B")
315	("$,15g6-(B" . "$,4!6(B")
316	("$,15g6-5p(B" . "$,4!7")(B")
317	("$,15g6-5p6-(B" . "$,4!7(B")
318
319	("$,15h(B" . "$,4!8")(B")
320	("$,15h6-(B" . "$,4!8(B")
321	("$,15h6-5p(B" . "$,4!9")(B")
322	("$,15h6-5p6-(B" . "$,4!9")(B")
323	("$,15h6-5h(B" . "$,4!:")(B")
324	("$,15h6-5h6-(B" . "$,4!:(B")
325
326	("$,15i(B" . "$,4!8"#")(B")
327	;; LABIALS
328	("$,15j(B" . "$,4!;")(B")
329	("$,15j6-(B" . "$,4!;(B")
330	("$,15j6-5p(B" . "$,4!<")(B")
331	("$,15j6-5p6-(B" . "$,4!<(B")
332
333	("$,15k(B" . "$,4!a"[(B")
334	("$,15k6-(B" . "$,4!=(B")
335	("$,15k6-5p(B" . "$,4!c"[(B")
336
337	("$,15l(B" . "$,4!d")(B")
338	("$,15l6-(B" . "$,4!d(B")
339	("$,15l6-5p(B" . "$,4!e")(B")
340	("$,15l6-5p6-(B" . "$,4!e(B")
341
342	("$,15m(B" . "$,4!f")(B")
343	("$,15m6-(B" . "$,4!f(B")
344	("$,15m6-5p(B" . "$,4!g")(B")
345	("$,15m6-5p6-(B" . "$,4!g(B")
346
347	("$,15n(B" . "$,4!h")(B")
348	("$,15n6-(B" . "$,4!h(B")
349	("$,15n6-5p(B" . "$,4!i")(B")
350	("$,15n6-5p6-(B" . "$,4!i(B")
351	;; SEMIVOWELS
352	("$,15o(B" . "$,4!j")(B")
353	("$,15o6-(B" . "$,4!j(B")
354	("$,15o6-5p(B" . "$,4!k")(B")
355	("$,15o6-5p6-(B" . "$,4!k(B")
356	("$,16-5o(B" . "$,4!l(B") ;; when every ohter lig. fails.
357
358	("$,15p(B" . "$,4!n"W(B")
359	;; ("$,15p6-(B" . "\$,4"'(B") ;; special case. only the topmost pos.
360	("$,15q(B" . "$,4!n"#"W(B")
361	("$,15q6-(B" . "$,4!m(B") ;; IS 13194 speical rule.
362	("$,15p6!(B" . "$,4!o"[(B")
363	("$,15p6"(B" . "$,4!p"\(B")
364
365	("$,15r(B" . "$,4!q")(B")
366	("$,15r6-(B" . "$,4!q(B")
367	("$,15s(B" . "$,4!s(B")
368	("$,15s6-(B" . "$,4!r(B")
369	("$,15t(B" . "$,4!s"#(B")
370	("$,15t6-(B" . "$,4!r"#(B")
371
372	("$,15u(B" . "$,4!t")(B")
373	("$,15u6-(B" . "$,4!t(B")
374	("$,15u6-5p(B" . "$,4!u")(B")
375	("$,15u6-5p6-(B" . "$,4!u(B")
376	;; SIBILANTS
377	("$,15v(B" . "$,4!v")(B")
378	("$,15v6-(B" . "$,4!v(B")
379	("$,15v6-5u(B" . "$,4!w")(B")
380	("$,15v6-5u6-(B" . "$,4!w(B")
381	("$,15v6-5p(B" . "$,4!x")(B")
382	("$,15v6-5p6-(B" . "$,4!x(B")
383
384	("$,15w(B" . "$,4!y")(B")
385	("$,15w6-(B" . "$,4!y(B")
386	("$,15x(B" . "$,4!z")(B")
387	("$,15x6-(B" . "$,4!z(B")
388	("$,15x6-5p(B" . "$,4!{")(B")
389	("$,15x6-5p6-(B" . "$,4!{(B")
390
391	("$,15y(B" . "$,4!}(B")
392	("$,15y6-(B" . "$,4!\|(B")
393	("$,15y6#(B" . "$,4!~(B")
394	("$,15y6-5p(B" . "$,4!(B")
395	("$,15y6-5n(B" . "$,4" (B")
396	("$,15y6-5o(B" . "$,4"!(B")
397	;; NUKTAS
398	("$,168(B" . "$,4 f"R"S(B")
399	("$,1686-(B" . "$,4 d(B")
400	("$,169(B" . "$,4 k")(B")
401	("$,1696-(B" . "$,4 k(B")
402	("$,16:(B" . "$,4 n")(B")
403	("$,16:6-(B" . "$,4 n(B")
404	("$,16;(B" . "$,4 w")(B")
405	("$,16;6-(B" . "$,4 w(B")
406	("$,16<(B" . "$,4!#"W(B")
407	("$,16=(B" . "$,4!'"X(B")
408	("$,16>(B" . "$,4!b"[(B")
409	("$,16>6-(B" . "$,4!>(B")
410	("$,16?(B" . "$,4!j"#")(B")
411	;; misc modifiers.
412	("$,15A(B" . "\$,4"$(B")
413	("$,15B(B" . "\$,4"&(B")
414	("$,15C(B" . "$,4 F(B")
415	("$,15\|(B" . "$,4"#(B")
416	("$,15}(B" . "$,4 E(B")
417	("$,16-(B" . "$,4""(B")
418	("$,16-5p(B" . "$,4"%(B") ;; following "r"
419	;; ("$,160(B" . "$,4 D(B")
420	("$,16D(B" . "$,4 J(B")
421	;; ("$,16F(B" . "")
422	;; ("$,16G(B" . "")
423	;; ("$,16H(B" . "")
424	;; ("$,16I(B" . "")
425	;; ("$,16J(B" . "")
426	;; ("$,16K(B" . "")
427	;; ("$,16L(B" . "")
428	;; ("$,16M(B" . "")
429	;; ("$,16N(B" . "")
430	;; ("$,16O(B" . "")
431	)
432	"Devanagari characters to glyphs conversion table.
433	Default value contains only the basic rules. You may add your own
434	preferred rule from the sanskrit fonts." )
435
436	(defvar dev-char-glyph-hash
437	*(let ((hash (make-hash-table :test 'equal)))**
438	(mapc (function (lambda (x) (puthash (car x) (cdr x) hash)))
439	dev-char-glyph)
440	hash))
441
442	(defvar dev-char-glyph-regexp
443	(devanagari-regexp-of-hashtbl-keys dev-char-glyph-hash))
444
445	;; glyph-to-glyph conversion table.
446	;; it is supposed that glyphs are ordered in
447	;; [consonant/nukta] - [matra/halant] - [preceding-r] - [anuswar].
448
449	(defvar dev-glyph-glyph
450	'(("\$,4"'(B\$,4"&(B" . "\$,4"((B")
451	("\$,4"'(B\$,4"$(B" . "\$,4"((B")
452	("$,4"*(B\$,4"&(B" . "$,4"+(B")
453	("$,4"(B\$,4"'(B" . "$,4"*,(B")
454	("$,4"(B\$,4"'(B\$,4"&(B" . "$,4"*-(B")
455	("$,4"2(B\$,4"&(B" . "$,4"3(B")
456	("$,4"2(B\$,4"'(B" . "$,4"4(B")
457	("$,4"2(B\$,4"'(B\$,4"&(B" . "$,4"5(B")
458	("$,4"#(B\$,4"6(B" . "$,4"7(B")
459	("$,4"%(B\$,4"6(B" . "$,4"8(B")
460	;;("$,4"6(B" . "$,4"9(B")
461	("$,4"#(B\$,4":(B" . "$,4";(B")
462	("$,4"%(B\$,4":(B" . "$,4"<(B")
463	;;("$,4":(B" . "$,4"=(B")
464	("\$,4"@(B\$,4"&(B" . "\$,4"A(B")
465	("\$,4"@(B\$,4"'(B" . "\$,4"B(B")
466	("\$,4"@(B\$,4"'(B\$,4"&(B" . "\$,4"C(B")
467	("\$,4"D(B\$,4"&(B" . "\$,4"E(B")
468	("\$,4"D(B\$,4"'(B" . "\$,4"F(B")
469	("\$,4"D(B\$,4"'(B\$,4"&(B" . "\$,4"G(B")
470	("\$,4"H(B\$,4"&(B" . "\$,4"I(B")
471	("\$,4"H(B\$,4"'(B" . "\$,4"J(B")
472	("\$,4"H(B\$,4"'(B\$,4"&(B" . "\$,4"K(B")
473	("\$,4"L(B\$,4"&(B" . "\$,4"M(B")
474	("\$,4"L(B\$,4"'(B" . "\$,4"N(B")
475	("\$,4"L(B\$,4"'(B\$,4"&(B" . "\$,4"O(B")
476	))
477	(defvar dev-glyph-glyph-hash
478	*(let ((hash (make-hash-table :test 'equal)))**
479	(mapc (function (lambda (x) (puthash (car x) (cdr x) hash)))
480	dev-glyph-glyph)
481	hash))
482	(defvar dev-glyph-glyph-regexp
483	(devanagari-regexp-of-hashtbl-keys dev-glyph-glyph-hash))
484
485
486	;; yet another glyph-to-glyph conversions.
487	(defvar dev-glyph-glyph-2
488	'(("$,4"(B" . "$,4"*.(B")
489	("$,4"+(B" . "$,4"/(B")
490	("$,4",(B" . "$,4"0(B")
491	("$,4"-(B" . "$,4"1(B")))
492	(defvar dev-glyph-glyph-2-hash
493	*(let ((hash (make-hash-table :test 'equal)))**
494	(mapc (function (lambda (x) (puthash (car x) (cdr x) hash)))
495	dev-glyph-glyph-2)
496	hash))
497	(defvar dev-glyph-glyph-2-regexp
498	(devanagari-regexp-of-hashtbl-keys dev-glyph-glyph-2-hash))
499
500
501	(defun dev-charseq (from &optional to)
502	(if (null to) (setq to from))
503	(mapcar (function (lambda (x) (indian-glyph-char x 'devanagari)))
504	(devanagari-range from to)))
505
506	(defvar dev-glyph-cvn
507	(append
508	(dev-charseq #x2b)
509	(dev-charseq #x3c #xc1)
510	(dev-charseq #xc3))
511	"Devanagari Consonants/Vowels/Nukta Glyphs")
512
513	(defvar dev-glyph-space
514	(dev-charseq #xf0 #xfe)
515	"Devanagari Spacing Glyphs")
516
517	(defvar dev-glyph-right-modifier
518	(append
519	(dev-charseq #xc9)
520	(dev-charseq #xd2 #xd5))
521	"Devanagari Modifiers attached at the right side.")
522
523	(defvar dev-glyph-right-modifier-regexp
524	(concat "[" dev-glyph-right-modifier "]"))
525
526	(defvar dev-glyph-left-matra
527	(dev-charseq #xca #xd1)
528	"Devanagari Matras attached at the left side.")
529
530	(defvar dev-glyph-top-matra
531	(dev-charseq #xe0 #xef)
532	"Devanagari Matras attached at the top side.")
533
534	(defvar dev-glyph-bottom-modifier
535	(append
536	(dev-charseq #xd6 #xdf)
537	(dev-charseq #xc2))
538	"Devanagari Modifiers attached at the bottom.")
539
540	(defvar dev-glyph-order
541	`((,dev-glyph-cvn . 1)
542	(,dev-glyph-space . 2)
543	(,dev-glyph-right-modifier . 3)
544	(,dev-glyph-left-matra . 3) ;; processed by reference point.
545	(,dev-glyph-top-matra . 4)
546	(,(dev-charseq #xc7 #xc8) . 5)
547	(,(dev-charseq #xc4) . 6)
548	(,(dev-charseq #xc6) . 6)
549	(,(dev-charseq #xc5) . 7)
550	(,dev-glyph-bottom-modifier . 8)))
551
552	(mapc
553	(function (lambda (x)
554	(mapc
555	(function (lambda (y)
556	(put-char-code-property y 'composition-order (cdr x))))
557	(car x))))
558	dev-glyph-order)
559
560	(mapc
561	(function (lambda (x)
562	(put-char-code-property x 'reference-point '(3 . 5))))
563	dev-glyph-left-matra)
564
565	(defun devanagari-compose-syllable-string (string)
566	(with-temp-buffer
567	(insert (decompose-string string))
568	(devanagari-compose-syllable-region (point-min) (point-max))
569	(buffer-string)))
570
571	(defun devanagari-compose-syllable-region (from to)
572	"Compose devanagari syllable in region FROM to TO."
573	(let ((glyph-str nil) (cons-num 0) glyph-str-list
574	(last-halant nil) (preceding-r nil) (last-modifier nil)
575	(last-char (char-before to)) match-str
576	glyph-block split-pos)
577	(save-excursion
578	(save-restriction
579	;;; * char-to-glyph conversion *
580	;; Special rule 1. -- Last halant must be preserved.
581	(if (eq last-char ?$,16-(B)
582	(progn
583	(setq last-halant t)
584	(narrow-to-region from (1- to)))
585	(narrow-to-region from to)
586	;; note if the last char is modifier.
587	(if (or (eq last-char ?$,15A(B) (eq last-char ?$,15B(B))
588	(setq last-modifier t)))
589	(goto-char (point-min))
590	;; Special rule 2. -- preceding "r halant" must be modifier.
591	(when (looking-at "$,15p6-(B.")
592	(setq preceding-r t)
593	(goto-char (+ 2 (point))))
594	;; translate the rest characters into glyphs
595	(while (re-search-forward dev-char-glyph-regexp nil t)
596	(setq match-str (match-string 0))
597	(setq glyph-str
598	(concat glyph-str
599	(gethash match-str dev-char-glyph-hash)))
600	;; count the number of consonant-glyhs.
601	(if (string-match devanagari-consonant match-str)
602	(setq cons-num (1+ cons-num))))
603	;; preceding-r must be attached before the anuswar if exists.
604	(if preceding-r
605	(if last-modifier
606	(setq glyph-str (concat (substring glyph-str 0 -1)
607	"$,4"'(B" (substring glyph-str -1)))
608	(setq glyph-str (concat glyph-str "$,4"'(B"))))
609	(if last-halant (setq glyph-str (concat glyph-str "$,4""(B")))
610	;;; * glyph-to-glyph conversion *
611	(when (string-match dev-glyph-glyph-regexp glyph-str)
612	(setq glyph-str
613	(replace-match (gethash (match-string 0 glyph-str)
614	dev-glyph-glyph-hash)
615	nil t glyph-str))
616	(if (and (> cons-num 1)
617	(string-match dev-glyph-glyph-2-regexp glyph-str))
618	(setq glyph-str
619	(replace-match (gethash (match-string 0 glyph-str)
620	dev-glyph-glyph-2-hash)
621	nil t glyph-str))))
622	;;; * glyph reordering *
623	(while (setq split-pos (string-match "$,4""(B\\\|.$" glyph-str))
624	(setq glyph-block (substring glyph-str 0 (1+ split-pos)))
625	(setq glyph-str (substring glyph-str (1+ split-pos)))
626	(setq
627	glyph-block
628	(if (string-match dev-glyph-right-modifier-regexp glyph-block)
629	(sort (string-to-list glyph-block)
630	(function (lambda (x y)
631	(< (get-char-code-property x 'composition-order)
632	(get-char-code-property y 'composition-order)))))
633	(sort (string-to-list glyph-block)
634	(function (lambda (x y)
635	(let ((xo (get-char-code-property x 'composition-order))
636	(yo (get-char-code-property y 'composition-order)))
637	(if (= xo 2) nil (if (= yo 2) t (< xo yo)))))))))
638	(setq glyph-str-list (nconc glyph-str-list glyph-block)))
639	;; concatenate and attach reference-points.
640	(setq glyph-str
641	(cdr
642	(apply
643	'nconc
644	(mapcar
645