1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-16 09:50:25 +00:00
emacs/lisp/language/tml-util.el
2005-07-04 17:55:18 +00:00

370 lines
12 KiB
EmacsLisp
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;; tml-util.el --- support for composing tamil characters -*-coding: iso-2022-7bit;-*-
;; Copyright (C) 2001 Free Software Foundation, Inc.
;; Maintainer: KAWABATA, Taichi <kawabata@m17n.org>
;; Keywords: multilingual, Indian, Tamil
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;; Created: Nov. 08. 2002
;;; Commentary:
;; This file provides character(Unicode) to glyph(CDAC) conversion and
;; composition of Tamil script characters.
;;; Code:
;; Tamil Composable Pattern
;; C .. Consonants
;; V .. Vowel
;; H .. Pulli
;; M .. Matra
;; V .. Vowel
;; A .. Anuswar
;; D .. Chandrabindu
;; 1. vowel
;; V
;; 2. syllable : only ligature-formed pattern forms composition.
;; (CkHCs|C)(H|M)?
;; 3. sri special
;; (CsHCrVi)
;; oririnal
;; ((CH)?(CH)?(CH)?CH)?C(H|M?(A|D)?)?
(defconst tamil-consonant
"[$,1<5(B-$,1<Y(B]")
(defconst tamil-composable-pattern
(concat
"\\([$,1<%(B-$,1<4(B]\\)\\|"
"[$,1<"<#(B]\\|" ;; vowel modifier considered independent
"\\(\\(?:\\(?:$,1<5<m<W(B\\)\\|[$,1<5(B-$,1<Y(B]\\)[$,1<m<^(B-$,1<l(B]?\\)\\|"
"\\($,1<W<m<P<`(B\\)")
"Regexp matching a composable sequence of Tamil characters.")
;;;###autoload
(defun tamil-compose-region (from to)
(interactive "r")
(save-excursion
(save-restriction
(narrow-to-region from to)
(goto-char (point-min))
(while (re-search-forward tamil-composable-pattern nil t)
(tamil-compose-syllable-region (match-beginning 0)
(match-end 0))))))
(defun tamil-compose-string (string)
(with-temp-buffer
(insert (decompose-string string))
(tamil-compose-region (point-min) (point-max))
(buffer-string)))
;;;###autoload
(defun tamil-post-read-conversion (len)
(save-excursion
(save-restriction
(let ((buffer-modified-p (buffer-modified-p)))
(narrow-to-region (point) (+ (point) len))
(tamil-compose-region (point-min) (point-max))
(set-buffer-modified-p buffer-modified-p)
(- (point-max) (point-min))))))
(defun tamil-range (from to)
"Make the list of the integers of range FROM to TO."
(let (result)
(while (<= from to) (setq result (cons to result) to (1- to))) result))
(defun tamil-regexp-of-hashtbl-keys (hashtbl)
"Return a regular expression that matches all keys in hashtable HASHTBL."
(let ((max-specpdl-size 1000))
(regexp-opt
(sort
(let (dummy)
(maphash (function (lambda (key val) (setq dummy (cons key dummy)))) hashtbl)
dummy)
(function (lambda (x y) (> (length x) (length y))))))))
;;;###autoload
(defun tamil-composition-function (from to pattern &optional string)
"Compose Tamil characters in REGION, or STRING if specified.
Assume that the REGION or STRING must fully match the composable
PATTERN regexp."
(if string (tamil-compose-syllable-string string)
(tamil-compose-syllable-region from to))
(- to from))
;; Register a function to compose Tamil characters.
(mapc
(function (lambda (ucs)
(aset composition-function-table (decode-char 'ucs ucs)
(list (cons tamil-composable-pattern
'tamil-composition-function)))))
(nconc '(#x0b82 #x0b83) (tamil-range #x0b85 #x0bb9)))
;; Notes on conversion steps.
;; 1. chars to glyphs
;; Simple replacement of characters to glyphs is done.
;; 2. glyphs reordering.
;; following "$,4)j(B", "$,4)k(B", "$,4)l(B" goes to the front.
;; 3. glyphs to glyphs
;; reordered vowels are ligatured to consonants.
;; 4. Composition.
;; left modifiers will be attached at the left.
;; others will be attached right.
(defvar tml-char-glyph
'(;; various signs
;;("$,1<"(B" . "")
("$,1<#(B" . "$,4*G(B")
;; Independent Vowels
("$,1<%(B" . "$,4*<(B")
("$,1<&(B" . "$,4*=(B")
("$,1<'(B" . "$,4*>(B")
("$,1<((B" . "$,4*?(B")
("$,1<)(B" . "$,4*@(B")
("$,1<*(B" . "$,4*A(B")
("$,1<.(B" . "$,4*B(B")
("$,1</(B" . "$,4*C(B")
("$,1<0(B" . "$,4*D(B")
("$,1<2(B" . "$,4*E(B")
("$,1<3(B" . "$,4*F(B")
("$,1<4(B" . "$,4*E*W(B")
;; Consonants
("$,1<5<m<W<m(B" . "$,4):(B") ; ks.
("$,1<5<m<W(B" . "$,4*^(B") ; ks
("$,1<5(B" . "$,4*H(B")
("$,1<9(B" . "$,4*I(B")
("$,1<:(B" . "$,4*J(B")
("$,1<<(B" . "$,4*\(B")
("$,1<<<m(B" . "$,4)8(B")
("$,1<>(B" . "$,4*K(B")
("$,1<?(B" . "$,4*L(B")
("$,1<C(B" . "$,4*M(B")
("$,1<D(B" . "$,4*N(B")
("$,1<H(B" . "$,4*O(B")
("$,1<I(B" . "$,4*Y(B")
("$,1<I<m(B" . "$,4)a(B")
("$,1<J(B" . "$,4*P(B")
("$,1<N(B" . "$,4*Q(B")
("$,1<O(B" . "$,4*R(B")
("$,1<P(B" . "$,4*S(B")
("$,1<Q(B" . "$,4*X(B")
("$,1<R(B" . "$,4*T(B")
("$,1<S(B" . "$,4*W(B")
("$,1<T(B" . "$,4*V(B")
("$,1<U(B" . "$,4*U(B")
("$,1<W(B" . "$,4*[(B")
("$,1<W<m(B" . "$,4)7(B")
("$,1<W<m<P<`(B" . "$,4*_(B")
("$,1<X(B" . "$,4*Z(B")
("$,1<X<m(B" . "$,4)6(B")
("$,1<Y(B" . "$,4*](B")
("$,1<Y<m(B" . "$,4)9(B")
;; Dependent vowel signs
("$,1<^(B" . "$,4)c(B")
("$,1<_(B" . "$,4)d(B")
("$,1<`(B" . "$,4)f(B")
("$,1<a(B" . "$,4)g(B")
("$,1<b(B" . "$,4)h(B")
("$,1<f(B" . "$,4)j(B")
("$,1<g(B" . "$,4)k(B")
("$,1<h(B" . "$,4)l(B")
("$,1<j(B" . "$,4)j)c(B")
("$,1<k(B" . "$,4)k)c(B")
("$,1<l(B" . "$,4)j*W(B")
;; Various signs
("$,1<m(B" . "$,4)b(B")
("$,1<w(B" . "nil") ;; not supported?
))
(defvar tml-char-glyph-hash
(let* ((hash (make-hash-table :test 'equal)))
(mapc (function (lambda (x) (puthash (car x) (cdr x) hash)))
tml-char-glyph)
hash))
(defvar tml-char-glyph-regexp
(tamil-regexp-of-hashtbl-keys tml-char-glyph-hash))
;; Tamil languages needed to be reordered.
(defvar tml-consonants-regexp
"[$,4*H*^*I*J*\*K*L*M*N*O*Y*P*Q*R*S*X*T*W*V*U*[*Z*](B]")
(defvar tml-glyph-reorder-key-glyphs "[$,4)j)k)l(B]")
(defvar tml-glyph-reordering-regexp-list
(cons
(concat "\\(" tml-consonants-regexp "\\)\\([$,4)j)k)l(B]\\)") "\\2\\1"))
;; Tamil vowel modifiers to be ligatured.
(defvar tml-glyph-glyph
'(
("$,4*H)d(B" . "$,4(a(B") ; ki
("$,4*^)d(B" . "$,4(v(B") ; ksi
("$,4*^)f(B" . "$,4)2(B") ; ksi~
("$,4*I)d(B" . "$,4(b(B") ; n^i
("$,4*J)d(B" . "$,4(c(B") ; ci
("$,4*K)d(B" . "$,4(d(B") ; n~i
("$,4*L)d(B" . "$,4)n(B") ; t.i
("$,4*M)d(B" . "$,4(e(B") ; n.i
("$,4*N)d(B" . "$,4(f(B") ; ti
("$,4*O)d(B" . "$,4(g(B") ; ni
("$,4*P)d(B" . "$,4(h(B") ; pi
("$,4*Q)d(B" . "$,4(i(B") ; mi
("$,4*R)d(B" . "$,4(j(B") ; yi
("$,4*S)d(B" . "$,4(k(B") ; ri
("$,4*T)d(B" . "$,4(l(B") ; li
("$,4*U)d(B" . "$,4(m(B") ; vi
("$,4*V)d(B" . "$,4(n(B") ; l_i
("$,4*W)d(B" . "$,4(o(B") ; l.i
("$,4*X)d(B" . "$,4(p(B") ; r_i
("$,4*Y)d(B" . "$,4(q(B") ; n_i
("$,4*Z)d(B" . "$,4(r(B") ; si
("$,4*[)d(B" . "$,4(s(B") ; s'i
("$,4*\)d(B" . "$,4(t(B") ; ji
("$,4*])d(B" . "$,4(u(B") ; hi
("$,4*H)f(B" . "$,4(w(B") ; ki~
("$,4*I)f(B" . "$,4(x(B") ; n^i~
("$,4*J)f(B" . "$,4(y(B") ; ci~
("$,4*K)f(B" . "$,4(z(B") ; n~i~
("$,4*L)f(B" . "$,4)o(B") ; t.i~
("$,4*M)f(B" . "$,4)!(B") ; n.i~
("$,4*N)f(B" . "$,4)"(B") ; ti~
("$,4*O)f(B" . "$,4)#(B") ; ni~
("$,4*P)f(B" . "$,4)$(B") ; pi~
("$,4*Q)f(B" . "$,4)%(B") ; mi~
("$,4*R)f(B" . "$,4)&(B") ; yi~
("$,4*S)f(B" . "$,4)'(B") ; ri~
("$,4*T)f(B" . "$,4)((B") ; li~
("$,4*U)f(B" . "$,4))(B") ; vi~
("$,4*V)f(B" . "$,4)*(B") ; l_i~
("$,4*W)f(B" . "$,4)+(B") ; l.i~
("$,4*X)f(B" . "$,4),(B") ; r_i~
("$,4*Y)f(B" . "$,4)-(B") ; n_i~
("$,4*Z)f(B" . "$,4).(B") ; si~
("$,4*[)f(B" . "$,4)/(B") ; s'i~
("$,4*\)f(B" . "$,4)0(B") ; ji~
("$,4*])f(B" . "$,4)1(B") ; hi~
("$,4*H)g(B" . "$,4)p(B") ; ku
("$,4*I)g(B" . "$,4)q(B") ; n^u
("$,4*J)g(B" . "$,4)r(B") ; cu
("$,4*K)g(B" . "$,4)s(B") ; n~u
("$,4*L)g(B" . "$,4)t(B") ; t.u
("$,4*M)g(B" . "$,4)u(B") ; n.u
("$,4*N)g(B" . "$,4)v(B") ; tu
("$,4*O)g(B" . "$,4)x(B") ; nu
("$,4*P)g(B" . "$,4)y(B") ; pu
("$,4*Q)g(B" . "$,4)z(B") ; mu
("$,4*R)g(B" . "$,4){(B") ; yu
("$,4*S)g(B" . "$,4)|(B") ; ru
("$,4*T)g(B" . "$,4)}(B") ; lu
("$,4*U)g(B" . "$,4)~(B") ; vu
("$,4*V)g(B" . "$,4)(B") ; l_u
("$,4*W)g(B" . "$,4* (B") ; l.u
("$,4*X)g(B" . "$,4*!(B") ; r_u
("$,4*Y)g(B" . "$,4*"(B") ; n_u
("$,4*H)h(B" . "$,4*#(B") ; ku~
("$,4*I)h(B" . "$,4*$(B") ; n^u~
("$,4*J)h(B" . "$,4*%(B") ; cu~
("$,4*K)h(B" . "$,4*&(B") ; n~u~
("$,4*L)h(B" . "$,4*'(B") ; t.u~
("$,4*M)h(B" . "$,4*((B") ; n.u~
("$,4*N)h(B" . "$,4*)(B") ; tu~
("$,4*O)h(B" . "$,4*+(B") ; nu~
("$,4*P)h(B" . "$,4*,(B") ; pu~
("$,4*Q)h(B" . "$,4*-(B") ; mu~
("$,4*R)h(B" . "$,4*.(B") ; yu~
("$,4*S)h(B" . "$,4*/(B") ; ru~
("$,4*T)h(B" . "$,4*6(B") ; lu~
("$,4*U)h(B" . "$,4*7(B") ; vu~
("$,4*V)h(B" . "$,4*8(B") ; l_u~
("$,4*W)h(B" . "$,4*9(B") ; l.u~
("$,4*X)h(B" . "$,4*:(B") ; r_u~
("$,4*Y)h(B" . "$,4*;(B") ; n_u~
))
(defvar tml-glyph-glyph-hash
(let* ((hash (make-hash-table :test 'equal)))
(mapc (function (lambda (x) (puthash (car x) (cdr x) hash)))
tml-glyph-glyph)
hash))
(defvar tml-glyph-glyph-regexp
(tamil-regexp-of-hashtbl-keys tml-glyph-glyph-hash))
(defun tamil-compose-syllable-string (string)
(with-temp-buffer
(insert (decompose-string string))
(tamil-compose-syllable-region (point-min) (point-max))
(buffer-string)))
(defun tamil-compose-syllable-region (from to)
"Compose tamil syllable in region FROM to TO."
(let (glyph-str match-str glyph-reorder-regexps)
(save-excursion
(save-restriction
(narrow-to-region from to)
(goto-char (point-min))
;; char-glyph-conversion
(while (re-search-forward tml-char-glyph-regexp nil t)
(setq match-str (match-string 0))
(setq glyph-str
(concat glyph-str (gethash match-str tml-char-glyph-hash))))
;; glyph reordering
(when (string-match tml-glyph-reorder-key-glyphs glyph-str)
(if (string-match (car tml-glyph-reordering-regexp-list)
glyph-str)
(setq glyph-str
(replace-match (cdr tml-glyph-reordering-regexp-list)
nil nil glyph-str))))
;; glyph-glyph-conversion
(when (string-match tml-glyph-glyph-regexp glyph-str)
(setq match-str (match-string 0 glyph-str))
(setq glyph-str
(replace-match (gethash match-str tml-glyph-glyph-hash)
nil nil glyph-str)))
;; concatenate and attach reference-points.
(setq glyph-str
(cdr
(apply
'nconc
(mapcar
(function
(lambda (x) (list '(5 . 3) x))) ;; default ref. point.
glyph-str))))
(compose-region from to glyph-str)))))
(provide 'tml-util)
;;; arch-tag: 4d1c9737-e7b1-44cf-a040-4f64c50e773e
;;; tml-util.el ends here