(U+3B05): Use `->denotational'.

[chise/xemacs-chise.git.1] / lisp / utf-2000 / char-db-util.el

diff --git a/lisp/utf-2000/char-db-util.el b/lisp/utf-2000/char-db-util.el
index 73a4f5a..82ea653 100644 (file)
--- a/lisp/utf-2000/char-db-util.el
+++ b/lisp/utf-2000/char-db-util.el
@@ -1,6 +1,6 @@
 ;;; char-db-util.el --- Character Database utility
 
-;; Copyright (C) 1998,1999,2000,2001,2002,2003,2004 MORIOKA Tomohiko.
+;; Copyright (C) 1998,1999,2000,2001,2002,2003,2004,2005 MORIOKA Tomohiko.
 
 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
 ;; Keywords: CHISE, Character Database, ISO/IEC 10646, Unicode, UCS-4, MULE.
@@ -75,7 +75,7 @@
   '(ucs daikanwa cns gt jis jis/alt jis/a jis/b
        jis-x0212 jis-x0213 cdp shinjigen misc unknown))
 
-(defvar char-db-ignored-attributes nil)
+(defvar char-db-ignored-attributes '(ideographic-products))
 
 (defun char-attribute-name< (ka kb)
   (cond
@@ -127,9 +127,9 @@
     greek-iso8859-7
     thai-tis620
     =jis-x0208
-    japanese-jisx0208
+    =jis-x0208@1978
+    =jis-x0208@1983
     japanese-jisx0212
-    japanese-jisx0208-1978
     chinese-gb2312
     chinese-cns11643-1
     chinese-cns11643-2
@@ -138,7 +138,7 @@
     chinese-cns11643-5
     chinese-cns11643-6
     chinese-cns11643-7
-    =jis-x0208-1990
+    =jis-x0208@1990
     =jis-x0213-1-2000
     =jis-x0213-2-2000
     korean-ksc5601
@@ -165,9 +165,10 @@
     ideograph-hanziku-10
     ideograph-hanziku-11
     ideograph-hanziku-12
+    =gt-k
+    =ucs@unicode
     =big5
     =big5-eten
-    =gt-k
     =jis-x0208@1997
     =jef-china3))
 
@@ -204,6 +205,8 @@
                                         =daikanwa@rev2
                                         ;; =gt-k
                                         )))
+                            (setq ccs (charset-name ccs))
+                            (null (assq ccs char-spec))
                             (setq ret (encode-char char ccs 'defined-only)))
                        (setq char-spec (cons (cons ccs ret) char-spec))))
                  (if (null char-spec)
@@ -1106,24 +1109,30 @@
                                           no-ucs-unified
                                           script excluded-script)
   (insert-char-data char printable)
-  (let ((variants (or (char-variants char)
-                     (let ((ucs (get-char-attribute char '->ucs)))
-                       (if ucs
-                           (delete char (char-variants (int-char ucs)))))))
-       variant vs)
+  (let ((variants (char-variants char))
+       rest
+       variant vs ret)
     (setq variants (sort variants #'<))
-    (while variants
-      (setq variant (car variants))
-      (if (and (or (null script)
-                  (null (setq vs (get-char-attribute variant 'script)))
-                  (memq script vs))
-              (or (null excluded-script)
-                  (null (setq vs (get-char-attribute variant 'script)))
-                  (not (memq excluded-script vs))))
-         (or (and no-ucs-unified (get-char-attribute variant '=ucs))
-             (insert-char-data variant printable)))
-      (setq variants (cdr variants))
-      )))
+    (setq rest variants)
+    (setq variants (cons char variants))
+    (while rest
+      (setq variant (car rest))
+      (unless (get-char-attribute variant '<-subsumptive)
+       (if (and (or (null script)
+                    (null (setq vs (get-char-attribute variant 'script)))
+                    (memq script vs))
+                (or (null excluded-script)
+                    (null (setq vs (get-char-attribute variant 'script)))
+                    (not (memq excluded-script vs))))
+           (unless (and no-ucs-unified (get-char-attribute variant '=ucs))
+             (insert-char-data variant printable)
+             (if (setq ret (char-variants variant))
+                 (while ret
+                   (or (memq (car ret) variants)
+                        ;; (get-char-attribute (car ret) '<-subsumptive)
+                       (setq rest (nconc rest (list (car ret)))))
+                   (setq ret (cdr ret)))))))
+      (setq rest (cdr rest)))))
 
 (defun insert-char-range-data (min max &optional script excluded-script)
   (let ((code min)