X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=ids-find.el;h=40b27b5d189a5bdfbc44a88a6729e65ffe182688;hb=e49571a03ff618b310baf3eb4bbfb69efffc2a02;hp=c3c6cbcbeb74d83d19c74483be1ce568a332ac3d;hpb=b662e7840fe069513df8b85a81d9dd39ad09bb91;p=chise%2Fids.git

diff --git a/ids-find.el b/ids-find.el
index c3c6cbc..40b27b5 100644
--- a/ids-find.el
+++ b/ids-find.el
@@ -1,11 +1,11 @@
 ;;; ids-find.el --- search utility based on Ideographic-structures
 
-;; Copyright (C) 2002,2003,2005 MORIOKA Tomohiko
+;; Copyright (C) 2002,2003,2005,2006,2007 MORIOKA Tomohiko
 
 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
 ;; Keywords: Kanji, Ideographs, search, IDS, CHISE, UCS, Unicode
 
-;; This file is a part of Tomoyo-Tools.
+;; This file is a part of CHISE IDS.
 
 ;; This program is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU General Public License as
@@ -42,8 +42,8 @@
 	     (ids-index-store-char product cell))
 	    ((setq ret (assq 'ideographic-structure cell))
 	     (ids-index-store-structure product (cdr ret)))
-            ;; ((setq ret (find-char cell))
-            ;;  (ids-index-store-char product ret))
+	    ((setq ret (find-char cell))
+	     (ids-index-store-char product ret))
 	    ))))
 
 ;;;###autoload
@@ -90,19 +90,23 @@
 (defun char-component-variants (char)
   (let ((dest (list char))
 	ret uchr)
+    (dolist (feature (to-component-features))
+      (if (setq ret (get-char-attribute char feature))
+	  (dolist (c ret)
+	    (setq dest (union dest (char-component-variants c))))))
     (cond
-     ((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 ret (some (lambda (feature)
+     ;;                    (get-char-attribute char feature))
+     ;;                  (to-component-features)))
+     ;;  (dolist (c ret)
+     ;;    (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
                           (some (lambda (feature)
-				  (get-char-attribute char feature))
+				  (get-char-attribute c feature))
 				(of-component-features))
 			  )))
       )
@@ -112,7 +116,7 @@
       (dolist (c dest)
 	(setq dest (union dest
                           (some (lambda (feature)
-				  (get-char-attribute char feature))
+				  (get-char-attribute c feature))
 				(of-component-features))
 			  )))
       )
@@ -184,26 +188,29 @@
 		 (m2 (char-ucs c2)))
 	     (or (and m1 m2
 		      (eq m1 m2))
-		 (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)))
-		   (unless (characterp m1)
-		     (setq m1 (find-char m1)))
-		   (unless (characterp m2)
-		     (setq m2 (find-char m2)))
-		   (when (or m1 m2)
-		     (ideographic-structure-char= m1 m2))))))))
+		 (memq c1 (char-component-variants c2))
+                 ;; (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)))
+                 ;;   (unless (characterp m1)
+                 ;;     (setq m1 (find-char m1)))
+                 ;;   (unless (characterp m2)
+                 ;;     (setq m2 (find-char m2)))
+                 ;;   (when (or m1 m2)
+                 ;;     (ideographic-structure-char= m1 m2))
+                 ;;   )
+		 )))))
 
 (defun ideographic-structure-member-compare-components (component s-component)
   (let (ret)
@@ -279,7 +286,7 @@
 					      &optional level ignored-chars)
   (unless level
     (setq level 0))
-  (let (is dis i as bs)
+  (let (is i as bs)
     (dolist (c (sort (copy-tree (ideographic-products-find components))
 		     (lambda (a b)
 		       (if (setq as (char-total-strokes a))