X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=ids-find.el;h=a4acb7187eb0665de4529852ac4e8b1b797e750f;hb=df06e7bde23caa4a84cc316c763b062840c0a85d;hp=2318c0d2ff6644bf6ed71458054389d697c195fc;hpb=6086d974a1f4ac3af6f024962ecf2ff0033d1587;p=chise%2Fids.git diff --git a/ids-find.el b/ids-find.el index 2318c0d..a4acb71 100644 --- a/ids-find.el +++ b/ids-find.el @@ -294,7 +294,7 @@ (unless level (setq level 0)) (let (is i as bs) - (dolist (c (sort (copy-tree (ideograph-find-products components + (dolist (c (sort (copy-list (ideograph-find-products components ignored-chars)) (lambda (a b) (if (setq as (char-total-strokes a)) @@ -341,7 +341,7 @@ (ids-insert-chars-including-components* (char-to-string vc) (1+ level) (cons vc ignored-chars))))))) - (dolist (c (sort (copy-tree (ideograph-find-products-with-variants + (dolist (c (sort (copy-list (ideograph-find-products-with-variants components ignored-chars)) (lambda (a b) (if (setq as (char-total-strokes a)) @@ -599,16 +599,20 @@ (defun ideographic-character-get-structure (character) "Return ideographic-structure of CHARACTER. CHARACTER can be a character or char-spec." - (let (ret) - (cond ((characterp character) - (get-char-attribute character 'ideographic-structure) - ) - ((setq ret (assq 'ideographic-structure character)) - (cdr ret) - ) - ((setq ret (find-char character)) - (get-char-attribute ret 'ideographic-structure) - )))) + (mapcar (lambda (cell) + (or (and (listp cell) + (find-char cell)) + cell)) + (let (ret) + (cond ((characterp character) + (get-char-attribute character 'ideographic-structure) + ) + ((setq ret (assq 'ideographic-structure character)) + (cdr ret) + ) + ((setq ret (find-char character)) + (get-char-attribute ret 'ideographic-structure) + ))))) ;;;###autoload (defun ideographic-char-match-component (char component) @@ -661,439 +665,96 @@ COMPONENT can be a character or char-spec." )) )) -(defun ideographic-chars-to-is-a-tree (chars) - (let (comp char products others dest rest - la lb) - (setq chars (sort chars #'ideographic-structure-char<)) - (while chars - (setq comp (pop chars) - rest chars - products nil - others nil) - (while rest - (setq char (pop rest)) - (cond - ((ideographic-char-match-component char comp) - (push char products) - ) - (t - (push char others) - ))) - (push (cons comp - ;; (nreverse products) - (if products - (sort (ideographic-chars-to-is-a-tree products) - (lambda (a b) - (setq la (length (cdr a)) - lb (length (cdr b))) - (or (> la lb) - (and (= la lb) - (ideograph-char< (car a) (car b)) - ;; (progn - ;; (setq tsa (char-total-strokes (car a)) - ;; tsb (char-total-strokes (car b))) - ;; (if tsa - ;; (if tsb - ;; (or (< tsa tsb) - ;; (and (= tsa tsb) - ;; (ideograph-char< - ;; (car a) (car b)))) - ;; t) - ;; (if tsb - ;; nil - ;; (ideograph-char< (car a) (car b))))) - )))) - nil) - ) - dest) - (setq chars others)) - dest)) +(defun ideo-comp-tree-adjoin (tree char) + (let ((rest tree) + included ; other + dest cell finished) + (while (and (not finished) + rest) + (setq cell (pop rest)) + (cond ((ideographic-structure-character= char (car cell)) + (setq finished t + dest tree + rest nil) + ) + ((ideographic-char-match-component char (car cell)) + (setq dest + (cons (cons (car cell) + (ideo-comp-tree-adjoin (cdr cell) char)) + dest)) + (setq finished t) + ) + ((ideographic-char-match-component (car cell) char) + (setq included (cons cell included)) + ) + ;; (included + ;; (setq other (cons cell other)) + ;; ) + (t + (setq dest (cons cell dest)) + ))) + (cond (finished + (nconc dest rest) + ) + (included + (cons (cons char included) + (nconc dest rest)) + ) + (t + (cons (list char) tree) + )))) -(defun ids-find-chars-including-ids* (operator component1 component2 - &optional component3) - (let ((comp-alist (ideographic-structure-to-components-alist* - operator component1 component2 component3)) - (comp-spec - (list (list* 'ideographic-structure - operator component1 component2 - (if component3 - (list component3))))) - ret str rest) - (dolist (pc (caar - (sort (mapcar (lambda (cell) - (if (setq ret (get-char-attribute - (car cell) 'ideographic-products)) - (cons ret (length ret)) - (cons nil 0))) - comp-alist) - (lambda (a b) - (< (cdr a)(cdr b)))))) - (when (and (every (lambda (cell) - (>= (ideographic-char-count-components pc (car cell)) - (cdr cell))) - comp-alist) - (or (ideographic-char-match-component pc comp-spec) - (and (setq str (get-char-attribute pc 'ideographic-structure)) - (ideographic-char-match-component - (list - (cons - 'ideographic-structure - (functional-ideographic-structure-to-apparent-structure - str))) - comp-spec)))) - (push pc rest))) - (ideographic-chars-to-is-a-tree rest))) +(defun ideographic-chars-to-is-a-tree (chars) + (let (tree) + (dolist (char (sort (copy-list chars) #'ideographic-structure-char<)) + (setq tree (ideo-comp-tree-adjoin tree char))) + tree)) (defun ids-find-chars-including-ids (structure) - (if (characterp structure) - (setq structure (get-char-attribute structure 'ideographic-structure))) - (apply #'ids-find-chars-including-ids* structure)) + (let (comp-alist comp-spec ret str rest) + (cond + ((characterp structure) + (setq rest (copy-list (get-char-attribute structure 'ideographic-products))) + ) + ((setq ret (ideographic-structure-find-chars structure)) + (dolist (pc ret) + (setq rest + (union + rest + (copy-list (get-char-attribute pc 'ideographic-products))))) + ) + (t + (setq comp-alist (ideographic-structure-to-components-alist structure) + comp-spec (list (cons 'ideographic-structure structure))) + (dolist (pc (caar + (sort (mapcar (lambda (cell) + (if (setq ret (get-char-attribute + (car cell) 'ideographic-products)) + (cons ret (length ret)) + (cons nil 0))) + comp-alist) + (lambda (a b) + (< (cdr a)(cdr b)))))) + (when (and (every (lambda (cell) + (>= (ideographic-char-count-components pc (car cell)) + (cdr cell))) + comp-alist) + (or (ideographic-char-match-component pc comp-spec) + (and (setq str (get-char-attribute pc 'ideographic-structure)) + (ideographic-char-match-component + (list + (cons + 'ideographic-structure + (functional-ideographic-structure-to-apparent-structure + str))) + comp-spec)))) + (push pc rest))) + )) + (ideographic-chars-to-is-a-tree rest))) (defun functional-ideographic-structure-to-apparent-structure (structure) (ideographic-structure-compare-functional-and-apparent - structure nil 'conversion-only) - ;; (ideographic-structure-compact - ;; (let (enc enc-str enc2-str new-str) - ;; (cond - ;; ((eq (car structure) ?⿸) - ;; (setq enc (nth 1 structure)) - ;; (when (setq enc-str - ;; (cond ((characterp enc) - ;; (get-char-attribute enc 'ideographic-structure) - ;; ) - ;; ((consp enc) - ;; (cdr (assq 'ideographic-structure enc)) - ;; ))) - ;; (cond - ;; ((eq (car enc-str) ?⿰) - ;; (list ?⿰ (nth 1 enc-str) - ;; (list (list 'ideographic-structure - ;; ?⿱ - ;; (nth 2 enc-str) - ;; (nth 2 structure)))) - ;; ) - ;; ((and (eq (car enc-str) ?⿲) - ;; (memq (char-ucs (nth 1 enc-str)) '(#x4EBB #x2E85)) - ;; (eq (nth 2 enc-str) ?丨)) - ;; (list ?⿰ - ;; (decode-char '=big5-cdp #x8B7A) - ;; (list (list 'ideographic-structure - ;; ?⿱ - ;; (nth 3 enc-str) - ;; (nth 2 structure)))) - ;; ) - ;; ((eq (car enc-str) ?⿱) - ;; (list ?⿱ (nth 1 enc-str) - ;; (list - ;; (cons 'ideographic-structure - ;; (or (functional-ideographic-structure-to-apparent-structure - ;; (setq new-str - ;; (list - ;; (cond - ;; ((characterp (nth 2 enc-str)) - ;; (if (or (eq (encode-char - ;; (nth 2 enc-str) - ;; '=>ucs@component) - ;; #x20087) - ;; (eq (encode-char - ;; (nth 2 enc-str) - ;; '=>ucs@component) - ;; #x5382) - ;; (eq (encode-char - ;; (nth 2 enc-str) - ;; '=>ucs@component) - ;; #x4E06) - ;; (eq (encode-char - ;; (nth 2 enc-str) - ;; '=big5-cdp) - ;; #x89CE) - ;; (eq (encode-char - ;; (nth 2 enc-str) - ;; '=>big5-cdp) - ;; #x88E2) - ;; (eq (encode-char - ;; (nth 2 enc-str) - ;; '=big5-cdp) - ;; #x88AD) - ;; (eq (or (encode-char - ;; (nth 2 enc-str) - ;; '=>big5-cdp) - ;; (encode-char - ;; (nth 2 enc-str) - ;; '=big5-cdp-itaiji-001)) - ;; #x8766) - ;; (eq (car - ;; (get-char-attribute - ;; (nth 2 enc-str) - ;; 'ideographic-structure)) - ;; ?⿸)) - ;; ?⿸ - ;; ?⿰)) - ;; ((eq (car - ;; (cdr - ;; (assq 'ideographic-structure - ;; (nth 2 enc-str)))) - ;; ?⿸) - ;; ?⿸) - ;; (t - ;; ?⿰)) - ;; (nth 2 enc-str) - ;; (nth 2 structure) - ;; ))) - ;; new-str)))) - ;; ) - ;; ((eq (car enc-str) ?⿸) - ;; (list ?⿸ (nth 1 enc-str) - ;; (list - ;; (cons 'ideographic-structure - ;; (setq new-str - ;; (list - ;; (cond - ;; ((characterp (nth 2 enc-str)) - ;; (if (memq (char-ucs (nth 2 enc-str)) - ;; '(#x5F73)) - ;; ?⿰ - ;; ?⿱) - ;; ) - ;; (t - ;; ?⿱)) - ;; (nth 2 enc-str) - ;; (nth 2 structure)))))) - ;; ))) - ;; ) - ;; ((eq (car structure) ?⿹) - ;; (setq enc (nth 1 structure)) - ;; (when (setq enc-str - ;; (cond ((characterp enc) - ;; (get-char-attribute enc 'ideographic-structure) - ;; ) - ;; ((consp enc) - ;; (cdr (assq 'ideographic-structure enc)) - ;; ))) - ;; (cond - ;; ((eq (car enc-str) ?⿰) - ;; (list ?⿰ - ;; (list (list 'ideographic-structure - ;; ?⿱ - ;; (nth 1 enc-str) - ;; (nth 2 structure))) - ;; (nth 2 enc-str)) - ;; ))) - ;; ) - ;; ((eq (get-char-attribute (car structure) '=ucs-itaiji-001) #x2FF6) - ;; (setq enc (nth 1 structure)) - ;; (when (setq enc-str - ;; (cond ((characterp enc) - ;; (get-char-attribute enc 'ideographic-structure) - ;; ) - ;; ((consp enc) - ;; (cdr (assq 'ideographic-structure enc)) - ;; ))) - ;; (cond - ;; ((eq (car enc-str) ?⿺) - ;; (list ?⿺ - ;; (list (list 'ideographic-structure - ;; ?⿱ - ;; (nth 2 structure) - ;; (nth 1 enc-str))) - ;; (nth 2 enc-str)) - ;; ) - ;; ((eq (car enc-str) ?⿱) - ;; (list ?⿱ - ;; (list (list 'ideographic-structure - ;; ?⿰ - ;; (nth 2 structure) - ;; (nth 1 enc-str))) - ;; (nth 2 enc-str)) - ;; )) - ;; ) - ;; ) - ;; ((eq (car structure) ?⿴) - ;; (setq enc (nth 1 structure)) - ;; (when (setq enc-str - ;; (cond ((characterp enc) - ;; (get-char-attribute enc 'ideographic-structure) - ;; ) - ;; ((consp enc) - ;; (cdr (assq 'ideographic-structure enc)) - ;; ))) - ;; (cond - ;; ((eq (car enc-str) ?⿱) - ;; (cond - ;; ((and (characterp (nth 2 enc-str)) - ;; (or (memq (char-ucs (nth 2 enc-str)) '(#x56D7 #x5F51 #x897F)) - ;; (eq (char-feature (nth 2 enc-str) '=>big5-cdp) - ;; #x87A5))) - ;; (list ?⿱ - ;; (nth 1 enc-str) - ;; (list (list 'ideographic-structure - ;; ?⿴ - ;; (nth 2 enc-str) - ;; (nth 2 structure))) - ;; ) - ;; ) - ;; ((and (characterp (nth 2 enc-str)) - ;; (eq (char-ucs (nth 2 enc-str)) #x51F5)) - ;; (list ?⿱ - ;; (nth 1 enc-str) - ;; (list (list 'ideographic-structure - ;; ?⿶ - ;; (nth 2 enc-str) - ;; (nth 2 structure))) - ;; ) - ;; ) - ;; ((and (characterp (nth 1 enc-str)) - ;; (eq (char-feature (nth 1 enc-str) '=>ucs@component) - ;; #x300E6)) - ;; (list ?⿱ - ;; (list (list 'ideographic-structure - ;; ?⿵ - ;; (nth 1 enc-str) - ;; (nth 2 structure))) - ;; (nth 2 enc-str)) - ;; ) - ;; (t - ;; (list ?⿳ - ;; (nth 1 enc-str) - ;; (nth 2 structure) - ;; (nth 2 enc-str)) - ;; )) - ;; )) - ;; ) - ;; ) - ;; ((eq (car structure) ?⿶) - ;; (setq enc (nth 1 structure)) - ;; (when (setq enc-str - ;; (cond ((characterp enc) - ;; (get-char-attribute enc 'ideographic-structure) - ;; ) - ;; ((consp enc) - ;; (cdr (assq 'ideographic-structure enc)) - ;; ))) - ;; (cond - ;; ((eq (car enc-str) ?⿱) - ;; (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str))) - ;; (when (and enc2-str - ;; (eq (car enc2-str) ?⿰)) - ;; (list ?⿱ - ;; (list (list 'ideographic-structure - ;; ?⿲ - ;; (nth 1 enc2-str) - ;; (nth 2 structure) - ;; (nth 2 enc2-str))) - ;; (nth 2 enc-str))) - ;; ) - ;; ((eq (car enc-str) ?⿳) - ;; (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str))) - ;; (when (and enc2-str - ;; (eq (car enc2-str) ?⿰)) - ;; (list ?⿳ - ;; (list (list 'ideographic-structure - ;; ?⿲ - ;; (nth 1 enc2-str) - ;; (nth 2 structure) - ;; (nth 2 enc2-str))) - ;; (nth 2 enc-str) - ;; (nth 3 enc-str))) - ;; ) - ;; ((eq (car enc-str) ?⿲) - ;; (list ?⿲ - ;; (nth 1 enc-str) - ;; (list (list 'ideographic-structure - ;; ?⿱ - ;; (nth 2 structure) - ;; (nth 2 enc-str))) - ;; (nth 3 enc-str)) - ;; ) - ;; ((eq (car enc-str) ?⿴) - ;; (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str))) - ;; (when (and enc2-str - ;; (eq (car enc2-str) ?⿰)) - ;; (list ?⿲ - ;; (nth 1 enc2-str) - ;; (list (list 'ideographic-structure - ;; ?⿱ - ;; (nth 2 structure) - ;; (nth 2 enc-str))) - ;; (nth 2 enc2-str))) - ;; ))) - ;; ) - ;; ((eq (car structure) ?⿵) - ;; (setq enc (nth 1 structure)) - ;; (when (setq enc-str - ;; (cond ((characterp enc) - ;; (get-char-attribute enc 'ideographic-structure) - ;; ) - ;; ((consp enc) - ;; (cdr (assq 'ideographic-structure enc)) - ;; ))) - ;; (cond - ;; ((eq (car enc-str) ?⿱) - ;; (setq enc2-str (ideographic-character-get-structure (nth 2 enc-str))) - ;; (when (and enc2-str - ;; (eq (car enc2-str) ?⿰)) - ;; (list ?⿱ - ;; (nth 1 enc-str) - ;; (list (list 'ideographic-structure - ;; ?⿲ - ;; (nth 1 enc2-str) - ;; (nth 2 structure) - ;; (nth 2 enc2-str))))) - ;; ) - ;; ((eq (car enc-str) ?⿳) - ;; (setq enc2-str (ideographic-character-get-structure (nth 3 enc-str))) - ;; (when (and enc2-str - ;; (eq (car enc2-str) ?⿰)) - ;; (list ?⿳ - ;; (nth 1 enc-str) - ;; (nth 2 enc-str) - ;; (list (list 'ideographic-structure - ;; ?⿲ - ;; (nth 1 enc2-str) - ;; (nth 2 structure) - ;; (nth 2 enc2-str))))) - ;; ) - ;; ((eq (car enc-str) ?⿲) - ;; (list ?⿲ - ;; (nth 1 enc-str) - ;; (list (list 'ideographic-structure - ;; ?⿱ - ;; (nth 2 enc-str) - ;; (nth 2 structure))) - ;; (nth 3 enc-str)) - ;; ) - ;; ((eq (car enc-str) ?⿴) - ;; (setq enc2-str (ideographic-character-get-structure (nth 1 enc-str))) - ;; (when (and enc2-str - ;; (eq (car enc2-str) ?⿰)) - ;; (list ?⿲ - ;; (nth 1 enc2-str) - ;; (list (list 'ideographic-structure - ;; ?⿱ - ;; (nth 2 enc-str) - ;; (nth 2 structure))) - ;; (nth 2 enc2-str))) - ;; ))) - ;; ) - ;; ((eq (car structure) ?⿻) - ;; (setq enc (nth 1 structure)) - ;; (when (setq enc-str - ;; (cond ((characterp enc) - ;; (get-char-attribute enc 'ideographic-structure) - ;; ) - ;; ((consp enc) - ;; (cdr (assq 'ideographic-structure enc)) - ;; ))) - ;; (cond - ;; ((eq (car enc-str) ?⿱) - ;; (list ?⿳ - ;; (nth 1 enc-str) - ;; (nth 2 structure) - ;; (nth 2 enc-str)) - ;; ))) - ;; )) - ;; )) - ) + structure nil 'conversion-only)) ;;;###autoload (defun ideographic-structure-compact (structure) @@ -1111,9 +772,15 @@ COMPONENT can be a character or char-spec." (setq sub cell) ))) (setq cell - (if (setq ret (ideographic-structure-find-chars sub)) - (car ret) - (list (cons 'ideographic-structure sub)))) + (cond ((setq ret (ideographic-structure-find-chars sub)) + (car ret) + ) + ((setq ret (ideographic-structure-compact sub)) + (list (cons 'ideographic-structure ret)) + ) + (t + (list (cons 'ideographic-structure sub)))) + ) )) (setq dest (cons cell dest))) (nreverse dest))) @@ -1121,7 +788,8 @@ COMPONENT can be a character or char-spec." (defun ideographic-structure-compare-functional-and-apparent (structure &optional char conversion-only) - (let (enc enc-str enc2-str new-str new-str-c f-res a-res ret) + (let (enc enc-str enc2-str enc3-str new-str new-str-c + f-res a-res ret code) (cond ((eq (car structure) ?⿸) (setq enc (nth 1 structure)) @@ -1182,12 +850,12 @@ COMPONENT can be a character or char-spec." (list (cond ((characterp (nth 2 enc-str)) - (if (or (eq (encode-char (nth 2 enc-str) '=>ucs@component) - #x20087) - (eq (encode-char (nth 2 enc-str) '=>ucs@component) - #x5382) - (eq (encode-char (nth 2 enc-str) '=>ucs@component) + (if (or (memq (encode-char (nth 2 enc-str) '=>ucs@component) + '(#x20087 #x5382 #x4E06)) + (eq (encode-char (nth 2 enc-str) '=>ucs@iwds-1) #x4E06) + (eq (encode-char (nth 2 enc-str) '=ucs-itaiji-001) + #x2E282) (eq (encode-char (nth 2 enc-str) '=big5-cdp) #x89CE) (eq (encode-char (nth 2 enc-str) '=>big5-cdp) @@ -1336,6 +1004,26 @@ COMPONENT can be a character or char-spec." a-res (list ?⿱ new-str-c (nth 2 enc-str)) 320)) + ) + ((eq (car enc-str) ?⿰) + (unless conversion-only + (setq f-res (ids-find-chars-including-ids enc-str))) + (setq new-str (list ?⿱ + (nth 2 structure) + (nth 1 enc-str))) + (setq new-str-c + (if (setq ret (ideographic-structure-find-chars new-str)) + (car ret) + (list (cons 'ideographic-structure new-str)))) + (if conversion-only + (list ?⿰ new-str-c (nth 2 enc-str)) + (setq a-res (ids-find-chars-including-ids new-str)) + (list enc + f-res + new-str-c + a-res + (list ?⿰ new-str-c (nth 2 enc-str)) + 330)) )) ) ) @@ -1537,7 +1225,50 @@ COMPONENT can be a character or char-spec." (list ?⿱ new-str-c (nth 3 enc-str)) 419)) )) - ))) + ) + ((eq (car enc-str) ?⿰) + (cond + ((equal (nth 1 enc-str)(nth 2 enc-str)) + (unless conversion-only + (setq f-res (ids-find-chars-including-ids enc-str))) + (setq new-str (list ?⿲ + (nth 1 enc-str) + (nth 2 structure) + (nth 2 enc-str))) + (setq new-str-c + (list (cons 'ideographic-structure new-str))) + (if conversion-only + new-str + (setq a-res (ids-find-chars-including-ids new-str)) + (list enc + f-res + new-str-c + a-res + new-str + 421)) + ) + (t + (unless conversion-only + (setq f-res (ids-find-chars-including-ids enc-str))) + (setq new-str (list ?⿰ + (nth 2 structure) + (nth 2 enc-str))) + (setq new-str-c + (if (setq ret (ideographic-structure-find-chars new-str)) + (car ret) + (list (cons 'ideographic-structure new-str)))) + (if conversion-only + (list ?⿰ (nth 1 enc-str) new-str-c) + (setq a-res (ids-find-chars-including-ids new-str)) + (list enc + f-res + new-str-c + a-res + (list ?⿰ (nth 1 enc-str) new-str-c) + 422)) + )) + )) + ) ) ((eq (car structure) ?⿶) (setq enc (nth 1 structure)) @@ -1654,16 +1385,16 @@ COMPONENT can be a character or char-spec." (cdr (assq 'ideographic-structure enc)) ))) (cond - ((eq (car enc-str) ?⿱) - (setq enc2-str (ideographic-character-get-structure (nth 2 enc-str))) - (when (and enc2-str - (eq (car enc2-str) ?⿰)) + ((eq (car enc-str) ?⿱) + (cond + ((and (characterp (nth 2 enc-str)) + (memq (char-ucs (nth 2 enc-str)) + '(#x9580 #x9B25))) (unless conversion-only (setq f-res (ids-find-chars-including-ids enc-str))) - (setq new-str (list ?⿲ - (nth 1 enc2-str) - (nth 2 structure) - (nth 2 enc2-str))) + (setq new-str (list ?⿵ + (nth 2 enc-str) + (nth 2 structure))) (setq new-str-c (if (setq ret (ideographic-structure-find-chars new-str)) (car ret) @@ -1676,8 +1407,73 @@ COMPONENT can be a character or char-spec." new-str-c a-res (list ?⿱ (nth 1 enc-str) new-str-c) - 611)) + 601)) ) + ((and (setq enc2-str (ideographic-character-get-structure (nth 2 enc-str))) + (cond + ((eq (car enc2-str) ?⿰) + (setq code 611) + ) + ((eq (car enc2-str) ?⿲) + (setq code 614) + ) + ((and (eq (car enc2-str) ?⿱) + (setq enc3-str + (ideographic-character-get-structure (nth 2 enc2-str))) + (eq (car enc3-str) ?⿰)) + (setq code 613) + ))) + (unless conversion-only + (setq f-res (ids-find-chars-including-ids enc-str))) + (setq new-str + (cond ((eq code 611) + (list ?⿲ + (nth 1 enc2-str) + (nth 2 structure) + (nth 2 enc2-str)) + ) + ((eq code 613) + (list ?⿲ + (nth 1 enc3-str) + (nth 2 structure) + (nth 2 enc3-str)) + ) + ((eq code 614) + (list ?⿲ + (nth 1 enc2-str) + (list (list 'ideographic-structure + ?⿱ + (nth 2 enc2-str) + (nth 2 structure))) + (nth 3 enc2-str)) + ))) + (setq new-str-c + (if (setq ret (ideographic-structure-find-chars new-str)) + (car ret) + (list (cons 'ideographic-structure + (ideographic-structure-compact new-str))))) + (if conversion-only + (cond ((or (eq code 611) + (eq code 614)) + (list ?⿱ (nth 1 enc-str) new-str-c) + ) + ((eq code 613) + (list ?⿳ (nth 1 enc-str)(nth 1 enc2-str) new-str-c) + )) + (setq a-res (ids-find-chars-including-ids new-str)) + (list enc + f-res + new-str-c + a-res + (cond ((or (eq code 611) + (eq code 614)) + (list ?⿱ (nth 1 enc-str) new-str-c) + ) + ((eq code 613) + (list ?⿳ (nth 1 enc-str)(nth 1 enc2-str) new-str-c) + )) + code)) + )) ) ((eq (car enc-str) ?⿳) (setq enc2-str (ideographic-character-get-structure (nth 3 enc-str))) @@ -1780,6 +1576,79 @@ COMPONENT can be a character or char-spec." 710)) ))) ) + ((eq (car structure) ?⿺) + (setq enc (nth 1 structure)) + (when (setq enc-str + (cond ((characterp enc) + (or (get-char-attribute enc 'ideographic-structure) + (get-char-attribute enc 'ideographic-structure@apparent)) + ) + ((consp enc) + (or (cdr (assq 'ideographic-structure enc)) + (cdr (assq 'ideographic-structure@apparent enc))) + ))) + ;; (setq enc-str + ;; (mapcar (lambda (cell) + ;; (or (and (listp cell) + ;; (find-char cell)) + ;; cell)) + ;; enc-str)) + (cond + ((eq (car enc-str) ?⿱) + (cond + ((and (characterp (nth 1 enc-str)) + (or (and (eq (char-ucs (nth 1 enc-str)) #x200CA) + (setq code 811)) + (and (eq (char-feature (nth 1 enc-str) '=>iwds-1) 233) + (characterp (nth 2 structure)) + (eq (char-ucs (nth 2 structure)) #x4E36) + (setq code 812)))) + (unless conversion-only + (setq f-res (ids-find-chars-including-ids enc-str))) + (setq new-str (list ?⿺ + (nth 1 enc-str) + (nth 2 structure))) + (setq new-str-c + (if (setq ret (ideographic-structure-find-chars new-str)) + (car ret) + (list (cons 'ideographic-structure new-str)))) + (if conversion-only + (list ?⿱ new-str-c (nth 2 enc-str)) + (setq a-res (ids-find-chars-including-ids new-str)) + (list enc + f-res + new-str-c + a-res + (list ?⿱ new-str-c (nth 2 enc-str)) + code)) + ) + ((and (characterp (nth 2 enc-str)) + (memq (char-ucs (nth 2 enc-str)) + '(#x4E00 + #x706C + #x65E5 #x66F0 #x5FC3 + #x2123C #x58EC #x738B #x7389))) + (unless conversion-only + (setq f-res (ids-find-chars-including-ids enc-str))) + (setq new-str (list ?⿰ + (nth 1 enc-str) + (nth 2 structure))) + (setq new-str-c + (if (setq ret (ideographic-structure-find-chars new-str)) + (car ret) + (list (cons 'ideographic-structure new-str)))) + (if conversion-only + (list ?⿱ new-str-c (nth 2 enc-str)) + (setq a-res (ids-find-chars-including-ids new-str)) + (list enc + f-res + new-str-c + a-res + (list ?⿱ new-str-c (nth 2 enc-str)) + 813)) + ) + )))) + ) ((eq (car structure) ?⿻) (setq enc (nth 1 structure)) (when (setq enc-str