dump-tables.el

   1 ;;; dump-tables.el --- Dump utility of mapping tables
   2
   3 ;; Copyright (C) 2002 MORIOKA Tomohiko
   4
   5 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
   6 ;; Keywords: Ideographs, Character Database, UTF-2000, UCS, Unicode
   7
   8 ;; This file is a part of tomoyo-tools.
   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 ;;;###autoload
  28 (defun dump-jis-x0208-1990-to-ucs-table (filename)
  29   (interactive "Fdump J90-to-UCS : ")
  30   (if (file-directory-p filename)
  31       (setq filename (expand-file-name "J90-to-UCS.txt" filename)))
  32   (with-temp-buffer
  33     (let ((row 33)
  34           cell chr ucs ucs-j)
  35       (while (< row 127)
  36         (setq cell 33)
  37         (while (< cell 127)
  38           (when (and (setq chr (make-char 'japanese-jisx0208-1990 row cell))
  39                      (setq ucs (or (get-char-attribute chr 'ucs)
  40                                    (get-char-attribute chr '=>ucs)
  41                                    (get-char-attribute chr '->ucs))))
  42             (setq ucs-j (or (get-char-attribute chr 'ucs-jis)
  43                             (get-char-attribute chr '=>ucs-jis)))
  44             (insert (format "J90-%02X%02X" row cell))
  45             (if ucs-j
  46                 (insert (format "\tJU+%04X\t" ucs-j))
  47               (insert "\t "))
  48             (insert (format (if (<= ucs #xFFFF)
  49                                 "U+%04X\n"
  50                               "U-%08X\n")
  51                             ucs)))
  52           (setq cell (1+ cell)))
  53         (setq row (1+ row))))
  54     (write-region (point-min)(point-max) filename)))
  55
  56 ;;;###autoload
  57 (defun dump-jis-x0212-to-ucs-table (filename)
  58   (interactive "Fdump JSP-to-UCS : ")
  59   (if (file-directory-p filename)
  60       (setq filename (expand-file-name "JSP-to-UCS.txt" filename)))
  61   (with-temp-buffer
  62     (let ((row 33)
  63           cell chr ucs ucs-j)
  64       (while (< row 127)
  65         (setq cell 33)
  66         (while (< cell 127)
  67           (when (and (setq chr (make-char 'japanese-jisx0212 row cell))
  68                      (setq ucs (or (get-char-attribute chr 'ucs)
  69                                    (get-char-attribute chr '=>ucs)
  70                                    (get-char-attribute chr '->ucs))))
  71             (setq ucs-j (or (get-char-attribute chr 'ucs-jis)
  72                             (get-char-attribute chr '=>ucs-jis)))
  73             (insert (format "JSP-%02X%02X" row cell))
  74             (if ucs-j
  75                 (insert (format "\tJU+%04X\t" ucs-j))
  76               (insert "\t "))
  77             (insert (format (if (<= ucs #xFFFF)
  78                                 "U+%04X\n"
  79                               "U-%08X\n")
  80                             ucs)))
  81           (setq cell (1+ cell)))
  82         (setq row (1+ row))))
  83     (write-region (point-min)(point-max) filename)))
  84
  85 ;;;###autoload
  86 (defun dump-jis-x0213-1-to-ucs-table (filename)
  87   (interactive "Fdump JX1-to-UCS : ")
  88   (if (file-directory-p filename)
  89       (setq filename (expand-file-name "JX1-to-UCS.txt" filename)))
  90   (with-temp-buffer
  91     (let ((row 33)
  92           cell chr ucs ucs-j)
  93       (while (< row 127)
  94         (setq cell 33)
  95         (while (< cell 127)
  96           (when (and (setq chr (make-char 'japanese-jisx0213-1 row cell))
  97                      (setq ucs (or (get-char-attribute chr 'ucs)
  98                                    (get-char-attribute chr '=>ucs)
  99                                    (get-char-attribute chr '->ucs))))
 100             (setq ucs-j (or (get-char-attribute chr 'ucs-jis)
 101                             (get-char-attribute chr '=>ucs-jis)))
 102             (insert (format "JX1-%02X%02X" row cell))
 103             (if ucs-j
 104                 (insert (format "\tJU+%04X\t" ucs-j))
 105               (insert "\t "))
 106             (insert (format (if (<= ucs #xFFFF)
 107                                 "U+%04X\n"
 108                               "U-%08X\n")
 109                             ucs)))
 110           (setq cell (1+ cell)))
 111         (setq row (1+ row))))
 112     (write-region (point-min)(point-max) filename)))
 113
 114 ;;;###autoload
 115 (defun dump-jis-x0213-2-to-ucs-table (filename)
 116   (interactive "Fdump JX2-to-UCS : ")
 117   (if (file-directory-p filename)
 118       (setq filename (expand-file-name "JX2-to-UCS.txt" filename)))
 119   (with-temp-buffer
 120     (let ((row 33)
 121           cell chr ucs ucs-j)
 122       (while (< row 127)
 123         (setq cell 33)
 124         (while (< cell 127)
 125           (when (and (setq chr (make-char 'japanese-jisx0213-2 row cell))
 126                      (setq ucs (or (get-char-attribute chr 'ucs)
 127                                    (get-char-attribute chr '=>ucs)
 128                                    (get-char-attribute chr '->ucs))))
 129             (setq ucs-j (or (get-char-attribute chr 'ucs-jis)
 130                             (get-char-attribute chr '=>ucs-jis)))
 131             (insert (format "JX2-%02X%02X" row cell))
 132             (if ucs-j
 133                 (insert (format "\tJU+%04X\t" ucs-j))
 134               (insert "\t "))
 135             (insert (format (if (<= ucs #xFFFF)
 136                                 "U+%04X\n"
 137                               "U-%08X\n")
 138                             ucs)))
 139           (setq cell (1+ cell)))
 140         (setq row (1+ row))))
 141     (write-region (point-min)(point-max) filename)))
 142
 143 ;;;###autoload
 144 (defun dump-cns-11643-3-to-ucs-table (filename)
 145   (interactive "Fdump C3-to-UCS : ")
 146   (if (file-directory-p filename)
 147       (setq filename (expand-file-name "C3-to-UCS.txt" filename)))
 148   (with-temp-buffer
 149     (let ((row 33)
 150           cell chr ucs ucs-cns)
 151       (while (< row 127)
 152         (setq cell 33)
 153         (while (< cell 127)
 154           (when (and (setq chr (make-char 'chinese-cns11643-3 row cell))
 155                      (setq ucs (or (get-char-attribute chr 'ucs)
 156                                    (get-char-attribute chr '=>ucs)
 157                                    (get-char-attribute chr '->ucs))))
 158             (setq ucs-cns (or (get-char-attribute chr 'ucs-cns)
 159                               (get-char-attribute chr '=>ucs-cns)))
 160             (insert (format "C3-%02X%02X" row cell))
 161             (if ucs-cns
 162                 (insert (format "\tCU+%04X\t" ucs-cns))
 163               (insert "\t "))
 164             (insert (format (if (<= ucs #xFFFF)
 165                                 "U+%04X\n"
 166                               "U-%08X\n")
 167                             ucs)))
 168           (setq cell (1+ cell)))
 169         (setq row (1+ row))))
 170     (write-region (point-min)(point-max) filename)))
 171
 172 ;;;###autoload
 173 (defun dump-cns-11643-4-to-ucs-table (filename)
 174   (interactive "Fdump C4-to-UCS : ")
 175   (if (file-directory-p filename)
 176       (setq filename (expand-file-name "C4-to-UCS.txt" filename)))
 177   (with-temp-buffer
 178     (let ((row 33)
 179           cell chr ucs ucs-cns)
 180       (while (< row 127)
 181         (setq cell 33)
 182         (while (< cell 127)
 183           (when (and (setq chr (make-char 'chinese-cns11643-4 row cell))
 184                      (setq ucs (or (get-char-attribute chr 'ucs)
 185                                    (get-char-attribute chr '=>ucs)
 186                                    (get-char-attribute chr '->ucs))))
 187             (setq ucs-cns (or (get-char-attribute chr 'ucs-cns)
 188                               (get-char-attribute chr '=>ucs-cns)))
 189             (insert (format "C4-%02X%02X" row cell))
 190             (if ucs-cns
 191                 (insert (format "\tCU+%04X\t" ucs-cns))
 192               (insert "\t "))
 193             (insert (format (if (<= ucs #xFFFF)
 194                                 "U+%04X\n"
 195                               "U-%08X\n")
 196                             ucs)))
 197           (setq cell (1+ cell)))
 198         (setq row (1+ row))))
 199     (write-region (point-min)(point-max) filename)))
 200
 201 ;;;###autoload
 202 (defun dump-big5-to-ucs-table (filename)
 203   (interactive "Fdump B-to-UCS : ")
 204   (if (file-directory-p filename)
 205       (setq filename (expand-file-name "B-to-UCS.txt" filename)))
 206   (with-temp-buffer
 207     (let ((row #xA1)
 208           cell chr ucs ucs-big5)
 209       (while (<= row #xFE)
 210         (setq cell #x40)
 211         (while (< cell #xFE)
 212           (when (and (setq chr (make-char 'chinese-big5 row cell))
 213                      (setq ucs (or (get-char-attribute chr 'ucs)
 214                                    (get-char-attribute chr '=>ucs)
 215                                    (get-char-attribute chr '->ucs))))
 216             (setq ucs-big5 (or (get-char-attribute chr 'ucs-big5)
 217                                (get-char-attribute chr '=>ucs-big5)))
 218             (insert (format "B-%02X%02X" row cell))
 219             (if ucs-big5
 220                 (insert (format "\tBU+%04X\t" ucs-big5))
 221               (insert "\t "))
 222             (insert (format (if (<= ucs #xFFFF)
 223                                 "U+%04X\n"
 224                               "U-%08X\n")
 225                             ucs)))
 226           (setq cell (1+ cell)))
 227         (setq row (1+ row))))
 228     (write-region (point-min)(point-max) filename)))
 229
 230 ;;;###autoload
 231 (defun dump-jef-china3-to-ucs-table (filename)
 232   (interactive "Fdump JC3-to-UCS : ")
 233   (if (file-directory-p filename)
 234       (setq filename (expand-file-name "JC3-to-UCS.txt" filename)))
 235   (with-temp-buffer
 236     (let ((row #x41)
 237           cell chr ucs)
 238       (while (<= row #x9F)
 239         (setq cell #xA1)
 240         (while (< cell #xFE)
 241           (when (and (setq chr (make-char 'china3-jef row cell))
 242                      (setq ucs (or (get-char-attribute chr 'ucs)
 243                                    (get-char-attribute chr '=>ucs))))
 244             (insert (format "JC3-%02X%02X\t" row cell))
 245             (insert (format (if (<= ucs #xFFFF)
 246                                 "U+%04X\n"
 247                               "U-%08X\n")
 248                             ucs)))
 249           (setq cell (1+ cell)))
 250         (setq row (1+ row))))
 251     (write-region (point-min)(point-max) filename)))
 252
 253
 254 ;;; @ End.
 255 ;;;
 256
 257 (provide 'dump-tables)
 258
 259 ;;; dump-tables.el ends here