1 ;;; dump-tables.el --- Dump utility of mapping tables
3 ;; Copyright (C) 2002,2003,2004 MORIOKA Tomohiko
5 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
6 ;; Keywords: Ideographs, Character Database, CHISE, 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-domain ucs-ccs-prefix)
30 (if (file-directory-p filename)
31 (setq filename (expand-file-name default-file-name filename)))
33 (let ((ucs-ccs (intern (format "=ucs@%s" ucs-domain)))
34 (ucs-ccs-map (intern (format "=>ucs@%s" ucs-domain)))
35 (ccs-format (concat ccs-prefix "%02X%02X"))
36 (ucs-ccs-format (concat "\t" ucs-ccs-prefix "%04X\t"))
42 (when (and (setq chr (make-char ccs row cell))
43 (setq ucs (or (encode-char chr 'ucs 'defined-only)
44 (char-feature chr '=>ucs))))
45 (setq ucs-l (or (encode-char chr ucs-ccs 'defined-only)
46 (char-feature chr ucs-ccs-map)))
47 (insert (format ccs-format row cell))
48 (if (and ucs-l (/= ucs-l ucs))
49 (insert (format ucs-ccs-format ucs-l))
51 (insert (format (if (<= ucs #xFFFF)
55 (setq cell (1+ cell)))
57 (write-region (point-min)(point-max) filename)))
60 (defun dump-jis-x0208-1990-to-ucs-table (filename)
61 (interactive "Fdump J90-to-UCS : ")
62 (dump-94x94-ccs-to-ucs-table
63 filename "J90-to-UCS.txt"
64 'japanese-jisx0208-1990 "J90-" 'jis "JU+"))
67 (defun dump-jis-x0212-to-ucs-table (filename)
68 (interactive "Fdump JSP-to-UCS : ")
69 (dump-94x94-ccs-to-ucs-table
70 filename "JSP-to-UCS.txt"
71 'japanese-jisx0212 "JSP-" 'jis "JU+"))
74 (defun dump-jis-x0213-1-to-ucs-table (filename)
75 (interactive "Fdump JX1-to-UCS : ")
76 (if (file-directory-p filename)
77 (setq filename (expand-file-name "JX1-to-UCS.txt" filename)))
84 (when (and (setq chr (make-char 'japanese-jisx0213-1 row cell))
85 (not (encode-char chr 'japanese-jisx0208-1990
87 (setq ucs (or (encode-char chr 'ucs 'defined-only)
88 (get-char-attribute chr '=>ucs))))
90 (or (encode-char chr '=ucs-jis-2000 'defined-only)
91 (get-char-attribute chr '=>ucs@jis)))
94 (insert (format "JX1-%02X%02X" row cell))
96 (insert (format "\tJU+%04X\t" ucs-j))
98 (insert (format (if (<= ucs #xFFFF)
102 (setq cell (1+ cell)))
103 (setq row (1+ row))))
104 (write-region (point-min)(point-max) filename)))
107 (defun dump-jis-x0213-2-to-ucs-table (filename)
108 (interactive "Fdump JX2-to-UCS : ")
109 (dump-94x94-ccs-to-ucs-table
110 filename "JX2-to-UCS.txt"
111 'japanese-jisx0213-2 "JX2-" 'jis "JU+"))
114 (defun dump-cns-11643-1-to-ucs-table (filename)
115 (interactive "Fdump C1-to-UCS : ")
116 (dump-94x94-ccs-to-ucs-table
117 filename "C1-to-UCS.txt"
118 'chinese-cns11643-1 "C1-" 'cns "CU+"))
121 (defun dump-cns-11643-2-to-ucs-table (filename)
122 (interactive "Fdump C2-to-UCS : ")
123 (dump-94x94-ccs-to-ucs-table
124 filename "C2-to-UCS.txt"
125 'chinese-cns11643-2 "C2-" 'cns "CU+"))
128 (defun dump-cns-11643-3-to-ucs-table (filename)
129 (interactive "Fdump C3-to-UCS : ")
130 (dump-94x94-ccs-to-ucs-table
131 filename "C3-to-UCS.txt"
132 'chinese-cns11643-3 "C3-" 'cns "CU+"))
135 (defun dump-cns-11643-4-to-ucs-table (filename)
136 (interactive "Fdump C4-to-UCS : ")
137 (dump-94x94-ccs-to-ucs-table
138 filename "C4-to-UCS.txt"
139 'chinese-cns11643-4 "C4-" 'cns "CU+"))
142 (defun dump-big5-to-ucs-table (filename)
143 (interactive "Fdump B-to-UCS : ")
144 (if (file-directory-p filename)
145 (setq filename (expand-file-name "B-to-UCS.txt" filename)))
148 cell chr ucs ucs-big5)
152 (when (and (setq chr (make-char 'chinese-big5 row cell))
153 (setq ucs (or (encode-char chr 'ucs 'defined-only)
154 (get-char-attribute chr '=>ucs))))
155 (setq ucs-big5 (or (encode-char chr 'ucs-big5 'defined-only)
156 (get-char-attribute chr '=>ucs@big5)))
157 (insert (format "B-%02X%02X" row cell))
159 (insert (format "\tBU+%04X\t" ucs-big5))
161 (insert (format (if (<= ucs #xFFFF)
165 (setq cell (1+ cell)))
166 (setq row (1+ row))))
167 (write-region (point-min)(point-max) filename)))
170 (defun dump-jef-china3-to-ucs-table (filename)
171 (interactive "Fdump JC3-to-UCS : ")
172 (if (file-directory-p filename)
173 (setq filename (expand-file-name "JC3-to-UCS.txt" filename)))
179 (while (<= cell #xFE)
180 (when (and (setq chr (make-char 'china3-jef row cell))
181 (setq ucs (or (encode-char chr 'ucs 'defined-only)
182 (get-char-attribute chr '=>ucs))))
183 (insert (format "JC3-%02X%02X\t" row cell))
184 (insert (format (if (<= ucs #xFFFF)
188 (setq cell (1+ cell)))
189 (setq row (1+ row))))
190 (write-region (point-min)(point-max) filename)))
193 (defun dump-cbeta-to-ucs-table (filename)
194 (interactive "Fdump CBETA-to-UCS : ")
195 (if (file-directory-p filename)
196 (setq filename (expand-file-name "CBETA-to-UCS.txt" filename)))
201 (when (and (setq chr (decode-char 'ideograph-cbeta i))
202 (setq ucs (or (encode-char chr 'ucs 'defined-only)
203 (get-char-attribute chr '=>ucs))))
204 (insert (format "CB%05d\t" i))
205 (insert (format (if (<= ucs #xFFFF)
210 (write-region (point-min)(point-max) filename)))
213 (defun dump-jis2ucsdkw (filename)
214 (interactive "Fdump jis2ucsdkw : ")
215 (if (file-directory-p filename)
216 (setq filename (expand-file-name "jis2ucsdkw.txt" filename)))
223 (when (and (setq chr (make-char 'japanese-jisx0213-1 row cell))
225 (or (encode-char chr '=ucs@jis-2000 'defined-only)
226 (get-char-attribute chr '=>ucs@jis-2000)
227 (get-char-attribute chr '=>ucs@jis)
228 (get-char-attribute chr '=>ucs)))
229 (or (and (<= #x3400 ucs-j) (<= ucs-j #x9FA5))
230 (and (<= #xF900 ucs-j) (<= ucs-j #xFA6F))
232 (insert (format "J1-%02d%02d" (- row 32)(- cell 32)))
234 (insert (format " U+%05X" ucs-j))
236 (setq md (char-daikanwa chr))
238 (insert (format " D%05d.0\n" md)))
240 (insert (format " DHo%03d\n" (nth 1 md))))
242 (insert (format " D%05d.%d\n" (car md)(nth 1 md))))
246 (setq cell (1+ cell)))
252 (when (and (setq chr (make-char 'japanese-jisx0213-2 row cell))
254 (or (encode-char chr '=ucs@jis-2000 'defined-only)
255 (get-char-attribute chr '=>ucs@jis-2000)
256 (get-char-attribute chr '=>ucs@jis)
257 (get-char-attribute chr '=>ucs))))
258 (insert (format "J2-%02d%02d" (- row 32)(- cell 32)))
260 (insert (format " U+%05X" ucs-j))
262 (setq md (char-daikanwa chr))
264 (insert (format " D%05d.0\n" md)))
266 (insert (format " DHo%03d\n" (nth 1 md))))
268 (insert (format " D%05d.%d\n" (car md)(nth 1 md))))
272 (setq cell (1+ cell)))
275 (write-region (point-min)(point-max) filename)))
281 (provide 'dump-tables)
283 ;;; dump-tables.el ends here