lisp/language/mlm-util.el

   1 ;;; mlm-util.el --- support for composing malayalam characters  -*-coding: iso-2022-7bit;-*-
   2
   3 ;; Copyright (C) 2003 Free Software Foundation, Inc.
   4
   5 ;; Maintainer:  KAWABATA, Taichi <kawabata@m17n.org>
   6 ;; Keywords: multilingual, Malayalam
   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. 11. 2003
  26
  27 ;;; Commentary:
  28
  29 ;; This file provides character(Unicode) to glyph(CDAC) conversion and
  30 ;; composition of Malayalam script characters.
  31
  32 ;;; Code:
  33
  34 ;; Malayalam Composable Pattern
  35 ;;    C .. Consonants
  36 ;;    V .. Vowel
  37 ;;    H .. Halant
  38 ;;    M .. Matra
  39 ;;    V .. Vowel
  40 ;;    A .. Anuswar
  41 ;;    D .. Chandrabindu
  42 ;;    (N .. Zerowidth Non Joiner)
  43 ;;    (J .. Zerowidth Joiner.  )
  44 ;; 1. vowel
  45 ;;  V(A|visargam)?
  46 ;; 2. syllable : maximum of 5 consecutive consonants.  (e.g. kartsnya)
  47 ;;  ((CH)?(CH)?(CH)?CH)?C(H|M?(A|D)?)?
  48
  49 (defconst malayalam-consonant
  50   "[\e$,1@5\e(B-\e$,1@Y\e(B]")
  51
  52 (defconst malayalam-composable-pattern
  53   (concat
  54    "\\([\e$,1@%\e(B-\e$,1@4\e(B][\e$,1@"\e(B]?\\)\\|\e$,1@#\e(B"
  55    "\\|\\("
  56    "\\(?:\\(?:[\e$,1@5\e(B-\e$,1@Y\e(B]\e$,1@m\e(B\\)?\\(?:[\e$,1@5\e(B-\e$,1@Y\e(B]\e$,1@m\e(B\\)?\\(?:[\e$,1@5\e(B-\e$,1@Y\e(B]\e$,1@m\e(B\\)?[\e$,1@5\e(B-\e$,1@Y\e(B]\e$,1@m\e(B\\)?"
  57    "[\e$,1@5\e(B-\e$,1@Y\e(B]\\(?:\e$,1@m\e(B\\|[\e$,1@^\e(B-\e$,1@c@f@g@h@j@j@k@l\e(B]?[\e$,1@"@m\e(B]?\\)?"
  58    "\\)")
  59   "Regexp matching a composable sequence of Malayalam characters.")
  60
  61 ;;;###autoload
  62 (defun malayalam-compose-region (from to)
  63   (interactive "r")
  64   (save-excursion
  65     (save-restriction
  66       (narrow-to-region from to)
  67       (goto-char (point-min))
  68       (while (re-search-forward malayalam-composable-pattern nil t)
  69         (malayalam-compose-syllable-region (match-beginning 0)
  70                                             (match-end 0))))))
  71 (defun malayalam-compose-string (string)
  72   (with-temp-buffer
  73     (insert (decompose-string string))
  74     (malayalam-compose-region (point-min) (point-max))
  75     (buffer-string)))
  76
  77 ;;;###autoload
  78 (defun malayalam-post-read-conversion (len)
  79   (save-excursion
  80     (save-restriction
  81       (let ((buffer-modified-p (buffer-modified-p)))
  82         (narrow-to-region (point) (+ (point) len))
  83         (malayalam-compose-region (point-min) (point-max))
  84         (set-buffer-modified-p buffer-modified-p)
  85         (- (point-max) (point-min))))))
  86
  87 (defun malayalam-range (from to)
  88   "Make the list of the integers of range FROM to TO."
  89   (let (result)
  90     (while (<= from to) (setq result (cons to result) to (1- to))) result))
  91
  92 (defun malayalam-regexp-of-hashtbl-keys (hashtbl)
  93   "Return a regular expression that matches all keys in hashtable HASHTBL."
  94   (let ((max-specpdl-size 1000))
  95     (regexp-opt
  96      (sort
  97       (let (dummy)
  98         (maphash (function (lambda (key val) (setq dummy (cons key dummy)))) hashtbl)
  99         dummy)
 100       (function (lambda (x y) (> (length x) (length y))))))))
 101
 102
 103 ;;;###autoload
 104 (defun malayalam-composition-function (pos  &optional string)
 105   "Compose Malayalam characters after the position POS.
 106 If STRING is not nil, it is a string, and POS is an index to the string.
 107 In this case, compose characters after POS of the string."
 108   (if string
 109       ;; Not yet implemented.
 110       nil
 111     (goto-char pos)
 112     (if (looking-at malayalam-composable-pattern)
 113         (prog1 (match-end 0)
 114           (malayalam-compose-syllable-region pos (match-end 0))))))
 115
 116 ;; Notes on conversion steps.
 117
 118 ;; 1. chars to glyphs
 119 ;;
 120 ;; Simple replacement of characters to glyphs is done.
 121
 122 ;; 2. glyphs reordering.
 123 ;;
 124 ;; Two special reordering rule takes place.
 125 ;; a. following "\e$,46[\e(B" goes to the front.
 126 ;; b. following "\e$,46S6S\e(B", "\e$,46S\e(B" or "\e$,46T\e(B" goes to the front.
 127 ;; This reordering occurs only to the last cluster of consonants.
 128 ;; Preceding consonants with halant characters are not affected.
 129
 130 ;; 3. Composition.
 131 ;;
 132 ;; left modifiers will be attached at the left.
 133 ;; others will be attached right.
 134
 135 (defvar mlm-char-glyph
 136   '(;; various signs
 137     ("\e$,1@"\e(B" . "\e$,46W\e(B")
 138     ("\e$,1@#\e(B" . "\e$,46X\e(B")
 139     ;; Independent Vowels
 140     ("\e$,1@%\e(B" . "\e$,46!\e(B")
 141     ("\e$,1@&\e(B" . "\e$,46"\e(B")
 142     ("\e$,1@'\e(B" . "\e$,46#\e(B")
 143     ("\e$,1@(\e(B" . "\e$,46#6U\e(B")
 144     ("\e$,1@)\e(B" . "\e$,46$\e(B")
 145     ("\e$,1@*\e(B" . "\e$,46$6U\e(B")
 146     ("\e$,1@+\e(B" . "\e$,46%\e(B")
 147     ("\e$,1@,\e(B" . "nil") ;; not in present use, not supported.
 148     ("\e$,1@.\e(B" . "\e$,46&\e(B")
 149     ("\e$,1@/\e(B" . "\e$,46'\e(B")
 150     ("\e$,1@0\e(B" . "\e$,46S6&\e(B")
 151     ("\e$,1@2\e(B" . "\e$,46(\e(B")
 152     ("\e$,1@3\e(B" . "\e$,46(6M\e(B")
 153     ("\e$,1@4\e(B" . "\e$,46(6U\e(B")
 154     ;; Consonants
 155     ("\e$,1@5\e(B" . "\e$,46)\e(B")
 156     ("\e$,1@5@m@5\e(B" . "\e$,47!\e(B")
 157     ("\e$,1@5@m@S\e(B" . "\e$,47"\e(B")
 158     ("\e$,1@5@m@W\e(B" . "\e$,47#\e(B")
 159     ("\e$,1@5@m@?\e(B" . "\e$,47N\e(B")
 160     ("\e$,1@5@m@D\e(B" . "\e$,47`\e(B")
 161     ("\e$,1@5@a\e(B" . "\e$,47f\e(B")
 162     ("\e$,1@5@m@5@a\e(B" . "\e$,47g\e(B")
 163     ("\e$,1@5@a\e(B" . "\e$,47f\e(B")
 164     ("\e$,1@5@m@5@a\e(B" . "\e$,47g\e(B")
 165
 166     ("\e$,1@6\e(B" . "\e$,46*\e(B")
 167
 168     ("\e$,1@7\e(B" . "\e$,46+\e(B")
 169     ("\e$,1@7@m@7\e(B" . "\e$,47$\e(B")
 170     ("\e$,1@7@m@R\e(B" . "\e$,47%\e(B")
 171     ("\e$,1@7@m@N\e(B" . "\e$,47\\e(B")
 172     ("\e$,1@7@m@H\e(B" . "\e$,47a\e(B")
 173
 174     ("\e$,1@8\e(B" . "\e$,46,\e(B")
 175
 176     ("\e$,1@9\e(B" . "\e$,46-\e(B")
 177     ("\e$,1@9@m@5\e(B" . "\e$,47&\e(B")
 178     ("\e$,1@9@m@9\e(B" . "\e$,47'\e(B")
 179     ("\e$,1@9@m@5@a\e(B" . "\e$,47h\e(B")
 180
 181     ("\e$,1@:\e(B" . "\e$,46.\e(B")
 182     ("\e$,1@:@m@:\e(B" . "\e$,47(\e(B") ;; duplicate
 183     ("\e$,1@:@m@;\e(B" . "\e$,47Q\e(B")
 184
 185     ("\e$,1@;\e(B" . "\e$,46/\e(B")
 186
 187     ("\e$,1@<\e(B" . "\e$,460\e(B")
 188     ("\e$,1@<@m@<\e(B" . "\e$,47V\e(B")
 189     ("\e$,1@<@m@>\e(B" . "\e$,47Z\e(B")
 190
 191     ("\e$,1@=\e(B" . "\e$,461\e(B")
 192
 193     ("\e$,1@>\e(B" . "\e$,462\e(B")
 194     ("\e$,1@>@m@:\e(B" . "\e$,47)\e(B")
 195     ("\e$,1@>@m@>\e(B" . "\e$,47*\e(B")
 196
 197     ("\e$,1@?\e(B" . "\e$,463\e(B")
 198     ("\e$,1@?@m@?\e(B" . "\e$,47+\e(B")
 199
 200     ("\e$,1@@\e(B" . "\e$,464\e(B")
 201     ("\e$,1@A\e(B" . "\e$,465\e(B")
 202     ("\e$,1@A@m@A\e(B" . "\e$,47M\e(B")
 203     ("\e$,1@B\e(B" . "\e$,466\e(B")
 204
 205     ("\e$,1@C\e(B" . "\e$,467\e(B")
 206     ("\e$,1@C@a@m\e(B" . "\e$,47,\e(B") ;; half consonant
 207     ("\e$,1@C@m@?\e(B" . "\e$,47-\e(B")
 208     ("\e$,1@C@m@C\e(B" . "\e$,47.\e(B")
 209     ("\e$,1@C@m@N\e(B" . "\e$,47W\e(B")
 210     ("\e$,1@C@m@A\e(B" . "\e$,47^\e(B")
 211     ("\e$,1@C@a\e(B" . "\e$,47i\e(B")
 212
 213     ("\e$,1@D\e(B" . "\e$,468\e(B")
 214     ("\e$,1@D@m@D\e(B" . "\e$,47/\e(B")
 215     ("\e$,1@D@m@E\e(B" . "\e$,470\e(B")
 216     ("\e$,1@D@m@X\e(B" . "\e$,47U\e(B")
 217     ("\e$,1@D@m@M\e(B" . "\e$,47[\e(B")
 218     ("\e$,1@D@m@N\e(B" . "\e$,47_\e(B")
 219
 220     ("\e$,1@E\e(B" . "\e$,469\e(B")
 221
 222     ("\e$,1@F\e(B" . "\e$,46:\e(B")
 223     ("\e$,1@F@m@F\e(B" . "\e$,471\e(B")
 224     ("\e$,1@F@m@G\e(B" . "\e$,472\e(B")
 225
 226     ("\e$,1@G\e(B" . "\e$,46;\e(B")
 227
 228     ("\e$,1@H\e(B" . "\e$,46<\e(B")
 229     ("\e$,1@H@a@m\e(B" . "\e$,473\e(B") ;; half consonant
 230     ("\e$,1@H@m@D\e(B" . "\e$,474\e(B")
 231     ("\e$,1@H@m@F\e(B" . "\e$,475\e(B")
 232     ("\e$,1@H@m@H\e(B" . "\e$,476\e(B")
 233     ("\e$,1@H@m@N\e(B" . "\e$,477\e(B")
 234     ("\e$,1@H@m@G\e(B" . "\e$,47T\e(B")
 235     ("\e$,1@H@m@E\e(B" . "\e$,47Y\e(B")
 236     ("\e$,1@H@m@Q\e(B" . "\e$,47b\e(B")
 237     ("\e$,1@H@a\e(B" . "\e$,47k\e(B")
 238     ("\e$,1@H@m@H@a\e(B" . "\e$,47l\e(B")
 239
 240     ("\e$,1@J\e(B" . "\e$,46=\e(B")
 241     ("\e$,1@J@m@J\e(B" . "\e$,478\e(B") ;; duplicate
 242     ("\e$,1@J@m@R\e(B" . "\e$,479\e(B") ;; lakar
 243
 244     ("\e$,1@K\e(B" . "\e$,46>\e(B")
 245
 246     ("\e$,1@L\e(B" . "\e$,46?\e(B")
 247     ("\e$,1@L@m@L\e(B" . "\e$,47:\e(B") ;; duplicate
 248     ("\e$,1@L@m@R\e(B" . "\e$,47;\e(B") ;; lakar
 249     ("\e$,1@L@m@G\e(B" . "\e$,47O\e(B")
 250     ("\e$,1@L@m@F\e(B" . "\e$,47P\e(B")
 251
 252     ("\e$,1@M\e(B" . "\e$,46@\e(B")
 253
 254     ("\e$,1@N\e(B" . "\e$,46A\e(B")
 255     ("\e$,1@N@m@J\e(B" . "\e$,47<\e(B")
 256     ("\e$,1@N@m@N\e(B" . "\e$,47=\e(B")
 257     ("\e$,1@N@m@R\e(B" . "\e$,47>\e(B") ;; lakar
 258
 259     ("\e$,1@O\e(B" . "\e$,46B\e(B")
 260     ("\e$,1@O@m@O\e(B" . "\e$,47?\e(B") ;; duplicate
 261     ("\e$,1@O@m@5@m@5\e(B" . "\e$,47m\e(B")
 262
 263     ("\e$,1@P\e(B" . "\e$,46C\e(B")
 264     ("\e$,1@P@a@m\e(B" . "\e$,47@\e(B")
 265     ("\e$,1@P@a\e(B" . "\e$,47j\e(B")
 266
 267     ("\e$,1@Q\e(B" . "\e$,46D\e(B")
 268     ("\e$,1@Q@m\e(B" . "\e$,47@\e(B") ;; same glyph as "\e$,1@P@m\e(B"
 269     ("\e$,1@Q@a@m\e(B" . "\e$,47@\e(B") ;; same glyph as "\e$,1@P@m\e(B"
 270     ;;("\e$,1@Q@m@Q\e(B" . "\e$,47A\e(B")
 271     ("\e$,1@Q@m@Q\e(B" . "\e$,47d\e(B")
 272
 273     ("\e$,1@R\e(B" . "\e$,46E\e(B")
 274     ("\e$,1@R@a@m\e(B" . "\e$,47B\e(B")
 275     ("\e$,1@R@m@R\e(B" . "\e$,47C\e(B") ;; lakar
 276     ("\e$,1@R@m@J\e(B" . "\e$,47e\e(B")
 277
 278     ("\e$,1@S\e(B" . "\e$,46F\e(B")
 279     ("\e$,1@S@a@m\e(B" . "\e$,47D\e(B")
 280     ("\e$,1@S@m@S\e(B" . "\e$,47E\e(B")
 281
 282     ("\e$,1@T\e(B" . "\e$,46G\e(B")
 283
 284     ("\e$,1@U\e(B" . "\e$,46H\e(B")
 285     ("\e$,1@U@m@U\e(B" . "\e$,47F\e(B")
 286
 287     ("\e$,1@V\e(B" . "\e$,46I\e(B")
 288     ("\e$,1@V@m@R\e(B" . "\e$,47G\e(B")
 289     ("\e$,1@V@m@V\e(B" . "\e$,47H\e(B")
 290     ("\e$,1@V@m@:\e(B" . "\e$,47]\e(B")
 291
 292     ("\e$,1@W\e(B" . "\e$,46J\e(B")
 293     ("\e$,1@W@m@?\e(B" . "\e$,47c\e(B")
 294
 295     ("\e$,1@X\e(B" . "\e$,46K\e(B")
 296     ("\e$,1@X@m@R\e(B" . "\e$,47I\e(B")
 297     ("\e$,1@X@m@X\e(B" . "\e$,47J\e(B")
 298     ("\e$,1@X@m@Q@m@Q\e(B" . "\e$,47L\e(B")
 299     ("\e$,1@X@m@E\e(B" . "\e$,47X\e(B")
 300
 301     ("\e$,1@Y\e(B" . "\e$,46L\e(B")
 302     ("\e$,1@Y@m@R\e(B" . "\e$,47K\e(B")
 303     ("\e$,1@Y@m@N\e(B" . "\e$,47R\e(B")
 304     ("\e$,1@Y@m@H\e(B" . "\e$,47S\e(B")
 305
 306     ;; Dependent vowel signs
 307     ("\e$,1@^\e(B" . "\e$,46M\e(B")
 308     ("\e$,1@_\e(B" . "\e$,46N\e(B")
 309     ("\e$,1@`\e(B" . "\e$,46O\e(B")
 310     ("\e$,1@a\e(B" . "\e$,46P\e(B")
 311     ("\e$,1@b\e(B" . "\e$,46Q\e(B")
 312     ("\e$,1@c\e(B" . "\e$,46R\e(B")
 313     ("\e$,1@f\e(B" . "\e$,46S\e(B")
 314     ("\e$,1@g\e(B" . "\e$,46T\e(B")
 315     ("\e$,1@h\e(B" . "\e$,46S6S\e(B")
 316     ("\e$,1@j\e(B" . "\e$,46S6M\e(B")
 317     ("\e$,1@k\e(B" . "\e$,46T6M\e(B")
 318     ("\e$,1@l\e(B" . "\e$,46U\e(B")
 319     ;; Various signs
 320     ("\e$,1@m\e(B" . "\e$,46V\e(B")
 321     ("\e$,1@m@O\e(B" . "\e$,46Y\e(B") ;; yakar
 322     ("\e$,1@m@O@a\e(B" . "\e$,46\\e(B") ;; yakar + u
 323     ("\e$,1@m@O@b\e(B" . "\e$,46]\e(B") ;; yakar + uu
 324     ("\e$,1@m@U\e(B" . "\e$,46Z\e(B") ;; vakar modifier
 325     ("\e$,1@m@P\e(B" . "\e$,46[\e(B") ;; rakar modifier is the same to rra modifier.
 326     ("\e$,1@m@P@m\e(B" . "\e$,46R\e(B") ;; halant + rakar + halant
 327     ("\e$,1@m@Q\e(B" . "\e$,46[\e(B") ;; rrakar modifier
 328     ("\e$,1@m@Q@m\e(B" . "\e$,46R\e(B") ;; halant + rrakar + halant
 329     ("\e$,1@m@m\e(B" . "\e$,46V\e(B") ;; double omission sign to stop forming half consonant.
 330     ("\e$,1@w\e(B" . "\e$,46U\e(B") ;; not in present use, already at 0D4C.
 331     ))
 332
 333 (defvar mlm-char-glyph-hash
 334   (let* ((hash (make-hash-table :test 'equal)))
 335     (mapc (function (lambda (x) (puthash (car x) (cdr x) hash)))
 336           mlm-char-glyph)
 337     hash))
 338
 339 (defvar mlm-char-glyph-regexp
 340   (malayalam-regexp-of-hashtbl-keys mlm-char-glyph-hash))
 341
 342 ;; Malayalam languages needed to be reordered in a complex mannar.
 343
 344 (defvar mlm-consonants
 345   (concat
 346   "\e$,46)6*6+6,6-6.6/606162636465666768696:6;6<6=6>6?6@6A6B6C6D6E6F6G6H6I6J6K6L\e(B"
 347   "\e$,47!7"7#7$7%7&7'7(7)7*7+7,7-7.7/707172737475767778797:7;7<7=7>7?7@7A7B7C7D7E7F7G7H7I7J7K7L7M7N7O7P7Q7R7S7T7U7V7W7X7Y7Z7[7\7]7^7_7`7a7b7c7d7e\e(B"
 348   ))
 349
 350 (defvar mlm-consonants-regexp
 351   (concat "\\(\e$,46[\e(B?[" mlm-consonants "][\e$,46Y6Z\e(B]?\\)"))
 352
 353 (defvar mlm-glyph-reorder-key-glyphs "[\e$,46[6S6T\e(B]")
 354
 355 (defvar mlm-glyph-reordering-regexp-list
 356   `((,(concat "\\([" mlm-consonants "][\e$,46Y6Z\e(B]?\\)\e$,46[\e(B") . "\e$,46[\e(B\\1")
 357     (,(concat mlm-consonants-regexp "\e$,46S6S\e(B") . "\e$,46S6S\e(B\\1")
 358     (,(concat mlm-consonants-regexp "\e$,46S\e(B") . "\e$,46S\e(B\\1")
 359     (,(concat mlm-consonants-regexp "\e$,46T\e(B") . "\e$,46T\e(B\\1")))
 360
 361 (defun malayalam-compose-syllable-string (string)
 362   (with-temp-buffer
 363     (insert (decompose-string string))
 364     (malayalam-compose-syllable-region (point-min) (point-max))
 365     (buffer-string)))
 366
 367 (defun malayalam-compose-syllable-region (from to)
 368   "Compose malayalam syllable in region FROM to TO."
 369   (let (glyph-str
 370         match-str
 371         glyph-reorder-regexps
 372         glyph-reorder-replace
 373         glyph-reorder-regexp)
 374     (save-excursion
 375       (save-restriction
 376         (narrow-to-region from to)
 377         (goto-char (point-min))
 378         ;; char-glyph-conversion
 379         (while (not (eobp))
 380           (if (looking-at mlm-char-glyph-regexp)
 381               (progn
 382                 (setq match-str (match-string 0)
 383                       glyph-str
 384                       (concat glyph-str
 385                               (gethash match-str mlm-char-glyph-hash)))
 386                 (goto-char (match-end 0)))
 387             (setq glyph-str (concat glyph-str (string (following-char))))
 388             (forward-char 1)))
 389         (when (string-match mlm-glyph-reorder-key-glyphs glyph-str)
 390           ;; glyph reordering
 391           (setq glyph-reorder-regexps mlm-glyph-reordering-regexp-list)
 392           (while glyph-reorder-regexps
 393             (setq glyph-reorder-regexp (caar glyph-reorder-regexps))
 394             (setq glyph-reorder-replace (cdar glyph-reorder-regexps))
 395             (setq glyph-reorder-regexps (cdr glyph-reorder-regexps))
 396             (if (string-match glyph-reorder-regexp glyph-str)
 397                 (setq glyph-str
 398                       (replace-match glyph-reorder-replace nil nil
 399                                      glyph-str)))))
 400         ;; concatenate and attach reference-points.
 401         (setq glyph-str
 402               (cdr
 403                (apply
 404                 'nconc
 405                 (mapcar
 406                  (function
 407                   (lambda (x) (list '(5 . 3) x))) ;; default ref. point.
 408                  glyph-str))))
 409         (compose-region from to glyph-str)))))
 410
 411 (provide 'mlm-util)
 412
 413 ;;; arch-tag: 7f25ee67-8f9d-49f2-837b-35c412c00eba
 414 ;;; devan-util.el ends here