1 ;;; ids-find.el --- search utility based on Ideographic-structures ;; -*- coding: utf-8-mcs-er -*-
3 ;; Copyright (C) 2002, 2003, 2005, 2006, 2007, 2017, 2020, 2021
6 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
7 ;; Keywords: Kanji, Ideographs, search, IDS, CHISE, UCS, Unicode
9 ;; This file is a part of CHISE-IDS.
11 ;; This program is free software; you can redistribute it and/or
12 ;; modify it under the terms of the GNU General Public License as
13 ;; published by the Free Software Foundation; either version 2, or (at
14 ;; your option) any later version.
16 ;; This program is distributed in the hope that it will be useful, but
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 ;; General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with this program; see the file COPYING. If not, write to
23 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
28 (defun ids-index-store-char (product component)
29 (let ((ret (get-char-attribute component 'ideographic-products)))
30 (unless (memq product ret)
31 (put-char-attribute component 'ideographic-products
33 (when (setq ret (char-feature component 'ideographic-structure))
34 (ids-index-store-structure product ret)))
37 (defun ids-index-store-structure (product structure)
39 (dolist (cell (cdr structure))
41 (setq cell (plist-get cell :char)))
42 (cond ((characterp cell)
43 (ids-index-store-char product cell))
44 ((setq ret (assq 'ideographic-structure cell))
45 (ids-index-store-structure product (cdr ret)))
46 ((setq ret (find-char cell))
47 (ids-index-store-char product ret))
51 (defun ids-update-index (&optional in-memory)
55 (ids-index-store-structure c v)
57 'ideographic-structure)
60 (ids-index-store-structure c v)
62 'ideographic-structure@apparent)
64 (save-char-attribute-table 'ideographic-products)))
67 (mount-char-attribute-table 'ideographic-products)
70 (defun ids-find-all-products (char)
72 (dolist (cell (char-feature char 'ideographic-products))
73 (unless (memq cell dest)
74 (setq dest (cons cell dest)))
75 (setq dest (union dest (ids-find-all-products cell))))
78 (defun of-component-features ()
80 (dolist (feature (char-attribute-list))
81 (when (string-match "^<-.*[@/]component\\(/[^*/]+\\)*$"
82 (symbol-name feature))
84 (list* '<-mistakable '->mistakable
87 '<-original '->original
91 (defun to-component-features ()
93 (dolist (feature (char-attribute-list))
94 (when (string-match "^->.*[@/]component\\(/[^*/]+\\)*$"
95 (symbol-name feature))
100 (defun char-component-variants (char)
101 (let ((dest (list char))
103 (dolist (feature (to-component-features))
104 (if (setq ret (get-char-attribute char feature))
106 (setq dest (union dest (char-component-variants c))))))
108 ;; ((setq ret (some (lambda (feature)
109 ;; (get-char-attribute char feature))
110 ;; (to-component-features)))
112 ;; (setq dest (union dest (char-component-variants c))))
114 ((setq ret (get-char-attribute char '->ucs-unified))
115 (setq dest (cons char ret))
117 (setq dest (union dest
118 (some (lambda (feature)
119 (get-char-attribute c feature))
120 (of-component-features))
123 ((and (setq ret (get-char-attribute char '=>ucs))
124 (setq uchr (decode-char '=ucs ret)))
125 (setq dest (cons uchr (char-variants uchr)))
127 (setq dest (union dest
128 (some (lambda (feature)
129 (get-char-attribute c feature))
130 (of-component-features))
136 (unless (memq c dest)
137 (setq dest (cons c dest)))
140 (some (lambda (feature)
141 (char-feature c feature))
142 (of-component-features))
150 (defun ideographic-products-find (&rest components)
151 (if (stringp (car components))
152 (setq components (string-to-char-list (car components))))
154 (dolist (variant (char-component-variants (car components)))
157 (get-char-attribute variant 'ideographic-products))))
160 (setq components (cdr components)))
162 (dolist (variant (char-component-variants (car components)))
165 (get-char-attribute variant 'ideographic-products))))
166 (setq dest (intersection dest products)))
169 (defun ideograph-find-products-with-variants (components &optional ignored-chars)
170 (if (stringp components)
171 (setq components (string-to-char-list components)))
173 (dolist (variant (char-component-variants (car components)))
177 (get-char-attribute variant 'ideographic-products)
181 (setq components (cdr components)))
183 (dolist (variant (char-component-variants (car components)))
187 (get-char-attribute variant 'ideographic-products)
189 (setq dest (intersection dest products)))
192 (defun ideograph-find-products (components &optional ignored-chars)
193 (if (stringp components)
194 (setq components (string-to-char-list components)))
196 ;; (dolist (variant (char-component-variants (car components)))
199 ;; (get-char-attribute variant 'ideographic-products))))
200 ;; (setq dest products)
201 (setq dest (get-char-attribute (car components) 'ideographic-products))
203 (setq components (cdr components)))
204 ;; (setq products nil)
205 ;; (dolist (variant (char-component-variants (car components)))
208 ;; (get-char-attribute variant 'ideographic-products))))
209 (setq products (get-char-attribute (car components) 'ideographic-products))
210 (setq dest (intersection dest products)))
214 (defun ideographic-structure-char= (c1 c2)
217 (let ((m1 (char-ucs c1))
221 (memq c1 (char-component-variants c2)))))))
223 (defun ideographic-structure-member-compare-components (component s-component)
225 (cond ((char-ref= component s-component #'ideographic-structure-char=))
227 (if (setq ret (assq 'ideographic-structure s-component))
228 (ideographic-structure-member component (cdr ret))))
229 ((setq ret (get-char-attribute s-component 'ideographic-structure))
230 (ideographic-structure-member component ret)))))
233 (defun ideographic-structure-member (component structure)
234 "Return non-nil if COMPONENT is included in STRUCTURE."
235 (or (memq component structure)
237 (setq structure (cdr structure))
238 (ideographic-structure-member-compare-components
239 component (car structure)))
241 (setq structure (cdr structure))
242 (ideographic-structure-member-compare-components
243 component (car structure)))
245 (setq structure (cdr structure))
247 (ideographic-structure-member-compare-components
248 component (car structure))))))
252 (defun ideographic-structure-repertoire-p (structure components)
253 "Return non-nil if STRUCTURE can be constructed by a subset of COMPONENTS."
255 (let (ret s-component)
257 (while (setq structure (cdr structure))
258 (setq s-component (car structure))
259 (unless (characterp s-component)
260 (if (setq ret (find-char s-component))
261 (setq s-component ret)))
264 (if (setq ret (assq 'ideographic-structure s-component))
265 (ideographic-structure-repertoire-p
266 (cdr ret) components)))
267 ((member* s-component components
268 :test #'ideographic-structure-char=))
270 (get-char-attribute s-component
271 'ideographic-structure))
272 (ideographic-structure-repertoire-p ret components)))
277 (defvar ids-find-result-buffer "*ids-chars*")
279 (defun ids-find-format-line (c v)
280 (format "%c\t%s\t%s\n"
282 (or (let ((ucs (or (char-ucs c)
283 (encode-char c 'ucs))))
285 (cond ((<= ucs #xFFFF)
286 (format " U+%04X" ucs))
288 (format "U-%08X" ucs)))))
290 (or (ideographic-structure-to-ids v)
293 (defun ids-insert-chars-including-components* (components
294 &optional level ignored-chars)
298 (dolist (c (sort (copy-list (ideograph-find-products components
301 (if (setq as (char-total-strokes a))
302 (if (setq bs (char-total-strokes b))
304 (ideograph-char< a b)
307 (ideograph-char< a b)))))
308 (unless (memq c ignored-chars)
309 (setq is (char-feature c 'ideographic-structure))
314 (insert (ids-find-format-line c is))
316 (ids-insert-chars-including-components*
317 (char-to-string c) (1+ level)
318 (cons c ignored-chars))))
323 (defun ids-insert-chars-including-components (components
324 &optional level ignored-chars)
329 (ids-insert-chars-including-components* components
330 level ignored-chars)))
332 (dolist (c ignored-chars)
333 (dolist (vc (char-component-variants c))
334 (unless (memq vc ignored-chars)
335 (when (setq is (get-char-attribute vc 'ideographic-structure))
340 (insert (ids-find-format-line vc is))
342 (ids-insert-chars-including-components*
343 (char-to-string vc) (1+ level)
344 (cons vc ignored-chars)))))))
345 (dolist (c (sort (copy-list (ideograph-find-products-with-variants
346 components ignored-chars))
348 (if (setq as (char-total-strokes a))
349 (if (setq bs (char-total-strokes b))
351 (ideograph-char< a b)
354 (ideograph-char< a b)))))
355 (unless (memq c ignored-chars)
356 (setq is (get-char-attribute c 'ideographic-structure))
361 (insert (ids-find-format-line c is))
363 (ids-insert-chars-including-components*
364 (char-to-string c) (1+ level)
365 (cons c ignored-chars))))
371 (defun ids-find-chars-including-components (components)
372 "Search Ideographs whose structures have COMPONENTS."
373 (interactive "sComponents : ")
374 (with-current-buffer (get-buffer-create ids-find-result-buffer)
375 (setq buffer-read-only nil)
377 (ids-insert-chars-including-components components 0 nil)
378 ;; (let ((ignored-chars
380 ;; (ids-insert-chars-including-components components 0 nil
381 ;; #'ideograph-find-products)))
383 ;; (setq rest ignored-chars)
384 ;; ;; (dolist (c rest)
385 ;; ;; (setq ignored-chars
386 ;; ;; (union ignored-chars
387 ;; ;; (ids-insert-chars-including-components
388 ;; ;; (list c) 0 ignored-chars
389 ;; ;; #'ideograph-find-products-with-variants))))
390 ;; (ids-insert-chars-including-components components 0 ignored-chars
391 ;; #'ideograph-find-products-with-variants))
392 (goto-char (point-min)))
393 (view-buffer ids-find-result-buffer))
396 (define-obsolete-function-alias 'ideographic-structure-search-chars
397 'ids-find-chars-including-components)
400 (defun ids-find-chars-covered-by-components (components)
401 "Search Ideographs which structures are consisted by subsets of COMPONENTS."
402 (interactive "sComponents: ")
403 (if (stringp components)
404 (setq components (string-to-char-list components)))
405 (with-current-buffer (get-buffer-create ids-find-result-buffer)
406 (setq buffer-read-only nil)
410 (when (ideographic-structure-repertoire-p v components)
411 (insert (ids-find-format-line c v))))
412 'ideographic-structure)
413 (goto-char (point-min)))
414 (view-buffer ids-find-result-buffer))
417 (defun ideographic-structure-merge-components-alist (ca1 ca2)
418 (let ((dest-alist ca1)
421 (if (setq ret (assq (car cell) dest-alist))
422 (setcdr ret (+ (cdr ret)(cdr cell)))
423 (setq dest-alist (cons cell dest-alist))))
426 (defun ideographic-structure-to-components-alist (structure)
427 (apply #'ideographic-structure-to-components-alist* structure))
429 (defun ideographic-structure-to-components-alist* (operator component1 component2
432 (let (dest-alist ret)
434 (cond ((characterp component1)
435 (unless (encode-char component1 'ascii)
436 (list (cons component1 1)))
438 ((setq ret (assq 'ideographic-structure component1))
439 (ideographic-structure-to-components-alist (cdr ret))
441 ((setq ret (find-char component1))
445 (ideographic-structure-merge-components-alist
447 (cond ((characterp component2)
448 (unless (encode-char component2 'ascii)
449 (list (cons component2 1)))
451 ((setq ret (assq 'ideographic-structure component2))
452 (ideographic-structure-to-components-alist (cdr ret))
454 ((setq ret (find-char component2))
457 (if (memq operator '(?\u2FF2 ?\u2FF3))
458 (ideographic-structure-merge-components-alist
460 (cond ((characterp component3)
461 (unless (encode-char component3 'ascii)
462 (list (cons component3 1)))
464 ((setq ret (assq 'ideographic-structure component3))
465 (ideographic-structure-to-components-alist (cdr ret))
467 ((setq ret (find-char component3))
472 (defun ids-find-merge-variables (ve1 ve2)
478 (let ((dest-alist ve1)
482 (setq cell (car rest))
483 (if (setq ret (assq (car cell) ve1))
484 (eq (cdr ret)(cdr cell))
485 (setq dest-alist (cons cell dest-alist))))
486 (setq rest (cdr rest)))
492 (defun ideographic-structure-equal (structure1 structure2)
493 (let (dest-alist ret)
494 (and (setq dest-alist (ideographic-structure-character=
495 (car structure1)(car structure2)))
496 (setq ret (ideographic-structure-character=
497 (nth 1 structure1)(nth 1 structure2)))
498 (setq dest-alist (ids-find-merge-variables dest-alist ret))
499 (setq ret (ideographic-structure-character=
500 (nth 2 structure1)(nth 2 structure2)))
501 (setq dest-alist (ids-find-merge-variables dest-alist ret))
502 (if (memq (car structure1) '(?\u2FF2 ?\u2FF3))
503 (and (setq ret (ideographic-structure-character=
504 (nth 3 structure1)(nth 3 structure2)))
505 (setq dest-alist (ids-find-merge-variables dest-alist ret)))
509 (defun ideographic-structure-character= (c1 c2)
511 (cond ((characterp c1)
512 (cond ((encode-char c1 'ascii)
516 (if (encode-char c2 'ascii)
520 ((setq ret2 (find-char c2))
523 ((setq ret2 (assq 'ideographic-structure c2))
524 (and (setq ret (get-char-attribute c1 'ideographic-structure))
525 (ideographic-structure-equal ret (cdr ret2)))
528 ((setq ret (assq 'ideographic-structure c1))
529 (cond ((characterp c2)
530 (if (encode-char c2 'ascii)
532 (and (setq ret2 (get-char-attribute c2 'ideographic-structure))
533 (ideographic-structure-equal (cdr ret) ret2)))
535 ((setq ret2 (find-char c2))
536 (and (setq ret2 (get-char-attribute ret2 'ideographic-structure))
537 (ideographic-structure-equal (cdr ret) ret2))
539 ((setq ret2 (assq 'ideographic-structure c2))
540 (ideographic-structure-equal (cdr ret)(cdr ret2))
543 ((setq ret (find-char c1))
544 (cond ((characterp c2)
545 (if (encode-char c2 'ascii)
549 ((setq ret2 (find-char c2))
552 ((setq ret2 (assq 'ideographic-structure c2))
553 (and (setq ret (get-char-attribute ret 'ideographic-structure))
554 (ideographic-structure-equal ret (cdr ret2))
558 (defun ideographic-structure-find-chars (structure)
559 (let ((comp-alist (ideographic-structure-to-components-alist structure))
562 (sort (mapcar (lambda (cell)
563 (if (setq ret (get-char-attribute
564 (car cell) 'ideographic-products))
565 (cons ret (length ret))
569 (< (cdr a)(cdr b))))))
570 (when (or (and (setq str
571 (get-char-attribute pc 'ideographic-structure))
572 (ideographic-structure-equal str structure))
574 (get-char-attribute pc 'ideographic-structure@apparent))
575 (ideographic-structure-equal str structure)))
576 (setq pl (cons pc pl))
581 (defun ideographic-char-count-components (char component)
584 (cond ((eq char component)
586 ((setq structure (get-char-attribute char 'ideographic-structure))
587 (dolist (cell (ideographic-structure-to-components-alist structure))
590 (if (eq (car cell) char)
592 (* (ideographic-char-count-components (car cell) component)
600 (defun ideographic-character-get-structure (character)
601 "Return ideographic-structure of CHARACTER.
602 CHARACTER can be a character or char-spec."
603 (mapcar (lambda (cell)
604 (or (and (listp cell)
608 (cond ((characterp character)
609 (get-char-attribute character 'ideographic-structure)
611 ((setq ret (assq 'ideographic-structure character))
614 ((setq ret (find-char character))
615 (get-char-attribute ret 'ideographic-structure)
619 (defun ideographic-char-match-component (char component)
620 "Return non-nil if character CHAR has COMPONENT in ideographic-structure.
621 COMPONENT can be a character or char-spec."
622 (or (ideographic-structure-character= char component)
623 (let ((str (ideographic-character-get-structure char)))
625 (or (ideographic-char-match-component (nth 1 str) component)
626 (ideographic-char-match-component (nth 2 str) component)
627 (if (memq (car str) '(?\u2FF2 ?\u2FF3))
628 (ideographic-char-match-component (nth 3 str) component)))))))
630 (defun ideographic-structure-char< (a b)
631 (let ((sa (get-char-attribute a 'ideographic-structure))
632 (sb (get-char-attribute b 'ideographic-structure))
636 (setq tsa (char-total-strokes a)
637 tsb (char-total-strokes b))
642 (ideograph-char< a b)))
646 (ideograph-char< a b))))
654 (setq tsa (char-total-strokes a)
655 tsb (char-total-strokes b))
660 (ideograph-char< a b)))
664 (ideograph-char< a b)))
669 (defun ideo-comp-tree-adjoin (tree char)
673 (while (and (not finished)
675 (setq cell (pop rest))
676 (cond ((ideographic-structure-character= char (car cell))
681 ((ideographic-char-match-component char (car cell))
683 (cons (cons (car cell)
684 (ideo-comp-tree-adjoin (cdr cell) char))
688 ((ideographic-char-match-component (car cell) char)
689 (setq included (cons cell included))
692 ;; (setq other (cons cell other))
695 (setq dest (cons cell dest))
701 (cons (cons char included)
705 (cons (list char) tree)
708 (defun ideographic-chars-to-is-a-tree (chars)
710 (dolist (char (sort (copy-list chars) #'ideographic-structure-char<))
711 (setq tree (ideo-comp-tree-adjoin tree char)))
714 (defun ids-find-chars-including-ids (structure)
715 (let (comp-alist comp-spec ret str rest)
717 ((characterp structure)
718 (setq rest (copy-list (get-char-attribute structure 'ideographic-products)))
720 ((setq ret (ideographic-structure-find-chars structure))
725 (copy-list (get-char-attribute pc 'ideographic-products)))))
728 (setq comp-alist (ideographic-structure-to-components-alist structure)
729 comp-spec (list (cons 'ideographic-structure structure)))
731 (sort (mapcar (lambda (cell)
732 (if (setq ret (get-char-attribute
733 (car cell) 'ideographic-products))
734 (cons ret (length ret))
738 (< (cdr a)(cdr b))))))
739 (when (and (every (lambda (cell)
740 (>= (ideographic-char-count-components pc (car cell))
743 (or (ideographic-char-match-component pc comp-spec)
744 (and (setq str (get-char-attribute pc 'ideographic-structure))
745 (ideographic-char-match-component
748 'ideographic-structure
749 (functional-ideographic-structure-to-apparent-structure
754 (ideographic-chars-to-is-a-tree rest)))
756 (defun functional-ideographic-structure-to-apparent-structure (structure)
757 (ideographic-structure-compare-functional-and-apparent
758 structure nil 'conversion-only))
761 (defun ideographic-structure-compact (structure)
762 (let ((rest structure)
766 (setq cell (pop rest))
769 (cond ((setq ret (assq 'ideographic-structure cell))
776 (cond ((setq ret (ideographic-structure-find-chars sub))
779 ((setq ret (ideographic-structure-compact sub))
780 (list (cons 'ideographic-structure ret))
783 (list (cons 'ideographic-structure sub))))
786 (setq dest (cons cell dest)))
789 (defun ideographic-structure-compare-functional-and-apparent (structure
792 (let (enc enc-str enc2-str enc3-str new-str new-str-c
793 f-res a-res ret code)
795 ((eq (car structure) ?⿸)
796 (setq enc (nth 1 structure))
798 (cond ((characterp enc)
799 (get-char-attribute enc 'ideographic-structure)
802 (cdr (assq 'ideographic-structure enc))
805 ((eq (car enc-str) ?⿰)
806 (unless conversion-only
807 (setq f-res (ids-find-chars-including-ids enc-str)))
808 (setq new-str (list ?⿱
812 (if (setq ret (ideographic-structure-find-chars new-str))
814 (list (cons 'ideographic-structure new-str))))
816 (list ?⿰ (nth 1 enc-str) new-str-c)
817 (setq a-res (ids-find-chars-including-ids new-str))
822 (list ?⿰ (nth 1 enc-str) new-str-c)
825 ((and (eq (car enc-str) ?⿲)
826 (memq (char-ucs (nth 1 enc-str)) '(#x4EBB #x2E85))
827 (eq (nth 2 enc-str) ?丨))
828 (unless conversion-only
829 (setq f-res (ids-find-chars-including-ids enc-str)))
830 (setq new-str (list ?⿱
834 (if (setq ret (ideographic-structure-find-chars new-str))
836 (list (cons 'ideographic-structure new-str))))
838 (list ?⿰ (decode-char '=big5-cdp #x8B7A) new-str-c)
839 (setq a-res (ids-find-chars-including-ids new-str))
844 (list ?⿰ (decode-char '=big5-cdp #x8B7A) new-str-c)
847 ((eq (car enc-str) ?⿱)
848 (unless conversion-only
849 (setq f-res (ids-find-chars-including-ids enc-str)))
853 ((characterp (nth 2 enc-str))
854 (if (or (memq (encode-char (nth 2 enc-str) '=>ucs@component)
855 '(#x20087 #x5382 #x4E06))
856 (eq (encode-char (nth 2 enc-str) '=>ucs@iwds-1)
858 (eq (encode-char (nth 2 enc-str) '=ucs-itaiji-001)
860 (eq (encode-char (nth 2 enc-str) '=big5-cdp)
862 (eq (encode-char (nth 2 enc-str) '=>big5-cdp)
864 (eq (encode-char (nth 2 enc-str) '=big5-cdp)
866 (eq (or (encode-char (nth 2 enc-str) '=>big5-cdp)
867 (encode-char (nth 2 enc-str) '=big5-cdp-itaiji-001))
869 (eq (car (get-char-attribute (nth 2 enc-str)
870 'ideographic-structure))
874 ((eq (car (cdr (assq 'ideographic-structure (nth 2 enc-str))))
882 (if (setq ret (ideographic-structure-find-chars new-str))
884 (list (cons 'ideographic-structure new-str))))
886 (list ?⿱ (nth 1 enc-str) new-str-c)
887 (setq a-res (ids-find-chars-including-ids new-str))
892 (list ?⿱ (nth 1 enc-str) new-str-c)
893 (if (eq (car new-str) ?⿸)
897 ((eq (car enc-str) ?⿸)
898 (unless conversion-only
899 (setq f-res (ids-find-chars-including-ids enc-str)))
900 (setq new-str (list (cond
901 ((characterp (nth 2 enc-str))
902 (if (memq (char-ucs (nth 2 enc-str))
912 (if (setq ret (ideographic-structure-find-chars new-str))
914 (list (cons 'ideographic-structure new-str))))
916 (list ?⿸ (nth 1 enc-str) new-str-c)
917 (setq a-res (ids-find-chars-including-ids new-str))
922 (list ?⿸ (nth 1 enc-str) new-str-c)
923 (if (eq (car new-str) ?⿰)
928 ((eq (car structure) ?⿹)
929 (setq enc (nth 1 structure))
931 (cond ((characterp enc)
932 (get-char-attribute enc 'ideographic-structure)
935 (cdr (assq 'ideographic-structure enc))
938 ((eq (car enc-str) ?⿰)
939 (unless conversion-only
940 (setq f-res (ids-find-chars-including-ids enc-str)))
941 (setq new-str (list ?⿱
945 (if (setq ret (ideographic-structure-find-chars new-str))
947 (list (cons 'ideographic-structure new-str))))
949 (list ?⿰ new-str-c (nth 2 enc-str))
950 (setq a-res (ids-find-chars-including-ids new-str))
955 (list ?⿰ new-str-c (nth 2 enc-str))
959 ((eq (get-char-attribute (car structure) '=ucs-itaiji-001) #x2FF6)
960 (setq enc (nth 1 structure))
962 (cond ((characterp enc)
963 (get-char-attribute enc 'ideographic-structure)
966 (cdr (assq 'ideographic-structure enc))
969 ((eq (car enc-str) ?⿺)
970 (unless conversion-only
971 (setq f-res (ids-find-chars-including-ids enc-str)))
972 (setq new-str (list ?⿱
976 (if (setq ret (ideographic-structure-find-chars new-str))
978 (list (cons 'ideographic-structure new-str))))
980 (list ?⿺ new-str-c (nth 2 enc-str))
981 (setq a-res (ids-find-chars-including-ids new-str))
986 (list ?⿺ new-str-c (nth 2 enc-str))
989 ((eq (car enc-str) ?⿱)
990 (unless conversion-only
991 (setq f-res (ids-find-chars-including-ids enc-str)))
992 (setq new-str (list ?⿰
996 (if (setq ret (ideographic-structure-find-chars new-str))
998 (list (cons 'ideographic-structure new-str))))
1000 (list ?⿱ new-str-c (nth 2 enc-str))
1001 (setq a-res (ids-find-chars-including-ids new-str))
1006 (list ?⿱ new-str-c (nth 2 enc-str))
1009 ((eq (car enc-str) ?⿰)
1010 (unless conversion-only
1011 (setq f-res (ids-find-chars-including-ids enc-str)))
1012 (setq new-str (list ?⿱
1016 (if (setq ret (ideographic-structure-find-chars new-str))
1018 (list (cons 'ideographic-structure new-str))))
1020 (list ?⿰ new-str-c (nth 2 enc-str))
1021 (setq a-res (ids-find-chars-including-ids new-str))
1026 (list ?⿰ new-str-c (nth 2 enc-str))
1031 ((eq (car structure) ?⿴)
1032 (setq enc (nth 1 structure))
1034 (cond ((characterp enc)
1035 (get-char-attribute enc 'ideographic-structure)
1038 (cdr (assq 'ideographic-structure enc))
1041 ((eq (car enc-str) ?⿱)
1043 ((and (characterp (nth 2 enc-str))
1044 (or (memq (char-ucs (nth 2 enc-str)) '(#x56D7 #x5F51 #x897F))
1045 (eq (char-feature (nth 2 enc-str) '=>big5-cdp)
1047 (unless conversion-only
1048 (setq f-res (ids-find-chars-including-ids enc-str)))
1049 (setq new-str (list ?⿴
1053 (if (setq ret (ideographic-structure-find-chars new-str))
1055 (list (cons 'ideographic-structure new-str))))
1057 (list ?⿱ (nth 1 enc-str) new-str-c)
1058 (setq a-res (ids-find-chars-including-ids new-str))
1063 (list ?⿱ (nth 1 enc-str) new-str-c)
1066 ((and (characterp (nth 2 enc-str))
1067 (eq (char-ucs (nth 2 enc-str)) #x51F5))
1068 (unless conversion-only
1069 (setq f-res (ids-find-chars-including-ids enc-str)))
1070 (setq new-str (list ?⿶
1074 (if (setq ret (ideographic-structure-find-chars new-str))
1076 (list (cons 'ideographic-structure new-str))))
1078 (list ?⿱ (nth 1 enc-str) new-str-c)
1079 (setq a-res (ids-find-chars-including-ids new-str))
1084 (list ?⿱ (nth 1 enc-str) new-str-c)
1087 ((and (characterp (nth 1 enc-str))
1088 (eq (char-feature (nth 1 enc-str) '=>ucs@component)
1090 (unless conversion-only
1091 (setq f-res (ids-find-chars-including-ids enc-str)))
1092 (setq new-str (list ?⿵
1096 (if (setq ret (ideographic-structure-find-chars new-str))
1098 (list (cons 'ideographic-structure new-str))))
1100 (list ?⿱ new-str-c (nth 2 enc-str))
1101 (setq a-res (ids-find-chars-including-ids new-str))
1106 (list ?⿱ new-str-c (nth 2 enc-str))
1110 (unless conversion-only
1111 (setq f-res (ids-find-chars-including-ids enc-str)))
1112 (setq new-str (list ?⿱ (nth 2 structure) (nth 2 enc-str)))
1114 (if (setq ret (ideographic-structure-find-chars new-str))
1116 (list (cons 'ideographic-structure new-str))))
1118 (list ?⿱ (nth 1 enc-str) new-str-c)
1119 (setq a-res (ids-find-chars-including-ids new-str))
1124 (list ?⿱ (nth 1 enc-str) new-str-c)
1128 ((eq (car enc-str) ?⿳)
1130 ((and (characterp (nth 2 enc-str))
1131 (eq (char-ucs (nth 2 enc-str)) #x56D7))
1132 (unless conversion-only
1133 (setq f-res (ids-find-chars-including-ids enc-str)))
1134 (setq new-str (list ?⿴ (nth 2 enc-str) (nth 2 structure)))
1136 (if (setq ret (ideographic-structure-find-chars new-str))
1138 (list (cons 'ideographic-structure new-str))))
1139 (setq new-str (list ?⿱ (nth 1 enc-str) new-str-c))
1141 (if (setq ret (ideographic-structure-find-chars new-str))
1143 (list (cons 'ideographic-structure new-str))))
1145 (list ?⿱ new-str-c (nth 3 enc-str))
1146 (setq a-res (ids-find-chars-including-ids new-str))
1151 (list ?⿱ new-str-c (nth 3 enc-str))
1154 ((and (characterp (nth 2 enc-str))
1155 (eq (char-ucs (nth 2 enc-str)) #x5196))
1156 (unless conversion-only
1157 (setq f-res (ids-find-chars-including-ids enc-str)))
1158 (setq new-str (list ?⿱ (nth 1 enc-str) (nth 2 enc-str)))
1160 (if (setq ret (ideographic-structure-find-chars new-str))
1162 (list (cons 'ideographic-structure new-str))))
1163 (setq new-str (list ?⿱ new-str-c (nth 2 structure)))
1165 (if (setq ret (ideographic-structure-find-chars new-str))
1167 (list (cons 'ideographic-structure new-str))))
1169 (list ?⿱ new-str-c (nth 3 enc-str))
1170 (setq a-res (ids-find-chars-including-ids new-str))
1175 (list ?⿱ new-str-c (nth 3 enc-str))
1178 ((and (characterp (nth 2 enc-str))
1179 (or (eq (encode-char (nth 2 enc-str) '=>big5-cdp)
1181 (eq (encode-char (nth 2 enc-str) '=>gt-k)
1183 (eq (char-ucs (nth 2 enc-str)) #x2008A)))
1184 (unless conversion-only
1185 (setq f-res (ids-find-chars-including-ids enc-str)))
1186 (setq new-str (list ?⿱ (nth 2 structure) (nth 2 enc-str)))
1188 (if (setq ret (ideographic-structure-find-chars new-str))
1190 (list (cons 'ideographic-structure new-str))))
1191 (setq new-str (list ?⿸ new-str-c (nth 3 enc-str)))
1193 (if (setq ret (ideographic-structure-find-chars new-str))
1195 (list (cons 'ideographic-structure new-str))))
1197 (list ?⿱ (nth 1 enc-str) new-str-c)
1198 (setq a-res (ids-find-chars-including-ids new-str))
1203 (list ?⿱ (nth 1 enc-str) new-str-c)
1207 (unless conversion-only
1208 (setq f-res (ids-find-chars-including-ids enc-str)))
1209 (setq new-str (list ?⿻ (nth 2 enc-str) (nth 2 structure)))
1211 (if (setq ret (ideographic-structure-find-chars new-str))
1213 (list (cons 'ideographic-structure new-str))))
1214 (setq new-str (list ?⿱ (nth 1 enc-str) new-str-c))
1216 (if (setq ret (ideographic-structure-find-chars new-str))
1218 (list (cons 'ideographic-structure new-str))))
1220 (list ?⿱ new-str-c (nth 3 enc-str))
1221 (setq a-res (ids-find-chars-including-ids new-str))
1226 (list ?⿱ new-str-c (nth 3 enc-str))
1230 ((eq (car enc-str) ?⿰)
1232 ((equal (nth 1 enc-str)(nth 2 enc-str))
1233 (unless conversion-only
1234 (setq f-res (ids-find-chars-including-ids enc-str)))
1235 (setq new-str (list ?⿲
1240 (list (cons 'ideographic-structure new-str)))
1243 (setq a-res (ids-find-chars-including-ids new-str))
1252 (unless conversion-only
1253 (setq f-res (ids-find-chars-including-ids enc-str)))
1254 (setq new-str (list ?⿰
1258 (if (setq ret (ideographic-structure-find-chars new-str))
1260 (list (cons 'ideographic-structure new-str))))
1262 (list ?⿰ (nth 1 enc-str) new-str-c)
1263 (setq a-res (ids-find-chars-including-ids new-str))
1268 (list ?⿰ (nth 1 enc-str) new-str-c)
1274 ((eq (car structure) ?⿶)
1275 (setq enc (nth 1 structure))
1277 (cond ((characterp enc)
1278 (get-char-attribute enc 'ideographic-structure)
1281 (cdr (assq 'ideographic-structure enc))
1284 ((eq (car enc-str) ?⿱)
1285 (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
1287 (eq (car enc2-str) ?⿰))
1288 (unless conversion-only
1289 (setq f-res (ids-find-chars-including-ids enc-str)))
1290 (setq new-str (list ?⿲
1295 (if (setq ret (ideographic-structure-find-chars new-str))
1297 (list (cons 'ideographic-structure new-str))))
1299 (list ?⿱ new-str-c (nth 2 enc-str))
1300 (setq a-res (ids-find-chars-including-ids new-str))
1305 (list ?⿱ new-str-c (nth 2 enc-str))
1309 ((eq (car enc-str) ?⿳)
1310 (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
1312 (eq (car enc2-str) ?⿰))
1313 (unless conversion-only
1314 (setq f-res (ids-find-chars-including-ids enc-str)))
1315 (setq new-str (list ?⿲
1320 (if (setq ret (ideographic-structure-find-chars new-str))
1322 (list (cons 'ideographic-structure new-str))))
1324 (list ?⿳ new-str-c (nth 2 enc-str) (nth 3 enc-str))
1325 (setq a-res (ids-find-chars-including-ids new-str))
1330 (list ?⿳ new-str-c (nth 2 enc-str) (nth 3 enc-str))
1334 ((eq (car enc-str) ?⿲)
1335 (unless conversion-only
1336 (setq f-res (ids-find-chars-including-ids enc-str)))
1337 (setq new-str (list ?⿱
1341 (if (setq ret (ideographic-structure-find-chars new-str))
1343 (list (cons 'ideographic-structure new-str))))
1345 (list ?⿲ (nth 1 enc-str) new-str-c (nth 3 enc-str))
1346 (setq a-res (ids-find-chars-including-ids new-str))
1351 (list ?⿲ (nth 1 enc-str) new-str-c (nth 3 enc-str))
1354 ((eq (car enc-str) ?⿴)
1355 (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
1357 (eq (car enc2-str) ?⿰))
1358 (unless conversion-only
1359 (setq f-res (ids-find-chars-including-ids enc-str)))
1360 (setq new-str (list ?⿱
1364 (if (setq ret (ideographic-structure-find-chars new-str))
1366 (list (cons 'ideographic-structure new-str))))
1368 (list ?⿲ (nth 1 enc2-str) new-str-c (nth 2 enc2-str))
1369 (setq a-res (ids-find-chars-including-ids new-str))
1374 (list ?⿲ (nth 1 enc2-str) new-str-c (nth 2 enc2-str))
1379 ((eq (car structure) ?⿵)
1380 (setq enc (nth 1 structure))
1382 (cond ((characterp enc)
1383 (get-char-attribute enc 'ideographic-structure)
1386 (cdr (assq 'ideographic-structure enc))
1389 ((eq (car enc-str) ?⿱)
1391 ((and (characterp (nth 2 enc-str))
1392 (memq (char-ucs (nth 2 enc-str))
1394 (unless conversion-only
1395 (setq f-res (ids-find-chars-including-ids enc-str)))
1396 (setq new-str (list ?⿵
1400 (if (setq ret (ideographic-structure-find-chars new-str))
1402 (list (cons 'ideographic-structure new-str))))
1404 (list ?⿱ (nth 1 enc-str) new-str-c)
1405 (setq a-res (ids-find-chars-including-ids new-str))
1410 (list ?⿱ (nth 1 enc-str) new-str-c)
1413 ((and (setq enc2-str (ideographic-character-get-structure (nth 2 enc-str)))
1415 ((eq (car enc2-str) ?⿰)
1418 ((eq (car enc2-str) ?⿲)
1421 ((and (eq (car enc2-str) ?⿱)
1423 (ideographic-character-get-structure (nth 2 enc2-str)))
1424 (eq (car enc3-str) ?⿰))
1427 (unless conversion-only
1428 (setq f-res (ids-find-chars-including-ids enc-str)))
1430 (cond ((eq code 611)
1445 (list (list 'ideographic-structure
1452 (if (setq ret (ideographic-structure-find-chars new-str))
1454 (list (cons 'ideographic-structure
1455 (ideographic-structure-compact new-str)))))
1457 (cond ((or (eq code 611)
1459 (list ?⿱ (nth 1 enc-str) new-str-c)
1462 (list ?⿳ (nth 1 enc-str)(nth 1 enc2-str) new-str-c)
1464 (setq a-res (ids-find-chars-including-ids new-str))
1469 (cond ((or (eq code 611)
1471 (list ?⿱ (nth 1 enc-str) new-str-c)
1474 (list ?⿳ (nth 1 enc-str)(nth 1 enc2-str) new-str-c)
1479 ((eq (car enc-str) ?⿳)
1480 (setq enc2-str (ideographic-character-get-structure (nth 3 enc-str)))
1482 (eq (car enc2-str) ?⿰))
1483 (unless conversion-only
1484 (setq f-res (ids-find-chars-including-ids enc-str)))
1485 (setq new-str (list ?⿲
1490 (if (setq ret (ideographic-structure-find-chars new-str))
1492 (list (cons 'ideographic-structure new-str))))
1494 (list ?⿳ (nth 1 enc-str) (nth 2 enc-str) new-str-c)
1495 (setq a-res (ids-find-chars-including-ids new-str))
1500 (list ?⿳ (nth 1 enc-str) (nth 2 enc-str) new-str-c)
1504 ((eq (car enc-str) ?⿲)
1505 (unless conversion-only
1506 (setq f-res (ids-find-chars-including-ids enc-str)))
1507 (setq new-str (list ?⿱
1511 (if (setq ret (ideographic-structure-find-chars new-str))
1513 (list (cons 'ideographic-structure new-str))))
1515 (list ?⿲ (nth 1 enc-str) new-str-c (nth 3 enc-str))
1516 (setq a-res (ids-find-chars-including-ids new-str))
1521 (list ?⿲ (nth 1 enc-str) new-str-c (nth 3 enc-str))
1524 ((eq (car enc-str) ?⿴)
1525 (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
1527 (eq (car enc2-str) ?⿰))
1528 (unless conversion-only
1529 (setq f-res (ids-find-chars-including-ids enc-str)))
1530 (setq new-str (list ?⿱
1534 (if (setq ret (ideographic-structure-find-chars new-str))
1536 (list (cons 'ideographic-structure new-str))))
1538 (list ?⿲ (nth 1 enc2-str) new-str-c (nth 2 enc2-str))
1539 (setq a-res (ids-find-chars-including-ids new-str))
1544 (list ?⿲ (nth 1 enc2-str) new-str-c (nth 2 enc2-str))
1549 ((eq (car structure) ?⿷)
1550 (setq enc (nth 1 structure))
1552 (cond ((characterp enc)
1553 (get-char-attribute enc 'ideographic-structure)
1556 (cdr (assq 'ideographic-structure enc))
1559 ((eq (car enc-str) ?⿺)
1560 (unless conversion-only
1561 (setq f-res (ids-find-chars-including-ids enc-str)))
1562 (setq new-str (list ?⿱
1566 (if (setq ret (ideographic-structure-find-chars new-str))
1568 (list (cons 'ideographic-structure new-str))))
1570 (list ?⿺ (nth 1 enc-str) new-str-c)
1571 (setq a-res (ids-find-chars-including-ids new-str))
1576 (list ?⿺ (nth 1 enc-str) new-str-c)
1580 ((eq (car structure) ?⿺)
1581 (setq enc (nth 1 structure))
1583 (cond ((characterp enc)
1584 (or (get-char-attribute enc 'ideographic-structure)
1585 (get-char-attribute enc 'ideographic-structure@apparent))
1588 (or (cdr (assq 'ideographic-structure enc))
1589 (cdr (assq 'ideographic-structure@apparent enc)))
1592 ;; (mapcar (lambda (cell)
1593 ;; (or (and (listp cell)
1594 ;; (find-char cell))
1598 ((eq (car enc-str) ?⿱)
1600 ((and (characterp (nth 1 enc-str))
1601 (or (and (eq (char-ucs (nth 1 enc-str)) #x200CA)
1603 (and (eq (char-feature (nth 1 enc-str) '=>iwds-1) 233)
1604 (characterp (nth 2 structure))
1605 (eq (char-ucs (nth 2 structure)) #x4E36)
1607 (unless conversion-only
1608 (setq f-res (ids-find-chars-including-ids enc-str)))
1609 (setq new-str (list ?⿺
1613 (if (setq ret (ideographic-structure-find-chars new-str))
1615 (list (cons 'ideographic-structure new-str))))
1617 (list ?⿱ new-str-c (nth 2 enc-str))
1618 (setq a-res (ids-find-chars-including-ids new-str))
1623 (list ?⿱ new-str-c (nth 2 enc-str))
1626 ((and (characterp (nth 2 enc-str))
1627 (or (memq (char-ucs (nth 2 enc-str))
1630 #x65E5 #x66F0 #x5FC3
1631 #x2123C #x58EC #x738B #x7389))
1632 (memq (encode-char (nth 2 enc-str) '=>ucs@component)
1634 (eq (encode-char (nth 2 enc-str) '=>ucs@iwds-1)
1636 (unless conversion-only
1637 (setq f-res (ids-find-chars-including-ids enc-str)))
1638 (setq new-str (list ?⿰
1642 (if (setq ret (ideographic-structure-find-chars new-str))
1644 (list (cons 'ideographic-structure new-str))))
1646 (list ?⿱ new-str-c (nth 2 enc-str))
1647 (setq a-res (ids-find-chars-including-ids new-str))
1652 (list ?⿱ new-str-c (nth 2 enc-str))
1657 ((eq (car structure) ?⿻)
1658 (setq enc (nth 1 structure))
1660 (cond ((characterp enc)
1661 (get-char-attribute enc 'ideographic-structure)
1664 (cdr (assq 'ideographic-structure enc))
1667 ((eq (car enc-str) ?⿱)
1668 (unless conversion-only
1669 (setq f-res (ids-find-chars-including-ids enc-str)))
1671 (list ?⿳ (nth 1 enc-str) (nth 2 structure) (nth 2 enc-str))
1691 ;;; ids-find.el ends here