X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Futf-2000%2Fideograph-util.el;h=adc7564ebd6389296b828c9cfed2fb881798c632;hb=60394efc79f8db484482b85ae5ab793b68b7048b;hp=ade3c81f9d4d11ad77e9138e6cf2ce1f68a141c1;hpb=a6cc2ca3f0d227bbdd7f17b9ad73585e2ae01876;p=chise%2Fxemacs-chise.git

diff --git a/lisp/utf-2000/ideograph-util.el b/lisp/utf-2000/ideograph-util.el
index ade3c81..adc7564 100644
--- a/lisp/utf-2000/ideograph-util.el
+++ b/lisp/utf-2000/ideograph-util.el
@@ -32,6 +32,16 @@
 (defun char-ideographic-radical (char &optional radical)
   (let (ret)
     (or (catch 'tag
+	  (dolist (domain '(ucs daikanwa cns))
+	    (if (and (setq ret (get-char-attribute
+				char
+				(intern
+				 (format "%s@%s"
+					 'ideographic-radical domain))))
+		     (or (eq ret radical)
+			 (null radical)))
+		(throw 'tag ret))))
+	(catch 'tag
 	  (dolist (cell (get-char-attribute char 'ideographic-))
 	    (if (and (setq ret (plist-get cell :radical))
 		     (or (eq ret radical)
@@ -78,6 +88,21 @@
 (defun char-ideographic-strokes (char &optional radical)
   (let (ret)
     (or (catch 'tag
+	  (dolist (domain '(ucs daikanwa cns))
+	    (if (and (setq ret (get-char-attribute
+				char
+				(intern
+				 (format "%s@%s"
+					 'ideographic-radical domain))))
+		     (or (eq ret radical)
+			 (null radical)))
+		(throw 'tag
+		       (get-char-attribute
+			char
+			(intern
+			 (format "%s@%s"
+				 'ideographic-strokes domain)))))))
+	(catch 'tag
 	  (dolist (cell (get-char-attribute char 'ideographic-))
 	    (if (and (setq ret (plist-get cell :radical))
 		     (or (eq ret radical)
@@ -102,6 +127,20 @@
 (defun update-ideograph-radical-table ()
   (interactive)
   (let (ret radical script)
+    (dolist (domain '(ucs daikanwa cns))
+      (map-char-attribute
+       (lambda (char radical)
+	 (when (and radical
+		    (or (null (setq script (get-char-attribute char 'script)))
+			(memq 'Ideograph script)))
+	   (unless (memq char
+			 (setq ret
+			       (aref ideograph-radical-chars-vector radical)))
+	     (char-ideographic-strokes char)
+	     (aset ideograph-radical-chars-vector radical
+		   (cons char ret))))
+	 nil)
+       (intern (format "%s@%s" 'ideographic-radical domain))))
     (map-char-attribute
      (lambda (char radical)
        (when (and radical
@@ -169,7 +208,8 @@
 
 ;;;###autoload
 (defun char-representative-of-daikanwa (char)
-  (if (get-char-attribute char 'ideograph-daikanwa)
+  (if (or (encode-char char 'ideograph-daikanwa 'defined-only)
+	  (encode-char char '=daikanwa-rev2 'defined-only))
       char
     (let ((m (get-char-attribute char 'morohashi-daikanwa))
 	  m-m m-s pat)
@@ -177,7 +217,8 @@
 	    (setq m-m (pop m))
 	    (setq m-s (pop m))
 	    (if (= m-s 0)
-		(decode-char 'ideograph-daikanwa m-m)
+		(or (decode-char '=daikanwa-rev2 m-m 'defined-only)
+		    (decode-char 'ideograph-daikanwa m-m))
 	      (when m
 		(setq pat (list m-m m-s))
 		(map-char-attribute (lambda (c v)
@@ -231,12 +272,13 @@
 
 ;;;###autoload
 (defun char-daikanwa (char)
-  (or (get-char-attribute char 'ideograph-daikanwa)
+  (or (encode-char char 'ideograph-daikanwa 'defined-only)
+      (encode-char char '=daikanwa-rev2 'defined-only)
       (get-char-attribute char 'morohashi-daikanwa)))
 
 ;;;###autoload
 (defun char-ucs (char)
-  (or (get-char-attribute char 'ucs)
+  (or (encode-char char '=ucs 'defined-only)
       (get-char-attribute char '=>ucs)))
 
 (defun char-id (char)
@@ -266,7 +308,13 @@
 	  ccss (sort ccss #'char-attribute-name<))
     (aset ideograph-radical-chars-vector radical chars)
     (dolist (char chars)
-      (insert-char-data char nil attributes ccss))))
+      (when (or (not (some (lambda (atr)
+			     (get-char-attribute char atr))
+			   char-db-ignored-attributes))
+		(some (lambda (ccs)
+			(encode-char char ccs 'defined-only))
+		      ccss))
+	(insert-char-data char nil attributes ccss)))))
 
 (defun write-ideograph-radical-char-data (radical file)
   (if (file-directory-p file)