X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Futf-2000%2Fchar-db-util.el;h=c4e288fa281d7c7a59356c497776e63716b12fbb;hb=9b9ab823536976a4cbf895153f61838b8ba01441;hp=e93cc2b4a8e9543dcbf3b1675dd2ab5df683922d;hpb=f2cc3010e2b36db63fe3d68ed32fb200352508db;p=chise%2Fxemacs-chise.git

diff --git a/lisp/utf-2000/char-db-util.el b/lisp/utf-2000/char-db-util.el
index e93cc2b..c4e288f 100644
--- a/lisp/utf-2000/char-db-util.el
+++ b/lisp/utf-2000/char-db-util.el
@@ -69,6 +69,9 @@
       (setq i (1+ i)))
     v))
 
+(defvar char-db-feature-domains
+  '(ucs daikanwa cns gt))
+
 (defvar char-db-ignored-attributes nil)
 
 (defun char-attribute-name< (ka kb)
@@ -616,6 +619,52 @@
 		      line-breaking))
       (setq attributes (delq 'ideographic-radical attributes))
       )
+    (let (key)
+      (dolist (domain char-db-feature-domains)
+	(setq key (intern (format "%s@%s" 'ideographic-radical domain)))
+	(when (and (memq key attributes)
+		   (setq value (get-char-attribute char key)))
+	  (setq radical value)
+	  (insert (format "(%s . %S)\t; %c%s"
+			  key
+			  radical
+			  (aref ideographic-radicals radical)
+			  line-breaking))
+	  (setq attributes (delq key attributes))
+	  )
+	(setq key (intern (format "%s@%s" 'ideographic-strokes domain)))
+	(when (and (memq key attributes)
+		   (setq value (get-char-attribute char key)))
+	  (setq strokes value)
+	  (insert (format "(%s . %S)%s"
+			  key
+			  strokes
+			  line-breaking))
+	  (setq attributes (delq key attributes))
+	  )
+	(setq key (intern (format "%s@%s" 'total-strokes domain)))
+	(when (and (memq key attributes)
+		   (setq value (get-char-attribute char key)))
+	  (insert (format "(%s       . %S)%s"
+			  key
+			  value
+			  line-breaking))
+	  (setq attributes (delq key attributes))
+	  )
+	(dolist (feature '(ideographic-radical
+			   ideographic-strokes
+			   total-strokes))
+	  (setq key (intern (format "%s@%s*sources" feature domain)))
+	  (when (and (memq key attributes)
+		     (setq value (get-char-attribute char key)))
+	    (insert (format "(%s%s" key line-breaking))
+	    (dolist (cell value)
+	      (insert (format " %s" cell)))
+	    (insert ")")
+	    (insert line-breaking)
+	    (setq attributes (delq key attributes))
+	    ))
+	))
     (when (and (memq 'ideographic-strokes attributes)
 	       (setq value (get-char-attribute char 'ideographic-strokes)))
       (setq strokes value)
@@ -798,8 +847,8 @@
       (setq attributes (delq 'hanyu-dazidian-char attributes))
       )
     (unless readable
-      (when (memq '->ucs-variants attributes)
-	(setq attributes (delq '->ucs-variants attributes))
+      (when (memq '->ucs-unified attributes)
+	(setq attributes (delq '->ucs-unified attributes))
 	)
       (when (memq 'composition attributes)
 	(setq attributes (delq 'composition attributes))
@@ -1007,7 +1056,7 @@
     ))
 
 (defun insert-char-data-with-variant (char &optional printable
-					   no-ucs-variant
+					   no-ucs-unified
 					   script excluded-script)
   (insert-char-data char printable)
   (let ((variants (or (char-variants char)
@@ -1024,7 +1073,7 @@
 	       (or (null excluded-script)
 		   (null (setq vs (get-char-attribute variant 'script)))
 		   (not (memq excluded-script vs))))
-	  (or (and no-ucs-variant (get-char-attribute variant '=ucs))
+	  (or (and no-ucs-unified (get-char-attribute variant '=ucs))
 	      (insert-char-data variant printable)))
       (setq variants (cdr variants))
       )))
@@ -1035,7 +1084,7 @@
     (while (<= code max)
       (setq char (decode-char '=ucs code))
       (if (encode-char char '=ucs 'defined-only)
-	  (insert-char-data-with-variant char nil 'no-ucs-variant
+	  (insert-char-data-with-variant char nil 'no-ucs-unified
 					 script excluded-script))
       (setq code (1+ code)))))