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, 2023
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)
89 (setq products (get-char-attribute c 'ideographic-products))
90 (dolist (comp (delq c (char-ucs-chars c)))
91 (dolist (p_c (get-char-attribute comp 'ideographic-products))
92 (unless (encode-char p_c '=ucs)
93 (if (setq ucs (char-ucs p_c))
94 (setq p_c (decode-char '=ucs ucs))))
95 (setq products (adjoin p_c products))))
96 (put-char-attribute c 'ideographic-products products)
101 (setq products (get-char-attribute c 'ideographic-products))
102 (dolist (comp (delq c (char-ucs-chars c)))
103 (dolist (p_c (get-char-attribute comp 'ideographic-products))
104 (unless (encode-char p_c '=ucs)
105 (if (setq ucs (char-ucs p_c))
106 (setq p_c (decode-char '=ucs ucs))))
107 (setq products (adjoin p_c products))))
108 (put-char-attribute c 'ideographic-products products)
113 (setq products (get-char-attribute c 'ideographic-products))
114 (dolist (comp (delq c (char-ucs-chars c)))
116 comp 'ideographic-products
118 (get-char-attribute comp 'ideographic-products))))
123 (setq products (get-char-attribute c 'ideographic-products))
124 (dolist (comp (delq c (char-ucs-chars c)))
126 comp 'ideographic-products
128 (get-char-attribute comp 'ideographic-products))))
133 (save-char-attribute-table 'ideographic-products)))
136 (mount-char-attribute-table 'ideographic-products)
139 (defun ids-find-all-products (char)
141 (dolist (cell (char-feature char 'ideographic-products))
142 (unless (memq cell dest)
143 (setq dest (cons cell dest)))
144 (setq dest (union dest (ids-find-all-products cell))))
147 (defun of-component-features ()
149 (dolist (feature (char-attribute-list))
150 (when (string-match "^<-.*[@/]component\\(/[^*/]+\\)*$"
151 (symbol-name feature))
152 (push feature dest)))
153 (list* '<-mistakable '->mistakable
156 '<-original '->original
157 '<-ancient '->ancient
160 (defun to-component-features ()
162 (dolist (feature (char-attribute-list))
163 (when (string-match "^->.*[@/]component\\(/[^*/]+\\)*$"
164 (symbol-name feature))
165 (push feature dest)))
169 (defun char-component-variants (char)
170 (let ((dest (list char))
172 (dolist (feature (to-component-features))
173 (if (setq ret (get-char-attribute char feature))
175 (setq dest (union dest (char-component-variants c))))))
177 ;; ((setq ret (some (lambda (feature)
178 ;; (get-char-attribute char feature))
179 ;; (to-component-features)))
181 ;; (setq dest (union dest (char-component-variants c))))
183 ((setq ret (get-char-attribute char '->ucs-unified))
184 (setq dest (cons char ret))
186 (setq dest (union dest
187 (some (lambda (feature)
188 (get-char-attribute c feature))
189 (of-component-features))
192 ((and (setq ret (get-char-attribute char '=>ucs))
193 (setq uchr (decode-char '=ucs ret)))
194 (setq dest (cons uchr (char-variants uchr)))
196 (setq dest (union dest
197 (some (lambda (feature)
198 (get-char-attribute c feature))
199 (of-component-features))
205 (unless (memq c dest)
206 (setq dest (cons c dest)))
209 (some (lambda (feature)
210 (char-feature c feature))
211 (of-component-features))
219 (defun ideographic-products-find (&rest components)
220 (if (stringp (car components))
221 (setq components (string-to-char-list (car components))))
223 (dolist (variant (char-component-variants (car components)))
226 (get-char-attribute variant 'ideographic-products))))
229 (setq components (cdr components)))
231 (dolist (variant (char-component-variants (car components)))
234 (get-char-attribute variant 'ideographic-products))))
235 (setq dest (intersection dest products)))
238 (defun ideograph-find-products-with-variants (components &optional ignored-chars)
239 (if (stringp components)
240 (setq components (string-to-char-list components)))
242 (dolist (variant (char-component-variants (car components)))
246 (get-char-attribute variant 'ideographic-products)
250 (setq components (cdr components)))
252 (dolist (variant (char-component-variants (car components)))
256 (get-char-attribute variant 'ideographic-products)
258 (setq dest (intersection dest products)))
261 (defun ideograph-find-products (components &optional ignored-chars)
262 (if (stringp components)
263 (setq components (string-to-char-list components)))
265 ;; (dolist (variant (char-component-variants (car components)))
268 ;; (get-char-attribute variant 'ideographic-products))))
269 ;; (setq dest products)
270 (setq dest (get-char-attribute (car components) 'ideographic-products))
272 (setq components (cdr components)))
273 ;; (setq products nil)
274 ;; (dolist (variant (char-component-variants (car components)))
277 ;; (get-char-attribute variant 'ideographic-products))))
278 (setq products (get-char-attribute (car components) 'ideographic-products))
279 (setq dest (intersection dest products)))
283 (defun ideographic-structure-char= (c1 c2)
286 (let ((m1 (char-ucs c1))
290 (memq c1 (char-component-variants c2)))))))
292 (defun ideographic-structure-member-compare-components (component s-component)
294 (cond ((char-ref= component s-component #'ideographic-structure-char=))
296 (if (setq ret (assq 'ideographic-structure s-component))
297 (ideographic-structure-member component (cdr ret))))
298 ((setq ret (get-char-attribute s-component 'ideographic-structure))
299 (ideographic-structure-member component ret)))))
302 (defun ideographic-structure-member (component structure)
303 "Return non-nil if COMPONENT is included in STRUCTURE."
304 (or (memq component structure)
306 (setq structure (cdr structure))
307 (ideographic-structure-member-compare-components
308 component (car structure)))
310 (setq structure (cdr structure))
311 (ideographic-structure-member-compare-components
312 component (car structure)))
314 (setq structure (cdr structure))
316 (ideographic-structure-member-compare-components
317 component (car structure))))))
321 (defun ideographic-structure-repertoire-p (structure components)
322 "Return non-nil if STRUCTURE can be constructed by a subset of COMPONENTS."
324 (let (ret s-component)
326 (while (setq structure (cdr structure))
327 (setq s-component (car structure))
328 (unless (characterp s-component)
329 (if (setq ret (find-char s-component))
330 (setq s-component ret)))
333 (if (setq ret (assq 'ideographic-structure s-component))
334 (ideographic-structure-repertoire-p
335 (cdr ret) components)))
336 ((member* s-component components
337 :test #'ideographic-structure-char=))
339 (get-char-attribute s-component
340 'ideographic-structure))
341 (ideographic-structure-repertoire-p ret components)))
346 (defvar ids-find-result-buffer "*ids-chars*")
348 (defun ids-find-format-line (c v)
349 (format "%c\t%s\t%s\n"
351 (or (let ((ucs (or (char-ucs c)
352 (encode-char c 'ucs))))
354 (cond ((<= ucs #xFFFF)
355 (format " U+%04X" ucs))
357 (format "U-%08X" ucs)))))
359 (or (ideographic-structure-to-ids v)
362 (defun ids-insert-chars-including-components* (components
363 &optional level ignored-chars)
367 (dolist (c (sort (copy-list (ideograph-find-products components
370 (if (setq as (char-total-strokes a))
371 (if (setq bs (char-total-strokes b))
373 (ideograph-char< a b)
376 (ideograph-char< a b)))))
377 (unless (memq c ignored-chars)
378 (setq is (char-feature c 'ideographic-structure))
383 (insert (ids-find-format-line c is))
385 (ids-insert-chars-including-components*
386 (char-to-string c) (1+ level)
387 (cons c ignored-chars))))
392 (defun ids-insert-chars-including-components (components
393 &optional level ignored-chars)
398 (ids-insert-chars-including-components* components
399 level ignored-chars)))
401 (dolist (c ignored-chars)
402 (dolist (vc (char-component-variants c))
403 (unless (memq vc ignored-chars)
404 (when (setq is (get-char-attribute vc 'ideographic-structure))
409 (insert (ids-find-format-line vc is))
411 (ids-insert-chars-including-components*
412 (char-to-string vc) (1+ level)
413 (cons vc ignored-chars)))))))
414 (dolist (c (sort (copy-list (ideograph-find-products-with-variants
415 components ignored-chars))
417 (if (setq as (char-total-strokes a))
418 (if (setq bs (char-total-strokes b))
420 (ideograph-char< a b)
423 (ideograph-char< a b)))))
424 (unless (memq c ignored-chars)
425 (setq is (get-char-attribute c 'ideographic-structure))
430 (insert (ids-find-format-line c is))
432 (ids-insert-chars-including-components*
433 (char-to-string c) (1+ level)
434 (cons c ignored-chars))))
440 (defun ids-find-chars-including-components (components)
441 "Search Ideographs whose structures have COMPONENTS."
442 (interactive "sComponents : ")
443 (with-current-buffer (get-buffer-create ids-find-result-buffer)
444 (setq buffer-read-only nil)
446 (ids-insert-chars-including-components components 0 nil)
447 ;; (let ((ignored-chars
449 ;; (ids-insert-chars-including-components components 0 nil
450 ;; #'ideograph-find-products)))
452 ;; (setq rest ignored-chars)
453 ;; ;; (dolist (c rest)
454 ;; ;; (setq ignored-chars
455 ;; ;; (union ignored-chars
456 ;; ;; (ids-insert-chars-including-components
457 ;; ;; (list c) 0 ignored-chars
458 ;; ;; #'ideograph-find-products-with-variants))))
459 ;; (ids-insert-chars-including-components components 0 ignored-chars
460 ;; #'ideograph-find-products-with-variants))
461 (goto-char (point-min)))
462 (view-buffer ids-find-result-buffer))
465 (define-obsolete-function-alias 'ideographic-structure-search-chars
466 'ids-find-chars-including-components)
469 (defun ids-find-chars-covered-by-components (components)
470 "Search Ideographs which structures are consisted by subsets of COMPONENTS."
471 (interactive "sComponents: ")
472 (if (stringp components)
473 (setq components (string-to-char-list components)))
474 (with-current-buffer (get-buffer-create ids-find-result-buffer)
475 (setq buffer-read-only nil)
479 (when (ideographic-structure-repertoire-p v components)
480 (insert (ids-find-format-line c v))))
481 'ideographic-structure)
482 (goto-char (point-min)))
483 (view-buffer ids-find-result-buffer))
486 (defun ideographic-structure-merge-components-alist (ca1 ca2)
487 (let ((dest-alist ca1)
490 (if (setq ret (assq (car cell) dest-alist))
491 (setcdr ret (+ (cdr ret)(cdr cell)))
492 (setq dest-alist (cons cell dest-alist))))
495 (defun ideographic-structure-to-components-alist (structure)
496 (apply #'ideographic-structure-to-components-alist* structure))
498 (defun ideographic-structure-to-components-alist* (operator component1 component2
501 (let (dest-alist ret)
503 (cond ((characterp component1)
504 (unless (encode-char component1 'ascii)
505 (list (cons component1 1)))
507 ((setq ret (assq 'ideographic-structure component1))
508 (ideographic-structure-to-components-alist (cdr ret))
510 ((setq ret (find-char component1))
514 (ideographic-structure-merge-components-alist
516 (cond ((characterp component2)
517 (unless (encode-char component2 'ascii)
518 (list (cons component2 1)))
520 ((setq ret (assq 'ideographic-structure component2))
521 (ideographic-structure-to-components-alist (cdr ret))
523 ((setq ret (find-char component2))
526 (if (memq operator '(?\u2FF2 ?\u2FF3))
527 (ideographic-structure-merge-components-alist
529 (cond ((characterp component3)
530 (unless (encode-char component3 'ascii)
531 (list (cons component3 1)))
533 ((setq ret (assq 'ideographic-structure component3))
534 (ideographic-structure-to-components-alist (cdr ret))
536 ((setq ret (find-char component3))
541 (defun ids-find-merge-variables (ve1 ve2)
547 (let ((dest-alist ve1)
551 (setq cell (car rest))
552 (if (setq ret (assq (car cell) ve1))
553 (eq (cdr ret)(cdr cell))
554 (setq dest-alist (cons cell dest-alist))))
555 (setq rest (cdr rest)))
561 (defun ideographic-structure-equal (structure1 structure2)
562 (let (dest-alist ret)
563 (and (setq dest-alist (ideographic-structure-character=
564 (car structure1)(car structure2)))
565 (setq ret (ideographic-structure-character=
566 (nth 1 structure1)(nth 1 structure2)))
567 (setq dest-alist (ids-find-merge-variables dest-alist ret))
568 (setq ret (ideographic-structure-character=
569 (nth 2 structure1)(nth 2 structure2)))
570 (setq dest-alist (ids-find-merge-variables dest-alist ret))
571 (if (memq (car structure1) '(?\u2FF2 ?\u2FF3))
572 (and (setq ret (ideographic-structure-character=
573 (nth 3 structure1)(nth 3 structure2)))
574 (setq dest-alist (ids-find-merge-variables dest-alist ret)))
578 (defun ideographic-structure-character= (c1 c2)
580 (cond ((characterp c1)
581 (cond ((encode-char c1 'ascii)
585 (if (encode-char c2 'ascii)
589 ((setq ret2 (find-char c2))
592 ((setq ret2 (assq 'ideographic-structure c2))
593 (and (setq ret (get-char-attribute c1 'ideographic-structure))
594 (ideographic-structure-equal ret (cdr ret2)))
597 ((setq ret (assq 'ideographic-structure c1))
598 (cond ((characterp c2)
599 (if (encode-char c2 'ascii)
601 (and (setq ret2 (get-char-attribute c2 'ideographic-structure))
602 (ideographic-structure-equal (cdr ret) ret2)))
604 ((setq ret2 (find-char c2))
605 (and (setq ret2 (get-char-attribute ret2 'ideographic-structure))
606 (ideographic-structure-equal (cdr ret) ret2))
608 ((setq ret2 (assq 'ideographic-structure c2))
609 (ideographic-structure-equal (cdr ret)(cdr ret2))
612 ((setq ret (find-char c1))
613 (cond ((characterp c2)
614 (if (encode-char c2 'ascii)
618 ((setq ret2 (find-char c2))
621 ((setq ret2 (assq 'ideographic-structure c2))
622 (and (setq ret (get-char-attribute ret 'ideographic-structure))
623 (ideographic-structure-equal ret (cdr ret2))
627 (defun ideographic-structure-find-chars (structure)
628 (let ((comp-alist (ideographic-structure-to-components-alist structure))
631 (sort (mapcar (lambda (cell)
632 (if (setq ret (get-char-attribute
633 (car cell) 'ideographic-products))
634 (cons ret (length ret))
638 (< (cdr a)(cdr b))))))
639 (when (or (and (setq str
640 (get-char-attribute pc 'ideographic-structure))
641 (ideographic-structure-equal str structure))
643 (get-char-attribute pc 'ideographic-structure@apparent))
644 (ideographic-structure-equal str structure))
646 (get-char-attribute pc 'ideographic-structure@apparent/leftmost))
647 (ideographic-structure-equal str structure))
649 (get-char-attribute pc 'ideographic-structure@apparent/rightmost))
650 (ideographic-structure-equal str structure)))
651 (setq pl (cons pc pl))
656 (defun ideographic-char-count-components (char component)
659 (cond ((eq char component)
661 ((setq structure (get-char-attribute char 'ideographic-structure))
662 (dolist (cell (ideographic-structure-to-components-alist structure))
665 (if (eq (car cell) char)
667 (* (ideographic-char-count-components (car cell) component)
675 (defun ideographic-character-get-structure (character)
676 "Return ideographic-structure of CHARACTER.
677 CHARACTER can be a character or char-spec."
678 (mapcar (lambda (cell)
679 (or (and (listp cell)
683 (cond ((characterp character)
684 (get-char-attribute character 'ideographic-structure)
686 ((setq ret (assq 'ideographic-structure character))
689 ((setq ret (find-char character))
690 (get-char-attribute ret 'ideographic-structure)
694 (defun ideographic-char-match-component (char component)
695 "Return non-nil if character CHAR has COMPONENT in ideographic-structure.
696 COMPONENT can be a character or char-spec."
697 (or (ideographic-structure-character= char component)
698 (let ((str (ideographic-character-get-structure char)))
700 (or (ideographic-char-match-component (nth 1 str) component)
701 (ideographic-char-match-component (nth 2 str) component)
702 (if (memq (car str) '(?\u2FF2 ?\u2FF3))
703 (ideographic-char-match-component (nth 3 str) component)))))))
705 (defun ideographic-structure-char< (a b)
706 (let ((sa (get-char-attribute a 'ideographic-structure))
707 (sb (get-char-attribute b 'ideographic-structure))
711 (setq tsa (char-total-strokes a)
712 tsb (char-total-strokes b))
717 (ideograph-char< a b)))
721 (ideograph-char< a b))))
729 (setq tsa (char-total-strokes a)
730 tsb (char-total-strokes b))
735 (ideograph-char< a b)))
739 (ideograph-char< a b)))
744 (defun ideo-comp-tree-adjoin (tree char)
748 (while (and (not finished)
750 (setq cell (pop rest))
751 (cond ((ideographic-structure-character= char (car cell))
756 ((ideographic-char-match-component char (car cell))
758 (cons (cons (car cell)
759 (ideo-comp-tree-adjoin (cdr cell) char))
763 ((ideographic-char-match-component (car cell) char)
764 (setq included (cons cell included))
767 ;; (setq other (cons cell other))
770 (setq dest (cons cell dest))
776 (cons (cons char included)
780 (cons (list char) tree)
783 (defun ideographic-chars-to-is-a-tree (chars)
785 (dolist (char (sort (copy-list chars) #'ideographic-structure-char<))
786 (setq tree (ideo-comp-tree-adjoin tree char)))
789 (defun ids-find-chars-including-ids (structure)
790 (let (comp-alist comp-spec ret str rest)
792 ((characterp structure)
793 (setq rest (copy-list (get-char-attribute structure 'ideographic-products)))
795 ((setq ret (ideographic-structure-find-chars structure))
800 (copy-list (get-char-attribute pc 'ideographic-products)))))
803 (setq comp-alist (ideographic-structure-to-components-alist structure)
804 comp-spec (list (cons 'ideographic-structure structure)))
806 (sort (mapcar (lambda (cell)
807 (if (setq ret (get-char-attribute
808 (car cell) 'ideographic-products))
809 (cons ret (length ret))
813 (< (cdr a)(cdr b))))))
814 (when (and (every (lambda (cell)
815 (>= (ideographic-char-count-components pc (car cell))
818 (or (ideographic-char-match-component pc comp-spec)
819 (and (setq str (get-char-attribute pc 'ideographic-structure))
820 (ideographic-char-match-component
823 'ideographic-structure
824 (functional-ideographic-structure-to-apparent-structure
829 (ideographic-chars-to-is-a-tree rest)))
831 (defun functional-ideographic-structure-to-apparent-structure (structure)
832 (ideographic-structure-compare-functional-and-apparent
833 structure nil 'conversion-only))
836 (defun ideographic-structure-compact (structure)
837 (let ((rest structure)
841 (setq cell (pop rest))
842 (if (and (consp cell)
843 (setq ret (find-char cell)))
847 (cond ((setq ret (assq 'ideographic-structure cell))
854 (cond ((setq ret (ideographic-structure-find-chars sub))
857 ((setq ret (ideographic-structure-compact sub))
858 (list (cons 'ideographic-structure ret))
861 (list (cons 'ideographic-structure sub))))
864 (setq dest (cons cell dest)))
867 (defun ideographic-structure-compare-functional-and-apparent (structure
870 (let (enc enc-str enc2-str enc3-str new-str new-str-c
871 f-res a-res ret code)
873 ((eq (car structure) ?⿸)
874 (setq enc (nth 1 structure))
876 (cond ((characterp enc)
877 (get-char-attribute enc 'ideographic-structure)
880 (cdr (assq 'ideographic-structure enc))
883 ((eq (car enc-str) ?⿰)
884 (unless conversion-only
885 (setq f-res (ids-find-chars-including-ids enc-str)))
886 (setq new-str (list ?⿱
890 (if (setq ret (ideographic-structure-find-chars new-str))
892 (list (cons 'ideographic-structure new-str))))
894 (list ?⿰ (nth 1 enc-str) new-str-c)
895 (setq a-res (ids-find-chars-including-ids new-str))
900 (list ?⿰ (nth 1 enc-str) new-str-c)
903 ((and (eq (car enc-str) ?⿲)
904 (memq (char-ucs (nth 1 enc-str)) '(#x4EBB #x2E85))
905 (eq (nth 2 enc-str) ?丨))
906 (unless conversion-only
907 (setq f-res (ids-find-chars-including-ids enc-str)))
908 (setq new-str (list ?⿱
912 (if (setq ret (ideographic-structure-find-chars new-str))
914 (list (cons 'ideographic-structure new-str))))
916 (list ?⿰ (decode-char '=big5-cdp #x8B7A) new-str-c)
917 (setq a-res (ids-find-chars-including-ids new-str))
922 (list ?⿰ (decode-char '=big5-cdp #x8B7A) new-str-c)
925 ((eq (car enc-str) ?⿱)
926 (unless conversion-only
927 (setq f-res (ids-find-chars-including-ids enc-str)))
931 ((characterp (nth 2 enc-str))
932 (if (or (memq (encode-char (nth 2 enc-str) '=>ucs@component)
933 '(#x20087 #x5382 #x4E06))
934 (eq (encode-char (nth 2 enc-str) '=>ucs@iwds-1)
936 (eq (encode-char (nth 2 enc-str) '=ucs-itaiji-001)
938 (eq (encode-char (nth 2 enc-str) '=big5-cdp)
940 (eq (encode-char (nth 2 enc-str) '=>big5-cdp)
942 (eq (encode-char (nth 2 enc-str) '=big5-cdp)
944 (eq (or (encode-char (nth 2 enc-str) '=>big5-cdp)
945 (encode-char (nth 2 enc-str) '=big5-cdp-itaiji-001))
947 (eq (car (get-char-attribute (nth 2 enc-str)
948 'ideographic-structure))
952 ((eq (car (cdr (assq 'ideographic-structure (nth 2 enc-str))))
960 (if (setq ret (ideographic-structure-find-chars new-str))
962 (list (cons 'ideographic-structure new-str))))
964 (list ?⿱ (nth 1 enc-str) new-str-c)
965 (setq a-res (ids-find-chars-including-ids new-str))
970 (list ?⿱ (nth 1 enc-str) new-str-c)
971 (if (eq (car new-str) ?⿸)
975 ((eq (car enc-str) ?⿸)
976 (unless conversion-only
977 (setq f-res (ids-find-chars-including-ids enc-str)))
978 (setq new-str (list (cond
979 ((characterp (nth 2 enc-str))
980 (if (memq (char-ucs (nth 2 enc-str))
990 (if (setq ret (ideographic-structure-find-chars new-str))
992 (list (cons 'ideographic-structure new-str))))
994 (list ?⿸ (nth 1 enc-str) new-str-c)
995 (setq a-res (ids-find-chars-including-ids new-str))
1000 (list ?⿸ (nth 1 enc-str) new-str-c)
1001 (if (eq (car new-str) ?⿰)
1006 ((eq (car structure) ?⿹)
1007 (setq enc (nth 1 structure))
1009 (cond ((characterp enc)
1010 (get-char-attribute enc 'ideographic-structure)
1013 (cdr (assq 'ideographic-structure enc))
1016 ((eq (car enc-str) ?⿰)
1017 (unless conversion-only
1018 (setq f-res (ids-find-chars-including-ids enc-str)))
1019 (setq new-str (list ?⿱
1023 (if (setq ret (ideographic-structure-find-chars new-str))
1025 (list (cons 'ideographic-structure new-str))))
1027 (list ?⿰ new-str-c (nth 2 enc-str))
1028 (setq a-res (ids-find-chars-including-ids new-str))
1033 (list ?⿰ new-str-c (nth 2 enc-str))
1036 ((eq (car enc-str) ?⿱)
1037 (unless conversion-only
1038 (setq f-res (ids-find-chars-including-ids enc-str)))
1039 (setq new-str (list ?⿰
1043 (if (setq ret (ideographic-structure-find-chars new-str))
1045 (list (cons 'ideographic-structure new-str))))
1047 (list ?⿱ (nth 1 enc-str) new-str-c)
1048 (setq a-res (ids-find-chars-including-ids new-str))
1053 (list ?⿱ (nth 1 enc-str) new-str-c)
1058 ((eq (get-char-attribute (car structure) '=ucs-itaiji-001) #x2FF6)
1059 (setq enc (nth 1 structure))
1061 (cond ((characterp enc)
1062 (get-char-attribute enc 'ideographic-structure)
1065 (cdr (assq 'ideographic-structure enc))
1068 ((eq (car enc-str) ?⿺)
1069 (unless conversion-only
1070 (setq f-res (ids-find-chars-including-ids enc-str)))
1071 (setq new-str (list ?⿱
1075 (if (setq ret (ideographic-structure-find-chars new-str))
1077 (list (cons 'ideographic-structure new-str))))
1079 (list ?⿺ new-str-c (nth 2 enc-str))
1080 (setq a-res (ids-find-chars-including-ids new-str))
1085 (list ?⿺ new-str-c (nth 2 enc-str))
1088 ((eq (car enc-str) ?⿱)
1089 (unless conversion-only
1090 (setq f-res (ids-find-chars-including-ids enc-str)))
1091 (setq new-str (list ?⿰
1095 (if (setq ret (ideographic-structure-find-chars new-str))
1097 (list (cons 'ideographic-structure new-str))))
1099 (list ?⿱ new-str-c (nth 2 enc-str))
1100 (setq a-res (ids-find-chars-including-ids new-str))
1105 (list ?⿱ new-str-c (nth 2 enc-str))
1108 ((eq (car enc-str) ?⿰)
1109 (unless conversion-only
1110 (setq f-res (ids-find-chars-including-ids enc-str)))
1111 (setq new-str (list ?⿱
1115 (if (setq ret (ideographic-structure-find-chars new-str))
1117 (list (cons 'ideographic-structure new-str))))
1119 (list ?⿰ new-str-c (nth 2 enc-str))
1120 (setq a-res (ids-find-chars-including-ids new-str))
1125 (list ?⿰ new-str-c (nth 2 enc-str))
1130 ((eq (car structure) ?⿴)
1131 (setq enc (nth 1 structure))
1133 (cond ((characterp enc)
1134 (get-char-attribute enc 'ideographic-structure)
1137 (cdr (assq 'ideographic-structure enc))
1140 ((eq (car enc-str) ?⿱)
1142 ((and (characterp (nth 2 enc-str))
1143 (or (memq (char-ucs (nth 2 enc-str)) '(#x56D7 #x5F51 #x897F))
1144 (eq (char-feature (nth 2 enc-str) '=>big5-cdp)
1146 (unless conversion-only
1147 (setq f-res (ids-find-chars-including-ids enc-str)))
1148 (setq new-str (list ?⿴
1152 (if (setq ret (ideographic-structure-find-chars new-str))
1154 (list (cons 'ideographic-structure new-str))))
1156 (list ?⿱ (nth 1 enc-str) new-str-c)
1157 (setq a-res (ids-find-chars-including-ids new-str))
1162 (list ?⿱ (nth 1 enc-str) new-str-c)
1165 ((and (characterp (nth 2 enc-str))
1166 (eq (char-ucs (nth 2 enc-str)) #x51F5))
1167 (unless conversion-only
1168 (setq f-res (ids-find-chars-including-ids enc-str)))
1169 (setq new-str (list ?⿶
1173 (if (setq ret (ideographic-structure-find-chars new-str))
1175 (list (cons 'ideographic-structure new-str))))
1177 (list ?⿱ (nth 1 enc-str) new-str-c)
1178 (setq a-res (ids-find-chars-including-ids new-str))
1183 (list ?⿱ (nth 1 enc-str) new-str-c)
1186 ((and (characterp (nth 1 enc-str))
1187 (eq (char-feature (nth 1 enc-str) '=>ucs@component)
1189 (unless conversion-only
1190 (setq f-res (ids-find-chars-including-ids enc-str)))
1191 (setq new-str (list ?⿵
1195 (if (setq ret (ideographic-structure-find-chars new-str))
1197 (list (cons 'ideographic-structure new-str))))
1199 (list ?⿱ new-str-c (nth 2 enc-str))
1200 (setq a-res (ids-find-chars-including-ids new-str))
1205 (list ?⿱ new-str-c (nth 2 enc-str))
1209 (unless conversion-only
1210 (setq f-res (ids-find-chars-including-ids enc-str)))
1211 (setq new-str (list ?⿱ (nth 2 structure) (nth 2 enc-str)))
1213 (if (setq ret (ideographic-structure-find-chars new-str))
1215 (list (cons 'ideographic-structure new-str))))
1217 (list ?⿱ (nth 1 enc-str) new-str-c)
1218 (setq a-res (ids-find-chars-including-ids new-str))
1223 (list ?⿱ (nth 1 enc-str) new-str-c)
1227 ((eq (car enc-str) ?⿳)
1229 ((and (characterp (nth 2 enc-str))
1230 (eq (char-ucs (nth 2 enc-str)) #x56D7))
1231 (unless conversion-only
1232 (setq f-res (ids-find-chars-including-ids enc-str)))
1233 (setq new-str (list ?⿴ (nth 2 enc-str) (nth 2 structure)))
1235 (if (setq ret (ideographic-structure-find-chars new-str))
1237 (list (cons 'ideographic-structure new-str))))
1238 (setq new-str (list ?⿱ (nth 1 enc-str) new-str-c))
1240 (if (setq ret (ideographic-structure-find-chars new-str))
1242 (list (cons 'ideographic-structure new-str))))
1244 (list ?⿱ new-str-c (nth 3 enc-str))
1245 (setq a-res (ids-find-chars-including-ids new-str))
1250 (list ?⿱ new-str-c (nth 3 enc-str))
1253 ((and (characterp (nth 2 enc-str))
1254 (eq (char-ucs (nth 2 enc-str)) #x5196))
1255 (unless conversion-only
1256 (setq f-res (ids-find-chars-including-ids enc-str)))
1257 (setq new-str (list ?⿱ (nth 1 enc-str) (nth 2 enc-str)))
1259 (if (setq ret (ideographic-structure-find-chars new-str))
1261 (list (cons 'ideographic-structure new-str))))
1262 (setq new-str (list ?⿱ new-str-c (nth 2 structure)))
1264 (if (setq ret (ideographic-structure-find-chars new-str))
1266 (list (cons 'ideographic-structure new-str))))
1268 (list ?⿱ new-str-c (nth 3 enc-str))
1269 (setq a-res (ids-find-chars-including-ids new-str))
1274 (list ?⿱ new-str-c (nth 3 enc-str))
1277 ((and (characterp (nth 2 enc-str))
1278 (or (eq (encode-char (nth 2 enc-str) '=>big5-cdp)
1280 (eq (encode-char (nth 2 enc-str) '=>gt-k)
1282 (eq (char-ucs (nth 2 enc-str)) #x2008A)))
1283 (unless conversion-only
1284 (setq f-res (ids-find-chars-including-ids enc-str)))
1285 (setq new-str (list ?⿱ (nth 2 structure) (nth 2 enc-str)))
1287 (if (setq ret (ideographic-structure-find-chars new-str))
1289 (list (cons 'ideographic-structure new-str))))
1290 (setq new-str (list ?⿸ new-str-c (nth 3 enc-str)))
1292 (if (setq ret (ideographic-structure-find-chars new-str))
1294 (list (cons 'ideographic-structure new-str))))
1296 (list ?⿱ (nth 1 enc-str) new-str-c)
1297 (setq a-res (ids-find-chars-including-ids new-str))
1302 (list ?⿱ (nth 1 enc-str) new-str-c)
1306 (unless conversion-only
1307 (setq f-res (ids-find-chars-including-ids enc-str)))
1308 (setq new-str (list ?⿻ (nth 2 enc-str) (nth 2 structure)))
1310 (if (setq ret (ideographic-structure-find-chars new-str))
1312 (list (cons 'ideographic-structure new-str))))
1313 (setq new-str (list ?⿱ (nth 1 enc-str) new-str-c))
1315 (if (setq ret (ideographic-structure-find-chars new-str))
1317 (list (cons 'ideographic-structure new-str))))
1319 (list ?⿱ new-str-c (nth 3 enc-str))
1320 (setq a-res (ids-find-chars-including-ids new-str))
1325 (list ?⿱ new-str-c (nth 3 enc-str))
1329 ((eq (car enc-str) ?⿰)
1331 ((equal (nth 1 enc-str)(nth 2 enc-str))
1332 (unless conversion-only
1333 (setq f-res (ids-find-chars-including-ids enc-str)))
1334 (setq new-str (list ?⿲
1339 (list (cons 'ideographic-structure new-str)))
1342 (setq a-res (ids-find-chars-including-ids new-str))
1351 (unless conversion-only
1352 (setq f-res (ids-find-chars-including-ids enc-str)))
1353 (setq new-str (list ?⿰
1357 (if (setq ret (ideographic-structure-find-chars new-str))
1359 (list (cons 'ideographic-structure new-str))))
1361 (list ?⿰ (nth 1 enc-str) new-str-c)
1362 (setq a-res (ids-find-chars-including-ids new-str))
1367 (list ?⿰ (nth 1 enc-str) new-str-c)
1373 ((eq (car structure) ?⿶)
1374 (setq enc (nth 1 structure))
1376 (cond ((characterp enc)
1377 (get-char-attribute enc 'ideographic-structure)
1380 (cdr (assq 'ideographic-structure enc))
1383 ((eq (car enc-str) ?⿱)
1384 (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
1386 (eq (car enc2-str) ?⿰))
1387 (unless conversion-only
1388 (setq f-res (ids-find-chars-including-ids enc-str)))
1389 (setq new-str (list ?⿲
1394 (if (setq ret (ideographic-structure-find-chars new-str))
1396 (list (cons 'ideographic-structure new-str))))
1398 (list ?⿱ new-str-c (nth 2 enc-str))
1399 (setq a-res (ids-find-chars-including-ids new-str))
1404 (list ?⿱ new-str-c (nth 2 enc-str))
1408 ((eq (car enc-str) ?⿳)
1409 (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
1411 (eq (car enc2-str) ?⿰))
1412 (unless conversion-only
1413 (setq f-res (ids-find-chars-including-ids enc-str)))
1414 (setq new-str (list ?⿲
1419 (if (setq ret (ideographic-structure-find-chars new-str))
1421 (list (cons 'ideographic-structure new-str))))
1423 (list ?⿳ new-str-c (nth 2 enc-str) (nth 3 enc-str))
1424 (setq a-res (ids-find-chars-including-ids new-str))
1429 (list ?⿳ new-str-c (nth 2 enc-str) (nth 3 enc-str))
1433 ((eq (car enc-str) ?⿲)
1434 (unless conversion-only
1435 (setq f-res (ids-find-chars-including-ids enc-str)))
1436 (setq new-str (list ?⿱
1440 (if (setq ret (ideographic-structure-find-chars new-str))
1442 (list (cons 'ideographic-structure new-str))))
1444 (list ?⿲ (nth 1 enc-str) new-str-c (nth 3 enc-str))
1445 (setq a-res (ids-find-chars-including-ids new-str))
1450 (list ?⿲ (nth 1 enc-str) new-str-c (nth 3 enc-str))
1453 ((eq (car enc-str) ?⿴)
1454 (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
1456 (eq (car enc2-str) ?⿰))
1457 (unless conversion-only
1458 (setq f-res (ids-find-chars-including-ids enc-str)))
1459 (setq new-str (list ?⿱
1463 (if (setq ret (ideographic-structure-find-chars new-str))
1465 (list (cons 'ideographic-structure new-str))))
1467 (list ?⿲ (nth 1 enc2-str) new-str-c (nth 2 enc2-str))
1468 (setq a-res (ids-find-chars-including-ids new-str))
1473 (list ?⿲ (nth 1 enc2-str) new-str-c (nth 2 enc2-str))
1478 ((eq (car structure) ?⿵)
1479 (setq enc (nth 1 structure))
1481 (cond ((characterp enc)
1482 (get-char-attribute enc 'ideographic-structure)
1485 (cdr (assq 'ideographic-structure enc))
1488 ((eq (car enc-str) ?⿱)
1490 ((and (characterp (nth 2 enc-str))
1491 (memq (char-ucs (nth 2 enc-str))
1493 (unless conversion-only
1494 (setq f-res (ids-find-chars-including-ids enc-str)))
1495 (setq new-str (list ?⿵
1499 (if (setq ret (ideographic-structure-find-chars new-str))
1501 (list (cons 'ideographic-structure new-str))))
1503 (list ?⿱ (nth 1 enc-str) new-str-c)
1504 (setq a-res (ids-find-chars-including-ids new-str))
1509 (list ?⿱ (nth 1 enc-str) new-str-c)
1512 ((and (setq enc2-str (ideographic-character-get-structure (nth 2 enc-str)))
1514 ((eq (car enc2-str) ?⿰)
1517 ((eq (car enc2-str) ?⿲)
1520 ((and (eq (car enc2-str) ?⿱)
1522 (ideographic-character-get-structure (nth 2 enc2-str)))
1523 (eq (car enc3-str) ?⿰))
1526 (unless conversion-only
1527 (setq f-res (ids-find-chars-including-ids enc-str)))
1529 (cond ((eq code 611)
1544 (list (list 'ideographic-structure
1551 (if (setq ret (ideographic-structure-find-chars new-str))
1553 (list (cons 'ideographic-structure
1554 (ideographic-structure-compact new-str)))))
1556 (cond ((or (eq code 611)
1558 (list ?⿱ (nth 1 enc-str) new-str-c)
1561 (list ?⿳ (nth 1 enc-str)(nth 1 enc2-str) new-str-c)
1563 (setq a-res (ids-find-chars-including-ids new-str))
1568 (cond ((or (eq code 611)
1570 (list ?⿱ (nth 1 enc-str) new-str-c)
1573 (list ?⿳ (nth 1 enc-str)(nth 1 enc2-str) new-str-c)
1578 ((eq (car enc-str) ?⿳)
1579 (setq enc2-str (ideographic-character-get-structure (nth 3 enc-str)))
1581 (eq (car enc2-str) ?⿰))
1582 (unless conversion-only
1583 (setq f-res (ids-find-chars-including-ids enc-str)))
1584 (setq new-str (list ?⿲
1589 (if (setq ret (ideographic-structure-find-chars new-str))
1591 (list (cons 'ideographic-structure new-str))))
1593 (list ?⿳ (nth 1 enc-str) (nth 2 enc-str) new-str-c)
1594 (setq a-res (ids-find-chars-including-ids new-str))
1599 (list ?⿳ (nth 1 enc-str) (nth 2 enc-str) new-str-c)
1603 ((eq (car enc-str) ?⿲)
1604 (unless conversion-only
1605 (setq f-res (ids-find-chars-including-ids enc-str)))
1606 (setq new-str (list ?⿱
1610 (if (setq ret (ideographic-structure-find-chars new-str))
1612 (list (cons 'ideographic-structure new-str))))
1614 (list ?⿲ (nth 1 enc-str) new-str-c (nth 3 enc-str))
1615 (setq a-res (ids-find-chars-including-ids new-str))
1620 (list ?⿲ (nth 1 enc-str) new-str-c (nth 3 enc-str))
1623 ((eq (car enc-str) ?⿴)
1624 (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str)))
1626 (eq (car enc2-str) ?⿰))
1627 (unless conversion-only
1628 (setq f-res (ids-find-chars-including-ids enc-str)))
1629 (setq new-str (list ?⿱
1633 (if (setq ret (ideographic-structure-find-chars new-str))
1635 (list (cons 'ideographic-structure new-str))))
1637 (list ?⿲ (nth 1 enc2-str) new-str-c (nth 2 enc2-str))
1638 (setq a-res (ids-find-chars-including-ids new-str))
1643 (list ?⿲ (nth 1 enc2-str) new-str-c (nth 2 enc2-str))
1646 ((eq (car enc-str) ?⿵)
1647 (unless conversion-only
1648 (setq f-res (ids-find-chars-including-ids enc-str)))
1649 (setq new-str (list ?⿱
1653 (if (setq ret (ideographic-structure-find-chars new-str))
1655 (list (cons 'ideographic-structure new-str))))
1657 (list ?⿵ (nth 1 enc-str) new-str-c)
1658 (setq a-res (ids-find-chars-including-ids new-str))
1663 (list ?⿵ (nth 1 enc-str) new-str-c)
1668 ((eq (car structure) ?⿷)
1669 (setq enc (nth 1 structure))
1671 (cond ((characterp enc)
1672 (get-char-attribute enc 'ideographic-structure)
1675 (cdr (assq 'ideographic-structure enc))
1678 ((eq (car enc-str) ?⿺)
1679 (unless conversion-only
1680 (setq f-res (ids-find-chars-including-ids enc-str)))
1681 (setq new-str (list ?⿱
1685 (if (setq ret (ideographic-structure-find-chars new-str))
1687 (list (cons 'ideographic-structure new-str))))
1689 (list ?⿺ (nth 1 enc-str) new-str-c)
1690 (setq a-res (ids-find-chars-including-ids new-str))
1695 (list ?⿺ (nth 1 enc-str) new-str-c)
1698 ((eq (car enc-str) ?⿸)
1699 (unless conversion-only
1700 (setq f-res (ids-find-chars-including-ids enc-str)))
1702 ((and (characterp (nth 2 enc-str))
1703 (or (memq (char-ucs (nth 2 enc-str))
1704 '(#x4EBA #x5165 #x513F #x51E0))
1705 (memq (or (encode-char (nth 2 enc-str) '=>ucs@iwds-1)
1706 (encode-char (nth 2 enc-str) '=>ucs@component))
1708 (setq new-str (list ?⿺
1712 (if (setq ret (ideographic-structure-find-chars new-str))
1714 (list (cons 'ideographic-structure new-str))))
1716 (list ?⿸ (nth 1 enc-str) new-str-c)
1717 (setq a-res (ids-find-chars-including-ids new-str))
1722 (list ?⿸ (nth 1 enc-str) new-str-c)
1726 (setq new-str (list ?⿱
1730 (if (setq ret (ideographic-structure-find-chars new-str))
1732 (list (cons 'ideographic-structure new-str))))
1734 (list ?⿸ (nth 1 enc-str) new-str-c)
1735 (setq a-res (ids-find-chars-including-ids new-str))
1740 (list ?⿸ (nth 1 enc-str) new-str-c)
1746 ((eq (car structure) ?⿺)
1747 (setq enc (nth 1 structure))
1749 (cond ((characterp enc)
1750 (or (get-char-attribute enc 'ideographic-structure)
1751 (get-char-attribute enc 'ideographic-structure@apparent)
1752 (get-char-attribute enc 'ideographic-structure@apparent/leftmost)
1753 (get-char-attribute enc 'ideographic-structure@apparent/rightmost))
1756 (or (cdr (assq 'ideographic-structure enc))
1757 (cdr (assq 'ideographic-structure@apparent enc))
1758 (cdr (assq 'ideographic-structure@apparent/leftmost enc))
1759 (cdr (assq 'ideographic-structure@apparent/rightmost enc)))
1762 ;; (mapcar (lambda (cell)
1763 ;; (or (and (listp cell)
1764 ;; (find-char cell))
1768 ((eq (car enc-str) ?⿱)
1770 ((and (characterp (nth 1 enc-str))
1771 (or (and (eq (char-ucs (nth 1 enc-str)) #x200CA)
1773 (and (eq (char-feature (nth 1 enc-str) '=>iwds-1) 233)
1774 (characterp (nth 2 structure))
1775 (eq (char-ucs (nth 2 structure)) #x4E36)
1777 (unless conversion-only
1778 (setq f-res (ids-find-chars-including-ids enc-str)))
1779 (setq new-str (list ?⿺
1783 (if (setq ret (ideographic-structure-find-chars new-str))
1785 (list (cons 'ideographic-structure new-str))))
1787 (list ?⿱ new-str-c (nth 2 enc-str))
1788 (setq a-res (ids-find-chars-including-ids new-str))
1793 (list ?⿱ new-str-c (nth 2 enc-str))
1796 ((and (characterp (nth 2 enc-str))
1797 (or (memq (char-ucs (nth 2 enc-str))
1800 #x65E5 #x66F0 #x5FC3
1801 #x2123C #x58EC #x738B #x7389))
1802 (memq (encode-char (nth 2 enc-str) '=>ucs@component)
1804 (eq (encode-char (nth 2 enc-str) '=>ucs@iwds-1)
1806 (eq (encode-char (nth 2 enc-str) '=>big5-cdp)
1808 (unless conversion-only
1809 (setq f-res (ids-find-chars-including-ids enc-str)))
1810 (setq new-str (list ?⿰
1814 (if (setq ret (ideographic-structure-find-chars new-str))
1816 (list (cons 'ideographic-structure new-str))))
1818 (list ?⿱ new-str-c (nth 2 enc-str))
1819 (setq a-res (ids-find-chars-including-ids new-str))
1824 (list ?⿱ new-str-c (nth 2 enc-str))
1829 ((eq (car structure) ?⿻)
1830 (setq enc (nth 1 structure))
1832 (cond ((characterp enc)
1833 (get-char-attribute enc 'ideographic-structure)
1836 (cdr (assq 'ideographic-structure enc))
1839 ((eq (car enc-str) ?⿱)
1840 (unless conversion-only
1841 (setq f-res (ids-find-chars-including-ids enc-str)))
1843 (list ?⿳ (nth 1 enc-str) (nth 2 structure) (nth 2 enc-str))
1863 ;;; ids-find.el ends here