From: tomo <tomo>
Date: Wed, 10 Dec 2003 16:03:15 +0000 (+0000)
Subject: (char-ideographic-strokes-from-domains): New function.
X-Git-Tag: r21-4-14-chise-0_21-ucs-jis-2000^2~18
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=119a7582ecd65deb2358f28355be99ae0444d4e6;p=chise%2Fxemacs-chise.git.1

(char-ideographic-strokes-from-domains): New function.
(char-ideographic-strokes): Add new optional argument
`preferred-domains'; use `char-ideographic-strokes-from-domains'.
(char-daikanwa-strokes): Specify '(daikanwa) as the
`preferred-domains' for `char-ideographic-strokes'.
---

diff --git a/lisp/utf-2000/ideograph-util.el b/lisp/utf-2000/ideograph-util.el
index f429f77..eafb64a 100644
--- a/lisp/utf-2000/ideograph-util.el
+++ b/lisp/utf-2000/ideograph-util.el
@@ -85,25 +85,32 @@
    11 12 12 12 12 13 13 13 13 14
    14 15 16 16 17])
 
-(defun char-ideographic-strokes (char &optional radical)
+(defun char-ideographic-strokes-from-domains (char domains &optional radical)
+  (catch 'tag
+    (dolist (domain domains)
+      (if (and (setq ret (or (get-char-attribute
+			      char
+			      (intern
+			       (format "%s@%s"
+				       'ideographic-radical domain)))
+			     (get-char-attribute
+			      char 'ideographic-radical)))
+	       (or (eq ret radical)
+		   (null radical))
+	       (setq ret (get-char-attribute
+			  char
+			  (intern
+			   (format "%s@%s"
+				   'ideographic-strokes domain)))))
+	  (throw 'tag ret)))))
+
+(defun char-ideographic-strokes (char &optional radical preferred-domains)
   (let (ret)
-    (or (catch 'tag
-	  (dolist (domain char-db-feature-domains)
-	    (if (and (setq ret (or (get-char-attribute
-				    char
-				    (intern
-				     (format "%s@%s"
-					     'ideographic-radical domain)))
-				   (get-char-attribute
-				    char 'ideographic-radical)))
-		     (or (eq ret radical)
-			 (null radical))
-		     (setq ret (get-char-attribute
-				char
-				(intern
-				 (format "%s@%s"
-					 'ideographic-strokes domain)))))
-		(throw 'tag ret))))
+    (or (char-ideographic-strokes-from-domains
+	 char preferred-domains radical)
+	(get-char-attribute char 'ideographic-strokes)
+	(char-ideographic-strokes-from-domains
+	 char char-db-feature-domains radical)
 	(catch 'tag
 	  (dolist (cell (get-char-attribute char 'ideographic-))
 	    (if (and (setq ret (plist-get cell :radical))
@@ -111,7 +118,6 @@
 			 (null radical)))
 		(throw 'tag (plist-get cell :strokes)))))
 	(get-char-attribute char 'daikanwa-strokes)
-	(get-char-attribute char 'ideographic-strokes)
 	(let ((strokes
 	       (or (get-char-attribute char 'kangxi-strokes)
 		   (get-char-attribute char 'japanese-strokes)
@@ -265,12 +271,10 @@
   (unless radical
     (setq radical ideographic-radical))
   (let ((drc (char-representative-of-daikanwa char)))
-    (char-ideographic-strokes
-     (if (= (char-ideographic-radical drc radical)
-	    (char-ideographic-radical char radical))
-	 drc
-       char)
-     radical)))
+    (if (= (char-ideographic-radical drc radical)
+	   (char-ideographic-radical char radical))
+	(setq char drc)))
+  (char-ideographic-strokes char radical '(daikanwa)))
 
 ;;;###autoload
 (defun char-daikanwa (char)