ids-find.el

   1 ;;; ids-find.el --- search utility based on Ideographic-structures ;; -*- coding: utf-8-mcs-er -*-
   2
   3 ;; Copyright (C) 2002, 2003, 2005, 2006, 2007, 2017, 2020 MORIOKA Tomohiko
   4
   5 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
   6 ;; Keywords: Kanji, Ideographs, search, IDS, CHISE, UCS, Unicode
   7
   8 ;; This file is a part of CHISE-IDS.
   9
  10 ;; This program is free software; you can redistribute it and/or
  11 ;; modify it under the terms of the GNU General Public License as
  12 ;; published by the Free Software Foundation; either version 2, or (at
  13 ;; your option) any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful, but
  16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18 ;; General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with this program; see the file COPYING.  If not, write to
  22 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Code:
  26
  27 (defun ids-index-store-char (product component)
  28   (let ((ret (get-char-attribute component 'ideographic-products)))
  29     (unless (memq product ret)
  30       (put-char-attribute component 'ideographic-products
  31                           (cons product ret))
  32       (when (setq ret (char-feature component 'ideographic-structure))
  33         (ids-index-store-structure product ret)))
  34     ))
  35
  36 (defun ids-index-store-structure (product structure)
  37   (let (ret)
  38     (dolist (cell (cdr structure))
  39       (if (char-ref-p cell)
  40           (setq cell (plist-get cell :char)))
  41       (cond ((characterp cell)
  42              (ids-index-store-char product cell))
  43             ((setq ret (assq 'ideographic-structure cell))
  44              (ids-index-store-structure product (cdr ret)))
  45             ((setq ret (find-char cell))
  46              (ids-index-store-char product ret))
  47             ))))
  48
  49 ;;;###autoload
  50 (defun ids-update-index (&optional in-memory)
  51   (interactive)
  52   (map-char-attribute
  53    (lambda (c v)
  54      (ids-index-store-structure c v)
  55      nil)
  56    'ideographic-structure)
  57   (map-char-attribute
  58    (lambda (c v)
  59      (ids-index-store-structure c v)
  60      nil)
  61    'ideographic-structure@apparent)
  62   (unless in-memory
  63     (save-char-attribute-table 'ideographic-products)))
  64
  65
  66 (mount-char-attribute-table 'ideographic-products)
  67
  68 ;;;###autoload
  69 (defun ids-find-all-products (char)
  70   (let (dest)
  71     (dolist (cell (char-feature char 'ideographic-products))
  72       (unless (memq cell dest)
  73         (setq dest (cons cell dest)))
  74       (setq dest (union dest (ids-find-all-products cell))))
  75     dest))
  76
  77 (defun of-component-features ()
  78   (let (dest)
  79     (dolist (feature (char-attribute-list))
  80       (when (string-match "^<-.*[@/]component\\(/[^*/]+\\)*$"
  81                           (symbol-name feature))
  82         (push feature dest)))
  83     (list* '<-mistakable '->mistakable
  84            '<-formed '->formed
  85            '<-same '->same
  86            '<-original '->original
  87            '<-ancient '->ancient
  88            dest)))
  89
  90 (defun to-component-features ()
  91   (let (dest)
  92     (dolist (feature (char-attribute-list))
  93       (when (string-match "^->.*[@/]component\\(/[^*/]+\\)*$"
  94                           (symbol-name feature))
  95         (push feature dest)))
  96     dest))
  97
  98 ;;;###autoload
  99 (defun char-component-variants (char)
 100   (let ((dest (list char))
 101         ret uchr)
 102     (dolist (feature (to-component-features))
 103       (if (setq ret (get-char-attribute char feature))
 104           (dolist (c ret)
 105             (setq dest (union dest (char-component-variants c))))))
 106     (cond
 107      ;; ((setq ret (some (lambda (feature)
 108      ;;                    (get-char-attribute char feature))
 109      ;;                  (to-component-features)))
 110      ;;  (dolist (c ret)
 111      ;;    (setq dest (union dest (char-component-variants c))))
 112      ;;  )
 113      ((setq ret (get-char-attribute char '->ucs-unified))
 114       (setq dest (cons char ret))
 115       (dolist (c dest)
 116         (setq dest (union dest
 117                           (some (lambda (feature)
 118                                   (get-char-attribute c feature))
 119                                 (of-component-features))
 120                           )))
 121       )
 122      ((and (setq ret (get-char-attribute char '=>ucs))
 123            (setq uchr (decode-char '=ucs ret)))
 124       (setq dest (cons uchr (char-variants uchr)))
 125       (dolist (c dest)
 126         (setq dest (union dest
 127                           (some (lambda (feature)
 128                                   (get-char-attribute c feature))
 129                                 (of-component-features))
 130                           )))
 131       )
 132      (t
 133       (map-char-family
 134        (lambda (c)
 135          (unless (memq c dest)
 136            (setq dest (cons c dest)))
 137          (setq dest
 138                (union dest
 139                       (some (lambda (feature)
 140                               (char-feature c feature))
 141                             (of-component-features))
 142                       ))
 143          nil)
 144        char)
 145       ))
 146     dest))
 147
 148 ;;;###autoload
 149 (defun ideographic-products-find (&rest components)
 150   (if (stringp (car components))
 151       (setq components (string-to-char-list (car components))))
 152   (let (dest products)
 153     (dolist (variant (char-component-variants (car components)))
 154       (setq products
 155             (union products
 156                    (get-char-attribute variant 'ideographic-products))))
 157     (setq dest products)
 158     (while (and dest
 159                 (setq components (cdr components)))
 160       (setq products nil)
 161       (dolist (variant (char-component-variants (car components)))
 162         (setq products
 163               (union products
 164                      (get-char-attribute variant 'ideographic-products))))
 165       (setq dest (intersection dest products)))
 166     dest))
 167
 168 (defun ideograph-find-products-with-variants (components &optional ignored-chars)
 169   (if (stringp components)
 170       (setq components (string-to-char-list components)))
 171   (let (dest products)
 172     (dolist (variant (char-component-variants (car components)))
 173       (setq products
 174             (union products
 175                    (set-difference
 176                     (get-char-attribute variant 'ideographic-products)
 177                     ignored-chars))))
 178     (setq dest products)
 179     (while (and dest
 180                 (setq components (cdr components)))
 181       (setq products nil)
 182       (dolist (variant (char-component-variants (car components)))
 183         (setq products
 184               (union products
 185                      (set-difference
 186                       (get-char-attribute variant 'ideographic-products)
 187                       ignored-chars))))
 188       (setq dest (intersection dest products)))
 189     dest))
 190
 191 (defun ideograph-find-products (components &optional ignored-chars)
 192   (if (stringp components)
 193       (setq components (string-to-char-list components)))
 194   (let (dest products)
 195     ;; (dolist (variant (char-component-variants (car components)))
 196     ;;   (setq products
 197     ;;         (union products
 198     ;;                (get-char-attribute variant 'ideographic-products))))
 199     ;; (setq dest products)
 200     (setq dest (get-char-attribute (car components) 'ideographic-products))
 201     (while (and dest
 202                 (setq components (cdr components)))
 203       ;; (setq products nil)
 204       ;; (dolist (variant (char-component-variants (car components)))
 205       ;;   (setq products
 206       ;;         (union products
 207       ;;                (get-char-attribute variant 'ideographic-products))))
 208       (setq products (get-char-attribute (car components) 'ideographic-products))
 209       (setq dest (intersection dest products)))
 210     dest))
 211
 212
 213 (defun ideographic-structure-char= (c1 c2)
 214   (or (eq c1 c2)
 215       (and c1 c2
 216            (let ((m1 (char-ucs c1))
 217                  (m2 (char-ucs c2)))
 218              (or (and m1 m2
 219                       (eq m1 m2))
 220                  (memq c1 (char-component-variants c2)))))))
 221
 222 (defun ideographic-structure-member-compare-components (component s-component)
 223   (let (ret)
 224     (cond ((char-ref= component s-component #'ideographic-structure-char=))
 225           ((listp s-component)
 226            (if (setq ret (assq 'ideographic-structure s-component))
 227                (ideographic-structure-member component (cdr ret))))
 228           ((setq ret (get-char-attribute s-component 'ideographic-structure))
 229            (ideographic-structure-member component ret)))))
 230
 231 ;;;###autoload
 232 (defun ideographic-structure-member (component structure)
 233   "Return non-nil if COMPONENT is included in STRUCTURE."
 234   (or (memq component structure)
 235       (progn
 236         (setq structure (cdr structure))
 237         (ideographic-structure-member-compare-components
 238          component (car structure)))
 239       (progn
 240         (setq structure (cdr structure))
 241         (ideographic-structure-member-compare-components
 242          component (car structure)))
 243       (progn
 244         (setq structure (cdr structure))
 245         (and (car structure)
 246              (ideographic-structure-member-compare-components
 247               component (car structure))))))
 248
 249
 250 ;;;###autoload
 251 (defun ideographic-structure-repertoire-p (structure components)
 252   "Return non-nil if STRUCTURE can be constructed by a subset of COMPONENTS."
 253   (and structure
 254        (let (ret s-component)
 255          (catch 'tag
 256            (while (setq structure (cdr structure))
 257              (setq s-component (car structure))
 258              (unless (characterp s-component)
 259                (if (setq ret (find-char s-component))
 260                    (setq s-component ret)))
 261              (unless (cond
 262                       ((listp s-component)
 263                        (if (setq ret (assq 'ideographic-structure s-component))
 264                            (ideographic-structure-repertoire-p
 265                             (cdr ret) components)))
 266                       ((member* s-component components
 267                                 :test #'ideographic-structure-char=))
 268                       ((setq ret
 269                              (get-char-attribute s-component
 270                                                  'ideographic-structure))
 271                        (ideographic-structure-repertoire-p ret components)))
 272                (throw 'tag nil)))
 273            t))))
 274
 275
 276 (defvar ids-find-result-buffer "*ids-chars*")
 277
 278 (defun ids-find-format-line (c v)
 279   (format "%c\t%s\t%s\n"
 280           c
 281           (or (let ((ucs (or (char-ucs c)
 282                              (encode-char c 'ucs))))
 283                 (if ucs
 284                     (cond ((<= ucs #xFFFF)
 285                            (format "    U+%04X" ucs))
 286                           ((<= ucs #x10FFFF)
 287                            (format "U-%08X" ucs)))))
 288               "          ")
 289           (or (ideographic-structure-to-ids v)
 290               v)))
 291
 292 (defun ids-insert-chars-including-components* (components
 293                                                &optional level ignored-chars)
 294   (unless level
 295     (setq level 0))
 296   (let (is i as bs)
 297     (dolist (c (sort (copy-tree (ideograph-find-products components
 298                                                          ignored-chars))
 299                      (lambda (a b)
 300                        (if (setq as (char-total-strokes a))
 301                            (if (setq bs (char-total-strokes b))
 302                                (if (= as bs)
 303                                    (ideograph-char< a b)
 304                                  (< as bs))
 305                              t)
 306                          (ideograph-char< a b)))))
 307       (unless (memq c ignored-chars)
 308         (setq is (char-feature c 'ideographic-structure))
 309         (setq i 0)
 310         (while (< i level)
 311           (insert "\t")
 312           (setq i (1+ i)))
 313         (insert (ids-find-format-line c is))
 314         (setq ignored-chars
 315               (ids-insert-chars-including-components*
 316                (char-to-string c) (1+ level)
 317                (cons c ignored-chars))))
 318       )
 319     )
 320   ignored-chars)
 321
 322 (defun ids-insert-chars-including-components (components
 323                                               &optional level ignored-chars)
 324   (unless level
 325     (setq level 0))
 326   (setq ignored-chars
 327         (nreverse
 328          (ids-insert-chars-including-components* components
 329                                                  level ignored-chars)))
 330   (let (is i as bs)
 331     (dolist (c ignored-chars)
 332       (dolist (vc (char-component-variants c))
 333         (unless (memq vc ignored-chars)
 334           (when (setq is (get-char-attribute vc 'ideographic-structure))
 335             (setq i 0)
 336             (while (< i level)
 337               (insert "\t")
 338               (setq i (1+ i)))
 339             (insert (ids-find-format-line vc is))
 340             (setq ignored-chars
 341                   (ids-insert-chars-including-components*
 342                    (char-to-string vc) (1+ level)
 343                    (cons vc ignored-chars)))))))
 344     (dolist (c (sort (copy-tree (ideograph-find-products-with-variants
 345                                  components ignored-chars))
 346                      (lambda (a b)
 347                        (if (setq as (char-total-strokes a))
 348                            (if (setq bs (char-total-strokes b))
 349                                (if (= as bs)
 350                                    (ideograph-char< a b)
 351                                  (< as bs))
 352                              t)
 353                          (ideograph-char< a b)))))
 354       (unless (memq c ignored-chars)
 355         (setq is (get-char-attribute c 'ideographic-structure))
 356         (setq i 0)
 357         (while (< i level)
 358           (insert "\t")
 359           (setq i (1+ i)))
 360         (insert (ids-find-format-line c is))
 361         (setq ignored-chars
 362               (ids-insert-chars-including-components*
 363                (char-to-string c) (1+ level)
 364                (cons c ignored-chars))))
 365       )
 366     )
 367   ignored-chars)
 368
 369 ;;;###autoload
 370 (defun ids-find-chars-including-components (components)
 371   "Search Ideographs whose structures have COMPONENTS."
 372   (interactive "sComponents : ")
 373   (with-current-buffer (get-buffer-create ids-find-result-buffer)
 374     (setq buffer-read-only nil)
 375     (erase-buffer)
 376     (ids-insert-chars-including-components components 0 nil)
 377     ;; (let ((ignored-chars
 378     ;;        (nreverse
 379     ;;         (ids-insert-chars-including-components components 0 nil
 380     ;;                                                #'ideograph-find-products)))
 381     ;;       rest)
 382     ;;   (setq rest ignored-chars)
 383     ;;   ;; (dolist (c rest)
 384     ;;   ;;   (setq ignored-chars
 385     ;;   ;;         (union ignored-chars
 386     ;;   ;;                (ids-insert-chars-including-components
 387     ;;   ;;                 (list c) 0 ignored-chars
 388     ;;   ;;                 #'ideograph-find-products-with-variants))))
 389     ;;   (ids-insert-chars-including-components components 0 ignored-chars
 390     ;;                                          #'ideograph-find-products-with-variants))
 391     (goto-char (point-min)))
 392   (view-buffer ids-find-result-buffer))
 393
 394 ;;;###autoload
 395 (define-obsolete-function-alias 'ideographic-structure-search-chars
 396   'ids-find-chars-including-components)
 397
 398 ;;;###autoload
 399 (defun ids-find-chars-covered-by-components (components)
 400   "Search Ideographs which structures are consisted by subsets of COMPONENTS."
 401   (interactive "sComponents: ")
 402   (if (stringp components)
 403       (setq components (string-to-char-list components)))
 404   (with-current-buffer (get-buffer-create ids-find-result-buffer)
 405     (setq buffer-read-only nil)
 406     (erase-buffer)
 407     (map-char-attribute
 408      (lambda (c v)
 409        (when (ideographic-structure-repertoire-p v components)
 410          (insert (ids-find-format-line c v))))
 411      'ideographic-structure)
 412     (goto-char (point-min)))
 413   (view-buffer ids-find-result-buffer))
 414
 415
 416 (defun ideographic-structure-merge-components-alist (ca1 ca2)
 417   (let ((dest-alist ca1)
 418         ret)
 419     (dolist (cell ca2)
 420       (if (setq ret (assq (car cell) dest-alist))
 421           (setcdr ret (+ (cdr ret)(cdr cell)))
 422         (setq dest-alist (cons cell dest-alist))))
 423     dest-alist))
 424
 425 (defun ideographic-structure-to-components-alist (structure)
 426   (apply #'ideographic-structure-to-components-alist* structure))
 427
 428 (defun ideographic-structure-to-components-alist* (operator component1 component2
 429                                                             &optional component3
 430                                                             &rest opts)
 431   (let (dest-alist ret)
 432     (setq dest-alist
 433           (cond ((characterp component1)
 434                  (unless (encode-char component1 'ascii)
 435                    (list (cons component1 1)))
 436                  )
 437                 ((setq ret (assq 'ideographic-structure component1))
 438                  (ideographic-structure-to-components-alist (cdr ret))
 439                  )
 440                 ((setq ret (find-char component1))
 441                  (list (cons ret 1))
 442                  )))
 443     (setq dest-alist
 444           (ideographic-structure-merge-components-alist
 445            dest-alist
 446            (cond ((characterp component2)
 447                   (unless (encode-char component2 'ascii)
 448                     (list (cons component2 1)))
 449                   )
 450                  ((setq ret (assq 'ideographic-structure component2))
 451                   (ideographic-structure-to-components-alist (cdr ret))
 452                   )
 453                  ((setq ret (find-char component2))
 454                   (list (cons ret 1))
 455                   ))))
 456     (if (memq operator '(?\u2FF2 ?\u2FF3))
 457         (ideographic-structure-merge-components-alist
 458          dest-alist
 459          (cond ((characterp component3)
 460                 (unless (encode-char component3 'ascii)
 461                   (list (cons component3 1)))
 462                 )
 463                ((setq ret (assq 'ideographic-structure component3))
 464                 (ideographic-structure-to-components-alist (cdr ret))
 465                 )
 466                ((setq ret (find-char component3))
 467                 (list (cons ret 1))
 468                 )))
 469       dest-alist)))
 470
 471 (defun ids-find-merge-variables (ve1 ve2)
 472   (cond ((eq ve1 t)
 473          ve2)
 474         ((eq ve2 t)
 475          ve1)
 476         (t
 477          (let ((dest-alist ve1)
 478                (rest ve2)
 479                cell ret)
 480            (while (and rest
 481                        (setq cell (car rest))
 482                        (if (setq ret (assq (car cell) ve1))
 483                            (eq (cdr ret)(cdr cell))
 484                          (setq dest-alist (cons cell dest-alist))))
 485              (setq rest (cdr rest)))
 486            (if rest
 487                nil
 488              dest-alist)))))
 489
 490 ;;;###autoload
 491 (defun ideographic-structure-equal (structure1 structure2)
 492   (let (dest-alist ret)
 493     (and (setq dest-alist (ideographic-structure-character=
 494                            (car structure1)(car structure2)))
 495          (setq ret (ideographic-structure-character=
 496                     (nth 1 structure1)(nth 1 structure2)))
 497          (setq dest-alist (ids-find-merge-variables dest-alist ret))
 498          (setq ret (ideographic-structure-character=
 499                     (nth 2 structure1)(nth 2 structure2)))
 500          (setq dest-alist (ids-find-merge-variables dest-alist ret))
 501          (if (memq (car structure1) '(?\u2FF2 ?\u2FF3))
 502              (and (setq ret (ideographic-structure-character=
 503                              (nth 3 structure1)(nth 3 structure2)))
 504                   (setq dest-alist (ids-find-merge-variables dest-alist ret)))
 505            dest-alist))))
 506
 507 ;;;###autoload
 508 (defun ideographic-structure-character= (c1 c2)
 509   (let (ret ret2)
 510     (cond ((characterp c1)
 511            (cond ((encode-char c1 'ascii)
 512                   (list (cons c1 c2))
 513                   )
 514                  ((characterp c2)
 515                   (if (encode-char c2 'ascii)
 516                       (list (cons c2 c1))
 517                     (eq c1 c2))
 518                   )
 519                  ((setq ret2 (find-char c2))
 520                   (eq c1 ret2)
 521                   )
 522                  ((setq ret2 (assq 'ideographic-structure c2))
 523                   (and (setq ret (get-char-attribute c1 'ideographic-structure))
 524                        (ideographic-structure-equal ret (cdr ret2)))
 525                   ))
 526            )
 527           ((setq ret (assq 'ideographic-structure c1))
 528            (cond ((characterp c2)
 529                   (if (encode-char c2 'ascii)
 530                       (list (cons c2 c1))
 531                     (and (setq ret2 (get-char-attribute c2 'ideographic-structure))
 532                          (ideographic-structure-equal (cdr ret) ret2)))
 533                   )
 534                  ((setq ret2 (find-char c2))
 535                   (and (setq ret2 (get-char-attribute ret2 'ideographic-structure))
 536                        (ideographic-structure-equal (cdr ret) ret2))
 537                   )
 538                  ((setq ret2 (assq 'ideographic-structure c2))
 539                   (ideographic-structure-equal (cdr ret)(cdr ret2))
 540                   ))
 541            )
 542           ((setq ret (find-char c1))
 543            (cond ((characterp c2)
 544                   (if (encode-char c2 'ascii)
 545                       (list (cons c2 c1))
 546                     (eq ret c2))
 547                   )
 548                  ((setq ret2 (find-char c2))
 549                   (eq ret ret2)
 550                   )
 551                  ((setq ret2 (assq 'ideographic-structure c2))
 552                   (and (setq ret (get-char-attribute ret 'ideographic-structure))
 553                        (ideographic-structure-equal ret (cdr ret2))
 554                        )))))))
 555
 556 ;;;###autoload
 557 (defun ideographic-structure-find-chars (structure)
 558   (apply #'ideographic-structure-find-chars* structure))
 559
 560 (defun ideographic-structure-find-chars* (operator component1 component2
 561                                                    &optional component3)
 562   (let ((comp-alist (ideographic-structure-to-components-alist*
 563                      operator component1 component2 component3))
 564         c1 c2 c3
 565         ret pl str
 566         var-alist)
 567     (dolist (pc (caar
 568                  (sort (mapcar (lambda (cell)
 569                                  (if (setq ret (get-char-attribute
 570                                                 (car cell) 'ideographic-products))
 571                                      (cons ret (length ret))
 572                                    (cons nil 0)))
 573                                comp-alist)
 574                        (lambda (a b)
 575                          (< (cdr a)(cdr b))))))
 576       (when (and (setq str (get-char-attribute pc 'ideographic-structure))
 577                  (setq var-alist
 578                        (ideographic-structure-character= (car str) operator))
 579                  (setq c1 (nth 1 str))
 580                  (setq ret (ideographic-structure-character= c1 component1))
 581                  (setq var-alist (ids-find-merge-variables var-alist ret))
 582                  (setq c2 (nth 2 str))
 583                  (setq ret (ideographic-structure-character= c2 component2))
 584                  (setq var-alist (ids-find-merge-variables var-alist ret))
 585                  (cond ((memq (car str) '(?\u2FF2 ?\u2FF3))
 586                         (setq c3 (nth 3 str))
 587                         (and (setq ret (ideographic-structure-character=
 588                                         c3 component3))
 589                              (ids-find-merge-variables var-alist ret))
 590                         )
 591                        (t var-alist)))
 592         (setq pl (cons pc pl))
 593         ))
 594     pl))
 595
 596 ;;;###autoload
 597 (defun ideographic-char-count-components (char component)
 598   (let ((dest 0)
 599         structure)
 600     (cond ((eq char component)
 601            1)
 602           ((setq structure (get-char-attribute char 'ideographic-structure))
 603            (dolist (cell (ideographic-structure-to-components-alist structure))
 604              (setq dest
 605                    (+ dest
 606                       (if (eq (car cell) char)
 607                           (cdr cell)
 608                         (* (ideographic-char-count-components (car cell) component)
 609                            (cdr cell))))))
 610            dest)
 611           (t
 612            0))))
 613
 614
 615 ;;;###autoload
 616 (defun ideographic-character-get-structure (character)
 617   "Return ideographic-structure of CHARACTER.
 618 CHARACTER can be a character or char-spec."
 619   (let (ret)
 620     (cond ((characterp character)
 621            (get-char-attribute character 'ideographic-structure)
 622            )
 623           ((setq ret (assq 'ideographic-structure character))
 624            (cdr ret)
 625            )
 626           ((setq ret (find-char character))
 627            (get-char-attribute ret 'ideographic-structure)
 628            ))))
 629
 630 ;;;###autoload
 631 (defun ideographic-char-match-component (char component)
 632   "Return non-nil if character CHAR has COMPONENT in ideographic-structure.
 633 COMPONENT can be a character or char-spec."
 634   (or (ideographic-structure-character= char component)
 635       (let ((str (ideographic-character-get-structure char)))
 636         (and str
 637              (or (ideographic-char-match-component (nth 1 str) component)
 638                  (ideographic-char-match-component (nth 2 str) component)
 639                  (if (memq (car str) '(?\u2FF2 ?\u2FF3))
 640                      (ideographic-char-match-component (nth 3 str) component)))))))
 641
 642 (defun ideographic-structure-char< (a b)
 643   (let ((sa (get-char-attribute a 'ideographic-structure))
 644         (sb (get-char-attribute b 'ideographic-structure))
 645         tsa tsb)
 646     (cond (sa
 647            (cond (sb
 648                   (setq tsa (char-total-strokes a)
 649                         tsb (char-total-strokes b))
 650                   (if tsa
 651                       (if tsb
 652                           (or (< tsa tsb)
 653                               (and (= tsa tsb)
 654                                    (ideograph-char< a b)))
 655                         t)
 656                     (if tsb
 657                         nil
 658                       (ideograph-char< a b))))
 659                  (t
 660                   nil))
 661            )
 662           (t
 663            (cond (sb
 664                   t)
 665                  (t
 666                   (setq tsa (char-total-strokes a)
 667                         tsb (char-total-strokes b))
 668                   (if tsa
 669                       (if tsb
 670                           (or (< tsa tsb)
 671                               (and (= tsa tsb)
 672                                    (ideograph-char< a b)))
 673                         t)
 674                     (if tsb
 675                         nil
 676                       (ideograph-char< a b)))
 677                   ))
 678            ))
 679     ))
 680
 681 (defun ideographic-chars-to-is-a-tree (chars)
 682   (let (comp char products others dest rest
 683              la lb)
 684     (setq chars (sort chars #'ideographic-structure-char<))
 685     (while chars
 686       (setq comp (pop chars)
 687             rest chars
 688             products nil
 689             others nil)
 690       (while rest
 691         (setq char (pop rest))
 692         (cond
 693          ((ideographic-char-match-component char comp)
 694           (push char products)
 695           )
 696          (t
 697           (push char others)
 698           )))
 699       (push (cons comp
 700                   ;; (nreverse products)
 701                   (if products
 702                       (sort (ideographic-chars-to-is-a-tree products)
 703                             (lambda (a b)
 704                               (setq la (length (cdr a))
 705                                     lb (length (cdr b)))
 706                               (or (> la lb)
 707                                   (and (= la lb)
 708                                        (ideograph-char< (car a) (car b))
 709                                        ;; (progn
 710                                        ;;   (setq tsa (char-total-strokes (car a))
 711                                        ;;         tsb (char-total-strokes (car b)))
 712                                        ;;   (if tsa
 713                                        ;;       (if tsb
 714                                        ;;           (or (< tsa tsb)
 715                                        ;;               (and (= tsa tsb)
 716                                        ;;                    (ideograph-char<
 717                                        ;;                     (car a) (car b))))
 718                                        ;;         t)
 719                                        ;;     (if tsb
 720                                        ;;         nil
 721                                        ;;       (ideograph-char< (car a) (car b)))))
 722                                        ))))
 723                     nil)
 724                   )
 725             dest)
 726       (setq chars others))
 727     dest))
 728
 729 (defun ids-find-chars-including-ids* (operator component1 component2
 730                                                &optional component3)
 731   (let ((comp-alist (ideographic-structure-to-components-alist*
 732                      operator component1 component2 component3))
 733         (comp-spec
 734          (list (list* 'ideographic-structure
 735                       operator component1 component2
 736                       (if component3
 737                           (list component3)))))
 738         ret str rest)
 739     (dolist (pc (caar
 740                  (sort (mapcar (lambda (cell)
 741                                  (if (setq ret (get-char-attribute
 742                                                 (car cell) 'ideographic-products))
 743                                      (cons ret (length ret))
 744                                    (cons nil 0)))
 745                                comp-alist)
 746                        (lambda (a b)
 747                          (< (cdr a)(cdr b))))))
 748       (when (and (every (lambda (cell)
 749                           (>= (ideographic-char-count-components pc (car cell))
 750                               (cdr cell)))
 751                         comp-alist)
 752                  (or (ideographic-char-match-component pc comp-spec)
 753                      (and (setq str (get-char-attribute pc 'ideographic-structure))
 754                           (ideographic-char-match-component
 755                            (list
 756                             (cons
 757                              'ideographic-structure
 758                              (functional-ideographic-structure-to-apparent-structure
 759                               str)))
 760                            comp-spec))))
 761         (push pc rest)))
 762     (ideographic-chars-to-is-a-tree rest)))
 763
 764 (defun ids-find-chars-including-ids (structure)
 765   (if (characterp structure)
 766       (setq structure (get-char-attribute structure 'ideographic-structure)))
 767   (apply #'ids-find-chars-including-ids* structure))
 768
 769 (defun functional-ideographic-structure-to-apparent-structure (structure)
 770   (ideographic-structure-compare-functional-and-apparent
 771    structure nil 'conversion-only)
 772   ;; (ideographic-structure-compact
 773   ;;  (let (enc enc-str enc2-str new-str)
 774   ;;    (cond
 775   ;;     ((eq (car structure) ?⿸)
 776   ;;      (setq enc (nth 1 structure))
 777   ;;      (when (setq enc-str
 778   ;;                  (cond ((characterp enc)
 779   ;;                         (get-char-attribute enc 'ideographic-structure)
 780   ;;                         )
 781   ;;                        ((consp enc)
 782   ;;                         (cdr (assq 'ideographic-structure enc))
 783   ;;                         )))
 784   ;;        (cond
 785   ;;         ((eq (car enc-str) ?⿰)
 786   ;;          (list ?⿰ (nth 1 enc-str)
 787   ;;                (list (list 'ideographic-structure
 788   ;;                            ?⿱
 789   ;;                            (nth 2 enc-str)
 790   ;;                            (nth 2 structure))))
 791   ;;          )
 792   ;;         ((and (eq (car enc-str) ?⿲)
 793   ;;               (memq (char-ucs (nth 1 enc-str)) '(#x4EBB #x2E85))
 794   ;;               (eq (nth 2 enc-str) ?丨))
 795   ;;          (list ?⿰
 796   ;;                (decode-char '=big5-cdp #x8B7A)
 797   ;;                (list (list 'ideographic-structure
 798   ;;                            ?⿱
 799   ;;                            (nth 3 enc-str)
 800   ;;                            (nth 2 structure))))
 801   ;;          )
 802   ;;         ((eq (car enc-str) ?⿱)
 803   ;;          (list ?⿱ (nth 1 enc-str)
 804   ;;                (list
 805   ;;                 (cons 'ideographic-structure
 806   ;;                       (or (functional-ideographic-structure-to-apparent-structure
 807   ;;                            (setq new-str
 808   ;;                                  (list
 809   ;;                                   (cond
 810   ;;                                    ((characterp (nth 2 enc-str))
 811   ;;                                     (if (or (eq (encode-char
 812   ;;                                                  (nth 2 enc-str)
 813   ;;                                                  '=>ucs@component)
 814   ;;                                                 #x20087)
 815   ;;                                             (eq (encode-char
 816   ;;                                                  (nth 2 enc-str)
 817   ;;                                                  '=>ucs@component)
 818   ;;                                                 #x5382)
 819   ;;                                             (eq (encode-char
 820   ;;                                                  (nth 2 enc-str)
 821   ;;                                                  '=>ucs@component)
 822   ;;                                                 #x4E06)
 823   ;;                                             (eq (encode-char
 824   ;;                                                  (nth 2 enc-str)
 825   ;;                                                  '=big5-cdp)
 826   ;;                                                 #x89CE)
 827   ;;                                             (eq (encode-char
 828   ;;                                                  (nth 2 enc-str)
 829   ;;                                                  '=>big5-cdp)
 830   ;;                                                 #x88E2)
 831   ;;                                             (eq (encode-char
 832   ;;                                                  (nth 2 enc-str)
 833   ;;                                                  '=big5-cdp)
 834   ;;                                                 #x88AD)
 835   ;;                                             (eq (or (encode-char
 836   ;;                                                      (nth 2 enc-str)
 837   ;;                                                      '=>big5-cdp)
 838   ;;                                                     (encode-char
 839   ;;                                                      (nth 2 enc-str)
 840   ;;                                                      '=big5-cdp-itaiji-001))
 841   ;;                                                 #x8766)
 842   ;;                                             (eq (car
 843   ;;                                                  (get-char-attribute
 844   ;;                                                   (nth 2 enc-str)
 845   ;;                                                   'ideographic-structure))
 846   ;;                                                 ?⿸))
 847   ;;                                         ?⿸
 848   ;;                                       ?⿰))
 849   ;;                                    ((eq (car
 850   ;;                                          (cdr
 851   ;;                                           (assq 'ideographic-structure
 852   ;;                                                 (nth 2 enc-str))))
 853   ;;                                         ?⿸)
 854   ;;                                     ?⿸)
 855   ;;                                    (t
 856   ;;                                     ?⿰))
 857   ;;                                   (nth 2 enc-str)
 858   ;;                                   (nth 2 structure)
 859   ;;                                   )))
 860   ;;                           new-str))))
 861   ;;          )
 862   ;;         ((eq (car enc-str) ?⿸)
 863   ;;          (list ?⿸ (nth 1 enc-str)
 864   ;;                (list
 865   ;;                 (cons 'ideographic-structure
 866   ;;                       (setq new-str
 867   ;;                             (list
 868   ;;                              (cond
 869   ;;                               ((characterp (nth 2 enc-str))
 870   ;;                                (if (memq (char-ucs (nth 2 enc-str))
 871   ;;                                          '(#x5F73))
 872   ;;                                    ?⿰
 873   ;;                                  ?⿱)
 874   ;;                                )
 875   ;;                               (t
 876   ;;                                ?⿱))
 877   ;;                              (nth 2 enc-str)
 878   ;;                              (nth 2 structure))))))
 879   ;;          )))
 880   ;;      )
 881   ;;     ((eq (car structure) ?⿹)
 882   ;;      (setq enc (nth 1 structure))
 883   ;;      (when (setq enc-str
 884   ;;                  (cond ((characterp enc)
 885   ;;                         (get-char-attribute enc 'ideographic-structure)
 886   ;;                         )
 887   ;;                        ((consp enc)
 888   ;;                         (cdr (assq 'ideographic-structure enc))
 889   ;;                         )))
 890   ;;        (cond
 891   ;;         ((eq (car enc-str) ?⿰)
 892   ;;          (list ?⿰
 893   ;;                (list (list 'ideographic-structure
 894   ;;                            ?⿱
 895   ;;                            (nth 1 enc-str)
 896   ;;                            (nth 2 structure)))
 897   ;;                (nth 2 enc-str))
 898   ;;          )))
 899   ;;      )
 900   ;;     ((eq (get-char-attribute (car structure) '=ucs-itaiji-001) #x2FF6)
 901   ;;      (setq enc (nth 1 structure))
 902   ;;      (when (setq enc-str
 903   ;;                  (cond ((characterp enc)
 904   ;;                         (get-char-attribute enc 'ideographic-structure)
 905   ;;                         )
 906   ;;                        ((consp enc)
 907   ;;                         (cdr (assq 'ideographic-structure enc))
 908   ;;                         )))
 909   ;;        (cond
 910   ;;         ((eq (car enc-str) ?⿺)
 911   ;;          (list ?⿺
 912   ;;                (list (list 'ideographic-structure
 913   ;;                            ?⿱
 914   ;;                            (nth 2 structure)
 915   ;;                            (nth 1 enc-str)))
 916   ;;                (nth 2 enc-str))
 917   ;;          )
 918   ;;         ((eq (car enc-str) ?⿱)
 919   ;;          (list ?⿱
 920   ;;                (list (list 'ideographic-structure
 921   ;;                            ?⿰
 922   ;;                            (nth 2 structure)
 923   ;;                            (nth 1 enc-str)))
 924   ;;                (nth 2 enc-str))
 925   ;;          ))
 926   ;;        )
 927   ;;      )
 928   ;;     ((eq (car structure) ?⿴)
 929   ;;      (setq enc (nth 1 structure))
 930   ;;      (when (setq enc-str
 931   ;;                  (cond ((characterp enc)
 932   ;;                         (get-char-attribute enc 'ideographic-structure)
 933   ;;                         )
 934   ;;                        ((consp enc)
 935   ;;                         (cdr (assq 'ideographic-structure enc))
 936   ;;                         )))
 937   ;;        (cond
 938   ;;         ((eq (car enc-str) ?⿱)
 939   ;;          (cond
 940   ;;           ((and (characterp (nth 2 enc-str))
 941   ;;                 (or (memq (char-ucs (nth 2 enc-str)) '(#x56D7 #x5F51 #x897F))
 942   ;;                     (eq (char-feature (nth 2 enc-str) '=>big5-cdp)
 943   ;;                         #x87A5)))
 944   ;;            (list ?⿱
 945   ;;                  (nth 1 enc-str)
 946   ;;                  (list (list 'ideographic-structure
 947   ;;                              ?⿴
 948   ;;                              (nth 2 enc-str)
 949   ;;                              (nth 2 structure)))
 950   ;;                  )
 951   ;;            )
 952   ;;           ((and (characterp (nth 2 enc-str))
 953   ;;                 (eq (char-ucs (nth 2 enc-str)) #x51F5))
 954   ;;            (list ?⿱
 955   ;;                  (nth 1 enc-str)
 956   ;;                  (list (list 'ideographic-structure
 957   ;;                              ?⿶
 958   ;;                              (nth 2 enc-str)
 959   ;;                              (nth 2 structure)))
 960   ;;                  )
 961   ;;            )
 962   ;;           ((and (characterp (nth 1 enc-str))
 963   ;;                 (eq (char-feature (nth 1 enc-str) '=>ucs@component)
 964   ;;                     #x300E6))
 965   ;;            (list ?⿱
 966   ;;                  (list (list 'ideographic-structure
 967   ;;                              ?⿵
 968   ;;                              (nth 1 enc-str)
 969   ;;                              (nth 2 structure)))
 970   ;;                  (nth 2 enc-str))
 971   ;;            )
 972   ;;           (t
 973   ;;            (list ?⿳
 974   ;;                  (nth 1 enc-str)
 975   ;;                  (nth 2 structure)
 976   ;;                  (nth 2 enc-str))
 977   ;;            ))
 978   ;;          ))
 979   ;;        )
 980   ;;      )
 981   ;;     ((eq (car structure) ?⿶)
 982   ;;      (setq enc (nth 1 structure))
 983   ;;      (when (setq enc-str
 984   ;;                  (cond ((characterp enc)
 985   ;;                         (get-char-attribute enc 'ideographic-structure)
 986   ;;                         )
 987   ;;                        ((consp enc)
 988   ;;                         (cdr (assq 'ideographic-structure enc))
 989   ;;                         )))
 990   ;;        (cond
 991   ;;         ((eq (car enc-str) ?⿱)
 992   ;;          (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
 993   ;;          (when (and enc2-str
 994   ;;                     (eq (car enc2-str) ?⿰))
 995   ;;            (list ?⿱
 996   ;;                  (list (list 'ideographic-structure
 997   ;;                              ?⿲
 998   ;;                              (nth 1 enc2-str)
 999   ;;                              (nth 2 structure)
1000   ;;                              (nth 2 enc2-str)))
1001   ;;                  (nth 2 enc-str)))
1002   ;;          )
1003   ;;         ((eq (car enc-str) ?⿳)
1004   ;;          (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
1005   ;;          (when (and enc2-str
1006   ;;                     (eq (car enc2-str) ?⿰))
1007   ;;            (list ?⿳
1008   ;;                  (list (list 'ideographic-structure
1009   ;;                              ?⿲
1010   ;;                              (nth 1 enc2-str)
1011   ;;                              (nth 2 structure)
1012   ;;                              (nth 2 enc2-str)))
1013   ;;                  (nth 2 enc-str)
1014   ;;                  (nth 3 enc-str)))
1015   ;;          )
1016   ;;         ((eq (car enc-str) ?⿲)
1017   ;;          (list ?⿲
1018   ;;                (nth 1 enc-str)
1019   ;;                (list (list 'ideographic-structure
1020   ;;                            ?⿱
1021   ;;                            (nth 2 structure)
1022   ;;                            (nth 2 enc-str)))
1023   ;;                (nth 3 enc-str))
1024   ;;          )
1025   ;;         ((eq (car enc-str) ?⿴)
1026   ;;          (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
1027   ;;          (when (and enc2-str
1028   ;;                     (eq (car enc2-str) ?⿰))
1029   ;;            (list ?⿲
1030   ;;                  (nth 1 enc2-str)
1031   ;;                  (list (list 'ideographic-structure
1032   ;;                              ?⿱
1033   ;;                              (nth 2 structure)
1034   ;;                              (nth 2 enc-str)))
1035   ;;                  (nth 2 enc2-str)))
1036   ;;          )))
1037   ;;      )
1038   ;;     ((eq (car structure) ?⿵)
1039   ;;      (setq enc (nth 1 structure))
1040   ;;      (when (setq enc-str
1041   ;;                  (cond ((characterp enc)
1042   ;;                         (get-char-attribute enc 'ideographic-structure)
1043   ;;                         )
1044   ;;                        ((consp enc)
1045   ;;                         (cdr (assq 'ideographic-structure enc))
1046   ;;                         )))
1047   ;;        (cond
1048   ;;         ((eq (car enc-str) ?⿱)
1049   ;;          (setq enc2-str (ideographic-character-get-structure (nth 2 enc-str)))
1050   ;;          (when (and enc2-str
1051   ;;                     (eq (car enc2-str) ?⿰))
1052   ;;            (list ?⿱
1053   ;;                  (nth 1 enc-str)
1054   ;;                  (list (list 'ideographic-structure
1055   ;;                              ?⿲
1056   ;;                              (nth 1 enc2-str)
1057   ;;                              (nth 2 structure)
1058   ;;                              (nth 2 enc2-str)))))
1059   ;;          )
1060   ;;         ((eq (car enc-str) ?⿳)
1061   ;;          (setq enc2-str (ideographic-character-get-structure (nth 3 enc-str)))
1062   ;;          (when (and enc2-str
1063   ;;                     (eq (car enc2-str) ?⿰))
1064   ;;            (list ?⿳
1065   ;;                  (nth 1 enc-str)
1066   ;;                  (nth 2 enc-str)
1067   ;;                  (list (list 'ideographic-structure
1068   ;;                              ?⿲
1069   ;;                              (nth 1 enc2-str)
1070   ;;                              (nth 2 structure)
1071   ;;                              (nth 2 enc2-str)))))
1072   ;;          )
1073   ;;         ((eq (car enc-str) ?⿲)
1074   ;;          (list ?⿲
1075   ;;                (nth 1 enc-str)
1076   ;;                (list (list 'ideographic-structure
1077   ;;                            ?⿱
1078   ;;                            (nth 2 enc-str)
1079   ;;                            (nth 2 structure)))
1080   ;;                (nth 3 enc-str))
1081   ;;          )
1082   ;;         ((eq (car enc-str) ?⿴)
1083   ;;          (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
1084   ;;          (when (and enc2-str
1085   ;;                     (eq (car enc2-str) ?⿰))
1086   ;;            (list ?⿲
1087   ;;                  (nth 1 enc2-str)
1088   ;;                  (list (list 'ideographic-structure
1089   ;;                              ?⿱
1090   ;;                              (nth 2 enc-str)
1091   ;;                              (nth 2 structure)))
1092   ;;                  (nth 2 enc2-str)))
1093   ;;          )))
1094   ;;      )
1095   ;;     ((eq (car structure) ?⿻)
1096   ;;      (setq enc (nth 1 structure))
1097   ;;      (when (setq enc-str
1098   ;;                  (cond ((characterp enc)
1099   ;;                         (get-char-attribute enc 'ideographic-structure)
1100   ;;                         )
1101   ;;                        ((consp enc)
1102   ;;                         (cdr (assq 'ideographic-structure enc))
1103   ;;                         )))
1104   ;;        (cond
1105   ;;         ((eq (car enc-str) ?⿱)
1106   ;;          (list ?⿳
1107   ;;                (nth 1 enc-str)
1108   ;;                (nth 2 structure)
1109   ;;                (nth 2 enc-str))
1110   ;;          )))
1111   ;;      ))
1112   ;;    ))
1113   )
1114
1115 ;;;###autoload
1116 (defun ideographic-structure-compact (structure)
1117   (let ((rest structure)
1118         cell
1119         ret dest sub)
1120     (while rest
1121       (setq cell (pop rest))
1122       (cond
1123        ((and (consp cell)
1124              (cond ((setq ret (assq 'ideographic-structure cell))
1125                     (setq sub (cdr ret))
1126                     )
1127                    ((atom (car cell))
1128                     (setq sub cell)
1129                     )))
1130         (setq cell
1131               (if (setq ret (ideographic-structure-find-chars sub))
1132                   (car ret)
1133                 (list (cons 'ideographic-structure sub))))
1134         ))
1135       (setq dest (cons cell dest)))
1136     (nreverse dest)))
1137
1138 (defun ideographic-structure-compare-functional-and-apparent (structure
1139                                                               &optional char
1140                                                               conversion-only)
1141   (let (enc enc-str enc2-str new-str new-str-c f-res a-res code ret)
1142     (cond
1143      ((eq (car structure) ?⿸)
1144       (setq enc (nth 1 structure))
1145       (when (setq enc-str
1146                   (cond ((characterp enc)
1147                          (get-char-attribute enc 'ideographic-structure)
1148                          )
1149                         ((consp enc)
1150                          (cdr (assq 'ideographic-structure enc))
1151                          )))
1152         (cond
1153          ((eq (car enc-str) ?⿰)
1154           (unless conversion-only
1155             (setq f-res (ids-find-chars-including-ids enc-str)))
1156           (setq new-str (list ?⿱
1157                               (nth 2 enc-str)
1158                               (nth 2 structure)))
1159           (setq new-str-c
1160                 (if (setq ret (ideographic-structure-find-chars new-str))
1161                     (car ret)
1162                   (list (cons 'ideographic-structure new-str))))
1163           (if conversion-only
1164               (list ?⿰ (nth 1 enc-str) new-str-c)
1165             (setq a-res (ids-find-chars-including-ids new-str))
1166             (list enc
1167                   f-res
1168                   new-str-c
1169                   a-res
1170                   (list ?⿰ (nth 1 enc-str) new-str-c)
1171                   111))
1172           )
1173          ((and (eq (car enc-str) ?⿲)
1174                (memq (char-ucs (nth 1 enc-str)) '(#x4EBB #x2E85))
1175                (eq (nth 2 enc-str) ?丨))
1176           (unless conversion-only
1177             (setq f-res (ids-find-chars-including-ids enc-str)))
1178           (setq new-str (list ?⿱
1179                               (nth 3 enc-str)
1180                               (nth 2 structure)))
1181           (setq new-str-c
1182                 (if (setq ret (ideographic-structure-find-chars new-str))
1183                     (car ret)
1184                   (list (cons 'ideographic-structure new-str))))
1185           (if conversion-only
1186               (list ?⿰ (decode-char '=big5-cdp #x8B7A) new-str-c)
1187             (setq a-res (ids-find-chars-including-ids new-str))
1188             (list enc
1189                   f-res
1190                   new-str-c
1191                   a-res
1192                   (list ?⿰ (decode-char '=big5-cdp #x8B7A) new-str-c)
1193                   112))
1194           )
1195          ((eq (car enc-str) ?⿱)
1196           (unless conversion-only
1197             (setq f-res (ids-find-chars-including-ids enc-str)))
1198           (setq new-str
1199                 (list
1200                  (cond
1201                   ((characterp (nth 2 enc-str))
1202                    (if (or (eq (encode-char (nth 2 enc-str) '=>ucs@component)
1203                                #x20087)
1204                            (eq (encode-char (nth 2 enc-str) '=>ucs@component)
1205                                #x5382)
1206                            (eq (encode-char (nth 2 enc-str) '=>ucs@component)
1207                                #x4E06)
1208                            (eq (encode-char (nth 2 enc-str) '=big5-cdp)
1209                                #x89CE)
1210                            (eq (encode-char (nth 2 enc-str) '=>big5-cdp)
1211                                #x88E2)
1212                            (eq (encode-char (nth 2 enc-str) '=big5-cdp)
1213                                #x88AD)
1214                            (eq (or (encode-char (nth 2 enc-str) '=>big5-cdp)
1215                                    (encode-char (nth 2 enc-str) '=big5-cdp-itaiji-001))
1216                                #x8766)
1217                            (eq (car (get-char-attribute (nth 2 enc-str)
1218                                                         'ideographic-structure))
1219                                ?⿸))
1220                        ?⿸
1221                      ?⿰))
1222                   ((eq (car (cdr (assq 'ideographic-structure (nth 2 enc-str))))
1223                        ?⿸)
1224                    ?⿸)
1225                   (t
1226                    ?⿰))
1227                  (nth 2 enc-str)
1228                  (nth 2 structure)))
1229           (setq new-str-c
1230                 (if (setq ret (ideographic-structure-find-chars new-str))
1231                     (car ret)
1232                   (list (cons 'ideographic-structure new-str))))
1233           (if conversion-only
1234               (list ?⿱ (nth 1 enc-str) new-str-c)
1235             (setq a-res (ids-find-chars-including-ids new-str))
1236             (list enc
1237                   f-res
1238                   new-str-c
1239                   a-res
1240                   (list ?⿱ (nth 1 enc-str) new-str-c)
1241                   (if (eq (car new-str) ?⿸)
1242                       121
1243                     122)))
1244           )
1245          ((eq (car enc-str) ?⿸)
1246           (unless conversion-only
1247             (setq f-res (ids-find-chars-including-ids enc-str)))
1248           (setq new-str (list (cond
1249                                ((characterp (nth 2 enc-str))
1250                                 (if (memq (char-ucs (nth 2 enc-str))
1251                                           '(#x5F73))
1252                                     ?⿰
1253                                   ?⿱)
1254                                 )
1255                                (t
1256                                 ?⿱))
1257                               (nth 2 enc-str)
1258                               (nth 2 structure)))
1259           (setq new-str-c
1260                 (if (setq ret (ideographic-structure-find-chars new-str))
1261                     (car ret)
1262                   (list (cons 'ideographic-structure new-str))))
1263           (if conversion-only
1264               (list ?⿸ (nth 1 enc-str) new-str-c)
1265             (setq a-res (ids-find-chars-including-ids new-str))
1266             (list enc
1267                   f-res
1268                   new-str-c
1269                   a-res
1270                   (list ?⿸ (nth 1 enc-str) new-str-c)
1271                   (if (eq (car new-str) ?⿰)
1272                       131
1273                     132)))
1274           )))
1275       )
1276      ((eq (car structure) ?⿹)
1277       (setq enc (nth 1 structure))
1278       (when (setq enc-str
1279                   (cond ((characterp enc)
1280                          (get-char-attribute enc 'ideographic-structure)
1281                          )
1282                         ((consp enc)
1283                          (cdr (assq 'ideographic-structure enc))
1284                          )))
1285         (cond
1286          ((eq (car enc-str) ?⿰)
1287           (unless conversion-only
1288             (setq f-res (ids-find-chars-including-ids enc-str)))
1289           (setq new-str (list ?⿱
1290                               (nth 1 enc-str)
1291                               (nth 2 structure)))
1292           (setq new-str-c
1293                 (if (setq ret (ideographic-structure-find-chars new-str))
1294                     (car ret)
1295                   (list (cons 'ideographic-structure new-str))))
1296           (if conversion-only
1297               (list ?⿰ new-str-c (nth 2 enc-str))
1298             (setq a-res (ids-find-chars-including-ids new-str))
1299             (list enc
1300                   f-res
1301                   new-str-c
1302                   a-res
1303                   (list ?⿰ new-str-c (nth 2 enc-str))
1304                   210))
1305           )))
1306       )
1307      ((eq (get-char-attribute (car structure) '=ucs-itaiji-001) #x2FF6)
1308       (setq enc (nth 1 structure))
1309       (when (setq enc-str
1310                   (cond ((characterp enc)
1311                          (get-char-attribute enc 'ideographic-structure)
1312                          )
1313                         ((consp enc)
1314                          (cdr (assq 'ideographic-structure enc))
1315                          )))
1316         (cond
1317          ((eq (car enc-str) ?⿺)
1318           (unless conversion-only
1319             (setq f-res (ids-find-chars-including-ids enc-str)))
1320           (setq new-str (list ?⿱
1321                               (nth 2 structure)
1322                               (nth 1 enc-str)))
1323           (setq new-str-c
1324                 (if (setq ret (ideographic-structure-find-chars new-str))
1325                     (car ret)
1326                   (list (cons 'ideographic-structure new-str))))
1327           (if conversion-only
1328               (list ?⿺ new-str-c (nth 2 enc-str))
1329             (setq a-res (ids-find-chars-including-ids new-str))
1330             (list enc
1331                   f-res
1332                   new-str-c
1333                   a-res
1334                   (list ?⿺ new-str-c (nth 2 enc-str))
1335                   310))
1336           )
1337          ((eq (car enc-str) ?⿱)
1338           (unless conversion-only
1339             (setq f-res (ids-find-chars-including-ids enc-str)))
1340           (setq new-str (list ?⿰
1341                               (nth 2 structure)
1342                               (nth 1 enc-str)))
1343           (setq new-str-c
1344                 (if (setq ret (ideographic-structure-find-chars new-str))
1345                     (car ret)
1346                   (list (cons 'ideographic-structure new-str))))
1347           (if conversion-only
1348               (list ?⿱ new-str-c (nth 2 enc-str))
1349             (setq a-res (ids-find-chars-including-ids new-str))
1350             (list enc
1351                   f-res
1352                   new-str-c
1353                   a-res
1354                   (list ?⿱ new-str-c (nth 2 enc-str))
1355                   320))
1356           ))
1357         )
1358       )
1359      ((eq (car structure) ?⿴)
1360       (setq enc (nth 1 structure))
1361       (when (setq enc-str
1362                   (cond ((characterp enc)
1363                          (get-char-attribute enc 'ideographic-structure)
1364                          )
1365                         ((consp enc)
1366                          (cdr (assq 'ideographic-structure enc))
1367                          )))
1368         (cond
1369          ((eq (car enc-str) ?⿱)
1370           (cond
1371            ((and (characterp (nth 2 enc-str))
1372                  (or (memq (char-ucs (nth 2 enc-str)) '(#x56D7 #x5F51 #x897F))
1373                      (eq (char-feature (nth 2 enc-str) '=>big5-cdp)
1374                          #x87A5)))
1375             (unless conversion-only
1376               (setq f-res (ids-find-chars-including-ids enc-str)))
1377             (setq new-str (list ?⿴
1378                                 (nth 2 enc-str)
1379                                 (nth 2 structure)))
1380             (setq new-str-c
1381                   (if (setq ret (ideographic-structure-find-chars new-str))
1382                       (car ret)
1383                     (list (cons 'ideographic-structure new-str))))
1384             (if conversion-only
1385                 (list ?⿱ (nth 1 enc-str) new-str-c)
1386               (setq a-res (ids-find-chars-including-ids new-str))
1387               (list enc
1388                     f-res
1389                     new-str-c
1390                     a-res
1391                     (list ?⿱ (nth 1 enc-str) new-str-c)
1392                     411))
1393             )
1394            ((and (characterp (nth 2 enc-str))
1395                  (eq (char-ucs (nth 2 enc-str)) #x51F5))
1396             (unless conversion-only
1397               (setq f-res (ids-find-chars-including-ids enc-str)))
1398             (setq new-str (list ?⿶
1399                                 (nth 2 enc-str)
1400                                 (nth 2 structure)))
1401             (setq new-str-c
1402                   (if (setq ret (ideographic-structure-find-chars new-str))
1403                       (car ret)
1404                     (list (cons 'ideographic-structure new-str))))
1405             (if conversion-only
1406                 (list ?⿱ (nth 1 enc-str) new-str-c)
1407               (setq a-res (ids-find-chars-including-ids new-str))
1408               (list enc
1409                     f-res
1410                     new-str-c
1411                     a-res
1412                     (list ?⿱ (nth 1 enc-str) new-str-c)
1413                     412))
1414             )
1415            ((and (characterp (nth 1 enc-str))
1416                  (eq (char-feature (nth 1 enc-str) '=>ucs@component)
1417                      #x300E6))
1418             (unless conversion-only
1419               (setq f-res (ids-find-chars-including-ids enc-str)))
1420             (setq new-str (list ?⿵
1421                                 (nth 1 enc-str)
1422                                 (nth 2 structure)))
1423             (setq new-str-c
1424                   (if (setq ret (ideographic-structure-find-chars new-str))
1425                       (car ret)
1426                     (list (cons 'ideographic-structure new-str))))
1427             (if conversion-only
1428                 (list ?⿱ new-str-c (nth 2 enc-str))
1429               (setq a-res (ids-find-chars-including-ids new-str))
1430               (list enc
1431                     f-res
1432                     new-str-c
1433                     a-res
1434                     (list ?⿱ new-str-c (nth 2 enc-str))
1435                     413))
1436             )
1437            (t
1438             (unless conversion-only
1439               (setq f-res (ids-find-chars-including-ids enc-str)))
1440             (setq new-str (list ?⿱ (nth 2 structure) (nth 2 enc-str)))
1441             (setq new-str-c
1442                   (if (setq ret (ideographic-structure-find-chars new-str))
1443                       (car ret)
1444                     (list (cons 'ideographic-structure new-str))))
1445             (if conversion-only
1446                 (list ?⿱ (nth 1 enc-str) new-str-c)
1447               (setq a-res (ids-find-chars-including-ids new-str))
1448               (list enc
1449                     f-res
1450                     new-str-c
1451                     a-res
1452                     (list ?⿱ (nth 1 enc-str) new-str-c)
1453                     414))
1454             ))
1455           ))
1456         )
1457       )
1458      ((eq (car structure) ?⿶)
1459       (setq enc (nth 1 structure))
1460       (when (setq enc-str
1461                   (cond ((characterp enc)
1462                          (get-char-attribute enc 'ideographic-structure)
1463                          )
1464                         ((consp enc)
1465                          (cdr (assq 'ideographic-structure enc))
1466                          )))
1467         (cond
1468          ((eq (car enc-str) ?⿱)
1469           (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
1470           (when (and enc2-str
1471                      (eq (car enc2-str) ?⿰))
1472             (unless conversion-only
1473               (setq f-res (ids-find-chars-including-ids enc-str)))
1474             (setq new-str (list ?⿲
1475                                 (nth 1 enc2-str)
1476                                 (nth 2 structure)
1477                                 (nth 2 enc2-str)))
1478             (setq new-str-c
1479                   (if (setq ret (ideographic-structure-find-chars new-str))
1480                       (car ret)
1481                     (list (cons 'ideographic-structure new-str))))
1482             (if conversion-only
1483                 (list ?⿱ new-str-c (nth 2 enc-str))
1484               (setq a-res (ids-find-chars-including-ids new-str))
1485               (list enc
1486                     f-res
1487                     new-str-c
1488                     a-res
1489                     (list ?⿱ new-str-c (nth 2 enc-str))
1490                     511))
1491             )
1492           )
1493          ((eq (car enc-str) ?⿳)
1494           (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
1495           (when (and enc2-str
1496                      (eq (car enc2-str) ?⿰))
1497             (unless conversion-only
1498               (setq f-res (ids-find-chars-including-ids enc-str)))
1499             (setq new-str (list ?⿲
1500                                 (nth 1 enc2-str)
1501                                 (nth 2 structure)
1502                                 (nth 2 enc2-str)))
1503             (setq new-str-c
1504                   (if (setq ret (ideographic-structure-find-chars new-str))
1505                       (car ret)
1506                     (list (cons 'ideographic-structure new-str))))
1507             (if conversion-only
1508                 (list ?⿳ new-str-c (nth 2 enc-str) (nth 3 enc-str))
1509               (setq a-res (ids-find-chars-including-ids new-str))
1510               (list enc
1511                     f-res
1512                     new-str-c
1513                     a-res
1514                     (list ?⿳ new-str-c (nth 2 enc-str) (nth 3 enc-str))
1515                     512))
1516             )
1517           )
1518          ((eq (car enc-str) ?⿲)
1519           (unless conversion-only
1520             (setq f-res (ids-find-chars-including-ids enc-str)))
1521           (setq new-str (list ?⿱
1522                               (nth 2 structure)
1523                               (nth 2 enc-str)))
1524           (setq new-str-c
1525                 (if (setq ret (ideographic-structure-find-chars new-str))
1526                     (car ret)
1527                   (list (cons 'ideographic-structure new-str))))
1528           (if conversion-only
1529               (list ?⿲ (nth 1 enc-str) new-str-c (nth 3 enc-str))
1530             (setq a-res (ids-find-chars-including-ids new-str))
1531             (list enc
1532                   f-res
1533                   new-str-c
1534                   a-res
1535                   (list ?⿲ (nth 1 enc-str) new-str-c (nth 3 enc-str))
1536                   520))
1537           )
1538          ((eq (car enc-str) ?⿴)
1539           (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
1540           (when (and enc2-str
1541                      (eq (car enc2-str) ?⿰))
1542             (unless conversion-only
1543               (setq f-res (ids-find-chars-including-ids enc-str)))
1544             (setq new-str (list ?⿱
1545                                 (nth 2 structure)
1546                                 (nth 2 enc-str)))
1547             (setq new-str-c
1548                   (if (setq ret (ideographic-structure-find-chars new-str))
1549                       (car ret)
1550                     (list (cons 'ideographic-structure new-str))))
1551             (if conversion-only
1552                 (list ?⿲ (nth 1 enc2-str) new-str-c (nth 2 enc2-str))
1553               (setq a-res (ids-find-chars-including-ids new-str))
1554               (list enc
1555                     f-res
1556                     new-str-c
1557                     a-res
1558                     (list ?⿲ (nth 1 enc2-str) new-str-c (nth 2 enc2-str))
1559                     530))
1560             )
1561           )))
1562       )
1563      ((eq (car structure) ?⿵)
1564       (setq enc (nth 1 structure))
1565       (when (setq enc-str
1566                   (cond ((characterp enc)
1567                          (get-char-attribute enc 'ideographic-structure)
1568                          )
1569                         ((consp enc)
1570                          (cdr (assq 'ideographic-structure enc))
1571                          )))
1572         (cond
1573          ((eq (car enc-str) ?⿱)
1574           (setq enc2-str (ideographic-character-get-structure (nth 2 enc-str)))
1575           (when (and enc2-str
1576                      (eq (car enc2-str) ?⿰))
1577             (unless conversion-only
1578               (setq f-res (ids-find-chars-including-ids enc-str)))
1579             (setq new-str (list ?⿲
1580                                 (nth 1 enc2-str)
1581                                 (nth 2 structure)
1582                                 (nth 2 enc2-str)))
1583             (setq new-str-c
1584                   (if (setq ret (ideographic-structure-find-chars new-str))
1585                       (car ret)
1586                     (list (cons 'ideographic-structure new-str))))
1587             (if conversion-only
1588                 (list ?⿱ (nth 1 enc-str) new-str-c)
1589               (setq a-res (ids-find-chars-including-ids new-str))
1590               (list enc
1591                     f-res
1592                     new-str-c
1593                     a-res
1594                     (list ?⿱ (nth 1 enc-str) new-str-c)
1595                     611))
1596             )
1597           )
1598          ((eq (car enc-str) ?⿳)
1599           (setq enc2-str (ideographic-character-get-structure (nth 3 enc-str)))
1600           (when (and enc2-str
1601                      (eq (car enc2-str) ?⿰))
1602             (unless conversion-only
1603               (setq f-res (ids-find-chars-including-ids enc-str)))
1604             (setq new-str (list ?⿲
1605                                 (nth 1 enc2-str)
1606                                 (nth 2 structure)
1607                                 (nth 2 enc2-str)))
1608             (setq new-str-c
1609                   (if (setq ret (ideographic-structure-find-chars new-str))
1610                       (car ret)
1611                     (list (cons 'ideographic-structure new-str))))
1612             (if conversion-only
1613                 (list ?⿳ (nth 1 enc-str) (nth 2 enc-str) new-str-c)
1614               (setq a-res (ids-find-chars-including-ids new-str))
1615               (list enc
1616                     f-res
1617                     new-str-c
1618                     a-res
1619                     (list ?⿳ (nth 1 enc-str) (nth 2 enc-str) new-str-c)
1620                     612))
1621             )
1622           )
1623          ((eq (car enc-str) ?⿲)
1624           (unless conversion-only
1625             (setq f-res (ids-find-chars-including-ids enc-str)))
1626           (setq new-str (list ?⿱
1627                               (nth 2 enc-str)
1628                               (nth 2 structure)))
1629           (setq new-str-c
1630                 (if (setq ret (ideographic-structure-find-chars new-str))
1631                     (car ret)
1632                   (list (cons 'ideographic-structure new-str))))
1633           (if conversion-only
1634               (list ?⿲ (nth 1 enc-str) new-str-c (nth 3 enc-str))
1635             (setq a-res (ids-find-chars-including-ids new-str))
1636             (list enc
1637                   f-res
1638                   new-str-c
1639                   a-res
1640                   (list ?⿲ (nth 1 enc-str) new-str-c (nth 3 enc-str))
1641                   620))
1642           )
1643          ((eq (car enc-str) ?⿴)
1644           (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
1645           (when (and enc2-str
1646                      (eq (car enc2-str) ?⿰))
1647             (unless conversion-only
1648               (setq f-res (ids-find-chars-including-ids enc-str)))
1649             (setq new-str (list ?⿱
1650                                 (nth 2 enc-str)
1651                                 (nth 2 structure)))
1652             (setq new-str-c
1653                   (if (setq ret (ideographic-structure-find-chars new-str))
1654                       (car ret)
1655                     (list (cons 'ideographic-structure new-str))))
1656             (if conversion-only
1657                 (list ?⿲ (nth 1 enc2-str) new-str-c (nth 2 enc2-str))
1658               (setq a-res (ids-find-chars-including-ids new-str))
1659               (list enc
1660                     f-res
1661                     new-str-c
1662                     a-res
1663                     (list ?⿲ (nth 1 enc2-str) new-str-c (nth 2 enc2-str))
1664                     630))
1665             )
1666           )))
1667       )
1668      ((eq (car structure) ?⿻)
1669       (setq enc (nth 1 structure))
1670       (when (setq enc-str
1671                   (cond ((characterp enc)
1672                          (get-char-attribute enc 'ideographic-structure)
1673                          )
1674                         ((consp enc)
1675                          (cdr (assq 'ideographic-structure enc))
1676                          )))
1677         (cond
1678          ((eq (car enc-str) ?⿱)
1679           (unless conversion-only
1680             (setq f-res (ids-find-chars-including-ids enc-str)))
1681           (if conversion-only
1682               (list ?⿳ (nth 1 enc-str) (nth 2 structure) (nth 2 enc-str))
1683             (list enc
1684                   f-res
1685                   new-str
1686                   nil
1687                   (list ?⿳
1688                         (nth 1 enc-str)
1689                         (nth 2 structure)
1690                         (nth 2 enc-str))
1691                   911))
1692           )))
1693       ))
1694     ))
1695
1696
1697 ;;; @ End.
1698 ;;;
1699
1700 (provide 'ids-find)
1701
1702 ;;; ids-find.el ends here