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 ad804fb..c18d2f0 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,61 +155,27 @@
     )
    ((find-charset ka)
     (if (find-charset kb)
-       (if (or (<= (charset-id ka) 1)
-               (and (charset-final ka)
-                    (>= (charset-final ka) ?@)))
-           (if (or (<= (charset-id kb) 1)
-                   (and (charset-final kb)
-                        (>= (charset-final kb) ?@)))
-               (cond
-                ((= (charset-dimension ka)
-                    (charset-dimension kb))
-                 (if (and (<= (charset-id ka) 1)
-                          (<= (charset-id kb) 1))
-                     (> (charset-id ka)(charset-id kb))
-                   (if (and (charset-final ka)
-                            (charset-final kb))
-                       (cond
-                        ((= (charset-final ka)(charset-final kb))
-                         (if (<= (charset-id ka) 1)
-                             (if (<= (charset-id kb) 1)
-                                 (> (charset-id ka)(charset-id kb))
-                               t)
-                           (if (<= (charset-id kb) 1)
-                               nil
-                             (< (charset-id ka)(charset-id kb))))
-                         )
-                        ((< (charset-final ka)(charset-final kb))
-                         ))
-                     (if (<= (charset-id ka) 1)
-                         (if (<= (charset-id kb) 1)
-                             (> (charset-id ka)(charset-id kb))
-                           t)
-                       (if (<= (charset-id kb) 1)
-                           nil
-                         (cond ((and (charset-final ka)
-                                     (>= (charset-final ka) ?@))
-                                t)
-                               ((and (charset-final kb)
-                                     (>= (charset-final kb) ?@))
-                                nil)
-                               (t
-                                (< (charset-id ka)(charset-id kb))
-                                ))))))
-                 )
-                (t
-                 (> (charset-dimension ka)
-                    (charset-dimension kb))
-                 ))
-             t)
-         (if (or (<= (charset-id kb) 1)
-                 (and (charset-final kb)
-                      (>= (charset-final kb) ?@)))
-             nil
-           (< (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)
@@ -243,8 +209,10 @@
     chinese-cns11643-5
     chinese-cns11643-6
     chinese-cns11643-7
-    =jis-x0213-1-2000
-    =jis-x0213-2-2000
+    =jis-x0213-1
+    =jis-x0213-1@2000
+    =jis-x0213-1@2004
+    =jis-x0213-2
     korean-ksc5601
     chinese-isoir165
     katakana-jisx0201
@@ -254,6 +222,7 @@
     ethiopic-ucs
     =big5-cdp
     =gt
+    =>>gt
     ideograph-daikanwa-2
     ideograph-daikanwa
     =cbeta
@@ -272,12 +241,21 @@
     =gt-k
     =ucs@iso
     =ucs@unicode
+    =>>jis-x0208
+    =>jis-x0208
+    =>jis-x0208@1997
+    =>>jis-x0213-1
+    =>jis-x0213-1
+    =>jis-x0213-1@2000
+    =>jis-x0213-1@2004
+    =>>jis-x0213-2
+    =>jis-x0213-2
     =big5
     =big5-eten
-    =jis-x0208@1997
     =zinbun-oracle
     =ruimoku-v6
-    =jef-china3))
+    =jef-china3
+    =shinjigen))
 
 (defun char-db-make-char-spec (char)
   (let (ret char-spec)
@@ -312,7 +290,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)))
@@ -521,7 +500,7 @@
           "(%-18s . %04d)\t; %c")
          ((or (memq name '(=daikanwa
                            =daikanwa@rev1 =daikanwa@rev2
-                           =gt =gt-k =cbeta =zinbun-oracle))
+                           =gt =>>gt =>gt =gt-k =cbeta =zinbun-oracle))
               (string-match "^=adobe-" (symbol-name name)))
           "(%-18s . %05d)\t; %c")
          ((eq name 'mojikyo)