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 (defun ids-dump-insert-line (ccs line-spec code)
  30   (let ((chr (decode-char ccs code))
  31         id-list)
  32     (when chr
  33       (setq id-list (get-char-attribute chr 'ideographic-structure))
  34       (insert (format line-spec
  35                       code (decode-builtin-char ccs code)
  36                       (if id-list
  37                           (ids-format-list id-list)
  38                         (char-to-string chr)))))))
  39
  40 (defun ids-dump-insert-ccs-ranges (ccs line-spec &rest ranges)
  41   (let (range code max-code)
  42     (while ranges
  43       (setq range (car ranges))
  44       (cond ((consp range)
  45              (setq code (car range)
  46                    max-code (cdr range))
  47              (while (<= code max-code)
  48                (ids-dump-insert-line ccs line-spec code)
  49                (setq code (1+ code))))
  50             ((integerp range)
  51              (ids-dump-insert-line ccs line-spec range))
  52             (t (error 'wrong-type-argument range)))
  53       (setq ranges (cdr ranges)))))
  54
  55 (defun ids-dump-insert-daikanwa (start end)
  56   (let ((i start)
  57         mdh-alist
  58         chr sal)
  59     (map-char-attribute
  60      (lambda (key val)
  61        (when (= (length val) 2)
  62          (set-alist 'mdh-alist
  63                     (car val)
  64                     (put-alist (nth 1 val)
  65                                key
  66                                (cdr (assq (car val) mdh-alist)))))
  67        nil)
  68      'morohashi-daikanwa)
  69     (while (<= i end)
  70       (when (setq chr (decode-char 'ideograph-daikanwa i))
  71         (insert
  72          (format "M-%05d \t%c\t%s\n"
  73                  i (decode-builtin-char 'ideograph-daikanwa i)
  74                  (or (ids-format-list
  75                       (get-char-attribute chr 'ideographic-structure))
  76                      ""))))
  77       (when (setq sal (assq i mdh-alist))
  78         (setq sal (cdr sal))
  79         (when (setq chr (assq 1 sal))
  80           (setq chr (cdr chr))
  81           (insert
  82            (format "M-%05d'\t%c\t%s\n"
  83                    i chr
  84                    (or (ids-format-list
  85                         (get-char-attribute chr 'ideographic-structure))
  86                        ""))))
  87         (when (setq chr (assq 2 sal))
  88           (setq chr (cdr chr))
  89           (insert
  90            (format "M-%05d\"\t%c\t%s\n"
  91                    i chr
  92                    (ids-format-list
  93                     (get-char-attribute chr 'ideographic-structure)))))
  94         )
  95       (setq i (1+ i)))))
  96
  97 (defun ids-dump-insert-daikanwa-hokan ()
  98   (let (chr sal)
  99     (map-char-attribute
 100      (lambda (key val)
 101        (when (and (eq (car val) 'ho)
 102                   (null (nthcdr 2 val)))
 103          (setq sal (cons (cons (nth 1 val) key) sal)))
 104        nil)
 105      'morohashi-daikanwa)
 106     (setq sal (sort sal (lambda (a b) (< (car a)(car b)))))
 107     (dolist (cell sal)
 108       (setq chr (cdr cell))
 109       (insert
 110        (format "MH-%04d \t%c\t%s\n"
 111                (car cell)
 112                chr
 113                (ids-format-list
 114                 (get-char-attribute chr 'ideographic-structure)))))))
 115
 116 (defun ids-dump-insert-jis-x0208-1990 ()
 117   (let ((row 16)
 118         cell h l code chr)
 119     (while (<= row 83)
 120       (setq h (+ row 32))
 121       (setq cell 1)
 122       (while (<= cell 94)
 123         (setq l (+ cell 32))
 124         (setq chr (make-char 'japanese-jisx0208-1990 h l))
 125         (insert
 126          (format "J90-%02X%02X\t%c\t%s\n"
 127                  h l
 128                  (decode-builtin-char 'japanese-jisx0208-1990
 129                                       (logior (lsh h 8) l))
 130                  (or (ids-format-list
 131                       (get-char-attribute chr 'ideographic-structure))
 132                      "")))
 133         (setq cell (1+ cell)))
 134       (setq row (1+ row)))
 135     (setq h (+ row 32))
 136     (setq cell 1)
 137     (while (<= cell 6)
 138       (setq l (+ cell 32))
 139       (setq chr (make-char 'japanese-jisx0208-1990 h l))
 140       (insert
 141        (format "J90-%02X%02X\t%c\t%s\n"
 142                h l
 143                (decode-builtin-char 'japanese-jisx0208-1990
 144                                     (logior (lsh h 8) l))
 145                (or (ids-format-list
 146                     (get-char-attribute chr 'ideographic-structure))
 147                    "")))
 148       (setq cell (1+ cell)))))
 149
 150 (defun ids-dump-range (file path func &rest args)
 151   (with-temp-buffer
 152     (let* ((coding-system-for-write 'utf-8-mcs-er))
 153       (if (file-directory-p path)
 154           (setq path (expand-file-name file path)))
 155       (insert ";; -*- coding: utf-8-mcs-er -*-\n")
 156       (apply func args)
 157       (write-region (point-min)(point-max) path))))
 158
 159 ;;;###autoload
 160 (defun ids-dump-ucs-basic (filename)
 161   (interactive "Fdump IDS-UCS-Basic : ")
 162   (ids-dump-range "IDS-UCS-Basic.txt" filename
 163                   #'ids-dump-insert-ccs-ranges 'ucs "U+%04X\t%c\t%s\n"
 164                   '(#x4E00 . #x9FA5)))
 165
 166 ;;;###autoload
 167 (defun ids-dump-ucs-ext-a (filename)
 168   (interactive "Fdump IDS-UCS-Ext-A : ")
 169   (ids-dump-range "IDS-UCS-Ext-A.txt" filename
 170                   #'ids-dump-insert-ccs-ranges 'ucs "U+%04X\t%c\t%s\n"
 171                   '(#x3400 . #x4DB5) #xFA1F #xFA23))
 172
 173 ;;;###autoload
 174 (defun ids-dump-ucs-compat (filename)
 175   (interactive "Fdump IDS-UCS-Compat : ")
 176   (ids-dump-range "IDS-UCS-Compat.txt" filename
 177                   #'ids-dump-insert-ccs-ranges 'ucs "U+%04X\t%c\t%s\n"
 178                   '(#xF900 . #xFA1E) '(#xFA20 . #xFA22) '(#xFA24 . #xFA2D)))
 179
 180 ;;;###autoload
 181 (defun ids-dump-ucs-ext-b-1 (filename)
 182   (interactive "Fdump IDS-UCS-Ext-B-1 : ")
 183   (ids-dump-range "IDS-UCS-Ext-B-1.txt" filename
 184                   #'ids-dump-insert-ccs-ranges 'ucs "U-%08X\t%c\t%s\n"
 185                   '(#x20000 . #x21FFF)))
 186
 187 ;;;###autoload
 188 (defun ids-dump-ucs-ext-b-2 (filename)
 189   (interactive "Fdump IDS-UCS-Ext-B-2 : ")
 190   (ids-dump-range "IDS-UCS-Ext-B-2.txt" filename
 191                   #'ids-dump-insert-ccs-ranges 'ucs "U-%08X\t%c\t%s\n"
 192                   '(#x22000 . #x23FFF)))
 193
 194 ;;;###autoload
 195 (defun ids-dump-ucs-ext-b-3 (filename)
 196   (interactive "Fdump IDS-UCS-Ext-B-3 : ")
 197   (ids-dump-range "IDS-UCS-Ext-B-3.txt" filename
 198                   #'ids-dump-insert-ccs-ranges 'ucs "U-%08X\t%c\t%s\n"
 199                   '(#x24000 . #x25FFF)))
 200
 201 ;;;###autoload
 202 (defun ids-dump-ucs-ext-b-4 (filename)
 203   (interactive "Fdump IDS-UCS-Ext-B-4 : ")
 204   (ids-dump-range "IDS-UCS-Ext-B-4.txt" filename
 205                   #'ids-dump-insert-ccs-ranges 'ucs "U-%08X\t%c\t%s\n"
 206                   '(#x26000 . #x27FFF)))
 207
 208 ;;;###autoload
 209 (defun ids-dump-ucs-ext-b-5 (filename)
 210   (interactive "Fdump IDS-UCS-Ext-B-5 : ")
 211   (ids-dump-range "IDS-UCS-Ext-B-5.txt" filename
 212                   #'ids-dump-insert-ccs-ranges 'ucs "U-%08X\t%c\t%s\n"
 213                   '(#x28000 . #x29FFF)))
 214
 215 ;;;###autoload
 216 (defun ids-dump-ucs-ext-b-6 (filename)
 217   (interactive "Fdump IDS-UCS-Ext-B-6 : ")
 218   (ids-dump-range "IDS-UCS-Ext-B-6.txt" filename
 219                   #'ids-dump-insert-ccs-ranges 'ucs "U-%08X\t%c\t%s\n"
 220                   '(#x2A000 . #x2A6D6)))
 221
 222 ;;;###autoload
 223 (defun ids-dump-ucs-compat-supplement (filename)
 224   (interactive "Fdump IDS-UCS-Compat-Supplement : ")
 225   (ids-dump-range "IDS-UCS-Compat-Supplement.txt" filename
 226                   #'ids-dump-insert-ccs-ranges 'ucs "U-%08X\t%c\t%s\n"
 227                   '(#x2F800 . #x2FA1D)))
 228
 229 ;;;###autoload
 230 (defun ids-dump-daikanwa-01 (filename)
 231   (interactive "Fdump IDS-Daikanwa-01 : ")
 232   (ids-dump-range "IDS-Daikanwa-01.txt" filename
 233                   #'ids-dump-insert-daikanwa 00001 01449))
 234
 235 ;;;###autoload
 236 (defun ids-dump-daikanwa-02 (filename)
 237   (interactive "Fdump IDS-Daikanwa-02 : ")
 238   (ids-dump-range "IDS-Daikanwa-02.txt" filename
 239                   #'ids-dump-insert-daikanwa 01450 04674))
 240
 241 ;;;###autoload
 242 (defun ids-dump-daikanwa-03 (filename)
 243   (interactive "Fdump IDS-Daikanwa-03 : ")
 244   (ids-dump-range "IDS-Daikanwa-03.txt" filename
 245                   #'ids-dump-insert-daikanwa 04675 07410))
 246
 247 ;;;###autoload
 248 (defun ids-dump-daikanwa-04 (filename)
 249   (interactive "Fdump IDS-Daikanwa-04 : ")
 250   (ids-dump-range "IDS-Daikanwa-04.txt" filename
 251                   #'ids-dump-insert-daikanwa 07411 11529))
 252
 253 ;;;###autoload
 254 (defun ids-dump-daikanwa-05 (filename)
 255   (interactive "Fdump IDS-Daikanwa-05 : ")
 256   (ids-dump-range "IDS-Daikanwa-05.txt" filename
 257                   #'ids-dump-insert-daikanwa 11530 14414))
 258
 259 ;;;###autoload
 260 (defun ids-dump-daikanwa-06 (filename)
 261   (interactive "Fdump IDS-Daikanwa-06 : ")
 262   (ids-dump-range "IDS-Daikanwa-06.txt" filename
 263                   #'ids-dump-insert-daikanwa 14415 17574))
 264
 265 ;;;###autoload
 266 (defun ids-dump-daikanwa-07 (filename)
 267   (interactive "Fdump IDS-Daikanwa-07 : ")
 268   (ids-dump-range "IDS-Daikanwa-07.txt" filename
 269                   #'ids-dump-insert-daikanwa 17575 22677))
 270
 271 ;;;###autoload
 272 (defun ids-dump-daikanwa-08 (filename)
 273   (interactive "Fdump IDS-Daikanwa-08 : ")
 274   (ids-dump-range "IDS-Daikanwa-08.txt" filename
 275                   #'ids-dump-insert-daikanwa 22678 28107))
 276
 277 ;;;###autoload
 278 (defun ids-dump-daikanwa-09 (filename)
 279   (interactive "Fdump IDS-Daikanwa-09 : ")
 280   (ids-dump-range "IDS-Daikanwa-09.txt" filename
 281                   #'ids-dump-insert-daikanwa 28108 32803))
 282
 283 ;;;###autoload
 284 (defun ids-dump-daikanwa-10 (filename)
 285   (interactive "Fdump IDS-Daikanwa-10 : ")
 286   (ids-dump-range "IDS-Daikanwa-10.txt" filename
 287                   #'ids-dump-insert-daikanwa 32804 38699))
 288
 289 ;;;###autoload
 290 (defun ids-dump-daikanwa-11 (filename)
 291   (interactive "Fdump IDS-Daikanwa-11 : ")
 292   (ids-dump-range "IDS-Daikanwa-11.txt" filename
 293                   #'ids-dump-insert-daikanwa 38700 42209))
 294
 295 ;;;###autoload
 296 (defun ids-dump-daikanwa-12 (filename)
 297   (interactive "Fdump IDS-Daikanwa-12 : ")
 298   (ids-dump-range "IDS-Daikanwa-12.txt" filename
 299                   #'ids-dump-insert-daikanwa 42210 48902))
 300
 301 ;;;###autoload
 302 (defun ids-dump-daikanwa-index (filename)
 303   (interactive "Fdump IDS-Daikanwa-dx : ")
 304   (ids-dump-range "IDS-Daikanwa-dx.txt" filename
 305                   #'ids-dump-insert-daikanwa 48903 49964))
 306
 307 ;;;###autoload
 308 (defun ids-dump-daikanwa-hokan (filename)
 309   (interactive "Fdump IDS-Daikanwa-ho : ")
 310   (ids-dump-range "IDS-Daikanwa-ho.txt" filename
 311                   #'ids-dump-insert-daikanwa-hokan))
 312
 313 ;;;###autoload
 314 (defun ids-dump-cbeta (filename)
 315   (interactive "Fdump IDS-CBETA : ")
 316   (ids-dump-range "IDS-CBETA.txt" filename
 317                   #'ids-dump-insert-ccs-ranges
 318                   'ideograph-cbeta "CB%05d\t%c\t%s\n"
 319                   '(1 . 13363)))
 320
 321 ;;;###autoload
 322 (defun ids-dump-jis-x0208-1990 (filename)
 323   (interactive "Fdump IDS-JIS-X0208-1990 : ")
 324   (ids-dump-range "IDS-JIS-X0208-1990.txt" filename
 325                   #'ids-dump-insert-jis-x0208-1990))
 326
 327
 328 ;;; @ End.
 329 ;;;
 330
 331 (provide 'ids-dump)
 332
 333 ;;; ids-dump.el ends here