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))
603 (get-char-attribute pc 'ideographic-structure@apparent/rightmost))
604 (ideographic-structure-equal str structure)))
605 (setq pl (cons pc pl))
610 (defun ideographic-char-count-components (char component)
613 (cond ((eq char component)
615 ((setq structure (get-char-attribute char 'ideographic-structure))
616 (dolist (cell (ideographic-structure-to-components-alist structure))
619 (if (eq (car cell) char)
621 (* (ideographic-char-count-components (car cell) component)
629 (defun ideographic-character-get-structure (character)
630 "Return ideographic-structure of CHARACTER.
631 CHARACTER can be a character or char-spec."
632 (mapcar (lambda (cell)
633 (or (and (listp cell)
637 (cond ((characterp character)
638 (get-char-attribute character 'ideographic-structure)
640 ((setq ret (assq 'ideographic-structure character))
643 ((setq ret (find-char character))
644 (get-char-attribute ret 'ideographic-structure)
648 (defun ideographic-char-match-component (char component)
649 "Return non-nil if character CHAR has COMPONENT in ideographic-structure.
650 COMPONENT can be a character or char-spec."
651 (or (ideographic-structure-character= char component)
652 (let ((str (ideographic-character-get-structure char)))
654 (or (ideographic-char-match-component (nth 1 str) component)
655 (ideographic-char-match-component (nth 2 str) component)
656 (if (memq (car str) '(?\u2FF2 ?\u2FF3))
657 (ideographic-char-match-component (nth 3 str) component)))))))
659 (defun ideographic-structure-char< (a b)
660 (let ((sa (get-char-attribute a 'ideographic-structure))
661 (sb (get-char-attribute b 'ideographic-structure))
665 (setq tsa (char-total-strokes a)
666 tsb (char-total-strokes b))
671 (ideograph-char< a b)))
675 (ideograph-char< a b))))
683 (setq tsa (char-total-strokes a)
684 tsb (char-total-strokes b))
689 (ideograph-char< a b)))
693 (ideograph-char< a b)))
698 (defun ideo-comp-tree-adjoin (tree char)
702 (while (and (not finished)
704 (setq cell (pop rest))
705 (cond ((ideographic-structure-character= char (car cell))
710 ((ideographic-char-match-component char (car cell))
712 (cons (cons (car cell)
713 (ideo-comp-tree-adjoin (cdr cell) char))
717 ((ideographic-char-match-component (car cell) char)
718 (setq included (cons cell included))
721 ;; (setq other (cons cell other))
724 (setq dest (cons cell dest))
730 (cons (cons char included)
734 (cons (list char) tree)
737 (defun ideographic-chars-to-is-a-tree (chars)
739 (dolist (char (sort (copy-list chars) #'ideographic-structure-char<))
740 (setq tree (ideo-comp-tree-adjoin tree char)))
743 (defun ids-find-chars-including-ids (structure)
744 (let (comp-alist comp-spec ret str rest)
746 ((characterp structure)
747 (setq rest (copy-list (get-char-attribute structure 'ideographic-products)))
749 ((setq ret (ideographic-structure-find-chars structure))
754 (copy-list (get-char-attribute pc 'ideographic-products)))))
757 (setq comp-alist (ideographic-structure-to-components-alist structure)
758 comp-spec (list (cons 'ideographic-structure structure)))
760 (sort (mapcar (lambda (cell)
761 (if (setq ret (get-char-attribute
762 (car cell) 'ideographic-products))
763 (cons ret (length ret))
767 (< (cdr a)(cdr b))))))
768 (when (and (every (lambda (cell)
769 (>= (ideographic-char-count-components pc (car cell))
772 (or (ideographic-char-match-component pc comp-spec)
773 (and (setq str (get-char-attribute pc 'ideographic-structure))
774 (ideographic-char-match-component
777 'ideographic-structure
778 (functional-ideographic-structure-to-apparent-structure
783 (ideographic-chars-to-is-a-tree rest)))
785 (defun functional-ideographic-structure-to-apparent-structure (structure)
786 (ideographic-structure-compare-functional-and-apparent
787 structure nil 'conversion-only))
790 (defun ideographic-structure-compact (structure)
791 (let ((rest structure)
795 (setq cell (pop rest))
796 (if (and (consp cell)
797 (setq ret (find-char cell)))
801 (cond ((setq ret (assq 'ideographic-structure cell))
808 (cond ((setq ret (ideographic-structure-find-chars sub))
811 ((setq ret (ideographic-structure-compact sub))
812 (list (cons 'ideographic-structure ret))
815 (list (cons 'ideographic-structure sub))))
818 (setq dest (cons cell dest)))
821 (defun ideographic-structure-compare-functional-and-apparent (structure
824 (let (enc enc-str enc2-str enc3-str new-str new-str-c
825 f-res a-res ret code)
827 ((eq (car structure) ?⿸)
828 (setq enc (nth 1 structure))
830 (cond ((characterp enc)
831 (get-char-attribute enc 'ideographic-structure)
834 (cdr (assq 'ideographic-structure enc))
837 ((eq (car enc-str) ?⿰)
838 (unless conversion-only
839 (setq f-res (ids-find-chars-including-ids enc-str)))
840 (setq new-str (list ?⿱
844 (if (setq ret (ideographic-structure-find-chars new-str))
846 (list (cons 'ideographic-structure new-str))))
848 (list ?⿰ (nth 1 enc-str) new-str-c)
849 (setq a-res (ids-find-chars-including-ids new-str))
854 (list ?⿰ (nth 1 enc-str) new-str-c)
857 ((and (eq (car enc-str) ?⿲)
858 (memq (char-ucs (nth 1 enc-str)) '(#x4EBB #x2E85))
859 (eq (nth 2 enc-str) ?丨))
860 (unless conversion-only
861 (setq f-res (ids-find-chars-including-ids enc-str)))
862 (setq new-str (list ?⿱
866 (if (setq ret (ideographic-structure-find-chars new-str))
868 (list (cons 'ideographic-structure new-str))))
870 (list ?⿰ (decode-char '=big5-cdp #x8B7A) new-str-c)
871 (setq a-res (ids-find-chars-including-ids new-str))
876 (list ?⿰ (decode-char '=big5-cdp #x8B7A) new-str-c)
879 ((eq (car enc-str) ?⿱)
880 (unless conversion-only
881 (setq f-res (ids-find-chars-including-ids enc-str)))
885 ((characterp (nth 2 enc-str))
886 (if (or (memq (encode-char (nth 2 enc-str) '=>ucs@component)
887 '(#x20087 #x5382 #x4E06))
888 (eq (encode-char (nth 2 enc-str) '=>ucs@iwds-1)
890 (eq (encode-char (nth 2 enc-str) '=ucs-itaiji-001)
892 (eq (encode-char (nth 2 enc-str) '=big5-cdp)
894 (eq (encode-char (nth 2 enc-str) '=>big5-cdp)
896 (eq (encode-char (nth 2 enc-str) '=big5-cdp)
898 (eq (or (encode-char (nth 2 enc-str) '=>big5-cdp)
899 (encode-char (nth 2 enc-str) '=big5-cdp-itaiji-001))
901 (eq (car (get-char-attribute (nth 2 enc-str)
902 'ideographic-structure))
906 ((eq (car (cdr (assq 'ideographic-structure (nth 2 enc-str))))
914 (if (setq ret (ideographic-structure-find-chars new-str))
916 (list (cons 'ideographic-structure new-str))))
918 (list ?⿱ (nth 1 enc-str) new-str-c)
919 (setq a-res (ids-find-chars-including-ids new-str))
924 (list ?⿱ (nth 1 enc-str) new-str-c)
925 (if (eq (car new-str) ?⿸)
929 ((eq (car enc-str) ?⿸)
930 (unless conversion-only
931 (setq f-res (ids-find-chars-including-ids enc-str)))
932 (setq new-str (list (cond
933 ((characterp (nth 2 enc-str))
934 (if (memq (char-ucs (nth 2 enc-str))
944 (if (setq ret (ideographic-structure-find-chars new-str))
946 (list (cons 'ideographic-structure new-str))))
948 (list ?⿸ (nth 1 enc-str) new-str-c)
949 (setq a-res (ids-find-chars-including-ids new-str))
954 (list ?⿸ (nth 1 enc-str) new-str-c)
955 (if (eq (car new-str) ?⿰)
960 ((eq (car structure) ?⿹)
961 (setq enc (nth 1 structure))
963 (cond ((characterp enc)
964 (get-char-attribute enc 'ideographic-structure)
967 (cdr (assq 'ideographic-structure enc))
970 ((eq (car enc-str) ?⿰)
971 (unless conversion-only
972 (setq f-res (ids-find-chars-including-ids enc-str)))
973 (setq new-str (list ?⿱
977 (if (setq ret (ideographic-structure-find-chars new-str))
979 (list (cons 'ideographic-structure new-str))))
981 (list ?⿰ new-str-c (nth 2 enc-str))
982 (setq a-res (ids-find-chars-including-ids new-str))
987 (list ?⿰ new-str-c (nth 2 enc-str))
990 ((eq (car enc-str) ?⿱)
991 (unless conversion-only
992 (setq f-res (ids-find-chars-including-ids enc-str)))
993 (setq new-str (list ?⿰
997 (if (setq ret (ideographic-structure-find-chars new-str))
999 (list (cons 'ideographic-structure new-str))))
1001 (list ?⿱ (nth 1 enc-str) new-str-c)
1002 (setq a-res (ids-find-chars-including-ids new-str))
1007 (list ?⿱ (nth 1 enc-str) new-str-c)
1012 ((eq (get-char-attribute (car structure) '=ucs-itaiji-001) #x2FF6)
1013 (setq enc (nth 1 structure))
1015 (cond ((characterp enc)
1016 (get-char-attribute enc 'ideographic-structure)
1019 (cdr (assq 'ideographic-structure enc))
1022 ((eq (car enc-str) ?⿺)
1023 (unless conversion-only
1024 (setq f-res (ids-find-chars-including-ids enc-str)))
1025 (setq new-str (list ?⿱
1029 (if (setq ret (ideographic-structure-find-chars new-str))
1031 (list (cons 'ideographic-structure new-str))))
1033 (list ?⿺ new-str-c (nth 2 enc-str))
1034 (setq a-res (ids-find-chars-including-ids new-str))
1039 (list ?⿺ new-str-c (nth 2 enc-str))
1042 ((eq (car enc-str) ?⿱)
1043 (unless conversion-only
1044 (setq f-res (ids-find-chars-including-ids enc-str)))
1045 (setq new-str (list ?⿰
1049 (if (setq ret (ideographic-structure-find-chars new-str))
1051 (list (cons 'ideographic-structure new-str))))
1053 (list ?⿱ new-str-c (nth 2 enc-str))
1054 (setq a-res (ids-find-chars-including-ids new-str))
1059 (list ?⿱ new-str-c (nth 2 enc-str))
1062 ((eq (car enc-str) ?⿰)
1063 (unless conversion-only
1064 (setq f-res (ids-find-chars-including-ids enc-str)))
1065 (setq new-str (list ?⿱
1069 (if (setq ret (ideographic-structure-find-chars new-str))
1071 (list (cons 'ideographic-structure new-str))))
1073 (list ?⿰ new-str-c (nth 2 enc-str))
1074 (setq a-res (ids-find-chars-including-ids new-str))
1079 (list ?⿰ new-str-c (nth 2 enc-str))
1084 ((eq (car structure) ?⿴)
1085 (setq enc (nth 1 structure))
1087 (cond ((characterp enc)
1088 (get-char-attribute enc 'ideographic-structure)
1091 (cdr (assq 'ideographic-structure enc))
1094 ((eq (car enc-str) ?⿱)
1096 ((and (characterp (nth 2 enc-str))
1097 (or (memq (char-ucs (nth 2 enc-str)) '(#x56D7 #x5F51 #x897F))
1098 (eq (char-feature (nth 2 enc-str) '=>big5-cdp)
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 2 enc-str))
1120 (eq (char-ucs (nth 2 enc-str)) #x51F5))
1121 (unless conversion-only
1122 (setq f-res (ids-find-chars-including-ids enc-str)))
1123 (setq new-str (list ?⿶
1127 (if (setq ret (ideographic-structure-find-chars new-str))
1129 (list (cons 'ideographic-structure new-str))))
1131 (list ?⿱ (nth 1 enc-str) new-str-c)
1132 (setq a-res (ids-find-chars-including-ids new-str))
1137 (list ?⿱ (nth 1 enc-str) new-str-c)
1140 ((and (characterp (nth 1 enc-str))
1141 (eq (char-feature (nth 1 enc-str) '=>ucs@component)
1143 (unless conversion-only
1144 (setq f-res (ids-find-chars-including-ids enc-str)))
1145 (setq new-str (list ?⿵
1149 (if (setq ret (ideographic-structure-find-chars new-str))
1151 (list (cons 'ideographic-structure new-str))))
1153 (list ?⿱ new-str-c (nth 2 enc-str))
1154 (setq a-res (ids-find-chars-including-ids new-str))
1159 (list ?⿱ new-str-c (nth 2 enc-str))
1163 (unless conversion-only
1164 (setq f-res (ids-find-chars-including-ids enc-str)))
1165 (setq new-str (list ?⿱ (nth 2 structure) (nth 2 enc-str)))
1167 (if (setq ret (ideographic-structure-find-chars new-str))
1169 (list (cons 'ideographic-structure new-str))))
1171 (list ?⿱ (nth 1 enc-str) new-str-c)
1172 (setq a-res (ids-find-chars-including-ids new-str))
1177 (list ?⿱ (nth 1 enc-str) new-str-c)
1181 ((eq (car enc-str) ?⿳)
1183 ((and (characterp (nth 2 enc-str))
1184 (eq (char-ucs (nth 2 enc-str)) #x56D7))
1185 (unless conversion-only
1186 (setq f-res (ids-find-chars-including-ids enc-str)))
1187 (setq new-str (list ?⿴ (nth 2 enc-str) (nth 2 structure)))
1189 (if (setq ret (ideographic-structure-find-chars new-str))
1191 (list (cons 'ideographic-structure new-str))))
1192 (setq new-str (list ?⿱ (nth 1 enc-str) new-str-c))
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 (eq (char-ucs (nth 2 enc-str)) #x5196))
1209 (unless conversion-only
1210 (setq f-res (ids-find-chars-including-ids enc-str)))
1211 (setq new-str (list ?⿱ (nth 1 enc-str) (nth 2 enc-str)))
1213 (if (setq ret (ideographic-structure-find-chars new-str))
1215 (list (cons 'ideographic-structure new-str))))
1216 (setq new-str (list ?⿱ new-str-c (nth 2 structure)))
1218 (if (setq ret (ideographic-structure-find-chars new-str))
1220 (list (cons 'ideographic-structure new-str))))
1222 (list ?⿱ new-str-c (nth 3 enc-str))
1223 (setq a-res (ids-find-chars-including-ids new-str))
1228 (list ?⿱ new-str-c (nth 3 enc-str))
1231 ((and (characterp (nth 2 enc-str))
1232 (or (eq (encode-char (nth 2 enc-str) '=>big5-cdp)
1234 (eq (encode-char (nth 2 enc-str) '=>gt-k)
1236 (eq (char-ucs (nth 2 enc-str)) #x2008A)))
1237 (unless conversion-only
1238 (setq f-res (ids-find-chars-including-ids enc-str)))
1239 (setq new-str (list ?⿱ (nth 2 structure) (nth 2 enc-str)))
1241 (if (setq ret (ideographic-structure-find-chars new-str))
1243 (list (cons 'ideographic-structure new-str))))
1244 (setq new-str (list ?⿸ new-str-c (nth 3 enc-str)))
1246 (if (setq ret (ideographic-structure-find-chars new-str))
1248 (list (cons 'ideographic-structure new-str))))
1250 (list ?⿱ (nth 1 enc-str) new-str-c)
1251 (setq a-res (ids-find-chars-including-ids new-str))
1256 (list ?⿱ (nth 1 enc-str) new-str-c)
1260 (unless conversion-only
1261 (setq f-res (ids-find-chars-including-ids enc-str)))
1262 (setq new-str (list ?⿻ (nth 2 enc-str) (nth 2 structure)))
1264 (if (setq ret (ideographic-structure-find-chars new-str))
1266 (list (cons 'ideographic-structure new-str))))
1267 (setq new-str (list ?⿱ (nth 1 enc-str) new-str-c))
1269 (if (setq ret (ideographic-structure-find-chars new-str))
1271 (list (cons 'ideographic-structure new-str))))
1273 (list ?⿱ new-str-c (nth 3 enc-str))
1274 (setq a-res (ids-find-chars-including-ids new-str))
1279 (list ?⿱ new-str-c (nth 3 enc-str))
1283 ((eq (car enc-str) ?⿰)
1285 ((equal (nth 1 enc-str)(nth 2 enc-str))
1286 (unless conversion-only
1287 (setq f-res (ids-find-chars-including-ids enc-str)))
1288 (setq new-str (list ?⿲
1293 (list (cons 'ideographic-structure new-str)))
1296 (setq a-res (ids-find-chars-including-ids new-str))
1305 (unless conversion-only
1306 (setq f-res (ids-find-chars-including-ids enc-str)))
1307 (setq new-str (list ?⿰
1311 (if (setq ret (ideographic-structure-find-chars new-str))
1313 (list (cons 'ideographic-structure new-str))))
1315 (list ?⿰ (nth 1 enc-str) new-str-c)
1316 (setq a-res (ids-find-chars-including-ids new-str))
1321 (list ?⿰ (nth 1 enc-str) new-str-c)
1327 ((eq (car structure) ?⿶)
1328 (setq enc (nth 1 structure))
1330 (cond ((characterp enc)
1331 (get-char-attribute enc 'ideographic-structure)
1334 (cdr (assq 'ideographic-structure enc))
1337 ((eq (car enc-str) ?⿱)
1338 (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
1340 (eq (car enc2-str) ?⿰))
1341 (unless conversion-only
1342 (setq f-res (ids-find-chars-including-ids enc-str)))
1343 (setq new-str (list ?⿲
1348 (if (setq ret (ideographic-structure-find-chars new-str))
1350 (list (cons 'ideographic-structure new-str))))
1352 (list ?⿱ new-str-c (nth 2 enc-str))
1353 (setq a-res (ids-find-chars-including-ids new-str))
1358 (list ?⿱ new-str-c (nth 2 enc-str))
1362 ((eq (car enc-str) ?⿳)
1363 (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
1365 (eq (car enc2-str) ?⿰))
1366 (unless conversion-only
1367 (setq f-res (ids-find-chars-including-ids enc-str)))
1368 (setq new-str (list ?⿲
1373 (if (setq ret (ideographic-structure-find-chars new-str))
1375 (list (cons 'ideographic-structure new-str))))
1377 (list ?⿳ new-str-c (nth 2 enc-str) (nth 3 enc-str))
1378 (setq a-res (ids-find-chars-including-ids new-str))
1383 (list ?⿳ new-str-c (nth 2 enc-str) (nth 3 enc-str))
1387 ((eq (car enc-str) ?⿲)
1388 (unless conversion-only
1389 (setq f-res (ids-find-chars-including-ids enc-str)))
1390 (setq new-str (list ?⿱
1394 (if (setq ret (ideographic-structure-find-chars new-str))
1396 (list (cons 'ideographic-structure new-str))))
1398 (list ?⿲ (nth 1 enc-str) new-str-c (nth 3 enc-str))
1399 (setq a-res (ids-find-chars-including-ids new-str))
1404 (list ?⿲ (nth 1 enc-str) new-str-c (nth 3 enc-str))
1407 ((eq (car enc-str) ?⿴)
1408 (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
1410 (eq (car enc2-str) ?⿰))
1411 (unless conversion-only
1412 (setq f-res (ids-find-chars-including-ids enc-str)))
1413 (setq new-str (list ?⿱
1417 (if (setq ret (ideographic-structure-find-chars new-str))
1419 (list (cons 'ideographic-structure new-str))))
1421 (list ?⿲ (nth 1 enc2-str) new-str-c (nth 2 enc2-str))
1422 (setq a-res (ids-find-chars-including-ids new-str))
1427 (list ?⿲ (nth 1 enc2-str) new-str-c (nth 2 enc2-str))
1432 ((eq (car structure) ?⿵)
1433 (setq enc (nth 1 structure))
1435 (cond ((characterp enc)
1436 (get-char-attribute enc 'ideographic-structure)
1439 (cdr (assq 'ideographic-structure enc))
1442 ((eq (car enc-str) ?⿱)
1444 ((and (characterp (nth 2 enc-str))
1445 (memq (char-ucs (nth 2 enc-str))
1447 (unless conversion-only
1448 (setq f-res (ids-find-chars-including-ids enc-str)))
1449 (setq new-str (list ?⿵
1453 (if (setq ret (ideographic-structure-find-chars new-str))
1455 (list (cons 'ideographic-structure new-str))))
1457 (list ?⿱ (nth 1 enc-str) new-str-c)
1458 (setq a-res (ids-find-chars-including-ids new-str))
1463 (list ?⿱ (nth 1 enc-str) new-str-c)
1466 ((and (setq enc2-str (ideographic-character-get-structure (nth 2 enc-str)))
1468 ((eq (car enc2-str) ?⿰)
1471 ((eq (car enc2-str) ?⿲)
1474 ((and (eq (car enc2-str) ?⿱)
1476 (ideographic-character-get-structure (nth 2 enc2-str)))
1477 (eq (car enc3-str) ?⿰))
1480 (unless conversion-only
1481 (setq f-res (ids-find-chars-including-ids enc-str)))
1483 (cond ((eq code 611)
1498 (list (list 'ideographic-structure
1505 (if (setq ret (ideographic-structure-find-chars new-str))
1507 (list (cons 'ideographic-structure
1508 (ideographic-structure-compact new-str)))))
1510 (cond ((or (eq code 611)
1512 (list ?⿱ (nth 1 enc-str) new-str-c)
1515 (list ?⿳ (nth 1 enc-str)(nth 1 enc2-str) new-str-c)
1517 (setq a-res (ids-find-chars-including-ids new-str))
1522 (cond ((or (eq code 611)
1524 (list ?⿱ (nth 1 enc-str) new-str-c)
1527 (list ?⿳ (nth 1 enc-str)(nth 1 enc2-str) new-str-c)
1532 ((eq (car enc-str) ?⿳)
1533 (setq enc2-str (ideographic-character-get-structure (nth 3 enc-str)))
1535 (eq (car enc2-str) ?⿰))
1536 (unless conversion-only
1537 (setq f-res (ids-find-chars-including-ids enc-str)))
1538 (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) (nth 2 enc-str) new-str-c)
1548 (setq a-res (ids-find-chars-including-ids new-str))
1553 (list ?⿳ (nth 1 enc-str) (nth 2 enc-str) new-str-c)
1557 ((eq (car enc-str) ?⿲)
1558 (unless conversion-only
1559 (setq f-res (ids-find-chars-including-ids enc-str)))
1560 (setq new-str (list ?⿱
1564 (if (setq ret (ideographic-structure-find-chars new-str))
1566 (list (cons 'ideographic-structure new-str))))
1568 (list ?⿲ (nth 1 enc-str) new-str-c (nth 3 enc-str))
1569 (setq a-res (ids-find-chars-including-ids new-str))
1574 (list ?⿲ (nth 1 enc-str) new-str-c (nth 3 enc-str))
1577 ((eq (car enc-str) ?⿴)
1578 (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
1580 (eq (car enc2-str) ?⿰))
1581 (unless conversion-only
1582 (setq f-res (ids-find-chars-including-ids enc-str)))
1583 (setq new-str (list ?⿱
1587 (if (setq ret (ideographic-structure-find-chars new-str))
1589 (list (cons 'ideographic-structure new-str))))
1591 (list ?⿲ (nth 1 enc2-str) new-str-c (nth 2 enc2-str))
1592 (setq a-res (ids-find-chars-including-ids new-str))
1597 (list ?⿲ (nth 1 enc2-str) new-str-c (nth 2 enc2-str))
1600 ((eq (car enc-str) ?⿵)
1601 (unless conversion-only
1602 (setq f-res (ids-find-chars-including-ids enc-str)))
1603 (setq new-str (list ?⿱
1607 (if (setq ret (ideographic-structure-find-chars new-str))
1609 (list (cons 'ideographic-structure new-str))))
1611 (list ?⿵ (nth 1 enc-str) new-str-c)
1612 (setq a-res (ids-find-chars-including-ids new-str))
1617 (list ?⿵ (nth 1 enc-str) new-str-c)
1622 ((eq (car structure) ?⿷)
1623 (setq enc (nth 1 structure))
1625 (cond ((characterp enc)
1626 (get-char-attribute enc 'ideographic-structure)
1629 (cdr (assq 'ideographic-structure enc))
1632 ((eq (car enc-str) ?⿺)
1633 (unless conversion-only
1634 (setq f-res (ids-find-chars-including-ids enc-str)))
1635 (setq new-str (list ?⿱
1639 (if (setq ret (ideographic-structure-find-chars new-str))
1641 (list (cons 'ideographic-structure new-str))))
1643 (list ?⿺ (nth 1 enc-str) new-str-c)
1644 (setq a-res (ids-find-chars-including-ids new-str))
1649 (list ?⿺ (nth 1 enc-str) new-str-c)
1652 ((eq (car enc-str) ?⿸)
1653 (unless conversion-only
1654 (setq f-res (ids-find-chars-including-ids enc-str)))
1656 ((and (characterp (nth 2 enc-str))
1657 (or (memq (char-ucs (nth 2 enc-str))
1658 '(#x4EBA #x5165 #x513F #x51E0))
1659 (memq (or (encode-char (nth 2 enc-str) '=>ucs@iwds-1)
1660 (encode-char (nth 2 enc-str) '=>ucs@component))
1662 (setq new-str (list ?⿺
1666 (if (setq ret (ideographic-structure-find-chars new-str))
1668 (list (cons 'ideographic-structure new-str))))
1670 (list ?⿸ (nth 1 enc-str) new-str-c)
1671 (setq a-res (ids-find-chars-including-ids new-str))
1676 (list ?⿸ (nth 1 enc-str) new-str-c)
1680 (setq new-str (list ?⿱
1684 (if (setq ret (ideographic-structure-find-chars new-str))
1686 (list (cons 'ideographic-structure new-str))))
1688 (list ?⿸ (nth 1 enc-str) new-str-c)
1689 (setq a-res (ids-find-chars-including-ids new-str))
1694 (list ?⿸ (nth 1 enc-str) new-str-c)
1700 ((eq (car structure) ?⿺)
1701 (setq enc (nth 1 structure))
1703 (cond ((characterp enc)
1704 (or (get-char-attribute enc 'ideographic-structure)
1705 (get-char-attribute enc 'ideographic-structure@apparent)
1706 (get-char-attribute enc 'ideographic-structure@apparent/leftmost)
1707 (get-char-attribute enc 'ideographic-structure@apparent/rightmost))
1710 (or (cdr (assq 'ideographic-structure enc))
1711 (cdr (assq 'ideographic-structure@apparent enc))
1712 (cdr (assq 'ideographic-structure@apparent/leftmost enc))
1713 (cdr (assq 'ideographic-structure@apparent/rightmost enc)))
1716 ;; (mapcar (lambda (cell)
1717 ;; (or (and (listp cell)
1718 ;; (find-char cell))
1722 ((eq (car enc-str) ?⿱)
1724 ((and (characterp (nth 1 enc-str))
1725 (or (and (eq (char-ucs (nth 1 enc-str)) #x200CA)
1727 (and (eq (char-feature (nth 1 enc-str) '=>iwds-1) 233)
1728 (characterp (nth 2 structure))
1729 (eq (char-ucs (nth 2 structure)) #x4E36)
1731 (unless conversion-only
1732 (setq f-res (ids-find-chars-including-ids enc-str)))
1733 (setq new-str (list ?⿺
1737 (if (setq ret (ideographic-structure-find-chars new-str))
1739 (list (cons 'ideographic-structure new-str))))
1741 (list ?⿱ new-str-c (nth 2 enc-str))
1742 (setq a-res (ids-find-chars-including-ids new-str))
1747 (list ?⿱ new-str-c (nth 2 enc-str))
1750 ((and (characterp (nth 2 enc-str))
1751 (or (memq (char-ucs (nth 2 enc-str))
1754 #x65E5 #x66F0 #x5FC3
1755 #x2123C #x58EC #x738B #x7389))
1756 (memq (encode-char (nth 2 enc-str) '=>ucs@component)
1758 (eq (encode-char (nth 2 enc-str) '=>ucs@iwds-1)
1760 (eq (encode-char (nth 2 enc-str) '=>big5-cdp)
1762 (unless conversion-only
1763 (setq f-res (ids-find-chars-including-ids enc-str)))
1764 (setq new-str (list ?⿰
1768 (if (setq ret (ideographic-structure-find-chars new-str))
1770 (list (cons 'ideographic-structure new-str))))
1772 (list ?⿱ new-str-c (nth 2 enc-str))
1773 (setq a-res (ids-find-chars-including-ids new-str))
1778 (list ?⿱ new-str-c (nth 2 enc-str))
1783 ((eq (car structure) ?⿻)
1784 (setq enc (nth 1 structure))
1786 (cond ((characterp enc)
1787 (get-char-attribute enc 'ideographic-structure)
1790 (cdr (assq 'ideographic-structure enc))
1793 ((eq (car enc-str) ?⿱)
1794 (unless conversion-only
1795 (setq f-res (ids-find-chars-including-ids enc-str)))
1797 (list ?⿳ (nth 1 enc-str) (nth 2 structure) (nth 2 enc-str))
1817 ;;; ids-find.el ends here