;;;###autoload
(defun ideographic-structure-find-chars (structure)
- (apply #'ideographic-structure-find-chars* structure))
-
-(defun ideographic-structure-find-chars* (operator component1 component2
- &optional component3)
- (let ((comp-alist (ideographic-structure-to-components-alist*
- operator component1 component2 component3))
- c1 c2 c3
- ret pl str
- var-alist)
+ (let ((comp-alist (ideographic-structure-to-components-alist structure))
+ ret pl str)
(dolist (pc (caar
(sort (mapcar (lambda (cell)
(if (setq ret (get-char-attribute
comp-alist)
(lambda (a b)
(< (cdr a)(cdr b))))))
- (when (and (setq str (get-char-attribute pc 'ideographic-structure))
- (setq var-alist
- (ideographic-structure-character= (car str) operator))
- (setq c1 (nth 1 str))
- (setq ret (ideographic-structure-character= c1 component1))
- (setq var-alist (ids-find-merge-variables var-alist ret))
- (setq c2 (nth 2 str))
- (setq ret (ideographic-structure-character= c2 component2))
- (setq var-alist (ids-find-merge-variables var-alist ret))
- (cond ((memq (car str) '(?\u2FF2 ?\u2FF3))
- (setq c3 (nth 3 str))
- (and (setq ret (ideographic-structure-character=
- c3 component3))
- (ids-find-merge-variables var-alist ret))
- )
- (t var-alist)))
+ (when (or (and (setq str
+ (get-char-attribute pc 'ideographic-structure))
+ (ideographic-structure-equal str structure))
+ (and (setq str
+ (get-char-attribute pc 'ideographic-structure@apparent))
+ (ideographic-structure-equal str structure)))
(setq pl (cons pc pl))
))
pl))
(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 code ret)
+ (let (enc enc-str enc2-str new-str new-str-c f-res a-res ret)
(cond
((eq (car structure) ?⿸)
(setq enc (nth 1 structure))
(list ?⿱ (nth 1 enc-str) new-str-c)
414))
))
- ))
- )
+ )
+ ((eq (car enc-str) ?⿳)
+ (cond
+ ((and (characterp (nth 2 enc-str))
+ (eq (char-ucs (nth 2 enc-str)) #x56D7))
+ (unless conversion-only
+ (setq f-res (ids-find-chars-including-ids enc-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)
+ (list (cons 'ideographic-structure new-str))))
+ (setq new-str (list ?⿱ (nth 1 enc-str) new-str-c))
+ (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 3 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 3 enc-str))
+ 415))
+ )
+ ((and (characterp (nth 2 enc-str))
+ (eq (char-ucs (nth 2 enc-str)) #x5196))
+ (unless conversion-only
+ (setq f-res (ids-find-chars-including-ids enc-str)))
+ (setq new-str (list ?⿱ (nth 1 enc-str) (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))))
+ (setq new-str (list ?⿱ new-str-c (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 3 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 3 enc-str))
+ 416))
+ )
+ ((and (characterp (nth 2 enc-str))
+ (or (eq (encode-char (nth 2 enc-str) '=>big5-cdp)
+ #x89A6)
+ (eq (encode-char (nth 2 enc-str) '=>gt-k)
+ 146)
+ (eq (char-ucs (nth 2 enc-str)) #x2008A)))
+ (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))))
+ (setq new-str (list ?⿸ new-str-c (nth 3 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)
+ 417))
+ )
+ (t
+ (unless conversion-only
+ (setq f-res (ids-find-chars-including-ids enc-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)
+ (list (cons 'ideographic-structure new-str))))
+ (setq new-str (list ?⿱ (nth 1 enc-str) new-str-c))
+ (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 3 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 3 enc-str))
+ 419))
+ ))
+ )))
)
((eq (car structure) ?⿶)
(setq enc (nth 1 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) ?⿺)
+ (unless conversion-only
+ (setq f-res (ids-find-chars-including-ids enc-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)
+ (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)
+ 710))
+ )))
+ )
((eq (car structure) ?⿻)
(setq enc (nth 1 structure))
(when (setq enc-str
projects / chise / ids.git / blobdiff