]> code.delx.au - gnu-emacs/blobdiff - lisp/language/tibet-util.el
*** empty log message ***
[gnu-emacs] / lisp / language / tibet-util.el
index 6412b4f3654ce581b92c76e6ad34d1e5cc2185a0..260cf7efe54fa6f57dc6c69cc78d73c937bd52e4 100644 (file)
 
 ;;; Code:
 
+(defconst tibetan-obsolete-glyphs
+  `(("\e$(7!=\e(B" . "\e$(7!=\e(B")                        ; 2 col <-> 1 col
+    ("\e$(7!?\e(B" . "\e$(7!?\e(B")
+    ("\e$(7!@\e(B" . "\e$(7!@\e(B")
+    ("\e$(7!A\e(B" . "\e$(7!A\e(B")
+    ("\e$(7"`\e(B" . "\e$(7"`\e(B")
+    ("\e$(7!;\e(B" . "\e$(7!;\e(B")
+    ("\e$(7!D\e(B" . "\e$(7!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.
@@ -146,7 +163,7 @@ The returned string has no composition information."
     ;; If 'a follows a consonant, turn it into the subjoined form.
     ;; * 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 \e$(7"9"""Q"A!;\e(B=\e$(7"9\e(B \e$(7""\e(B \e$(7"A\e(B not \e$(7"9\e(B \e$(7""\e(B \e$(7"Q\e(B \e$(7"A\e(B  
+    ;; any intervening vowel, as in \e$(7"9"""Q"A!;\e(B=\e$(7"9\e(B \e$(7""\e(B \e$(7"A\e(B not \e$(7"9\e(B \e$(7""\e(B \e$(7"Q\e(B \e$(7"A\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
@@ -168,7 +185,8 @@ The returned string has no composition information."
 
      ;; Compose lower vowel sign vertically under.
      ((aref (char-category-set char) ?3)
-      (if (eq char ?\e$(7"Q\e(B)         ;; `\e$(7"Q\e(B' should not visible when composed.
+      (if (or (eq char ?\e$(7"Q\e(B) ;; `\e$(7"Q\e(B' and `\e$,1FP\e(B' should not visible when composed.
+             (eq char #xF70))
          (setq rule nil)
        (setq rule stack-under)))
      ;; Transform ra-mgo (superscribed r) if followed by a subjoined
@@ -356,6 +374,64 @@ See also docstring of the function tibetan-compose-region."
     ;; 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)
 
 ;;; tibet-util.el ends here