X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fids.git;a=blobdiff_plain;f=ids-find.el;h=a4acb7187eb0665de4529852ac4e8b1b797e750f;hp=0e0e7be8f32c0287858a438c12e66a5d87b5a153;hb=HEAD;hpb=f7abebb51ae1a8f4e828f1816bdf2d33a4853752

diff --git a/ids-find.el b/ids-find.el
index 0e0e7be..b0afbdd 100644
--- a/ids-find.el
+++ b/ids-find.el
@@ -1,11 +1,12 @@
-;;; ids-find.el --- search utility based on Ideographic-structures
+;;; ids-find.el --- search utility based on Ideographic-structures ;; -*- coding: utf-8-mcs-er -*-
 
-;; Copyright (C) 2002,2003,2005 MORIOKA Tomohiko
+;; Copyright (C) 2002, 2003, 2005, 2006, 2007, 2017, 2020, 2021, 2022, 2023
+;;   MORIOKA Tomohiko
 
 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
 ;; Keywords: Kanji, Ideographs, search, IDS, CHISE, UCS, Unicode
 
-;; This file is a part of Tomoyo-Tools.
+;; This file is a part of CHISE-IDS.
 
 ;; This program is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU General Public License as
@@ -30,7 +31,14 @@
       (put-char-attribute component 'ideographic-products
 			  (cons product ret))
       (when (setq ret (char-feature component 'ideographic-structure))
-	(ids-index-store-structure product ret)))
+	(ids-index-store-structure product ret))
+      (when (setq ret (char-feature component 'ideographic-structure@apparent))
+	(ids-index-store-structure product ret))
+      (when (setq ret (char-feature component 'ideographic-structure@apparent/leftmost))
+	(ids-index-store-structure product ret))
+      (when (setq ret (char-feature component 'ideographic-structure@apparent/rightmost))
+	(ids-index-store-structure product ret))
+      )
     ))
 
 (defun ids-index-store-structure (product structure)
@@ -42,19 +50,87 @@
 	     (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 (assq 'ideographic-structure@apparent cell))
+	     (ids-index-store-structure product (cdr ret)))
+	    ((setq ret (assq 'ideographic-structure@apparent/leftmost cell))
+	     (ids-index-store-structure product (cdr ret)))
+	    ((setq ret (assq 'ideographic-structure@apparent/rightmost cell))
+	     (ids-index-store-structure product (cdr ret)))
+	    ((setq ret (find-char cell))
+	     (ids-index-store-char product ret))
 	    ))))
 
 ;;;###autoload
-(defun ids-update-index ()
+(defun ids-update-index (&optional in-memory)
   (interactive)
   (map-char-attribute
    (lambda (c v)
      (ids-index-store-structure c v)
      nil)
    'ideographic-structure)
-  (save-char-attribute-table 'ideographic-products))
+  (map-char-attribute
+   (lambda (c v)
+     (ids-index-store-structure c v)
+     nil)
+   'ideographic-structure@apparent)
+  (map-char-attribute
+   (lambda (c v)
+     (ids-index-store-structure c v)
+     nil)
+   'ideographic-structure@apparent/leftmost)
+  (map-char-attribute
+   (lambda (c v)
+     (ids-index-store-structure c v)
+     nil)
+   'ideographic-structure@apparent/rightmost)
+  (let (products ucs)
+    (map-char-attribute
+     (lambda (c v)
+       (setq products (get-char-attribute c 'ideographic-products))
+       (dolist (comp (delq c (char-ucs-chars c)))
+	 (dolist (p_c (get-char-attribute comp 'ideographic-products))
+	   (unless (encode-char p_c '=ucs)
+	     (if (setq ucs (char-ucs p_c))
+		 (setq p_c (decode-char '=ucs ucs))))
+	   (setq products (adjoin p_c products))))
+       (put-char-attribute c 'ideographic-products products)
+       nil)
+     '=>iwds-1)
+    (map-char-attribute
+     (lambda (c v)
+       (setq products (get-char-attribute c 'ideographic-products))
+       (dolist (comp (delq c (char-ucs-chars c)))
+	 (dolist (p_c (get-char-attribute comp 'ideographic-products))
+	   (unless (encode-char p_c '=ucs)
+	     (if (setq ucs (char-ucs p_c))
+		 (setq p_c (decode-char '=ucs ucs))))
+	   (setq products (adjoin p_c products))))
+       (put-char-attribute c 'ideographic-products products)
+       nil)
+     '=>ucs@iwds-1)
+    (map-char-attribute
+     (lambda (c v)
+       (setq products (get-char-attribute c 'ideographic-products))
+       (dolist (comp (delq c (char-ucs-chars c)))
+	 (put-char-attribute
+	  comp 'ideographic-products
+	  (union products
+		 (get-char-attribute comp 'ideographic-products))))
+       )
+     '=>iwds-1)
+    (map-char-attribute
+     (lambda (c v)
+       (setq products (get-char-attribute c 'ideographic-products))
+       (dolist (comp (delq c (char-ucs-chars c)))
+	 (put-char-attribute
+	  comp 'ideographic-products
+	  (union products
+		 (get-char-attribute comp 'ideographic-products))))
+       )
+     '=>ucs@iwds-1)
+    )
+  (unless in-memory
+    (save-char-attribute-table 'ideographic-products)))
 
 
 (mount-char-attribute-table 'ideographic-products)
@@ -74,8 +150,12 @@
       (when (string-match "^<-.*[@/]component\\(/[^*/]+\\)*$"
 			  (symbol-name feature))
 	(push feature dest)))
-    (cons '<-ideographic-component-forms
-	  dest)))
+    (list* '<-mistakable '->mistakable
+	   '<-formed '->formed
+	   '<-same '->same
+	   '<-original '->original
+	   '<-ancient '->ancient
+	   dest)))
 
 (defun to-component-features ()
   (let (dest)
@@ -83,26 +163,29 @@
       (when (string-match "^->.*[@/]component\\(/[^*/]+\\)*$"
 			  (symbol-name feature))
 	(push feature dest)))
-    (cons '->ideographic-component-forms
-	  dest)))
+    dest))
 
 ;;;###autoload
 (defun char-component-variants (char)
   (let ((dest (list char))
 	ret uchr)
+    (dolist (feature (to-component-features))
+      (if (setq ret (get-char-attribute char feature))
+	  (dolist (c ret)
+	    (setq dest (union dest (char-component-variants c))))))
     (cond
-     ((setq ret (some (lambda (feature)
-			(get-char-attribute char feature))
-		      (to-component-features)))
-      (dolist (c ret)
-	(setq dest (union dest (char-component-variants c))))
-      )
+     ;; ((setq ret (some (lambda (feature)
+     ;;                    (get-char-attribute char feature))
+     ;;                  (to-component-features)))
+     ;;  (dolist (c ret)
+     ;;    (setq dest (union dest (char-component-variants c))))
+     ;;  )
      ((setq ret (get-char-attribute char '->ucs-unified))
       (setq dest (cons char ret))
       (dolist (c dest)
 	(setq dest (union dest
                           (some (lambda (feature)
-				  (get-char-attribute char feature))
+				  (get-char-attribute c feature))
 				(of-component-features))
 			  )))
       )
@@ -112,7 +195,7 @@
       (dolist (c dest)
 	(setq dest (union dest
                           (some (lambda (feature)
-				  (get-char-attribute char feature))
+				  (get-char-attribute c feature))
 				(of-component-features))
 			  )))
       )
@@ -146,35 +229,55 @@
 		(setq components (cdr components)))
       (setq products nil)
       (dolist (variant (char-component-variants (car components)))
+	(setq products
+	      (union products
+		     (get-char-attribute variant 'ideographic-products))))
+      (setq dest (intersection dest products)))
+    dest))
+
+(defun ideograph-find-products-with-variants (components &optional ignored-chars)
+  (if (stringp components)
+      (setq components (string-to-char-list components)))
+  (let (dest products)
+    (dolist (variant (char-component-variants (car components)))
       (setq products
 	    (union products
-		   (get-char-attribute variant 'ideographic-products))))
+		   (set-difference
+		    (get-char-attribute variant 'ideographic-products)
+		    ignored-chars))))
+    (setq dest products)
+    (while (and dest
+		(setq components (cdr components)))
+      (setq products nil)
+      (dolist (variant (char-component-variants (car components)))
+	(setq products
+	      (union products
+		     (set-difference
+		      (get-char-attribute variant 'ideographic-products)
+		      ignored-chars))))
+      (setq dest (intersection dest products)))
+    dest))
+
+(defun ideograph-find-products (components &optional ignored-chars)
+  (if (stringp components)
+      (setq components (string-to-char-list components)))
+  (let (dest products)
+    ;; (dolist (variant (char-component-variants (car components)))
+    ;;   (setq products
+    ;;         (union products
+    ;;                (get-char-attribute variant 'ideographic-products))))
+    ;; (setq dest products)
+    (setq dest (get-char-attribute (car components) 'ideographic-products))
+    (while (and dest
+		(setq components (cdr components)))
+      ;; (setq products nil)
+      ;; (dolist (variant (char-component-variants (car components)))
+      ;;   (setq products
+      ;;         (union products
+      ;;                (get-char-attribute variant 'ideographic-products))))
+      (setq products (get-char-attribute (car components) 'ideographic-products))
       (setq dest (intersection dest products)))
     dest))
-;; (defun ideographic-products-find (&rest components)
-;;   (if (stringp (car components))
-;;       (setq components (car components)))
-;;   (let ((len (length components))
-;;         (i 1)
-;;         dest products)
-;;     (dolist (variant (char-component-variants (elt components 0)))
-;;       (setq products
-;;             (union products
-;;                    (get-char-attribute variant 'ideographic-products))))
-;;     (setq dest products)
-;;     (while (and
-;;             (< i len)
-;;             (progn
-;;               (setq products nil)
-;;               (dolist (variant (char-component-variants (elt components i)))
-;;                 (dolist (product (get-char-attribute
-;;                                   variant 'ideographic-products))
-;;                   (unless (memq product products)
-;;                     (when (memq product dest)
-;;                       (setq products (cons product products))))))
-;;               (setq dest products)))
-;;       (setq i (1+ i)))
-;;     products))
 
 
 (defun ideographic-structure-char= (c1 c2)
@@ -184,26 +287,7 @@
 		 (m2 (char-ucs c2)))
 	     (or (and m1 m2
 		      (eq m1 m2))
-		 (some (lambda (feature)
-			 (some (lambda (b2)
-				 (unless (characterp b2)
-				   (setq b2 (find-char b2)))
-				 (and b2
-				      (ideographic-structure-char= c1 b2)))
-                               (char-feature c2 feature)
-			       ;; (get-char-attribute
-                               ;;  c2 '<-ideographic-component-forms)
-			       ))
-		       (of-component-features))
-		 (progn
-		   (setq m1 (car (get-char-attribute c1 '<-radical))
-			 m2 (car (get-char-attribute c2 '<-radical)))
-		   (unless (characterp m1)
-		     (setq m1 (find-char m1)))
-		   (unless (characterp m2)
-		     (setq m2 (find-char m2)))
-		   (when (or m1 m2)
-		     (ideographic-structure-char= m1 m2))))))))
+		 (memq c1 (char-component-variants c2)))))))
 
 (defun ideographic-structure-member-compare-components (component s-component)
   (let (ret)
@@ -275,12 +359,60 @@
 	  (or (ideographic-structure-to-ids v)
 	      v)))
 
+(defun ids-insert-chars-including-components* (components
+					       &optional level ignored-chars)
+  (unless level
+    (setq level 0))
+  (let (is i as bs)
+    (dolist (c (sort (copy-list (ideograph-find-products components
+							 ignored-chars))
+		     (lambda (a b)
+		       (if (setq as (char-total-strokes a))
+			   (if (setq bs (char-total-strokes b))
+			       (if (= as bs)
+				   (ideograph-char< a b)
+				 (< as bs))
+			     t)
+			 (ideograph-char< a b)))))
+      (unless (memq c ignored-chars)
+	(setq is (char-feature c 'ideographic-structure))
+	(setq i 0)
+	(while (< i level)
+	  (insert "\t")
+	  (setq i (1+ i)))
+	(insert (ids-find-format-line c is))
+	(setq ignored-chars
+	      (ids-insert-chars-including-components*
+	       (char-to-string c) (1+ level)
+	       (cons c ignored-chars))))
+      )
+    )
+  ignored-chars)
+
 (defun ids-insert-chars-including-components (components
 					      &optional level ignored-chars)
   (unless level
     (setq level 0))
-  (let (is dis i as bs)
-    (dolist (c (sort (ideographic-products-find components)
+  (setq ignored-chars
+	(nreverse
+	 (ids-insert-chars-including-components* components
+						 level ignored-chars)))
+  (let (is i as bs)
+    (dolist (c ignored-chars)
+      (dolist (vc (char-component-variants c))
+	(unless (memq vc ignored-chars)
+	  (when (setq is (get-char-attribute vc 'ideographic-structure))
+	    (setq i 0)
+	    (while (< i level)
+	      (insert "\t")
+	      (setq i (1+ i)))
+	    (insert (ids-find-format-line vc is))
+	    (setq ignored-chars
+		  (ids-insert-chars-including-components*
+		   (char-to-string vc) (1+ level)
+		   (cons vc ignored-chars)))))))
+    (dolist (c (sort (copy-list (ideograph-find-products-with-variants
+				 components ignored-chars))
 		     (lambda (a b)
 		       (if (setq as (char-total-strokes a))
 			   (if (setq bs (char-total-strokes b))
@@ -290,31 +422,19 @@
 			     t)
 			 (ideograph-char< a b)))))
       (unless (memq c ignored-chars)
-	(setq is (char-feature c 'ideographic-structure))
+	(setq is (get-char-attribute c 'ideographic-structure))
 	(setq i 0)
 	(while (< i level)
 	  (insert "\t")
 	  (setq i (1+ i)))
 	(insert (ids-find-format-line c is))
 	(setq ignored-chars
-	      (ids-insert-chars-including-components
+	      (ids-insert-chars-including-components*
 	       (char-to-string c) (1+ level)
 	       (cons c ignored-chars))))
-      ))
+      )
+    )
   ignored-chars)
-;; (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))
-;;       (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)
@@ -323,48 +443,23 @@
   (with-current-buffer (get-buffer-create ids-find-result-buffer)
     (setq buffer-read-only nil)
     (erase-buffer)
-    (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)
-    ;;     ;;   )
-    ;;     )
-    ;;   )
+    (ids-insert-chars-including-components components 0 nil)
+    ;; (let ((ignored-chars
+    ;;        (nreverse
+    ;;         (ids-insert-chars-including-components components 0 nil
+    ;;                                                #'ideograph-find-products)))
+    ;;       rest)
+    ;;   (setq rest ignored-chars)
+    ;;   ;; (dolist (c rest)
+    ;;   ;;   (setq ignored-chars
+    ;;   ;;         (union ignored-chars
+    ;;   ;;                (ids-insert-chars-including-components
+    ;;   ;;                 (list c) 0 ignored-chars
+    ;;   ;;                 #'ideograph-find-products-with-variants))))
+    ;;   (ids-insert-chars-including-components components 0 ignored-chars
+    ;;                                          #'ideograph-find-products-with-variants))
     (goto-char (point-min)))
   (view-buffer ids-find-result-buffer))
-;; (defun ids-find-chars-including-components (components)
-;;   "Search Ideographs whose structures have COMPONENTS."
-;;   (interactive "sComponents : ")
-;;   (with-current-buffer (get-buffer-create ids-find-result-buffer)
-;;     (setq buffer-read-only nil)
-;;     (erase-buffer)
-;;     (map-char-attribute
-;;      (lambda (c v)
-;;        (when (every (lambda (p)
-;;                       (ideographic-structure-member p v))
-;;                     components)
-;;          (insert (ids-find-format-line c v)))
-;;        nil)
-;;      'ideographic-structure)
-;;     (goto-char (point-min)))
-;;   (view-buffer ids-find-result-buffer))
 
 ;;;###autoload
 (define-obsolete-function-alias 'ideographic-structure-search-chars
@@ -379,16 +474,1387 @@
   (with-current-buffer (get-buffer-create ids-find-result-buffer)
     (setq buffer-read-only nil)
     (erase-buffer)
-    (let (ucs jis)
-      (map-char-attribute
-       (lambda (c v)
-	 (when (ideographic-structure-repertoire-p v components)
-	   (insert (ids-find-format-line c v))))
-       'ideographic-structure))
+    (map-char-attribute
+     (lambda (c v)
+       (when (ideographic-structure-repertoire-p v components)
+	 (insert (ids-find-format-line c v))))
+     'ideographic-structure)
     (goto-char (point-min)))
   (view-buffer ids-find-result-buffer))
 
 
+(defun ideographic-structure-merge-components-alist (ca1 ca2)
+  (let ((dest-alist ca1)
+	ret)
+    (dolist (cell ca2)
+      (if (setq ret (assq (car cell) dest-alist))
+	  (setcdr ret (+ (cdr ret)(cdr cell)))
+	(setq dest-alist (cons cell dest-alist))))
+    dest-alist))
+
+(defun ideographic-structure-to-components-alist (structure)
+  (apply #'ideographic-structure-to-components-alist* structure))
+
+(defun ideographic-structure-to-components-alist* (operator component1 component2
+							    &optional component3
+							    &rest opts)
+  (let (dest-alist ret)
+    (setq dest-alist
+	  (cond ((characterp component1)
+		 (unless (encode-char component1 'ascii)
+		   (list (cons component1 1)))
+		 )
+		((setq ret (assq 'ideographic-structure component1))
+		 (ideographic-structure-to-components-alist (cdr ret))
+		 )
+		((setq ret (find-char component1))
+		 (list (cons ret 1))
+		 )))
+    (setq dest-alist
+	  (ideographic-structure-merge-components-alist
+	   dest-alist
+	   (cond ((characterp component2)
+		  (unless (encode-char component2 'ascii)
+		    (list (cons component2 1)))
+		  )
+		 ((setq ret (assq 'ideographic-structure component2))
+		  (ideographic-structure-to-components-alist (cdr ret))
+		  )
+		 ((setq ret (find-char component2))
+		  (list (cons ret 1))
+		  ))))
+    (if (memq operator '(?\u2FF2 ?\u2FF3))
+	(ideographic-structure-merge-components-alist
+	 dest-alist
+	 (cond ((characterp component3)
+		(unless (encode-char component3 'ascii)
+		  (list (cons component3 1)))
+		)
+	       ((setq ret (assq 'ideographic-structure component3))
+		(ideographic-structure-to-components-alist (cdr ret))
+		)
+	       ((setq ret (find-char component3))
+		(list (cons ret 1))
+		)))
+      dest-alist)))
+
+(defun ids-find-merge-variables (ve1 ve2)
+  (cond ((eq ve1 t)
+	 ve2)
+	((eq ve2 t)
+	 ve1)
+	(t
+	 (let ((dest-alist ve1)
+	       (rest ve2)
+	       cell ret)
+	   (while (and rest
+		       (setq cell (car rest))
+		       (if (setq ret (assq (car cell) ve1))
+			   (eq (cdr ret)(cdr cell))
+			 (setq dest-alist (cons cell dest-alist))))
+	     (setq rest (cdr rest)))
+	   (if rest
+	       nil
+	     dest-alist)))))
+
+;;;###autoload
+(defun ideographic-structure-equal (structure1 structure2)
+  (let (dest-alist ret)
+    (and (setq dest-alist (ideographic-structure-character=
+			   (car structure1)(car structure2)))
+	 (setq ret (ideographic-structure-character=
+		    (nth 1 structure1)(nth 1 structure2)))
+	 (setq dest-alist (ids-find-merge-variables dest-alist ret))
+	 (setq ret (ideographic-structure-character=
+		    (nth 2 structure1)(nth 2 structure2)))
+	 (setq dest-alist (ids-find-merge-variables dest-alist ret))
+	 (if (memq (car structure1) '(?\u2FF2 ?\u2FF3))
+	     (and (setq ret (ideographic-structure-character=
+			     (nth 3 structure1)(nth 3 structure2)))
+		  (setq dest-alist (ids-find-merge-variables dest-alist ret)))
+	   dest-alist))))
+
+;;;###autoload
+(defun ideographic-structure-character= (c1 c2)
+  (let (ret ret2)
+    (cond ((characterp c1)
+	   (cond ((encode-char c1 'ascii)
+		  (list (cons c1 c2))
+		  )
+		 ((characterp c2)
+		  (if (encode-char c2 'ascii)
+		      (list (cons c2 c1))
+		    (eq c1 c2))
+		  )
+		 ((setq ret2 (find-char c2))
+		  (eq c1 ret2)
+		  )
+		 ((setq ret2 (assq 'ideographic-structure c2))
+		  (and (setq ret (get-char-attribute c1 'ideographic-structure))
+		       (ideographic-structure-equal ret (cdr ret2)))
+		  ))
+	   )
+	  ((setq ret (assq 'ideographic-structure c1))
+	   (cond ((characterp c2)
+		  (if (encode-char c2 'ascii)
+		      (list (cons c2 c1))
+		    (and (setq ret2 (get-char-attribute c2 'ideographic-structure))
+			 (ideographic-structure-equal (cdr ret) ret2)))
+		  )
+		 ((setq ret2 (find-char c2))
+		  (and (setq ret2 (get-char-attribute ret2 'ideographic-structure))
+		       (ideographic-structure-equal (cdr ret) ret2))
+		  )
+		 ((setq ret2 (assq 'ideographic-structure c2))
+		  (ideographic-structure-equal (cdr ret)(cdr ret2))
+		  ))
+	   )
+	  ((setq ret (find-char c1))
+	   (cond ((characterp c2)
+		  (if (encode-char c2 'ascii)
+		      (list (cons c2 c1))
+		    (eq ret c2))
+		  )
+		 ((setq ret2 (find-char c2))
+		  (eq ret ret2)
+		  )
+		 ((setq ret2 (assq 'ideographic-structure c2))
+		  (and (setq ret (get-char-attribute ret 'ideographic-structure))
+		       (ideographic-structure-equal ret (cdr ret2))
+		       )))))))
+
+;;;###autoload
+(defun ideographic-structure-find-chars (structure)
+  (let ((comp-alist (ideographic-structure-to-components-alist structure))
+	ret pl str)
+    (dolist (pc (caar
+		 (sort (mapcar (lambda (cell)
+				 (if (setq ret (get-char-attribute
+						(car cell) 'ideographic-products))
+				     (cons ret (length ret))
+				   (cons nil 0)))
+			       comp-alist)
+		       (lambda (a b)
+			 (< (cdr a)(cdr b))))))
+      (when (or (and (setq str
+			   (get-char-attribute pc 'ideographic-structure))
+		     (ideographic-structure-equal str structure))
+		(and (setq str
+			   (get-char-attribute pc 'ideographic-structure@apparent))
+		     (ideographic-structure-equal str structure))
+		(and (setq str
+			   (get-char-attribute pc 'ideographic-structure@apparent/leftmost))
+		     (ideographic-structure-equal str structure))
+		(and (setq str
+			   (get-char-attribute pc 'ideographic-structure@apparent/rightmost))
+		     (ideographic-structure-equal str structure)))
+	(setq pl (cons pc pl))
+	))
+    pl))
+
+;;;###autoload
+(defun ideographic-char-count-components (char component)
+  (let ((dest 0)
+	structure)
+    (cond ((eq char component)
+	   1)
+	  ((setq structure (get-char-attribute char 'ideographic-structure))
+	   (dolist (cell (ideographic-structure-to-components-alist structure))
+	     (setq dest
+		   (+ dest
+		      (if (eq (car cell) char)
+			  (cdr cell)
+			(* (ideographic-char-count-components (car cell) component)
+			   (cdr cell))))))
+	   dest)
+	  (t
+	   0))))
+
+
+;;;###autoload
+(defun ideographic-character-get-structure (character)
+  "Return ideographic-structure of CHARACTER.
+CHARACTER can be a character or char-spec."
+  (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)
+  "Return non-nil if character CHAR has COMPONENT in ideographic-structure.
+COMPONENT can be a character or char-spec."
+  (or (ideographic-structure-character= char component)
+      (let ((str (ideographic-character-get-structure char)))
+	(and str
+	     (or (ideographic-char-match-component (nth 1 str) component)
+		 (ideographic-char-match-component (nth 2 str) component)
+		 (if (memq (car str) '(?\u2FF2 ?\u2FF3))
+		     (ideographic-char-match-component (nth 3 str) component)))))))
+
+(defun ideographic-structure-char< (a b)
+  (let ((sa (get-char-attribute a 'ideographic-structure))
+	(sb (get-char-attribute b 'ideographic-structure))
+	tsa tsb)
+    (cond (sa
+	   (cond (sb
+		  (setq tsa (char-total-strokes a)
+			tsb (char-total-strokes b))
+		  (if tsa
+		      (if tsb
+			  (or (< tsa tsb)
+			      (and (= tsa tsb)
+				   (ideograph-char< a b)))
+			t)
+		    (if tsb
+			nil
+		      (ideograph-char< a b))))
+		 (t
+		  nil))
+	   )
+	  (t
+	   (cond (sb
+		  t)
+		 (t
+		  (setq tsa (char-total-strokes a)
+			tsb (char-total-strokes b))
+		  (if tsa
+		      (if tsb
+			  (or (< tsa tsb)
+			      (and (= tsa tsb)
+				   (ideograph-char< a b)))
+			t)
+		    (if tsb
+			nil
+		      (ideograph-char< a b)))
+		  ))
+	   ))
+    ))
+
+(defun ideo-comp-tree-adjoin (tree char)
+  (let ((rest tree)
+	included ; other
+	dest cell finished)
+    (while (and (not finished)
+		rest)
+      (setq cell (pop rest))
+      (cond ((ideographic-structure-character= char (car cell))
+	     (setq finished t
+		   dest tree
+		   rest nil)
+	     )
+	    ((ideographic-char-match-component char (car cell))
+	     (setq dest
+		   (cons (cons (car cell)
+			       (ideo-comp-tree-adjoin (cdr cell) char))
+			 dest))
+	     (setq finished t)
+	     )
+	    ((ideographic-char-match-component (car cell) char)
+	     (setq included (cons cell included))
+	     )
+            ;; (included
+            ;;  (setq other (cons cell other))
+            ;;  )
+	    (t
+	     (setq dest (cons cell dest))
+	     )))
+    (cond (finished
+	   (nconc dest rest)
+	   )
+	  (included
+	   (cons (cons char included)
+		 (nconc dest rest))
+	   )
+	  (t
+	   (cons (list char) tree)
+	   ))))
+
+(defun ideographic-chars-to-is-a-tree (chars)
+  (let (tree)
+    (dolist (char (sort (copy-list chars) #'ideographic-structure-char<))
+      (setq tree (ideo-comp-tree-adjoin tree char)))
+    tree))
+
+(defun ids-find-chars-including-ids (structure)
+  (let (comp-alist comp-spec ret str rest)
+    (cond
+     ((characterp structure)
+      (setq rest (copy-list (get-char-attribute structure 'ideographic-products)))
+      )
+     ((setq ret (ideographic-structure-find-chars structure))
+      (dolist (pc ret)
+	(setq rest
+	      (union
+	       rest
+	       (copy-list (get-char-attribute pc 'ideographic-products)))))
+      )
+     (t
+      (setq comp-alist (ideographic-structure-to-components-alist structure)
+	    comp-spec (list (cons 'ideographic-structure structure)))
+      (dolist (pc (caar
+		   (sort (mapcar (lambda (cell)
+				   (if (setq ret (get-char-attribute
+						  (car cell) 'ideographic-products))
+				       (cons ret (length ret))
+				     (cons nil 0)))
+				 comp-alist)
+			 (lambda (a b)
+			   (< (cdr a)(cdr b))))))
+	(when (and (every (lambda (cell)
+			    (>= (ideographic-char-count-components pc (car cell))
+				(cdr cell)))
+			  comp-alist)
+		   (or (ideographic-char-match-component pc comp-spec)
+		       (and (setq str (get-char-attribute pc 'ideographic-structure))
+			    (ideographic-char-match-component
+			     (list
+			      (cons
+			       'ideographic-structure
+			       (functional-ideographic-structure-to-apparent-structure
+				str)))
+			     comp-spec))))
+	  (push pc rest)))
+      ))
+    (ideographic-chars-to-is-a-tree rest)))
+
+(defun functional-ideographic-structure-to-apparent-structure (structure)
+  (ideographic-structure-compare-functional-and-apparent
+   structure nil 'conversion-only))
+
+;;;###autoload
+(defun ideographic-structure-compact (structure)
+  (let ((rest structure)
+	cell
+	ret dest sub)
+    (while rest
+      (setq cell (pop rest))
+      (if (and (consp cell)
+	       (setq ret (find-char cell)))
+	  (setq cell ret))
+      (cond
+       ((and (consp cell)
+	     (cond ((setq ret (assq 'ideographic-structure cell))
+		    (setq sub (cdr ret))
+		    )
+		   ((atom (car cell))
+		    (setq sub cell)
+		    )))
+	(setq cell
+	      (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)))
+
+(defun ideographic-structure-compare-functional-and-apparent (structure
+							      &optional char
+							      conversion-only)
+  (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))
+      (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) ?â¿°)
+	  (unless conversion-only
+	    (setq f-res (ids-find-chars-including-ids enc-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)
+		  (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)
+		  111))
+	  )
+	 ((and (eq (car enc-str) ?⿲)
+	       (memq (char-ucs (nth 1 enc-str)) '(#x4EBB #x2E85))
+	       (eq (nth 2 enc-str) ?丨))
+	  (unless conversion-only
+	    (setq f-res (ids-find-chars-including-ids enc-str)))
+	  (setq new-str (list ?⿱
+			      (nth 3 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 ?â¿° (decode-char '=big5-cdp #x8B7A) new-str-c)
+	    (setq a-res (ids-find-chars-including-ids new-str))
+	    (list enc
+		  f-res
+		  new-str-c
+		  a-res
+		  (list ?â¿° (decode-char '=big5-cdp #x8B7A) new-str-c)
+		  112))
+	  )
+	 ((eq (car enc-str) ?⿱)
+	  (unless conversion-only
+	    (setq f-res (ids-find-chars-including-ids enc-str)))
+	  (setq new-str
+		(list
+		 (cond
+		  ((characterp (nth 2 enc-str))
+		   (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)
+			       #x88E2)
+			   (eq (encode-char (nth 2 enc-str) '=big5-cdp)
+			       #x88AD)
+			   (eq (or (encode-char (nth 2 enc-str) '=>big5-cdp)
+				   (encode-char (nth 2 enc-str) '=big5-cdp-itaiji-001))
+			       #x8766)
+			   (eq (car (get-char-attribute (nth 2 enc-str)
+							'ideographic-structure))
+			       ?⿸))
+		       ?⿸
+		     ?â¿°))
+		  ((eq (car (cdr (assq 'ideographic-structure (nth 2 enc-str))))
+		       ?⿸)
+		   ?⿸)
+		  (t
+		   ?â¿°))
+		 (nth 2 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 ?⿱ (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)
+		  (if (eq (car new-str) ?⿸)
+		      121
+		    122)))
+	  )
+	 ((eq (car enc-str) ?⿸)
+	  (unless conversion-only
+	    (setq f-res (ids-find-chars-including-ids enc-str)))
+	  (setq new-str (list (cond
+			       ((characterp (nth 2 enc-str))
+				(if (memq (char-ucs (nth 2 enc-str))
+					  '(#x5F73))
+				    ?â¿°
+				  ?⿱)
+				)
+			       (t
+				?⿱))
+			      (nth 2 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 ?⿸ (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)
+		  (if (eq (car new-str) ?â¿°)
+		      131
+		    132)))
+	  )))
+      )
+     ((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) ?â¿°)
+	  (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))
+		  210))
+	  )
+	 ((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 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)
+		  220))
+	  )
+	 ))
+      )
+     ((eq (get-char-attribute (car structure) '=ucs-itaiji-001) #x2FF6)
+      (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) ?⿺)
+	  (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))
+		  310))
+	  )
+	 ((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))
+		  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))
+	  ))
+	)
+      )
+     ((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 2 enc-str))
+		 (or (memq (char-ucs (nth 2 enc-str)) '(#x56D7 #x5F51 #x897F))
+		     (eq (char-feature (nth 2 enc-str) '=>big5-cdp)
+			 #x87A5)))
+	    (unless conversion-only
+	      (setq f-res (ids-find-chars-including-ids enc-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)
+		    (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)
+		    411))
+	    )
+	   ((and (characterp (nth 2 enc-str))
+		 (eq (char-ucs (nth 2 enc-str)) #x51F5))
+	    (unless conversion-only
+	      (setq f-res (ids-find-chars-including-ids enc-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)
+		    (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)
+		    412))
+	    )	    
+	   ((and (characterp (nth 1 enc-str))
+		 (eq (char-feature (nth 1 enc-str) '=>ucs@component)
+		     #x300E6))
+	    (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))
+		    413))
+	    )
+	   (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)
+		    414))
+	    ))
+	  )
+	 ((eq (car enc-str) ?⿳)
+	  (cond
+	   ((and (characterp (nth 2 enc-str))
+		 (eq (char-ucs (nth 2 enc-str)) #x56D7))
+	    (unless conversion-only
+	      (setq f-res (ids-find-chars-including-ids enc-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)
+		    (list (cons 'ideographic-structure new-str))))
+	    (setq new-str (list ?⿱ (nth 1 enc-str) new-str-c))
+	    (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 3 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 3 enc-str))
+		    415))
+	    )
+	   ((and (characterp (nth 2 enc-str))
+		 (eq (char-ucs (nth 2 enc-str)) #x5196))
+	    (unless conversion-only
+	      (setq f-res (ids-find-chars-including-ids enc-str)))
+	    (setq new-str (list ?⿱ (nth 1 enc-str) (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))))
+	    (setq new-str (list ?⿱ new-str-c (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 3 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 3 enc-str))
+		    416))
+	    )
+	   ((and (characterp (nth 2 enc-str))
+		 (or (eq (encode-char (nth 2 enc-str) '=>big5-cdp)
+			 #x89A6)
+		     (eq (encode-char (nth 2 enc-str) '=>gt-k)
+			 146)
+		     (eq (char-ucs (nth 2 enc-str)) #x2008A)))
+	    (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))))
+	    (setq new-str (list ?⿸ new-str-c (nth 3 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)
+		    417))
+	    )
+	   (t
+	    (unless conversion-only
+	      (setq f-res (ids-find-chars-including-ids enc-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)
+		    (list (cons 'ideographic-structure new-str))))
+	    (setq new-str (list ?⿱ (nth 1 enc-str) new-str-c))
+	    (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 3 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 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))
+      (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) ?⿱)
+	  (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
+	  (when (and enc2-str
+		     (eq (car enc2-str) ?â¿°))
+	    (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-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))
+		    511))
+	    )
+	  )
+	 ((eq (car enc-str) ?⿳)
+	  (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
+	  (when (and enc2-str
+		     (eq (car enc2-str) ?â¿°))
+	    (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-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) (nth 3 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) (nth 3 enc-str))
+		    512))
+	    )
+	  )
+	 ((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 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 (nth 3 enc-str))
+	    (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 (nth 3 enc-str))
+		  520))
+	  )
+	 ((eq (car enc-str) ?â¿´)
+	  (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
+	  (when (and enc2-str
+		     (eq (car enc2-str) ?â¿°))
+	    (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 enc2-str) new-str-c (nth 2 enc2-str))
+	      (setq a-res (ids-find-chars-including-ids new-str))
+	      (list enc
+		    f-res
+		    new-str-c
+		    a-res
+		    (list ?⿲ (nth 1 enc2-str) new-str-c (nth 2 enc2-str))
+		    530))
+	    )
+	  )))
+      )
+     ((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 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 2 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 ?⿱ (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)
+		    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)))
+	  (when (and enc2-str
+		     (eq (car enc2-str) ?â¿°))
+	    (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-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) (nth 2 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) (nth 2 enc-str) new-str-c)
+		    612))
+	    )
+	  )
+	 ((eq (car enc-str) ?⿲)
+	  (unless conversion-only
+	    (setq f-res (ids-find-chars-including-ids enc-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)
+		  (list (cons 'ideographic-structure new-str))))
+	  (if conversion-only
+	      (list ?⿲ (nth 1 enc-str) new-str-c (nth 3 enc-str))
+	    (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 (nth 3 enc-str))
+		  620))
+	  )
+	 ((eq (car enc-str) ?â¿´)
+	  (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
+	  (when (and enc2-str
+		     (eq (car enc2-str) ?â¿°))
+	    (unless conversion-only
+	      (setq f-res (ids-find-chars-including-ids enc-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)
+		    (list (cons 'ideographic-structure new-str))))
+	    (if conversion-only
+		(list ?⿲ (nth 1 enc2-str) new-str-c (nth 2 enc2-str))
+	      (setq a-res (ids-find-chars-including-ids new-str))
+	      (list enc
+		    f-res
+		    new-str-c
+		    a-res
+		    (list ?⿲ (nth 1 enc2-str) new-str-c (nth 2 enc2-str))
+		    630)))
+	  )
+	 ((eq (car enc-str) ?⿵)
+	  (unless conversion-only
+	    (setq f-res (ids-find-chars-including-ids enc-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)
+		  (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)
+		  640))
+	  )
+	 ))
+      )
+     ((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) ?⿺)
+	  (unless conversion-only
+	    (setq f-res (ids-find-chars-including-ids enc-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)
+		  (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)
+		  710))
+	  )
+	 ((eq (car enc-str) ?⿸)
+	  (unless conversion-only
+	    (setq f-res (ids-find-chars-including-ids enc-str)))
+	  (cond
+	   ((and (characterp (nth 2 enc-str))
+		 (or (memq (char-ucs (nth 2 enc-str))
+			   '(#x4EBA #x5165 #x513F #x51E0))
+		     (memq (or (encode-char (nth 2 enc-str) '=>ucs@iwds-1)
+			       (encode-char (nth 2 enc-str) '=>ucs@component))
+			   '(#x4EBA #x513F))))
+	    (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)
+		    (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)
+		    721))
+	    )
+	   (t
+	    (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)
+		    722))
+	    ))
+	  )
+	 ))
+      )
+     ((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)
+			     (get-char-attribute enc 'ideographic-structure@apparent/leftmost)
+			     (get-char-attribute enc 'ideographic-structure@apparent/rightmost))
+			 )
+			((consp enc)
+			 (or (cdr (assq 'ideographic-structure enc))
+			     (cdr (assq 'ideographic-structure@apparent enc))
+			     (cdr (assq 'ideographic-structure@apparent/leftmost enc))
+			     (cdr (assq 'ideographic-structure@apparent/rightmost 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))
+		 (or (memq (char-ucs (nth 2 enc-str))
+			   '(#x4E00
+			     #x706C
+			     #x65E5 #x66F0 #x5FC3
+			     #x2123C #x58EC #x738B #x7389))
+		     (memq (encode-char (nth 2 enc-str) '=>ucs@component)
+			   '(#x2123C #x58EC))
+		     (eq (encode-char (nth 2 enc-str) '=>ucs@iwds-1)
+			 #x7389)
+		     (eq (encode-char (nth 2 enc-str) '=>big5-cdp)
+			 #x8D71)))
+	    (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
+		  (cond ((characterp enc)
+			 (get-char-attribute enc 'ideographic-structure)
+			 )
+			((consp enc)
+			 (cdr (assq 'ideographic-structure enc))
+			 )))
+	(cond
+	 ((eq (car enc-str) ?⿱)
+	  (unless conversion-only
+	    (setq f-res (ids-find-chars-including-ids enc-str)))
+	  (if conversion-only
+	      (list ?⿳ (nth 1 enc-str) (nth 2 structure) (nth 2 enc-str))
+	    (list enc
+		  f-res
+		  new-str
+		  nil
+		  (list ?⿳
+			(nth 1 enc-str)
+			(nth 2 structure)
+			(nth 2 enc-str))
+		  911))
+	  )))
+      ))
+    ))
+
+
 ;;; @ End.
 ;;;