Commit c595d888 authored by Kenichi Handa's avatar Kenichi Handa

(thai-category-table): Use

make-category-table, not copy-category-table, to initialize it.
(thai-composition-pattern): New variable.
(thai-with-thai-category-table): New macro.
(thai-compose-region, thai-compose-string): Rewritten.
(thai-post-read-conversion): Rewritten.
(thai-pre-write-conversion): Deleted.
(thai-composition-function): New function.
parent 817e162f
...@@ -32,11 +32,22 @@ ...@@ -32,11 +32,22 @@
;; Setting information of Thai characters. ;; Setting information of Thai characters.
(defvar thai-category-table (copy-category-table)) (defconst thai-category-table (make-category-table))
(or (category-docstring ?+ thai-category-table) (define-category ?c "Thai consonant" thai-category-table)
(define-category ?+ "Thai consonant" thai-category-table)) (define-category ?v "Thai upper/lower vowel" thai-category-table)
(or (category-docstring ?- thai-category-table) (define-category ?t "Thai tone" thai-category-table)
(define-category ?- "Thai diacritical mark" 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 (let ((l '((?,T!(B consonant "LETTER KO KAI") ; 0xA1
(?,T"(B consonant "LETTER KHO KHAI") ; 0xA2 (?,T"(B consonant "LETTER KHO KHAI") ; 0xA2
...@@ -135,16 +146,17 @@ ...@@ -135,16 +146,17 @@
)) ))
elm) elm)
(while l (while l
(setq elm (car l)) (setq elm (car l) l (cdr l))
(let ((ptype (nth 1 elm))) (let ((char (car elm))
(put-char-code-property (car elm) 'phonetic-type ptype) (ptype (nth 1 elm)))
(if (eq ptype 'consonant) (put-char-code-property char 'phonetic-type ptype)
(modify-category-entry (car elm) ?+ thai-category-table) (cond ((eq ptype 'consonant)
(if (memq ptype '(vowel-upper vowel-lower tone)) (modify-category-entry char ?c thai-category-table))
(modify-category-entry (car elm) ?- thai-category-table)))) ((memq ptype '(vowel-upper vowel-lower))
(put-char-code-property (car elm) 'name (nth 2 elm)) (modify-category-entry char ?v thai-category-table))
(setq l (cdr l)))) ((eq ptype 'tone)
(modify-category-entry char ?t thai-category-table)))
(put-char-code-property char 'name (nth 2 elm)))))
;;;###autoload ;;;###autoload
(defun thai-compose-region (beg end) (defun thai-compose-region (beg end)
...@@ -154,33 +166,20 @@ positions (integers or markers) specifying the region." ...@@ -154,33 +166,20 @@ positions (integers or markers) specifying the region."
(interactive "r") (interactive "r")
(save-restriction (save-restriction
(narrow-to-region beg end) (narrow-to-region beg end)
(decompose-region (point-min) (point-max))
(goto-char (point-min)) (goto-char (point-min))
(let ((current-ctbl (category-table))) (with-category-table thai-category-table
(set-category-table thai-category-table) (while (re-search-forward thai-composition-pattern nil t)
(unwind-protect (compose-region (match-beginning 0) (match-end 0))))))
(while (re-search-forward "\\c+\\c-+" nil t)
(compose-region (match-beginning 0) (match-end 0)))
(set-category-table current-ctbl)))))
;;;###autoload ;;;###autoload
(defun thai-compose-string (string) (defun thai-compose-string (string)
"Compose Thai characters in STRING and return the resulting string." "Compose Thai characters in STRING and return the resulting string."
(let ((current-ctbl (category-table))) (with-category-table thai-category-table
(set-category-table thai-category-table) (let ((idx 0))
(unwind-protect (while (setq idx (string-match thai-composition-pattern string idx))
(let ((idx 0) (compose-string string idx (match-end 0))
(new "")) (setq idx (match-end 0)))))
(while (string-match "\\c+\\c-+" string idx) string)
(if (< idx (match-beginning 0))
(setq new
(concat new (substring string idx (match-beginning 0)))))
(setq new (concat new (compose-string (match-string 0 string))))
(setq idx (match-end 0)))
(if (< idx (length string))
(setq new (concat new (substring string idx))))
(set-category-table current-ctbl))))
;;;###autoload ;;;###autoload
(defun thai-compose-buffer () (defun thai-compose-buffer ()
...@@ -190,48 +189,23 @@ positions (integers or markers) specifying the region." ...@@ -190,48 +189,23 @@ positions (integers or markers) specifying the region."
;;;###autoload ;;;###autoload
(defun thai-post-read-conversion (len) (defun thai-post-read-conversion (len)
(save-excursion (thai-compose-region (point) (+ (point) len))
(save-restriction len)
(let ((buffer-modified-p (buffer-modified-p))
(category-table (category-table))
(buf (current-buffer))
(workbuf (generate-new-buffer "*thai-work*"))
(pos (point))
start end str)
(set-buffer workbuf)
(setq buffer-undo-list t))
(narrow-to-region pos (+ pos len))
(set-category-table thai-category-table)
(while (re-search-forward "\\c+\\c-+" nil t)
(setq start (match-beginning 0)
end (point)
str (compose-string (buffer-substring start end)))
(set-buffer workbuf)
(if (< pos start)
(insert-buffer-substring buf pos start))
(insert str)
(set-buffer buf)
(setq pos end))
(delete-region (point-min) (point))
(insert-buffer-substring workbuf))
(set-category-table category-table)
(kill-buffer workbuf))
(set-buffer-modified-p buffer-modified-p)
(- (point-max) (point-min))))))
;;;###autoload ;;;###autoload
(defun thai-pre-write-conversion (from to) (defun thai-composition-function (from to pattern &optional string)
(let ((old-buf (current-buffer))) "Compose Thai text in the region FROM and TO.
(set-buffer (generate-new-buffer " *temp*")) The text matches the regular expression PATTERN.
(if (stringp from) Optional 4th argument STRING, if non-nil, is a string containing text
(insert from) to compose.
(insert-buffer-substring old-buf from to))
(decompose-region (point-min) (point-max)) The return value is number of composed characters."a
;; Should return nil as annotations. (if (< (1+ from) to)
nil)) (prog1 (- to from)
(if string
(compose-string from to)
(compose-region from to))
(- to from))))
;; ;;
(provide 'thai-util) (provide 'thai-util)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment