ids-dump.el

   1 ;;; ids-dump.el --- Dump utility of IDS-* files
   2
   3 ;; Copyright (C) 2002 MORIOKA Tomohiko
   4
   5 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
   6 ;; Keywords: IDS, IDC, Ideographs, UCS, Unicode
   7
   8 ;; This file is a part of IDS.
   9
  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.
  14
  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.
  19
  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.
  24
  25 ;;; Code:
  26
  27 (require 'ids)
  28
  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"
  33                (#x4E00 . #x9FA5))
  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"
  45                  (#x20000 . #x21FFF))
  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"
  49                  (#x22000 . #x23FFF))
  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"
  53                  (#x24000 . #x25FFF))
  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"
  57                  (#x26000 . #x27FFF))
  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"
  61                  (#x28000 . #x29FFF))
  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"
  65                  (#x2A000 . #x2A6D6))
  66     (ucs-compat-supplement "IDS-UCS-Compat-Supplement.txt"
  67                            ids-dump-insert-ccs-ranges
  68                            ucs "U-%08X\t%c\t%s\n"
  69                            (#x2F800 . #x2FA1D))
  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"
  86            (1 . 13363))
  87     ))
  88
  89 (defun ids-dump-insert-line (ccs line-spec code)
  90   (let ((chr (decode-char ccs code))
  91         id-list)
  92     (when chr
  93       (setq id-list (get-char-attribute chr 'ideographic-structure))
  94       (insert (format line-spec
  95                       code (decode-builtin-char ccs code)
  96                       (if id-list
  97                           (ids-format-list id-list)
  98                         (char-to-string chr)))))))
  99
 100 (defun ids-dump-insert-ccs-ranges (ccs line-spec &rest ranges)
 101   (let (range code max-code)
 102     (while ranges
 103       (setq range (car ranges))
 104       (cond ((consp range)
 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))))
 110             ((integerp range)
 111              (ids-dump-insert-line ccs line-spec range))
 112             (t (error 'wrong-type-argument range)))
 113       (setq ranges (cdr ranges)))))
 114
 115 (defun ids-dump-ranges (range filename)
 116   (with-temp-buffer
 117     (let* ((coding-system-for-write 'utf-8)
 118            (spec (assq range ids-dump-file-specs-alist))
 119            (file (nth 1 spec))
 120            (func (nth 2 spec))
 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")
 125       (apply func args)
 126       (write-region (point-min)(point-max)
 127                     filename))))
 128
 129 (defun ids-dump-insert-daikanwa (start end)
 130   (let ((i start)
 131         mdh-alist
 132         chr sal)
 133     (map-char-attribute
 134      (lambda (key val)
 135        (when (= (length val) 2)
 136          (set-alist 'mdh-alist
 137                     (car val)
 138                     (put-alist (nth 1 val)
 139                                key
 140                                (cdr (assq (car val) mdh-alist)))))
 141        nil)
 142      'morohashi-daikanwa)
 143     (while (<= i end)
 144       (when (setq chr (decode-char 'ideograph-daikanwa i))
 145         (insert
 146          (format "M-%05d \t%c\t%s\n"
 147                  i (decode-builtin-char 'ideograph-daikanwa i)
 148                  (ids-format-list
 149                   (get-char-attribute chr 'ideographic-structure)))))
 150       (when (setq sal (assq i mdh-alist))
 151         (setq sal (cdr sal))
 152         (when (setq chr (assq 1 sal))
 153           (setq chr (cdr chr))
 154           (insert
 155            (format "M-%05d'\t%c\t%s\n"
 156                    i chr
 157                    (ids-format-list
 158                     (get-char-attribute chr 'ideographic-structure)))))
 159         (when (setq chr (assq 2 sal))
 160           (setq chr (cdr chr))
 161           (insert
 162            (format "M-%05d\"\t%c\t%s\n"
 163                    i chr
 164                    (ids-format-list
 165                     (get-char-attribute chr 'ideographic-structure)))))
 166         )
 167       (setq i (1+ i)))))
 168
 169 (defun ids-dump-insert-daikanwa-hokan ()
 170   (let (chr sal)
 171     (map-char-attribute
 172      (lambda (key val)
 173        (when (and (eq (car val) 'ho)
 174                   (null (nthcdr 2 val)))
 175          (setq sal (cons (cons (nth 1 val) key) sal)))
 176        nil)
 177      'morohashi-daikanwa)
 178     (setq sal (sort sal (lambda (a b) (< (car a)(car b)))))
 179     (dolist (cell sal)
 180       (setq chr (cdr cell))
 181       (insert
 182        (format "MH-%04d \t%c\t%s\n"
 183                (car cell)
 184                chr
 185                (ids-format-list
 186                 (get-char-attribute chr 'ideographic-structure)))))))
 187
 188 (dolist (spec ids-dump-file-specs-alist)
 189   (eval `(defun ,(intern (concat "ids-dump-" (symbol-name (car spec))))
 190            (filename)
 191            (interactive ,(concat "Fdump "
 192                                  (file-name-sans-extension (nth 1 spec))
 193                                  " : "))
 194            (ids-dump-ranges ',(car spec) filename))))
 195
 196
 197 ;;; @ End.
 198 ;;;
 199
 200 (provide 'ids-dump)
 201
 202 ;;; ids-dump.el ends here