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   (let ((comp-alist (ideographic-structure-to-components-alist structure))
 559         ret pl str)
 560     (dolist (pc (caar
 561                  (sort (mapcar (lambda (cell)
 562                                  (if (setq ret (get-char-attribute
 563                                                 (car cell) 'ideographic-products))
 564                                      (cons ret (length ret))
 565                                    (cons nil 0)))
 566                                comp-alist)
 567                        (lambda (a b)
 568                          (< (cdr a)(cdr b))))))
 569       (when (or (and (setq str
 570                            (get-char-attribute pc 'ideographic-structure))
 571                      (ideographic-structure-equal str structure))
 572                 (and (setq str
 573                            (get-char-attribute pc 'ideographic-structure@apparent))
 574                      (ideographic-structure-equal str structure)))
 575         (setq pl (cons pc pl))
 576         ))
 577     pl))
 578
 579 ;;;###autoload
 580 (defun ideographic-char-count-components (char component)
 581   (let ((dest 0)
 582         structure)
 583     (cond ((eq char component)
 584            1)
 585           ((setq structure (get-char-attribute char 'ideographic-structure))
 586            (dolist (cell (ideographic-structure-to-components-alist structure))
 587              (setq dest
 588                    (+ dest
 589                       (if (eq (car cell) char)
 590                           (cdr cell)
 591                         (* (ideographic-char-count-components (car cell) component)
 592                            (cdr cell))))))
 593            dest)
 594           (t
 595            0))))
 596
 597
 598 ;;;###autoload
 599 (defun ideographic-character-get-structure (character)
 600   "Return ideographic-structure of CHARACTER.
 601 CHARACTER can be a character or char-spec."
 602   (let (ret)
 603     (cond ((characterp character)
 604            (get-char-attribute character 'ideographic-structure)
 605            )
 606           ((setq ret (assq 'ideographic-structure character))
 607            (cdr ret)
 608            )
 609           ((setq ret (find-char character))
 610            (get-char-attribute ret 'ideographic-structure)
 611            ))))
 612
 613 ;;;###autoload
 614 (defun ideographic-char-match-component (char component)
 615   "Return non-nil if character CHAR has COMPONENT in ideographic-structure.
 616 COMPONENT can be a character or char-spec."
 617   (or (ideographic-structure-character= char component)
 618       (let ((str (ideographic-character-get-structure char)))
 619         (and str
 620              (or (ideographic-char-match-component (nth 1 str) component)
 621                  (ideographic-char-match-component (nth 2 str) component)
 622                  (if (memq (car str) '(?\u2FF2 ?\u2FF3))
 623                      (ideographic-char-match-component (nth 3 str) component)))))))
 624
 625 (defun ideographic-structure-char< (a b)
 626   (let ((sa (get-char-attribute a 'ideographic-structure))
 627         (sb (get-char-attribute b 'ideographic-structure))
 628         tsa tsb)
 629     (cond (sa
 630            (cond (sb
 631                   (setq tsa (char-total-strokes a)
 632                         tsb (char-total-strokes b))
 633                   (if tsa
 634                       (if tsb
 635                           (or (< tsa tsb)
 636                               (and (= tsa tsb)
 637                                    (ideograph-char< a b)))
 638                         t)
 639                     (if tsb
 640                         nil
 641                       (ideograph-char< a b))))
 642                  (t
 643                   nil))
 644            )
 645           (t
 646            (cond (sb
 647                   t)
 648                  (t
 649                   (setq tsa (char-total-strokes a)
 650                         tsb (char-total-strokes b))
 651                   (if tsa
 652                       (if tsb
 653                           (or (< tsa tsb)
 654                               (and (= tsa tsb)
 655                                    (ideograph-char< a b)))
 656                         t)
 657                     (if tsb
 658                         nil
 659                       (ideograph-char< a b)))
 660                   ))
 661            ))
 662     ))
 663
 664 (defun ideographic-chars-to-is-a-tree (chars)
 665   (let (comp char products others dest rest
 666              la lb)
 667     (setq chars (sort chars #'ideographic-structure-char<))
 668     (while chars
 669       (setq comp (pop chars)
 670             rest chars
 671             products nil
 672             others nil)
 673       (while rest
 674         (setq char (pop rest))
 675         (cond
 676          ((ideographic-char-match-component char comp)
 677           (push char products)
 678           )
 679          (t
 680           (push char others)
 681           )))
 682       (push (cons comp
 683                   ;; (nreverse products)
 684                   (if products
 685                       (sort (ideographic-chars-to-is-a-tree products)
 686                             (lambda (a b)
 687                               (setq la (length (cdr a))
 688                                     lb (length (cdr b)))
 689                               (or (> la lb)
 690                                   (and (= la lb)
 691                                        (ideograph-char< (car a) (car b))
 692                                        ;; (progn
 693                                        ;;   (setq tsa (char-total-strokes (car a))
 694                                        ;;         tsb (char-total-strokes (car b)))
 695                                        ;;   (if tsa
 696                                        ;;       (if tsb
 697                                        ;;           (or (< tsa tsb)
 698                                        ;;               (and (= tsa tsb)
 699                                        ;;                    (ideograph-char<
 700                                        ;;                     (car a) (car b))))
 701                                        ;;         t)
 702                                        ;;     (if tsb
 703                                        ;;         nil
 704                                        ;;       (ideograph-char< (car a) (car b)))))
 705                                        ))))
 706                     nil)
 707                   )
 708             dest)
 709       (setq chars others))
 710     dest))
 711
 712 (defun ids-find-chars-including-ids* (operator component1 component2
 713                                                &optional component3)
 714   (let ((comp-alist (ideographic-structure-to-components-alist*
 715                      operator component1 component2 component3))
 716         (comp-spec
 717          (list (list* 'ideographic-structure
 718                       operator component1 component2
 719                       (if component3
 720                           (list component3)))))
 721         ret str rest)
 722     (dolist (pc (caar
 723                  (sort (mapcar (lambda (cell)
 724                                  (if (setq ret (get-char-attribute
 725                                                 (car cell) 'ideographic-products))
 726                                      (cons ret (length ret))
 727                                    (cons nil 0)))
 728                                comp-alist)
 729                        (lambda (a b)
 730                          (< (cdr a)(cdr b))))))
 731       (when (and (every (lambda (cell)
 732                           (>= (ideographic-char-count-components pc (car cell))
 733                               (cdr cell)))
 734                         comp-alist)
 735                  (or (ideographic-char-match-component pc comp-spec)
 736                      (and (setq str (get-char-attribute pc 'ideographic-structure))
 737                           (ideographic-char-match-component
 738                            (list
 739                             (cons
 740                              'ideographic-structure
 741                              (functional-ideographic-structure-to-apparent-structure
 742                               str)))
 743                            comp-spec))))
 744         (push pc rest)))
 745     (ideographic-chars-to-is-a-tree rest)))
 746
 747 (defun ids-find-chars-including-ids (structure)
 748   (if (characterp structure)
 749       (setq structure (get-char-attribute structure 'ideographic-structure)))
 750   (apply #'ids-find-chars-including-ids* structure))
 751
 752 (defun functional-ideographic-structure-to-apparent-structure (structure)
 753   (ideographic-structure-compare-functional-and-apparent
 754    structure nil 'conversion-only)
 755   ;; (ideographic-structure-compact
 756   ;;  (let (enc enc-str enc2-str new-str)
 757   ;;    (cond
 758   ;;     ((eq (car structure) ?⿸)
 759   ;;      (setq enc (nth 1 structure))
 760   ;;      (when (setq enc-str
 761   ;;                  (cond ((characterp enc)
 762   ;;                         (get-char-attribute enc 'ideographic-structure)
 763   ;;                         )
 764   ;;                        ((consp enc)
 765   ;;                         (cdr (assq 'ideographic-structure enc))
 766   ;;                         )))
 767   ;;        (cond
 768   ;;         ((eq (car enc-str) ?⿰)
 769   ;;          (list ?⿰ (nth 1 enc-str)
 770   ;;                (list (list 'ideographic-structure
 771   ;;                            ?⿱
 772   ;;                            (nth 2 enc-str)
 773   ;;                            (nth 2 structure))))
 774   ;;          )
 775   ;;         ((and (eq (car enc-str) ?⿲)
 776   ;;               (memq (char-ucs (nth 1 enc-str)) '(#x4EBB #x2E85))
 777   ;;               (eq (nth 2 enc-str) ?丨))
 778   ;;          (list ?⿰
 779   ;;                (decode-char '=big5-cdp #x8B7A)
 780   ;;                (list (list 'ideographic-structure
 781   ;;                            ?⿱
 782   ;;                            (nth 3 enc-str)
 783   ;;                            (nth 2 structure))))
 784   ;;          )
 785   ;;         ((eq (car enc-str) ?⿱)
 786   ;;          (list ?⿱ (nth 1 enc-str)
 787   ;;                (list
 788   ;;                 (cons 'ideographic-structure
 789   ;;                       (or (functional-ideographic-structure-to-apparent-structure
 790   ;;                            (setq new-str
 791   ;;                                  (list
 792   ;;                                   (cond
 793   ;;                                    ((characterp (nth 2 enc-str))
 794   ;;                                     (if (or (eq (encode-char
 795   ;;                                                  (nth 2 enc-str)
 796   ;;                                                  '=>ucs@component)
 797   ;;                                                 #x20087)
 798   ;;                                             (eq (encode-char
 799   ;;                                                  (nth 2 enc-str)
 800   ;;                                                  '=>ucs@component)
 801   ;;                                                 #x5382)
 802   ;;                                             (eq (encode-char
 803   ;;                                                  (nth 2 enc-str)
 804   ;;                                                  '=>ucs@component)
 805   ;;                                                 #x4E06)
 806   ;;                                             (eq (encode-char
 807   ;;                                                  (nth 2 enc-str)
 808   ;;                                                  '=big5-cdp)
 809   ;;                                                 #x89CE)
 810   ;;                                             (eq (encode-char
 811   ;;                                                  (nth 2 enc-str)
 812   ;;                                                  '=>big5-cdp)
 813   ;;                                                 #x88E2)
 814   ;;                                             (eq (encode-char
 815   ;;                                                  (nth 2 enc-str)
 816   ;;                                                  '=big5-cdp)
 817   ;;                                                 #x88AD)
 818   ;;                                             (eq (or (encode-char
 819   ;;                                                      (nth 2 enc-str)
 820   ;;                                                      '=>big5-cdp)
 821   ;;                                                     (encode-char
 822   ;;                                                      (nth 2 enc-str)
 823   ;;                                                      '=big5-cdp-itaiji-001))
 824   ;;                                                 #x8766)
 825   ;;                                             (eq (car
 826   ;;                                                  (get-char-attribute
 827   ;;                                                   (nth 2 enc-str)
 828   ;;                                                   'ideographic-structure))
 829   ;;                                                 ?⿸))
 830   ;;                                         ?⿸
 831   ;;                                       ?⿰))
 832   ;;                                    ((eq (car
 833   ;;                                          (cdr
 834   ;;                                           (assq 'ideographic-structure
 835   ;;                                                 (nth 2 enc-str))))
 836   ;;                                         ?⿸)
 837   ;;                                     ?⿸)
 838   ;;                                    (t
 839   ;;                                     ?⿰))
 840   ;;                                   (nth 2 enc-str)
 841   ;;                                   (nth 2 structure)
 842   ;;                                   )))
 843   ;;                           new-str))))
 844   ;;          )
 845   ;;         ((eq (car enc-str) ?⿸)
 846   ;;          (list ?⿸ (nth 1 enc-str)
 847   ;;                (list
 848   ;;                 (cons 'ideographic-structure
 849   ;;                       (setq new-str
 850   ;;                             (list
 851   ;;                              (cond
 852   ;;                               ((characterp (nth 2 enc-str))
 853   ;;                                (if (memq (char-ucs (nth 2 enc-str))
 854   ;;                                          '(#x5F73))
 855   ;;                                    ?⿰
 856   ;;                                  ?⿱)
 857   ;;                                )
 858   ;;                               (t
 859   ;;                                ?⿱))
 860   ;;                              (nth 2 enc-str)
 861   ;;                              (nth 2 structure))))))
 862   ;;          )))
 863   ;;      )
 864   ;;     ((eq (car structure) ?⿹)
 865   ;;      (setq enc (nth 1 structure))
 866   ;;      (when (setq enc-str
 867   ;;                  (cond ((characterp enc)
 868   ;;                         (get-char-attribute enc 'ideographic-structure)
 869   ;;                         )
 870   ;;                        ((consp enc)
 871   ;;                         (cdr (assq 'ideographic-structure enc))
 872   ;;                         )))
 873   ;;        (cond
 874   ;;         ((eq (car enc-str) ?⿰)
 875   ;;          (list ?⿰
 876   ;;                (list (list 'ideographic-structure
 877   ;;                            ?⿱
 878   ;;                            (nth 1 enc-str)
 879   ;;                            (nth 2 structure)))
 880   ;;                (nth 2 enc-str))
 881   ;;          )))
 882   ;;      )
 883   ;;     ((eq (get-char-attribute (car structure) '=ucs-itaiji-001) #x2FF6)
 884   ;;      (setq enc (nth 1 structure))
 885   ;;      (when (setq enc-str
 886   ;;                  (cond ((characterp enc)
 887   ;;                         (get-char-attribute enc 'ideographic-structure)
 888   ;;                         )
 889   ;;                        ((consp enc)
 890   ;;                         (cdr (assq 'ideographic-structure enc))
 891   ;;                         )))
 892   ;;        (cond
 893   ;;         ((eq (car enc-str) ?⿺)
 894   ;;          (list ?⿺
 895   ;;                (list (list 'ideographic-structure
 896   ;;                            ?⿱
 897   ;;                            (nth 2 structure)
 898   ;;                            (nth 1 enc-str)))
 899   ;;                (nth 2 enc-str))
 900   ;;          )
 901   ;;         ((eq (car enc-str) ?⿱)
 902   ;;          (list ?⿱
 903   ;;                (list (list 'ideographic-structure
 904   ;;                            ?⿰
 905   ;;                            (nth 2 structure)
 906   ;;                            (nth 1 enc-str)))
 907   ;;                (nth 2 enc-str))
 908   ;;          ))
 909   ;;        )
 910   ;;      )
 911   ;;     ((eq (car structure) ?⿴)
 912   ;;      (setq enc (nth 1 structure))
 913   ;;      (when (setq enc-str
 914   ;;                  (cond ((characterp enc)
 915   ;;                         (get-char-attribute enc 'ideographic-structure)
 916   ;;                         )
 917   ;;                        ((consp enc)
 918   ;;                         (cdr (assq 'ideographic-structure enc))
 919   ;;                         )))
 920   ;;        (cond
 921   ;;         ((eq (car enc-str) ?⿱)
 922   ;;          (cond
 923   ;;           ((and (characterp (nth 2 enc-str))
 924   ;;                 (or (memq (char-ucs (nth 2 enc-str)) '(#x56D7 #x5F51 #x897F))
 925   ;;                     (eq (char-feature (nth 2 enc-str) '=>big5-cdp)
 926   ;;                         #x87A5)))
 927   ;;            (list ?⿱
 928   ;;                  (nth 1 enc-str)
 929   ;;                  (list (list 'ideographic-structure
 930   ;;                              ?⿴
 931   ;;                              (nth 2 enc-str)
 932   ;;                              (nth 2 structure)))
 933   ;;                  )
 934   ;;            )
 935   ;;           ((and (characterp (nth 2 enc-str))
 936   ;;                 (eq (char-ucs (nth 2 enc-str)) #x51F5))
 937   ;;            (list ?⿱
 938   ;;                  (nth 1 enc-str)
 939   ;;                  (list (list 'ideographic-structure
 940   ;;                              ?⿶
 941   ;;                              (nth 2 enc-str)
 942   ;;                              (nth 2 structure)))
 943   ;;                  )
 944   ;;            )
 945   ;;           ((and (characterp (nth 1 enc-str))
 946   ;;                 (eq (char-feature (nth 1 enc-str) '=>ucs@component)
 947   ;;                     #x300E6))
 948   ;;            (list ?⿱
 949   ;;                  (list (list 'ideographic-structure
 950   ;;                              ?⿵
 951   ;;                              (nth 1 enc-str)
 952   ;;                              (nth 2 structure)))
 953   ;;                  (nth 2 enc-str))
 954   ;;            )
 955   ;;           (t
 956   ;;            (list ?⿳
 957   ;;                  (nth 1 enc-str)
 958   ;;                  (nth 2 structure)
 959   ;;                  (nth 2 enc-str))
 960   ;;            ))
 961   ;;          ))
 962   ;;        )
 963   ;;      )
 964   ;;     ((eq (car structure) ?⿶)
 965   ;;      (setq enc (nth 1 structure))
 966   ;;      (when (setq enc-str
 967   ;;                  (cond ((characterp enc)
 968   ;;                         (get-char-attribute enc 'ideographic-structure)
 969   ;;                         )
 970   ;;                        ((consp enc)
 971   ;;                         (cdr (assq 'ideographic-structure enc))
 972   ;;                         )))
 973   ;;        (cond
 974   ;;         ((eq (car enc-str) ?⿱)
 975   ;;          (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
 976   ;;          (when (and enc2-str
 977   ;;                     (eq (car enc2-str) ?⿰))
 978   ;;            (list ?⿱
 979   ;;                  (list (list 'ideographic-structure
 980   ;;                              ?⿲
 981   ;;                              (nth 1 enc2-str)
 982   ;;                              (nth 2 structure)
 983   ;;                              (nth 2 enc2-str)))
 984   ;;                  (nth 2 enc-str)))
 985   ;;          )
 986   ;;         ((eq (car enc-str) ?⿳)
 987   ;;          (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
 988   ;;          (when (and enc2-str
 989   ;;                     (eq (car enc2-str) ?⿰))
 990   ;;            (list ?⿳
 991   ;;                  (list (list 'ideographic-structure
 992   ;;                              ?⿲
 993   ;;                              (nth 1 enc2-str)
 994   ;;                              (nth 2 structure)
 995   ;;                              (nth 2 enc2-str)))
 996   ;;                  (nth 2 enc-str)
 997   ;;                  (nth 3 enc-str)))
 998   ;;          )
 999   ;;         ((eq (car enc-str) ?⿲)
1000   ;;          (list ?⿲
1001   ;;                (nth 1 enc-str)
1002   ;;                (list (list 'ideographic-structure
1003   ;;                            ?⿱
1004   ;;                            (nth 2 structure)
1005   ;;                            (nth 2 enc-str)))
1006   ;;                (nth 3 enc-str))
1007   ;;          )
1008   ;;         ((eq (car enc-str) ?⿴)
1009   ;;          (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
1010   ;;          (when (and enc2-str
1011   ;;                     (eq (car enc2-str) ?⿰))
1012   ;;            (list ?⿲
1013   ;;                  (nth 1 enc2-str)
1014   ;;                  (list (list 'ideographic-structure
1015   ;;                              ?⿱
1016   ;;                              (nth 2 structure)
1017   ;;                              (nth 2 enc-str)))
1018   ;;                  (nth 2 enc2-str)))
1019   ;;          )))
1020   ;;      )
1021   ;;     ((eq (car structure) ?⿵)
1022   ;;      (setq enc (nth 1 structure))
1023   ;;      (when (setq enc-str
1024   ;;                  (cond ((characterp enc)
1025   ;;                         (get-char-attribute enc 'ideographic-structure)
1026   ;;                         )
1027   ;;                        ((consp enc)
1028   ;;                         (cdr (assq 'ideographic-structure enc))
1029   ;;                         )))
1030   ;;        (cond
1031   ;;         ((eq (car enc-str) ?⿱)
1032   ;;          (setq enc2-str (ideographic-character-get-structure (nth 2 enc-str)))
1033   ;;          (when (and enc2-str
1034   ;;                     (eq (car enc2-str) ?⿰))
1035   ;;            (list ?⿱
1036   ;;                  (nth 1 enc-str)
1037   ;;                  (list (list 'ideographic-structure
1038   ;;                              ?⿲
1039   ;;                              (nth 1 enc2-str)
1040   ;;                              (nth 2 structure)
1041   ;;                              (nth 2 enc2-str)))))
1042   ;;          )
1043   ;;         ((eq (car enc-str) ?⿳)
1044   ;;          (setq enc2-str (ideographic-character-get-structure (nth 3 enc-str)))
1045   ;;          (when (and enc2-str
1046   ;;                     (eq (car enc2-str) ?⿰))
1047   ;;            (list ?⿳
1048   ;;                  (nth 1 enc-str)
1049   ;;                  (nth 2 enc-str)
1050   ;;                  (list (list 'ideographic-structure
1051   ;;                              ?⿲
1052   ;;                              (nth 1 enc2-str)
1053   ;;                              (nth 2 structure)
1054   ;;                              (nth 2 enc2-str)))))
1055   ;;          )
1056   ;;         ((eq (car enc-str) ?⿲)
1057   ;;          (list ?⿲
1058   ;;                (nth 1 enc-str)
1059   ;;                (list (list 'ideographic-structure
1060   ;;                            ?⿱
1061   ;;                            (nth 2 enc-str)
1062   ;;                            (nth 2 structure)))
1063   ;;                (nth 3 enc-str))
1064   ;;          )
1065   ;;         ((eq (car enc-str) ?⿴)
1066   ;;          (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
1067   ;;          (when (and enc2-str
1068   ;;                     (eq (car enc2-str) ?⿰))
1069   ;;            (list ?⿲
1070   ;;                  (nth 1 enc2-str)
1071   ;;                  (list (list 'ideographic-structure
1072   ;;                              ?⿱
1073   ;;                              (nth 2 enc-str)
1074   ;;                              (nth 2 structure)))
1075   ;;                  (nth 2 enc2-str)))
1076   ;;          )))
1077   ;;      )
1078   ;;     ((eq (car structure) ?⿻)
1079   ;;      (setq enc (nth 1 structure))
1080   ;;      (when (setq enc-str
1081   ;;                  (cond ((characterp enc)
1082   ;;                         (get-char-attribute enc 'ideographic-structure)
1083   ;;                         )
1084   ;;                        ((consp enc)
1085   ;;                         (cdr (assq 'ideographic-structure enc))
1086   ;;                         )))
1087   ;;        (cond
1088   ;;         ((eq (car enc-str) ?⿱)
1089   ;;          (list ?⿳
1090   ;;                (nth 1 enc-str)
1091   ;;                (nth 2 structure)
1092   ;;                (nth 2 enc-str))
1093   ;;          )))
1094   ;;      ))
1095   ;;    ))
1096   )
1097
1098 ;;;###autoload
1099 (defun ideographic-structure-compact (structure)
1100   (let ((rest structure)
1101         cell
1102         ret dest sub)
1103     (while rest
1104       (setq cell (pop rest))
1105       (cond
1106        ((and (consp cell)
1107              (cond ((setq ret (assq 'ideographic-structure cell))
1108                     (setq sub (cdr ret))
1109                     )
1110                    ((atom (car cell))
1111                     (setq sub cell)
1112                     )))
1113         (setq cell
1114               (if (setq ret (ideographic-structure-find-chars sub))
1115                   (car ret)
1116                 (list (cons 'ideographic-structure sub))))
1117         ))
1118       (setq dest (cons cell dest)))
1119     (nreverse dest)))
1120
1121 (defun ideographic-structure-compare-functional-and-apparent (structure
1122                                                               &optional char
1123                                                               conversion-only)
1124   (let (enc enc-str enc2-str new-str new-str-c f-res a-res ret)
1125     (cond
1126      ((eq (car structure) ?⿸)
1127       (setq enc (nth 1 structure))
1128       (when (setq enc-str
1129                   (cond ((characterp enc)
1130                          (get-char-attribute enc 'ideographic-structure)
1131                          )
1132                         ((consp enc)
1133                          (cdr (assq 'ideographic-structure enc))
1134                          )))
1135         (cond
1136          ((eq (car enc-str) ?⿰)
1137           (unless conversion-only
1138             (setq f-res (ids-find-chars-including-ids enc-str)))
1139           (setq new-str (list ?⿱
1140                               (nth 2 enc-str)
1141                               (nth 2 structure)))
1142           (setq new-str-c
1143                 (if (setq ret (ideographic-structure-find-chars new-str))
1144                     (car ret)
1145                   (list (cons 'ideographic-structure new-str))))
1146           (if conversion-only
1147               (list ?⿰ (nth 1 enc-str) new-str-c)
1148             (setq a-res (ids-find-chars-including-ids new-str))
1149             (list enc
1150                   f-res
1151                   new-str-c
1152                   a-res
1153                   (list ?⿰ (nth 1 enc-str) new-str-c)
1154                   111))
1155           )
1156          ((and (eq (car enc-str) ?⿲)
1157                (memq (char-ucs (nth 1 enc-str)) '(#x4EBB #x2E85))
1158                (eq (nth 2 enc-str) ?丨))
1159           (unless conversion-only
1160             (setq f-res (ids-find-chars-including-ids enc-str)))
1161           (setq new-str (list ?⿱
1162                               (nth 3 enc-str)
1163                               (nth 2 structure)))
1164           (setq new-str-c
1165                 (if (setq ret (ideographic-structure-find-chars new-str))
1166                     (car ret)
1167                   (list (cons 'ideographic-structure new-str))))
1168           (if conversion-only
1169               (list ?⿰ (decode-char '=big5-cdp #x8B7A) new-str-c)
1170             (setq a-res (ids-find-chars-including-ids new-str))
1171             (list enc
1172                   f-res
1173                   new-str-c
1174                   a-res
1175                   (list ?⿰ (decode-char '=big5-cdp #x8B7A) new-str-c)
1176                   112))
1177           )
1178          ((eq (car enc-str) ?⿱)
1179           (unless conversion-only
1180             (setq f-res (ids-find-chars-including-ids enc-str)))
1181           (setq new-str
1182                 (list
1183                  (cond
1184                   ((characterp (nth 2 enc-str))
1185                    (if (or (eq (encode-char (nth 2 enc-str) '=>ucs@component)
1186                                #x20087)
1187                            (eq (encode-char (nth 2 enc-str) '=>ucs@component)
1188                                #x5382)
1189                            (eq (encode-char (nth 2 enc-str) '=>ucs@component)
1190                                #x4E06)
1191                            (eq (encode-char (nth 2 enc-str) '=big5-cdp)
1192                                #x89CE)
1193                            (eq (encode-char (nth 2 enc-str) '=>big5-cdp)
1194                                #x88E2)
1195                            (eq (encode-char (nth 2 enc-str) '=big5-cdp)
1196                                #x88AD)
1197                            (eq (or (encode-char (nth 2 enc-str) '=>big5-cdp)
1198                                    (encode-char (nth 2 enc-str) '=big5-cdp-itaiji-001))
1199                                #x8766)
1200                            (eq (car (get-char-attribute (nth 2 enc-str)
1201                                                         'ideographic-structure))
1202                                ?⿸))
1203                        ?⿸
1204                      ?⿰))
1205                   ((eq (car (cdr (assq 'ideographic-structure (nth 2 enc-str))))
1206                        ?⿸)
1207                    ?⿸)
1208                   (t
1209                    ?⿰))
1210                  (nth 2 enc-str)
1211                  (nth 2 structure)))
1212           (setq new-str-c
1213                 (if (setq ret (ideographic-structure-find-chars new-str))
1214                     (car ret)
1215                   (list (cons 'ideographic-structure new-str))))
1216           (if conversion-only
1217               (list ?⿱ (nth 1 enc-str) new-str-c)
1218             (setq a-res (ids-find-chars-including-ids new-str))
1219             (list enc
1220                   f-res
1221                   new-str-c
1222                   a-res
1223                   (list ?⿱ (nth 1 enc-str) new-str-c)
1224                   (if (eq (car new-str) ?⿸)
1225                       121
1226                     122)))
1227           )
1228          ((eq (car enc-str) ?⿸)
1229           (unless conversion-only
1230             (setq f-res (ids-find-chars-including-ids enc-str)))
1231           (setq new-str (list (cond
1232                                ((characterp (nth 2 enc-str))
1233                                 (if (memq (char-ucs (nth 2 enc-str))
1234                                           '(#x5F73))
1235                                     ?⿰
1236                                   ?⿱)
1237                                 )
1238                                (t
1239                                 ?⿱))
1240                               (nth 2 enc-str)
1241                               (nth 2 structure)))
1242           (setq new-str-c
1243                 (if (setq ret (ideographic-structure-find-chars new-str))
1244                     (car ret)
1245                   (list (cons 'ideographic-structure new-str))))
1246           (if conversion-only
1247               (list ?⿸ (nth 1 enc-str) new-str-c)
1248             (setq a-res (ids-find-chars-including-ids new-str))
1249             (list enc
1250                   f-res
1251                   new-str-c
1252                   a-res
1253                   (list ?⿸ (nth 1 enc-str) new-str-c)
1254                   (if (eq (car new-str) ?⿰)
1255                       131
1256                     132)))
1257           )))
1258       )
1259      ((eq (car structure) ?⿹)
1260       (setq enc (nth 1 structure))
1261       (when (setq enc-str
1262                   (cond ((characterp enc)
1263                          (get-char-attribute enc 'ideographic-structure)
1264                          )
1265                         ((consp enc)
1266                          (cdr (assq 'ideographic-structure enc))
1267                          )))
1268         (cond
1269          ((eq (car enc-str) ?⿰)
1270           (unless conversion-only
1271             (setq f-res (ids-find-chars-including-ids enc-str)))
1272           (setq new-str (list ?⿱
1273                               (nth 1 enc-str)
1274                               (nth 2 structure)))
1275           (setq new-str-c
1276                 (if (setq ret (ideographic-structure-find-chars new-str))
1277                     (car ret)
1278                   (list (cons 'ideographic-structure new-str))))
1279           (if conversion-only
1280               (list ?⿰ new-str-c (nth 2 enc-str))
1281             (setq a-res (ids-find-chars-including-ids new-str))
1282             (list enc
1283                   f-res
1284                   new-str-c
1285                   a-res
1286                   (list ?⿰ new-str-c (nth 2 enc-str))
1287                   210))
1288           )))
1289       )
1290      ((eq (get-char-attribute (car structure) '=ucs-itaiji-001) #x2FF6)
1291       (setq enc (nth 1 structure))
1292       (when (setq enc-str
1293                   (cond ((characterp enc)
1294                          (get-char-attribute enc 'ideographic-structure)
1295                          )
1296                         ((consp enc)
1297                          (cdr (assq 'ideographic-structure enc))
1298                          )))
1299         (cond
1300          ((eq (car enc-str) ?⿺)
1301           (unless conversion-only
1302             (setq f-res (ids-find-chars-including-ids enc-str)))
1303           (setq new-str (list ?⿱
1304                               (nth 2 structure)
1305                               (nth 1 enc-str)))
1306           (setq new-str-c
1307                 (if (setq ret (ideographic-structure-find-chars new-str))
1308                     (car ret)
1309                   (list (cons 'ideographic-structure new-str))))
1310           (if conversion-only
1311               (list ?⿺ new-str-c (nth 2 enc-str))
1312             (setq a-res (ids-find-chars-including-ids new-str))
1313             (list enc
1314                   f-res
1315                   new-str-c
1316                   a-res
1317                   (list ?⿺ new-str-c (nth 2 enc-str))
1318                   310))
1319           )
1320          ((eq (car enc-str) ?⿱)
1321           (unless conversion-only
1322             (setq f-res (ids-find-chars-including-ids enc-str)))
1323           (setq new-str (list ?⿰
1324                               (nth 2 structure)
1325                               (nth 1 enc-str)))
1326           (setq new-str-c
1327                 (if (setq ret (ideographic-structure-find-chars new-str))
1328                     (car ret)
1329                   (list (cons 'ideographic-structure new-str))))
1330           (if conversion-only
1331               (list ?⿱ new-str-c (nth 2 enc-str))
1332             (setq a-res (ids-find-chars-including-ids new-str))
1333             (list enc
1334                   f-res
1335                   new-str-c
1336                   a-res
1337                   (list ?⿱ new-str-c (nth 2 enc-str))
1338                   320))
1339           ))
1340         )
1341       )
1342      ((eq (car structure) ?⿴)
1343       (setq enc (nth 1 structure))
1344       (when (setq enc-str
1345                   (cond ((characterp enc)
1346                          (get-char-attribute enc 'ideographic-structure)
1347                          )
1348                         ((consp enc)
1349                          (cdr (assq 'ideographic-structure enc))
1350                          )))
1351         (cond
1352          ((eq (car enc-str) ?⿱)
1353           (cond
1354            ((and (characterp (nth 2 enc-str))
1355                  (or (memq (char-ucs (nth 2 enc-str)) '(#x56D7 #x5F51 #x897F))
1356                      (eq (char-feature (nth 2 enc-str) '=>big5-cdp)
1357                          #x87A5)))
1358             (unless conversion-only
1359               (setq f-res (ids-find-chars-including-ids enc-str)))
1360             (setq new-str (list ?⿴
1361                                 (nth 2 enc-str)
1362                                 (nth 2 structure)))
1363             (setq new-str-c
1364                   (if (setq ret (ideographic-structure-find-chars new-str))
1365                       (car ret)
1366                     (list (cons 'ideographic-structure new-str))))
1367             (if conversion-only
1368                 (list ?⿱ (nth 1 enc-str) new-str-c)
1369               (setq a-res (ids-find-chars-including-ids new-str))
1370               (list enc
1371                     f-res
1372                     new-str-c
1373                     a-res
1374                     (list ?⿱ (nth 1 enc-str) new-str-c)
1375                     411))
1376             )
1377            ((and (characterp (nth 2 enc-str))
1378                  (eq (char-ucs (nth 2 enc-str)) #x51F5))
1379             (unless conversion-only
1380               (setq f-res (ids-find-chars-including-ids enc-str)))
1381             (setq new-str (list ?⿶
1382                                 (nth 2 enc-str)
1383                                 (nth 2 structure)))
1384             (setq new-str-c
1385                   (if (setq ret (ideographic-structure-find-chars new-str))
1386                       (car ret)
1387                     (list (cons 'ideographic-structure new-str))))
1388             (if conversion-only
1389                 (list ?⿱ (nth 1 enc-str) new-str-c)
1390               (setq a-res (ids-find-chars-including-ids new-str))
1391               (list enc
1392                     f-res
1393                     new-str-c
1394                     a-res
1395                     (list ?⿱ (nth 1 enc-str) new-str-c)
1396                     412))
1397             )
1398            ((and (characterp (nth 1 enc-str))
1399                  (eq (char-feature (nth 1 enc-str) '=>ucs@component)
1400                      #x300E6))
1401             (unless conversion-only
1402               (setq f-res (ids-find-chars-including-ids enc-str)))
1403             (setq new-str (list ?⿵
1404                                 (nth 1 enc-str)
1405                                 (nth 2 structure)))
1406             (setq new-str-c
1407                   (if (setq ret (ideographic-structure-find-chars new-str))
1408                       (car ret)
1409                     (list (cons 'ideographic-structure new-str))))
1410             (if conversion-only
1411                 (list ?⿱ new-str-c (nth 2 enc-str))
1412               (setq a-res (ids-find-chars-including-ids new-str))
1413               (list enc
1414                     f-res
1415                     new-str-c
1416                     a-res
1417                     (list ?⿱ new-str-c (nth 2 enc-str))
1418                     413))
1419             )
1420            (t
1421             (unless conversion-only
1422               (setq f-res (ids-find-chars-including-ids enc-str)))
1423             (setq new-str (list ?⿱ (nth 2 structure) (nth 2 enc-str)))
1424             (setq new-str-c
1425                   (if (setq ret (ideographic-structure-find-chars new-str))
1426                       (car ret)
1427                     (list (cons 'ideographic-structure new-str))))
1428             (if conversion-only
1429                 (list ?⿱ (nth 1 enc-str) new-str-c)
1430               (setq a-res (ids-find-chars-including-ids new-str))
1431               (list enc
1432                     f-res
1433                     new-str-c
1434                     a-res
1435                     (list ?⿱ (nth 1 enc-str) new-str-c)
1436                     414))
1437             ))
1438           )
1439          ((eq (car enc-str) ?⿳)
1440           (cond
1441            ((and (characterp (nth 2 enc-str))
1442                  (eq (char-ucs (nth 2 enc-str)) #x56D7))
1443             (unless conversion-only
1444               (setq f-res (ids-find-chars-including-ids enc-str)))
1445             (setq new-str (list ?⿴ (nth 2 enc-str) (nth 2 structure)))
1446             (setq new-str-c
1447                   (if (setq ret (ideographic-structure-find-chars new-str))
1448                       (car ret)
1449                     (list (cons 'ideographic-structure new-str))))
1450             (setq new-str (list ?⿱ (nth 1 enc-str) new-str-c))
1451             (setq new-str-c
1452                   (if (setq ret (ideographic-structure-find-chars new-str))
1453                       (car ret)
1454                     (list (cons 'ideographic-structure new-str))))
1455             (if conversion-only
1456                 (list ?⿱  new-str-c (nth 3 enc-str))
1457               (setq a-res (ids-find-chars-including-ids new-str))
1458               (list enc
1459                     f-res
1460                     new-str-c
1461                     a-res
1462                     (list ?⿱  new-str-c (nth 3 enc-str))
1463                     415))
1464             )
1465            ((and (characterp (nth 2 enc-str))
1466                  (eq (char-ucs (nth 2 enc-str)) #x5196))
1467             (unless conversion-only
1468               (setq f-res (ids-find-chars-including-ids enc-str)))
1469             (setq new-str (list ?⿱ (nth 1 enc-str) (nth 2 enc-str)))
1470             (setq new-str-c
1471                   (if (setq ret (ideographic-structure-find-chars new-str))
1472                       (car ret)
1473                     (list (cons 'ideographic-structure new-str))))
1474             (setq new-str (list ?⿱ new-str-c (nth 2 structure)))
1475             (setq new-str-c
1476                   (if (setq ret (ideographic-structure-find-chars new-str))
1477                       (car ret)
1478                     (list (cons 'ideographic-structure new-str))))
1479             (if conversion-only
1480                 (list ?⿱ new-str-c (nth 3 enc-str))
1481               (setq a-res (ids-find-chars-including-ids new-str))
1482               (list enc
1483                     f-res
1484                     new-str-c
1485                     a-res
1486                     (list ?⿱ new-str-c (nth 3 enc-str))
1487                     416))
1488             )
1489            ((and (characterp (nth 2 enc-str))
1490                  (or (eq (encode-char (nth 2 enc-str) '=>big5-cdp)
1491                          #x89A6)
1492                      (eq (encode-char (nth 2 enc-str) '=>gt-k)
1493                          146)
1494                      (eq (char-ucs (nth 2 enc-str)) #x2008A)))
1495             (unless conversion-only
1496               (setq f-res (ids-find-chars-including-ids enc-str)))
1497             (setq new-str (list ?⿱ (nth 2 structure) (nth 2 enc-str)))
1498             (setq new-str-c
1499                   (if (setq ret (ideographic-structure-find-chars new-str))
1500                       (car ret)
1501                     (list (cons 'ideographic-structure new-str))))
1502             (setq new-str (list ?⿸ new-str-c (nth 3 enc-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 ?⿱ (nth 1 enc-str) new-str-c)
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 ?⿱ (nth 1 enc-str) new-str-c)
1515                     417))
1516             )
1517            (t
1518             (unless conversion-only
1519               (setq f-res (ids-find-chars-including-ids enc-str)))
1520             (setq new-str (list ?⿻ (nth 2 enc-str) (nth 2 structure)))
1521             (setq new-str-c
1522                   (if (setq ret (ideographic-structure-find-chars new-str))
1523                       (car ret)
1524                     (list (cons 'ideographic-structure new-str))))
1525             (setq new-str (list ?⿱ (nth 1 enc-str) new-str-c))
1526             (setq new-str-c
1527                   (if (setq ret (ideographic-structure-find-chars new-str))
1528                       (car ret)
1529                     (list (cons 'ideographic-structure new-str))))
1530             (if conversion-only
1531                 (list ?⿱  new-str-c (nth 3 enc-str))
1532               (setq a-res (ids-find-chars-including-ids new-str))
1533               (list enc
1534                     f-res
1535                     new-str-c
1536                     a-res
1537                     (list ?⿱  new-str-c (nth 3 enc-str))
1538                     419))
1539             ))
1540           )))
1541       )
1542      ((eq (car structure) ?⿶)
1543       (setq enc (nth 1 structure))
1544       (when (setq enc-str
1545                   (cond ((characterp enc)
1546                          (get-char-attribute enc 'ideographic-structure)
1547                          )
1548                         ((consp enc)
1549                          (cdr (assq 'ideographic-structure enc))
1550                          )))
1551         (cond
1552          ((eq (car enc-str) ?⿱)
1553           (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
1554           (when (and enc2-str
1555                      (eq (car enc2-str) ?⿰))
1556             (unless conversion-only
1557               (setq f-res (ids-find-chars-including-ids enc-str)))
1558             (setq new-str (list ?⿲
1559                                 (nth 1 enc2-str)
1560                                 (nth 2 structure)
1561                                 (nth 2 enc2-str)))
1562             (setq new-str-c
1563                   (if (setq ret (ideographic-structure-find-chars new-str))
1564                       (car ret)
1565                     (list (cons 'ideographic-structure new-str))))
1566             (if conversion-only
1567                 (list ?⿱ new-str-c (nth 2 enc-str))
1568               (setq a-res (ids-find-chars-including-ids new-str))
1569               (list enc
1570                     f-res
1571                     new-str-c
1572                     a-res
1573                     (list ?⿱ new-str-c (nth 2 enc-str))
1574                     511))
1575             )
1576           )
1577          ((eq (car enc-str) ?⿳)
1578           (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
1579           (when (and enc2-str
1580                      (eq (car enc2-str) ?⿰))
1581             (unless conversion-only
1582               (setq f-res (ids-find-chars-including-ids enc-str)))
1583             (setq new-str (list ?⿲
1584                                 (nth 1 enc2-str)
1585                                 (nth 2 structure)
1586                                 (nth 2 enc2-str)))
1587             (setq new-str-c
1588                   (if (setq ret (ideographic-structure-find-chars new-str))
1589                       (car ret)
1590                     (list (cons 'ideographic-structure new-str))))
1591             (if conversion-only
1592                 (list ?⿳ new-str-c (nth 2 enc-str) (nth 3 enc-str))
1593               (setq a-res (ids-find-chars-including-ids new-str))
1594               (list enc
1595                     f-res
1596                     new-str-c
1597                     a-res
1598                     (list ?⿳ new-str-c (nth 2 enc-str) (nth 3 enc-str))
1599                     512))
1600             )
1601           )
1602          ((eq (car enc-str) ?⿲)
1603           (unless conversion-only
1604             (setq f-res (ids-find-chars-including-ids enc-str)))
1605           (setq new-str (list ?⿱
1606                               (nth 2 structure)
1607                               (nth 2 enc-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) new-str-c (nth 3 enc-str))
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) new-str-c (nth 3 enc-str))
1620                   520))
1621           )
1622          ((eq (car enc-str) ?⿴)
1623           (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
1624           (when (and enc2-str
1625                      (eq (car enc2-str) ?⿰))
1626             (unless conversion-only
1627               (setq f-res (ids-find-chars-including-ids enc-str)))
1628             (setq new-str (list ?⿱
1629                                 (nth 2 structure)
1630                                 (nth 2 enc-str)))
1631             (setq new-str-c
1632                   (if (setq ret (ideographic-structure-find-chars new-str))
1633                       (car ret)
1634                     (list (cons 'ideographic-structure new-str))))
1635             (if conversion-only
1636                 (list ?⿲ (nth 1 enc2-str) new-str-c (nth 2 enc2-str))
1637               (setq a-res (ids-find-chars-including-ids new-str))
1638               (list enc
1639                     f-res
1640                     new-str-c
1641                     a-res
1642                     (list ?⿲ (nth 1 enc2-str) new-str-c (nth 2 enc2-str))
1643                     530))
1644             )
1645           )))
1646       )
1647      ((eq (car structure) ?⿵)
1648       (setq enc (nth 1 structure))
1649       (when (setq enc-str
1650                   (cond ((characterp enc)
1651                          (get-char-attribute enc 'ideographic-structure)
1652                          )
1653                         ((consp enc)
1654                          (cdr (assq 'ideographic-structure enc))
1655                          )))
1656         (cond
1657          ((eq (car enc-str) ?⿱)
1658           (setq enc2-str (ideographic-character-get-structure (nth 2 enc-str)))
1659           (when (and enc2-str
1660                      (eq (car enc2-str) ?⿰))
1661             (unless conversion-only
1662               (setq f-res (ids-find-chars-including-ids enc-str)))
1663             (setq new-str (list ?⿲
1664                                 (nth 1 enc2-str)
1665                                 (nth 2 structure)
1666                                 (nth 2 enc2-str)))
1667             (setq new-str-c
1668                   (if (setq ret (ideographic-structure-find-chars new-str))
1669                       (car ret)
1670                     (list (cons 'ideographic-structure new-str))))
1671             (if conversion-only
1672                 (list ?⿱ (nth 1 enc-str) new-str-c)
1673               (setq a-res (ids-find-chars-including-ids new-str))
1674               (list enc
1675                     f-res
1676                     new-str-c
1677                     a-res
1678                     (list ?⿱ (nth 1 enc-str) new-str-c)
1679                     611))
1680             )
1681           )
1682          ((eq (car enc-str) ?⿳)
1683           (setq enc2-str (ideographic-character-get-structure (nth 3 enc-str)))
1684           (when (and enc2-str
1685                      (eq (car enc2-str) ?⿰))
1686             (unless conversion-only
1687               (setq f-res (ids-find-chars-including-ids enc-str)))
1688             (setq new-str (list ?⿲
1689                                 (nth 1 enc2-str)
1690                                 (nth 2 structure)
1691                                 (nth 2 enc2-str)))
1692             (setq new-str-c
1693                   (if (setq ret (ideographic-structure-find-chars new-str))
1694                       (car ret)
1695                     (list (cons 'ideographic-structure new-str))))
1696             (if conversion-only
1697                 (list ?⿳ (nth 1 enc-str) (nth 2 enc-str) new-str-c)
1698               (setq a-res (ids-find-chars-including-ids new-str))
1699               (list enc
1700                     f-res
1701                     new-str-c
1702                     a-res
1703                     (list ?⿳ (nth 1 enc-str) (nth 2 enc-str) new-str-c)
1704                     612))
1705             )
1706           )
1707          ((eq (car enc-str) ?⿲)
1708           (unless conversion-only
1709             (setq f-res (ids-find-chars-including-ids enc-str)))
1710           (setq new-str (list ?⿱
1711                               (nth 2 enc-str)
1712                               (nth 2 structure)))
1713           (setq new-str-c
1714                 (if (setq ret (ideographic-structure-find-chars new-str))
1715                     (car ret)
1716                   (list (cons 'ideographic-structure new-str))))
1717           (if conversion-only
1718               (list ?⿲ (nth 1 enc-str) new-str-c (nth 3 enc-str))
1719             (setq a-res (ids-find-chars-including-ids new-str))
1720             (list enc
1721                   f-res
1722                   new-str-c
1723                   a-res
1724                   (list ?⿲ (nth 1 enc-str) new-str-c (nth 3 enc-str))
1725                   620))
1726           )
1727          ((eq (car enc-str) ?⿴)
1728           (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
1729           (when (and enc2-str
1730                      (eq (car enc2-str) ?⿰))
1731             (unless conversion-only
1732               (setq f-res (ids-find-chars-including-ids enc-str)))
1733             (setq new-str (list ?⿱
1734                                 (nth 2 enc-str)
1735                                 (nth 2 structure)))
1736             (setq new-str-c
1737                   (if (setq ret (ideographic-structure-find-chars new-str))
1738                       (car ret)
1739                     (list (cons 'ideographic-structure new-str))))
1740             (if conversion-only
1741                 (list ?⿲ (nth 1 enc2-str) new-str-c (nth 2 enc2-str))
1742               (setq a-res (ids-find-chars-including-ids new-str))
1743               (list enc
1744                     f-res
1745                     new-str-c
1746                     a-res
1747                     (list ?⿲ (nth 1 enc2-str) new-str-c (nth 2 enc2-str))
1748                     630))
1749             )
1750           )))
1751       )
1752      ((eq (car structure) ?⿷)
1753       (setq enc (nth 1 structure))
1754       (when (setq enc-str
1755                   (cond ((characterp enc)
1756                          (get-char-attribute enc 'ideographic-structure)
1757                          )
1758                         ((consp enc)
1759                          (cdr (assq 'ideographic-structure enc))
1760                          )))
1761         (cond
1762          ((eq (car enc-str) ?⿺)
1763           (unless conversion-only
1764             (setq f-res (ids-find-chars-including-ids enc-str)))
1765           (setq new-str (list ?⿱
1766                               (nth 2 enc-str)
1767                               (nth 2 structure)))
1768           (setq new-str-c
1769                 (if (setq ret (ideographic-structure-find-chars new-str))
1770                     (car ret)
1771                   (list (cons 'ideographic-structure new-str))))
1772           (if conversion-only
1773               (list ?⿺ (nth 1 enc-str) new-str-c)
1774             (setq a-res (ids-find-chars-including-ids new-str))
1775             (list enc
1776                   f-res
1777                   new-str-c
1778                   a-res
1779                   (list ?⿺ (nth 1 enc-str) new-str-c)
1780                   710))
1781           )))
1782       )
1783      ((eq (car structure) ?⿻)
1784       (setq enc (nth 1 structure))
1785       (when (setq enc-str
1786                   (cond ((characterp enc)
1787                          (get-char-attribute enc 'ideographic-structure)
1788                          )
1789                         ((consp enc)
1790                          (cdr (assq 'ideographic-structure enc))
1791                          )))
1792         (cond
1793          ((eq (car enc-str) ?⿱)
1794           (unless conversion-only
1795             (setq f-res (ids-find-chars-including-ids enc-str)))
1796           (if conversion-only
1797               (list ?⿳ (nth 1 enc-str) (nth 2 structure) (nth 2 enc-str))
1798             (list enc
1799                   f-res
1800                   new-str
1801                   nil
1802                   (list ?⿳
1803                         (nth 1 enc-str)
1804                         (nth 2 structure)
1805                         (nth 2 enc-str))
1806                   911))
1807           )))
1808       ))
1809     ))
1810
1811
1812 ;;; @ End.
1813 ;;;
1814
1815 (provide 'ids-find)
1816
1817 ;;; ids-find.el ends here