Rename `<-ancient-ideograph' to `<-ancient'.

[chise/xemacs-chise.git.1] / 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 a5d8195..d0e521a 100644 (file)
--- a/lisp/utf-2000/char-db-util.el
+++ b/lisp/utf-2000/char-db-util.el
@@ -73,7 +73,7 @@
 
 (defvar char-db-feature-domains
   '(ucs daikanwa cns gt jis jis/alt jis/a jis/b
-       jis-x0213 misc unknown))
+       jis-x0213 cdp shinjigen misc unknown))
 
 (defvar char-db-ignored-attributes nil)
 
@@ -89,8 +89,8 @@
     nil)
    ((find-charset ka)
     (if (find-charset kb)
-       (if (<= (charset-id ka) 0)
-           (if (<= (charset-id kb) 0)
+       (if (<= (charset-id ka) 1)
+           (if (<= (charset-id kb) 1)
                (cond
                 ((= (charset-dimension ka)
                     (charset-dimension kb))
@@ -100,7 +100,7 @@
                     (charset-dimension kb))
                  ))
              t)
-         (if (<= (charset-id kb) 0)
+         (if (<= (charset-id kb) 1)
              nil
            (< (charset-id ka)(charset-id kb))))
       nil))
@@ -392,10 +392,43 @@
 
 (defvar char-db-convert-obsolete-format t)
 
+(defun char-db-insert-ccs-feature (name value line-breaking)
+  (insert
+   (format
+    (cond ((memq name '(=daikanwa
+                       =daikanwa-rev1 =daikanwa-rev2
+                       =gt =gt-k =cbeta))
+          "(%-18s . %05d)\t; %c")
+         ((eq name 'mojikyo)
+          "(%-18s . %06d)\t; %c")
+         ((>= (charset-dimension name) 2)
+          "(%-18s . #x%04X)\t; %c")
+         (t
+          "(%-18s . #x%02X)\t; %c"))
+    name
+    (if (= (charset-iso-graphic-plane name) 1)
+       (logior value
+               (cond ((= (charset-dimension name) 1)
+                      #x80)
+                     ((= (charset-dimension name) 2)
+                      #x8080)
+                     ((= (charset-dimension name) 3)
+                      #x808080)
+                     (t 0)))
+      value)
+    (char-db-decode-isolated-char name value)))
+  (if (and (= (charset-chars name) 94)
+          (= (charset-dimension name) 2))
+      (insert (format " [%02d-%02d]"
+                     (- (lsh value -8) 32)
+                     (- (logand value 255) 32))))
+  (insert line-breaking))
+
 (defun insert-char-attributes (char &optional readable attributes column)
   (unless column
     (setq column (current-column)))
-  (let (name value has-long-ccs-name rest
+  (let (name value ; has-long-ccs-name
+       rest
        radical strokes
        (line-breaking
         (concat "\n" (make-string (1+ column) ?\ )))
@@ -863,39 +896,41 @@
                          (prog1
                              (setq value (get-char-attribute char name))
                            (setq dest-ccss (cons name dest-ccss))))
-                    (insert
-                     (format
-                      (cond ((memq name '(=daikanwa
-                                          =daikanwa-rev1 =daikanwa-rev2
-                                          =gt =gt-k =cbeta))
-                             (if has-long-ccs-name
-                                 "(%-26s . %05d)\t; %c%s"
-                               "(%-18s . %05d)\t; %c%s"))
-                            ((eq name 'mojikyo)
-                             (if has-long-ccs-name
-                                 "(%-26s . %06d)\t; %c%s"
-                               "(%-18s . %06d)\t; %c%s"))
-                            ((>= (charset-dimension name) 2)
-                             (if has-long-ccs-name
-                                 "(%-26s . #x%04X)\t; %c%s"
-                               "(%-18s . #x%04X)\t; %c%s"))
-                            (t
-                             (if has-long-ccs-name
-                                 "(%-26s . #x%02X)\t; %c%s"
-                               "(%-18s . #x%02X)\t; %c%s")))
-                      name
-                      (if (= (charset-iso-graphic-plane name) 1)
-                          (logior value
-                                  (cond ((= (charset-dimension name) 1)
-                                         #x80)
-                                        ((= (charset-dimension name) 2)
-                                         #x8080)
-                                        ((= (charset-dimension name) 3)
-                                         #x808080)
-                                        (t 0)))
-                        value)
-                      (char-db-decode-isolated-char name value)
-                      line-breaking)))
+                    (char-db-insert-ccs-feature name value line-breaking)
+                     ;; (insert
+                     ;;  (format
+                     ;;   (cond ((memq name '(=daikanwa
+                     ;;                       =daikanwa-rev1 =daikanwa-rev2
+                     ;;                       =gt =gt-k =cbeta))
+                     ;;          (if has-long-ccs-name
+                     ;;              "(%-26s . %05d)\t; %c%s"
+                     ;;            "(%-18s . %05d)\t; %c%s"))
+                     ;;         ((eq name 'mojikyo)
+                     ;;          (if has-long-ccs-name
+                     ;;              "(%-26s . %06d)\t; %c%s"
+                     ;;            "(%-18s . %06d)\t; %c%s"))
+                     ;;         ((>= (charset-dimension name) 2)
+                     ;;          (if has-long-ccs-name
+                     ;;              "(%-26s . #x%04X)\t; %c%s"
+                     ;;            "(%-18s . #x%04X)\t; %c%s"))
+                     ;;         (t
+                     ;;          (if has-long-ccs-name
+                     ;;              "(%-26s . #x%02X)\t; %c%s"
+                     ;;            "(%-18s . #x%02X)\t; %c%s")))
+                     ;;   name
+                     ;;   (if (= (charset-iso-graphic-plane name) 1)
+                     ;;       (logior value
+                     ;;               (cond ((= (charset-dimension name) 1)
+                     ;;                      #x80)
+                     ;;                     ((= (charset-dimension name) 2)
+                     ;;                      #x8080)
+                     ;;                     ((= (charset-dimension name) 3)
+                     ;;                      #x808080)
+                     ;;                     (t 0)))
+                     ;;     value)
+                     ;;   (char-db-decode-isolated-char name value)
+                     ;;   line-breaking))
+                    )
                 )
                ((string-match "^=>ucs@" (symbol-name name))
                 (insert (format "(%-18s . #x%04X)\t; %c%s"
@@ -908,8 +943,17 @@
                                 line-breaking))
                 )
                ((and (not readable)
+                     (null (get-char-attribute
+                            char
+                            (intern (format "%s*sources" name))))
+                     (not (string-match "\\*sources$" (symbol-name name)))
                      (or (eq name '<-identical)
-                         (string-match "^->simplified" (symbol-name name))))
+                         (string-match "^->simplified" (symbol-name name))
+                         (string-match "^<-same" (symbol-name name))
+                         (string-match "^->vulgar" (symbol-name name))
+                         (string-match "^->wrong" (symbol-name name))
+                         (string-match "^->original" (symbol-name name))
+                         ))
                 )
                ((or (eq name 'ideographic-structure)
                     (eq name 'ideographic-)
@@ -946,11 +990,8 @@
                          (setq required-features nil)
                          (dolist (source sources)
                            (cond
-                            ((find-charset
-                              (setq ret (intern (format "=%s" source))))
-                             (setq required-features
-                                   (cons ret required-features)))
-                            ((memq source '(JP JP/Jouyou))
+                            ((memq source '(JP JP/Jouyou
+                                               shinjigen-1))
                              (setq required-features
                                    (union required-features
                                           '(=jis-x0208
@@ -965,7 +1006,12 @@
                                    (union required-features
                                           '(=gb2312
                                             =gb12345
-                                            =iso-ir165))))
+                                            =iso-ir165)))))
+                           (cond
+                            ((find-charset
+                              (setq ret (intern (format "=%s" source))))
+                             (setq required-features
+                                   (cons ret required-features)))
                             (t (setq required-features
                                      (cons source required-features)))))
                          (cond ((string-match "@JP" (symbol-name name))