-(defun char-representative-of-daikanwa (char)
- (if (or (encode-char char 'ideograph-daikanwa 'defined-only)
- (encode-char char '=daikanwa-rev2 'defined-only))
- char
- (let ((m (char-feature char '=>daikanwa))
- m-m m-s pat)
- (or (and (integerp m)
- (or (decode-char '=daikanwa-rev2 m 'defined-only)
- (decode-char 'ideograph-daikanwa m)))
- (when (or m
- (setq m (get-char-attribute char 'morohashi-daikanwa)))
- (setq m-m (pop m))
- (setq m-s (pop m))
- (if (= m-s 0)
- (or (decode-char '=daikanwa-rev2 m-m 'defined-only)
- (decode-char 'ideograph-daikanwa m-m))
- (when m
- (setq pat (list m-m m-s))
- (map-char-attribute (lambda (c v)
- (if (equal pat v)
- c))
- 'morohashi-daikanwa))))
- char))))
+(defun char-representative-of-daikanwa (char &optional radical
+ ignore-default checked)
+ (unless radical
+ (setq radical ideographic-radical))
+ (if (or (null radical)
+ (eq (or (get-char-attribute char 'ideographic-radical)
+ (char-ideographic-radical char radical t))
+ radical))
+ (let ((ret (or (encode-char char 'ideograph-daikanwa 'defined-only)
+ (encode-char char '=daikanwa-rev2 'defined-only))))
+ (or (and ret char)
+ (if (setq ret (get-char-attribute char 'morohashi-daikanwa))
+ (let ((m-m (car ret))
+ (m-s (nth 1 ret))
+ pat)
+ (if (= m-s 0)
+ (or (decode-char '=daikanwa-rev2 m-m 'defined-only)
+ (decode-char 'ideograph-daikanwa m-m))
+ (setq pat (list m-m m-s))
+ (map-char-attribute (lambda (c v)
+ (if (equal pat v)
+ c))
+ 'morohashi-daikanwa))))
+ (and (setq ret (get-char-attribute char '=>daikanwa))
+ (if (numberp ret)
+ (or (decode-char '=daikanwa-rev2 ret 'defined-only)
+ (decode-char 'ideograph-daikanwa ret))
+ (map-char-attribute (lambda (c v)
+ (if (equal ret v)
+ char))
+ 'morohashi-daikanwa)))
+ (unless (memq char checked)
+ (catch 'tag
+ (let ((rest
+ (append (get-char-attribute char '->subsumptive)
+ (get-char-attribute char '->denotational)))
+ (i 0)
+ sc)
+ (setq checked (cons char checked))
+ (while rest
+ (setq sc (car rest))
+ (if (setq ret (char-representative-of-daikanwa
+ sc radical t checked))
+ (throw 'tag ret))
+ (setq checked (cons sc checked)
+ rest (cdr rest)
+ i (1+ i)))
+ (setq rest (get-char-attribute char '->identical))
+ (while rest
+ (setq sc (car rest))
+ (when (setq ret (char-representative-of-daikanwa
+ sc radical t checked))
+ (throw 'tag ret))
+ (setq checked (cons sc checked)
+ rest (cdr rest)))
+ (setq rest
+ (append (get-char-attribute char '<-subsumptive)
+ (get-char-attribute char '<-denotational)))
+ (while rest
+ (setq sc (car rest))
+ (when (setq ret (char-representative-of-daikanwa
+ sc radical t checked))
+ (throw 'tag ret))
+ (setq checked (cons sc checked)
+ rest (cdr rest))))))
+ (unless ignore-default
+ char)))))