update.

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

diff --git a/lisp/utf-2000/char-db-util.el b/lisp/utf-2000/char-db-util.el
index 9a7e22b..4b557b7 100644 (file)
--- a/lisp/utf-2000/char-db-util.el
+++ b/lisp/utf-2000/char-db-util.el
@@ -1,7 +1,7 @@
 ;;; char-db-util.el --- Character Database utility -*- coding: utf-8-er; -*-
 
 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
-;;   2007, 2008 MORIOKA Tomohiko.
+;;   2007, 2008, 2009 MORIOKA Tomohiko.
 
 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
 ;; Keywords: CHISE, Character Database, ISO/IEC 10646, UCS, Unicode, MULE.
@@ -155,34 +155,27 @@
     )
    ((find-charset ka)
     (if (find-charset kb)
-       (if (<= (charset-id ka) 1)
-           (if (<= (charset-id kb) 1)
-               (cond
-                ((= (charset-dimension ka)
-                    (charset-dimension kb))
-                 (> (charset-id ka)(charset-id kb)))
-                (t
-                 (> (charset-dimension ka)
-                    (charset-dimension kb))
-                 ))
-             t)
-         (if (<= (charset-id kb) 1)
-             nil
-           (cond
-            ((and (charset-final ka)
-                  (>= (charset-final ka) ?@))
-             (if (and (charset-final kb)
-                      (>= (charset-final kb) ?@))
-                 (< (charset-final ka)(charset-final kb))
-               t))
-            ((and (charset-final kb)
-                  (>= (charset-final kb) ?@))
-             nil)
-            (t
-             (< (charset-id ka)(charset-id kb))))))
-      nil))
-   ((find-charset kb)
-    t)
+       (let (a-ir b-ir)
+         (if (setq a-ir (charset-property ka 'iso-ir))
+             (if (setq b-ir (charset-property kb 'iso-ir))
+                 (cond
+                  ((= a-ir b-ir)
+                   (< (charset-id ka)(charset-id kb))
+                   )
+                  ((= a-ir 177)
+                   t)
+                  ((= b-ir 177)
+                   nil)
+                  ((< a-ir
+                      b-ir)
+                   ))
+               t)
+           (if (charset-property kb 'iso-ir)
+               nil
+             (< (charset-id ka)(charset-id kb)))))
+      nil)
+    )
+   ((find-charset kb))
    ((symbolp ka)
     (cond ((symbolp kb)
           (string< (symbol-name ka)
@@ -285,7 +278,8 @@
                                         =daikanwa@rev2
                                         ;; =gt-k
                                         =jis-x0208@1997
-                                        )))
+                                        ))
+                                (string-match "=ucs@" (symbol-name ccs)))
                             (setq ccs (charset-name ccs))
                             (null (assq ccs char-spec))
                             (setq ret (encode-char char ccs 'defined-only)))
@@ -298,6 +292,12 @@
                        ((setq ret (get-char-attribute char 'name*))
                         (setq char-spec (cons (cons 'name* ret) char-spec))
                         ))
+                 )
+                ((setq ret (get-char-attribute
+                            char 'ideographic-combination))
+                 (setq char-spec
+                       (cons (cons 'ideographic-combination ret)
+                             char-spec))
                  ))
           char-spec)
          ((consp char)
@@ -488,7 +488,7 @@
           "(%-18s . %04d)\t; %c")
          ((or (memq name '(=daikanwa
                            =daikanwa@rev1 =daikanwa@rev2
-                           =gt =gt-k =cbeta =zinbun-oracle))
+                           =gt <=>gt =gt-k =cbeta =zinbun-oracle))
               (string-match "^=adobe-" (symbol-name name)))
           "(%-18s . %05d)\t; %c")
          ((eq name 'mojikyo)