ids-dump.el

   1 ;;; ids-dump.el --- Dump utility of IDS-* files
   2
   3 ;; Copyright (C) 2002,2003 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-94x94-ccs-ranges (ccs line-spec &rest ranges)
  56   (let (range code max-code l)
  57     (while ranges
  58       (setq range (car ranges))
  59       (cond ((consp range)
  60              (setq code (car range)
  61                    max-code (cdr range))
  62              (while (<= code max-code)
  63                (setq l (logand code 255))
  64                (if (and (<= #x21 l)(<= l #x7E))
  65                    (ids-dump-insert-line ccs line-spec code))
  66                (setq code (1+ code))))
  67             ((integerp range)
  68              (ids-dump-insert-line ccs line-spec range))
  69             (t (error 'wrong-type-argument range)))
  70       (setq ranges (cdr ranges)))))
  71
  72 (defun ids-dump-insert-daikanwa (start end)
  73   (let ((i start)
  74         mdh-alist
  75         chr sal)
  76     (map-char-attribute
  77      (lambda (key val)
  78        (when (= (length val) 2)
  79          (set-alist 'mdh-alist
  80                     (car val)
  81                     (put-alist (nth 1 val)
  82                                key
  83                                (cdr (assq (car val) mdh-alist)))))
  84        nil)
  85      'morohashi-daikanwa)
  86     (while (<= i end)
  87       (when (setq chr (decode-char 'ideograph-daikanwa i))
  88         (insert
  89          (format "M-%05d \t%c\t%s\n"
  90                  i (decode-builtin-char 'ideograph-daikanwa i)
  91                  (or (ids-format-list
  92                       (get-char-attribute chr 'ideographic-structure))
  93                      ""))))
  94       (when (setq sal (assq i mdh-alist))
  95         (setq sal (cdr sal))
  96         (when (setq chr (assq 1 sal))
  97           (setq chr (cdr chr))
  98           (insert
  99            (format "M-%05d'\t%c\t%s\n"
 100                    i chr
 101                    (or (ids-format-list
 102                         (get-char-attribute chr 'ideographic-structure))
 103                        ""))))
 104         (when (setq chr (assq 2 sal))
 105           (setq chr (cdr chr))
 106           (insert
 107            (format "M-%05d\"\t%c\t%s\n"
 108                    i chr
 109                    (ids-format-list
 110                     (get-char-attribute chr 'ideographic-structure)))))
 111         )
 112       (setq i (1+ i)))))
 113
 114 (defun ids-dump-insert-daikanwa-hokan ()
 115   (let (chr sal)
 116     (map-char-attribute
 117      (lambda (key val)
 118        (when (and (eq (car val) 'ho)
 119                   (null (nthcdr 2 val)))
 120          (setq sal (cons (cons (nth 1 val) key) sal)))
 121        nil)
 122      'morohashi-daikanwa)
 123     (setq sal (sort sal (lambda (a b) (< (car a)(car b)))))
 124     (dolist (cell sal)
 125       (setq chr (cdr cell))
 126       (insert
 127        (format "MH-%04d \t%c\t%s\n"
 128                (car cell)
 129                chr
 130                (ids-format-list
 131                 (get-char-attribute chr 'ideographic-structure)))))))
 132
 133 (defun ids-dump-insert-jis-x0208-1990 ()
 134   (let ((row 16)
 135         cell h l code chr)
 136     (while (<= row 83)
 137       (setq h (+ row 32))
 138       (setq cell 1)
 139       (while (<= cell 94)
 140         (setq l (+ cell 32))
 141         (setq chr (make-char 'japanese-jisx0208-1990 h l))
 142         (insert
 143          (format "J90-%02X%02X\t%c\t%s\n"
 144                  h l
 145                  (decode-builtin-char 'japanese-jisx0208-1990
 146                                       (logior (lsh h 8) l))
 147                  (or (ids-format-list
 148                       (get-char-attribute chr 'ideographic-structure))
 149                      "")))
 150         (setq cell (1+ cell)))
 151       (setq row (1+ row)))
 152     (setq h (+ row 32))
 153     (setq cell 1)
 154     (while (<= cell 6)
 155       (setq l (+ cell 32))
 156       (setq chr (make-char 'japanese-jisx0208-1990 h l))
 157       (insert
 158        (format "J90-%02X%02X\t%c\t%s\n"
 159                h l
 160                (decode-builtin-char 'japanese-jisx0208-1990
 161                                     (logior (lsh h 8) l))
 162                (or (ids-format-list
 163                     (get-char-attribute chr 'ideographic-structure))
 164                    "")))
 165       (setq cell (1+ cell)))))
 166
 167 (defun ids-dump-insert-big5 (ccs prefix)
 168   (let ((h #x81)
 169         l code chr structure)
 170     (while (<= h #xFE)
 171       (setq l #x40)
 172       (while (<= l #x7E)
 173         (setq chr (make-char ccs h l))
 174         (setq structure nil)
 175         (when (setq structure
 176                     (get-char-attribute chr 'ideographic-structure))
 177           (insert
 178            (format "%s%02X%02X\t%c\t%s\n"
 179                    prefix h l
 180                    (decode-builtin-char ccs
 181                                         (logior (lsh h 8) l))
 182                    (or (ids-format-list
 183                         (get-char-attribute chr 'ideographic-structure))
 184                        ""))))
 185         (setq l (1+ l)))
 186       (setq l #xA1)
 187       (while (<= l #xFE)
 188         (setq chr (make-char ccs h l))
 189         (setq structure nil)
 190         (when (setq structure
 191                     (get-char-attribute chr 'ideographic-structure))
 192           (insert
 193            (format "%s%02X%02X\t%c\t%s\n"
 194                    prefix h l
 195                    (decode-builtin-char ccs
 196                                         (logior (lsh h 8) l))
 197                    (or (ids-format-list
 198                         (get-char-attribute chr 'ideographic-structure))
 199                        ""))))
 200         (setq l (1+ l)))
 201       (setq h (1+ h)))))
 202
 203 (defun ids-dump-range (file path func &rest args)
 204   (with-temp-buffer
 205     (let* ((coding-system-for-write 'utf-8-mcs-er))
 206       (if (file-directory-p path)
 207           (setq path (expand-file-name file path)))
 208       (insert ";; -*- coding: utf-8-mcs-er -*-\n")
 209       (apply func args)
 210       (write-region (point-min)(point-max) path))))
 211
 212 ;;;###autoload
 213 (defun ids-dump-ucs-basic (filename)
 214   (interactive "Fdump IDS-UCS-Basic : ")
 215   (ids-dump-range "IDS-UCS-Basic.txt" filename
 216                   #'ids-dump-insert-ccs-ranges 'ucs "U+%04X\t%c\t%s\n"
 217                   '(#x4E00 . #x9FA5)))
 218
 219 ;;;###autoload
 220 (defun ids-dump-ucs-ext-a (filename)
 221   (interactive "Fdump IDS-UCS-Ext-A : ")
 222   (ids-dump-range "IDS-UCS-Ext-A.txt" filename
 223                   #'ids-dump-insert-ccs-ranges 'ucs "U+%04X\t%c\t%s\n"
 224                   '(#x3400 . #x4DB5) #xFA1F #xFA23))
 225
 226 ;;;###autoload
 227 (defun ids-dump-ucs-compat (filename)
 228   (interactive "Fdump IDS-UCS-Compat : ")
 229   (ids-dump-range "IDS-UCS-Compat.txt" filename
 230                   #'ids-dump-insert-ccs-ranges 'ucs "U+%04X\t%c\t%s\n"
 231                   '(#xF900 . #xFA1E) '(#xFA20 . #xFA22) '(#xFA24 . #xFA2D)))
 232
 233 ;;;###autoload
 234 (defun ids-dump-ucs-ext-b-1 (filename)
 235   (interactive "Fdump IDS-UCS-Ext-B-1 : ")
 236   (ids-dump-range "IDS-UCS-Ext-B-1.txt" filename
 237                   #'ids-dump-insert-ccs-ranges 'ucs "U-%08X\t%c\t%s\n"
 238                   '(#x20000 . #x21FFF)))
 239
 240 ;;;###autoload
 241 (defun ids-dump-ucs-ext-b-2 (filename)
 242   (interactive "Fdump IDS-UCS-Ext-B-2 : ")
 243   (ids-dump-range "IDS-UCS-Ext-B-2.txt" filename
 244                   #'ids-dump-insert-ccs-ranges 'ucs "U-%08X\t%c\t%s\n"
 245                   '(#x22000 . #x23FFF)))
 246
 247 ;;;###autoload
 248 (defun ids-dump-ucs-ext-b-3 (filename)
 249   (interactive "Fdump IDS-UCS-Ext-B-3 : ")
 250   (ids-dump-range "IDS-UCS-Ext-B-3.txt" filename
 251                   #'ids-dump-insert-ccs-ranges 'ucs "U-%08X\t%c\t%s\n"
 252                   '(#x24000 . #x25FFF)))
 253
 254 ;;;###autoload
 255 (defun ids-dump-ucs-ext-b-4 (filename)
 256   (interactive "Fdump IDS-UCS-Ext-B-4 : ")
 257   (ids-dump-range "IDS-UCS-Ext-B-4.txt" filename
 258                   #'ids-dump-insert-ccs-ranges 'ucs "U-%08X\t%c\t%s\n"
 259                   '(#x26000 . #x27FFF)))
 260
 261 ;;;###autoload
 262 (defun ids-dump-ucs-ext-b-5 (filename)
 263   (interactive "Fdump IDS-UCS-Ext-B-5 : ")
 264   (ids-dump-range "IDS-UCS-Ext-B-5.txt" filename
 265                   #'ids-dump-insert-ccs-ranges 'ucs "U-%08X\t%c\t%s\n"
 266                   '(#x28000 . #x29FFF)))
 267
 268 ;;;###autoload
 269 (defun ids-dump-ucs-ext-b-6 (filename)
 270   (interactive "Fdump IDS-UCS-Ext-B-6 : ")
 271   (ids-dump-range "IDS-UCS-Ext-B-6.txt" filename
 272                   #'ids-dump-insert-ccs-ranges 'ucs "U-%08X\t%c\t%s\n"
 273                   '(#x2A000 . #x2A6D6)))
 274
 275 ;;;###autoload
 276 (defun ids-dump-ucs-compat-supplement (filename)
 277   (interactive "Fdump IDS-UCS-Compat-Supplement : ")
 278   (ids-dump-range "IDS-UCS-Compat-Supplement.txt" filename
 279                   #'ids-dump-insert-ccs-ranges 'ucs "U-%08X\t%c\t%s\n"
 280                   '(#x2F800 . #x2FA1D)))
 281
 282 ;;;###autoload
 283 (defun ids-dump-cns11643-1 (filename)
 284   (interactive "Fdump IDS-CNS-1 : ")
 285   (ids-dump-range "IDS-CNS-1.txt" filename
 286                   #'ids-dump-insert-94x94-ccs-ranges
 287                   'chinese-cns11643-1 "C1-%04X\t%c\t%s\n"
 288                   '(#x4421 . #x7D4B)))
 289
 290 ;;;###autoload
 291 (defun ids-dump-cns11643-2 (filename)
 292   (interactive "Fdump IDS-CNS-2 : ")
 293   (ids-dump-range "IDS-CNS-2.txt" filename
 294                   #'ids-dump-insert-94x94-ccs-ranges
 295                   'chinese-cns11643-2 "C2-%04X\t%c\t%s\n"
 296                   '(#x2121 . #x7244)))
 297
 298 ;;;###autoload
 299 (defun ids-dump-cns11643-3 (filename)
 300   (interactive "Fdump IDS-CNS-3 : ")
 301   (ids-dump-range "IDS-CNS-3.txt" filename
 302                   #'ids-dump-insert-94x94-ccs-ranges
 303                   'chinese-cns11643-3 "C3-%04X\t%c\t%s\n"
 304                   '(#x2121 . #x6246)))
 305
 306 ;;;###autoload
 307 (defun ids-dump-daikanwa-01 (filename)
 308   (interactive "Fdump IDS-Daikanwa-01 : ")
 309   (ids-dump-range "IDS-Daikanwa-01.txt" filename
 310                   #'ids-dump-insert-daikanwa 00001 01449))
 311
 312 ;;;###autoload
 313 (defun ids-dump-daikanwa-02 (filename)
 314   (interactive "Fdump IDS-Daikanwa-02 : ")
 315   (ids-dump-range "IDS-Daikanwa-02.txt" filename
 316                   #'ids-dump-insert-daikanwa 01450 04674))
 317
 318 ;;;###autoload
 319 (defun ids-dump-daikanwa-03 (filename)
 320   (interactive "Fdump IDS-Daikanwa-03 : ")
 321   (ids-dump-range "IDS-Daikanwa-03.txt" filename
 322                   #'ids-dump-insert-daikanwa 04675 07410))
 323
 324 ;;;###autoload
 325 (defun ids-dump-daikanwa-04 (filename)
 326   (interactive "Fdump IDS-Daikanwa-04 : ")
 327   (ids-dump-range "IDS-Daikanwa-04.txt" filename
 328                   #'ids-dump-insert-daikanwa 07411 11529))
 329
 330 ;;;###autoload
 331 (defun ids-dump-daikanwa-05 (filename)
 332   (interactive "Fdump IDS-Daikanwa-05 : ")
 333   (ids-dump-range "IDS-Daikanwa-05.txt" filename
 334                   #'ids-dump-insert-daikanwa 11530 14414))
 335
 336 ;;;###autoload
 337 (defun ids-dump-daikanwa-06 (filename)
 338   (interactive "Fdump IDS-Daikanwa-06 : ")
 339   (ids-dump-range "IDS-Daikanwa-06.txt" filename
 340                   #'ids-dump-insert-daikanwa 14415 17574))
 341
 342 ;;;###autoload
 343 (defun ids-dump-daikanwa-07 (filename)
 344   (interactive "Fdump IDS-Daikanwa-07 : ")
 345   (ids-dump-range "IDS-Daikanwa-07.txt" filename
 346                   #'ids-dump-insert-daikanwa 17575 22677))
 347
 348 ;;;###autoload
 349 (defun ids-dump-daikanwa-08 (filename)
 350   (interactive "Fdump IDS-Daikanwa-08 : ")
 351   (ids-dump-range "IDS-Daikanwa-08.txt" filename
 352                   #'ids-dump-insert-daikanwa 22678 28107))
 353
 354 ;;;###autoload
 355 (defun ids-dump-daikanwa-09 (filename)
 356   (interactive "Fdump IDS-Daikanwa-09 : ")
 357   (ids-dump-range "IDS-Daikanwa-09.txt" filename
 358                   #'ids-dump-insert-daikanwa 28108 32803))
 359
 360 ;;;###autoload
 361 (defun ids-dump-daikanwa-10 (filename)
 362   (interactive "Fdump IDS-Daikanwa-10 : ")
 363   (ids-dump-range "IDS-Daikanwa-10.txt" filename
 364                   #'ids-dump-insert-daikanwa 32804 38699))
 365
 366 ;;;###autoload
 367 (defun ids-dump-daikanwa-11 (filename)
 368   (interactive "Fdump IDS-Daikanwa-11 : ")
 369   (ids-dump-range "IDS-Daikanwa-11.txt" filename
 370                   #'ids-dump-insert-daikanwa 38700 42209))
 371
 372 ;;;###autoload
 373 (defun ids-dump-daikanwa-12 (filename)
 374   (interactive "Fdump IDS-Daikanwa-12 : ")
 375   (ids-dump-range "IDS-Daikanwa-12.txt" filename
 376                   #'ids-dump-insert-daikanwa 42210 48902))
 377
 378 ;;;###autoload
 379 (defun ids-dump-daikanwa-index (filename)
 380   (interactive "Fdump IDS-Daikanwa-dx : ")
 381   (ids-dump-range "IDS-Daikanwa-dx.txt" filename
 382                   #'ids-dump-insert-daikanwa 48903 49964))
 383
 384 ;;;###autoload
 385 (defun ids-dump-daikanwa-hokan (filename)
 386   (interactive "Fdump IDS-Daikanwa-ho : ")
 387   (ids-dump-range "IDS-Daikanwa-ho.txt" filename
 388                   #'ids-dump-insert-daikanwa-hokan))
 389
 390 ;;;###autoload
 391 (defun ids-dump-cbeta (filename)
 392   (interactive "Fdump IDS-CBETA : ")
 393   (ids-dump-range "IDS-CBETA.txt" filename
 394                   #'ids-dump-insert-ccs-ranges
 395                   'ideograph-cbeta "CB%05d\t%c\t%s\n"
 396                   '(1 . 13363)))
 397
 398 ;;;###autoload
 399 (defun ids-dump-jis-x0208-1990 (filename)
 400   (interactive "Fdump IDS-JIS-X0208-1990 : ")
 401   (ids-dump-range "IDS-JIS-X0208-1990.txt" filename
 402                   #'ids-dump-insert-jis-x0208-1990))
 403
 404 ;;;###autoload
 405 (defun ids-dump-big5-cdp (filename)
 406   (interactive "Fdump IDS-CDP : ")
 407   (ids-dump-range "IDS-CDP.txt" filename
 408                   #'ids-dump-insert-big5
 409                   '=big5-cdp "CDP-"))
 410
 411
 412 ;;; @ End.
 413 ;;;
 414
 415 (provide 'ids-dump)
 416
 417 ;;; ids-dump.el ends here