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))
775 (if (and (consp cell)
776 (setq ret (find-char cell)))
780 (cond ((setq ret (assq 'ideographic-structure cell))
787 (cond ((setq ret (ideographic-structure-find-chars sub))
790 ((setq ret (ideographic-structure-compact sub))
791 (list (cons 'ideographic-structure ret))
794 (list (cons 'ideographic-structure sub))))
797 (setq dest (cons cell dest)))
800 (defun ideographic-structure-compare-functional-and-apparent (structure
803 (let (enc enc-str enc2-str enc3-str new-str new-str-c
804 f-res a-res ret code)
806 ((eq (car structure) ?⿸)
807 (setq enc (nth 1 structure))
809 (cond ((characterp enc)
810 (get-char-attribute enc 'ideographic-structure)
813 (cdr (assq 'ideographic-structure enc))
816 ((eq (car enc-str) ?⿰)
817 (unless conversion-only
818 (setq f-res (ids-find-chars-including-ids enc-str)))
819 (setq new-str (list ?⿱
823 (if (setq ret (ideographic-structure-find-chars new-str))
825 (list (cons 'ideographic-structure new-str))))
827 (list ?⿰ (nth 1 enc-str) new-str-c)
828 (setq a-res (ids-find-chars-including-ids new-str))
833 (list ?⿰ (nth 1 enc-str) new-str-c)
836 ((and (eq (car enc-str) ?⿲)
837 (memq (char-ucs (nth 1 enc-str)) '(#x4EBB #x2E85))
838 (eq (nth 2 enc-str) ?丨))
839 (unless conversion-only
840 (setq f-res (ids-find-chars-including-ids enc-str)))
841 (setq new-str (list ?⿱
845 (if (setq ret (ideographic-structure-find-chars new-str))
847 (list (cons 'ideographic-structure new-str))))
849 (list ?⿰ (decode-char '=big5-cdp #x8B7A) new-str-c)
850 (setq a-res (ids-find-chars-including-ids new-str))
855 (list ?⿰ (decode-char '=big5-cdp #x8B7A) new-str-c)
858 ((eq (car enc-str) ?⿱)
859 (unless conversion-only
860 (setq f-res (ids-find-chars-including-ids enc-str)))
864 ((characterp (nth 2 enc-str))
865 (if (or (memq (encode-char (nth 2 enc-str) '=>ucs@component)
866 '(#x20087 #x5382 #x4E06))
867 (eq (encode-char (nth 2 enc-str) '=>ucs@iwds-1)
869 (eq (encode-char (nth 2 enc-str) '=ucs-itaiji-001)
871 (eq (encode-char (nth 2 enc-str) '=big5-cdp)
873 (eq (encode-char (nth 2 enc-str) '=>big5-cdp)
875 (eq (encode-char (nth 2 enc-str) '=big5-cdp)
877 (eq (or (encode-char (nth 2 enc-str) '=>big5-cdp)
878 (encode-char (nth 2 enc-str) '=big5-cdp-itaiji-001))
880 (eq (car (get-char-attribute (nth 2 enc-str)
881 'ideographic-structure))
885 ((eq (car (cdr (assq 'ideographic-structure (nth 2 enc-str))))
893 (if (setq ret (ideographic-structure-find-chars new-str))
895 (list (cons 'ideographic-structure new-str))))
897 (list ?⿱ (nth 1 enc-str) new-str-c)
898 (setq a-res (ids-find-chars-including-ids new-str))
903 (list ?⿱ (nth 1 enc-str) new-str-c)
904 (if (eq (car new-str) ?⿸)
908 ((eq (car enc-str) ?⿸)
909 (unless conversion-only
910 (setq f-res (ids-find-chars-including-ids enc-str)))
911 (setq new-str (list (cond
912 ((characterp (nth 2 enc-str))
913 (if (memq (char-ucs (nth 2 enc-str))
923 (if (setq ret (ideographic-structure-find-chars new-str))
925 (list (cons 'ideographic-structure new-str))))
927 (list ?⿸ (nth 1 enc-str) new-str-c)
928 (setq a-res (ids-find-chars-including-ids new-str))
933 (list ?⿸ (nth 1 enc-str) new-str-c)
934 (if (eq (car new-str) ?⿰)
939 ((eq (car structure) ?⿹)
940 (setq enc (nth 1 structure))
942 (cond ((characterp enc)
943 (get-char-attribute enc 'ideographic-structure)
946 (cdr (assq 'ideographic-structure enc))
949 ((eq (car enc-str) ?⿰)
950 (unless conversion-only
951 (setq f-res (ids-find-chars-including-ids enc-str)))
952 (setq new-str (list ?⿱
956 (if (setq ret (ideographic-structure-find-chars new-str))
958 (list (cons 'ideographic-structure new-str))))
960 (list ?⿰ new-str-c (nth 2 enc-str))
961 (setq a-res (ids-find-chars-including-ids new-str))
966 (list ?⿰ new-str-c (nth 2 enc-str))
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 ?⿱ (nth 1 enc-str) new-str-c)
981 (setq a-res (ids-find-chars-including-ids new-str))
986 (list ?⿱ (nth 1 enc-str) new-str-c)
991 ((eq (get-char-attribute (car structure) '=ucs-itaiji-001) #x2FF6)
992 (setq enc (nth 1 structure))
994 (cond ((characterp enc)
995 (get-char-attribute enc 'ideographic-structure)
998 (cdr (assq 'ideographic-structure enc))
1001 ((eq (car enc-str) ?⿺)
1002 (unless conversion-only
1003 (setq f-res (ids-find-chars-including-ids enc-str)))
1004 (setq new-str (list ?⿱
1008 (if (setq ret (ideographic-structure-find-chars new-str))
1010 (list (cons 'ideographic-structure new-str))))
1012 (list ?⿺ new-str-c (nth 2 enc-str))
1013 (setq a-res (ids-find-chars-including-ids new-str))
1018 (list ?⿺ new-str-c (nth 2 enc-str))
1021 ((eq (car enc-str) ?⿱)
1022 (unless conversion-only
1023 (setq f-res (ids-find-chars-including-ids enc-str)))
1024 (setq new-str (list ?⿰
1028 (if (setq ret (ideographic-structure-find-chars new-str))
1030 (list (cons 'ideographic-structure new-str))))
1032 (list ?⿱ new-str-c (nth 2 enc-str))
1033 (setq a-res (ids-find-chars-including-ids new-str))
1038 (list ?⿱ new-str-c (nth 2 enc-str))
1041 ((eq (car enc-str) ?⿰)
1042 (unless conversion-only
1043 (setq f-res (ids-find-chars-including-ids enc-str)))
1044 (setq new-str (list ?⿱
1048 (if (setq ret (ideographic-structure-find-chars new-str))
1050 (list (cons 'ideographic-structure new-str))))
1052 (list ?⿰ new-str-c (nth 2 enc-str))
1053 (setq a-res (ids-find-chars-including-ids new-str))
1058 (list ?⿰ new-str-c (nth 2 enc-str))
1063 ((eq (car structure) ?⿴)
1064 (setq enc (nth 1 structure))
1066 (cond ((characterp enc)
1067 (get-char-attribute enc 'ideographic-structure)
1070 (cdr (assq 'ideographic-structure enc))
1073 ((eq (car enc-str) ?⿱)
1075 ((and (characterp (nth 2 enc-str))
1076 (or (memq (char-ucs (nth 2 enc-str)) '(#x56D7 #x5F51 #x897F))
1077 (eq (char-feature (nth 2 enc-str) '=>big5-cdp)
1079 (unless conversion-only
1080 (setq f-res (ids-find-chars-including-ids enc-str)))
1081 (setq new-str (list ?⿴
1085 (if (setq ret (ideographic-structure-find-chars new-str))
1087 (list (cons 'ideographic-structure new-str))))
1089 (list ?⿱ (nth 1 enc-str) new-str-c)
1090 (setq a-res (ids-find-chars-including-ids new-str))
1095 (list ?⿱ (nth 1 enc-str) new-str-c)
1098 ((and (characterp (nth 2 enc-str))
1099 (eq (char-ucs (nth 2 enc-str)) #x51F5))
1100 (unless conversion-only
1101 (setq f-res (ids-find-chars-including-ids enc-str)))
1102 (setq new-str (list ?⿶
1106 (if (setq ret (ideographic-structure-find-chars new-str))
1108 (list (cons 'ideographic-structure new-str))))
1110 (list ?⿱ (nth 1 enc-str) new-str-c)
1111 (setq a-res (ids-find-chars-including-ids new-str))
1116 (list ?⿱ (nth 1 enc-str) new-str-c)
1119 ((and (characterp (nth 1 enc-str))
1120 (eq (char-feature (nth 1 enc-str) '=>ucs@component)
1122 (unless conversion-only
1123 (setq f-res (ids-find-chars-including-ids enc-str)))
1124 (setq new-str (list ?⿵
1128 (if (setq ret (ideographic-structure-find-chars new-str))
1130 (list (cons 'ideographic-structure new-str))))
1132 (list ?⿱ new-str-c (nth 2 enc-str))
1133 (setq a-res (ids-find-chars-including-ids new-str))
1138 (list ?⿱ new-str-c (nth 2 enc-str))
1142 (unless conversion-only
1143 (setq f-res (ids-find-chars-including-ids enc-str)))
1144 (setq new-str (list ?⿱ (nth 2 structure) (nth 2 enc-str)))
1146 (if (setq ret (ideographic-structure-find-chars new-str))
1148 (list (cons 'ideographic-structure new-str))))
1150 (list ?⿱ (nth 1 enc-str) new-str-c)
1151 (setq a-res (ids-find-chars-including-ids new-str))
1156 (list ?⿱ (nth 1 enc-str) new-str-c)
1160 ((eq (car enc-str) ?⿳)
1162 ((and (characterp (nth 2 enc-str))
1163 (eq (char-ucs (nth 2 enc-str)) #x56D7))
1164 (unless conversion-only
1165 (setq f-res (ids-find-chars-including-ids enc-str)))
1166 (setq new-str (list ?⿴ (nth 2 enc-str) (nth 2 structure)))
1168 (if (setq ret (ideographic-structure-find-chars new-str))
1170 (list (cons 'ideographic-structure new-str))))
1171 (setq new-str (list ?⿱ (nth 1 enc-str) new-str-c))
1173 (if (setq ret (ideographic-structure-find-chars new-str))
1175 (list (cons 'ideographic-structure new-str))))
1177 (list ?⿱ new-str-c (nth 3 enc-str))
1178 (setq a-res (ids-find-chars-including-ids new-str))
1183 (list ?⿱ new-str-c (nth 3 enc-str))
1186 ((and (characterp (nth 2 enc-str))
1187 (eq (char-ucs (nth 2 enc-str)) #x5196))
1188 (unless conversion-only
1189 (setq f-res (ids-find-chars-including-ids enc-str)))
1190 (setq new-str (list ?⿱ (nth 1 enc-str) (nth 2 enc-str)))
1192 (if (setq ret (ideographic-structure-find-chars new-str))
1194 (list (cons 'ideographic-structure new-str))))
1195 (setq new-str (list ?⿱ new-str-c (nth 2 structure)))
1197 (if (setq ret (ideographic-structure-find-chars new-str))
1199 (list (cons 'ideographic-structure new-str))))
1201 (list ?⿱ new-str-c (nth 3 enc-str))
1202 (setq a-res (ids-find-chars-including-ids new-str))
1207 (list ?⿱ new-str-c (nth 3 enc-str))
1210 ((and (characterp (nth 2 enc-str))
1211 (or (eq (encode-char (nth 2 enc-str) '=>big5-cdp)
1213 (eq (encode-char (nth 2 enc-str) '=>gt-k)
1215 (eq (char-ucs (nth 2 enc-str)) #x2008A)))
1216 (unless conversion-only
1217 (setq f-res (ids-find-chars-including-ids enc-str)))
1218 (setq new-str (list ?⿱ (nth 2 structure) (nth 2 enc-str)))
1220 (if (setq ret (ideographic-structure-find-chars new-str))
1222 (list (cons 'ideographic-structure new-str))))
1223 (setq new-str (list ?⿸ new-str-c (nth 3 enc-str)))
1225 (if (setq ret (ideographic-structure-find-chars new-str))
1227 (list (cons 'ideographic-structure new-str))))
1229 (list ?⿱ (nth 1 enc-str) new-str-c)
1230 (setq a-res (ids-find-chars-including-ids new-str))
1235 (list ?⿱ (nth 1 enc-str) new-str-c)
1239 (unless conversion-only
1240 (setq f-res (ids-find-chars-including-ids enc-str)))
1241 (setq new-str (list ?⿻ (nth 2 enc-str) (nth 2 structure)))
1243 (if (setq ret (ideographic-structure-find-chars new-str))
1245 (list (cons 'ideographic-structure new-str))))
1246 (setq new-str (list ?⿱ (nth 1 enc-str) new-str-c))
1248 (if (setq ret (ideographic-structure-find-chars new-str))
1250 (list (cons 'ideographic-structure new-str))))
1252 (list ?⿱ new-str-c (nth 3 enc-str))
1253 (setq a-res (ids-find-chars-including-ids new-str))
1258 (list ?⿱ new-str-c (nth 3 enc-str))
1262 ((eq (car enc-str) ?⿰)
1264 ((equal (nth 1 enc-str)(nth 2 enc-str))
1265 (unless conversion-only
1266 (setq f-res (ids-find-chars-including-ids enc-str)))
1267 (setq new-str (list ?⿲
1272 (list (cons 'ideographic-structure new-str)))
1275 (setq a-res (ids-find-chars-including-ids new-str))
1284 (unless conversion-only
1285 (setq f-res (ids-find-chars-including-ids enc-str)))
1286 (setq new-str (list ?⿰
1290 (if (setq ret (ideographic-structure-find-chars new-str))
1292 (list (cons 'ideographic-structure new-str))))
1294 (list ?⿰ (nth 1 enc-str) new-str-c)
1295 (setq a-res (ids-find-chars-including-ids new-str))
1300 (list ?⿰ (nth 1 enc-str) new-str-c)
1306 ((eq (car structure) ?⿶)
1307 (setq enc (nth 1 structure))
1309 (cond ((characterp enc)
1310 (get-char-attribute enc 'ideographic-structure)
1313 (cdr (assq 'ideographic-structure enc))
1316 ((eq (car enc-str) ?⿱)
1317 (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
1319 (eq (car enc2-str) ?⿰))
1320 (unless conversion-only
1321 (setq f-res (ids-find-chars-including-ids enc-str)))
1322 (setq new-str (list ?⿲
1327 (if (setq ret (ideographic-structure-find-chars new-str))
1329 (list (cons 'ideographic-structure new-str))))
1331 (list ?⿱ new-str-c (nth 2 enc-str))
1332 (setq a-res (ids-find-chars-including-ids new-str))
1337 (list ?⿱ new-str-c (nth 2 enc-str))
1341 ((eq (car enc-str) ?⿳)
1342 (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
1344 (eq (car enc2-str) ?⿰))
1345 (unless conversion-only
1346 (setq f-res (ids-find-chars-including-ids enc-str)))
1347 (setq new-str (list ?⿲
1352 (if (setq ret (ideographic-structure-find-chars new-str))
1354 (list (cons 'ideographic-structure new-str))))
1356 (list ?⿳ new-str-c (nth 2 enc-str) (nth 3 enc-str))
1357 (setq a-res (ids-find-chars-including-ids new-str))
1362 (list ?⿳ new-str-c (nth 2 enc-str) (nth 3 enc-str))
1366 ((eq (car enc-str) ?⿲)
1367 (unless conversion-only
1368 (setq f-res (ids-find-chars-including-ids enc-str)))
1369 (setq new-str (list ?⿱
1373 (if (setq ret (ideographic-structure-find-chars new-str))
1375 (list (cons 'ideographic-structure new-str))))
1377 (list ?⿲ (nth 1 enc-str) new-str-c (nth 3 enc-str))
1378 (setq a-res (ids-find-chars-including-ids new-str))
1383 (list ?⿲ (nth 1 enc-str) new-str-c (nth 3 enc-str))
1386 ((eq (car enc-str) ?⿴)
1387 (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
1389 (eq (car enc2-str) ?⿰))
1390 (unless conversion-only
1391 (setq f-res (ids-find-chars-including-ids enc-str)))
1392 (setq new-str (list ?⿱
1396 (if (setq ret (ideographic-structure-find-chars new-str))
1398 (list (cons 'ideographic-structure new-str))))
1400 (list ?⿲ (nth 1 enc2-str) new-str-c (nth 2 enc2-str))
1401 (setq a-res (ids-find-chars-including-ids new-str))
1406 (list ?⿲ (nth 1 enc2-str) new-str-c (nth 2 enc2-str))
1411 ((eq (car structure) ?⿵)
1412 (setq enc (nth 1 structure))
1414 (cond ((characterp enc)
1415 (get-char-attribute enc 'ideographic-structure)
1418 (cdr (assq 'ideographic-structure enc))
1421 ((eq (car enc-str) ?⿱)
1423 ((and (characterp (nth 2 enc-str))
1424 (memq (char-ucs (nth 2 enc-str))
1426 (unless conversion-only
1427 (setq f-res (ids-find-chars-including-ids enc-str)))
1428 (setq new-str (list ?⿵
1432 (if (setq ret (ideographic-structure-find-chars new-str))
1434 (list (cons 'ideographic-structure new-str))))
1436 (list ?⿱ (nth 1 enc-str) new-str-c)
1437 (setq a-res (ids-find-chars-including-ids new-str))
1442 (list ?⿱ (nth 1 enc-str) new-str-c)
1445 ((and (setq enc2-str (ideographic-character-get-structure (nth 2 enc-str)))
1447 ((eq (car enc2-str) ?⿰)
1450 ((eq (car enc2-str) ?⿲)
1453 ((and (eq (car enc2-str) ?⿱)
1455 (ideographic-character-get-structure (nth 2 enc2-str)))
1456 (eq (car enc3-str) ?⿰))
1459 (unless conversion-only
1460 (setq f-res (ids-find-chars-including-ids enc-str)))
1462 (cond ((eq code 611)
1477 (list (list 'ideographic-structure
1484 (if (setq ret (ideographic-structure-find-chars new-str))
1486 (list (cons 'ideographic-structure
1487 (ideographic-structure-compact new-str)))))
1489 (cond ((or (eq code 611)
1491 (list ?⿱ (nth 1 enc-str) new-str-c)
1494 (list ?⿳ (nth 1 enc-str)(nth 1 enc2-str) new-str-c)
1496 (setq a-res (ids-find-chars-including-ids new-str))
1501 (cond ((or (eq code 611)
1503 (list ?⿱ (nth 1 enc-str) new-str-c)
1506 (list ?⿳ (nth 1 enc-str)(nth 1 enc2-str) new-str-c)
1511 ((eq (car enc-str) ?⿳)
1512 (setq enc2-str (ideographic-character-get-structure (nth 3 enc-str)))
1514 (eq (car enc2-str) ?⿰))
1515 (unless conversion-only
1516 (setq f-res (ids-find-chars-including-ids enc-str)))
1517 (setq new-str (list ?⿲
1522 (if (setq ret (ideographic-structure-find-chars new-str))
1524 (list (cons 'ideographic-structure new-str))))
1526 (list ?⿳ (nth 1 enc-str) (nth 2 enc-str) new-str-c)
1527 (setq a-res (ids-find-chars-including-ids new-str))
1532 (list ?⿳ (nth 1 enc-str) (nth 2 enc-str) new-str-c)
1536 ((eq (car enc-str) ?⿲)
1537 (unless conversion-only
1538 (setq f-res (ids-find-chars-including-ids enc-str)))
1539 (setq new-str (list ?⿱
1543 (if (setq ret (ideographic-structure-find-chars new-str))
1545 (list (cons 'ideographic-structure new-str))))
1547 (list ?⿲ (nth 1 enc-str) new-str-c (nth 3 enc-str))
1548 (setq a-res (ids-find-chars-including-ids new-str))
1553 (list ?⿲ (nth 1 enc-str) new-str-c (nth 3 enc-str))
1556 ((eq (car enc-str) ?⿴)
1557 (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
1559 (eq (car enc2-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 enc2-str) new-str-c (nth 2 enc2-str))
1571 (setq a-res (ids-find-chars-including-ids new-str))
1576 (list ?⿲ (nth 1 enc2-str) new-str-c (nth 2 enc2-str))
1579 ((eq (car enc-str) ?⿵)
1580 (unless conversion-only
1581 (setq f-res (ids-find-chars-including-ids enc-str)))
1582 (setq new-str (list ?⿱
1586 (if (setq ret (ideographic-structure-find-chars new-str))
1588 (list (cons 'ideographic-structure new-str))))
1590 (list ?⿵ (nth 1 enc-str) new-str-c)
1591 (setq a-res (ids-find-chars-including-ids new-str))
1596 (list ?⿵ (nth 1 enc-str) new-str-c)
1601 ((eq (car structure) ?⿷)
1602 (setq enc (nth 1 structure))
1604 (cond ((characterp enc)
1605 (get-char-attribute enc 'ideographic-structure)
1608 (cdr (assq 'ideographic-structure enc))
1611 ((eq (car enc-str) ?⿺)
1612 (unless conversion-only
1613 (setq f-res (ids-find-chars-including-ids enc-str)))
1614 (setq new-str (list ?⿱
1618 (if (setq ret (ideographic-structure-find-chars new-str))
1620 (list (cons 'ideographic-structure new-str))))
1622 (list ?⿺ (nth 1 enc-str) new-str-c)
1623 (setq a-res (ids-find-chars-including-ids new-str))
1628 (list ?⿺ (nth 1 enc-str) new-str-c)
1631 ((eq (car enc-str) ?⿸)
1632 (unless conversion-only
1633 (setq f-res (ids-find-chars-including-ids enc-str)))
1635 ((and (characterp (nth 2 enc-str))
1636 (or (memq (char-ucs (nth 2 enc-str))
1637 '(#x4EBA #x5165 #x513F #x51E0))
1638 (memq (or (encode-char (nth 2 enc-str) '=>ucs@iwds-1)
1639 (encode-char (nth 2 enc-str) '=>ucs@component))
1641 (setq new-str (list ?⿺
1645 (if (setq ret (ideographic-structure-find-chars new-str))
1647 (list (cons 'ideographic-structure new-str))))
1649 (list ?⿸ (nth 1 enc-str) new-str-c)
1650 (setq a-res (ids-find-chars-including-ids new-str))
1655 (list ?⿸ (nth 1 enc-str) new-str-c)
1659 (setq new-str (list ?⿱
1663 (if (setq ret (ideographic-structure-find-chars new-str))
1665 (list (cons 'ideographic-structure new-str))))
1667 (list ?⿸ (nth 1 enc-str) new-str-c)
1668 (setq a-res (ids-find-chars-including-ids new-str))
1673 (list ?⿸ (nth 1 enc-str) new-str-c)
1679 ((eq (car structure) ?⿺)
1680 (setq enc (nth 1 structure))
1682 (cond ((characterp enc)
1683 (or (get-char-attribute enc 'ideographic-structure)
1684 (get-char-attribute enc 'ideographic-structure@apparent)
1685 (get-char-attribute enc 'ideographic-structure@apparent/leftmost))
1688 (or (cdr (assq 'ideographic-structure enc))
1689 (cdr (assq 'ideographic-structure@apparent enc))
1690 (cdr (assq 'ideographic-structure@apparent/leftmost enc)))
1693 ;; (mapcar (lambda (cell)
1694 ;; (or (and (listp cell)
1695 ;; (find-char cell))
1699 ((eq (car enc-str) ?⿱)
1701 ((and (characterp (nth 1 enc-str))
1702 (or (and (eq (char-ucs (nth 1 enc-str)) #x200CA)
1704 (and (eq (char-feature (nth 1 enc-str) '=>iwds-1) 233)
1705 (characterp (nth 2 structure))
1706 (eq (char-ucs (nth 2 structure)) #x4E36)
1708 (unless conversion-only
1709 (setq f-res (ids-find-chars-including-ids enc-str)))
1710 (setq new-str (list ?⿺
1714 (if (setq ret (ideographic-structure-find-chars new-str))
1716 (list (cons 'ideographic-structure new-str))))
1718 (list ?⿱ new-str-c (nth 2 enc-str))
1719 (setq a-res (ids-find-chars-including-ids new-str))
1724 (list ?⿱ new-str-c (nth 2 enc-str))
1727 ((and (characterp (nth 2 enc-str))
1728 (or (memq (char-ucs (nth 2 enc-str))
1731 #x65E5 #x66F0 #x5FC3
1732 #x2123C #x58EC #x738B #x7389))
1733 (memq (encode-char (nth 2 enc-str) '=>ucs@component)
1735 (eq (encode-char (nth 2 enc-str) '=>ucs@iwds-1)
1737 (eq (encode-char (nth 2 enc-str) '=>big5-cdp)
1739 (unless conversion-only
1740 (setq f-res (ids-find-chars-including-ids enc-str)))
1741 (setq new-str (list ?⿰
1745 (if (setq ret (ideographic-structure-find-chars new-str))
1747 (list (cons 'ideographic-structure new-str))))
1749 (list ?⿱ new-str-c (nth 2 enc-str))
1750 (setq a-res (ids-find-chars-including-ids new-str))
1755 (list ?⿱ new-str-c (nth 2 enc-str))
1760 ((eq (car structure) ?⿻)
1761 (setq enc (nth 1 structure))
1763 (cond ((characterp enc)
1764 (get-char-attribute enc 'ideographic-structure)
1767 (cdr (assq 'ideographic-structure enc))
1770 ((eq (car enc-str) ?⿱)
1771 (unless conversion-only
1772 (setq f-res (ids-find-chars-including-ids enc-str)))
1774 (list ?⿳ (nth 1 enc-str) (nth 2 structure) (nth 2 enc-str))
1794 ;;; ids-find.el ends here