(dump-94x94-ccs-to-ucs-table): New function.

(dump-jis-x0208-1990-to-ucs-table): Use `dump-94x94-ccs-to-ucs-table'.
(dump-jis-x0212-to-ucs-table): Likewise.
(dump-jis-x0213-1-to-ucs-table): Likewise; use `=ucs-jis-2000' instead
of `ucs-jis'.
(dump-jis-x0213-2-to-ucs-table): Use `dump-94x94-ccs-to-ucs-table'.
(dump-cns-11643-3-to-ucs-table): Likewise.
(dump-cns-11643-4-to-ucs-table): Likewise.

diff --git a/dump-tables.el b/dump-tables.el
index b694536..689812a 100644 (file)
--- a/dump-tables.el
+++ b/dump-tables.el
@@ -24,26 +24,28 @@
 
 ;;; Code:
 
-;;;###autoload
-(defun dump-jis-x0208-1990-to-ucs-table (filename)
-  (interactive "Fdump J90-to-UCS : ")
+(defun dump-94x94-ccs-to-ucs-table (filename default-file-name
+                                            ccs ccs-prefix
+                                            ucs-ccs ucs-ccs-prefix)
   (if (file-directory-p filename)
-      (setq filename (expand-file-name "J90-to-UCS.txt" filename)))
+      (setq filename (expand-file-name default-file-name filename)))
   (with-temp-buffer
-    (let ((row 33)
-         cell chr ucs ucs-j)
+    (let ((ucs-ccs-map (intern (format "=>%s" ucs-ccs)))
+         (ccs-format (concat ccs-prefix "%02X%02X"))
+         (ucs-ccs-format (concat "\t" ucs-ccs-prefix "%04X\t"))
+         (row 33)
+         cell chr ucs ucs-l)
       (while (< row 127)
        (setq cell 33)
        (while (< cell 127)
-         (when (and (setq chr (make-char 'japanese-jisx0208-1990 row cell))
+         (when (and (setq chr (make-char ccs row cell))
                     (setq ucs (or (get-char-attribute chr 'ucs)
-                                  (get-char-attribute chr '=>ucs)
-                                  (get-char-attribute chr '->ucs))))
-           (setq ucs-j (or (get-char-attribute chr 'ucs-jis)
-                           (get-char-attribute chr '=>ucs-jis)))
-           (insert (format "J90-%02X%02X" row cell))
-           (if (and ucs-j (/= ucs-j ucs))
-               (insert (format "\tJU+%04X\t" ucs-j))
+                                  (get-char-attribute chr '=>ucs))))
+           (setq ucs-l (or (get-char-attribute chr ucs-ccs)
+                           (get-char-attribute chr ucs-ccs-map)))
+           (insert (format ccs-format row cell))
+           (if (and ucs-l (/= ucs-l ucs))
+               (insert (format ucs-ccs-format ucs-l))
              (insert "\t "))
            (insert (format (if (<= ucs #xFFFF)
                                "U+%04X\n"
@@ -54,33 +56,18 @@
     (write-region (point-min)(point-max) filename)))
 
 ;;;###autoload
+(defun dump-jis-x0208-1990-to-ucs-table (filename)
+  (interactive "Fdump J90-to-UCS : ")
+  (dump-94x94-ccs-to-ucs-table
+   filename "J90-to-UCS.txt"
+   'japanese-jisx0208-1990 "J90-" 'ucs-jis "JU+"))
+
+;;;###autoload
 (defun dump-jis-x0212-to-ucs-table (filename)
   (interactive "Fdump JSP-to-UCS : ")
-  (if (file-directory-p filename)
-      (setq filename (expand-file-name "JSP-to-UCS.txt" filename)))
-  (with-temp-buffer
-    (let ((row 33)
-         cell chr ucs ucs-j)
-      (while (< row 127)
-       (setq cell 33)
-       (while (< cell 127)
-         (when (and (setq chr (make-char 'japanese-jisx0212 row cell))
-                    (setq ucs (or (get-char-attribute chr 'ucs)
-                                  (get-char-attribute chr '=>ucs)
-                                  (get-char-attribute chr '->ucs))))
-           (setq ucs-j (or (get-char-attribute chr 'ucs-jis)
-                           (get-char-attribute chr '=>ucs-jis)))
-           (insert (format "JSP-%02X%02X" row cell))
-           (if (and ucs-j (/= ucs-j ucs))
-               (insert (format "\tJU+%04X\t" ucs-j))
-             (insert "\t "))
-           (insert (format (if (<= ucs #xFFFF)
-                               "U+%04X\n"
-                             "U-%08X\n")
-                           ucs)))
-         (setq cell (1+ cell)))
-       (setq row (1+ row))))
-    (write-region (point-min)(point-max) filename)))
+  (dump-94x94-ccs-to-ucs-table
+   filename "JSP-to-UCS.txt"
+   'japanese-jisx0212 "JSP-" 'ucs-jis "JU+"))
 
 ;;;###autoload
 (defun dump-jis-x0213-1-to-ucs-table (filename)
@@ -98,8 +85,11 @@
                     (setq ucs (or (get-char-attribute chr 'ucs)
                                   (get-char-attribute chr '=>ucs)
                                   (get-char-attribute chr '->ucs))))
-           (setq ucs-j (or (get-char-attribute chr 'ucs-jis)
+           (when (setq ucs-j
+                       (or (encode-char chr '=ucs-jis-2000 'defined-only)
                            (get-char-attribute chr '=>ucs-jis)))
+             (if (eq ucs-j ucs)
+                 (setq ucs-j nil)))
            (insert (format "JX1-%02X%02X" row cell))
            (if ucs-j
                (insert (format "\tJU+%04X\t" ucs-j))
@@ -115,89 +105,23 @@
 ;;;###autoload
 (defun dump-jis-x0213-2-to-ucs-table (filename)
   (interactive "Fdump JX2-to-UCS : ")
-  (if (file-directory-p filename)
-      (setq filename (expand-file-name "JX2-to-UCS.txt" filename)))
-  (with-temp-buffer
-    (let ((row 33)
-         cell chr ucs ucs-j)
-      (while (< row 127)
-       (setq cell 33)
-       (while (< cell 127)
-         (when (and (setq chr (make-char 'japanese-jisx0213-2 row cell))
-                    (setq ucs (or (get-char-attribute chr 'ucs)
-                                  (get-char-attribute chr '=>ucs)
-                                  (get-char-attribute chr '->ucs))))
-           (setq ucs-j (or (get-char-attribute chr 'ucs-jis)
-                           (get-char-attribute chr '=>ucs-jis)))
-           (insert (format "JX2-%02X%02X" row cell))
-           (if ucs-j
-               (insert (format "\tJU+%04X\t" ucs-j))
-             (insert "\t "))
-           (insert (format (if (<= ucs #xFFFF)
-                               "U+%04X\n"
-                             "U-%08X\n")
-                           ucs)))
-         (setq cell (1+ cell)))
-       (setq row (1+ row))))
-    (write-region (point-min)(point-max) filename)))
+  (dump-94x94-ccs-to-ucs-table
+   filename "JX2-to-UCS.txt"
+   'japanese-jisx0213-2 "JX2-" 'ucs-jis "JU+"))
 
 ;;;###autoload
 (defun dump-cns-11643-3-to-ucs-table (filename)
   (interactive "Fdump C3-to-UCS : ")
-  (if (file-directory-p filename)
-      (setq filename (expand-file-name "C3-to-UCS.txt" filename)))
-  (with-temp-buffer
-    (let ((row 33)
-         cell chr ucs ucs-cns)
-      (while (< row 127)
-       (setq cell 33)
-       (while (< cell 127)
-         (when (and (setq chr (make-char 'chinese-cns11643-3 row cell))
-                    (setq ucs (or (get-char-attribute chr 'ucs)
-                                  (get-char-attribute chr '=>ucs)
-                                  (get-char-attribute chr '->ucs))))
-           (setq ucs-cns (or (get-char-attribute chr 'ucs-cns)
-                             (get-char-attribute chr '=>ucs-cns)))
-           (insert (format "C3-%02X%02X" row cell))
-           (if (and ucs-cns (/= ucs-cns ucs))
-               (insert (format "\tCU+%04X\t" ucs-cns))
-             (insert "\t "))
-           (insert (format (if (<= ucs #xFFFF)
-                               "U+%04X\n"
-                             "U-%08X\n")
-                           ucs)))
-         (setq cell (1+ cell)))
-       (setq row (1+ row))))
-    (write-region (point-min)(point-max) filename)))
+  (dump-94x94-ccs-to-ucs-table
+   filename "C3-to-UCS.txt"
+   'chinese-cns11643-3 "C3-" 'ucs-cns "CU+"))
 
 ;;;###autoload
 (defun dump-cns-11643-4-to-ucs-table (filename)
   (interactive "Fdump C4-to-UCS : ")
-  (if (file-directory-p filename)
-      (setq filename (expand-file-name "C4-to-UCS.txt" filename)))
-  (with-temp-buffer
-    (let ((row 33)
-         cell chr ucs ucs-cns)
-      (while (< row 127)
-       (setq cell 33)
-       (while (< cell 127)
-         (when (and (setq chr (make-char 'chinese-cns11643-4 row cell))
-                    (setq ucs (or (get-char-attribute chr 'ucs)
-                                  (get-char-attribute chr '=>ucs)
-                                  (get-char-attribute chr '->ucs))))
-           (setq ucs-cns (or (get-char-attribute chr 'ucs-cns)
-                             (get-char-attribute chr '=>ucs-cns)))
-           (insert (format "C4-%02X%02X" row cell))
-           (if ucs-cns
-               (insert (format "\tCU+%04X\t" ucs-cns))
-             (insert "\t "))
-           (insert (format (if (<= ucs #xFFFF)
-                               "U+%04X\n"
-                             "U-%08X\n")
-                           ucs)))
-         (setq cell (1+ cell)))
-       (setq row (1+ row))))
-    (write-region (point-min)(point-max) filename)))
+  (dump-94x94-ccs-to-ucs-table
+   filename "C4-to-UCS.txt"
+   'chinese-cns11643-4 "C4-" 'ucs-cns "CU+"))
 
 ;;;###autoload
 (defun dump-big5-to-ucs-table (filename)