code.delx.au - gnu-emacs/blob - lisp/language/devan-util.el

   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   "[\e$,15U\e(B-\e$,15y68\e(B-\e$,16?\e(B]")
  58
  59 (defconst devanagari-composable-pattern
  60   (concat
  61    "\\([\e$,15E\e(B-\e$,15T6@6A\e(B][\e$,15A5B\e(B]?\\)\\|[\e$,15C6D\e(B]"
  62    "\\|\\("
  63    "\\(?:\\(?:[\e$,15U\e(B-\e$,15y68\e(B-\e$,16?\e(B]\e$,16-\e(B\\)?\\(?:[\e$,15U\e(B-\e$,15y68\e(B-\e$,16?\e(B]\e$,16-\e(B\\)?\\(?:[\e$,15U\e(B-\e$,15y68\e(B-\e$,16?\e(B]\e$,16-\e(B\\)?[\e$,15U\e(B-\e$,15y68\e(B-\e$,16?\e(B]\e$,16-\e(B\\)?"
  64    "[\e$,15U\e(B-\e$,15y68\e(B-\e$,16?\e(B]\\(?:\e$,16-\e(B\\|[\e$,15~\e(B-\e$,16-6B6C\e(B]?[\e$,15B5A\e(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   '(("\e$,15E\e(B" . "\e$,4 K\e(B")
 175     ("\e$,15F\e(B" . "\e$,4 K")\e(B")
 176     ("\e$,15~\e(B" . "\e$,4")\e(B")
 177     ("\e$,15G\e(B" . "\e$,4 \\e(B")
 178     ("\e$,15\7f\e(B" . "\e$,4"*\e(B")
 179     ("\e$,15\7f5A\e(B" . "\e$,4"*\e(B\\e$,4"&\e(B")
 180     ("\e$,15H\e(B" . "\e$,4 \"'\e(B")
 181     ("\e$,15H5A\e(B" . "\e$,4 \"'"&\e(B")
 182     ("\e$,16 \e(B" . "\e$,4"2\e(B")
 183     ("\e$,16 5A\e(B" . "\e$,4"2"&\e(B")
 184     ("\e$,15I\e(B" . "\e$,4 ]\e(B")
 185     ("\e$,16!\e(B" . "\e$,4"6\e(B")
 186     ("\e$,15J\e(B" . "\e$,4 ^"P\e(B")
 187     ("\e$,16"\e(B" . "\e$,4":\e(B")
 188     ("\e$,15K\e(B" . "\e$,4 `"Q\e(B")
 189     ("\e$,16#\e(B" . "\e$,4">\e(B")
 190     ;;("\e$,15L\e(B" . nil) ; not implemented.
 191     ("\e$,16$\e(B" . "\e$,4"?\e(B")
 192     ("\e$,15M\e(B" . "\e$,4 b"L\e(B")
 193     ("\e$,15M5A\e(B" . "\e$,4 b"$\e(B")
 194     ("\e$,15M5B\e(B" . "\e$,4 b"$\e(B")
 195     ("\e$,16%\e(B" . "\\e$,4"L\e(B")
 196     ("\e$,15N\e(B" . "\e$,4 b"@\e(B")
 197     ("\e$,15N5A\e(B" . "\e$,4 b"@"&\e(B")
 198     ("\e$,16&\e(B" . "\\e$,4"@\e(B")
 199     ("\e$,16&5A\e(B" . "\\e$,4"@\e(B\\e$,4"&\e(B")
 200     ("\e$,15O\e(B" . "\e$,4 b\e(B")
 201     ("\e$,16'\e(B" . "\\e$,4"D\e(B")
 202     ("\e$,16'5A\e(B" . "\\e$,4"D\e(B\\e$,4"&\e(B")
 203     ("\e$,15P\e(B" . "\e$,4 b"D\e(B")
 204     ("\e$,15P5A\e(B" . "\e$,4 b"D"&\e(B")
 205     ("\e$,16(\e(B" . "\\e$,4"H\e(B")
 206     ("\e$,16(5A\e(B" . "\\e$,4"H\e(B\\e$,4"&\e(B")
 207     ("\e$,15Q\e(B" . "\e$,4 K")"L\e(B") ;; special rule for reodering.
 208     ("\e$,15Q5A\e(B" . "\e$,4 K")"$\e(B")
 209     ("\e$,15Q5B\e(B" . "\e$,4 K")"$\e(B")
 210     ("\e$,16)\e(B" . "\\e$,4")"L\e(B")
 211     ("\e$,16)5A\e(B" . "\\e$,4")"$\e(B")
 212     ("\e$,16)5B\e(B" . "\\e$,4")"$\e(B")
 213     ("\e$,15R\e(B" . "\e$,4 K")"@\e(B")
 214     ("\e$,15R5A\e(B" . "\e$,4 K")"@"&\e(B")
 215     ("\e$,16*\e(B" . "\\e$,4")"@\e(B")
 216     ("\e$,16*5A\e(B" . "\\e$,4")"@"&\e(B")
 217     ("\e$,15S\e(B" . "\e$,4 K")"D\e(B")
 218     ("\e$,15S5A\e(B" . "\e$,4 K")"D"&\e(B")
 219     ("\e$,16+\e(B" . "\\e$,4")"D\e(B")
 220     ("\e$,16+5A\e(B" . "\\e$,4")"D"&\e(B")
 221     ("\e$,15T\e(B" . "\e$,4 K")"H\e(B")
 222     ("\e$,15T5A\e(B" . "\e$,4 K")"H"&\e(B")
 223     ("\e$,16,\e(B" . "\\e$,4")"H\e(B")
 224     ("\e$,16,5A\e(B" . "\\e$,4")"H"&\e(B")
 225     ("\e$,16@\e(B" . "\e$,4 a"Q\e(B")
 226     ;;("\e$,16B\e(B" . nil)
 227     ;;("\e$,16A\e(B" . nil)
 228     ;;("\e$,16C\e(B" . nil)
 229
 230     ;; GRUTTALS
 231     ("\e$,15U\e(B" . "\e$,4 e"R\e(B")
 232     ("\e$,15U6-\e(B" . "\e$,4 c\e(B")
 233     ("\e$,15U6-5p\e(B" . "\e$,4 g"R\e(B")
 234     ("\e$,15U6-5d\e(B" . "\e$,4 h"R\e(B")
 235     ("\e$,15U6-5w\e(B" . "\e$,4 i")\e(B")
 236     ("\e$,15U6-5w6-\e(B" . "\e$,4 i\e(B")
 237
 238     ("\e$,15V\e(B" . "\e$,4 j")\e(B")
 239     ("\e$,15V6-\e(B" . "\e$,4 j\e(B")
 240     ("\e$,15V6-5p\e(B" . "\e$,4 l")\e(B")
 241     ("\e$,15V6-5p6-\e(B" . "\e$,4 l\e(B")
 242
 243     ("\e$,15W\e(B" . "\e$,4 m")\e(B")
 244     ("\e$,15W6-\e(B" . "\e$,4 m\e(B")
 245     ("\e$,15W6-5p\e(B" . "\e$,4 o")\e(B")
 246     ("\e$,15W6-5p6-\e(B" . "\e$,4 o\e(B")
 247
 248     ("\e$,15X\e(B" . "\e$,4 p")\e(B")
 249     ("\e$,15X6-\e(B" . "\e$,4 p\e(B")
 250     ("\e$,15X6-5p\e(B" . "\e$,4 q")\e(B")
 251     ("\e$,15X6-5p6-\e(B" . "\e$,4 q\e(B")
 252
 253     ("\e$,15Y\e(B" . "\e$,4 r"S\e(B")
 254     ;; PALATALS
 255     ("\e$,15Z\e(B" . "\e$,4 s")\e(B")
 256     ("\e$,15Z6-\e(B" . "\e$,4 s\e(B")
 257     ("\e$,15Z6-5p\e(B" . "\e$,4 t")\e(B")
 258     ("\e$,15Z6-5p6-\e(B" . "\e$,4 t\e(B")
 259
 260     ("\e$,15[\e(B" . "\e$,4 u"T\e(B")
 261
 262     ("\e$,15\\e(B" . "\e$,4 v")\e(B")
 263     ("\e$,15\6-\e(B" . "\e$,4 v\e(B")
 264     ("\e$,15\6-5p\e(B" . "\e$,4 x")\e(B")
 265     ("\e$,15\6-5p6-\e(B" . "\e$,4 x\e(B")
 266     ("\e$,15\6-5^\e(B" . "\e$,4 y")\e(B")
 267     ("\e$,15\6-5^6-\e(B" . "\e$,4 y\e(B")
 268
 269     ("\e$,15]\e(B" . "\e$,4 z")\e(B")
 270     ("\e$,15]6-\e(B" . "\e$,4 z\e(B")
 271     ("\e$,15]6-5p\e(B" . "\e$,4 {")\e(B")
 272     ("\e$,15]6-5p6-\e(B" . "\e$,4 {\e(B")
 273
 274     ("\e$,15^\e(B" . "\e$,4 |")\e(B")
 275     ("\e$,15^6-\e(B" . "\e$,4 |\e(B")
 276     ;; CEREBRALS
 277     ("\e$,15_\e(B" . "\e$,4 }"U\e(B")
 278     ("\e$,15_6-5_\e(B" . "\e$,4 ~"U\e(B")
 279     ("\e$,15_6-5`\e(B" . "\e$,4 \7f"U\e(B")
 280
 281     ("\e$,15`\e(B" . "\e$,4! "V\e(B")
 282     ("\e$,15`6-5`\e(B" . "\e$,4!!"V\e(B")
 283
 284     ("\e$,15a\e(B" . "\e$,4!""W\e(B")
 285     ("\e$,15a6-5a\e(B" . "\e$,4!$"W\e(B")
 286     ("\e$,15a6-5b\e(B" . "\e$,4!%"W\e(B")
 287
 288     ("\e$,15b\e(B" . "\e$,4!&"X\e(B")
 289
 290     ("\e$,15c\e(B" . "\e$,4!(")\e(B")
 291     ("\e$,15c6-\e(B" . "\e$,4!(\e(B")
 292     ;; DENTALS
 293     ("\e$,15d\e(B" . "\e$,4!)")\e(B")
 294     ("\e$,15d6-\e(B" . "\e$,4!)\e(B")
 295     ("\e$,15d6-5p\e(B" . "\e$,4!*")\e(B")
 296     ("\e$,15d6-5p6-\e(B" . "\e$,4!*\e(B")
 297     ("\e$,15d6-5d\e(B" . "\e$,4!+")\e(B")
 298     ("\e$,15d6-5d6-\e(B" . "\e$,4!+\e(B")
 299
 300     ("\e$,15e\e(B" . "\e$,4!,")\e(B")
 301     ("\e$,15e6-\e(B" . "\e$,4!,\e(B")
 302     ("\e$,15e6-5p\e(B" . "\e$,4!-")\e(B")
 303     ("\e$,15e6-5p6-\e(B" . "\e$,4!-\e(B")
 304
 305     ("\e$,15f\e(B" . "\e$,4!."Y\e(B")
 306     ("\e$,15f6#\e(B" . "\e$,4!/"Y\e(B")
 307     ("\e$,15f6-5p\e(B" . "\e$,4!0"Y\e(B")
 308     ("\e$,15f6-5f\e(B" . "\e$,4!1"Y\e(B")
 309     ("\e$,15f6-5g\e(B" . "\e$,4!2"Y\e(B")
 310     ("\e$,15f6-5n\e(B" . "\e$,4!3\e(B")
 311     ("\e$,15f6-5o\e(B" . "\e$,4!4\e(B")
 312     ("\e$,15f6-5u\e(B" . "\e$,4!5"Y\e(B")
 313
 314     ("\e$,15g\e(B" . "\e$,4!6")\e(B")
 315     ("\e$,15g6-\e(B" . "\e$,4!6\e(B")
 316     ("\e$,15g6-5p\e(B" . "\e$,4!7")\e(B")
 317     ("\e$,15g6-5p6-\e(B" . "\e$,4!7\e(B")
 318
 319     ("\e$,15h\e(B" . "\e$,4!8")\e(B")
 320     ("\e$,15h6-\e(B" . "\e$,4!8\e(B")
 321     ("\e$,15h6-5p\e(B" . "\e$,4!9")\e(B")
 322     ("\e$,15h6-5p6-\e(B" . "\e$,4!9")\e(B")
 323     ("\e$,15h6-5h\e(B" . "\e$,4!:")\e(B")
 324     ("\e$,15h6-5h6-\e(B" . "\e$,4!:\e(B")
 325
 326     ("\e$,15i\e(B" . "\e$,4!8"#")\e(B")
 327     ;; LABIALS
 328     ("\e$,15j\e(B" . "\e$,4!;")\e(B")
 329     ("\e$,15j6-\e(B" . "\e$,4!;\e(B")
 330     ("\e$,15j6-5p\e(B" . "\e$,4!<")\e(B")
 331     ("\e$,15j6-5p6-\e(B" . "\e$,4!<\e(B")
 332
 333     ("\e$,15k\e(B" . "\e$,4!a"[\e(B")
 334     ("\e$,15k6-\e(B" . "\e$,4!=\e(B")
 335     ("\e$,15k6-5p\e(B" . "\e$,4!c"[\e(B")
 336
 337     ("\e$,15l\e(B" . "\e$,4!d")\e(B")
 338     ("\e$,15l6-\e(B" . "\e$,4!d\e(B")
 339     ("\e$,15l6-5p\e(B" . "\e$,4!e")\e(B")
 340     ("\e$,15l6-5p6-\e(B" . "\e$,4!e\e(B")
 341
 342     ("\e$,15m\e(B" . "\e$,4!f")\e(B")
 343     ("\e$,15m6-\e(B" . "\e$,4!f\e(B")
 344     ("\e$,15m6-5p\e(B" . "\e$,4!g")\e(B")
 345     ("\e$,15m6-5p6-\e(B" . "\e$,4!g\e(B")
 346
 347     ("\e$,15n\e(B" . "\e$,4!h")\e(B")
 348     ("\e$,15n6-\e(B" . "\e$,4!h\e(B")
 349     ("\e$,15n6-5p\e(B" . "\e$,4!i")\e(B")
 350     ("\e$,15n6-5p6-\e(B" . "\e$,4!i\e(B")
 351     ;; SEMIVOWELS
 352     ("\e$,15o\e(B" . "\e$,4!j")\e(B")
 353     ("\e$,15o6-\e(B" . "\e$,4!j\e(B")
 354     ("\e$,15o6-5p\e(B" . "\e$,4!k")\e(B")
 355     ("\e$,15o6-5p6-\e(B" . "\e$,4!k\e(B")
 356     ("\e$,16-5o\e(B" . "\e$,4!l\e(B") ;; when every ohter lig. fails.
 357
 358     ("\e$,15p\e(B" . "\e$,4!n"W\e(B")
 359     ;; ("\e$,15p6-\e(B" . "\\e$,4"'\e(B") ;; special case.  only the topmost pos.
 360     ("\e$,15q\e(B" . "\e$,4!n"#"W\e(B")
 361     ("\e$,15q6-\e(B" . "\e$,4!m\e(B") ;; IS 13194 speical rule.
 362     ("\e$,15p6!\e(B" . "\e$,4!o"[\e(B")
 363     ("\e$,15p6"\e(B" . "\e$,4!p"\\e(B")
 364
 365     ("\e$,15r\e(B" . "\e$,4!q")\e(B")
 366     ("\e$,15r6-\e(B" . "\e$,4!q\e(B")
 367     ("\e$,15s\e(B" . "\e$,4!s\e(B")
 368     ("\e$,15s6-\e(B" . "\e$,4!r\e(B")
 369     ("\e$,15t\e(B" . "\e$,4!s"#\e(B")
 370     ("\e$,15t6-\e(B" . "\e$,4!r"#\e(B")
 371
 372     ("\e$,15u\e(B" . "\e$,4!t")\e(B")
 373     ("\e$,15u6-\e(B" . "\e$,4!t\e(B")
 374     ("\e$,15u6-5p\e(B" . "\e$,4!u")\e(B")
 375     ("\e$,15u6-5p6-\e(B" . "\e$,4!u\e(B")
 376     ;; SIBILANTS
 377     ("\e$,15v\e(B" . "\e$,4!v")\e(B")
 378     ("\e$,15v6-\e(B" . "\e$,4!v\e(B")
 379     ("\e$,15v6-5u\e(B" . "\e$,4!w")\e(B")
 380     ("\e$,15v6-5u6-\e(B" . "\e$,4!w\e(B")
 381     ("\e$,15v6-5p\e(B" . "\e$,4!x")\e(B")
 382     ("\e$,15v6-5p6-\e(B" . "\e$,4!x\e(B")
 383
 384     ("\e$,15w\e(B" . "\e$,4!y")\e(B")
 385     ("\e$,15w6-\e(B" . "\e$,4!y\e(B")
 386     ("\e$,15x\e(B" . "\e$,4!z")\e(B")
 387     ("\e$,15x6-\e(B" . "\e$,4!z\e(B")
 388     ("\e$,15x6-5p\e(B" . "\e$,4!{")\e(B")
 389     ("\e$,15x6-5p6-\e(B" . "\e$,4!{\e(B")
 390
 391     ("\e$,15y\e(B" . "\e$,4!}\e(B")
 392     ("\e$,15y6-\e(B" . "\e$,4!|\e(B")
 393     ("\e$,15y6#\e(B" . "\e$,4!~\e(B")
 394     ("\e$,15y6-5p\e(B" . "\e$,4!\7f\e(B")
 395     ("\e$,15y6-5n\e(B" . "\e$,4" \e(B")
 396     ("\e$,15y6-5o\e(B" . "\e$,4"!\e(B")
 397     ;; NUKTAS
 398     ("\e$,168\e(B" . "\e$,4 f"R"S\e(B")
 399     ("\e$,1686-\e(B" . "\e$,4 d\e(B")
 400     ("\e$,169\e(B" . "\e$,4 k")\e(B")
 401     ("\e$,1696-\e(B" . "\e$,4 k\e(B")
 402     ("\e$,16:\e(B" . "\e$,4 n")\e(B")
 403     ("\e$,16:6-\e(B" . "\e$,4 n\e(B")
 404     ("\e$,16;\e(B" . "\e$,4 w")\e(B")
 405     ("\e$,16;6-\e(B" . "\e$,4 w\e(B")
 406     ("\e$,16<\e(B" . "\e$,4!#"W\e(B")
 407     ("\e$,16=\e(B" . "\e$,4!'"X\e(B")
 408     ("\e$,16>\e(B" . "\e$,4!b"[\e(B")
 409     ("\e$,16>6-\e(B" . "\e$,4!>\e(B")
 410     ("\e$,16?\e(B" . "\e$,4!j"#")\e(B")
 411     ;; misc modifiers.
 412     ("\e$,15A\e(B" . "\\e$,4"$\e(B")
 413     ("\e$,15B\e(B" . "\\e$,4"&\e(B")
 414     ("\e$,15C\e(B" . "\e$,4 F\e(B")
 415     ("\e$,15|\e(B" . "\e$,4"#\e(B")
 416     ("\e$,15}\e(B" . "\e$,4 E\e(B")
 417     ("\e$,16-\e(B" . "\e$,4""\e(B")
 418     ("\e$,16-5p\e(B" . "\e$,4"%\e(B") ;; following "r"
 419     ;; ("\e$,160\e(B" . "\e$,4 D\e(B")
 420     ("\e$,16D\e(B" . "\e$,4 J\e(B")
 421     ;; ("\e$,16F\e(B" . "")
 422     ;; ("\e$,16G\e(B" . "")
 423     ;; ("\e$,16H\e(B" . "")
 424     ;; ("\e$,16I\e(B" . "")
 425     ;; ("\e$,16J\e(B" . "")
 426     ;; ("\e$,16K\e(B" . "")
 427     ;; ("\e$,16L\e(B" . "")
 428     ;; ("\e$,16M\e(B" . "")
 429     ;; ("\e$,16N\e(B" . "")
 430     ;; ("\e$,16O\e(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   '(("\\e$,4"'\e(B\\e$,4"&\e(B" . "\\e$,4"(\e(B")
 451     ("\\e$,4"'\e(B\\e$,4"$\e(B" . "\\e$,4"(\e(B")
 452     ("\e$,4"*\e(B\\e$,4"&\e(B" . "\e$,4"+\e(B")
 453     ("\e$,4"*\e(B\\e$,4"'\e(B" . "\e$,4",\e(B")
 454     ("\e$,4"*\e(B\\e$,4"'\e(B\\e$,4"&\e(B" . "\e$,4"-\e(B")
 455     ("\e$,4"2\e(B\\e$,4"&\e(B" . "\e$,4"3\e(B")
 456     ("\e$,4"2\e(B\\e$,4"'\e(B" . "\e$,4"4\e(B")
 457     ("\e$,4"2\e(B\\e$,4"'\e(B\\e$,4"&\e(B" . "\e$,4"5\e(B")
 458     ("\e$,4"#\e(B\\e$,4"6\e(B" . "\e$,4"7\e(B")
 459     ("\e$,4"%\e(B\\e$,4"6\e(B" . "\e$,4"8\e(B")
 460     ;;("\e$,4"6\e(B" . "\e$,4"9\e(B")
 461     ("\e$,4"#\e(B\\e$,4":\e(B" . "\e$,4";\e(B")
 462     ("\e$,4"%\e(B\\e$,4":\e(B" . "\e$,4"<\e(B")
 463     ;;("\e$,4":\e(B" . "\e$,4"=\e(B")
 464     ("\\e$,4"@\e(B\\e$,4"&\e(B" . "\\e$,4"A\e(B")
 465     ("\\e$,4"@\e(B\\e$,4"'\e(B" . "\\e$,4"B\e(B")
 466     ("\\e$,4"@\e(B\\e$,4"'\e(B\\e$,4"&\e(B" . "\\e$,4"C\e(B")
 467     ("\\e$,4"D\e(B\\e$,4"&\e(B" . "\\e$,4"E\e(B")
 468     ("\\e$,4"D\e(B\\e$,4"'\e(B" . "\\e$,4"F\e(B")
 469     ("\\e$,4"D\e(B\\e$,4"'\e(B\\e$,4"&\e(B" . "\\e$,4"G\e(B")
 470     ("\\e$,4"H\e(B\\e$,4"&\e(B" . "\\e$,4"I\e(B")
 471     ("\\e$,4"H\e(B\\e$,4"'\e(B" . "\\e$,4"J\e(B")
 472     ("\\e$,4"H\e(B\\e$,4"'\e(B\\e$,4"&\e(B" . "\\e$,4"K\e(B")
 473     ("\\e$,4"L\e(B\\e$,4"&\e(B" . "\\e$,4"M\e(B")
 474     ("\\e$,4"L\e(B\\e$,4"'\e(B" . "\\e$,4"N\e(B")
 475     ("\\e$,4"L\e(B\\e$,4"'\e(B\\e$,4"&\e(B" . "\\e$,4"O\e(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   '(("\e$,4"*\e(B" . "\e$,4".\e(B")
 489     ("\e$,4"+\e(B" . "\e$,4"/\e(B")
 490     ("\e$,4",\e(B" . "\e$,4"0\e(B")
 491     ("\e$,4"-\e(B" . "\e$,4"1\e(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 ?\e$,16-\e(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 ?\e$,15A\e(B) (eq last-char ?\e$,15B\e(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 "\e$,15p6-\e(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                                         "\e$,4"'\e(B" (substring glyph-str -1)))
 608               (setq glyph-str (concat glyph-str "\e$,4"'\e(B"))))
 609         (if last-halant (setq glyph-str (concat glyph-str "\e$,4""\e(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 "\e$,4""\e(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                  (function (lambda (x)
 646                    (list
 647                     (or (get-char-code-property x 'reference-point)
 648                     '(5 . 3) ;; default reference point.
 649                      )
 650                     x)))
 651                  glyph-str-list))))))
 652       (compose-region from to glyph-str)))
 653
 654 (provide 'devan-util)
 655
 656 ;;; arch-tag: 9bc4d6e3-f2b9-4110-886e-ff9b66b7eebc
 657 ;;; devan-util.el ends here