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