1 ;;; ids-dump.el --- Dump utility of IDS-* files
3 ;; Copyright (C) 2002,2003 MORIOKA Tomohiko
5 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
6 ;; Keywords: IDS, IDC, Ideographs, UCS, Unicode
8 ;; This file is a part of IDS.
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.
29 (defun ids-dump-insert-line (ccs line-spec code)
30 (let ((chr (decode-char ccs code))
33 (setq id-list (get-char-attribute chr 'ideographic-structure))
34 (insert (format line-spec
35 code (decode-builtin-char ccs code)
37 (ids-format-list id-list)
38 (char-to-string chr)))))))
40 (defun ids-dump-insert-ccs-ranges (ccs line-spec &rest ranges)
41 (let (range code max-code)
43 (setq range (car ranges))
45 (setq code (car range)
47 (while (<= code max-code)
48 (ids-dump-insert-line ccs line-spec code)
49 (setq code (1+ code))))
51 (ids-dump-insert-line ccs line-spec range))
52 (t (error 'wrong-type-argument range)))
53 (setq ranges (cdr ranges)))))
55 (defun ids-dump-insert-daikanwa (start end)
61 (when (= (length val) 2)
64 (put-alist (nth 1 val)
66 (cdr (assq (car val) mdh-alist)))))
70 (when (setq chr (decode-char 'ideograph-daikanwa i))
72 (format "M-%05d \t%c\t%s\n"
73 i (decode-builtin-char 'ideograph-daikanwa i)
75 (get-char-attribute chr 'ideographic-structure))
77 (when (setq sal (assq i mdh-alist))
79 (when (setq chr (assq 1 sal))
82 (format "M-%05d'\t%c\t%s\n"
85 (get-char-attribute chr 'ideographic-structure))
87 (when (setq chr (assq 2 sal))
90 (format "M-%05d\"\t%c\t%s\n"
93 (get-char-attribute chr 'ideographic-structure)))))
97 (defun ids-dump-insert-daikanwa-hokan ()
101 (when (and (eq (car val) 'ho)
102 (null (nthcdr 2 val)))
103 (setq sal (cons (cons (nth 1 val) key) sal)))
106 (setq sal (sort sal (lambda (a b) (< (car a)(car b)))))
108 (setq chr (cdr cell))
110 (format "MH-%04d \t%c\t%s\n"
114 (get-char-attribute chr 'ideographic-structure)))))))
116 (defun ids-dump-insert-jis-x0208-1990 ()
124 (setq chr (make-char 'japanese-jisx0208-1990 h l))
126 (format "J90-%02X%02X\t%c\t%s\n"
128 (decode-builtin-char 'japanese-jisx0208-1990
129 (logior (lsh h 8) l))
131 (get-char-attribute chr 'ideographic-structure))
133 (setq cell (1+ cell)))
139 (setq chr (make-char 'japanese-jisx0208-1990 h l))
141 (format "J90-%02X%02X\t%c\t%s\n"
143 (decode-builtin-char 'japanese-jisx0208-1990
144 (logior (lsh h 8) l))
146 (get-char-attribute chr 'ideographic-structure))
148 (setq cell (1+ cell)))))
150 (defun ids-dump-insert-big5 (ccs prefix)
152 l code chr structure)
156 (setq chr (make-char ccs h l))
158 (when (setq structure
159 (get-char-attribute chr 'ideographic-structure))
161 (format "%s%02X%02X\t%c\t%s\n"
163 (decode-builtin-char ccs
164 (logior (lsh h 8) l))
166 (get-char-attribute chr 'ideographic-structure))
171 (setq chr (make-char ccs h l))
173 (when (setq structure
174 (get-char-attribute chr 'ideographic-structure))
176 (format "%s%02X%02X\t%c\t%s\n"
178 (decode-builtin-char ccs
179 (logior (lsh h 8) l))
181 (get-char-attribute chr 'ideographic-structure))
186 (defun ids-dump-range (file path func &rest args)
188 (let* ((coding-system-for-write 'utf-8-mcs-er))
189 (if (file-directory-p path)
190 (setq path (expand-file-name file path)))
191 (insert ";; -*- coding: utf-8-mcs-er -*-\n")
193 (write-region (point-min)(point-max) path))))
196 (defun ids-dump-ucs-basic (filename)
197 (interactive "Fdump IDS-UCS-Basic : ")
198 (ids-dump-range "IDS-UCS-Basic.txt" filename
199 #'ids-dump-insert-ccs-ranges 'ucs "U+%04X\t%c\t%s\n"
203 (defun ids-dump-ucs-ext-a (filename)
204 (interactive "Fdump IDS-UCS-Ext-A : ")
205 (ids-dump-range "IDS-UCS-Ext-A.txt" filename
206 #'ids-dump-insert-ccs-ranges 'ucs "U+%04X\t%c\t%s\n"
207 '(#x3400 . #x4DB5) #xFA1F #xFA23))
210 (defun ids-dump-ucs-compat (filename)
211 (interactive "Fdump IDS-UCS-Compat : ")
212 (ids-dump-range "IDS-UCS-Compat.txt" filename
213 #'ids-dump-insert-ccs-ranges 'ucs "U+%04X\t%c\t%s\n"
214 '(#xF900 . #xFA1E) '(#xFA20 . #xFA22) '(#xFA24 . #xFA2D)))
217 (defun ids-dump-ucs-ext-b-1 (filename)
218 (interactive "Fdump IDS-UCS-Ext-B-1 : ")
219 (ids-dump-range "IDS-UCS-Ext-B-1.txt" filename
220 #'ids-dump-insert-ccs-ranges 'ucs "U-%08X\t%c\t%s\n"
221 '(#x20000 . #x21FFF)))
224 (defun ids-dump-ucs-ext-b-2 (filename)
225 (interactive "Fdump IDS-UCS-Ext-B-2 : ")
226 (ids-dump-range "IDS-UCS-Ext-B-2.txt" filename
227 #'ids-dump-insert-ccs-ranges 'ucs "U-%08X\t%c\t%s\n"
228 '(#x22000 . #x23FFF)))
231 (defun ids-dump-ucs-ext-b-3 (filename)
232 (interactive "Fdump IDS-UCS-Ext-B-3 : ")
233 (ids-dump-range "IDS-UCS-Ext-B-3.txt" filename
234 #'ids-dump-insert-ccs-ranges 'ucs "U-%08X\t%c\t%s\n"
235 '(#x24000 . #x25FFF)))
238 (defun ids-dump-ucs-ext-b-4 (filename)
239 (interactive "Fdump IDS-UCS-Ext-B-4 : ")
240 (ids-dump-range "IDS-UCS-Ext-B-4.txt" filename
241 #'ids-dump-insert-ccs-ranges 'ucs "U-%08X\t%c\t%s\n"
242 '(#x26000 . #x27FFF)))
245 (defun ids-dump-ucs-ext-b-5 (filename)
246 (interactive "Fdump IDS-UCS-Ext-B-5 : ")
247 (ids-dump-range "IDS-UCS-Ext-B-5.txt" filename
248 #'ids-dump-insert-ccs-ranges 'ucs "U-%08X\t%c\t%s\n"
249 '(#x28000 . #x29FFF)))
252 (defun ids-dump-ucs-ext-b-6 (filename)
253 (interactive "Fdump IDS-UCS-Ext-B-6 : ")
254 (ids-dump-range "IDS-UCS-Ext-B-6.txt" filename
255 #'ids-dump-insert-ccs-ranges 'ucs "U-%08X\t%c\t%s\n"
256 '(#x2A000 . #x2A6D6)))
259 (defun ids-dump-ucs-compat-supplement (filename)
260 (interactive "Fdump IDS-UCS-Compat-Supplement : ")
261 (ids-dump-range "IDS-UCS-Compat-Supplement.txt" filename
262 #'ids-dump-insert-ccs-ranges 'ucs "U-%08X\t%c\t%s\n"
263 '(#x2F800 . #x2FA1D)))
266 (defun ids-dump-daikanwa-01 (filename)
267 (interactive "Fdump IDS-Daikanwa-01 : ")
268 (ids-dump-range "IDS-Daikanwa-01.txt" filename
269 #'ids-dump-insert-daikanwa 00001 01449))
272 (defun ids-dump-daikanwa-02 (filename)
273 (interactive "Fdump IDS-Daikanwa-02 : ")
274 (ids-dump-range "IDS-Daikanwa-02.txt" filename
275 #'ids-dump-insert-daikanwa 01450 04674))
278 (defun ids-dump-daikanwa-03 (filename)
279 (interactive "Fdump IDS-Daikanwa-03 : ")
280 (ids-dump-range "IDS-Daikanwa-03.txt" filename
281 #'ids-dump-insert-daikanwa 04675 07410))
284 (defun ids-dump-daikanwa-04 (filename)
285 (interactive "Fdump IDS-Daikanwa-04 : ")
286 (ids-dump-range "IDS-Daikanwa-04.txt" filename
287 #'ids-dump-insert-daikanwa 07411 11529))
290 (defun ids-dump-daikanwa-05 (filename)
291 (interactive "Fdump IDS-Daikanwa-05 : ")
292 (ids-dump-range "IDS-Daikanwa-05.txt" filename
293 #'ids-dump-insert-daikanwa 11530 14414))
296 (defun ids-dump-daikanwa-06 (filename)
297 (interactive "Fdump IDS-Daikanwa-06 : ")
298 (ids-dump-range "IDS-Daikanwa-06.txt" filename
299 #'ids-dump-insert-daikanwa 14415 17574))
302 (defun ids-dump-daikanwa-07 (filename)
303 (interactive "Fdump IDS-Daikanwa-07 : ")
304 (ids-dump-range "IDS-Daikanwa-07.txt" filename
305 #'ids-dump-insert-daikanwa 17575 22677))
308 (defun ids-dump-daikanwa-08 (filename)
309 (interactive "Fdump IDS-Daikanwa-08 : ")
310 (ids-dump-range "IDS-Daikanwa-08.txt" filename
311 #'ids-dump-insert-daikanwa 22678 28107))
314 (defun ids-dump-daikanwa-09 (filename)
315 (interactive "Fdump IDS-Daikanwa-09 : ")
316 (ids-dump-range "IDS-Daikanwa-09.txt" filename
317 #'ids-dump-insert-daikanwa 28108 32803))
320 (defun ids-dump-daikanwa-10 (filename)
321 (interactive "Fdump IDS-Daikanwa-10 : ")
322 (ids-dump-range "IDS-Daikanwa-10.txt" filename
323 #'ids-dump-insert-daikanwa 32804 38699))
326 (defun ids-dump-daikanwa-11 (filename)
327 (interactive "Fdump IDS-Daikanwa-11 : ")
328 (ids-dump-range "IDS-Daikanwa-11.txt" filename
329 #'ids-dump-insert-daikanwa 38700 42209))
332 (defun ids-dump-daikanwa-12 (filename)
333 (interactive "Fdump IDS-Daikanwa-12 : ")
334 (ids-dump-range "IDS-Daikanwa-12.txt" filename
335 #'ids-dump-insert-daikanwa 42210 48902))
338 (defun ids-dump-daikanwa-index (filename)
339 (interactive "Fdump IDS-Daikanwa-dx : ")
340 (ids-dump-range "IDS-Daikanwa-dx.txt" filename
341 #'ids-dump-insert-daikanwa 48903 49964))
344 (defun ids-dump-daikanwa-hokan (filename)
345 (interactive "Fdump IDS-Daikanwa-ho : ")
346 (ids-dump-range "IDS-Daikanwa-ho.txt" filename
347 #'ids-dump-insert-daikanwa-hokan))
350 (defun ids-dump-cbeta (filename)
351 (interactive "Fdump IDS-CBETA : ")
352 (ids-dump-range "IDS-CBETA.txt" filename
353 #'ids-dump-insert-ccs-ranges
354 'ideograph-cbeta "CB%05d\t%c\t%s\n"
358 (defun ids-dump-jis-x0208-1990 (filename)
359 (interactive "Fdump IDS-JIS-X0208-1990 : ")
360 (ids-dump-range "IDS-JIS-X0208-1990.txt" filename
361 #'ids-dump-insert-jis-x0208-1990))
364 (defun ids-dump-big5-cdp (filename)
365 (interactive "Fdump IDS-CDP : ")
366 (ids-dump-range "IDS-CDP.txt" filename
367 #'ids-dump-insert-big5
376 ;;; ids-dump.el ends here