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 (and ucs-j (/= ucs-j ucs))
  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 (and ucs-j (/= ucs-j ucs))
  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                      (not (encode-char chr 'japanese-jisx0208-1990 t))
  98                      (setq ucs (or (get-char-attribute chr 'ucs)
  99                                    (get-char-attribute chr '=>ucs)
 100                                    (get-char-attribute chr '->ucs))))
 101             (setq ucs-j (or (get-char-attribute chr 'ucs-jis)
 102                             (get-char-attribute chr '=>ucs-jis)))
 103             (insert (format "JX1-%02X%02X" row cell))
 104             (if ucs-j
 105                 (insert (format "\tJU+%04X\t" ucs-j))
 106               (insert "\t "))
 107             (insert (format (if (<= ucs #xFFFF)
 108                                 "U+%04X\n"
 109                               "U-%08X\n")
 110                             ucs)))
 111           (setq cell (1+ cell)))
 112         (setq row (1+ row))))
 113     (write-region (point-min)(point-max) filename)))
 114
 115 ;;;###autoload
 116 (defun dump-jis-x0213-2-to-ucs-table (filename)
 117   (interactive "Fdump JX2-to-UCS : ")
 118   (if (file-directory-p filename)
 119       (setq filename (expand-file-name "JX2-to-UCS.txt" filename)))
 120   (with-temp-buffer
 121     (let ((row 33)
 122           cell chr ucs ucs-j)
 123       (while (< row 127)
 124         (setq cell 33)
 125         (while (< cell 127)
 126           (when (and (setq chr (make-char 'japanese-jisx0213-2 row cell))
 127                      (setq ucs (or (get-char-attribute chr 'ucs)
 128                                    (get-char-attribute chr '=>ucs)
 129                                    (get-char-attribute chr '->ucs))))
 130             (setq ucs-j (or (get-char-attribute chr 'ucs-jis)
 131                             (get-char-attribute chr '=>ucs-jis)))
 132             (insert (format "JX2-%02X%02X" row cell))
 133             (if ucs-j
 134                 (insert (format "\tJU+%04X\t" ucs-j))
 135               (insert "\t "))
 136             (insert (format (if (<= ucs #xFFFF)
 137                                 "U+%04X\n"
 138                               "U-%08X\n")
 139                             ucs)))
 140           (setq cell (1+ cell)))
 141         (setq row (1+ row))))
 142     (write-region (point-min)(point-max) filename)))
 143
 144 ;;;###autoload
 145 (defun dump-cns-11643-3-to-ucs-table (filename)
 146   (interactive "Fdump C3-to-UCS : ")
 147   (if (file-directory-p filename)
 148       (setq filename (expand-file-name "C3-to-UCS.txt" filename)))
 149   (with-temp-buffer
 150     (let ((row 33)
 151           cell chr ucs ucs-cns)
 152       (while (< row 127)
 153         (setq cell 33)
 154         (while (< cell 127)
 155           (when (and (setq chr (make-char 'chinese-cns11643-3 row cell))
 156                      (setq ucs (or (get-char-attribute chr 'ucs)
 157                                    (get-char-attribute chr '=>ucs)
 158                                    (get-char-attribute chr '->ucs))))
 159             (setq ucs-cns (or (get-char-attribute chr 'ucs-cns)
 160                               (get-char-attribute chr '=>ucs-cns)))
 161             (insert (format "C3-%02X%02X" row cell))
 162             (if (and ucs-cns (/= ucs-cns ucs))
 163                 (insert (format "\tCU+%04X\t" ucs-cns))
 164               (insert "\t "))
 165             (insert (format (if (<= ucs #xFFFF)
 166                                 "U+%04X\n"
 167                               "U-%08X\n")
 168                             ucs)))
 169           (setq cell (1+ cell)))
 170         (setq row (1+ row))))
 171     (write-region (point-min)(point-max) filename)))
 172
 173 ;;;###autoload
 174 (defun dump-cns-11643-4-to-ucs-table (filename)
 175   (interactive "Fdump C4-to-UCS : ")
 176   (if (file-directory-p filename)
 177       (setq filename (expand-file-name "C4-to-UCS.txt" filename)))
 178   (with-temp-buffer
 179     (let ((row 33)
 180           cell chr ucs ucs-cns)
 181       (while (< row 127)
 182         (setq cell 33)
 183         (while (< cell 127)
 184           (when (and (setq chr (make-char 'chinese-cns11643-4 row cell))
 185                      (setq ucs (or (get-char-attribute chr 'ucs)
 186                                    (get-char-attribute chr '=>ucs)
 187                                    (get-char-attribute chr '->ucs))))
 188             (setq ucs-cns (or (get-char-attribute chr 'ucs-cns)
 189                               (get-char-attribute chr '=>ucs-cns)))
 190             (insert (format "C4-%02X%02X" row cell))
 191             (if ucs-cns
 192                 (insert (format "\tCU+%04X\t" ucs-cns))
 193               (insert "\t "))
 194             (insert (format (if (<= ucs #xFFFF)
 195                                 "U+%04X\n"
 196                               "U-%08X\n")
 197                             ucs)))
 198           (setq cell (1+ cell)))
 199         (setq row (1+ row))))
 200     (write-region (point-min)(point-max) filename)))
 201
 202 ;;;###autoload
 203 (defun dump-big5-to-ucs-table (filename)
 204   (interactive "Fdump B-to-UCS : ")
 205   (if (file-directory-p filename)
 206       (setq filename (expand-file-name "B-to-UCS.txt" filename)))
 207   (with-temp-buffer
 208     (let ((row #xA1)
 209           cell chr ucs ucs-big5)
 210       (while (<= row #xFE)
 211         (setq cell #x40)
 212         (while (< cell #xFE)
 213           (when (and (setq chr (make-char 'chinese-big5 row cell))
 214                      (setq ucs (or (get-char-attribute chr 'ucs)
 215                                    (get-char-attribute chr '=>ucs)
 216                                    (get-char-attribute chr '->ucs))))
 217             (setq ucs-big5 (or (get-char-attribute chr 'ucs-big5)
 218                                (get-char-attribute chr '=>ucs-big5)))
 219             (insert (format "B-%02X%02X" row cell))
 220             (if ucs-big5
 221                 (insert (format "\tBU+%04X\t" ucs-big5))
 222               (insert "\t "))
 223             (insert (format (if (<= ucs #xFFFF)
 224                                 "U+%04X\n"
 225                               "U-%08X\n")
 226                             ucs)))
 227           (setq cell (1+ cell)))
 228         (setq row (1+ row))))
 229     (write-region (point-min)(point-max) filename)))
 230
 231 ;;;###autoload
 232 (defun dump-jef-china3-to-ucs-table (filename)
 233   (interactive "Fdump JC3-to-UCS : ")
 234   (if (file-directory-p filename)
 235       (setq filename (expand-file-name "JC3-to-UCS.txt" filename)))
 236   (with-temp-buffer
 237     (let ((row #x41)
 238           cell chr ucs)
 239       (while (<= row #x9F)
 240         (setq cell #xA1)
 241         (while (<= cell #xFE)
 242           (when (and (setq chr (make-char 'china3-jef row cell))
 243                      (setq ucs (or (get-char-attribute chr 'ucs)
 244                                    (get-char-attribute chr '=>ucs))))
 245             (insert (format "JC3-%02X%02X\t" row cell))
 246             (insert (format (if (<= ucs #xFFFF)
 247                                 "U+%04X\n"
 248                               "U-%08X\n")
 249                             ucs)))
 250           (setq cell (1+ cell)))
 251         (setq row (1+ row))))
 252     (write-region (point-min)(point-max) filename)))
 253
 254 ;;;###autoload
 255 (defun dump-cbeta-to-ucs-table (filename)
 256   (interactive "Fdump CBETA-to-UCS : ")
 257   (if (file-directory-p filename)
 258       (setq filename (expand-file-name "CBETA-to-UCS.txt" filename)))
 259   (with-temp-buffer
 260     (let ((i 1)
 261           chr ucs)
 262       (while (<= i 20000)
 263         (when (and (setq chr (decode-char 'ideograph-cbeta i))
 264                    (setq ucs (or (get-char-attribute chr 'ucs)
 265                                  (get-char-attribute chr '=>ucs))))
 266           (insert (format "CB%05d\t" i))
 267           (insert (format (if (<= ucs #xFFFF)
 268                               "U+%04X\n"
 269                             "U-%08X\n")
 270                           ucs)))
 271         (setq i (1+ i))))
 272     (write-region (point-min)(point-max) filename)))
 273
 274
 275 ;;; @ End.
 276 ;;;
 277
 278 (provide 'dump-tables)
 279
 280 ;;; dump-tables.el ends here