tibet-util.el 12.2 KB
Newer Older
1
;;; tibet-util.el --- Support for inputting Tibetan characters
Kenichi Handa's avatar
Kenichi Handa committed
2 3

;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
Richard M. Stallman's avatar
Richard M. Stallman committed
4
;; Licensed to the Free Software Foundation.
Kenichi Handa's avatar
Kenichi Handa committed
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31

;; Keywords: multilingual, Tibetan

;; 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., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;; Author: Toru TOMABECHI, <Toru.Tomabechi@orient.unil.ch>

;; Created: Feb. 17. 1997

;; History:
;; 1997.03.13 Modification in treatment of text properties;
;;            Support for some special signs and punctuations.
Kenichi Handa's avatar
Kenichi Handa committed
32
;; 1999.10.25 Modification for a new composition way by K.Handa.
Kenichi Handa's avatar
Kenichi Handa committed
33 34 35 36

;;; Code:

;;;###autoload
Kenichi Handa's avatar
Kenichi Handa committed
37 38 39 40
(defun tibetan-char-p (ch)
  "Check if char CH is Tibetan character.
Returns non-nil if CH is Tibetan. Otherwise, returns nil."
  (memq (char-charset ch) '(tibetan tibetan-1-column)))
Kenichi Handa's avatar
Kenichi Handa committed
41

Kenichi Handa's avatar
Kenichi Handa committed
42
;;; Functions for Tibetan <-> Tibetan-transcription.
Kenichi Handa's avatar
Kenichi Handa committed
43 44

;;;###autoload
Kenichi Handa's avatar
Kenichi Handa committed
45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70
(defun tibetan-tibetan-to-transcription (str)
  "Transcribe Tibetan string STR and return the corresponding Roman string."
  (let (;; Accumulate transcriptions here in reverse order.
	(trans nil)
	(len (length str))
	(i 0)
	ch this-trans)
    (while (< i len)
      (let ((idx (string-match tibetan-precomposition-rule-alist str i)))
	(if (eq idx i)
	    ;; Ith character and the followings matches precomposable
	    ;; Tibetan sequence.
	    (setq i (match-end 0)
		  this-trans
		  (car (rassoc
			(cdr (assoc (match-string 0 str)
				    tibetan-precomposition-rule-alist))
			tibetan-precomposed-transcription-alist)))
	  (setq ch (substring str i (1+ i))
		i (1+ i)
		this-trans
		(car (or (rassoc ch tibetan-consonant-transcription-alist)
			 (rassoc ch tibetan-vowel-transcription-alist)
			 (rassoc ch tibetan-subjoined-transcription-alist)))))
	(setq trans (cons this-trans trans))))
    (apply 'concat (nreverse trans))))
Kenichi Handa's avatar
Kenichi Handa committed
71

Kenichi Handa's avatar
Kenichi Handa committed
72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105
;;;###autoload
(defun tibetan-transcription-to-tibetan (str)
  "Convert Tibetan Roman string STR to Tibetan character string.
The returned string has no composition information."
  (let (;; Case is significant.
	(case-fold-search nil)
	(idx 0)
	;; Accumulate Tibetan strings here in reverse order.
	(t-str-list nil)
	i subtrans)
    (while (setq i (string-match tibetan-regexp str idx))
      (if (< idx i)
	  ;; STR contains a pattern that doesn't match Tibetan
	  ;; transcription.  Include the pattern as is.
	  (setq t-str-list (cons (substring str idx i) t-str-list)))
      (setq subtrans (match-string 0 str)
	    idx (match-end 0))
      (let ((t-char (cdr (assoc subtrans
				tibetan-precomposed-transcription-alist))))
	(if t-char
	    ;; SUBTRANS corresponds to a transcription for
	    ;; precomposable Tibetan sequence.
	    (setq t-char (car (rassoc t-char
				      tibetan-precomposition-rule-alist)))
	  (setq t-char
		(cdr
		 (or (assoc subtrans tibetan-consonant-transcription-alist)
		     (assoc subtrans tibetan-vowel-transcription-alist)
		     (assoc subtrans tibetan-modifier-transcription-alist)
		     (assoc subtrans tibetan-subjoined-transcription-alist)))))
	(setq t-str-list (cons t-char t-str-list))))
    (if (< idx (length str))
	(setq t-str-list (cons (substring str idx) t-str-list)))
    (apply 'concat (nreverse t-str-list))))
Kenichi Handa's avatar
Kenichi Handa committed
106 107

;;;
Kenichi Handa's avatar
Kenichi Handa committed
108
;;; Functions for composing/decomposing Tibetan sequence.
Kenichi Handa's avatar
Kenichi Handa committed
109 110 111 112 113 114 115 116 117 118 119 120
;;;
;;; A Tibetan syllable is typically structured as follows:
;;;
;;;      [Prefix] C [C+] V [M] [Suffix [Post suffix]]
;;;
;;; where C's are all vertically stacked, V appears below or above
;;; consonant cluster and M is always put above the C[C+]V combination.
;;; (Sanskrit visarga, though it is a vowel modifier, is considered
;;;  to be a punctuation.)
;;;
;;; Here are examples of the words "bsgrubs" and "h'uM"
;;;
121
;;;            4$(7"70"714%qx!"U0"G###C"U14"70"714"G0"G1(B         4$(7"Hx!"Rx!"Ur'"_0"H"A"U"_1(B
Kenichi Handa's avatar
Kenichi Handa committed
122 123 124 125 126 127 128
;;;
;;;                             M
;;;             b s b s         h
;;;               g             '
;;;               r             u
;;;               u
;;;
Kenichi Handa's avatar
Kenichi Handa committed
129 130 131 132 133 134 135 136 137 138 139 140 141
;;; Consonants `'' ($(7"A(B), `w' ($(7">(B), `y' ($(7"B(B), `r' ($(7"C(B) take special
;;; forms when they are used as subjoined consonant.  Consonant `r'
;;; takes another special form when used as superjoined in such a case
;;; as "rka", while it does not change its form when conjoined with
;;; subjoined `'', `w' or `y' as in "rwa", "rya".

;; Append a proper composition rule and glyph to COMPONENTS to compose
;; CHAR with a composition that has COMPONENTS.

(defun tibetan-add-components (components char)
  (let ((last (last components))
	(stack-upper '(tc . bc))
	(stack-under '(bc . tc))
142
	rule comp-vowel tmp)
Kenichi Handa's avatar
Kenichi Handa committed
143 144
    ;; Special treatment for 'a chung.
    ;; If 'a follows a consonant, turn it into the subjoined form.
145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160
    ;; * Disabled by Tomabechi 2000/06/09 *
    ;; Because in Unicode, $(7"A(B may follow directly a consonant without
    ;; any intervening vowel, as in 4$(7"90"914""0"""Q14"A0"A1!;(B=4$(7"90"91(B 4$(7""0""1(B 4$(7"A0"A1(B not 4$(7"90"91(B 4$(7""0""1(B $(7"Q(B 4$(7"A0"A1(B  
    ;;(if (and (= char ?$(7"A(B)
    ;;	     (aref (char-category-set (car last)) ?0))
    ;;	(setq char ?$(7"R(B)) ;; modified for new font by Tomabechi 1999/12/10

    ;; Composite vowel signs are decomposed before being added
    ;; Added by Tomabechi 2000/06/08
    (if (memq char '(?$(7"T(B ?$(7"V(B ?$(7"W(B ?$(7"X(B ?$(7"Y(B ?$(7"Z(B ?$(7"b(B))
	(setq comp-vowel
	      (cddr (assoc (char-to-string char)
			   tibetan-composite-vowel-alist))
	      char
	      (cadr (assoc (char-to-string char)
			   tibetan-composite-vowel-alist))))
Kenichi Handa's avatar
Kenichi Handa committed
161 162 163 164 165 166 167
    (cond
     ;; Compose upper vowel sign vertically over.
     ((aref (char-category-set char) ?2)
      (setq rule stack-upper))

     ;; Compose lower vowel sign vertically under.
     ((aref (char-category-set char) ?3)
168 169 170
      (if (eq char ?$(7"Q(B)		;; `$(7"Q(B' should not visible when composed.
	  (setq rule nil)
	(setq rule stack-under)))
Kenichi Handa's avatar
Kenichi Handa committed
171 172 173
     ;; Transform ra-mgo (superscribed r) if followed by a subjoined
     ;; consonant other than w, ', y, r.
     ((and (= (car last) ?$(7"C(B)
174 175
	   (not (memq char '(?$(7#>(B ?$(7"R(B ?$(7#B(B ?$(7#C(B))))
      (setcar last ?$(7!"(B) ;; modified for newfont by Tomabechi 1999/12/10
Kenichi Handa's avatar
Kenichi Handa committed
176 177 178 179 180
      (setq rule stack-under))
     ;; Transform initial base consonant if followed by a subjoined
     ;; consonant but 'a.
     (t
      (let ((laststr (char-to-string (car last))))
181 182
	(if (and (/= char ?$(7"R(B) ;; modified for new font by Tomabechi
		 (string-match "[$(7"!(B-$(7"="?"@"D(B-$(7"J"K(B]" laststr))
Kenichi Handa's avatar
Kenichi Handa committed
183 184 185 186 187
	    (setcar last (string-to-char
			  (cdr (assoc (char-to-string (car last))
				      tibetan-base-to-subjoined-alist)))))
	(setq rule stack-under))))

188
    (if rule
189 190 191 192 193
	(setcdr last (list rule char)))
    ;; Added by Tomabechi 2000/06/08
    (if comp-vowel
	(nconc last comp-vowel))
    ))
Kenichi Handa's avatar
Kenichi Handa committed
194 195 196

;;;###autoload
(defun tibetan-compose-string (str)
Kenichi Handa's avatar
Kenichi Handa committed
197 198 199 200
  "Compose Tibetan string STR."
  (let ((idx 0))
    ;; `$(7"A(B' is included in the pattern for subjoined consonants
    ;; because we treat it specially in tibetan-add-components.
201
    ;; (This feature is removed by Tomabechi 2000/06/08)
Kenichi Handa's avatar
Kenichi Handa committed
202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219
    (while (setq idx (string-match tibetan-composable-pattern str idx))
      (let ((from idx)
	    (to (match-end 0))
	    components)
	(if (eq (string-match tibetan-precomposition-rule-regexp str idx) idx)
	    (setq idx (match-end 0)
		  components
		  (list (string-to-char
			 (cdr
			  (assoc (match-string 0 str)
				 tibetan-precomposition-rule-alist)))))
	  (setq components (list (aref str idx))
		idx (1+ idx)))
	(while (< idx to)
	  (tibetan-add-components components (aref str idx))
	  (setq idx (1+ idx)))
	(compose-string str from to components))))
  str)
Kenichi Handa's avatar
Kenichi Handa committed
220 221

;;;###autoload
Kenichi Handa's avatar
Kenichi Handa committed
222 223
(defun tibetan-compose-region (beg end)
  "Compose Tibetan text the region BEG and END."
Kenichi Handa's avatar
Kenichi Handa committed
224
  (interactive "r")
Kenichi Handa's avatar
Kenichi Handa committed
225
  (let (str result chars)
Kenichi Handa's avatar
Kenichi Handa committed
226 227 228 229
    (save-excursion
      (save-restriction
	(narrow-to-region beg end)
	(goto-char (point-min))
Kenichi Handa's avatar
Kenichi Handa committed
230 231
	;; `$(7"A(B' is included in the pattern for subjoined consonants
	;; because we treat it specially in tibetan-add-components.
232
	;; (This feature is removed by Tomabechi 2000/06/08)
Kenichi Handa's avatar
Kenichi Handa committed
233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251
	(while (re-search-forward tibetan-composable-pattern nil t)
	  (let ((from (match-beginning 0))
		(to (match-end 0))
		components)
	    (goto-char from)
	    (if (looking-at tibetan-precomposition-rule-regexp)
		(progn
		  (setq components
			(list (string-to-char
			       (cdr
				(assoc (match-string 0)
				       tibetan-precomposition-rule-alist)))))
		  (goto-char (match-end 0)))
	      (setq components (list (char-after from)))
	      (forward-char 1))
	    (while (< (point) to)
	      (tibetan-add-components components (following-char))
	      (forward-char 1))
	    (compose-region from to components)))))))
Kenichi Handa's avatar
Kenichi Handa committed
252

253 254 255 256
(defvar tibetan-decompose-precomposition-alist
  (mapcar (function (lambda (x) (cons (string-to-char (cdr x)) (car x))))
	  tibetan-precomposition-rule-alist))

Kenichi Handa's avatar
Kenichi Handa committed
257
;;;###autoload
258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276
(defun tibetan-decompose-region (from to)
  "Decompose Tibetan text in the region FROM and TO.
This is different from decompose-region because precomposed Tibetan characters
are decomposed into normal Tiebtan character sequences."
  (interactive "r")
  (save-restriction
    (narrow-to-region from to)
    (decompose-region from to)
    (goto-char from)
    (while (not (eobp))
      (let* ((char (following-char))
	     (slot (assq char tibetan-decompose-precomposition-alist)))
	(if slot
	    (progn
	      (delete-char 1)
	      (insert (cdr slot)))
	  (forward-char 1))))))


Kenichi Handa's avatar
Kenichi Handa committed
277
;;;###autoload
278 279 280 281 282 283 284 285 286 287 288 289 290 291
(defun tibetan-decompose-string (str)
  "Decompose Tibetan string STR.
This is different from decompose-string because precomposed Tibetan characters
are decomposed into normal Tiebtan character sequences."
  (let ((new "")
	(len (length str))
	(idx 0)
	char slot)
    (while (< idx len)
      (setq char (aref str idx)
	    slot (assq (aref str idx) tibetan-decompose-precomposition-alist)
	    new (concat new (if slot (cdr slot) (char-to-string char)))
	    idx (1+ idx)))
    new))
Kenichi Handa's avatar
Kenichi Handa committed
292 293 294 295 296 297 298

;;;###autoload
(defun tibetan-composition-function (from to pattern &optional string)
  (if string
      (tibetan-compose-string string)
    (tibetan-compose-region from to))
  (- to from))
Kenichi Handa's avatar
Kenichi Handa committed
299 300 301 302 303 304 305 306 307

;;;
;;; This variable is used to avoid repeated decomposition.
;;;
(setq-default tibetan-decomposed nil)

;;;###autoload
(defun tibetan-decompose-buffer ()
  "Decomposes Tibetan characters in the buffer into their components.
Kenichi Handa's avatar
Kenichi Handa committed
308
See also the documentation of the function `tibetan-decompose-region'."
Kenichi Handa's avatar
Kenichi Handa committed
309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331
  (interactive)
  (make-local-variable 'tibetan-decomposed)
  (cond ((not tibetan-decomposed)
	 (tibetan-decompose-region (point-min) (point-max))
	 (setq tibetan-decomposed t))))

;;;###autoload
(defun tibetan-compose-buffer ()
  "Composes Tibetan character components in the buffer.
See also docstring of the function tibetan-compose-region."
  (interactive)
  (make-local-variable 'tibetan-decomposed)
  (tibetan-compose-region (point-min) (point-max))
  (setq tibetan-decomposed nil))

;;;###autoload
(defun tibetan-post-read-conversion (len)
  (save-excursion
    (save-restriction
      (let ((buffer-modified-p (buffer-modified-p)))
	(narrow-to-region (point) (+ (point) len))
	(tibetan-compose-region (point-min) (point-max))
	(set-buffer-modified-p buffer-modified-p)
332 333 334
	(make-local-variable 'tibetan-decomposed)
	(setq tibetan-decomposed nil)
	(- (point-max) (point-min))))))
Kenichi Handa's avatar
Kenichi Handa committed
335 336 337 338 339


;;;###autoload
(defun tibetan-pre-write-conversion (from to)
  (setq tibetan-decomposed-temp tibetan-decomposed)
340
  (let ((old-buf (current-buffer)))
341 342 343 344 345 346
    (set-buffer (generate-new-buffer " *temp*"))
    (if (stringp from)
	(insert from)
      (insert-buffer-substring old-buf from to))
    (if (not tibetan-decomposed-temp)
	(tibetan-decompose-region (point-min) (point-max)))
347 348
    ;; Should return nil as annotations.
    nil))
Kenichi Handa's avatar
Kenichi Handa committed
349

Kenichi Handa's avatar
Kenichi Handa committed
350
(provide 'tibet-util)
Kenichi Handa's avatar
Kenichi Handa committed
351 352

;;; language/tibet-util.el ends here.