Mercurial > emacs

comparison lisp/language/thai-util.el @ 88155:d7ddb3e565de

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
sync with trunk
author Henrik Enberg <henrik.enberg@telia.com>
date Mon, 16 Jan 2006 00:03:54 +0000
parents 0d8b17d428b5
children
comparison
equal deleted inserted replaced
88154:8ce476d3ba36 88155:d7ddb3e565de
1 ;;; thai-util.el --- utilities for Thai -*- coding: iso-2022-7bit; -*- 1 ;;; thai-util.el --- utilities for Thai -*- coding: iso-2022-7bit; -*-
2 2
3 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. 3 ;; Copyright (C) 1995, 1997, 1998, 1999, 2000, 2001, 2005
4 ;; Licensed to the Free Software Foundation. 4 ;; National Institute of Advanced Industrial Science and Technology (AIST)
5 ;; Registration Number H14PRO021
6 ;; Copyright (C) 2000, 2001 Free Software Foundation, Inc.
5 7
6 ;; Keywords: mule, multilingual, thai 8 ;; Keywords: mule, multilingual, thai
7 9
8 ;; This file is part of GNU Emacs. 10 ;; This file is part of GNU Emacs.
9 11
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details. 20 ;; GNU General Public License for more details.
19 21
20 ;; You should have received a copy of the GNU General Public License 22 ;; 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 23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23 ;; Boston, MA 02111-1307, USA. 25 ;; Boston, MA 02110-1301, USA.
24 26
25 ;;; Commentary: 27 ;;; Commentary:
26 28
27 ;;; Code: 29 ;;; Code:
30
31 (defvar thai-auto-composition-mode)
28 32
29 ;; Setting information of Thai characters. 33 ;; Setting information of Thai characters.
30 34
31 (defconst thai-category-table (make-category-table)) 35 (defconst thai-category-table (make-category-table))
32 (define-category ?c "Thai consonant" thai-category-table) 36 (define-category ?c "Thai consonant" thai-category-table)
33 (define-category ?v "Thai upper/lower vowel" thai-category-table) 37 (define-category ?v "Thai upper/lower vowel" thai-category-table)
34 (define-category ?t "Thai tone" thai-category-table) 38 (define-category ?t "Thai tone mark" thai-category-table)
39 (define-category ?u "Thai tone mark and upper sign" thai-category-table)
40 (define-category ?I "THAI CHARACTER SARA I" thai-category-table)
41 (define-category ?U "THAI CHARACTER THANTHAKHAT" thai-category-table)
35 42
36 ;; The general composing rules are as follows: 43 ;; The general composing rules are as follows:
37 ;; 44 ;;
38 ;; T 45 ;; T
39 ;; V T V T 46 ;; V U V U
40 ;; CV -> C, CT -> C, CVT -> C, Cv -> C, CvT -> C 47 ;; CV -> C, CU -> C, CVT -> C, Cv -> C, CvU -> C
41 ;; v v 48 ;; v v
42 ;; 49 ;;
43 ;; where C: consonant, V: vowel upper, v: vowel lower, T: tone mark. 50 ;; where C: consonant, V: vowel upper, v: vowel lower,
44 51 ;; T: tone mark, U: tone mark and upper sign.
45 (defvar thai-composition-pattern "\\cc\\(\\ct\\|\\cv\\ct?\\)" 52 ;; Special rule: The sign `,Tl(B' can be put on the vowel `,TT(B'.
53
54
55 (defvar thai-composition-pattern
56 "\\cc\\(\\cu\\|\\cI\\cU\\|\\cv\\ct?\\)\\|\\cv\\ct\\|\\cI\\cU"
46 "Regular expression matching a Thai composite sequence.") 57 "Regular expression matching a Thai composite sequence.")
58
59 (defun thai-self-insert-command (&optional n)
60 "Insert the Thai character you type.
61 The character will be composed with the surrounding Thai character
62 if necessary."
63 (interactive "*p")
64 (let ((pos (point))
65 category-set ch)
66 (self-insert-command n)
67 (or thai-auto-composition-mode
68 (thai-auto-composition (1- (point)) (point) 0))))
47 69
48 (let ((l '((?,T!(B consonant "LETTER KO KAI") ; 0xA1 70 (let ((l '((?,T!(B consonant "LETTER KO KAI") ; 0xA1
49 (?,T"(B consonant "LETTER KHO KHAI") ; 0xA2 71 (?,T"(B consonant "LETTER KHO KHAI") ; 0xA2
50 (?,T#(B consonant "LETTER KHO KHUAT") ; 0xA3 72 (?,T#(B consonant "LETTER KHO KHUAT") ; 0xA3
51 (?,T$(B consonant "LETTER KHO KHWAI") ; 0xA4 73 (?,T$(B consonant "LETTER KHO KHWAI") ; 0xA4
113 (?,Tb(B vowel-base "VOWEL SIGN SARA O") ; 0xE2 135 (?,Tb(B vowel-base "VOWEL SIGN SARA O") ; 0xE2
114 (?,Tc(B vowel-base "VOWEL SIGN SARA MAI MUAN") ; 0xE3 136 (?,Tc(B vowel-base "VOWEL SIGN SARA MAI MUAN") ; 0xE3
115 (?,Td(B vowel-base "VOWEL SIGN SARA MAI MALAI") ; 0xE4 137 (?,Td(B vowel-base "VOWEL SIGN SARA MAI MALAI") ; 0xE4
116 (?,Te(B vowel-base "LAK KHANG YAO") ; 0xE5 138 (?,Te(B vowel-base "LAK KHANG YAO") ; 0xE5
117 (?,Tf(B special "MAI YAMOK (repetion)") ; 0xE6 139 (?,Tf(B special "MAI YAMOK (repetion)") ; 0xE6
118 (?,Tg(B vowel-upper "VOWEL SIGN MAI TAI KHU N/S-T") ; 0xE7 140 (?,Tg(B sign-upper "VOWEL SIGN MAI TAI KHU N/S-T") ; 0xE7
119 (?,Th(B tone "TONE MAI EK N/S-T") ; 0xE8 141 (?,Th(B tone "TONE MAI EK N/S-T") ; 0xE8
120 (?,Ti(B tone "TONE MAI THO N/S-T") ; 0xE9 142 (?,Ti(B tone "TONE MAI THO N/S-T") ; 0xE9
121 (?,Tj(B tone "TONE MAI TRI N/S-T") ; 0xEA 143 (?,Tj(B tone "TONE MAI TRI N/S-T") ; 0xEA
122 (?,Tk(B tone "TONE MAI CHATTAWA N/S-T") ; 0xEB 144 (?,Tk(B tone "TONE MAI CHATTAWA N/S-T") ; 0xEB
123 (?,Tl(B tone "THANTHAKHAT N/S-T (cancellation mark)") ; 0xEC 145 (?,Tl(B sign-upper "THANTHAKHAT N/S-T (cancellation mark)") ; 0xEC
124 (?,Tm(B tone "NIKKHAHIT N/S-T (final nasal)") ; 0xED 146 (?,Tm(B sign-upper "NIKKHAHIT N/S-T (final nasal)") ; 0xED
125 (?,Tn(B vowel-upper "YAMAKKAN N/S-T") ; 0xEE 147 (?,Tn(B sign-upper "YAMAKKAN N/S-T") ; 0xEE
126 (?,To(B special "FONRMAN") ; 0xEF 148 (?,To(B special "FONRMAN") ; 0xEF
127 (?,Tp(B special "DIGIT ZERO") ; 0xF0 149 (?,Tp(B special "DIGIT ZERO") ; 0xF0
128 (?,Tq(B special "DIGIT ONE") ; 0xF1 150 (?,Tq(B special "DIGIT ONE") ; 0xF1
129 (?,Tr(B special "DIGIT TWO") ; 0xF2 151 (?,Tr(B special "DIGIT TWO") ; 0xF2
130 (?,Ts(B special "DIGIT THREE") ; 0xF3 152 (?,Ts(B special "DIGIT THREE") ; 0xF3
205 (?$,1CB(B vowel-base "VOWEL SIGN SARA O") 227 (?$,1CB(B vowel-base "VOWEL SIGN SARA O")
206 (?$,1CC(B vowel-base "VOWEL SIGN SARA MAI MUAN") 228 (?$,1CC(B vowel-base "VOWEL SIGN SARA MAI MUAN")
207 (?$,1CD(B vowel-base "VOWEL SIGN SARA MAI MALAI") 229 (?$,1CD(B vowel-base "VOWEL SIGN SARA MAI MALAI")
208 (?$,1CE(B vowel-base "LAK KHANG YAO") 230 (?$,1CE(B vowel-base "LAK KHANG YAO")
209 (?$,1CF(B special "MAI YAMOK (repetion)") 231 (?$,1CF(B special "MAI YAMOK (repetion)")
210 (?$,1CG(B vowel-upper "VOWEL SIGN MAI TAI KHU N/S-T") 232 (?$,1CG(B sign-upper "VOWEL SIGN MAI TAI KHU N/S-T")
211 (?$,1CH(B tone "TONE MAI EK N/S-T") 233 (?$,1CH(B tone "TONE MAI EK N/S-T")
212 (?$,1CI(B tone "TONE MAI THO N/S-T") 234 (?$,1CI(B tone "TONE MAI THO N/S-T")
213 (?$,1CJ(B tone "TONE MAI TRI N/S-T") 235 (?$,1CJ(B tone "TONE MAI TRI N/S-T")
214 (?$,1CK(B tone "TONE MAI CHATTAWA N/S-T") 236 (?$,1CK(B tone "TONE MAI CHATTAWA N/S-T")
215 (?$,1CL(B tone "THANTHAKHAT N/S-T (cancellation mark)") 237 (?$,1CL(B sign-upper "THANTHAKHAT N/S-T (cancellation mark)")
216 (?$,1CM(B tone "NIKKHAHIT N/S-T (final nasal)") 238 (?$,1CM(B sign-upper "NIKKHAHIT N/S-T (final nasal)")
217 (?$,1CN(B vowel-upper "YAMAKKAN N/S-T") 239 (?$,1CN(B sign-upper "YAMAKKAN N/S-T")
218 (?$,1CO(B special "FONRMAN") 240 (?$,1CO(B special "FONRMAN")
219 (?$,1CP(B special "DIGIT ZERO") 241 (?$,1CP(B special "DIGIT ZERO")
220 (?$,1CQ(B special "DIGIT ONE") 242 (?$,1CQ(B special "DIGIT ONE")
221 (?$,1CR(B special "DIGIT TWO") 243 (?$,1CR(B special "DIGIT TWO")
222 (?$,1CS(B special "DIGIT THREE") 244 (?$,1CS(B special "DIGIT THREE")
234 (setq elm (car l) l (cdr l)) 256 (setq elm (car l) l (cdr l))
235 (let ((char (car elm)) 257 (let ((char (car elm))
236 (ptype (nth 1 elm))) 258 (ptype (nth 1 elm)))
237 (put-char-code-property char 'phonetic-type ptype) 259 (put-char-code-property char 'phonetic-type ptype)
238 (cond ((eq ptype 'consonant) 260 (cond ((eq ptype 'consonant)
239 (modify-category-entry char ?c thai-category-table)) 261 (modify-category-entry char ?c thai-category-table)
262 (global-set-key (vector char) 'thai-self-insert-command))
240 ((memq ptype '(vowel-upper vowel-lower)) 263 ((memq ptype '(vowel-upper vowel-lower))
241 (modify-category-entry char ?v thai-category-table)) 264 (modify-category-entry char ?v thai-category-table)
265 (if (or (= char ?,TT(B) (= char ?$,1C4(B))
266 ;; Give category `I' to "SARA I".
267 (modify-category-entry char ?I thai-category-table))
268 (global-set-key (vector char) 'thai-self-insert-command))
242 ((eq ptype 'tone) 269 ((eq ptype 'tone)
243 (modify-category-entry char ?t thai-category-table))) 270 (modify-category-entry char ?t thai-category-table)
271 (modify-category-entry char ?u thai-category-table)
272 (global-set-key (vector char) 'thai-self-insert-command))
273 ((eq ptype 'sign-upper)
274 (modify-category-entry char ?u thai-category-table)
275 (if (or (= char ?,Tl(B) (= char ?$,1CL(B))
276 ;; Give category `U' to "THANTHAKHAT".
277 (modify-category-entry char ?U thai-category-table))
278 (global-set-key (vector char) 'thai-self-insert-command)))
244 (put-char-code-property char 'name (nth 2 elm))))) 279 (put-char-code-property char 'name (nth 2 elm)))))
280
281 (defun thai-compose-syllable (beg end &optional category-set string)
282 (or category-set
283 (setq category-set
284 (char-category-set (if string (aref string beg) (char-after beg)))))
285 (if (aref category-set ?c)
286 ;; Starting with a consonant. We do relative composition.
287 (if string
288 (compose-string string beg end)
289 (compose-region beg end))
290 ;; Vowel tone sequence.
291 (if string
292 (compose-string string beg end (list (aref string beg) '(Bc . Bc)
293 (aref string (1+ beg))))
294 (compose-region beg end (list (char-after beg) '(Bc . Bc)
295 (char-after (1+ beg))))))
296 (- end beg))
245 297
246 ;;;###autoload 298 ;;;###autoload
247 (defun thai-compose-region (beg end) 299 (defun thai-compose-region (beg end)
248 "Compose Thai characters in the region. 300 "Compose Thai characters in the region.
249 When called from a program, expects two arguments, 301 When called from a program, expects two arguments,
250 positions (integers or markers) specifying the region." 302 positions (integers or markers) specifying the region."
251 (interactive "r") 303 (interactive "r")
252 (save-restriction 304 (let ((pos (point)))
253 (narrow-to-region beg end) 305 (save-restriction
254 (goto-char (point-min)) 306 (narrow-to-region beg end)
255 (with-category-table thai-category-table 307 (goto-char (point-min))
256 (while (re-search-forward thai-composition-pattern nil t) 308 (with-category-table thai-category-table
257 (compose-region (match-beginning 0) (match-end 0)))))) 309 (while (re-search-forward thai-composition-pattern nil t)
310 (setq beg (match-beginning 0) end (match-end 0))
311 (if (and (> pos beg) (< pos end))
312 (setq pos end))
313 (thai-compose-syllable beg end
314 (char-category-set (char-after beg))))))
315 (goto-char pos)))
258 316
259 ;;;###autoload 317 ;;;###autoload
260 (defun thai-compose-string (string) 318 (defun thai-compose-string (string)
261 "Compose Thai characters in STRING and return the resulting string." 319 "Compose Thai characters in STRING and return the resulting string."
262 (with-category-table thai-category-table 320 (with-category-table thai-category-table
263 (let ((idx 0)) 321 (let ((idx 0))
264 (while (setq idx (string-match thai-composition-pattern string idx)) 322 (while (setq idx (string-match thai-composition-pattern string idx))
265 (compose-string string idx (match-end 0)) 323 (thai-compose-syllable idx (match-end 0) nil string)
266 (setq idx (match-end 0))))) 324 (setq idx (match-end 0)))))
267 string) 325 string)
268 326
269 ;;;###autoload 327 ;;;###autoload
270 (defun thai-compose-buffer () 328 (defun thai-compose-buffer ()
283 The text matches the regular expression PATTERN. 341 The text matches the regular expression PATTERN.
284 Optional 4th argument STRING, if non-nil, is a string containing text 342 Optional 4th argument STRING, if non-nil, is a string containing text
285 to compose. 343 to compose.
286 344
287 The return value is number of composed characters." 345 The return value is number of composed characters."
288 (if (< (1+ from) to) 346 (when (and (not thai-auto-composition-mode)
289 (progn 347 (< (1+ from) to))
290 (if string 348 (with-category-table thai-category-table
291 (compose-string string from to) 349 (if string
292 (compose-region from to)) 350 (if (eq (string-match thai-composition-pattern string from) from)
293 (- to from)))) 351 (thai-compose-syllable from (match-end 0) nil string))
352 (if (save-excursion
353 (goto-char from)
354 (and (looking-at thai-composition-pattern)
355 (setq to (match-end 0))))
356 (thai-compose-syllable from to))))))
357
358 (defun thai-auto-composition (beg end len)
359 (with-category-table thai-category-table
360 (let (category-set)
361 (while (and (> beg (point-min))
362 (setq category-set (char-category-set (char-after (1- beg))))
363 (or (aref category-set ?v) (aref category-set ?u)))
364 (setq beg (1- beg)))
365 (if (and (> beg (point-min))
366 (aref (char-category-set (char-after (1- beg))) ?c))
367 (setq beg (1- beg)))
368 (while (and (< end (point-max))
369 (setq category-set (char-category-set (char-after end)))
370 (or (aref category-set ?v) (aref category-set ?u)))
371 (setq end (1+ end)))
372 (if (< beg end)
373 (thai-compose-region beg end)))))
374
375 (put 'thai-auto-composition-mode 'permanent-local t)
376
377 ;;;###autoload
378 (define-minor-mode thai-auto-composition-mode
379 "Minor mode for automatically correct Thai character composition."
380 :group 'mule
381 (cond ((null thai-auto-composition-mode)
382 (remove-hook 'after-change-functions 'thai-auto-composition))
383 (t
384 (add-hook 'after-change-functions 'thai-auto-composition))))
385
386 ;; Thai-word-mode requires functions in the feature `thai-word'.
387 (require 'thai-word)
388
389 (defvar thai-word-mode-map
390 (let ((map (make-sparse-keymap)))
391 (define-key map [remap forward-word] 'thai-forward-word)
392 (define-key map [remap backward-word] 'thai-backward-word)
393 (define-key map [remap kill-word] 'thai-kill-word)
394 (define-key map [remap backward-kill-word] 'thai-backward-kill-word)
395 (define-key map [remap transpose-words] 'thai-transpose-words)
396 map)
397 "Keymap for `thai-word-mode'.")
398
399 (define-minor-mode thai-word-mode
400 "Minor mode to make word-oriented commands aware of Thai words.
401 The commands affected are \\[forward-word], \\[backward-word], \\[kill-word], \\[backward-kill-word], \\[transpose-words], and \\[fill-paragraph]."
402 :global t :group 'mule
403 (cond (thai-word-mode
404 ;; This enables linebreak between Thai characters.
405 (modify-category-entry (make-char 'thai-tis620) ?|)
406 ;; This enables linebreak at a Thai word boundary.
407 (put-charset-property 'thai-tis620 'fill-find-break-point-function
408 'thai-fill-find-break-point))
409 (t
410 (modify-category-entry (make-char 'thai-tis620) ?| nil t)
411 (put-charset-property 'thai-tis620 'fill-find-break-point-function
412 nil))))
413
414 ;; Function to call on entering the Thai language environment.
415 (defun setup-thai-language-environment-internal ()
416 (thai-word-mode 1))
417
418 ;; Function to call on exiting the Thai language environment.
419 (defun exit-thai-language-environment-internal ()
420 (thai-word-mode -1))
294 421
295 ;; 422 ;;
296 (provide 'thai-util) 423 (provide 'thai-util)
297 424
425 ;;; arch-tag: 59425d6a-8cf9-4e06-a6ab-8ab7dc7a7a97
298 ;;; thai-util.el ends here 426 ;;; thai-util.el ends here