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)
65 (ids-index-store-structure c v)
67 'ideographic-structure@apparent/leftmost)
69 (save-char-attribute-table 'ideographic-products)))
72 (mount-char-attribute-table 'ideographic-products)
75 (defun ids-find-all-products (char)
77 (dolist (cell (char-feature char 'ideographic-products))
78 (unless (memq cell dest)
79 (setq dest (cons cell dest)))
80 (setq dest (union dest (ids-find-all-products cell))))
83 (defun of-component-features ()
85 (dolist (feature (char-attribute-list))
86 (when (string-match "^<-.*[@/]component\\(/[^*/]+\\)*$"
87 (symbol-name feature))
89 (list* '<-mistakable '->mistakable
92 '<-original '->original
96 (defun to-component-features ()
98 (dolist (feature (char-attribute-list))
99 (when (string-match "^->.*[@/]component\\(/[^*/]+\\)*$"
100 (symbol-name feature))
101 (push feature dest)))
105 (defun char-component-variants (char)
106 (let ((dest (list char))
108 (dolist (feature (to-component-features))
109 (if (setq ret (get-char-attribute char feature))
111 (setq dest (union dest (char-component-variants c))))))
113 ;; ((setq ret (some (lambda (feature)
114 ;; (get-char-attribute char feature))
115 ;; (to-component-features)))
117 ;; (setq dest (union dest (char-component-variants c))))
119 ((setq ret (get-char-attribute char '->ucs-unified))
120 (setq dest (cons char ret))
122 (setq dest (union dest
123 (some (lambda (feature)
124 (get-char-attribute c feature))
125 (of-component-features))
128 ((and (setq ret (get-char-attribute char '=>ucs))
129 (setq uchr (decode-char '=ucs ret)))
130 (setq dest (cons uchr (char-variants uchr)))
132 (setq dest (union dest
133 (some (lambda (feature)
134 (get-char-attribute c feature))
135 (of-component-features))
141 (unless (memq c dest)
142 (setq dest (cons c dest)))
145 (some (lambda (feature)
146 (char-feature c feature))
147 (of-component-features))
155 (defun ideographic-products-find (&rest components)
156 (if (stringp (car components))
157 (setq components (string-to-char-list (car components))))
159 (dolist (variant (char-component-variants (car components)))
162 (get-char-attribute variant 'ideographic-products))))
165 (setq components (cdr components)))
167 (dolist (variant (char-component-variants (car components)))
170 (get-char-attribute variant 'ideographic-products))))
171 (setq dest (intersection dest products)))
174 (defun ideograph-find-products-with-variants (components &optional ignored-chars)
175 (if (stringp components)
176 (setq components (string-to-char-list components)))
178 (dolist (variant (char-component-variants (car components)))
182 (get-char-attribute variant 'ideographic-products)
186 (setq components (cdr components)))
188 (dolist (variant (char-component-variants (car components)))
192 (get-char-attribute variant 'ideographic-products)
194 (setq dest (intersection dest products)))
197 (defun ideograph-find-products (components &optional ignored-chars)
198 (if (stringp components)
199 (setq components (string-to-char-list components)))
201 ;; (dolist (variant (char-component-variants (car components)))
204 ;; (get-char-attribute variant 'ideographic-products))))
205 ;; (setq dest products)
206 (setq dest (get-char-attribute (car components) 'ideographic-products))
208 (setq components (cdr components)))
209 ;; (setq products nil)
210 ;; (dolist (variant (char-component-variants (car components)))
213 ;; (get-char-attribute variant 'ideographic-products))))
214 (setq products (get-char-attribute (car components) 'ideographic-products))
215 (setq dest (intersection dest products)))
219 (defun ideographic-structure-char= (c1 c2)
222 (let ((m1 (char-ucs c1))
226 (memq c1 (char-component-variants c2)))))))
228 (defun ideographic-structure-member-compare-components (component s-component)
230 (cond ((char-ref= component s-component #'ideographic-structure-char=))
232 (if (setq ret (assq 'ideographic-structure s-component))
233 (ideographic-structure-member component (cdr ret))))
234 ((setq ret (get-char-attribute s-component 'ideographic-structure))
235 (ideographic-structure-member component ret)))))
238 (defun ideographic-structure-member (component structure)
239 "Return non-nil if COMPONENT is included in STRUCTURE."
240 (or (memq component structure)
242 (setq structure (cdr structure))
243 (ideographic-structure-member-compare-components
244 component (car structure)))
246 (setq structure (cdr structure))
247 (ideographic-structure-member-compare-components
248 component (car structure)))
250 (setq structure (cdr structure))
252 (ideographic-structure-member-compare-components
253 component (car structure))))))
257 (defun ideographic-structure-repertoire-p (structure components)
258 "Return non-nil if STRUCTURE can be constructed by a subset of COMPONENTS."
260 (let (ret s-component)
262 (while (setq structure (cdr structure))
263 (setq s-component (car structure))
264 (unless (characterp s-component)
265 (if (setq ret (find-char s-component))
266 (setq s-component ret)))
269 (if (setq ret (assq 'ideographic-structure s-component))
270 (ideographic-structure-repertoire-p
271 (cdr ret) components)))
272 ((member* s-component components
273 :test #'ideographic-structure-char=))
275 (get-char-attribute s-component
276 'ideographic-structure))
277 (ideographic-structure-repertoire-p ret components)))
282 (defvar ids-find-result-buffer "*ids-chars*")
284 (defun ids-find-format-line (c v)
285 (format "%c\t%s\t%s\n"
287 (or (let ((ucs (or (char-ucs c)
288 (encode-char c 'ucs))))
290 (cond ((<= ucs #xFFFF)
291 (format " U+%04X" ucs))
293 (format "U-%08X" ucs)))))
295 (or (ideographic-structure-to-ids v)
298 (defun ids-insert-chars-including-components* (components
299 &optional level ignored-chars)
303 (dolist (c (sort (copy-list (ideograph-find-products components
306 (if (setq as (char-total-strokes a))
307 (if (setq bs (char-total-strokes b))
309 (ideograph-char< a b)
312 (ideograph-char< a b)))))
313 (unless (memq c ignored-chars)
314 (setq is (char-feature c 'ideographic-structure))
319 (insert (ids-find-format-line c is))
321 (ids-insert-chars-including-components*
322 (char-to-string c) (1+ level)
323 (cons c ignored-chars))))
328 (defun ids-insert-chars-including-components (components
329 &optional level ignored-chars)
334 (ids-insert-chars-including-components* components
335 level ignored-chars)))
337 (dolist (c ignored-chars)
338 (dolist (vc (char-component-variants c))
339 (unless (memq vc ignored-chars)
340 (when (setq is (get-char-attribute vc 'ideographic-structure))
345 (insert (ids-find-format-line vc is))
347 (ids-insert-chars-including-components*
348 (char-to-string vc) (1+ level)
349 (cons vc ignored-chars)))))))
350 (dolist (c (sort (copy-list (ideograph-find-products-with-variants
351 components ignored-chars))
353 (if (setq as (char-total-strokes a))
354 (if (setq bs (char-total-strokes b))
356 (ideograph-char< a b)
359 (ideograph-char< a b)))))
360 (unless (memq c ignored-chars)
361 (setq is (get-char-attribute c 'ideographic-structure))
366 (insert (ids-find-format-line c is))
368 (ids-insert-chars-including-components*
369 (char-to-string c) (1+ level)
370 (cons c ignored-chars))))
376 (defun ids-find-chars-including-components (components)
377 "Search Ideographs whose structures have COMPONENTS."
378 (interactive "sComponents : ")
379 (with-current-buffer (get-buffer-create ids-find-result-buffer)
380 (setq buffer-read-only nil)
382 (ids-insert-chars-including-components components 0 nil)
383 ;; (let ((ignored-chars
385 ;; (ids-insert-chars-including-components components 0 nil
386 ;; #'ideograph-find-products)))
388 ;; (setq rest ignored-chars)
389 ;; ;; (dolist (c rest)
390 ;; ;; (setq ignored-chars
391 ;; ;; (union ignored-chars
392 ;; ;; (ids-insert-chars-including-components
393 ;; ;; (list c) 0 ignored-chars
394 ;; ;; #'ideograph-find-products-with-variants))))
395 ;; (ids-insert-chars-including-components components 0 ignored-chars
396 ;; #'ideograph-find-products-with-variants))
397 (goto-char (point-min)))
398 (view-buffer ids-find-result-buffer))
401 (define-obsolete-function-alias 'ideographic-structure-search-chars
402 'ids-find-chars-including-components)
405 (defun ids-find-chars-covered-by-components (components)
406 "Search Ideographs which structures are consisted by subsets of COMPONENTS."
407 (interactive "sComponents: ")
408 (if (stringp components)
409 (setq components (string-to-char-list components)))
410 (with-current-buffer (get-buffer-create ids-find-result-buffer)
411 (setq buffer-read-only nil)
415 (when (ideographic-structure-repertoire-p v components)
416 (insert (ids-find-format-line c v))))
417 'ideographic-structure)
418 (goto-char (point-min)))
419 (view-buffer ids-find-result-buffer))
422 (defun ideographic-structure-merge-components-alist (ca1 ca2)
423 (let ((dest-alist ca1)
426 (if (setq ret (assq (car cell) dest-alist))
427 (setcdr ret (+ (cdr ret)(cdr cell)))
428 (setq dest-alist (cons cell dest-alist))))
431 (defun ideographic-structure-to-components-alist (structure)
432 (apply #'ideographic-structure-to-components-alist* structure))
434 (defun ideographic-structure-to-components-alist* (operator component1 component2
437 (let (dest-alist ret)
439 (cond ((characterp component1)
440 (unless (encode-char component1 'ascii)
441 (list (cons component1 1)))
443 ((setq ret (assq 'ideographic-structure component1))
444 (ideographic-structure-to-components-alist (cdr ret))
446 ((setq ret (find-char component1))
450 (ideographic-structure-merge-components-alist
452 (cond ((characterp component2)
453 (unless (encode-char component2 'ascii)
454 (list (cons component2 1)))
456 ((setq ret (assq 'ideographic-structure component2))
457 (ideographic-structure-to-components-alist (cdr ret))
459 ((setq ret (find-char component2))
462 (if (memq operator '(?\u2FF2 ?\u2FF3))
463 (ideographic-structure-merge-components-alist
465 (cond ((characterp component3)
466 (unless (encode-char component3 'ascii)
467 (list (cons component3 1)))
469 ((setq ret (assq 'ideographic-structure component3))
470 (ideographic-structure-to-components-alist (cdr ret))
472 ((setq ret (find-char component3))
477 (defun ids-find-merge-variables (ve1 ve2)
483 (let ((dest-alist ve1)
487 (setq cell (car rest))
488 (if (setq ret (assq (car cell) ve1))
489 (eq (cdr ret)(cdr cell))
490 (setq dest-alist (cons cell dest-alist))))
491 (setq rest (cdr rest)))
497 (defun ideographic-structure-equal (structure1 structure2)
498 (let (dest-alist ret)
499 (and (setq dest-alist (ideographic-structure-character=
500 (car structure1)(car structure2)))
501 (setq ret (ideographic-structure-character=
502 (nth 1 structure1)(nth 1 structure2)))
503 (setq dest-alist (ids-find-merge-variables dest-alist ret))
504 (setq ret (ideographic-structure-character=
505 (nth 2 structure1)(nth 2 structure2)))
506 (setq dest-alist (ids-find-merge-variables dest-alist ret))
507 (if (memq (car structure1) '(?\u2FF2 ?\u2FF3))
508 (and (setq ret (ideographic-structure-character=
509 (nth 3 structure1)(nth 3 structure2)))
510 (setq dest-alist (ids-find-merge-variables dest-alist ret)))
514 (defun ideographic-structure-character= (c1 c2)
516 (cond ((characterp c1)
517 (cond ((encode-char c1 'ascii)
521 (if (encode-char c2 'ascii)
525 ((setq ret2 (find-char c2))
528 ((setq ret2 (assq 'ideographic-structure c2))
529 (and (setq ret (get-char-attribute c1 'ideographic-structure))
530 (ideographic-structure-equal ret (cdr ret2)))
533 ((setq ret (assq 'ideographic-structure c1))
534 (cond ((characterp c2)
535 (if (encode-char c2 'ascii)
537 (and (setq ret2 (get-char-attribute c2 'ideographic-structure))
538 (ideographic-structure-equal (cdr ret) ret2)))
540 ((setq ret2 (find-char c2))
541 (and (setq ret2 (get-char-attribute ret2 'ideographic-structure))
542 (ideographic-structure-equal (cdr ret) ret2))
544 ((setq ret2 (assq 'ideographic-structure c2))
545 (ideographic-structure-equal (cdr ret)(cdr ret2))
548 ((setq ret (find-char c1))
549 (cond ((characterp c2)
550 (if (encode-char c2 'ascii)
554 ((setq ret2 (find-char c2))
557 ((setq ret2 (assq 'ideographic-structure c2))
558 (and (setq ret (get-char-attribute ret 'ideographic-structure))
559 (ideographic-structure-equal ret (cdr ret2))
563 (defun ideographic-structure-find-chars (structure)
564 (let ((comp-alist (ideographic-structure-to-components-alist structure))
567 (sort (mapcar (lambda (cell)
568 (if (setq ret (get-char-attribute
569 (car cell) 'ideographic-products))
570 (cons ret (length ret))
574 (< (cdr a)(cdr b))))))
575 (when (or (and (setq str
576 (get-char-attribute pc 'ideographic-structure))
577 (ideographic-structure-equal str structure))
579 (get-char-attribute pc 'ideographic-structure@apparent))
580 (ideographic-structure-equal str structure))
582 (get-char-attribute pc 'ideographic-structure@apparent/leftmost))
583 (ideographic-structure-equal str structure)))
584 (setq pl (cons pc pl))
589 (defun ideographic-char-count-components (char component)
592 (cond ((eq char component)
594 ((setq structure (get-char-attribute char 'ideographic-structure))
595 (dolist (cell (ideographic-structure-to-components-alist structure))
598 (if (eq (car cell) char)
600 (* (ideographic-char-count-components (car cell) component)
608 (defun ideographic-character-get-structure (character)
609 "Return ideographic-structure of CHARACTER.
610 CHARACTER can be a character or char-spec."
611 (mapcar (lambda (cell)
612 (or (and (listp cell)
616 (cond ((characterp character)
617 (get-char-attribute character 'ideographic-structure)
619 ((setq ret (assq 'ideographic-structure character))
622 ((setq ret (find-char character))
623 (get-char-attribute ret 'ideographic-structure)
627 (defun ideographic-char-match-component (char component)
628 "Return non-nil if character CHAR has COMPONENT in ideographic-structure.
629 COMPONENT can be a character or char-spec."
630 (or (ideographic-structure-character= char component)
631 (let ((str (ideographic-character-get-structure char)))
633 (or (ideographic-char-match-component (nth 1 str) component)
634 (ideographic-char-match-component (nth 2 str) component)
635 (if (memq (car str) '(?\u2FF2 ?\u2FF3))
636 (ideographic-char-match-component (nth 3 str) component)))))))
638 (defun ideographic-structure-char< (a b)
639 (let ((sa (get-char-attribute a 'ideographic-structure))
640 (sb (get-char-attribute b 'ideographic-structure))
644 (setq tsa (char-total-strokes a)
645 tsb (char-total-strokes b))
650 (ideograph-char< a b)))
654 (ideograph-char< a b))))
662 (setq tsa (char-total-strokes a)
663 tsb (char-total-strokes b))
668 (ideograph-char< a b)))
672 (ideograph-char< a b)))
677 (defun ideo-comp-tree-adjoin (tree char)
681 (while (and (not finished)
683 (setq cell (pop rest))
684 (cond ((ideographic-structure-character= char (car cell))
689 ((ideographic-char-match-component char (car cell))
691 (cons (cons (car cell)
692 (ideo-comp-tree-adjoin (cdr cell) char))
696 ((ideographic-char-match-component (car cell) char)
697 (setq included (cons cell included))
700 ;; (setq other (cons cell other))
703 (setq dest (cons cell dest))
709 (cons (cons char included)
713 (cons (list char) tree)
716 (defun ideographic-chars-to-is-a-tree (chars)
718 (dolist (char (sort (copy-list chars) #'ideographic-structure-char<))
719 (setq tree (ideo-comp-tree-adjoin tree char)))
722 (defun ids-find-chars-including-ids (structure)
723 (let (comp-alist comp-spec ret str rest)
725 ((characterp structure)
726 (setq rest (copy-list (get-char-attribute structure 'ideographic-products)))
728 ((setq ret (ideographic-structure-find-chars structure))
733 (copy-list (get-char-attribute pc 'ideographic-products)))))
736 (setq comp-alist (ideographic-structure-to-components-alist structure)
737 comp-spec (list (cons 'ideographic-structure structure)))
739 (sort (mapcar (lambda (cell)
740 (if (setq ret (get-char-attribute
741 (car cell) 'ideographic-products))
742 (cons ret (length ret))
746 (< (cdr a)(cdr b))))))
747 (when (and (every (lambda (cell)
748 (>= (ideographic-char-count-components pc (car cell))
751 (or (ideographic-char-match-component pc comp-spec)
752 (and (setq str (get-char-attribute pc 'ideographic-structure))
753 (ideographic-char-match-component
756 'ideographic-structure
757 (functional-ideographic-structure-to-apparent-structure
762 (ideographic-chars-to-is-a-tree rest)))
764 (defun functional-ideographic-structure-to-apparent-structure (structure)
765 (ideographic-structure-compare-functional-and-apparent
766 structure nil 'conversion-only))
769 (defun ideographic-structure-compact (structure)
770 (let ((rest structure)
774 (setq cell (pop rest))
777 (cond ((setq ret (assq 'ideographic-structure cell))
784 (cond ((setq ret (ideographic-structure-find-chars sub))
787 ((setq ret (ideographic-structure-compact sub))
788 (list (cons 'ideographic-structure ret))
791 (list (cons 'ideographic-structure sub))))
794 (setq dest (cons cell dest)))
797 (defun ideographic-structure-compare-functional-and-apparent (structure
800 (let (enc enc-str enc2-str enc3-str new-str new-str-c
801 f-res a-res ret code)
803 ((eq (car structure) ?⿸)
804 (setq enc (nth 1 structure))
806 (cond ((characterp enc)
807 (get-char-attribute enc 'ideographic-structure)
810 (cdr (assq 'ideographic-structure enc))
813 ((eq (car enc-str) ?⿰)
814 (unless conversion-only
815 (setq f-res (ids-find-chars-including-ids enc-str)))
816 (setq new-str (list ?⿱
820 (if (setq ret (ideographic-structure-find-chars new-str))
822 (list (cons 'ideographic-structure new-str))))
824 (list ?⿰ (nth 1 enc-str) new-str-c)
825 (setq a-res (ids-find-chars-including-ids new-str))
830 (list ?⿰ (nth 1 enc-str) new-str-c)
833 ((and (eq (car enc-str) ?⿲)
834 (memq (char-ucs (nth 1 enc-str)) '(#x4EBB #x2E85))
835 (eq (nth 2 enc-str) ?丨))
836 (unless conversion-only
837 (setq f-res (ids-find-chars-including-ids enc-str)))
838 (setq new-str (list ?⿱
842 (if (setq ret (ideographic-structure-find-chars new-str))
844 (list (cons 'ideographic-structure new-str))))
846 (list ?⿰ (decode-char '=big5-cdp #x8B7A) new-str-c)
847 (setq a-res (ids-find-chars-including-ids new-str))
852 (list ?⿰ (decode-char '=big5-cdp #x8B7A) new-str-c)
855 ((eq (car enc-str) ?⿱)
856 (unless conversion-only
857 (setq f-res (ids-find-chars-including-ids enc-str)))
861 ((characterp (nth 2 enc-str))
862 (if (or (memq (encode-char (nth 2 enc-str) '=>ucs@component)
863 '(#x20087 #x5382 #x4E06))
864 (eq (encode-char (nth 2 enc-str) '=>ucs@iwds-1)
866 (eq (encode-char (nth 2 enc-str) '=ucs-itaiji-001)
868 (eq (encode-char (nth 2 enc-str) '=big5-cdp)
870 (eq (encode-char (nth 2 enc-str) '=>big5-cdp)
872 (eq (encode-char (nth 2 enc-str) '=big5-cdp)
874 (eq (or (encode-char (nth 2 enc-str) '=>big5-cdp)
875 (encode-char (nth 2 enc-str) '=big5-cdp-itaiji-001))
877 (eq (car (get-char-attribute (nth 2 enc-str)
878 'ideographic-structure))
882 ((eq (car (cdr (assq 'ideographic-structure (nth 2 enc-str))))
890 (if (setq ret (ideographic-structure-find-chars new-str))
892 (list (cons 'ideographic-structure new-str))))
894 (list ?⿱ (nth 1 enc-str) new-str-c)
895 (setq a-res (ids-find-chars-including-ids new-str))
900 (list ?⿱ (nth 1 enc-str) new-str-c)
901 (if (eq (car new-str) ?⿸)
905 ((eq (car enc-str) ?⿸)
906 (unless conversion-only
907 (setq f-res (ids-find-chars-including-ids enc-str)))
908 (setq new-str (list (cond
909 ((characterp (nth 2 enc-str))
910 (if (memq (char-ucs (nth 2 enc-str))
920 (if (setq ret (ideographic-structure-find-chars new-str))
922 (list (cons 'ideographic-structure new-str))))
924 (list ?⿸ (nth 1 enc-str) new-str-c)
925 (setq a-res (ids-find-chars-including-ids new-str))
930 (list ?⿸ (nth 1 enc-str) new-str-c)
931 (if (eq (car new-str) ?⿰)
936 ((eq (car structure) ?⿹)
937 (setq enc (nth 1 structure))
939 (cond ((characterp enc)
940 (get-char-attribute enc 'ideographic-structure)
943 (cdr (assq 'ideographic-structure enc))
946 ((eq (car enc-str) ?⿰)
947 (unless conversion-only
948 (setq f-res (ids-find-chars-including-ids enc-str)))
949 (setq new-str (list ?⿱
953 (if (setq ret (ideographic-structure-find-chars new-str))
955 (list (cons 'ideographic-structure new-str))))
957 (list ?⿰ new-str-c (nth 2 enc-str))
958 (setq a-res (ids-find-chars-including-ids new-str))
963 (list ?⿰ new-str-c (nth 2 enc-str))
966 ((eq (car enc-str) ?⿱)
967 (unless conversion-only
968 (setq f-res (ids-find-chars-including-ids enc-str)))
969 (setq new-str (list ?⿰
973 (if (setq ret (ideographic-structure-find-chars new-str))
975 (list (cons 'ideographic-structure new-str))))
977 (list ?⿱ (nth 1 enc-str) new-str-c)
978 (setq a-res (ids-find-chars-including-ids new-str))
983 (list ?⿱ (nth 1 enc-str) new-str-c)
988 ((eq (get-char-attribute (car structure) '=ucs-itaiji-001) #x2FF6)
989 (setq enc (nth 1 structure))
991 (cond ((characterp enc)
992 (get-char-attribute enc 'ideographic-structure)
995 (cdr (assq 'ideographic-structure enc))
998 ((eq (car enc-str) ?⿺)
999 (unless conversion-only
1000 (setq f-res (ids-find-chars-including-ids enc-str)))
1001 (setq new-str (list ?⿱
1005 (if (setq ret (ideographic-structure-find-chars new-str))
1007 (list (cons 'ideographic-structure new-str))))
1009 (list ?⿺ new-str-c (nth 2 enc-str))
1010 (setq a-res (ids-find-chars-including-ids new-str))
1015 (list ?⿺ new-str-c (nth 2 enc-str))
1018 ((eq (car enc-str) ?⿱)
1019 (unless conversion-only
1020 (setq f-res (ids-find-chars-including-ids enc-str)))
1021 (setq new-str (list ?⿰
1025 (if (setq ret (ideographic-structure-find-chars new-str))
1027 (list (cons 'ideographic-structure new-str))))
1029 (list ?⿱ new-str-c (nth 2 enc-str))
1030 (setq a-res (ids-find-chars-including-ids new-str))
1035 (list ?⿱ new-str-c (nth 2 enc-str))
1038 ((eq (car enc-str) ?⿰)
1039 (unless conversion-only
1040 (setq f-res (ids-find-chars-including-ids enc-str)))
1041 (setq new-str (list ?⿱
1045 (if (setq ret (ideographic-structure-find-chars new-str))
1047 (list (cons 'ideographic-structure new-str))))
1049 (list ?⿰ new-str-c (nth 2 enc-str))
1050 (setq a-res (ids-find-chars-including-ids new-str))
1055 (list ?⿰ new-str-c (nth 2 enc-str))
1060 ((eq (car structure) ?⿴)
1061 (setq enc (nth 1 structure))
1063 (cond ((characterp enc)
1064 (get-char-attribute enc 'ideographic-structure)
1067 (cdr (assq 'ideographic-structure enc))
1070 ((eq (car enc-str) ?⿱)
1072 ((and (characterp (nth 2 enc-str))
1073 (or (memq (char-ucs (nth 2 enc-str)) '(#x56D7 #x5F51 #x897F))
1074 (eq (char-feature (nth 2 enc-str) '=>big5-cdp)
1076 (unless conversion-only
1077 (setq f-res (ids-find-chars-including-ids enc-str)))
1078 (setq new-str (list ?⿴
1082 (if (setq ret (ideographic-structure-find-chars new-str))
1084 (list (cons 'ideographic-structure new-str))))
1086 (list ?⿱ (nth 1 enc-str) new-str-c)
1087 (setq a-res (ids-find-chars-including-ids new-str))
1092 (list ?⿱ (nth 1 enc-str) new-str-c)
1095 ((and (characterp (nth 2 enc-str))
1096 (eq (char-ucs (nth 2 enc-str)) #x51F5))
1097 (unless conversion-only
1098 (setq f-res (ids-find-chars-including-ids enc-str)))
1099 (setq new-str (list ?⿶
1103 (if (setq ret (ideographic-structure-find-chars new-str))
1105 (list (cons 'ideographic-structure new-str))))
1107 (list ?⿱ (nth 1 enc-str) new-str-c)
1108 (setq a-res (ids-find-chars-including-ids new-str))
1113 (list ?⿱ (nth 1 enc-str) new-str-c)
1116 ((and (characterp (nth 1 enc-str))
1117 (eq (char-feature (nth 1 enc-str) '=>ucs@component)
1119 (unless conversion-only
1120 (setq f-res (ids-find-chars-including-ids enc-str)))
1121 (setq new-str (list ?⿵
1125 (if (setq ret (ideographic-structure-find-chars new-str))
1127 (list (cons 'ideographic-structure new-str))))
1129 (list ?⿱ new-str-c (nth 2 enc-str))
1130 (setq a-res (ids-find-chars-including-ids new-str))
1135 (list ?⿱ new-str-c (nth 2 enc-str))
1139 (unless conversion-only
1140 (setq f-res (ids-find-chars-including-ids enc-str)))
1141 (setq new-str (list ?⿱ (nth 2 structure) (nth 2 enc-str)))
1143 (if (setq ret (ideographic-structure-find-chars new-str))
1145 (list (cons 'ideographic-structure new-str))))
1147 (list ?⿱ (nth 1 enc-str) new-str-c)
1148 (setq a-res (ids-find-chars-including-ids new-str))
1153 (list ?⿱ (nth 1 enc-str) new-str-c)
1157 ((eq (car enc-str) ?⿳)
1159 ((and (characterp (nth 2 enc-str))
1160 (eq (char-ucs (nth 2 enc-str)) #x56D7))
1161 (unless conversion-only
1162 (setq f-res (ids-find-chars-including-ids enc-str)))
1163 (setq new-str (list ?⿴ (nth 2 enc-str) (nth 2 structure)))
1165 (if (setq ret (ideographic-structure-find-chars new-str))
1167 (list (cons 'ideographic-structure new-str))))
1168 (setq new-str (list ?⿱ (nth 1 enc-str) new-str-c))
1170 (if (setq ret (ideographic-structure-find-chars new-str))
1172 (list (cons 'ideographic-structure new-str))))
1174 (list ?⿱ new-str-c (nth 3 enc-str))
1175 (setq a-res (ids-find-chars-including-ids new-str))
1180 (list ?⿱ new-str-c (nth 3 enc-str))
1183 ((and (characterp (nth 2 enc-str))
1184 (eq (char-ucs (nth 2 enc-str)) #x5196))
1185 (unless conversion-only
1186 (setq f-res (ids-find-chars-including-ids enc-str)))
1187 (setq new-str (list ?⿱ (nth 1 enc-str) (nth 2 enc-str)))
1189 (if (setq ret (ideographic-structure-find-chars new-str))
1191 (list (cons 'ideographic-structure new-str))))
1192 (setq new-str (list ?⿱ new-str-c (nth 2 structure)))
1194 (if (setq ret (ideographic-structure-find-chars new-str))
1196 (list (cons 'ideographic-structure new-str))))
1198 (list ?⿱ new-str-c (nth 3 enc-str))
1199 (setq a-res (ids-find-chars-including-ids new-str))
1204 (list ?⿱ new-str-c (nth 3 enc-str))
1207 ((and (characterp (nth 2 enc-str))
1208 (or (eq (encode-char (nth 2 enc-str) '=>big5-cdp)
1210 (eq (encode-char (nth 2 enc-str) '=>gt-k)
1212 (eq (char-ucs (nth 2 enc-str)) #x2008A)))
1213 (unless conversion-only
1214 (setq f-res (ids-find-chars-including-ids enc-str)))
1215 (setq new-str (list ?⿱ (nth 2 structure) (nth 2 enc-str)))
1217 (if (setq ret (ideographic-structure-find-chars new-str))
1219 (list (cons 'ideographic-structure new-str))))
1220 (setq new-str (list ?⿸ new-str-c (nth 3 enc-str)))
1222 (if (setq ret (ideographic-structure-find-chars new-str))
1224 (list (cons 'ideographic-structure new-str))))
1226 (list ?⿱ (nth 1 enc-str) new-str-c)
1227 (setq a-res (ids-find-chars-including-ids new-str))
1232 (list ?⿱ (nth 1 enc-str) new-str-c)
1236 (unless conversion-only
1237 (setq f-res (ids-find-chars-including-ids enc-str)))
1238 (setq new-str (list ?⿻ (nth 2 enc-str) (nth 2 structure)))
1240 (if (setq ret (ideographic-structure-find-chars new-str))
1242 (list (cons 'ideographic-structure new-str))))
1243 (setq new-str (list ?⿱ (nth 1 enc-str) new-str-c))
1245 (if (setq ret (ideographic-structure-find-chars new-str))
1247 (list (cons 'ideographic-structure new-str))))
1249 (list ?⿱ new-str-c (nth 3 enc-str))
1250 (setq a-res (ids-find-chars-including-ids new-str))
1255 (list ?⿱ new-str-c (nth 3 enc-str))
1259 ((eq (car enc-str) ?⿰)
1261 ((equal (nth 1 enc-str)(nth 2 enc-str))
1262 (unless conversion-only
1263 (setq f-res (ids-find-chars-including-ids enc-str)))
1264 (setq new-str (list ?⿲
1269 (list (cons 'ideographic-structure new-str)))
1272 (setq a-res (ids-find-chars-including-ids new-str))
1281 (unless conversion-only
1282 (setq f-res (ids-find-chars-including-ids enc-str)))
1283 (setq new-str (list ?⿰
1287 (if (setq ret (ideographic-structure-find-chars new-str))
1289 (list (cons 'ideographic-structure new-str))))
1291 (list ?⿰ (nth 1 enc-str) new-str-c)
1292 (setq a-res (ids-find-chars-including-ids new-str))
1297 (list ?⿰ (nth 1 enc-str) new-str-c)
1303 ((eq (car structure) ?⿶)
1304 (setq enc (nth 1 structure))
1306 (cond ((characterp enc)
1307 (get-char-attribute enc 'ideographic-structure)
1310 (cdr (assq 'ideographic-structure enc))
1313 ((eq (car enc-str) ?⿱)
1314 (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
1316 (eq (car enc2-str) ?⿰))
1317 (unless conversion-only
1318 (setq f-res (ids-find-chars-including-ids enc-str)))
1319 (setq new-str (list ?⿲
1324 (if (setq ret (ideographic-structure-find-chars new-str))
1326 (list (cons 'ideographic-structure new-str))))
1328 (list ?⿱ new-str-c (nth 2 enc-str))
1329 (setq a-res (ids-find-chars-including-ids new-str))
1334 (list ?⿱ new-str-c (nth 2 enc-str))
1338 ((eq (car enc-str) ?⿳)
1339 (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
1341 (eq (car enc2-str) ?⿰))
1342 (unless conversion-only
1343 (setq f-res (ids-find-chars-including-ids enc-str)))
1344 (setq new-str (list ?⿲
1349 (if (setq ret (ideographic-structure-find-chars new-str))
1351 (list (cons 'ideographic-structure new-str))))
1353 (list ?⿳ new-str-c (nth 2 enc-str) (nth 3 enc-str))
1354 (setq a-res (ids-find-chars-including-ids new-str))
1359 (list ?⿳ new-str-c (nth 2 enc-str) (nth 3 enc-str))
1363 ((eq (car enc-str) ?⿲)
1364 (unless conversion-only
1365 (setq f-res (ids-find-chars-including-ids enc-str)))
1366 (setq new-str (list ?⿱
1370 (if (setq ret (ideographic-structure-find-chars new-str))
1372 (list (cons 'ideographic-structure new-str))))
1374 (list ?⿲ (nth 1 enc-str) new-str-c (nth 3 enc-str))
1375 (setq a-res (ids-find-chars-including-ids new-str))
1380 (list ?⿲ (nth 1 enc-str) new-str-c (nth 3 enc-str))
1383 ((eq (car enc-str) ?⿴)
1384 (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
1386 (eq (car enc2-str) ?⿰))
1387 (unless conversion-only
1388 (setq f-res (ids-find-chars-including-ids enc-str)))
1389 (setq new-str (list ?⿱
1393 (if (setq ret (ideographic-structure-find-chars new-str))
1395 (list (cons 'ideographic-structure new-str))))
1397 (list ?⿲ (nth 1 enc2-str) new-str-c (nth 2 enc2-str))
1398 (setq a-res (ids-find-chars-including-ids new-str))
1403 (list ?⿲ (nth 1 enc2-str) new-str-c (nth 2 enc2-str))
1408 ((eq (car structure) ?⿵)
1409 (setq enc (nth 1 structure))
1411 (cond ((characterp enc)
1412 (get-char-attribute enc 'ideographic-structure)
1415 (cdr (assq 'ideographic-structure enc))
1418 ((eq (car enc-str) ?⿱)
1420 ((and (characterp (nth 2 enc-str))
1421 (memq (char-ucs (nth 2 enc-str))
1423 (unless conversion-only
1424 (setq f-res (ids-find-chars-including-ids enc-str)))
1425 (setq new-str (list ?⿵
1429 (if (setq ret (ideographic-structure-find-chars new-str))
1431 (list (cons 'ideographic-structure new-str))))
1433 (list ?⿱ (nth 1 enc-str) new-str-c)
1434 (setq a-res (ids-find-chars-including-ids new-str))
1439 (list ?⿱ (nth 1 enc-str) new-str-c)
1442 ((and (setq enc2-str (ideographic-character-get-structure (nth 2 enc-str)))
1444 ((eq (car enc2-str) ?⿰)
1447 ((eq (car enc2-str) ?⿲)
1450 ((and (eq (car enc2-str) ?⿱)
1452 (ideographic-character-get-structure (nth 2 enc2-str)))
1453 (eq (car enc3-str) ?⿰))
1456 (unless conversion-only
1457 (setq f-res (ids-find-chars-including-ids enc-str)))
1459 (cond ((eq code 611)
1474 (list (list 'ideographic-structure
1481 (if (setq ret (ideographic-structure-find-chars new-str))
1483 (list (cons 'ideographic-structure
1484 (ideographic-structure-compact new-str)))))
1486 (cond ((or (eq code 611)
1488 (list ?⿱ (nth 1 enc-str) new-str-c)
1491 (list ?⿳ (nth 1 enc-str)(nth 1 enc2-str) new-str-c)
1493 (setq a-res (ids-find-chars-including-ids new-str))
1498 (cond ((or (eq code 611)
1500 (list ?⿱ (nth 1 enc-str) new-str-c)
1503 (list ?⿳ (nth 1 enc-str)(nth 1 enc2-str) new-str-c)
1508 ((eq (car enc-str) ?⿳)
1509 (setq enc2-str (ideographic-character-get-structure (nth 3 enc-str)))
1511 (eq (car enc2-str) ?⿰))
1512 (unless conversion-only
1513 (setq f-res (ids-find-chars-including-ids enc-str)))
1514 (setq new-str (list ?⿲
1519 (if (setq ret (ideographic-structure-find-chars new-str))
1521 (list (cons 'ideographic-structure new-str))))
1523 (list ?⿳ (nth 1 enc-str) (nth 2 enc-str) new-str-c)
1524 (setq a-res (ids-find-chars-including-ids new-str))
1529 (list ?⿳ (nth 1 enc-str) (nth 2 enc-str) new-str-c)
1533 ((eq (car enc-str) ?⿲)
1534 (unless conversion-only
1535 (setq f-res (ids-find-chars-including-ids enc-str)))
1536 (setq new-str (list ?⿱
1540 (if (setq ret (ideographic-structure-find-chars new-str))
1542 (list (cons 'ideographic-structure new-str))))
1544 (list ?⿲ (nth 1 enc-str) new-str-c (nth 3 enc-str))
1545 (setq a-res (ids-find-chars-including-ids new-str))
1550 (list ?⿲ (nth 1 enc-str) new-str-c (nth 3 enc-str))
1553 ((eq (car enc-str) ?⿴)
1554 (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
1556 (eq (car enc2-str) ?⿰))
1557 (unless conversion-only
1558 (setq f-res (ids-find-chars-including-ids enc-str)))
1559 (setq new-str (list ?⿱
1563 (if (setq ret (ideographic-structure-find-chars new-str))
1565 (list (cons 'ideographic-structure new-str))))
1567 (list ?⿲ (nth 1 enc2-str) new-str-c (nth 2 enc2-str))
1568 (setq a-res (ids-find-chars-including-ids new-str))
1573 (list ?⿲ (nth 1 enc2-str) new-str-c (nth 2 enc2-str))
1576 ((eq (car enc-str) ?⿵)
1577 (unless conversion-only
1578 (setq f-res (ids-find-chars-including-ids enc-str)))
1579 (setq new-str (list ?⿱
1583 (if (setq ret (ideographic-structure-find-chars new-str))
1585 (list (cons 'ideographic-structure new-str))))
1587 (list ?⿵ (nth 1 enc-str) new-str-c)
1588 (setq a-res (ids-find-chars-including-ids new-str))
1593 (list ?⿵ (nth 1 enc-str) new-str-c)
1598 ((eq (car structure) ?⿷)
1599 (setq enc (nth 1 structure))
1601 (cond ((characterp enc)
1602 (get-char-attribute enc 'ideographic-structure)
1605 (cdr (assq 'ideographic-structure enc))
1608 ((eq (car enc-str) ?⿺)
1609 (unless conversion-only
1610 (setq f-res (ids-find-chars-including-ids enc-str)))
1611 (setq new-str (list ?⿱
1615 (if (setq ret (ideographic-structure-find-chars new-str))
1617 (list (cons 'ideographic-structure new-str))))
1619 (list ?⿺ (nth 1 enc-str) new-str-c)
1620 (setq a-res (ids-find-chars-including-ids new-str))
1625 (list ?⿺ (nth 1 enc-str) new-str-c)
1628 ((eq (car enc-str) ?⿸)
1629 (unless conversion-only
1630 (setq f-res (ids-find-chars-including-ids enc-str)))
1632 ((and (characterp (nth 2 enc-str))
1633 (or (memq (char-ucs (nth 2 enc-str))
1634 '(#x4EBA #x5165 #x513F #x51E0))
1635 (memq (or (encode-char (nth 2 enc-str) '=>ucs@iwds-1)
1636 (encode-char (nth 2 enc-str) '=>ucs@component))
1638 (setq new-str (list ?⿺
1642 (if (setq ret (ideographic-structure-find-chars new-str))
1644 (list (cons 'ideographic-structure new-str))))
1646 (list ?⿸ (nth 1 enc-str) new-str-c)
1647 (setq a-res (ids-find-chars-including-ids new-str))
1652 (list ?⿸ (nth 1 enc-str) new-str-c)
1656 (setq new-str (list ?⿱
1660 (if (setq ret (ideographic-structure-find-chars new-str))
1662 (list (cons 'ideographic-structure new-str))))
1664 (list ?⿸ (nth 1 enc-str) new-str-c)
1665 (setq a-res (ids-find-chars-including-ids new-str))
1670 (list ?⿸ (nth 1 enc-str) new-str-c)
1676 ((eq (car structure) ?⿺)
1677 (setq enc (nth 1 structure))
1679 (cond ((characterp enc)
1680 (or (get-char-attribute enc 'ideographic-structure)
1681 (get-char-attribute enc 'ideographic-structure@apparent)
1682 (get-char-attribute enc 'ideographic-structure@apparent/leftmost))
1685 (or (cdr (assq 'ideographic-structure enc))
1686 (cdr (assq 'ideographic-structure@apparent enc))
1687 (cdr (assq 'ideographic-structure@apparent/leftmost enc)))
1690 ;; (mapcar (lambda (cell)
1691 ;; (or (and (listp cell)
1692 ;; (find-char cell))
1696 ((eq (car enc-str) ?⿱)
1698 ((and (characterp (nth 1 enc-str))
1699 (or (and (eq (char-ucs (nth 1 enc-str)) #x200CA)
1701 (and (eq (char-feature (nth 1 enc-str) '=>iwds-1) 233)
1702 (characterp (nth 2 structure))
1703 (eq (char-ucs (nth 2 structure)) #x4E36)
1705 (unless conversion-only
1706 (setq f-res (ids-find-chars-including-ids enc-str)))
1707 (setq new-str (list ?⿺
1711 (if (setq ret (ideographic-structure-find-chars new-str))
1713 (list (cons 'ideographic-structure new-str))))
1715 (list ?⿱ new-str-c (nth 2 enc-str))
1716 (setq a-res (ids-find-chars-including-ids new-str))
1721 (list ?⿱ new-str-c (nth 2 enc-str))
1724 ((and (characterp (nth 2 enc-str))
1725 (or (memq (char-ucs (nth 2 enc-str))
1728 #x65E5 #x66F0 #x5FC3
1729 #x2123C #x58EC #x738B #x7389))
1730 (memq (encode-char (nth 2 enc-str) '=>ucs@component)
1732 (eq (encode-char (nth 2 enc-str) '=>ucs@iwds-1)
1734 (eq (encode-char (nth 2 enc-str) '=>big5-cdp)
1736 (unless conversion-only
1737 (setq f-res (ids-find-chars-including-ids enc-str)))
1738 (setq new-str (list ?⿰
1742 (if (setq ret (ideographic-structure-find-chars new-str))
1744 (list (cons 'ideographic-structure new-str))))
1746 (list ?⿱ new-str-c (nth 2 enc-str))
1747 (setq a-res (ids-find-chars-including-ids new-str))
1752 (list ?⿱ new-str-c (nth 2 enc-str))
1757 ((eq (car structure) ?⿻)
1758 (setq enc (nth 1 structure))
1760 (cond ((characterp enc)
1761 (get-char-attribute enc 'ideographic-structure)
1764 (cdr (assq 'ideographic-structure enc))
1767 ((eq (car enc-str) ?⿱)
1768 (unless conversion-only
1769 (setq f-res (ids-find-chars-including-ids enc-str)))
1771 (list ?⿳ (nth 1 enc-str) (nth 2 structure) (nth 2 enc-str))
1791 ;;; ids-find.el ends here