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 "IDS-Daikanwa.txt" ids-dump-insert-daikanwa)
71 (cbeta "IDS-CBETA.txt"
72 ids-dump-insert-ccs-ranges
73 ideograph-cbeta "CB%05d\t%c\t%s\n"
77 (defun ids-dump-insert-line (ccs line-spec code)
78 (let ((chr (decode-char ccs code))
81 (setq id-list (get-char-attribute chr 'ideographic-structure))
82 (insert (format line-spec
83 code (decode-builtin-char ccs code)
85 (ids-format-list id-list)
86 (char-to-string chr)))))))
88 (defun ids-dump-insert-ccs-ranges (ccs line-spec &rest ranges)
89 (let (range code max-code)
91 (setq range (car ranges))
93 (setq code (car range)
95 (while (<= code max-code)
96 (ids-dump-insert-line ccs line-spec code)
97 (setq code (1+ code))))
99 (ids-dump-insert-line ccs line-spec range))
100 (t (error 'wrong-type-argument range)))
101 (setq ranges (cdr ranges)))))
103 (defun ids-dump-ranges (range filename)
105 (let* ((coding-system-for-write 'utf-8)
106 (spec (assq range ids-dump-file-specs-alist))
109 (args (nthcdr 3 spec)))
110 (if (file-directory-p filename)
111 (setq filename (expand-file-name file filename)))
112 (insert ";; -*- coding: utf-8 -*-\n")
114 (write-region (point-min)(point-max)
117 (defun ids-dump-insert-daikanwa ()
123 (when (= (length val) 2)
124 (set-alist 'mdh-alist
126 (put-alist (nth 1 val)
128 (cdr (assq (car val) mdh-alist)))))
132 (when (setq chr (decode-char 'ideograph-daikanwa i))
134 (format "M-%05d \t%c\t%s\n"
135 i (decode-builtin-char 'ideograph-daikanwa i)
137 (get-char-attribute chr 'ideographic-structure)))))
138 (when (setq sal (assq i mdh-alist))
140 (when (setq chr (assq 1 sal))
143 (format "M-%05d'\t%c\t%s\n"
146 (get-char-attribute chr 'ideographic-structure)))))
147 (when (setq chr (assq 2 sal))
150 (format "M-%05d\"\t%c\t%s\n"
153 (get-char-attribute chr 'ideographic-structure)))))
156 (setq sal (sort (cdr (assq 'ho mdh-alist))
158 (< (car a)(car b)))))
160 (setq chr (cdr cell))
162 (format "MH-%04d \t%c\t%s\n"
166 (get-char-attribute chr 'ideographic-structure)))))))
168 (dolist (spec ids-dump-file-specs-alist)
169 (eval `(defun ,(intern (concat "ids-dump-" (symbol-name (car spec))))
171 (interactive ,(concat "Fdump "
172 (file-name-sans-extension (nth 1 spec))
174 (ids-dump-ranges ',(car spec) filename))))
182 ;;; ids-dump.el ends here