-;;; tibet-util.el --- Support for inputting Tibetan characters
+;;; tibet-util.el --- utilities for Tibetan -*- coding: iso-2022-7bit; -*-
;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
;; Licensed to the Free Software Foundation.
;; Created: Feb. 17. 1997
-;; History:
+;;; History:
;; 1997.03.13 Modification in treatment of text properties;
;; Support for some special signs and punctuations.
;; 1999.10.25 Modification for a new composition way by K.Handa.
+;;; Commentary:
+
;;; Code:
+(defconst tibetan-obsolete-glyphs
+ `(("\e$(7!=\e(B" . "\e$(8!=\e(B") ; 2 col <-> 1 col
+ ("\e$(7!?\e(B" . "\e$(8!?\e(B")
+ ("\e$(7!@\e(B" . "\e$(8!@\e(B")
+ ("\e$(7!A\e(B" . "\e$(8!A\e(B")
+ ("\e$(7"`\e(B" . "\e$(8"`\e(B")
+ ("\e$(7!;\e(B" . "\e$(8!;\e(B")
+ ("\e$(7!D\e(B" . "\e$(8!D\e(B")
+ ;; Yes these are dirty. But ...
+ ("\e$(7!>\e(B \e$(7!>\e(B" . ,(compose-string "\e$(7!>\e(B \e$(7!>\e(B" 0 3 [?\e$(7!>\e(B (Br . Bl) ? (Br . Bl) ?\e$(7!>\e(B]))
+ ("\e$(7!4!5!5\e(B" . ,(compose-string
+ "\e$(7#R#S#S#S\e(B" 0 4
+ [?\e$(7#R\e(B (Br . Bl) ?\e$(7#S\e(B (Br . Bl) ?\e$(7#S\e(B (Br . Bl) ?\e$(7#S\e(B]))
+ ("\e$(7!4!5\e(B" . ,(compose-string "\e$(7#R#S#S\e(B" 0 3 [?\e$(7#R\e(B (Br . Bl) ?\e$(7#S\e(B (Br . Bl) ?\e$(7#S\e(B]))
+ ("\e$(7!6\e(B" . ,(compose-string "\e$(7#R#S!I\e(B" 0 3 [?\e$(7#R\e(B (Br . Bl) ?\e$(7#S\e(B (br . tr) ?\e$(7!I\e(B]))
+ ("\e$(7!4\e(B" . ,(compose-string "\e$(7#R#S\e(B" 0 2 [?\e$(7#R\e(B (Br . Bl) ?\e$(7#S\e(B]))))
+
;;;###autoload
(defun tibetan-char-p (ch)
"Check if char CH is Tibetan character.
(i 0)
ch this-trans)
(while (< i len)
- (let ((idx (string-match tibetan-precomposition-rule-alist str i)))
+ (let ((idx (string-match tibetan-precomposition-rule-regexp str i)))
(if (eq idx i)
;; Ith character and the followings matches precomposable
;; Tibetan sequence.
;;; (Sanskrit visarga, though it is a vowel modifier, is considered
;;; to be a punctuation.)
;;;
-;;; Here are examples of the words "bsgrubs" and "h'uM"
+;;; Here are examples of the words "bsgrubs" and "hfauM"
;;;
-;;; \e4\e$(7"7\e0"7\e1\e4%qx!"U\e0"G###C"U\e1\e4"7\e0"7\e1\e4"G\e0"G\e1\e(B \e4\e$(7"Hx!#Ax!"Ur'"_\e0"H"A"U"_\e1\e(B
+;;; \e4\e$(7"7\e0"7\e1\e4%qx!"U\e0"G###C"U\e1\e4"7\e0"7\e1\e4"G\e0"G\e1\e(B \e4\e$(7"Hx!"Rx!"Ur'"_\e0"H"R"U"_\e1\e(B
;;;
;;; M
;;; b s b s h
-;;; g '
+;;; g fa
;;; r u
;;; u
;;;
(let ((last (last components))
(stack-upper '(tc . bc))
(stack-under '(bc . tc))
- rule)
+ rule comp-vowel tmp)
;; Special treatment for 'a chung.
;; If 'a follows a consonant, turn it into the subjoined form.
- (if (and (= char ?\e$(7"A\e(B)
- (aref (char-category-set (car last)) ?0))
- (setq char ?\e$(7#A\e(B))
-
+ ;; * Disabled by Tomabechi 2000/06/09 *
+ ;; Because in Unicode, \e$(7"A\e(B may follow directly a consonant without
+ ;; any intervening vowel, as in \e4\e$(7"9\e0"9\e1\e4""\e0"""Q\e1\e4"A\e0"A\e1!;\e(B=\e4\e$(7"9\e0"9\e1\e(B \e4\e$(7""\e0""\e1\e(B \e4\e$(7"A\e0"A\e1\e(B not \e4\e$(7"9\e0"9\e1\e(B \e4\e$(7""\e0""\e1\e(B \e$(7"Q\e(B \e4\e$(7"A\e0"A\e1\e(B
+ ;;(if (and (= char ?\e$(7"A\e(B)
+ ;; (aref (char-category-set (car last)) ?0))
+ ;; (setq char ?\e$(7"R\e(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 '(?\e$(7"T\e(B ?\e$(7"V\e(B ?\e$(7"W\e(B ?\e$(7"X\e(B ?\e$(7"Y\e(B ?\e$(7"Z\e(B ?\e$(7"b\e(B))
+ (setq comp-vowel
+ (copy-sequence
+ (cddr (assoc (char-to-string char)
+ tibetan-composite-vowel-alist)))
+ char
+ (cadr (assoc (char-to-string char)
+ tibetan-composite-vowel-alist))))
(cond
;; Compose upper vowel sign vertically over.
((aref (char-category-set char) ?2)
;; Compose lower vowel sign vertically under.
((aref (char-category-set char) ?3)
- (setq rule stack-under))
-
+ (if (eq char ?\e$(7"Q\e(B) ;; `\e$(7"Q\e(B' should not visible when composed.
+ (setq rule nil)
+ (setq rule stack-under)))
;; Transform ra-mgo (superscribed r) if followed by a subjoined
;; consonant other than w, ', y, r.
((and (= (car last) ?\e$(7"C\e(B)
- (not (memq char '(?\e$(7#>\e(B ?\e$(7#A\e(B ?\e$(7#B\e(B ?\e$(7#C\e(B))))
- (setcar last ?\e$(7#P\e(B)
+ (not (memq char '(?\e$(7#>\e(B ?\e$(7"R\e(B ?\e$(7#B\e(B ?\e$(7#C\e(B))))
+ (setcar last ?\e$(7!"\e(B) ;; modified for newfont by Tomabechi 1999/12/10
(setq rule stack-under))
-
;; Transform initial base consonant if followed by a subjoined
;; consonant but 'a.
(t
(let ((laststr (char-to-string (car last))))
- (if (and (/= char ?\e$(7#A\e(B)
- (string-match "[\e$(7"!\e(B-\e$(7"="?"@"D\e(B-\e$(7"J\e(B]" laststr))
+ (if (and (/= char ?\e$(7"R\e(B) ;; modified for new font by Tomabechi
+ (string-match "[\e$(7"!\e(B-\e$(7"="?"@"D\e(B-\e$(7"J"K\e(B]" laststr))
(setcar last (string-to-char
(cdr (assoc (char-to-string (car last))
tibetan-base-to-subjoined-alist)))))
(setq rule stack-under))))
- (setcdr last (list rule char))))
+ (if rule
+ (setcdr last (list rule char)))
+ ;; Added by Tomabechi 2000/06/08
+ (if comp-vowel
+ (nconc last comp-vowel))
+ ))
;;;###autoload
(defun tibetan-compose-string (str)
(let ((idx 0))
;; `\e$(7"A\e(B' is included in the pattern for subjoined consonants
;; because we treat it specially in tibetan-add-components.
+ ;; (This feature is removed by Tomabechi 2000/06/08)
(while (setq idx (string-match tibetan-composable-pattern str idx))
(let ((from idx)
(to (match-end 0))
(goto-char (point-min))
;; `\e$(7"A\e(B' is included in the pattern for subjoined consonants
;; because we treat it specially in tibetan-add-components.
+ ;; (This feature is removed by Tomabechi 2000/06/08)
(while (re-search-forward tibetan-composable-pattern nil t)
(let ((from (match-beginning 0))
(to (match-end 0))
(forward-char 1))
(compose-region from to components)))))))
+(defvar tibetan-decompose-precomposition-alist
+ (mapcar (function (lambda (x) (cons (string-to-char (cdr x)) (car x))))
+ tibetan-precomposition-rule-alist))
+
;;;###autoload
-(defalias 'tibetan-decompose-region 'decompose-region)
+(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 Tibetan 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))))))
+
+
;;;###autoload
-(defalias 'tibetan-decompose-string 'decompose-string)
+(defun tibetan-decompose-string (str)
+ "Decompose Tibetan string STR.
+This is different from decompose-string because precomposed Tibetan characters
+are decomposed into normal Tibetan 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))
;;;###autoload
(defun tibetan-composition-function (from to pattern &optional string)
;; Should return nil as annotations.
nil))
+\f
+;;;
+;;; Unicode-related definitions.
+;;;
+
+(defvar tibetan-canonicalize-for-unicode-alist
+ '(("\e$(7"Q\e(B" . "") ;; remove vowel a
+ ("\e$(7"T\e(B" . "\e$(7"R"S\e(B") ;; decompose vowels whose use is ``discouraged'' in Unicode 3.0
+ ("\e$(7"V\e(B" . "\e$(7"R"U\e(B")
+ ("\e$(7"W\e(B" . "\e$(7#C"a\e(B")
+ ("\e$(7"X\e(B" . "\e$(7#C"R"a\e(B")
+ ("\e$(7"Y\e(B" . "\e$(7#D"a\e(B")
+ ("\e$(7"Z\e(B" . "\e$(7#D"R"a\e(B")
+ ("\e$(7"b\e(B" . "\e$(7"R"a\e(B"))
+ "Rules for canonicalizing Tibetan vowels for Unicode.")
+
+(defvar tibetan-canonicalize-for-unicode-regexp
+ "[\e$(7"Q"T"V"W"X"Y"Z"b\e(B]"
+ "Regexp for Tibetan vowels to be canonicalized in Unicode.")
+
+(defun tibetan-canonicalize-for-unicode-region (from to)
+ (save-restriction
+ (narrow-to-region from to)
+ (goto-char from)
+ (while (re-search-forward tibetan-canonicalize-for-unicode-regexp nil t)
+ (let (
+ ;;(from (match-beginning 0))
+ ;;(to (match-end 0))
+ (canonical-form
+ (cdr (assoc (match-string 0)
+ tibetan-canonicalize-for-unicode-alist))))
+ ;;(goto-char from)
+ ;;(delete-region from to)
+ ;;(insert canonical-form)
+ (replace-match canonical-form)
+ ))))
+
+(defvar tibetan-strict-unicode t
+ "*Flag to control Tibetan canonicalizing for Unicode.
+
+If non-nil, the vowel a is removed and composite vowels are decomposed
+before writing buffer in Unicode. See also
+`tibetan-canonicalize-for-unicode-regexp' and
+`tibetan-canonicalize-for-unicode-alist'.")
+
+;;;###autoload
+(defun tibetan-pre-write-canonicalize-for-unicode (from to)
+ (let ((old-buf (current-buffer))
+ (strict-unicode tibetan-strict-unicode))
+ (set-buffer (generate-new-buffer " *temp*"))
+ (if (stringp from)
+ (insert from)
+ (insert-buffer-substring old-buf from to))
+ (if strict-unicode
+ (tibetan-canonicalize-for-unicode-region (point-min) (point-max)))
+ ;; Should return nil as annotations.
+ nil))
+
(provide 'tibet-util)
-;;; language/tibet-util.el ends here.
+;;; arch-tag: 7a7333e8-1584-446c-b39c-a02b9def265d
+;;; tibet-util.el ends here