1 ;;; ids-dump.el --- Dump utility of IDS-* files
3 ;; Copyright (C) 2002 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 (defvar ids-dump-file-specs-alist
30 '((ucs-basic "IDS-UCS-Basic.txt"
31 ids-dump-insert-ccs-ranges
32 ucs "U+%04X\t%c\t%s\n"
34 (ucs-ext-a "IDS-UCS-Ext-A.txt"
35 ids-dump-insert-ccs-ranges
36 ucs "U+%04X\t%c\t%s\n"
37 (#x3400 . #x4DB5) #xFA1F #xFA23)
38 (ucs-compat "IDS-UCS-Compat.txt"
39 ids-dump-insert-ccs-ranges
40 ucs "U+%04X\t%c\t%s\n"
41 (#xF900 . #xFA1E) (#xFA20 . #xFA22) (#xFA24 . #xFA2D))
42 (ucs-ext-b-1 "IDS-UCS-Ext-B-1.txt"
43 ids-dump-insert-ccs-ranges
44 ucs "U-%08X\t%c\t%s\n"
46 (ucs-ext-b-2 "IDS-UCS-Ext-B-2.txt"
47 ids-dump-insert-ccs-ranges
48 ucs "U-%08X\t%c\t%s\n"
50 (ucs-ext-b-3 "IDS-UCS-Ext-B-3.txt"
51 ids-dump-insert-ccs-ranges
52 ucs "U-%08X\t%c\t%s\n"
54 (ucs-ext-b-4 "IDS-UCS-Ext-B-4.txt"
55 ids-dump-insert-ccs-ranges
56 ucs "U-%08X\t%c\t%s\n"
58 (ucs-ext-b-5 "IDS-UCS-Ext-B-5.txt"
59 ids-dump-insert-ccs-ranges
60 ucs "U-%08X\t%c\t%s\n"
62 (ucs-ext-b-6 "IDS-UCS-Ext-B-6.txt"
63 ids-dump-insert-ccs-ranges
64 ucs "U-%08X\t%c\t%s\n"
66 (ucs-compat-supplement "IDS-UCS-Compat-Supplement.txt"
67 ids-dump-insert-ccs-ranges
68 ucs "U-%08X\t%c\t%s\n"
70 (daikanwa-01 "IDS-Daikanwa-01.txt" ids-dump-insert-daikanwa 00001 01449)
71 (daikanwa-02 "IDS-Daikanwa-02.txt" ids-dump-insert-daikanwa 01450 04674)
72 (daikanwa-03 "IDS-Daikanwa-03.txt" ids-dump-insert-daikanwa 04675 07410)
73 (daikanwa-04 "IDS-Daikanwa-04.txt" ids-dump-insert-daikanwa 07411 11529)
74 (daikanwa-05 "IDS-Daikanwa-05.txt" ids-dump-insert-daikanwa 11530 14414)
75 (daikanwa-06 "IDS-Daikanwa-06.txt" ids-dump-insert-daikanwa 14415 17574)
76 (daikanwa-07 "IDS-Daikanwa-07.txt" ids-dump-insert-daikanwa 17575 22677)
77 (daikanwa-08 "IDS-Daikanwa-08.txt" ids-dump-insert-daikanwa 22678 28107)
78 (daikanwa-09 "IDS-Daikanwa-09.txt" ids-dump-insert-daikanwa 28108 32803)
79 (daikanwa-10 "IDS-Daikanwa-10.txt" ids-dump-insert-daikanwa 32804 38699)
80 (daikanwa-11 "IDS-Daikanwa-11.txt" ids-dump-insert-daikanwa 38700 42209)
81 (daikanwa-12 "IDS-Daikanwa-12.txt" ids-dump-insert-daikanwa 42210 48902)
82 (daikanwa-ho "IDS-Daikanwa-ho.txt" ids-dump-insert-daikanwa-hokan)
83 (cbeta "IDS-CBETA.txt"
84 ids-dump-insert-ccs-ranges
85 ideograph-cbeta "CB%05d\t%c\t%s\n"
89 (defun ids-dump-insert-line (ccs line-spec code)
90 (let ((chr (decode-char ccs code))
93 (setq id-list (get-char-attribute chr 'ideographic-structure))
94 (insert (format line-spec
95 code (decode-builtin-char ccs code)
97 (ids-format-list id-list)
98 (char-to-string chr)))))))
100 (defun ids-dump-insert-ccs-ranges (ccs line-spec &rest ranges)
101 (let (range code max-code)
103 (setq range (car ranges))
105 (setq code (car range)
106 max-code (cdr range))
107 (while (<= code max-code)
108 (ids-dump-insert-line ccs line-spec code)
109 (setq code (1+ code))))
111 (ids-dump-insert-line ccs line-spec range))
112 (t (error 'wrong-type-argument range)))
113 (setq ranges (cdr ranges)))))
115 (defun ids-dump-ranges (range filename)
117 (let* ((coding-system-for-write 'utf-8)
118 (spec (assq range ids-dump-file-specs-alist))
121 (args (nthcdr 3 spec)))
122 (if (file-directory-p filename)
123 (setq filename (expand-file-name file filename)))
124 (insert ";; -*- coding: utf-8 -*-\n")
126 (write-region (point-min)(point-max)
129 (defun ids-dump-insert-daikanwa (start end)
135 (when (= (length val) 2)
136 (set-alist 'mdh-alist
138 (put-alist (nth 1 val)
140 (cdr (assq (car val) mdh-alist)))))
144 (when (setq chr (decode-char 'ideograph-daikanwa i))
146 (format "M-%05d \t%c\t%s\n"
147 i (decode-builtin-char 'ideograph-daikanwa i)
149 (get-char-attribute chr 'ideographic-structure)))))
150 (when (setq sal (assq i mdh-alist))
152 (when (setq chr (assq 1 sal))
155 (format "M-%05d'\t%c\t%s\n"
158 (get-char-attribute chr 'ideographic-structure)))))
159 (when (setq chr (assq 2 sal))
162 (format "M-%05d\"\t%c\t%s\n"
165 (get-char-attribute chr 'ideographic-structure)))))
169 (defun ids-dump-insert-daikanwa-hokan ()
173 (when (and (eq (car val) 'ho)
174 (null (nthcdr 2 val)))
175 (setq sal (cons (cons (nth 1 val) key) sal)))
178 (setq sal (sort sal (lambda (a b) (< (car a)(car b)))))
180 (setq chr (cdr cell))
182 (format "MH-%04d \t%c\t%s\n"
186 (get-char-attribute chr 'ideographic-structure)))))))
188 (dolist (spec ids-dump-file-specs-alist)
189 (eval `(defun ,(intern (concat "ids-dump-" (symbol-name (car spec))))
191 (interactive ,(concat "Fdump "
192 (file-name-sans-extension (nth 1 spec))
194 (ids-dump-ranges ',(car spec) filename))))
202 ;;; ids-dump.el ends here