From: tomo <tomo>
Date: Sun, 16 Feb 2003 09:04:16 +0000 (+0000)
Subject: (dump-94x94-ccs-to-ucs-table): New function.
X-Git-Tag: chise-base-0_23~64
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=9eccb5e0ff17275238d39176c215924e107f7fb7;p=chise%2Ftomoyo-tools.git

(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
--- 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)