lisp/language/devan-util.el

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