From: MORIOKA Tomohiko <tomo.git@chise.org>
Date: Thu, 29 Oct 2020 02:11:56 +0000 (+0900)
Subject: (ideographic-structure-compare-functional-and-apparent):
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=995c6fd0c5cf24288d66ba94b763fab620eb9ad3;p=chise%2Fids.git

(ideographic-structure-compare-functional-and-apparent):
- Implement rule-811: ⿺⿱𠃊BC -> ⿱⿺𠃊CB.
- Implement rule-812: ⿺⿱木B丶 -> ⿱⿺木丶B.
- Implement rule-813: ⿺⿱LBC -> ⿱⿰LCB if B is not nyou.
---

diff --git a/ids-find.el b/ids-find.el
index ee1ce9d..c7276b7 100644
--- a/ids-find.el
+++ b/ids-find.el
@@ -778,7 +778,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 new-str new-str-c f-res a-res ret code)
     (cond
      ((eq (car structure) ?⿸)
       (setq enc (nth 1 structure))
@@ -1437,6 +1437,70 @@ COMPONENT can be a character or char-spec."
 		  710))
 	  )))
       )
+     ((eq (car structure) ?⿺)
+      (setq enc (nth 1 structure))
+      (when (setq enc-str
+		  (cond ((characterp enc)
+			 (get-char-attribute enc 'ideographic-structure)
+			 )
+			((consp enc)
+			 (cdr (assq 'ideographic-structure enc))
+			 )))
+	(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))
+		       '(#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