From: tomo <tomo>
Date: Thu, 15 May 2003 17:42:54 +0000 (+0000)
Subject: (char-ideographic-radical): Support
X-Git-Tag: r21-2-44-utf-2000-m0_18-mh-r009~9
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=c5e5e8ddd05e49a641169522075b2b8623c5cbac;p=chise%2Fxemacs-chise.git.1

(char-ideographic-radical): Support
`ideographic-radical@{ucs|daikanwa|cns}'.
(char-ideographic-strokes): Support
`ideographic-strokes@{ucs|daikanwa|cns}'.
(update-ideograph-radical-table): Search
`ideographic-radical@{ucs|daikanwa|cns}'.
---

diff --git a/lisp/utf-2000/ideograph-util.el b/lisp/utf-2000/ideograph-util.el
index 5c9bccc..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