(char-attribute-name<): Put `->denotational' into the last place and

`->subsumptive' is second to last.
(char-db-make-char-spec): Use `=daikanwa' instead of
`ideograph-daikanwa'.
(char-db-insert-char-spec): Modify for `insert-char-attributes'.
(char-db-insert-alist): Likewise.
(insert-char-attributes): Delete optional argument `ccs-attributes';
CCS-features are also specified in `attributes'.
(insert-char-data): Likewise.

diff --git a/lisp/utf-2000/char-db-util.el b/lisp/utf-2000/char-db-util.el
index fe5ab7b..5aaa6e2 100644 (file)
--- a/lisp/utf-2000/char-db-util.el
+++ b/lisp/utf-2000/char-db-util.el
@@ -98,6 +98,14 @@
       nil)
      (t
       t)))
       nil)
      (t
       t)))

+   ((eq '->denotational kb)
+    t)
+   ((eq '->subsumptive kb)
+    (not (eq '->denotational ka)))
+   ((eq '->denotational ka)
+    nil)
+   ((eq '->subsumptive ka)
+    nil)

    ((find-charset kb)
     t)
    ((symbolp ka)
    ((find-charset kb)
     t)
    ((symbolp ka)

@@ -193,7 +201,7 @@
                  (dolist (ccs (delq (car ret) (charset-list)))
                    (if (and (or (charset-iso-final-char ccs)
                                 (memq ccs
                  (dolist (ccs (delq (car ret) (charset-list)))
                    (if (and (or (charset-iso-final-char ccs)
                                 (memq ccs

-                                      '(ideograph-daikanwa
+                                      '(=daikanwa

                                         =daikanwa-rev2
                                         ;; =gt-k
                                         )))
                                         =daikanwa-rev2
                                         ;; =gt-k
                                         )))

@@ -228,37 +236,40 @@
                                         char-spec)))
       (remove-char-attribute temp-char 'ideograph-daikanwa)
       (setq char temp-char))
                                         char-spec)))
       (remove-char-attribute temp-char 'ideograph-daikanwa)
       (setq char temp-char))

-    (setq al nil
-         cal nil)
-    (while char-spec
-      (setq key (car (car char-spec)))
-      (unless (memq key char-db-ignored-attributes)
-       (if (find-charset key)
-           (if (encode-char char key 'defined-only)
-               (setq cal (cons key cal)))
-         (setq al (cons key al))))
-      (setq char-spec (cdr char-spec)))
-    (unless cal
-      (setq char-spec (char-db-make-char-spec char))
-      (while char-spec
-       (setq key (car (car char-spec)))
-       (unless (memq key char-db-ignored-attributes)
-         (if (find-charset key)
-             (setq cal (cons key cal))
-           (setq al (cons key al))))
-       (setq char-spec (cdr char-spec)))
-      )
-    (unless (or cal
-               (memq 'ideographic-structure al))
-      (push 'ideographic-structure al))
-    (dolist (feature required-features)
-      (if (find-charset feature)
-         (if (encode-char char feature 'defined-only)
-             (setq cal (adjoin feature cal)))
-       (setq al (adjoin feature al))))
+    ;; (setq al nil
+    ;;       cal nil)
+    ;; (while char-spec
+    ;;   (setq key (car (car char-spec)))
+    ;;   (unless (memq key char-db-ignored-attributes)
+    ;;     (if (find-charset key)
+    ;;         (if (encode-char char key 'defined-only)
+    ;;             (setq cal (cons key cal)))
+    ;;       (setq al (cons key al))))
+    ;;   (setq char-spec (cdr char-spec)))
+    ;; (unless cal
+    ;;   (setq char-spec (char-db-make-char-spec char))
+    ;;   (while char-spec
+    ;;     (setq key (car (car char-spec)))
+    ;;     (unless (memq key char-db-ignored-attributes)
+    ;;       (if (find-charset key)
+    ;;           (setq cal (cons key cal))
+    ;;         (setq al (cons key al))))
+    ;;     (setq char-spec (cdr char-spec)))
+    ;;   )
+    ;; (unless (or cal
+    ;;             (memq 'ideographic-structure al))
+    ;;   (push 'ideographic-structure al))
+    ;; (dolist (feature required-features)
+    ;;   (if (find-charset feature)
+    ;;       (if (encode-char char feature 'defined-only)
+    ;;           (setq cal (adjoin feature cal)))
+    ;;     (setq al (adjoin feature al))))

     (insert-char-attributes char
                            readable
     (insert-char-attributes char
                            readable

-                           (or al 'none) cal)
+                            ;; (or al 'none) cal
+                           (union (mapcar #'car char-spec)
+                                  required-features)
+                           )

     (when temp-char
       ;; undefine temporary character
       ;;   Current implementation is dirty.
     (when temp-char
       ;; undefine temporary character
       ;;   Current implementation is dirty.

@@ -273,7 +284,8 @@
   (let ((line-breaking
         (concat "\n" (make-string (1+ column) ?\ )))
        name value
   (let ((line-breaking
         (concat "\n" (make-string (1+ column) ?\ )))
        name value

-       ret al cal key
+       ret al ; cal
+       key

        lbs cell rest separator)
     (insert "(")
     (while alist
        lbs cell rest separator)
     (insert "(")
     (while alist

@@ -289,13 +301,15 @@
                         cal nil)
                   (while value
                     (setq key (car (car value)))
                         cal nil)
                   (while value
                     (setq key (car (car value)))

-                    (if (find-charset key)
-                        (setq cal (cons key cal))
-                      (setq al (cons key al)))
+                     ;; (if (find-charset key)
+                     ;;     (setq cal (cons key cal))
+                    (setq al (cons key al))
+                    ;; )

                     (setq value (cdr value)))
                   (insert-char-attributes ret
                                           readable
                     (setq value (cdr value)))
                   (insert-char-attributes ret
                                           readable

-                                          (or al 'none) cal))
+                                          (or al 'none) ; cal
+                                          ))

               (insert (prin1-to-string value)))
             (insert ")")
             (insert line-breaking))
               (insert (prin1-to-string value)))
             (insert ")")
             (insert line-breaking))

@@ -316,15 +330,17 @@
                           cal nil)
                     (while rest
                       (setq key (car (car rest)))
                           cal nil)
                     (while rest
                       (setq key (car (car rest)))

-                      (if (find-charset key)
-                          (setq cal (cons key cal))
-                        (setq al (cons key al)))
+                       ;; (if (find-charset key)
+                       ;;     (setq cal (cons key cal))
+                      (setq al (cons key al))
+                      ;; )

                       (setq rest (cdr rest)))
                     (if separator
                         (insert lbs))
                     (insert-char-attributes ret
                                             readable
                       (setq rest (cdr rest)))
                     (if separator
                         (insert lbs))
                     (insert-char-attributes ret
                                             readable

-                                            al cal)
+                                            al ; cal
+                                            )

                     (setq separator lbs))
                 (if separator
                     (insert separator))
                     (setq separator lbs))
                 (if separator
                     (insert separator))

@@ -406,10 +422,8 @@
 
 (defvar char-db-convert-obsolete-format t)
 
 
 (defvar char-db-convert-obsolete-format t)
 

-(defun insert-char-attributes (char &optional readable
-                                   attributes ccs-attributes
-                                   column)
-  (let (atr-d ccs-d)
+(defun insert-char-attributes (char &optional readable attributes column)
+  (let (atr-d)

     (setq attributes
          (sort (if attributes
                    (if (consp attributes)
     (setq attributes
          (sort (if attributes
                    (if (consp attributes)

@@ -420,25 +434,8 @@
                          atr-d))
                  (dolist (name (char-attribute-list))
                    (unless (memq name char-db-ignored-attributes)
                          atr-d))
                  (dolist (name (char-attribute-list))
                    (unless (memq name char-db-ignored-attributes)

-                     (if (find-charset name)
-                         (push name ccs-d)
-                       (push name atr-d))))
+                     (push name atr-d)))

                  atr-d)
                  atr-d)

-               #'char-attribute-name<))
-    (setq ccs-attributes
-         (sort (if ccs-attributes
-                   (progn
-                     (setq ccs-d nil)
-                     (dolist (name ccs-attributes)
-                       (unless (memq name char-db-ignored-attributes)
-                         (push name ccs-d)))
-                     ccs-d)
-                 (or ccs-d
-                     (progn
-                       (dolist (name (charset-list))
-                         (unless (memq name char-db-ignored-attributes)
-                           (push name ccs-d)))
-                       ccs-d)))

                #'char-attribute-name<)))
   (unless column
     (setq column (current-column)))
                #'char-attribute-name<)))
   (unless column
     (setq column (current-column)))

@@ -860,22 +857,62 @@
       (dolist (ignored '(composition
                         ->denotational <-subsumptive ->ucs-unified))
        (setq attributes (delq ignored attributes))))
       (dolist (ignored '(composition
                         ->denotational <-subsumptive ->ucs-unified))
        (setq attributes (delq ignored attributes))))

-    (setq rest ccs-attributes)
-    (while (and rest
-               (progn
-                 (setq value (get-char-attribute char (car rest)))
-                 (if value
-                     (if (>= (length (symbol-name (car rest))) 19)
-                         (progn
-                           (setq has-long-ccs-name t)
-                           nil)
-                       t)
-                   t)))
-      (setq rest (cdr rest)))
+    ;; (setq rest ccs-attributes)
+    ;; (while (and rest
+    ;;             (progn
+    ;;               (setq value (get-char-attribute char (car rest)))
+    ;;               (if value
+    ;;                   (if (>= (length (symbol-name (car rest))) 19)
+    ;;                       (progn
+    ;;                         (setq has-long-ccs-name t)
+    ;;                         nil)
+    ;;                     t)
+    ;;                 t)))
+    ;;   (setq rest (cdr rest)))

     (while attributes
       (setq name (car attributes))
       (if (setq value (get-char-attribute char name))
     (while attributes
       (setq name (car attributes))
       (if (setq value (get-char-attribute char name))

-         (cond ((string-match "^=>ucs@" (symbol-name name))
+         (cond ((setq ret (find-charset name))
+                (setq name (charset-name ret))
+                (if (and (not (memq name dest-ccss))
+                         (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)))
+                )
+               ((string-match "^=>ucs@" (symbol-name name))

                 (insert (format "(%-18s . #x%04X)\t; %c%s"
                                 name value (decode-char '=ucs value)
                                 line-breaking))
                 (insert (format "(%-18s . #x%04X)\t; %c%s"
                                 name value (decode-char '=ucs value)
                                 line-breaking))

@@ -1028,56 +1065,55 @@
                                 line-breaking)))
                ))
       (setq attributes (cdr attributes)))
                                 line-breaking)))
                ))
       (setq attributes (cdr attributes)))

-    (while ccs-attributes
-      (setq name (charset-name (car ccs-attributes)))
-      (if (and (not (memq name dest-ccss))
-              (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)))
-      (setq ccs-attributes (cdr ccs-attributes)))
+    ;; (while ccs-attributes
+    ;;   (setq name (charset-name (car ccs-attributes)))
+    ;;   (if (and (not (memq name dest-ccss))
+    ;;            (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)))
+    ;;   (setq ccs-attributes (cdr ccs-attributes)))

     (insert ")")))
 
 (defun insert-char-data (char &optional readable
     (insert ")")))
 
 (defun insert-char-data (char &optional readable

-                             attributes ccs-attributes)
+                             attributes)

   (save-restriction
     (narrow-to-region (point)(point))
     (insert "(define-char
   '")
   (save-restriction
     (narrow-to-region (point)(point))
     (insert "(define-char
   '")

-    (insert-char-attributes char readable
-                           attributes ccs-attributes)
+    (insert-char-attributes char readable attributes)

     (insert ")\n")
     (goto-char (point-min))
     (while (re-search-forward "[ \t]+$" nil t)
     (insert ")\n")
     (goto-char (point-min))
     (while (re-search-forward "[ \t]+$" nil t)