- (let (ra rb)
- (cond
- ((setq ra (or (get-char-attribute a 'non-morohashi)
- (get-char-attribute a 'morohashi-daikanwa)))
- (cond
- ((setq rb (or (get-char-attribute b 'non-morohashi)
- (get-char-attribute b 'morohashi-daikanwa)))
- (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)))))
- (t)))
- ((or (get-char-attribute b 'non-morohashi)
- (get-char-attribute b 'morohashi-daikanwa))
- nil)
- ((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-m (get-char-attribute a 'ideograph-daikanwa))
+ (b-m-m (get-char-attribute b 'ideograph-daikanwa))
+ a-m-r b-m-r
+ a-s b-s
+ a-u b-u m)
+ (if a-m-m
+ (setq a-s (char-ideographic-strokes a))
+ (setq a-m-r (get-char-attribute a 'morohashi-daikanwa))
+ (if a-m-r
+ (progn
+ (setq a-m-m (car a-m-r)
+ a-m-r (cdr a-m-r))
+ (if (= (car a-m-r) 0)
+ (setq a-s (char-ideographic-strokes
+ (decode-char 'ideograph-daikanwa a-m-m)))
+ (if (setq m (get-char-attribute a '->mojikyo))
+ (setq a-s (char-ideographic-strokes
+ (decode-char 'mojikyo m)))
+ (setq a-s (char-ideographic-strokes a)))))
+ (setq a-s (char-ideographic-strokes a))))
+ (if b-m-m
+ (setq b-s (char-ideographic-strokes b))
+ (setq b-m-r (get-char-attribute b 'morohashi-daikanwa))
+ (if b-m-r
+ (progn
+ (setq b-m-m (car b-m-r)
+ b-m-r (cdr b-m-r))
+ (if (= (car b-m-r) 0)
+ (setq b-s (char-ideographic-strokes
+ (decode-char 'ideograph-daikanwa b-m-m)))
+ (if (setq m (get-char-attribute b '->mojikyo))
+ (setq b-s (char-ideographic-strokes
+ (decode-char 'mojikyo m)))
+ (setq b-s (char-ideographic-strokes b)))))
+ (setq b-s (char-ideographic-strokes b))))
+ (if a-s
+ (if b-s
+ (if (= a-s b-s)
+ (if a-m-m
+ (if b-m-m
+ (int-list< (cons a-m-m a-m-r)
+ (cons b-m-m b-m-r))
+ t)
+ (if b-m-m
+ 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 (get-char-attribute b '->ucs))
+ (if b-u
+ (<= a-u b-u)
+ t))
+ (setq a-u (get-char-attribute a '->ucs))
+ (if a-u
+ (if b-u
+ (< a-u b-u)
+ (setq b-u (get-char-attribute b '->ucs))
+ (if b-u
+ (< a-u b-u)
+ t))
+ (if (or b-u (get-char-attribute b '->ucs))
+ nil
+ (< (char-int a)(char-int b)))))))
+ (< a-s b-s))
+ t))))
+
+;; (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))))))
+;; )))))