From: tomo <tomo>
Date: Wed, 14 Sep 2005 09:48:24 +0000 (+0000)
Subject: (of-component-features): New function.
X-Git-Tag: chise-base-0_23~80
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=ab7074fead0fe4d946a8a1b37be48f45f7af99b0;p=chise%2Fids.git

(of-component-features): New function.
(to-component-features): New function.
(char-component-variants): Use `{of|to}-component-features'.
(ideographic-structure-char=): Use `of-component-features'.
---

diff --git a/ids-find.el b/ids-find.el
index c0b1832..0a85b5b 100644
--- a/ids-find.el
+++ b/ids-find.el
@@ -70,38 +70,68 @@
       (setq dest (union dest (ids-find-all-products cell))))
     dest))
 
+(defun of-component-features ()
+  (let (dest)
+    (dolist (feature (char-attribute-list))
+      (when (string-match "^<-.*[@/]component\\(/[^*/]+\\)*$"
+			  (symbol-name feature))
+	(push feature dest)))
+    (cons '<-ideographic-component-forms
+	  dest)))
+
+(defun to-component-features ()
+  (let (dest)
+    (dolist (feature (char-attribute-list))
+      (when (string-match "^->.*[@/]component\\(/[^*/]+\\)*$"
+			  (symbol-name feature))
+	(push feature dest)))
+    (cons '->ideographic-component-forms
+	  dest)))
+
 ;;;###autoload
 (defun char-component-variants (char)
-  (let (dest ret uchr)
+  (let ((dest (list char))
+	ret uchr)
     (cond
-     ((setq ret (char-feature char '<-ideographic-component-forms))
+     ((setq ret (some (lambda (feature)
+			(get-char-attribute char feature))
+		      (to-component-features)))
       (dolist (c ret)
-	(setq dest (union dest (char-component-variants c)))))
+	(setq dest (union dest (char-component-variants c))))
+      )
      ((setq ret (get-char-attribute char '->ucs-unified))
       (setq dest (cons char ret))
       (dolist (c dest)
 	(setq dest (union dest
-			  (get-char-attribute
-			   c '->ideographic-component-forms))))
+                          (some (lambda (feature)
+				  (get-char-attribute char feature))
+				(of-component-features))
+			  )))
       )
      ((and (setq ret (get-char-attribute char '=>ucs))
 	   (setq uchr (decode-char '=ucs ret)))
       (setq dest (cons uchr (char-variants uchr)))
       (dolist (c dest)
 	(setq dest (union dest
-			  (get-char-attribute
-			   c '->ideographic-component-forms))))
+                          (some (lambda (feature)
+				  (get-char-attribute char feature))
+				(of-component-features))
+			  )))
       )
      (t
-      (map-char-family (lambda (c)
-			 (unless (memq c dest)
-			   (setq dest (cons c dest)))
-			 (setq dest
-			       (union dest
-				      (get-char-attribute
-				       c '->ideographic-component-forms)))
-			 nil)
-		       char)))
+      (map-char-family
+       (lambda (c)
+	 (unless (memq c dest)
+	   (setq dest (cons c dest)))
+	 (setq dest
+	       (union dest
+		      (some (lambda (feature)
+			      (char-feature c feature))
+			    (of-component-features))
+		      ))
+	 nil)
+       char)
+      ))
     dest))
 
 ;;;###autoload
@@ -138,13 +168,17 @@
 		 (m2 (char-ucs c2)))
 	     (or (and m1 m2
 		      (eq m1 m2))
-		 (some (lambda (b2)
-			 (unless (characterp b2)
-			   (setq b2 (find-char b2)))
-			 (and b2
-			      (ideographic-structure-char= c1 b2)))
-		       (get-char-attribute
-			c2 '<-ideographic-component-forms))
+		 (some (lambda (feature)
+			 (some (lambda (b2)
+				 (unless (characterp b2)
+				   (setq b2 (find-char b2)))
+				 (and b2
+				      (ideographic-structure-char= c1 b2)))
+                               (char-feature c2 feature)
+			       ;; (get-char-attribute
+                               ;;  c2 '<-ideographic-component-forms)
+			       ))
+		       (of-component-features))
 		 (progn
 		   (setq m1 (car (get-char-attribute c1 '<-radical))
 			 m2 (car (get-char-attribute c2 '<-radical)))