- (let (ra rb)
- (cond
- ((setq ra (or (get-char-attribute a 'morohashi-daikanwa)
- (get-char-attribute a 'non-morohashi)))
- (cond
- ((setq rb (or (get-char-attribute b 'morohashi-daikanwa)
- (get-char-attribute b 'non-morohashi)))
- (cond
- ((= (car ra)(car rb))
- (cond ((eq (car (cdr ra))(car (cdr rb)))
- (cond ((< (length ra)(length rb)))
- ((= (length ra)(length rb))
- (cond ((integerp (nth 2 ra))
- (cond ((integerp (nth 2 rb))
- (< (nth 2 ra)(nth 2 rb)))
- (t nil)))
- (t
- (cond ((setq ra (get-char-attribute a 'ucs))
- (cond
- ((setq rb (get-char-attribute b 'ucs))
- (< ra rb))
- (t))))))))
- )
- ((null (car (cdr ra))))
- ((null (car (cdr rb)))
- nil)
- (t (< (car (cdr ra))(car (cdr rb))))))
- (t (< (car ra)(car rb)))))
- ((setq ra (get-char-attribute a 'ucs))
- (cond
- ((setq rb (get-char-attribute b 'ucs))
- (< ra rb))))
- (t
- (cond
- ((setq ra (char-ideograph-strokes a))
- (cond ((setq rb (char-ideograph-strokes b))
- (cond ((= ra rb)
- (not (char-ideograph-strokes b)))
- ((< ra rb))))))
- )))))))
+ (let (a-m b-m a-s b-s a-u b-u ret)
+ (setq ret (char-representative-of-daikanwa a))
+ (setq a-s (char-ideographic-strokes
+ (if (= (get-char-attribute ret 'ideographic-radical)
+ (get-char-attribute a 'ideographic-radical))
+ ret
+ a)))
+ (setq ret (char-representative-of-daikanwa b))
+ (setq b-s (char-ideographic-strokes
+ (if (= (get-char-attribute ret 'ideographic-radical)
+ (get-char-attribute b 'ideographic-radical))
+ ret
+ b)))
+ (if a-s
+ (if b-s
+ (if (= a-s b-s)
+ (if (setq a-m (or (get-char-attribute a 'ideograph-daikanwa)
+ (get-char-attribute a 'morohashi-daikanwa)))
+ (if (setq b-m
+ (or (get-char-attribute b 'ideograph-daikanwa)
+ (get-char-attribute b 'morohashi-daikanwa)))
+ (morohashi-daikanwa< a-m b-m)
+ t)
+ (if (setq b-m
+ (or (get-char-attribute b 'ideograph-daikanwa)
+ (get-char-attribute b 'morohashi-daikanwa)))
+ nil
+ (setq a-u (get-char-attribute a 'ucs)
+ b-u (get-char-attribute b 'ucs))
+ (if a-u
+ (if b-u
+ (< a-u b-u)
+ (setq b-u (or (get-char-attribute b '=>ucs)
+ (get-char-attribute b '->ucs)))
+ (if b-u
+ (<= a-u b-u)
+ t))
+ (setq a-u (or (get-char-attribute a '=>ucs)
+ (get-char-attribute a '->ucs)))
+ (if a-u
+ (if b-u
+ (< a-u b-u)
+ (setq b-u (or (get-char-attribute b '=>ucs)
+ (get-char-attribute b '->ucs)))
+ (if b-u
+ (< a-u b-u)
+ t))
+ (if (or b-u (or (get-char-attribute b '=>ucs)
+ (get-char-attribute b '->ucs)))
+ nil
+ (< (char-int a)(char-int b)))))))
+ (< a-s b-s))
+ t))))