X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/b34fe182272b235962435d71cfb37f4bc5cfff5d..40fb2103c2986cbb91add4afed635886c4f87ae5:/lisp/language/thai-util.el

diff --git a/lisp/language/thai-util.el b/lisp/language/thai-util.el
index d7e7eb01cd..259a102c61 100644
--- a/lisp/language/thai-util.el
+++ b/lisp/language/thai-util.el
@@ -1,9 +1,12 @@
-;;; thai-util.el --- utilities for Thai
+;;; thai-util.el --- utilities for Thai -*- coding: iso-2022-7bit; -*-
 
 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
-;; Licensed to the Free Software Foundation.
+;;   Licensed to the Free Software Foundation.
+;; Copyright (C) 2003
+;;   National Institute of Advanced Industrial Science and Technology (AIST)
+;;   Registration Number H13PRO009
 
-;; Keywords: mule, multilingual, thai
+;; Keywords: mule, multilingual, Thai, i18n
 
 ;; This file is part of GNU Emacs.
 
@@ -22,17 +25,29 @@
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
-;;; Code:
+;;; Commentary:
 
-;;;###autoload
-(defun setup-thai-environment ()
-  "Setup multilingual environment (MULE) for Thai."
-  (interactive)
-  (setup-8-bit-environment "Thai" 'thai-tis620 'thai-tis620
-			   "thai-kesmanee"))
+;;; Code:
 
 ;; Setting information of Thai characters.
 
+(defconst thai-category-table (make-category-table))
+(define-category ?c "Thai consonant" thai-category-table)
+(define-category ?v "Thai upper/lower vowel" thai-category-table)
+(define-category ?t "Thai tone" thai-category-table)
+
+;; The general composing rules are as follows:
+;;
+;;                          T
+;;       V        T         V                  T
+;; CV -> C, CT -> C, CVT -> C, Cv -> C, CvT -> C
+;;                                   v         v
+;;
+;; where C: consonant, V: vowel upper, v: vowel lower, T: tone mark.
+
+(defvar thai-composition-pattern "\\cc\\(\\ct\\|\\cv\\ct?\\)"
+  "Regular expression matching a Thai composite sequence.")
+
 (let ((l '((?,T!(B consonant "LETTER KO KAI")				; 0xA1
 	   (?,T"(B consonant "LETTER KHO KHAI")				; 0xA2
 	   (?,T#(B consonant "LETTER KHO KHUAT")				; 0xA3
@@ -130,10 +145,17 @@
 	   ))
       elm)
   (while l
-    (setq elm (car l))
-    (put-char-code-property (car elm) 'phonetic-type (car (cdr elm)))
-    (put-char-code-property (car elm) 'name (nth 2 elm))
-    (setq l (cdr l))))
+    (setq elm (car l) l (cdr l))
+    (let ((char (car elm))
+	  (ptype (nth 1 elm)))
+      (put-char-code-property char 'phonetic-type ptype)
+      (cond ((eq ptype 'consonant)
+	     (modify-category-entry char ?c thai-category-table))
+	    ((memq ptype '(vowel-upper vowel-lower))
+	     (modify-category-entry char ?v thai-category-table))
+	    ((eq ptype 'tone)
+	     (modify-category-entry char ?t thai-category-table)))
+      (put-char-code-property char 'name (nth 2 elm)))))
 
 ;;;###autoload
 (defun thai-compose-region (beg end)
@@ -143,11 +165,20 @@ positions (integers or markers) specifying the region."
   (interactive "r")
   (save-restriction
     (narrow-to-region beg end)
-    (decompose-region (point-min) (point-max))
     (goto-char (point-min))
-    (while (re-search-forward "\\c0\\(\\c2\\|\\c3\\|\\c4\\)+" nil t)
-      (if (aref (char-category-set (char-after (match-beginning 0))) ?t)
-	  (compose-region (match-beginning 0) (match-end 0))))))
+    (with-category-table thai-category-table
+      (while (re-search-forward thai-composition-pattern nil t)
+	(compose-region (match-beginning 0) (match-end 0))))))
+
+;;;###autoload
+(defun thai-compose-string (string)
+  "Compose Thai characters in STRING and return the resulting string."
+  (with-category-table thai-category-table
+    (let ((idx 0))
+      (while (setq idx (string-match thai-composition-pattern string idx))
+	(compose-string string idx (match-end 0))
+	(setq idx (match-end 0)))))
+  string)
 
 ;;;###autoload
 (defun thai-compose-buffer ()
@@ -156,29 +187,23 @@ positions (integers or markers) specifying the region."
   (thai-compose-region (point-min) (point-max)))
 
 ;;;###autoload
-(defun thai-post-read-conversion (len)
-  (save-excursion
-    (save-restriction
-      (let ((buffer-modified-p (buffer-modified-p)))
-	(narrow-to-region (point) (+ (point) len))
-	(thai-compose-region (point-min) (point-max))
-	(set-buffer-modified-p buffer-modified-p)
-	(- (point-max) (point-min))))))
-
-;;;###autoload
-(defun thai-pre-write-conversion (from to)
-  (let ((old-buf (current-buffer))
-	(work-buf (get-buffer-create " *thai-work*")))
-    (set-buffer work-buf)
-    (erase-buffer)
-    (if (stringp from)
-	(insert from)
-      (insert-buffer-substring old-buf from to))
-    (decompose-region (point-min) (point-max))
-    ;; Should return nil as annotations.
-    nil))
+(defun thai-composition-function (pos &optional string)
+  (setq pos (1- pos))
+  (let ((pattern "[,T!(B-,TCEG(B-,TN!(B-,TCEG(B-,TN(B][,TQT(B-,TWgnX(B-,TZQT(B-,TWgnX(B-,TZ(B]?[,Th(B-,Tmh(B-,Tm(B]?"))
+    (if string
+	(if (and (>= pos 0)
+		 (eq (string-match pattern string pos) pos))
+	    (prog1 (match-end 0)
+	      (compose-string string pos (match-end 0))))
+      (if (>= pos (point-min))
+	  (progn
+	    (goto-char pos)
+	    (if (looking-at pattern)
+		(prog1 (match-end 0)
+		  (compose-region pos (match-end 0)))))))))
 
 ;;
 (provide 'thai-util)
 
+;;; arch-tag: 59425d6a-8cf9-4e06-a6ab-8ab7dc7a7a97
 ;;; thai-util.el ends here