X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=ids-find.el;h=a4acb7187eb0665de4529852ac4e8b1b797e750f;hb=757ac145d5d8185b02babd82723c5ce715f7c0ac;hp=576718ff76dd60c06230c1ed05d7a19e3399a09e;hpb=19573c0f2925166fcc42324ec872c1c46576a6b5;p=chise%2Fids.git

diff --git a/ids-find.el b/ids-find.el
index 576718f..a4acb71 100644
--- a/ids-find.el
+++ b/ids-find.el
@@ -599,16 +599,20 @@
 (defun ideographic-character-get-structure (character)
   "Return ideographic-structure of CHARACTER.
 CHARACTER can be a character or char-spec."
-  (let (ret)
-    (cond ((characterp character)
-	   (get-char-attribute character 'ideographic-structure)
-	   )
-	  ((setq ret (assq 'ideographic-structure character))
-	   (cdr ret)
-	   )
-	  ((setq ret (find-char character))
-	   (get-char-attribute ret 'ideographic-structure)
-	   ))))
+  (mapcar (lambda (cell)
+	    (or (and (listp cell)
+		     (find-char cell))
+		cell))
+	  (let (ret)
+	    (cond ((characterp character)
+		   (get-char-attribute character 'ideographic-structure)
+		   )
+		  ((setq ret (assq 'ideographic-structure character))
+		   (cdr ret)
+		   )
+		  ((setq ret (find-char character))
+		   (get-char-attribute ret 'ideographic-structure)
+		   )))))
 
 ;;;###autoload
 (defun ideographic-char-match-component (char component)
@@ -768,9 +772,15 @@ COMPONENT can be a character or char-spec."
 		    (setq sub cell)
 		    )))
 	(setq cell
-	      (if (setq ret (ideographic-structure-find-chars sub))
-		  (car ret)
-		(list (cons 'ideographic-structure sub))))
+	      (cond ((setq ret (ideographic-structure-find-chars sub))
+		     (car ret)
+		     )
+		    ((setq ret (ideographic-structure-compact sub))
+		     (list (cons 'ideographic-structure ret))
+		     )
+		    (t
+		     (list (cons 'ideographic-structure sub))))
+	      )
 	))
       (setq dest (cons cell dest)))
     (nreverse dest)))
@@ -778,7 +788,8 @@ COMPONENT can be a character or char-spec."
 (defun ideographic-structure-compare-functional-and-apparent (structure
 							      &optional char
 							      conversion-only)
-  (let (enc enc-str enc2-str new-str new-str-c f-res a-res ret code)
+  (let (enc enc-str enc2-str enc3-str new-str new-str-c
+	    f-res a-res ret code)
     (cond
      ((eq (car structure) ?⿸)
       (setq enc (nth 1 structure))
@@ -1399,26 +1410,69 @@ COMPONENT can be a character or char-spec."
 		    601))
 	    )
 	   ((and (setq enc2-str (ideographic-character-get-structure (nth 2 enc-str)))
-		 (eq (car enc2-str) ?â¿°))
+		 (cond
+		  ((eq (car enc2-str) ?â¿°)
+		   (setq code 611)
+		   )
+		  ((eq (car enc2-str) ?⿲)
+		   (setq code 614)
+		   )
+		  ((and (eq (car enc2-str) ?⿱)
+			(setq enc3-str
+			      (ideographic-character-get-structure (nth 2 enc2-str)))
+			(eq (car enc3-str) ?â¿°))
+		   (setq code 613)
+		   )))
 	    (unless conversion-only
 	      (setq f-res (ids-find-chars-including-ids enc-str)))
-	    (setq new-str (list ?⿲
-				(nth 1 enc2-str)
-				(nth 2 structure)
-				(nth 2 enc2-str)))
+	    (setq new-str
+		  (cond ((eq code 611)
+			 (list ?⿲
+			       (nth 1 enc2-str)
+			       (nth 2 structure)
+			       (nth 2 enc2-str))
+			 )
+			((eq code 613)
+			 (list ?⿲
+			       (nth 1 enc3-str)
+			       (nth 2 structure)
+			       (nth 2 enc3-str))
+			 )
+			((eq code 614)
+			 (list ?⿲
+			       (nth 1 enc2-str)
+			       (list (list 'ideographic-structure
+					   ?⿱
+					   (nth 2 enc2-str)
+					   (nth 2 structure)))
+			       (nth 3 enc2-str))
+			 )))
 	    (setq new-str-c
 		  (if (setq ret (ideographic-structure-find-chars new-str))
 		      (car ret)
-		    (list (cons 'ideographic-structure new-str))))
+		    (list (cons 'ideographic-structure
+				(ideographic-structure-compact new-str)))))
 	    (if conversion-only
-		(list ?⿱ (nth 1 enc-str) new-str-c)
+		(cond ((or (eq code 611)
+			   (eq code 614))
+		       (list ?⿱ (nth 1 enc-str) new-str-c)
+		       )
+		      ((eq code 613)
+		       (list ?⿳ (nth 1 enc-str)(nth 1 enc2-str) new-str-c)
+		       ))
 	      (setq a-res (ids-find-chars-including-ids new-str))
 	      (list enc
 		    f-res
 		    new-str-c
 		    a-res
-		    (list ?⿱ (nth 1 enc-str) new-str-c)
-		    611))
+		    (cond ((or (eq code 611)
+			       (eq code 614))
+			   (list ?⿱ (nth 1 enc-str) new-str-c)
+			   )
+			  ((eq code 613)
+			   (list ?⿳ (nth 1 enc-str)(nth 1 enc2-str) new-str-c)
+			   ))
+		    code))
 	    ))
 	  )
 	 ((eq (car enc-str) ?⿳)
@@ -1533,12 +1587,12 @@ COMPONENT can be a character or char-spec."
 			 (or (cdr (assq 'ideographic-structure enc))
 			     (cdr (assq 'ideographic-structure@apparent enc)))
 			 )))
-	(setq enc-str
-	      (mapcar (lambda (cell)
-			(or (and (listp cell)
-				 (find-char cell))
-			    cell))
-		      enc-str))
+        ;; (setq enc-str
+        ;;       (mapcar (lambda (cell)
+        ;;                 (or (and (listp cell)
+        ;;                          (find-char cell))
+        ;;                     cell))
+        ;;               enc-str))
 	(cond
 	 ((eq (car enc-str) ?⿱)
 	  (cond