(setq dest (cons pc dest))))
dest)
(list chr))
- (get-char-attribute chr '<-identical)
- (get-char-attribute chr '->denotational)))
+ (let ((rest (append
+ (get-char-attribute chr '<-identical)
+ (get-char-attribute chr '->denotational)))
+ pc)
+ (setq dest nil)
+ (while rest
+ (setq pc (car rest))
+ (if (memq pc dest)
+ (setq rest (cdr rest))
+ (setq dest (cons pc dest))
+ (setq rest
+ (append (cdr rest)
+ (get-char-attribute
+ pc '<-identical)
+ (get-char-attribute
+ pc '->denotational)))))
+ dest)))
(when (and radical
(or (eq radical
(or (get-char-attribute
(char-ideographic-strokes char radical '(daikanwa)))
;;;###autoload
-(defun char-daikanwa (char &optional radical)
+(defun char-daikanwa (char &optional radical checked)
(unless radical
(setq radical ideographic-radical))
- (map-char-family
- (lambda (sc)
- (if (or (null radical)
- (eq (or (get-char-attribute sc 'ideographic-radical)
- (char-ideographic-radical sc radical t))
- radical))
- (let ((ret (or (encode-char sc 'ideograph-daikanwa 'defined-only)
- (encode-char sc '=daikanwa-rev2 'defined-only))))
- (if ret
- (if (or (eq sc char)
- (and (null (get-char-attribute char '<-subsumptive))
- (null (get-char-attribute char '<-denotational))))
- ret
- (list ret 0))
- (or (get-char-attribute sc 'morohashi-daikanwa)
- (if (setq ret (char-feature sc '=>daikanwa))
- (cond ((consp ret) ret)
- ((or (get-char-attribute char '<-subsumptive)
- (get-char-attribute char '<-denotational))
- (list ret 0))
- (t ret))))))))
- char))
+ (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)
+ (get-char-attribute char 'morohashi-daikanwa))))
+ (or ret
+ (and (setq ret (get-char-attribute char '=>daikanwa))
+ (if (numberp ret)
+ (list ret 0)
+ (append ret '(0))))
+ (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-daikanwa sc radical 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-daikanwa sc radical checked))
+ (throw 'tag
+ (if (numberp ret)
+ (list ret 0)
+ (append ret (list i)))))
+ (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-daikanwa sc radical checked))
+ (throw 'tag
+ (if (numberp ret)
+ (list ret 0 i)
+ (append ret (list i)))))
+ (setq checked (cons sc checked)
+ rest (cdr rest))))))))))
;;;###autoload
(defun char-ucs (char)
(defun write-ideograph-radical-char-data (radical file)
(if (file-directory-p file)
- (let ((name (get-char-attribute (int-char (+ #x2EFF radical)) 'name)))
+ (let ((name (char-feature (decode-char 'ucs (+ #x2EFF radical))
+ 'name)))
(if (string-match "KANGXI RADICAL " name)
(setq name (capitalize (substring name (match-end 0)))))
(setq name (mapconcat (lambda (char)
(format "Ideograph-R%03d-%s.el" radical name)
file))))
(with-temp-buffer
- (insert ";; -*- coding: utf-8-mcs -*-\n")
+ (insert (format ";; -*- coding: %s -*-\n"
+ char-db-file-coding-system))
(insert-ideograph-radical-char-data radical)
- (let ((coding-system-for-write 'utf-8-mcs))
- (write-region (point-min)(point-max) file)
- )))
+ (let ((coding-system-for-write char-db-file-coding-system))
+ (write-region (point-min)(point-max) file))))
(defun ideographic-structure= (char1 char2)
(if (char-ref-p char1)