code.delx.au - gnu-emacs/blob - lisp/language/thai-util.el

   1 ;;; thai-util.el --- utilities for Thai -*- coding: utf-8; -*-
   2
   3 ;; Copyright (C) 2000-2016 Free Software Foundation, Inc.
   4 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
   5 ;;   2005, 2006, 2007, 2008, 2009, 2010, 2011
   6 ;;   National Institute of Advanced Industrial Science and Technology (AIST)
   7 ;;   Registration Number H14PRO021
   8
   9 ;; Keywords: mule, multilingual, Thai, i18n
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; GNU Emacs is free software: you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation, either version 3 of the License, or
  16 ;; (at your option) any later version.
  17
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  25
  26 ;;; Commentary:
  27
  28 ;;; Code:
  29
  30 (defvar thai-auto-composition-mode)
  31
  32 ;; Setting information of Thai characters.
  33
  34 (defconst thai-category-table (make-category-table))
  35 (define-category ?c "Thai consonant" thai-category-table)
  36 (define-category ?v "Thai upper/lower vowel" thai-category-table)
  37 (define-category ?t "Thai tone mark" thai-category-table)
  38 (define-category ?u "Thai tone mark and upper sign" thai-category-table)
  39 (define-category ?I "THAI CHARACTER SARA I" thai-category-table)
  40 (define-category ?U "THAI CHARACTER THANTHAKHAT" thai-category-table)
  41
  42 ;; The general composing rules are as follows:
  43 ;;
  44 ;;                          T
  45 ;;       V        U         V                  U
  46 ;; CV -> C, CU -> C, CVT -> C, Cv -> C, CvU -> C
  47 ;;                                   v         v
  48 ;;
  49 ;; where C: consonant, V: vowel upper, v: vowel lower,
  50 ;;       T: tone mark, U: tone mark and upper sign.
  51 ;; Special rule: The sign `์' can be put on the vowel `ิ'.
  52
  53
  54 (defvar thai-composition-pattern
  55   "\\cc\\(\\cu\\|\\cI\\cU\\|\\cv\\ct?\\)\\|\\cv\\ct\\|\\cI\\cU"
  56   "Regular expression matching a Thai composite sequence.")
  57
  58 (let ((l '((?ก consonant)     ; 0xA1
  59            (?ข consonant)     ; 0xA2
  60            (?ฃ consonant)     ; 0xA3
  61            (?ค consonant)     ; 0xA4
  62            (?ฅ consonant)     ; 0xA5
  63            (?ฆ consonant)     ; 0xA6
  64            (?ง consonant)     ; 0xA7
  65            (?จ consonant)     ; 0xA8
  66            (?ฉ consonant)     ; 0xA9
  67            (?ช consonant)     ; 0xAA
  68            (?ซ consonant)     ; 0xAB
  69            (?ฌ consonant)     ; 0xAC
  70            (?ญ consonant)     ; 0xAD
  71            (?ฎ consonant)     ; 0xAE
  72            (?ฏ consonant)     ; 0xAF
  73            (?ฐ consonant)     ; 0xB0
  74            (?ฑ consonant)     ; 0xB1
  75            (?ฒ consonant)     ; 0xB2
  76            (?ณ consonant)     ; 0xB3
  77            (?ด consonant)     ; 0xB4
  78            (?ต consonant)     ; 0xB5
  79            (?ถ consonant)     ; 0xB6
  80            (?ท consonant)     ; 0xB7
  81            (?ธ consonant)     ; 0xB8
  82            (?น consonant)     ; 0xB9
  83            (?บ consonant)     ; 0xBA
  84            (?ป consonant)     ; 0xBB
  85            (?ผ consonant)     ; 0xBC
  86            (?ฝ consonant)     ; 0xBD
  87            (?พ consonant)     ; 0xBE
  88            (?ฟ consonant)     ; 0xBF
  89            (?ภ consonant)     ; 0xC0
  90            (?ม consonant)     ; 0xC1
  91            (?ย consonant)     ; 0xC2
  92            (?ร consonant)     ; 0xC3
  93            (?ฤ vowel-base)    ; 0xC4
  94            (?ล consonant)     ; 0xC5
  95            (?ฦ vowel-base)    ; 0xC6
  96            (?ว consonant)     ; 0xC7
  97            (?ศ consonant)     ; 0xC8
  98            (?ษ consonant)     ; 0xC9
  99            (?ส consonant)     ; 0xCA
 100            (?ห consonant)     ; 0xCB
 101            (?ฬ consonant)     ; 0xCC
 102            (?อ consonant)     ; 0xCD
 103            (?ฮ consonant)     ; 0xCE
 104            (?ฯ special)       ; 0xCF
 105            (?ะ vowel-base)    ; 0xD0
 106            (?ั vowel-upper)   ; 0xD1
 107            (?า vowel-base)    ; 0xD2
 108            (?ำ vowel-base)    ; 0xD3
 109            (?ิ vowel-upper)   ; 0xD4
 110            (?ี vowel-upper)   ; 0xD5
 111            (?ึ vowel-upper)   ; 0xD6
 112            (?ื vowel-upper)   ; 0xD7
 113            (?ุ vowel-lower)   ; 0xD8
 114            (?ู vowel-lower)   ; 0xD9
 115            (?ฺ vowel-lower)   ; 0xDA
 116            (?฻ invalid)       ; 0xDA
 117            (?฼ invalid)       ; 0xDC
 118            (?฽ invalid)       ; 0xDC
 119            (?฾ invalid)       ; 0xDC
 120            (?฿ special)       ; 0xDF
 121            (?เ vowel-base)    ; 0xE0
 122            (?แ vowel-base)    ; 0xE1
 123            (?โ vowel-base)    ; 0xE2
 124            (?ใ vowel-base)    ; 0xE3
 125            (?ไ vowel-base)    ; 0xE4
 126            (?ๅ vowel-base)    ; 0xE5
 127            (?ๆ special)       ; 0xE6
 128            (?็ sign-upper)    ; 0xE7
 129            (?่ tone)          ; 0xE8
 130            (?้ tone)          ; 0xE9
 131            (?๊ tone)          ; 0xEA
 132            (?๋ tone)          ; 0xEB
 133            (?์ sign-upper)    ; 0xEC
 134            (?ํ sign-upper)    ; 0xED
 135            (?๎ sign-upper)    ; 0xEE
 136            (?๏ special)       ; 0xEF
 137            (?๐ special)       ; 0xF0
 138            (?๑ special)       ; 0xF1
 139            (?๒ special)       ; 0xF2
 140            (?๓ special)       ; 0xF3
 141            (?๔ special)       ; 0xF4
 142            (?๕ special)       ; 0xF5
 143            (?๖ special)       ; 0xF6
 144            (?๗ special)       ; 0xF7
 145            (?๘ special)       ; 0xF8
 146            (?๙ special)       ; 0xF9
 147            (?๚ special)       ; 0xFA
 148            (?๛ special)       ; 0xFB
 149            (?๜ invalid)       ; 0xFC
 150            (?๝ invalid)       ; 0xFD
 151            (?๞ invalid)       ; 0xFE
 152            ))
 153       elm)
 154   (while l
 155     (setq elm (car l) l (cdr l))
 156     (let ((char (car elm))
 157           (ptype (nth 1 elm)))
 158       (put-char-code-property char 'phonetic-type ptype)
 159       (cond ((eq ptype 'consonant)
 160              (modify-category-entry char ?c thai-category-table))
 161             ((memq ptype '(vowel-upper vowel-lower))
 162              (modify-category-entry char ?v thai-category-table)
 163              (if (= char ?ิ)
 164                  ;; Give category `I' to "SARA I".
 165                  (modify-category-entry char ?I thai-category-table)))
 166             ((eq ptype 'tone)
 167              (modify-category-entry char ?t thai-category-table)
 168              (modify-category-entry char ?u thai-category-table))
 169             ((eq ptype 'sign-upper)
 170              (modify-category-entry char ?u thai-category-table)
 171              (if (= char ?์)
 172                  ;; Give category `U' to "THANTHAKHAT".
 173                  (modify-category-entry char ?U thai-category-table)))))))
 174
 175 (defun thai-compose-syllable (beg end &optional category-set string)
 176   (or category-set
 177       (setq category-set
 178             (char-category-set (if string (aref string beg) (char-after beg)))))
 179   (if (aref category-set ?c)
 180       ;; Starting with a consonant.  We do relative composition.
 181       (if string
 182           (compose-string string beg end)
 183         (compose-region beg end))
 184     ;; Vowel tone sequence.
 185     (if string
 186         (compose-string string beg end (list (aref string beg) '(Bc . Bc)
 187                                              (aref string (1+ beg))))
 188       (compose-region beg end (list (char-after beg) '(Bc . Bc)
 189                                     (char-after (1+ beg))))))
 190   (- end beg))
 191
 192 ;;;###autoload
 193 (defun thai-compose-region (beg end)
 194   "Compose Thai characters in the region.
 195 When called from a program, expects two arguments,
 196 positions (integers or markers) specifying the region."
 197   (interactive "r")
 198   (let ((pos (point)))
 199     (save-restriction
 200       (narrow-to-region beg end)
 201       (goto-char (point-min))
 202       (with-category-table thai-category-table
 203         (while (re-search-forward thai-composition-pattern nil t)
 204           (setq beg (match-beginning 0) end (match-end 0))
 205           (if (and (> pos beg) (< pos end))
 206               (setq pos end))
 207           (thai-compose-syllable beg end
 208                                  (char-category-set (char-after beg))))))
 209     (goto-char pos)))
 210
 211 ;;;###autoload
 212 (defun thai-compose-string (string)
 213   "Compose Thai characters in STRING and return the resulting string."
 214   (with-category-table thai-category-table
 215     (let ((idx 0))
 216       (while (setq idx (string-match thai-composition-pattern string idx))
 217         (thai-compose-syllable idx (match-end 0) nil string)
 218         (setq idx (match-end 0)))))
 219   string)
 220
 221 ;;;###autoload
 222 (defun thai-compose-buffer ()
 223   "Compose Thai characters in the current buffer."
 224   (interactive)
 225   (thai-compose-region (point-min) (point-max)))
 226
 227 ;;;###autoload
 228 (defun thai-composition-function (gstring)
 229   (if (= (lgstring-char-len gstring) 1)
 230       (compose-gstring-for-graphic gstring)
 231     (or (font-shape-gstring gstring)
 232         (let ((glyph-len (lgstring-glyph-len gstring))
 233               (last-char (lgstring-char gstring
 234                                         (1- (lgstring-char-len gstring))))
 235               (i 0)
 236               glyph)
 237           (while (and (< i glyph-len)
 238                       (setq glyph (lgstring-glyph gstring i)))
 239             (setq i (1+ i)))
 240           (if (= last-char ?ำ)
 241               (setq i (1- i)))
 242           (compose-glyph-string-relative gstring 0 i 0.1)))))
 243
 244 ;; Thai-word-mode requires functions in the feature `thai-word'.
 245 (require 'thai-word)
 246
 247 (defvar thai-word-mode-map
 248   (let ((map (make-sparse-keymap)))
 249     (define-key map [remap forward-word] 'thai-forward-word)
 250     (define-key map [remap backward-word] 'thai-backward-word)
 251     (define-key map [remap kill-word] 'thai-kill-word)
 252     (define-key map [remap backward-kill-word] 'thai-backward-kill-word)
 253     (define-key map [remap transpose-words] 'thai-transpose-words)
 254     map)
 255   "Keymap for `thai-word-mode'.")
 256
 257 (define-minor-mode thai-word-mode
 258   "Minor mode to make word-oriented commands aware of Thai words.
 259 With a prefix argument ARG, enable the mode if ARG is positive,
 260 and disable it otherwise.  If called from Lisp, enable the mode
 261 if ARG is omitted or nil.  The commands affected are
 262 \\[forward-word], \\[backward-word], \\[kill-word], \\[backward-kill-word],
 263 \\[transpose-words], and \\[fill-paragraph]."
 264   :global t :group 'mule
 265   (cond (thai-word-mode
 266          ;; This enables linebreak between Thai characters.
 267          (modify-category-entry (make-char 'thai-tis620) ?|)
 268          ;; This enables linebreak at a Thai word boundary.
 269          (put-charset-property 'thai-tis620 'fill-find-break-point-function
 270                                'thai-fill-find-break-point))
 271         (t
 272          (modify-category-entry (make-char 'thai-tis620) ?| nil t)
 273          (put-charset-property 'thai-tis620 'fill-find-break-point-function
 274                                nil))))
 275
 276 ;; Function to call on entering the Thai language environment.
 277 (defun setup-thai-language-environment-internal ()
 278   (thai-word-mode 1))
 279
 280 ;; Function to call on exiting the Thai language environment.
 281 (defun exit-thai-language-environment-internal ()
 282   (thai-word-mode -1))
 283
 284 ;;
 285 (provide 'thai-util)
 286
 287 ;;; thai-util.el ends here