(let ((chars
(sort (copy-list (aref ideograph-radical-chars-vector radical))
(function ideograph-char<)))
- (attributes (sort (char-attribute-list) #'char-attribute-name<))
- (ccs (sort (charset-list) #'char-attribute-name<)))
+ attributes ccs)
+ (dolist (name (char-attribute-list))
+ (if (find-charset name)
+ (push name ccs)
+ (push name attributes)))
+ (setq attributes (sort attributes #'char-attribute-name<)
+ ccs (sort ccs #'char-attribute-name<))
(aset ideograph-radical-chars-vector radical chars)
(while chars
(insert-char-data (car chars) nil attributes ccs)
(write-region (point-min)(point-max) file)
)))
+(defun ideographic-structure= (char1 char2)
+ (if (char-ref-p char1)
+ (setq char1 (plist-get char1 :char)))
+ (if (char-ref-p char2)
+ (setq char2 (plist-get char2 :char)))
+ (let ((s1 (if (characterp char1)
+ (get-char-attribute char1 'ideographic-structure)
+ (cdr (assq 'ideographic-structure char1))))
+ (s2 (if (characterp char2)
+ (get-char-attribute char2 'ideographic-structure)
+ (cdr (assq 'ideographic-structure char2))))
+ e1 e2)
+ (if (or (null s1)(null s2))
+ (char-spec= char1 char2)
+ (catch 'tag
+ (while (and s1 s2)
+ (setq e1 (car s1)
+ e2 (car s2))
+ (unless (ideographic-structure= e1 e2)
+ (throw 'tag nil))
+ (setq s1 (cdr s1)
+ s2 (cdr s2)))
+ (and (null s1)(null s2))))))
+
;;;###autoload
(defun ideographic-structure-find-char (structure)
(let (rest)
(setq rest structure)
(catch 'tag
(while (and rest value)
- (unless (char-ref= (car rest)(car value))
+ (unless (ideographic-structure=
+ (car rest)(car value))
(throw 'tag nil))
(setq rest (cdr rest)
value (cdr value)))