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, 2022
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))
35 (when (setq ret (char-feature component 'ideographic-structure@apparent))
36 (ids-index-store-structure product ret))
37 (when (setq ret (char-feature component 'ideographic-structure@apparent/leftmost))
38 (ids-index-store-structure product ret))
39 (when (setq ret (char-feature component 'ideographic-structure@apparent/rightmost))
40 (ids-index-store-structure product ret))
44 (defun ids-index-store-structure (product structure)
46 (dolist (cell (cdr structure))
48 (setq cell (plist-get cell :char)))
49 (cond ((characterp cell)
50 (ids-index-store-char product cell))
51 ((setq ret (assq 'ideographic-structure cell))
52 (ids-index-store-structure product (cdr ret)))
53 ((setq ret (assq 'ideographic-structure@apparent cell))
54 (ids-index-store-structure product (cdr ret)))
55 ((setq ret (assq 'ideographic-structure@apparent/leftmost cell))
56 (ids-index-store-structure product (cdr ret)))
57 ((setq ret (assq 'ideographic-structure@apparent/rightmost cell))
58 (ids-index-store-structure product (cdr ret)))
59 ((setq ret (find-char cell))
60 (ids-index-store-char product ret))
64 (defun ids-update-index (&optional in-memory)
68 (ids-index-store-structure c v)
70 'ideographic-structure)
73 (ids-index-store-structure c v)
75 'ideographic-structure@apparent)
78 (ids-index-store-structure c v)
80 'ideographic-structure@apparent/leftmost)
83 (ids-index-store-structure c v)
85 'ideographic-structure@apparent/rightmost)
87 (save-char-attribute-table 'ideographic-products)))
90 (mount-char-attribute-table 'ideographic-products)
93 (defun ids-find-all-products (char)
95 (dolist (cell (char-feature char 'ideographic-products))
96 (unless (memq cell dest)
97 (setq dest (cons cell dest)))
98 (setq dest (union dest (ids-find-all-products cell))))
101 (defun of-component-features ()
103 (dolist (feature (char-attribute-list))
104 (when (string-match "^<-.*[@/]component\\(/[^*/]+\\)*$"
105 (symbol-name feature))
106 (push feature dest)))
107 (list* '<-mistakable '->mistakable
110 '<-original '->original
111 '<-ancient '->ancient
114 (defun to-component-features ()
116 (dolist (feature (char-attribute-list))
117 (when (string-match "^->.*[@/]component\\(/[^*/]+\\)*$"
118 (symbol-name feature))
119 (push feature dest)))
123 (defun char-component-variants (char)
124 (let ((dest (list char))
126 (dolist (feature (to-component-features))
127 (if (setq ret (get-char-attribute char feature))
129 (setq dest (union dest (char-component-variants c))))))
131 ;; ((setq ret (some (lambda (feature)
132 ;; (get-char-attribute char feature))
133 ;; (to-component-features)))
135 ;; (setq dest (union dest (char-component-variants c))))
137 ((setq ret (get-char-attribute char '->ucs-unified))
138 (setq dest (cons char ret))
140 (setq dest (union dest
141 (some (lambda (feature)
142 (get-char-attribute c feature))
143 (of-component-features))
146 ((and (setq ret (get-char-attribute char '=>ucs))
147 (setq uchr (decode-char '=ucs ret)))
148 (setq dest (cons uchr (char-variants uchr)))
150 (setq dest (union dest
151 (some (lambda (feature)
152 (get-char-attribute c feature))
153 (of-component-features))
159 (unless (memq c dest)
160 (setq dest (cons c dest)))
163 (some (lambda (feature)
164 (char-feature c feature))
165 (of-component-features))
173 (defun ideographic-products-find (&rest components)
174 (if (stringp (car components))
175 (setq components (string-to-char-list (car components))))
177 (dolist (variant (char-component-variants (car components)))
180 (get-char-attribute variant 'ideographic-products))))
183 (setq components (cdr components)))
185 (dolist (variant (char-component-variants (car components)))
188 (get-char-attribute variant 'ideographic-products))))
189 (setq dest (intersection dest products)))
192 (defun ideograph-find-products-with-variants (components &optional ignored-chars)
193 (if (stringp components)
194 (setq components (string-to-char-list components)))
196 (dolist (variant (char-component-variants (car components)))
200 (get-char-attribute variant 'ideographic-products)
204 (setq components (cdr components)))
206 (dolist (variant (char-component-variants (car components)))
210 (get-char-attribute variant 'ideographic-products)
212 (setq dest (intersection dest products)))
215 (defun ideograph-find-products (components &optional ignored-chars)
216 (if (stringp components)
217 (setq components (string-to-char-list components)))
219 ;; (dolist (variant (char-component-variants (car components)))
222 ;; (get-char-attribute variant 'ideographic-products))))
223 ;; (setq dest products)
224 (setq dest (get-char-attribute (car components) 'ideographic-products))
226 (setq components (cdr components)))
227 ;; (setq products nil)
228 ;; (dolist (variant (char-component-variants (car components)))
231 ;; (get-char-attribute variant 'ideographic-products))))
232 (setq products (get-char-attribute (car components) 'ideographic-products))
233 (setq dest (intersection dest products)))
237 (defun ideographic-structure-char= (c1 c2)
240 (let ((m1 (char-ucs c1))
244 (memq c1 (char-component-variants c2)))))))
246 (defun ideographic-structure-member-compare-components (component s-component)
248 (cond ((char-ref= component s-component #'ideographic-structure-char=))
250 (if (setq ret (assq 'ideographic-structure s-component))
251 (ideographic-structure-member component (cdr ret))))
252 ((setq ret (get-char-attribute s-component 'ideographic-structure))
253 (ideographic-structure-member component ret)))))
256 (defun ideographic-structure-member (component structure)
257 "Return non-nil if COMPONENT is included in STRUCTURE."
258 (or (memq component structure)
260 (setq structure (cdr structure))
261 (ideographic-structure-member-compare-components
262 component (car structure)))
264 (setq structure (cdr structure))
265 (ideographic-structure-member-compare-components
266 component (car structure)))
268 (setq structure (cdr structure))
270 (ideographic-structure-member-compare-components
271 component (car structure))))))
275 (defun ideographic-structure-repertoire-p (structure components)
276 "Return non-nil if STRUCTURE can be constructed by a subset of COMPONENTS."
278 (let (ret s-component)
280 (while (setq structure (cdr structure))
281 (setq s-component (car structure))
282 (unless (characterp s-component)
283 (if (setq ret (find-char s-component))
284 (setq s-component ret)))
287 (if (setq ret (assq 'ideographic-structure s-component))
288 (ideographic-structure-repertoire-p
289 (cdr ret) components)))
290 ((member* s-component components
291 :test #'ideographic-structure-char=))
293 (get-char-attribute s-component
294 'ideographic-structure))
295 (ideographic-structure-repertoire-p ret components)))
300 (defvar ids-find-result-buffer "*ids-chars*")
302 (defun ids-find-format-line (c v)
303 (format "%c\t%s\t%s\n"
305 (or (let ((ucs (or (char-ucs c)
306 (encode-char c 'ucs))))
308 (cond ((<= ucs #xFFFF)
309 (format " U+%04X" ucs))
311 (format "U-%08X" ucs)))))
313 (or (ideographic-structure-to-ids v)
316 (defun ids-insert-chars-including-components* (components
317 &optional level ignored-chars)
321 (dolist (c (sort (copy-list (ideograph-find-products components
324 (if (setq as (char-total-strokes a))
325 (if (setq bs (char-total-strokes b))
327 (ideograph-char< a b)
330 (ideograph-char< a b)))))
331 (unless (memq c ignored-chars)
332 (setq is (char-feature c 'ideographic-structure))
337 (insert (ids-find-format-line c is))
339 (ids-insert-chars-including-components*
340 (char-to-string c) (1+ level)
341 (cons c ignored-chars))))
346 (defun ids-insert-chars-including-components (components
347 &optional level ignored-chars)
352 (ids-insert-chars-including-components* components
353 level ignored-chars)))
355 (dolist (c ignored-chars)
356 (dolist (vc (char-component-variants c))
357 (unless (memq vc ignored-chars)
358 (when (setq is (get-char-attribute vc 'ideographic-structure))
363 (insert (ids-find-format-line vc is))
365 (ids-insert-chars-including-components*
366 (char-to-string vc) (1+ level)
367 (cons vc ignored-chars)))))))
368 (dolist (c (sort (copy-list (ideograph-find-products-with-variants
369 components ignored-chars))
371 (if (setq as (char-total-strokes a))
372 (if (setq bs (char-total-strokes b))
374 (ideograph-char< a b)
377 (ideograph-char< a b)))))
378 (unless (memq c ignored-chars)
379 (setq is (get-char-attribute c 'ideographic-structure))
384 (insert (ids-find-format-line c is))
386 (ids-insert-chars-including-components*
387 (char-to-string c) (1+ level)
388 (cons c ignored-chars))))
394 (defun ids-find-chars-including-components (components)
395 "Search Ideographs whose structures have COMPONENTS."
396 (interactive "sComponents : ")
397 (with-current-buffer (get-buffer-create ids-find-result-buffer)
398 (setq buffer-read-only nil)
400 (ids-insert-chars-including-components components 0 nil)
401 ;; (let ((ignored-chars
403 ;; (ids-insert-chars-including-components components 0 nil
404 ;; #'ideograph-find-products)))
406 ;; (setq rest ignored-chars)
407 ;; ;; (dolist (c rest)
408 ;; ;; (setq ignored-chars
409 ;; ;; (union ignored-chars
410 ;; ;; (ids-insert-chars-including-components
411 ;; ;; (list c) 0 ignored-chars
412 ;; ;; #'ideograph-find-products-with-variants))))
413 ;; (ids-insert-chars-including-components components 0 ignored-chars
414 ;; #'ideograph-find-products-with-variants))
415 (goto-char (point-min)))
416 (view-buffer ids-find-result-buffer))
419 (define-obsolete-function-alias 'ideographic-structure-search-chars
420 'ids-find-chars-including-components)
423 (defun ids-find-chars-covered-by-components (components)
424 "Search Ideographs which structures are consisted by subsets of COMPONENTS."
425 (interactive "sComponents: ")
426 (if (stringp components)
427 (setq components (string-to-char-list components)))
428 (with-current-buffer (get-buffer-create ids-find-result-buffer)
429 (setq buffer-read-only nil)
433 (when (ideographic-structure-repertoire-p v components)
434 (insert (ids-find-format-line c v))))
435 'ideographic-structure)
436 (goto-char (point-min)))
437 (view-buffer ids-find-result-buffer))
440 (defun ideographic-structure-merge-components-alist (ca1 ca2)
441 (let ((dest-alist ca1)
444 (if (setq ret (assq (car cell) dest-alist))
445 (setcdr ret (+ (cdr ret)(cdr cell)))
446 (setq dest-alist (cons cell dest-alist))))
449 (defun ideographic-structure-to-components-alist (structure)
450 (apply #'ideographic-structure-to-components-alist* structure))
452 (defun ideographic-structure-to-components-alist* (operator component1 component2
455 (let (dest-alist ret)
457 (cond ((characterp component1)
458 (unless (encode-char component1 'ascii)
459 (list (cons component1 1)))
461 ((setq ret (assq 'ideographic-structure component1))
462 (ideographic-structure-to-components-alist (cdr ret))
464 ((setq ret (find-char component1))
468 (ideographic-structure-merge-components-alist
470 (cond ((characterp component2)
471 (unless (encode-char component2 'ascii)
472 (list (cons component2 1)))
474 ((setq ret (assq 'ideographic-structure component2))
475 (ideographic-structure-to-components-alist (cdr ret))
477 ((setq ret (find-char component2))
480 (if (memq operator '(?\u2FF2 ?\u2FF3))
481 (ideographic-structure-merge-components-alist
483 (cond ((characterp component3)
484 (unless (encode-char component3 'ascii)
485 (list (cons component3 1)))
487 ((setq ret (assq 'ideographic-structure component3))
488 (ideographic-structure-to-components-alist (cdr ret))
490 ((setq ret (find-char component3))
495 (defun ids-find-merge-variables (ve1 ve2)
501 (let ((dest-alist ve1)
505 (setq cell (car rest))
506 (if (setq ret (assq (car cell) ve1))
507 (eq (cdr ret)(cdr cell))
508 (setq dest-alist (cons cell dest-alist))))
509 (setq rest (cdr rest)))
515 (defun ideographic-structure-equal (structure1 structure2)
516 (let (dest-alist ret)
517 (and (setq dest-alist (ideographic-structure-character=
518 (car structure1)(car structure2)))
519 (setq ret (ideographic-structure-character=
520 (nth 1 structure1)(nth 1 structure2)))
521 (setq dest-alist (ids-find-merge-variables dest-alist ret))
522 (setq ret (ideographic-structure-character=
523 (nth 2 structure1)(nth 2 structure2)))
524 (setq dest-alist (ids-find-merge-variables dest-alist ret))
525 (if (memq (car structure1) '(?\u2FF2 ?\u2FF3))
526 (and (setq ret (ideographic-structure-character=
527 (nth 3 structure1)(nth 3 structure2)))
528 (setq dest-alist (ids-find-merge-variables dest-alist ret)))
532 (defun ideographic-structure-character= (c1 c2)
534 (cond ((characterp c1)
535 (cond ((encode-char c1 'ascii)
539 (if (encode-char c2 'ascii)
543 ((setq ret2 (find-char c2))
546 ((setq ret2 (assq 'ideographic-structure c2))
547 (and (setq ret (get-char-attribute c1 'ideographic-structure))
548 (ideographic-structure-equal ret (cdr ret2)))
551 ((setq ret (assq 'ideographic-structure c1))
552 (cond ((characterp c2)
553 (if (encode-char c2 'ascii)
555 (and (setq ret2 (get-char-attribute c2 'ideographic-structure))
556 (ideographic-structure-equal (cdr ret) ret2)))
558 ((setq ret2 (find-char c2))
559 (and (setq ret2 (get-char-attribute ret2 'ideographic-structure))
560 (ideographic-structure-equal (cdr ret) ret2))
562 ((setq ret2 (assq 'ideographic-structure c2))
563 (ideographic-structure-equal (cdr ret)(cdr ret2))
566 ((setq ret (find-char c1))
567 (cond ((characterp c2)
568 (if (encode-char c2 'ascii)
572 ((setq ret2 (find-char c2))
575 ((setq ret2 (assq 'ideographic-structure c2))
576 (and (setq ret (get-char-attribute ret 'ideographic-structure))
577 (ideographic-structure-equal ret (cdr ret2))
581 (defun ideographic-structure-find-chars (structure)
582 (let ((comp-alist (ideographic-structure-to-components-alist structure))
585 (sort (mapcar (lambda (cell)
586 (if (setq ret (get-char-attribute
587 (car cell) 'ideographic-products))
588 (cons ret (length ret))
592 (< (cdr a)(cdr b))))))
593 (when (or (and (setq str
594 (get-char-attribute pc 'ideographic-structure))
595 (ideographic-structure-equal str structure))
597 (get-char-attribute pc 'ideographic-structure@apparent))
598 (ideographic-structure-equal str structure))
600 (get-char-attribute pc 'ideographic-structure@apparent/leftmost))
601 (ideographic-structure-equal str structure)))
602 (setq pl (cons pc pl))
607 (defun ideographic-char-count-components (char component)
610 (cond ((eq char component)
612 ((setq structure (get-char-attribute char 'ideographic-structure))
613 (dolist (cell (ideographic-structure-to-components-alist structure))
616 (if (eq (car cell) char)
618 (* (ideographic-char-count-components (car cell) component)
626 (defun ideographic-character-get-structure (character)
627 "Return ideographic-structure of CHARACTER.
628 CHARACTER can be a character or char-spec."
629 (mapcar (lambda (cell)
630 (or (and (listp cell)
634 (cond ((characterp character)
635 (get-char-attribute character 'ideographic-structure)
637 ((setq ret (assq 'ideographic-structure character))
640 ((setq ret (find-char character))
641 (get-char-attribute ret 'ideographic-structure)
645 (defun ideographic-char-match-component (char component)
646 "Return non-nil if character CHAR has COMPONENT in ideographic-structure.
647 COMPONENT can be a character or char-spec."
648 (or (ideographic-structure-character= char component)
649 (let ((str (ideographic-character-get-structure char)))
651 (or (ideographic-char-match-component (nth 1 str) component)
652 (ideographic-char-match-component (nth 2 str) component)
653 (if (memq (car str) '(?\u2FF2 ?\u2FF3))
654 (ideographic-char-match-component (nth 3 str) component)))))))
656 (defun ideographic-structure-char< (a b)
657 (let ((sa (get-char-attribute a 'ideographic-structure))
658 (sb (get-char-attribute b 'ideographic-structure))
662 (setq tsa (char-total-strokes a)
663 tsb (char-total-strokes b))
668 (ideograph-char< a b)))
672 (ideograph-char< a b))))
680 (setq tsa (char-total-strokes a)
681 tsb (char-total-strokes b))
686 (ideograph-char< a b)))
690 (ideograph-char< a b)))
695 (defun ideo-comp-tree-adjoin (tree char)
699 (while (and (not finished)
701 (setq cell (pop rest))
702 (cond ((ideographic-structure-character= char (car cell))
707 ((ideographic-char-match-component char (car cell))
709 (cons (cons (car cell)
710 (ideo-comp-tree-adjoin (cdr cell) char))
714 ((ideographic-char-match-component (car cell) char)
715 (setq included (cons cell included))
718 ;; (setq other (cons cell other))
721 (setq dest (cons cell dest))
727 (cons (cons char included)
731 (cons (list char) tree)
734 (defun ideographic-chars-to-is-a-tree (chars)
736 (dolist (char (sort (copy-list chars) #'ideographic-structure-char<))
737 (setq tree (ideo-comp-tree-adjoin tree char)))
740 (defun ids-find-chars-including-ids (structure)
741 (let (comp-alist comp-spec ret str rest)
743 ((characterp structure)
744 (setq rest (copy-list (get-char-attribute structure 'ideographic-products)))
746 ((setq ret (ideographic-structure-find-chars structure))
751 (copy-list (get-char-attribute pc 'ideographic-products)))))
754 (setq comp-alist (ideographic-structure-to-components-alist structure)
755 comp-spec (list (cons 'ideographic-structure structure)))
757 (sort (mapcar (lambda (cell)
758 (if (setq ret (get-char-attribute
759 (car cell) 'ideographic-products))
760 (cons ret (length ret))
764 (< (cdr a)(cdr b))))))
765 (when (and (every (lambda (cell)
766 (>= (ideographic-char-count-components pc (car cell))
769 (or (ideographic-char-match-component pc comp-spec)
770 (and (setq str (get-char-attribute pc 'ideographic-structure))
771 (ideographic-char-match-component
774 'ideographic-structure
775 (functional-ideographic-structure-to-apparent-structure
780 (ideographic-chars-to-is-a-tree rest)))
782 (defun functional-ideographic-structure-to-apparent-structure (structure)
783 (ideographic-structure-compare-functional-and-apparent
784 structure nil 'conversion-only))
787 (defun ideographic-structure-compact (structure)
788 (let ((rest structure)
792 (setq cell (pop rest))
793 (if (and (consp cell)
794 (setq ret (find-char cell)))
798 (cond ((setq ret (assq 'ideographic-structure cell))
805 (cond ((setq ret (ideographic-structure-find-chars sub))
808 ((setq ret (ideographic-structure-compact sub))
809 (list (cons 'ideographic-structure ret))
812 (list (cons 'ideographic-structure sub))))
815 (setq dest (cons cell dest)))
818 (defun ideographic-structure-compare-functional-and-apparent (structure
821 (let (enc enc-str enc2-str enc3-str new-str new-str-c
822 f-res a-res ret code)
824 ((eq (car structure) ?⿸)
825 (setq enc (nth 1 structure))
827 (cond ((characterp enc)
828 (get-char-attribute enc 'ideographic-structure)
831 (cdr (assq 'ideographic-structure enc))
834 ((eq (car enc-str) ?⿰)
835 (unless conversion-only
836 (setq f-res (ids-find-chars-including-ids enc-str)))
837 (setq new-str (list ?⿱
841 (if (setq ret (ideographic-structure-find-chars new-str))
843 (list (cons 'ideographic-structure new-str))))
845 (list ?⿰ (nth 1 enc-str) new-str-c)
846 (setq a-res (ids-find-chars-including-ids new-str))
851 (list ?⿰ (nth 1 enc-str) new-str-c)
854 ((and (eq (car enc-str) ?⿲)
855 (memq (char-ucs (nth 1 enc-str)) '(#x4EBB #x2E85))
856 (eq (nth 2 enc-str) ?丨))
857 (unless conversion-only
858 (setq f-res (ids-find-chars-including-ids enc-str)))
859 (setq new-str (list ?⿱
863 (if (setq ret (ideographic-structure-find-chars new-str))
865 (list (cons 'ideographic-structure new-str))))
867 (list ?⿰ (decode-char '=big5-cdp #x8B7A) new-str-c)
868 (setq a-res (ids-find-chars-including-ids new-str))
873 (list ?⿰ (decode-char '=big5-cdp #x8B7A) new-str-c)
876 ((eq (car enc-str) ?⿱)
877 (unless conversion-only
878 (setq f-res (ids-find-chars-including-ids enc-str)))
882 ((characterp (nth 2 enc-str))
883 (if (or (memq (encode-char (nth 2 enc-str) '=>ucs@component)
884 '(#x20087 #x5382 #x4E06))
885 (eq (encode-char (nth 2 enc-str) '=>ucs@iwds-1)
887 (eq (encode-char (nth 2 enc-str) '=ucs-itaiji-001)
889 (eq (encode-char (nth 2 enc-str) '=big5-cdp)
891 (eq (encode-char (nth 2 enc-str) '=>big5-cdp)
893 (eq (encode-char (nth 2 enc-str) '=big5-cdp)
895 (eq (or (encode-char (nth 2 enc-str) '=>big5-cdp)
896 (encode-char (nth 2 enc-str) '=big5-cdp-itaiji-001))
898 (eq (car (get-char-attribute (nth 2 enc-str)
899 'ideographic-structure))
903 ((eq (car (cdr (assq 'ideographic-structure (nth 2 enc-str))))
911 (if (setq ret (ideographic-structure-find-chars new-str))
913 (list (cons 'ideographic-structure new-str))))
915 (list ?⿱ (nth 1 enc-str) new-str-c)
916 (setq a-res (ids-find-chars-including-ids new-str))
921 (list ?⿱ (nth 1 enc-str) new-str-c)
922 (if (eq (car new-str) ?⿸)
926 ((eq (car enc-str) ?⿸)
927 (unless conversion-only
928 (setq f-res (ids-find-chars-including-ids enc-str)))
929 (setq new-str (list (cond
930 ((characterp (nth 2 enc-str))
931 (if (memq (char-ucs (nth 2 enc-str))
941 (if (setq ret (ideographic-structure-find-chars new-str))
943 (list (cons 'ideographic-structure new-str))))
945 (list ?⿸ (nth 1 enc-str) new-str-c)
946 (setq a-res (ids-find-chars-including-ids new-str))
951 (list ?⿸ (nth 1 enc-str) new-str-c)
952 (if (eq (car new-str) ?⿰)
957 ((eq (car structure) ?⿹)
958 (setq enc (nth 1 structure))
960 (cond ((characterp enc)
961 (get-char-attribute enc 'ideographic-structure)
964 (cdr (assq 'ideographic-structure enc))
967 ((eq (car enc-str) ?⿰)
968 (unless conversion-only
969 (setq f-res (ids-find-chars-including-ids enc-str)))
970 (setq new-str (list ?⿱
974 (if (setq ret (ideographic-structure-find-chars new-str))
976 (list (cons 'ideographic-structure new-str))))
978 (list ?⿰ new-str-c (nth 2 enc-str))
979 (setq a-res (ids-find-chars-including-ids new-str))
984 (list ?⿰ new-str-c (nth 2 enc-str))
987 ((eq (car enc-str) ?⿱)
988 (unless conversion-only
989 (setq f-res (ids-find-chars-including-ids enc-str)))
990 (setq new-str (list ?⿰
994 (if (setq ret (ideographic-structure-find-chars new-str))
996 (list (cons 'ideographic-structure new-str))))
998 (list ?⿱ (nth 1 enc-str) new-str-c)
999 (setq a-res (ids-find-chars-including-ids new-str))
1004 (list ?⿱ (nth 1 enc-str) new-str-c)
1009 ((eq (get-char-attribute (car structure) '=ucs-itaiji-001) #x2FF6)
1010 (setq enc (nth 1 structure))
1012 (cond ((characterp enc)
1013 (get-char-attribute enc 'ideographic-structure)
1016 (cdr (assq 'ideographic-structure enc))
1019 ((eq (car enc-str) ?⿺)
1020 (unless conversion-only
1021 (setq f-res (ids-find-chars-including-ids enc-str)))
1022 (setq new-str (list ?⿱
1026 (if (setq ret (ideographic-structure-find-chars new-str))
1028 (list (cons 'ideographic-structure new-str))))
1030 (list ?⿺ new-str-c (nth 2 enc-str))
1031 (setq a-res (ids-find-chars-including-ids new-str))
1036 (list ?⿺ new-str-c (nth 2 enc-str))
1039 ((eq (car enc-str) ?⿱)
1040 (unless conversion-only
1041 (setq f-res (ids-find-chars-including-ids enc-str)))
1042 (setq new-str (list ?⿰
1046 (if (setq ret (ideographic-structure-find-chars new-str))
1048 (list (cons 'ideographic-structure new-str))))
1050 (list ?⿱ new-str-c (nth 2 enc-str))
1051 (setq a-res (ids-find-chars-including-ids new-str))
1056 (list ?⿱ new-str-c (nth 2 enc-str))
1059 ((eq (car enc-str) ?⿰)
1060 (unless conversion-only
1061 (setq f-res (ids-find-chars-including-ids enc-str)))
1062 (setq new-str (list ?⿱
1066 (if (setq ret (ideographic-structure-find-chars new-str))
1068 (list (cons 'ideographic-structure new-str))))
1070 (list ?⿰ new-str-c (nth 2 enc-str))
1071 (setq a-res (ids-find-chars-including-ids new-str))
1076 (list ?⿰ new-str-c (nth 2 enc-str))
1081 ((eq (car structure) ?⿴)
1082 (setq enc (nth 1 structure))
1084 (cond ((characterp enc)
1085 (get-char-attribute enc 'ideographic-structure)
1088 (cdr (assq 'ideographic-structure enc))
1091 ((eq (car enc-str) ?⿱)
1093 ((and (characterp (nth 2 enc-str))
1094 (or (memq (char-ucs (nth 2 enc-str)) '(#x56D7 #x5F51 #x897F))
1095 (eq (char-feature (nth 2 enc-str) '=>big5-cdp)
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 2 enc-str))
1117 (eq (char-ucs (nth 2 enc-str)) #x51F5))
1118 (unless conversion-only
1119 (setq f-res (ids-find-chars-including-ids enc-str)))
1120 (setq new-str (list ?⿶
1124 (if (setq ret (ideographic-structure-find-chars new-str))
1126 (list (cons 'ideographic-structure new-str))))
1128 (list ?⿱ (nth 1 enc-str) new-str-c)
1129 (setq a-res (ids-find-chars-including-ids new-str))
1134 (list ?⿱ (nth 1 enc-str) new-str-c)
1137 ((and (characterp (nth 1 enc-str))
1138 (eq (char-feature (nth 1 enc-str) '=>ucs@component)
1140 (unless conversion-only
1141 (setq f-res (ids-find-chars-including-ids enc-str)))
1142 (setq new-str (list ?⿵
1146 (if (setq ret (ideographic-structure-find-chars new-str))
1148 (list (cons 'ideographic-structure new-str))))
1150 (list ?⿱ new-str-c (nth 2 enc-str))
1151 (setq a-res (ids-find-chars-including-ids new-str))
1156 (list ?⿱ new-str-c (nth 2 enc-str))
1160 (unless conversion-only
1161 (setq f-res (ids-find-chars-including-ids enc-str)))
1162 (setq new-str (list ?⿱ (nth 2 structure) (nth 2 enc-str)))
1164 (if (setq ret (ideographic-structure-find-chars new-str))
1166 (list (cons 'ideographic-structure new-str))))
1168 (list ?⿱ (nth 1 enc-str) new-str-c)
1169 (setq a-res (ids-find-chars-including-ids new-str))
1174 (list ?⿱ (nth 1 enc-str) new-str-c)
1178 ((eq (car enc-str) ?⿳)
1180 ((and (characterp (nth 2 enc-str))
1181 (eq (char-ucs (nth 2 enc-str)) #x56D7))
1182 (unless conversion-only
1183 (setq f-res (ids-find-chars-including-ids enc-str)))
1184 (setq new-str (list ?⿴ (nth 2 enc-str) (nth 2 structure)))
1186 (if (setq ret (ideographic-structure-find-chars new-str))
1188 (list (cons 'ideographic-structure new-str))))
1189 (setq new-str (list ?⿱ (nth 1 enc-str) new-str-c))
1191 (if (setq ret (ideographic-structure-find-chars new-str))
1193 (list (cons 'ideographic-structure new-str))))
1195 (list ?⿱ new-str-c (nth 3 enc-str))
1196 (setq a-res (ids-find-chars-including-ids new-str))
1201 (list ?⿱ new-str-c (nth 3 enc-str))
1204 ((and (characterp (nth 2 enc-str))
1205 (eq (char-ucs (nth 2 enc-str)) #x5196))
1206 (unless conversion-only
1207 (setq f-res (ids-find-chars-including-ids enc-str)))
1208 (setq new-str (list ?⿱ (nth 1 enc-str) (nth 2 enc-str)))
1210 (if (setq ret (ideographic-structure-find-chars new-str))
1212 (list (cons 'ideographic-structure new-str))))
1213 (setq new-str (list ?⿱ new-str-c (nth 2 structure)))
1215 (if (setq ret (ideographic-structure-find-chars new-str))
1217 (list (cons 'ideographic-structure new-str))))
1219 (list ?⿱ new-str-c (nth 3 enc-str))
1220 (setq a-res (ids-find-chars-including-ids new-str))
1225 (list ?⿱ new-str-c (nth 3 enc-str))
1228 ((and (characterp (nth 2 enc-str))
1229 (or (eq (encode-char (nth 2 enc-str) '=>big5-cdp)
1231 (eq (encode-char (nth 2 enc-str) '=>gt-k)
1233 (eq (char-ucs (nth 2 enc-str)) #x2008A)))
1234 (unless conversion-only
1235 (setq f-res (ids-find-chars-including-ids enc-str)))
1236 (setq new-str (list ?⿱ (nth 2 structure) (nth 2 enc-str)))
1238 (if (setq ret (ideographic-structure-find-chars new-str))
1240 (list (cons 'ideographic-structure new-str))))
1241 (setq new-str (list ?⿸ new-str-c (nth 3 enc-str)))
1243 (if (setq ret (ideographic-structure-find-chars new-str))
1245 (list (cons 'ideographic-structure new-str))))
1247 (list ?⿱ (nth 1 enc-str) new-str-c)
1248 (setq a-res (ids-find-chars-including-ids new-str))
1253 (list ?⿱ (nth 1 enc-str) new-str-c)
1257 (unless conversion-only
1258 (setq f-res (ids-find-chars-including-ids enc-str)))
1259 (setq new-str (list ?⿻ (nth 2 enc-str) (nth 2 structure)))
1261 (if (setq ret (ideographic-structure-find-chars new-str))
1263 (list (cons 'ideographic-structure new-str))))
1264 (setq new-str (list ?⿱ (nth 1 enc-str) new-str-c))
1266 (if (setq ret (ideographic-structure-find-chars new-str))
1268 (list (cons 'ideographic-structure new-str))))
1270 (list ?⿱ new-str-c (nth 3 enc-str))
1271 (setq a-res (ids-find-chars-including-ids new-str))
1276 (list ?⿱ new-str-c (nth 3 enc-str))
1280 ((eq (car enc-str) ?⿰)
1282 ((equal (nth 1 enc-str)(nth 2 enc-str))
1283 (unless conversion-only
1284 (setq f-res (ids-find-chars-including-ids enc-str)))
1285 (setq new-str (list ?⿲
1290 (list (cons 'ideographic-structure new-str)))
1293 (setq a-res (ids-find-chars-including-ids new-str))
1302 (unless conversion-only
1303 (setq f-res (ids-find-chars-including-ids enc-str)))
1304 (setq new-str (list ?⿰
1308 (if (setq ret (ideographic-structure-find-chars new-str))
1310 (list (cons 'ideographic-structure new-str))))
1312 (list ?⿰ (nth 1 enc-str) new-str-c)
1313 (setq a-res (ids-find-chars-including-ids new-str))
1318 (list ?⿰ (nth 1 enc-str) new-str-c)
1324 ((eq (car structure) ?⿶)
1325 (setq enc (nth 1 structure))
1327 (cond ((characterp enc)
1328 (get-char-attribute enc 'ideographic-structure)
1331 (cdr (assq 'ideographic-structure enc))
1334 ((eq (car enc-str) ?⿱)
1335 (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
1337 (eq (car enc2-str) ?⿰))
1338 (unless conversion-only
1339 (setq f-res (ids-find-chars-including-ids enc-str)))
1340 (setq new-str (list ?⿲
1345 (if (setq ret (ideographic-structure-find-chars new-str))
1347 (list (cons 'ideographic-structure new-str))))
1349 (list ?⿱ new-str-c (nth 2 enc-str))
1350 (setq a-res (ids-find-chars-including-ids new-str))
1355 (list ?⿱ new-str-c (nth 2 enc-str))
1359 ((eq (car enc-str) ?⿳)
1360 (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
1362 (eq (car enc2-str) ?⿰))
1363 (unless conversion-only
1364 (setq f-res (ids-find-chars-including-ids enc-str)))
1365 (setq new-str (list ?⿲
1370 (if (setq ret (ideographic-structure-find-chars new-str))
1372 (list (cons 'ideographic-structure new-str))))
1374 (list ?⿳ new-str-c (nth 2 enc-str) (nth 3 enc-str))
1375 (setq a-res (ids-find-chars-including-ids new-str))
1380 (list ?⿳ new-str-c (nth 2 enc-str) (nth 3 enc-str))
1384 ((eq (car enc-str) ?⿲)
1385 (unless conversion-only
1386 (setq f-res (ids-find-chars-including-ids enc-str)))
1387 (setq new-str (list ?⿱
1391 (if (setq ret (ideographic-structure-find-chars new-str))
1393 (list (cons 'ideographic-structure new-str))))
1395 (list ?⿲ (nth 1 enc-str) new-str-c (nth 3 enc-str))
1396 (setq a-res (ids-find-chars-including-ids new-str))
1401 (list ?⿲ (nth 1 enc-str) new-str-c (nth 3 enc-str))
1404 ((eq (car enc-str) ?⿴)
1405 (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
1407 (eq (car enc2-str) ?⿰))
1408 (unless conversion-only
1409 (setq f-res (ids-find-chars-including-ids enc-str)))
1410 (setq new-str (list ?⿱
1414 (if (setq ret (ideographic-structure-find-chars new-str))
1416 (list (cons 'ideographic-structure new-str))))
1418 (list ?⿲ (nth 1 enc2-str) new-str-c (nth 2 enc2-str))
1419 (setq a-res (ids-find-chars-including-ids new-str))
1424 (list ?⿲ (nth 1 enc2-str) new-str-c (nth 2 enc2-str))
1429 ((eq (car structure) ?⿵)
1430 (setq enc (nth 1 structure))
1432 (cond ((characterp enc)
1433 (get-char-attribute enc 'ideographic-structure)
1436 (cdr (assq 'ideographic-structure enc))
1439 ((eq (car enc-str) ?⿱)
1441 ((and (characterp (nth 2 enc-str))
1442 (memq (char-ucs (nth 2 enc-str))
1444 (unless conversion-only
1445 (setq f-res (ids-find-chars-including-ids enc-str)))
1446 (setq new-str (list ?⿵
1450 (if (setq ret (ideographic-structure-find-chars new-str))
1452 (list (cons 'ideographic-structure new-str))))
1454 (list ?⿱ (nth 1 enc-str) new-str-c)
1455 (setq a-res (ids-find-chars-including-ids new-str))
1460 (list ?⿱ (nth 1 enc-str) new-str-c)
1463 ((and (setq enc2-str (ideographic-character-get-structure (nth 2 enc-str)))
1465 ((eq (car enc2-str) ?⿰)
1468 ((eq (car enc2-str) ?⿲)
1471 ((and (eq (car enc2-str) ?⿱)
1473 (ideographic-character-get-structure (nth 2 enc2-str)))
1474 (eq (car enc3-str) ?⿰))
1477 (unless conversion-only
1478 (setq f-res (ids-find-chars-including-ids enc-str)))
1480 (cond ((eq code 611)
1495 (list (list 'ideographic-structure
1502 (if (setq ret (ideographic-structure-find-chars new-str))
1504 (list (cons 'ideographic-structure
1505 (ideographic-structure-compact new-str)))))
1507 (cond ((or (eq code 611)
1509 (list ?⿱ (nth 1 enc-str) new-str-c)
1512 (list ?⿳ (nth 1 enc-str)(nth 1 enc2-str) new-str-c)
1514 (setq a-res (ids-find-chars-including-ids new-str))
1519 (cond ((or (eq code 611)
1521 (list ?⿱ (nth 1 enc-str) new-str-c)
1524 (list ?⿳ (nth 1 enc-str)(nth 1 enc2-str) new-str-c)
1529 ((eq (car enc-str) ?⿳)
1530 (setq enc2-str (ideographic-character-get-structure (nth 3 enc-str)))
1532 (eq (car enc2-str) ?⿰))
1533 (unless conversion-only
1534 (setq f-res (ids-find-chars-including-ids enc-str)))
1535 (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) (nth 2 enc-str) new-str-c)
1545 (setq a-res (ids-find-chars-including-ids new-str))
1550 (list ?⿳ (nth 1 enc-str) (nth 2 enc-str) new-str-c)
1554 ((eq (car enc-str) ?⿲)
1555 (unless conversion-only
1556 (setq f-res (ids-find-chars-including-ids enc-str)))
1557 (setq new-str (list ?⿱
1561 (if (setq ret (ideographic-structure-find-chars new-str))
1563 (list (cons 'ideographic-structure new-str))))
1565 (list ?⿲ (nth 1 enc-str) new-str-c (nth 3 enc-str))
1566 (setq a-res (ids-find-chars-including-ids new-str))
1571 (list ?⿲ (nth 1 enc-str) new-str-c (nth 3 enc-str))
1574 ((eq (car enc-str) ?⿴)
1575 (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
1577 (eq (car enc2-str) ?⿰))
1578 (unless conversion-only
1579 (setq f-res (ids-find-chars-including-ids enc-str)))
1580 (setq new-str (list ?⿱
1584 (if (setq ret (ideographic-structure-find-chars new-str))
1586 (list (cons 'ideographic-structure new-str))))
1588 (list ?⿲ (nth 1 enc2-str) new-str-c (nth 2 enc2-str))
1589 (setq a-res (ids-find-chars-including-ids new-str))
1594 (list ?⿲ (nth 1 enc2-str) new-str-c (nth 2 enc2-str))
1597 ((eq (car enc-str) ?⿵)
1598 (unless conversion-only
1599 (setq f-res (ids-find-chars-including-ids enc-str)))
1600 (setq new-str (list ?⿱
1604 (if (setq ret (ideographic-structure-find-chars new-str))
1606 (list (cons 'ideographic-structure new-str))))
1608 (list ?⿵ (nth 1 enc-str) new-str-c)
1609 (setq a-res (ids-find-chars-including-ids new-str))
1614 (list ?⿵ (nth 1 enc-str) new-str-c)
1619 ((eq (car structure) ?⿷)
1620 (setq enc (nth 1 structure))
1622 (cond ((characterp enc)
1623 (get-char-attribute enc 'ideographic-structure)
1626 (cdr (assq 'ideographic-structure enc))
1629 ((eq (car enc-str) ?⿺)
1630 (unless conversion-only
1631 (setq f-res (ids-find-chars-including-ids enc-str)))
1632 (setq new-str (list ?⿱
1636 (if (setq ret (ideographic-structure-find-chars new-str))
1638 (list (cons 'ideographic-structure new-str))))
1640 (list ?⿺ (nth 1 enc-str) new-str-c)
1641 (setq a-res (ids-find-chars-including-ids new-str))
1646 (list ?⿺ (nth 1 enc-str) new-str-c)
1649 ((eq (car enc-str) ?⿸)
1650 (unless conversion-only
1651 (setq f-res (ids-find-chars-including-ids enc-str)))
1653 ((and (characterp (nth 2 enc-str))
1654 (or (memq (char-ucs (nth 2 enc-str))
1655 '(#x4EBA #x5165 #x513F #x51E0))
1656 (memq (or (encode-char (nth 2 enc-str) '=>ucs@iwds-1)
1657 (encode-char (nth 2 enc-str) '=>ucs@component))
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)
1677 (setq new-str (list ?⿱
1681 (if (setq ret (ideographic-structure-find-chars new-str))
1683 (list (cons 'ideographic-structure new-str))))
1685 (list ?⿸ (nth 1 enc-str) new-str-c)
1686 (setq a-res (ids-find-chars-including-ids new-str))
1691 (list ?⿸ (nth 1 enc-str) new-str-c)
1697 ((eq (car structure) ?⿺)
1698 (setq enc (nth 1 structure))
1700 (cond ((characterp enc)
1701 (or (get-char-attribute enc 'ideographic-structure)
1702 (get-char-attribute enc 'ideographic-structure@apparent)
1703 (get-char-attribute enc 'ideographic-structure@apparent/leftmost))
1706 (or (cdr (assq 'ideographic-structure enc))
1707 (cdr (assq 'ideographic-structure@apparent enc))
1708 (cdr (assq 'ideographic-structure@apparent/leftmost enc)))
1711 ;; (mapcar (lambda (cell)
1712 ;; (or (and (listp cell)
1713 ;; (find-char cell))
1717 ((eq (car enc-str) ?⿱)
1719 ((and (characterp (nth 1 enc-str))
1720 (or (and (eq (char-ucs (nth 1 enc-str)) #x200CA)
1722 (and (eq (char-feature (nth 1 enc-str) '=>iwds-1) 233)
1723 (characterp (nth 2 structure))
1724 (eq (char-ucs (nth 2 structure)) #x4E36)
1726 (unless conversion-only
1727 (setq f-res (ids-find-chars-including-ids enc-str)))
1728 (setq new-str (list ?⿺
1732 (if (setq ret (ideographic-structure-find-chars new-str))
1734 (list (cons 'ideographic-structure new-str))))
1736 (list ?⿱ new-str-c (nth 2 enc-str))
1737 (setq a-res (ids-find-chars-including-ids new-str))
1742 (list ?⿱ new-str-c (nth 2 enc-str))
1745 ((and (characterp (nth 2 enc-str))
1746 (or (memq (char-ucs (nth 2 enc-str))
1749 #x65E5 #x66F0 #x5FC3
1750 #x2123C #x58EC #x738B #x7389))
1751 (memq (encode-char (nth 2 enc-str) '=>ucs@component)
1753 (eq (encode-char (nth 2 enc-str) '=>ucs@iwds-1)
1755 (eq (encode-char (nth 2 enc-str) '=>big5-cdp)
1757 (unless conversion-only
1758 (setq f-res (ids-find-chars-including-ids enc-str)))
1759 (setq new-str (list ?⿰
1763 (if (setq ret (ideographic-structure-find-chars new-str))
1765 (list (cons 'ideographic-structure new-str))))
1767 (list ?⿱ new-str-c (nth 2 enc-str))
1768 (setq a-res (ids-find-chars-including-ids new-str))
1773 (list ?⿱ new-str-c (nth 2 enc-str))
1778 ((eq (car structure) ?⿻)
1779 (setq enc (nth 1 structure))
1781 (cond ((characterp enc)
1782 (get-char-attribute enc 'ideographic-structure)
1785 (cdr (assq 'ideographic-structure enc))
1788 ((eq (car enc-str) ?⿱)
1789 (unless conversion-only
1790 (setq f-res (ids-find-chars-including-ids enc-str)))
1792 (list ?⿳ (nth 1 enc-str) (nth 2 structure) (nth 2 enc-str))
1812 ;;; ids-find.el ends here