1 ;;; dump-tables.el --- Dump utility of mapping tables
3 ;; Copyright (C) 2002 MORIOKA Tomohiko
5 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
6 ;; Keywords: Ideographs, Character Database, UTF-2000, UCS, Unicode
8 ;; This file is a part of tomoyo-tools.
10 ;; This program is free software; you can redistribute it and/or
11 ;; modify it under the terms of the GNU General Public License as
12 ;; published by the Free Software Foundation; either version 2, or (at
13 ;; your option) any later version.
15 ;; This program is distributed in the hope that it will be useful, but
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with this program; see the file COPYING. If not, write to
22 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
27 (defun dump-94x94-ccs-to-ucs-table (filename default-file-name
29 ucs-ccs ucs-ccs-prefix)
30 (if (file-directory-p filename)
31 (setq filename (expand-file-name default-file-name filename)))
33 (let ((ucs-ccs-map (intern (format "=>%s" ucs-ccs)))
34 (ccs-format (concat ccs-prefix "%02X%02X"))
35 (ucs-ccs-format (concat "\t" ucs-ccs-prefix "%04X\t"))
41 (when (and (setq chr (make-char ccs row cell))
42 (setq ucs (or (get-char-attribute chr 'ucs)
43 (get-char-attribute chr '=>ucs))))
44 (setq ucs-l (or (get-char-attribute chr ucs-ccs)
45 (get-char-attribute chr ucs-ccs-map)))
46 (insert (format ccs-format row cell))
47 (if (and ucs-l (/= ucs-l ucs))
48 (insert (format ucs-ccs-format ucs-l))
50 (insert (format (if (<= ucs #xFFFF)
54 (setq cell (1+ cell)))
56 (write-region (point-min)(point-max) filename)))
59 (defun dump-jis-x0208-1990-to-ucs-table (filename)
60 (interactive "Fdump J90-to-UCS : ")
61 (dump-94x94-ccs-to-ucs-table
62 filename "J90-to-UCS.txt"
63 'japanese-jisx0208-1990 "J90-" 'ucs-jis "JU+"))
66 (defun dump-jis-x0212-to-ucs-table (filename)
67 (interactive "Fdump JSP-to-UCS : ")
68 (dump-94x94-ccs-to-ucs-table
69 filename "JSP-to-UCS.txt"
70 'japanese-jisx0212 "JSP-" 'ucs-jis "JU+"))
73 (defun dump-jis-x0213-1-to-ucs-table (filename)
74 (interactive "Fdump JX1-to-UCS : ")
75 (if (file-directory-p filename)
76 (setq filename (expand-file-name "JX1-to-UCS.txt" filename)))
83 (when (and (setq chr (make-char 'japanese-jisx0213-1 row cell))
84 (not (encode-char chr 'japanese-jisx0208-1990 t))
85 (setq ucs (or (get-char-attribute chr 'ucs)
86 (get-char-attribute chr '=>ucs)
87 (get-char-attribute chr '->ucs))))
89 (or (encode-char chr '=ucs-jis-2000 'defined-only)
90 (get-char-attribute chr '=>ucs-jis)))
93 (insert (format "JX1-%02X%02X" row cell))
95 (insert (format "\tJU+%04X\t" ucs-j))
97 (insert (format (if (<= ucs #xFFFF)
101 (setq cell (1+ cell)))
102 (setq row (1+ row))))
103 (write-region (point-min)(point-max) filename)))
106 (defun dump-jis-x0213-2-to-ucs-table (filename)
107 (interactive "Fdump JX2-to-UCS : ")
108 (dump-94x94-ccs-to-ucs-table
109 filename "JX2-to-UCS.txt"
110 'japanese-jisx0213-2 "JX2-" 'ucs-jis "JU+"))
113 (defun dump-cns-11643-3-to-ucs-table (filename)
114 (interactive "Fdump C3-to-UCS : ")
115 (dump-94x94-ccs-to-ucs-table
116 filename "C3-to-UCS.txt"
117 'chinese-cns11643-3 "C3-" 'ucs-cns "CU+"))
120 (defun dump-cns-11643-4-to-ucs-table (filename)
121 (interactive "Fdump C4-to-UCS : ")
122 (dump-94x94-ccs-to-ucs-table
123 filename "C4-to-UCS.txt"
124 'chinese-cns11643-4 "C4-" 'ucs-cns "CU+"))
127 (defun dump-big5-to-ucs-table (filename)
128 (interactive "Fdump B-to-UCS : ")
129 (if (file-directory-p filename)
130 (setq filename (expand-file-name "B-to-UCS.txt" filename)))
133 cell chr ucs ucs-big5)
137 (when (and (setq chr (make-char 'chinese-big5 row cell))
138 (setq ucs (or (get-char-attribute chr 'ucs)
139 (get-char-attribute chr '=>ucs)
140 (get-char-attribute chr '->ucs))))
141 (setq ucs-big5 (or (get-char-attribute chr 'ucs-big5)
142 (get-char-attribute chr '=>ucs-big5)))
143 (insert (format "B-%02X%02X" row cell))
145 (insert (format "\tBU+%04X\t" ucs-big5))
147 (insert (format (if (<= ucs #xFFFF)
151 (setq cell (1+ cell)))
152 (setq row (1+ row))))
153 (write-region (point-min)(point-max) filename)))
156 (defun dump-jef-china3-to-ucs-table (filename)
157 (interactive "Fdump JC3-to-UCS : ")
158 (if (file-directory-p filename)
159 (setq filename (expand-file-name "JC3-to-UCS.txt" filename)))
165 (while (<= cell #xFE)
166 (when (and (setq chr (make-char 'china3-jef row cell))
167 (setq ucs (or (get-char-attribute chr 'ucs)
168 (get-char-attribute chr '=>ucs))))
169 (insert (format "JC3-%02X%02X\t" row cell))
170 (insert (format (if (<= ucs #xFFFF)
174 (setq cell (1+ cell)))
175 (setq row (1+ row))))
176 (write-region (point-min)(point-max) filename)))
179 (defun dump-cbeta-to-ucs-table (filename)
180 (interactive "Fdump CBETA-to-UCS : ")
181 (if (file-directory-p filename)
182 (setq filename (expand-file-name "CBETA-to-UCS.txt" filename)))
187 (when (and (setq chr (decode-char 'ideograph-cbeta i))
188 (setq ucs (or (get-char-attribute chr 'ucs)
189 (get-char-attribute chr '=>ucs))))
190 (insert (format "CB%05d\t" i))
191 (insert (format (if (<= ucs #xFFFF)
196 (write-region (point-min)(point-max) filename)))
202 (provide 'dump-tables)
204 ;;; dump-tables.el ends here