X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=ids-find.el;h=a4acb7187eb0665de4529852ac4e8b1b797e750f;hb=df06e7bde23caa4a84cc316c763b062840c0a85d;hp=c7276b7f305d08f6f3a730e8bc4782987183d084;hpb=995c6fd0c5cf24288d66ba94b763fab620eb9ad3;p=chise%2Fids.git

diff --git a/ids-find.el b/ids-find.el
index c7276b7..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))
@@ -839,12 +850,12 @@ COMPONENT can be a character or char-spec."
 		(list
 		 (cond
 		  ((characterp (nth 2 enc-str))
-		   (if (or (eq (encode-char (nth 2 enc-str) '=>ucs@component)
-			       #x20087)
-			   (eq (encode-char (nth 2 enc-str) '=>ucs@component)
-			       #x5382)
-			   (eq (encode-char (nth 2 enc-str) '=>ucs@component)
+		   (if (or (memq (encode-char (nth 2 enc-str) '=>ucs@component)
+				 '(#x20087 #x5382 #x4E06))
+			   (eq (encode-char (nth 2 enc-str) '=>ucs@iwds-1)
 			       #x4E06)
+			   (eq (encode-char (nth 2 enc-str) '=ucs-itaiji-001)
+			       #x2E282)
 			   (eq (encode-char (nth 2 enc-str) '=big5-cdp)
 			       #x89CE)
 			   (eq (encode-char (nth 2 enc-str) '=>big5-cdp)
@@ -993,6 +1004,26 @@ COMPONENT can be a character or char-spec."
 		  a-res
 		  (list ?⿱ new-str-c (nth 2 enc-str))
 		  320))
+	  )
+	 ((eq (car enc-str) ?â¿°)
+	  (unless conversion-only
+	    (setq f-res (ids-find-chars-including-ids enc-str)))
+	  (setq new-str (list ?⿱
+			      (nth 2 structure)
+			      (nth 1 enc-str)))
+	  (setq new-str-c
+		(if (setq ret (ideographic-structure-find-chars new-str))
+		    (car ret)
+		  (list (cons 'ideographic-structure new-str))))
+	  (if conversion-only
+	      (list ?â¿° new-str-c (nth 2 enc-str))
+	    (setq a-res (ids-find-chars-including-ids new-str))
+	    (list enc
+		  f-res
+		  new-str-c
+		  a-res
+		  (list ?â¿° new-str-c (nth 2 enc-str))
+		  330))
 	  ))
 	)
       )
@@ -1194,7 +1225,50 @@ COMPONENT can be a character or char-spec."
 		    (list ?⿱  new-str-c (nth 3 enc-str))
 		    419))
 	    ))
-	  )))
+	  )
+	 ((eq (car enc-str) ?â¿°)
+	  (cond
+	   ((equal (nth 1 enc-str)(nth 2 enc-str))
+	    (unless conversion-only
+	      (setq f-res (ids-find-chars-including-ids enc-str)))
+	    (setq new-str (list ?⿲
+				(nth 1 enc-str)
+				(nth 2 structure)
+				(nth 2 enc-str)))
+	    (setq new-str-c
+		  (list (cons 'ideographic-structure new-str)))
+	    (if conversion-only
+		new-str
+	      (setq a-res (ids-find-chars-including-ids new-str))
+	      (list enc
+		    f-res
+		    new-str-c
+		    a-res
+		    new-str
+		    421))
+	    )
+	   (t
+	    (unless conversion-only
+	      (setq f-res (ids-find-chars-including-ids enc-str)))
+	    (setq new-str (list ?â¿°
+				(nth 2 structure)
+				(nth 2 enc-str)))
+	    (setq new-str-c
+		  (if (setq ret (ideographic-structure-find-chars new-str))
+		      (car ret)
+		    (list (cons 'ideographic-structure new-str))))
+	    (if conversion-only
+		(list ?â¿° (nth 1 enc-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)
+		    422))
+	    ))
+	  ))
+	)
       )
      ((eq (car structure) ?⿶)
       (setq enc (nth 1 structure))
@@ -1311,16 +1385,16 @@ COMPONENT can be a character or char-spec."
 			 (cdr (assq 'ideographic-structure enc))
 			 )))
 	(cond
-	 ((eq (car enc-str) ?⿱)
-	  (setq enc2-str (ideographic-character-get-structure (nth 2 enc-str)))
-	  (when (and enc2-str
-		     (eq (car enc2-str) ?â¿°))
+	 ((eq (car enc-str) ?⿱)	  
+	  (cond
+	   ((and (characterp (nth 2 enc-str))
+		 (memq (char-ucs (nth 2 enc-str))
+		       '(#x9580 #x9B25)))
 	    (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 (list ?⿵
+				(nth 2 enc-str)
+				(nth 2 structure)))
 	    (setq new-str-c
 		  (if (setq ret (ideographic-structure-find-chars new-str))
 		      (car ret)
@@ -1333,8 +1407,73 @@ COMPONENT can be a character or char-spec."
 		    new-str-c
 		    a-res
 		    (list ?⿱ (nth 1 enc-str) new-str-c)
-		    611))
+		    601))
 	    )
+	   ((and (setq enc2-str (ideographic-character-get-structure (nth 2 enc-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
+		  (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
+				(ideographic-structure-compact new-str)))))
+	    (if conversion-only
+		(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
+		    (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) ?⿳)
 	  (setq enc2-str (ideographic-character-get-structure (nth 3 enc-str)))
@@ -1441,11 +1580,19 @@ COMPONENT can be a character or char-spec."
       (setq enc (nth 1 structure))
       (when (setq enc-str
 		  (cond ((characterp enc)
-			 (get-char-attribute enc 'ideographic-structure)
+			 (or (get-char-attribute enc 'ideographic-structure)
+			     (get-char-attribute enc 'ideographic-structure@apparent))
 			 )
 			((consp enc)
-			 (cdr (assq 'ideographic-structure enc))
+			 (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))
 	(cond
 	 ((eq (car enc-str) ?⿱)
 	  (cond
@@ -1477,7 +1624,8 @@ COMPONENT can be a character or char-spec."
 	    )
 	   ((and (characterp (nth 2 enc-str))
 		 (memq (char-ucs (nth 2 enc-str))
-		       '(#x706C
+		       '(#x4E00
+			 #x706C
 			 #x65E5 #x66F0 #x5FC3
 			 #x2123C #x58EC #x738B #x7389)))
 	    (unless conversion-only