(ideograph-char<): Don't use daikanwa-strokes if ideographic-radical
authortomo <tomo>
Wed, 30 May 2001 08:43:14 +0000 (08:43 +0000)
committertomo <tomo>
Wed, 30 May 2001 08:43:14 +0000 (08:43 +0000)
and daikanwa-radical are different.

lisp/utf-2000/ideograph-util.el

index 1fdf8ef..98be81e 100644 (file)
@@ -1,6 +1,6 @@
 ;;; ideograph-util.el --- Ideographic Character Database utility
 
-;; Copyright (C) 1999,2000 MORIOKA Tomohiko.
+;; Copyright (C) 1999,2000,2001 MORIOKA Tomohiko.
 
 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
 ;; Keywords: UTF-2000, ISO/IEC 10646, Unicode, UCS-4, MULE.
        (b-m-m (get-char-attribute b 'ideograph-daikanwa))
        a-m-r b-m-r
        a-s b-s
-       a-u b-u m)
+       a-u b-u m ret)
     (if a-m-m
        (setq a-s (char-ideographic-strokes a))
       (setq a-m-r (get-char-attribute a 'morohashi-daikanwa))
            (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)))
+               (progn
+                 (setq ret (decode-char 'ideograph-daikanwa a-m-m))
+                 (if (= (get-char-attribute ret 'ideographic-radical)
+                        (get-char-attribute a 'ideographic-radical))
+                     (setq a-s (char-ideographic-strokes ret))
+                   (setq a-s (char-ideographic-strokes a))))
              (if (setq m (get-char-attribute a '->mojikyo))
                  (setq a-s (char-ideographic-strokes
                             (decode-char 'mojikyo m)))
            (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)))
+               (progn
+                 (setq ret (decode-char 'ideograph-daikanwa b-m-m))
+                 (if (= (get-char-attribute ret 'ideographic-radical)
+                        (get-char-attribute b 'ideographic-radical))
+                     (setq b-s (char-ideographic-strokes ret))
+                   (setq b-s (char-ideographic-strokes b))))
              (if (setq m (get-char-attribute b '->mojikyo))
                  (setq b-s (char-ideographic-strokes
                             (decode-char 'mojikyo m)))