-;; (defun ideograph-char< (a b)
-;; (let (ra rb mma mmb msa msb)
-;; (cond
-;; ((progn
-;; (if (setq ra (or (get-char-attribute a 'non-morohashi)
-;; (get-char-attribute a 'morohashi-daikanwa)))
-;; (setq msa (cdr ra)
-;; mma (car ra))
-;; (setq mma (get-char-attribute a 'ideograph-daikanwa))))
-;; (cond
-;; ((progn
-;; (if (setq rb (or (get-char-attribute b 'non-morohashi)
-;; (get-char-attribute b 'morohashi-daikanwa)))
-;; (setq msb (cdr rb)
-;; mmb (car rb))
-;; (setq mmb (get-char-attribute b 'ideograph-daikanwa))))
-;; (cond
-;; ((= mma mmb)
-;; (cond ((eq (car msa)(car msb))
-;; (cond ((< (length msa)(length msb)))
-;; ((= (length msa)(length msb))
-;; (cond ((integerp (nth 1 msa))
-;; (cond ((integerp (nth 1 msb))
-;; (< (nth 1 msa)(nth 1 msb)))
-;; (t nil)))
-;; (t
-;; (cond ((setq ra (get-char-attribute a 'ucs))
-;; (cond
-;; ((setq rb (get-char-attribute b 'ucs))
-;; (< ra rb))
-;; (t))))))))
-;; )
-;; ((null (car msa)))
-;; ((null (car msb))
-;; nil)
-;; (t (< (car msa)(car msb)))))
-;; (t (< mma mmb))))
-;; (t)))
-;; ((or (get-char-attribute b 'non-morohashi)
-;; (get-char-attribute b 'morohashi-daikanwa)
-;; (get-char-attribute b 'ideograph-daikanwa))
-;; nil)
-;; ((setq ra (get-char-attribute a 'ucs))
-;; (cond
-;; ((setq rb (get-char-attribute b 'ucs))
-;; (< ra rb))))
-;; (t
-;; (cond
-;; ((setq ra (char-ideographic-strokes a))
-;; (cond ((setq rb (char-ideographic-strokes b))
-;; (cond ((= ra rb)
-;; (not (char-ideographic-strokes b)))
-;; ((< ra rb))))))
-;; )))))
+;; (defun nil>-int< (a b)
+;; (cond ((null a) nil)
+;; ((null b) t)
+;; (t (< a b))))
+
+;;;###autoload
+(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 (get-char-attribute char 'morohashi-daikanwa))
+ m-m m-s pat)
+ (or (when m
+ (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-attributes-poly< (c1 c2 accessors testers defaulters)
+ (catch 'tag
+ (let (a1 a2 accessor tester dm)
+ (while (and accessors testers)
+ (setq accessor (car accessors)
+ tester (car testers)
+ dm (car defaulters))
+ (when (and accessor tester)
+ (setq a1 (funcall accessor c1)
+ a2 (funcall accessor c2))
+ (cond ((null a1)
+ (if a2
+ (cond ((eq dm '<)
+ (throw 'tag t))
+ ((eq dm '>)
+ (throw 'tag nil)))))
+ ((null a2)
+ (cond ((eq dm '<)
+ (throw 'tag nil))
+ ((eq dm '>)
+ (throw 'tag t))))
+ (t
+ (cond ((funcall tester a1 a2)
+ (throw 'tag t))
+ ((funcall tester a2 a1)
+ (throw 'tag nil))))))
+ (setq accessors (cdr accessors)
+ testers (cdr testers)
+ defaulters (cdr defaulters))))))
+
+(defvar ideographic-radical nil)
+
+(defun char-daikanwa-strokes (char &optional radical)
+ (unless radical
+ (setq radical ideographic-radical))
+ (let ((drc (char-representative-of-daikanwa char)))
+ (char-ideographic-strokes
+ (if (= (char-ideographic-radical drc radical)
+ (char-ideographic-radical char radical))
+ drc
+ char)
+ radical)))
+
+;;;###autoload
+(defun char-daikanwa (char)
+ (or (encode-char char 'ideograph-daikanwa 'defined-only)
+ (encode-char char '=daikanwa-rev2 'defined-only)
+ (get-char-attribute char 'morohashi-daikanwa)))
+
+;;;###autoload
+(defun char-ucs (char)
+ (or (encode-char char '=ucs 'defined-only)
+ (get-char-attribute char '=>ucs)))
+
+(defun char-id (char)
+ (logand (char-int char) #x3FFFFFFF))
+
+(defun ideograph-char< (a b &optional radical)
+ (let ((ideographic-radical (or radical
+ ideographic-radical)))
+ (char-attributes-poly<
+ a b
+ '(char-daikanwa-strokes char-daikanwa char-ucs char-id)
+ '(< morohashi-daikanwa< < <)
+ '(> > > >))))