X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=ids-find.el;h=5519a1c7f81d0a2599c22842ce08907222c225e1;hb=f0a6db4ace6dce0fcd1f6887a19c89860c3583a4;hp=ee1ce9de30d36864d71cca8d4034bcfbc540c18c;hpb=a0471897dce02dbb6c979097b1620a9a329a42e2;p=chise%2Fids.git

diff --git a/ids-find.el b/ids-find.el
index ee1ce9d..5519a1c 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)
@@ -778,7 +782,7 @@ 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)
+  (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 +843,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 +997,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 +1218,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 +1378,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 +1400,58 @@ 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)
+		   )
+		  ((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))
+			 )))
+	    (setq new-str-c
+		  (if (setq ret (ideographic-structure-find-chars new-str))
+		      (car ret)
+		    (list (cons 'ideographic-structure new-str))))
+	    (if conversion-only
+		(cond ((eq code 611)
+		       (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 ((eq code 611)
+			   (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)))
@@ -1437,6 +1554,79 @@ COMPONENT can be a character or char-spec."
 		  710))
 	  )))
       )
+     ((eq (car structure) ?⿺)
+      (setq enc (nth 1 structure))
+      (when (setq enc-str
+		  (cond ((characterp enc)
+			 (or (get-char-attribute enc 'ideographic-structure)
+			     (get-char-attribute enc 'ideographic-structure@apparent))
+			 )
+			((consp 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
+	   ((and (characterp (nth 1 enc-str))
+		 (or (and (eq (char-ucs (nth 1 enc-str)) #x200CA)
+			  (setq code 811))
+		     (and (eq (char-feature (nth 1 enc-str) '=>iwds-1) 233)
+			  (characterp (nth 2 structure))
+			  (eq (char-ucs (nth 2 structure)) #x4E36)
+			  (setq code 812))))
+	    (unless conversion-only
+	      (setq f-res (ids-find-chars-including-ids enc-str)))
+	    (setq new-str (list ?⿺
+				(nth 1 enc-str)
+				(nth 2 structure)))
+	    (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))
+		    code))
+	    )
+	   ((and (characterp (nth 2 enc-str))
+		 (memq (char-ucs (nth 2 enc-str))
+		       '(#x4E00
+			 #x706C
+			 #x65E5 #x66F0 #x5FC3
+			 #x2123C #x58EC #x738B #x7389)))
+	    (unless conversion-only
+	      (setq f-res (ids-find-chars-including-ids enc-str)))
+	    (setq new-str (list ?â¿°
+				(nth 1 enc-str)
+				(nth 2 structure)))
+	    (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))
+		    813))
+	    )
+	   ))))
+      )
      ((eq (car structure) ?â¿»)
       (setq enc (nth 1 structure))
       (when (setq enc-str