;;;###autoload
(defun char-ideographic-strokes (char &optional radical preferred-domains)
(let (ret)
- (or (char-ideographic-strokes-from-domains
- char preferred-domains radical)
- (char-feature char 'ideographic-strokes)
- (char-ideographic-strokes-from-domains
- char char-db-feature-domains radical)
- (catch 'tag
+ (or (catch 'tag
(dolist (cell (get-char-attribute char 'ideographic-))
(if (and (setq ret (plist-get cell :radical))
(or (eq ret radical)
(null radical)))
(throw 'tag (plist-get cell :strokes)))))
+ (char-ideographic-strokes-from-domains
+ char preferred-domains radical)
+ (get-char-attribute char 'ideographic-strokes)
+ (char-ideographic-strokes-from-domains
+ char char-db-feature-domains radical)
+ (char-feature char 'ideographic-strokes)
(get-char-attribute char 'daikanwa-strokes)
(let ((strokes
(or (get-char-attribute char 'kangxi-strokes)
;;;###autoload
(defun update-ideograph-radical-table ()
(interactive)
- (let (ret radical script)
+ (let (ret radical script dest)
(dolist (feature
(cons 'ideographic-radical
(mapcar
char-db-feature-domains)))
(map-char-attribute
(lambda (chr radical)
- (dolist (char (cons chr
- (get-char-attribute chr '->denotational)))
+ (dolist (char (append
+ (if (setq ret
+ (get-char-attribute chr '<-subsumptive))
+ (progn
+ (setq dest nil)
+ (dolist (pc ret)
+ (unless (get-char-attribute
+ pc 'ideographic-radical)
+ (setq dest (cons pc dest))))
+ dest)
+ (list chr))
+ (get-char-attribute chr '<-identical)
+ (get-char-attribute chr '->denotational)))
(when (and radical
+ (or (eq radical
+ (char-ideographic-radical char radical))
+ (null (char-ideographic-radical char)))
(or (null (setq script
(get-char-attribute char 'script)))
(memq 'Ideograph script)))
;; (t (< a b))))
;;;###autoload
-(defun char-representative-of-daikanwa (char)
+(defun char-representative-of-daikanwa (char &optional radical)
+ (unless radical
+ (setq radical ideographic-radical))
(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)
+ m-m m-s pat
+ scs sc ret)
(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))
+ (setq m-m (car m))
+ (setq m-s (nth 1 m))
(if (= m-s 0)
(or (decode-char '=daikanwa-rev2 m-m 'defined-only)
(decode-char 'ideograph-daikanwa m-m))
(if (equal pat v)
c))
'morohashi-daikanwa))))
+ (when (setq scs (get-char-attribute char '->subsumptive))
+ (while (and scs
+ (setq sc (car scs))
+ (not
+ (and
+ (setq ret
+ (char-representative-of-daikanwa sc))
+ (or (null radical)
+ (eq (char-ideographic-radical ret radical)
+ radical)
+ (setq ret nil)))))
+ (setq scs (cdr scs)))
+ ret)
char))))
(defun char-attributes-poly< (c1 c2 accessors testers defaulters)
(defun char-daikanwa-strokes (char &optional radical)
(unless radical
(setq radical ideographic-radical))
- (let ((drc (char-representative-of-daikanwa char)))
- (if (= (char-ideographic-radical drc radical)
- (char-ideographic-radical char radical))
+ (let ((drc (char-representative-of-daikanwa char radical))
+ (r (char-ideographic-radical char radical)))
+ (if (or (null r)
+ (= (char-ideographic-radical drc radical) r))
(setq char drc)))
(char-ideographic-strokes char radical '(daikanwa)))
;;;###autoload
-(defun char-daikanwa (char)
+(defun char-daikanwa (char &optional radical)
(or (encode-char char 'ideograph-daikanwa 'defined-only)
(encode-char char '=daikanwa-rev2 'defined-only)
+ (get-char-attribute char 'morohashi-daikanwa)
(let ((ret (char-feature char '=>daikanwa)))
(and ret
(if (or (get-char-attribute char '<-subsumptive)
(get-char-attribute char '<-denotational))
(list ret 0)
ret)))
- (get-char-attribute char 'morohashi-daikanwa)))
+ (let ((scs (get-char-attribute char '->subsumptive))
+ sc ret)
+ (unless radical
+ (setq radical ideographic-radical))
+ (when scs
+ (while (and scs
+ (setq sc (car scs))
+ (not
+ (and
+ (setq ret
+ (char-representative-of-daikanwa sc))
+ (or (null radical)
+ (eq (char-ideographic-radical ret radical)
+ radical)
+ (setq ret nil)))))
+ (setq scs (cdr scs))))
+ (if ret
+ (char-daikanwa ret)))))
;;;###autoload
(defun char-ucs (char)
(or (encode-char char '=ucs 'defined-only)
- (get-char-attribute char '=>ucs)))
+ (char-feature char '=>ucs)))
(defun char-id (char)
(logand (char-int char) #x3FFFFFFF))