From: tomo <tomo>
Date: Sun, 8 Sep 2002 11:19:50 +0000 (+0000)
Subject: (char-ref=): New function [moved from char-db-util.el].
X-Git-Tag: r21-4-6-utf-2000-0_19-new-case3~2
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=04cb86c5c52f081ed52af931ec502f95537cadeb;p=chise%2Fxemacs-chise.git

(char-ref=): New function [moved from char-db-util.el].
(char-spec=): Likewise.
Update standard case-table from the char-attribute `->lowercase' and
`->uppercase'.
---

diff --git a/lisp/utf-2000/update-cdb.el b/lisp/utf-2000/update-cdb.el
index 3eadd0b..3666b41 100644
--- a/lisp/utf-2000/update-cdb.el
+++ b/lisp/utf-2000/update-cdb.el
@@ -90,6 +90,44 @@
     (pureload file))
   ))
 
+(defun char-ref= (cr1 cr2)
+  (cond ((char-ref-p cr1)
+	 (if (char-ref-p cr2)
+	     (char-spec= (plist-get cr1 :char)
+			 (plist-get cr2 :char))
+	   (char-spec= (plist-get cr1 :char) cr2)))
+	(t
+	 (char-spec= cr1
+		     (if (char-ref-p cr2)
+			 (plist-get cr2 :char)
+		       cr2)))))
+
+(defun char-spec= (cs1 cs2)
+  (if (characterp cs1)
+      (if (characterp cs2)
+	  (eq cs1 cs2)
+	(eq cs1 (find-char cs2)))
+    (if (characterp cs2)
+	(eq (find-char cs1) cs2)
+      (eq (find-char cs1) (find-char cs2)))))
+
+(let (ret)
+  (map-char-attribute
+   (lambda (c dc)
+     (if (consp dc)
+	 (setq dc (car dc)))
+     (if (listp dc)
+	 (if (setq ret (find-char dc))
+	     (setq dc ret)))
+     (when (characterp dc)
+       (setq ret (get-char-attribute dc '->uppercase))
+       (if (if (listp ret)
+	       (member* c ret :test #'char-ref=)
+	     (char-ref= c ret))
+	   (put-case-table-pair c dc (standard-case-table))))
+     nil)
+   '->lowercase))
+
 (garbage-collect)
 
 ;;; update-cdb.el ends here