(M-41676): Add `ideograph=' for M-41704; unify M041676; separate

[chise/xemacs-chise.git] / lisp / utf-2000 / ideograph-util.el

diff --git a/lisp/utf-2000/ideograph-util.el b/lisp/utf-2000/ideograph-util.el
index 9bddea0..a03cf12 100644 (file)
--- a/lisp/utf-2000/ideograph-util.el
+++ b/lisp/utf-2000/ideograph-util.el
@@ -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.
@@ -50,28 +50,28 @@
     3  3  3  3  3  3  3  3  3  3
     3  4  4  4  3  4  4  4  4  4
     4  4  4  4  4  4  4  4  4  4
-    4  4  4  4  4  4  4  4  4  4
-    4  4  4  4  4  5  5  5  5  5
+    4  4  4  4  4  3  4  4  4  4
+    4  4  4  4  3  5  4  5  5  5
     ;; 100
     5  5  5  5  5  5  5  5  5  5
     5  5  5  5  5  5  5  5  6  6
     6  6  6  6  6  6  6  6  6  6
-    6  6  6  6  6  6  6  6  6  6
-    6  6  6  6  6  6  6  7  7  7
+    4  6  6  6  6  6  6  6  6  6
+    4  6  6  6  6  6  6  7  7  7
     7  7  7  7  7  7  7  7  7  7
-    7  7  4  3  7  7  7  8  8  8
-    8  8  8  8  8  8  9  9  9  9
-    9  9  9  9  9  9  9 10 10 10
+    7  7  4  3  7  7  7  8  7  8
+    3  8  8  8  8  8  9  9  9  9
+    9  9  9  9  8  9  9 10 10 10
    10 10 10 10 10 11 11 11 11 11
    ;; 200
    11 12 12 12 12 13 13 13 13 14
    14 15 16 16 17])
 
 (defun char-ideographic-strokes (char)
-  (or (get-char-attribute char 'ideographic-strokes)
+  (or (get-char-attribute char 'daikanwa-strokes)
+      (get-char-attribute char 'ideographic-strokes)
       (let ((strokes
-            (or (get-char-attribute char 'daikanwa-strokes)
-                (get-char-attribute char 'kangxi-strokes)
+            (or (get-char-attribute char 'kangxi-strokes)
                 (get-char-attribute char 'japanese-strokes)
                 (get-char-attribute char 'korean-strokes)
                 (let ((r (char-ideographic-radical char))
@@ -145,6 +145,17 @@
          (aset ideograph-radical-chars-vector radical
                (cons char ret)))
       (setq i (1+ i)))
+    (setq i 0)
+    (while (< i (* 94 60 22))
+      (setq char (decode-char 'mojikyo i))
+      (if (and (setq radical (char-ideographic-radical char))
+              (not
+               (memq char
+                     (setq ret
+                           (aref ideograph-radical-chars-vector radical)))))
+         (aset ideograph-radical-chars-vector radical
+               (cons char ret)))
+      (setq i (1+ i)))
     (while charsets
       (setq i 33)
       (while (< i 127)
@@ -174,12 +185,26 @@
        nil)
     (numberp (car b))))
 
+(defun morohashi-daikanwa< (a b)
+  (cond ((eq (car a) 'ho)
+        (if (eq (car b) 'ho)
+            (int-list< (cdr a)(cdr b))
+          nil))
+       ((numberp (car a))
+        (if (eq (car b) 'ho)
+            t
+          (int-list< a b)))
+       (t
+        (if (eq (car b) 'ho)
+            t
+          (int-list< a b)))))
+
 (defun ideograph-char< (a b)
   (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)
+       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))
@@ -188,8 +213,12 @@
            (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)))
@@ -203,8 +232,12 @@
            (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)))
@@ -215,8 +248,8 @@
            (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))
+                       (morohashi-daikanwa< (cons a-m-m a-m-r)
+                                            (cons b-m-m b-m-r))
                      t)
                  (if b-m-m
                      nil