(tibetan-add-components): Fixes for new

encoding of Tibetan characters.
(tibetan-decompose-precomposition-alist): New variable.
(tibetan-decompose-region): Convert precomposed characters to
non-precomposed characters.
(tibetan-decompose-string): Likewise.
(tibetan-composition-function): Fix args to
thibetan-compose-string.

diff --git a/lisp/language/tibet-util.el b/lisp/language/tibet-util.el
index 009f88a56161e116d6d2e63da39b4e0f1c51de51..a558a6b426f268502d0b1816b44ba294b531a5b1 100644 (file)
--- a/lisp/language/tibet-util.el
+++ b/lisp/language/tibet-util.el
@@ -118,7 +118,7 @@ The returned string has no composition information."
 ;;;
 ;;; Here are examples of the words "bsgrubs" and "h'uM"
 ;;;
-;;;            \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"A"U"_\e1\e(B
 ;;;
 ;;;                             M
 ;;;             b s b s         h
@@ -144,7 +144,7 @@ The returned string has no composition information."
     ;; 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))
+       (setq char ?\e$(7"R\e(B)) ;; modified for new font by Tomabechi 1999/12/10
 
     (cond
      ;; Compose upper vowel sign vertically over.
@@ -153,27 +153,30 @@ The returned string has no composition information."
 
      ;; 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)))))
 
 ;;;###autoload
 (defun tibetan-compose-string (str)
@@ -231,10 +234,45 @@ The returned string has no composition information."
              (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 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))))))
+
+
 ;;;###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 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))
 
 ;;;###autoload
 (defun tibetan-composition-function (from to pattern &optional string)