Merge KS X 1001 code points.

[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 bbedac2..cbf81eb 100644 (file)
--- a/lisp/utf-2000/char-db-util.el
+++ b/lisp/utf-2000/char-db-util.el
@@ -116,6 +116,10 @@
    ((symbolp kb)
     nil)))
 
+(defvar char-db-coded-charset-priority-list
+  (sort (copy-list default-coded-charset-priority-list)
+       #'char-attribute-name<))
+
 (defun char-db-insert-char-spec (char &optional readable column)
   (unless column
     (setq column (current-column)))
@@ -127,7 +131,10 @@
                  (if (setq ret (get-char-attribute char 'name))
                      (setq char-spec (cons (cons 'name ret) char-spec)))
                  )
-                ((setq ret (split-char char))
+                ((setq ret
+                       (let ((default-coded-charset-priority-list
+                               char-db-coded-charset-priority-list))
+                         (split-char char)))
                  (setq char-spec (list ret))
                  (dolist (ccs (delq (car ret) (charset-list)))
                    (if (or (and (>= (charset-iso-final-char ccs) ?0)
@@ -579,6 +586,24 @@
                      line-breaking))
       (setq attributes (delq '->mojikyo attributes))
       )
+    (when (and (memq 'hanyu-dazidian-vol attributes)
+              (setq value (get-char-attribute char 'hanyu-dazidian-vol)))
+      (insert (format "(hanyu-dazidian-vol  . %d)%s"
+                     value line-breaking))
+      (setq attributes (delq 'hanyu-dazidian-vol attributes))
+      )
+    (when (and (memq 'hanyu-dazidian-page attributes)
+              (setq value (get-char-attribute char 'hanyu-dazidian-page)))
+      (insert (format "(hanyu-dazidian-page . %d)%s"
+                     value line-breaking))
+      (setq attributes (delq 'hanyu-dazidian-page attributes))
+      )
+    (when (and (memq 'hanyu-dazidian-char attributes)
+              (setq value (get-char-attribute char 'hanyu-dazidian-char)))
+      (insert (format "(hanyu-dazidian-char . %d)%s"
+                     value line-breaking))
+      (setq attributes (delq 'hanyu-dazidian-char attributes))
+      )
     (setq rest ccs-attributes)
     (while (and rest
                (progn
@@ -601,6 +626,7 @@
                ((memq name '(->lowercase
                              ->uppercase ->titlecase
                              ->fullwidth <-fullwidth
+                             ->identical
                              ->vulgar-ideograph <-vulgar-ideograph
                              ->ancient-ideograph <-ancient-ideograph
                              ->original-ideograph <-original-ideograph