--- /dev/null
+;;; ids-dump.el --- Dump utility of IDS-* files
+
+;; Copyright (C) 2002 MORIOKA Tomohiko
+
+;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
+;; Keywords: IDS, IDC, Ideographs, UCS, Unicode
+
+;; This file is a part of IDS.
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(require 'ids)
+
+(defvar ids-dump-file-specs-alist
+ '((ucs-basic "IDS-UCS-Basic.txt"
+ ids-dump-insert-ccs-ranges
+ ucs "U+%04X\t%c\t%s\n"
+ (#x4E00 . #x9FA5))
+ (ucs-ext-a "IDS-UCS-Ext-A.txt"
+ ids-dump-insert-ccs-ranges
+ ucs "U+%04X\t%c\t%s\n"
+ (#x3400 . #x4DB5) #xFA1F #xFA23)
+ (ucs-compat "IDS-UCS-Compat.txt"
+ ids-dump-insert-ccs-ranges
+ ucs "U+%04X\t%c\t%s\n"
+ (#xF900 . #xFA1E) (#xFA20 . #xFA22) (#xFA24 . #xFA2D))
+ (ucs-ext-b-1 "IDS-UCS-Ext-B-1.txt"
+ ids-dump-insert-ccs-ranges
+ ucs "U-%08X\t%c\t%s\n"
+ (#x20000 . #x21FFF))
+ (ucs-ext-b-2 "IDS-UCS-Ext-B-2.txt"
+ ids-dump-insert-ccs-ranges
+ ucs "U-%08X\t%c\t%s\n"
+ (#x22000 . #x23FFF))
+ (ucs-ext-b-3 "IDS-UCS-Ext-B-3.txt"
+ ids-dump-insert-ccs-ranges
+ ucs "U-%08X\t%c\t%s\n"
+ (#x24000 . #x25FFF))
+ (ucs-ext-b-4 "IDS-UCS-Ext-B-4.txt"
+ ids-dump-insert-ccs-ranges
+ ucs "U-%08X\t%c\t%s\n"
+ (#x26000 . #x27FFF))
+ (ucs-ext-b-5 "IDS-UCS-Ext-B-5.txt"
+ ids-dump-insert-ccs-ranges
+ ucs "U-%08X\t%c\t%s\n"
+ (#x28000 . #x29FFF))
+ (ucs-ext-b-6 "IDS-UCS-Ext-B-6.txt"
+ ids-dump-insert-ccs-ranges
+ ucs "U-%08X\t%c\t%s\n"
+ (#x2A000 . #x2A6D6))
+ (ucs-compat-supplement "IDS-UCS-Compat-Supplement.txt"
+ ids-dump-insert-ccs-ranges
+ ucs "U-%08X\t%c\t%s\n"
+ (#x2F800 . #x2FA1D))
+ (daikanwa "IDS-Daikanwa.txt" ids-dump-insert-daikanwa)
+ (cbeta "IDS-CBETA.txt"
+ ids-dump-insert-ccs-ranges
+ ideograph-cbeta "CB%05d\t%c\t%s\n"
+ (1 . 13363))
+ ))
+
+(defun ids-dump-insert-line (ccs line-spec code)
+ (let ((chr (decode-char ccs code))
+ id-list)
+ (when chr
+ (setq id-list (get-char-attribute chr 'ideographic-structure))
+ (insert (format line-spec
+ code (decode-builtin-char ccs code)
+ (if id-list
+ (ids-format-list id-list)
+ (char-to-string chr)))))))
+
+(defun ids-dump-insert-ccs-ranges (ccs line-spec &rest ranges)
+ (let (range code max-code)
+ (while ranges
+ (setq range (car ranges))
+ (cond ((consp range)
+ (setq code (car range)
+ max-code (cdr range))
+ (while (<= code max-code)
+ (ids-dump-insert-line ccs line-spec code)
+ (setq code (1+ code))))
+ ((integerp range)
+ (ids-dump-insert-line ccs line-spec range))
+ (t (error 'wrong-type-argument range)))
+ (setq ranges (cdr ranges)))))
+
+(defun ids-dump-ranges (range filename)
+ (with-temp-buffer
+ (let* ((coding-system-for-write 'utf-8)
+ (spec (assq range ids-dump-file-specs-alist))
+ (file (nth 1 spec))
+ (func (nth 2 spec))
+ (args (nthcdr 3 spec)))
+ (if (file-directory-p filename)
+ (setq filename (expand-file-name file filename)))
+ (insert ";; -*- coding: utf-8 -*-\n")
+ (apply func args)
+ (write-region (point-min)(point-max)
+ filename))))
+
+(defun ids-dump-insert-daikanwa ()
+ (let ((i 1)
+ mdh-alist
+ chr sal)
+ (map-char-attribute
+ (lambda (key val)
+ (when (= (length val) 2)
+ (set-alist 'mdh-alist
+ (car val)
+ (put-alist (nth 1 val)
+ key
+ (cdr (assq (car val) mdh-alist)))))
+ nil)
+ 'morohashi-daikanwa)
+ (while (<= i 49964)
+ (when (setq chr (decode-char 'ideograph-daikanwa i))
+ (insert
+ (format "M-%05d \t%c\t%s\n"
+ i (decode-builtin-char 'ideograph-daikanwa i)
+ (ids-format-list
+ (get-char-attribute chr 'ideographic-structure)))))
+ (when (setq sal (assq i mdh-alist))
+ (setq sal (cdr sal))
+ (when (setq chr (assq 1 sal))
+ (setq chr (cdr chr))
+ (insert
+ (format "M-%05d'\t%c\t%s\n"
+ i chr
+ (ids-format-list
+ (get-char-attribute chr 'ideographic-structure)))))
+ (when (setq chr (assq 2 sal))
+ (setq chr (cdr chr))
+ (insert
+ (format "M-%05d\"\t%c\t%s\n"
+ i chr
+ (ids-format-list
+ (get-char-attribute chr 'ideographic-structure)))))
+ )
+ (setq i (1+ i)))
+ (setq sal (sort (cdr (assq 'ho mdh-alist))
+ (lambda (a b)
+ (< (car a)(car b)))))
+ (dolist (cell sal)
+ (setq chr (cdr cell))
+ (insert
+ (format "MH-%04d \t%c\t%s\n"
+ (car cell)
+ chr
+ (ids-format-list
+ (get-char-attribute chr 'ideographic-structure)))))))
+
+(dolist (spec ids-dump-file-specs-alist)
+ (eval `(defun ,(intern (concat "ids-dump-" (symbol-name (car spec))))
+ (filename)
+ (interactive ,(concat "Fdump "
+ (file-name-sans-extension (nth 1 spec))
+ " : "))
+ (ids-dump-ranges ',(car spec) filename))))
+
+
+;;; @ End.
+;;;
+
+(provide 'ids-dump)
+
+;;; ids-dump.el ends here
projects / chise / ids.git / commitdiff