Reformatted.

[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 cf1a523..87e2e21 100644 (file)
--- a/lisp/utf-2000/ideograph-util.el
+++ b/lisp/utf-2000/ideograph-util.el
@@ -83,6 +83,7 @@
                 (setq radical (char-ideograph-radical char)))
        (or (get-char-attribute char 'ucs)
            (put-char-attribute char 'ucs i))
+       (char-ideograph-strokes char)
        (if (not (memq char
                       (setq ret
                             (aref ideograph-radical-chars-vector radical))))
@@ -102,18 +103,15 @@
                  (cons char ret))))
       (setq i (1+ i)))
     (setq i 0)
-    (while (< i 256)
-      (setq j 0)
-      (while (< j 256)
-       (setq char (make-char 'ideograph-daikanwa i j))
-       (if (and (setq radical (char-ideograph-radical char))
-                (not
-                 (memq char
-                       (setq ret
-                             (aref ideograph-radical-chars-vector radical)))))
-           (aset ideograph-radical-chars-vector radical
-                 (cons char ret)))
-       (setq j (1+ j)))
+    (while (< i 50101)
+      (setq char (decode-char 'ideograph-daikanwa i))
+      (if (and (setq radical (char-ideograph-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)
@@ -136,21 +134,29 @@
     ))
 
 (defun ideograph-char< (a b)
-  (let (ra rb)
+  (let (ra rb mma mmb msa msb)
     (cond
-     ((setq ra (or (get-char-attribute a 'non-morohashi)
-                  (get-char-attribute a 'morohashi-daikanwa)))
+     ((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
-       ((setq rb (or (get-char-attribute b 'non-morohashi)
-                    (get-char-attribute b 'morohashi-daikanwa)))
+       ((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
-        ((= (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)))
+        ((= 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))
@@ -159,14 +165,15 @@
                                        (< ra rb))
                                       (t))))))))
                 )
-               ((null (car (cdr ra))))
-               ((null (car (cdr rb)))
+               ((null (car msa)))
+               ((null (car msb))
                 nil)
-               (t (< (car (cdr ra))(car (cdr rb))))))
-        (t (< (car ra)(car rb)))))
+               (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 'morohashi-daikanwa)
+         (get-char-attribute b 'ideograph-daikanwa))
       nil)
      ((setq ra (get-char-attribute a 'ucs))
       (cond
@@ -184,9 +191,12 @@
 (defun insert-ideograph-radical-char-data (radical)
   (let ((chars
         (sort (copy-list (aref ideograph-radical-chars-vector radical))
-              (function ideograph-char<))))
+              (function ideograph-char<)))
+       (attributes (sort (char-attribute-list) #'char-attribute-name<))
+       (ccs (sort (charset-list) #'char-attribute-name<)))
+    (aset ideograph-radical-chars-vector radical chars)
     (while chars
-      (insert-char-data (car chars))
+      (insert-char-data (car chars) nil attributes ccs)
       (setq chars (cdr chars)))))
 
 (defun write-ideograph-radical-char-data (radical file)