From: tomo <tomo>
Date: Thu, 2 Jun 2005 13:53:39 +0000 (+0000)
Subject: (ids-index-store-char): Use `get-char-attribute' instead of
X-Git-Tag: chise-base-0_23~86
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=4d98e76d208bbca8e7af8bbde5a83a9ef489f522;p=chise%2Fids.git

(ids-index-store-char): Use `get-char-attribute' instead of
`char-feature' to refer `ideographic-products' to avoid infinite loop;
ignore COMPONENT's substructure.
(ids-index-store-structure): Ignore char-ref format.
(ids-insert-chars-including-components): New function.
(ids-find-chars-including-components): Use
`ids-insert-chars-including-components'.
---

diff --git a/ids-find.el b/ids-find.el
index d21bd7b..c0b1832 100644
--- a/ids-find.el
+++ b/ids-find.el
@@ -25,13 +25,15 @@
 ;;; Code:
 
 (defun ids-index-store-char (product component)
-  (let ((ret (char-feature ; get-char-attribute
+  (let ((ret (get-char-attribute ; char-feature
 	      component 'ideographic-products)))
     (unless (memq product ret)
       (put-char-attribute component 'ideographic-products
 			  (cons product ret)))
-    (when (setq ret (char-feature component 'ideographic-structure))
-      (ids-index-store-structure product ret))))
+    ;; (when ret (setq ret (get-char-attribute ; char-feature
+    ;;                      component 'ideographic-structure))
+    ;;   (ids-index-store-structure product ret))
+    ))
 
 (defun ids-index-store-structure (product structure)
   (let (ret)
@@ -42,8 +44,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
@@ -223,6 +225,26 @@
 	  (or (ideographic-structure-to-ids v)
 	      v)))
 
+(defun ids-insert-chars-including-components (components level)
+  (let (is dis i)
+    (dolist (c (ideographic-products-find components))
+      (setq is (char-feature c 'ideographic-structure))
+      ;; to avoid problems caused by wrong indexes
+      (when (every (lambda (cc)
+		     (ideographic-structure-member cc is))
+		   components)
+	;;(ids-insert-chars-including-components (char-to-string c) (1+ level))
+	(setq i 0)
+	(while (< i level)
+	  (insert "\t")
+	  (setq i (1+ i)))
+	(insert (ids-find-format-line c is))
+	;;(forward-line -1)
+	(ids-insert-chars-including-components
+	 (char-to-string c) (1+ level))
+	)
+      )))
+
 ;;;###autoload
 (defun ids-find-chars-including-components (components)
   "Search Ideographs whose structures have COMPONENTS."
@@ -230,18 +252,30 @@
   (with-current-buffer (get-buffer-create ids-find-result-buffer)
     (setq buffer-read-only nil)
     (erase-buffer)
-    (let (is)
-      (dolist (c (ideographic-products-find components))
-	(setq is (char-feature c 'ideographic-structure))
-	;; to avoid problems caused by wrong indexes
-	(when (every (lambda (c)
-		       (ideographic-structure-member c is))
-		     components)
-	  (insert (ids-find-format-line c is))
-	  )
-	)
-      ;; (forward-line -1)
-      )
+    (ids-insert-chars-including-components components 0)
+    ;; (let (is dis)
+    ;;   (dolist (c (ideographic-products-find components))
+    ;;     (setq is (char-feature c 'ideographic-structure))
+    ;;     ;; to avoid problems caused by wrong indexes
+    ;;     ;; (when (every (lambda (cc)
+    ;;     ;;                (ideographic-structure-member cc is))
+    ;;     ;;              components)
+    ;;     (dolist (dc (ideographic-products-find (char-to-string c)))
+    ;;       (setq dis (char-feature dc 'ideographic-structure))
+    ;;     ;;     ;; to avoid problems caused by wrong indexes
+    ;;     ;;     (when (every (lambda (dcc)
+    ;;     ;;                    (ideographic-structure-member dcc is))
+    ;;     ;;                  components)
+    ;;       (insert "\t")
+    ;;       (insert (ids-find-format-line dc dis))
+    ;;       (forward-line -1)
+    ;;     ;;       )
+    ;;       )
+    ;;     (insert (ids-find-format-line c is))
+    ;;     (forward-line -1)
+    ;;     ;;   )
+    ;;     )
+    ;;   )
     (goto-char (point-min)))
   (view-buffer ids-find-result-buffer))
 ;; (defun ids-find-chars-including-components (components)