dump-tables.el

   1 (defun dump-jis-x0208-1990-to-ucs-table (filename)
   2   (interactive "Fdump J90-to-UCS : ")
   3   (if (file-directory-p filename)
   4       (setq filename (expand-file-name "J90-to-UCS.txt" filename)))
   5   (with-temp-buffer
   6     (let ((row 33)
   7           cell chr ucs ucs-j)
   8       (while (< row 127)
   9         (setq cell 33)
  10         (while (< cell 127)
  11           (when (and (setq chr (make-char 'japanese-jisx0208-1990 row cell))
  12                      (setq ucs (or (get-char-attribute chr 'ucs)
  13                                    (get-char-attribute chr '=>ucs)
  14                                    (get-char-attribute chr '->ucs))))
  15             (setq ucs-j (or (get-char-attribute chr 'ucs-jis)
  16                             (get-char-attribute chr '=>ucs-jis)))
  17             (insert (format "J90-%02X%02X" row cell))
  18             (if ucs-j
  19                 (insert (format "\tJU+%04X\t" ucs-j))
  20               (insert "\t "))
  21             (insert (format (if (<= ucs #xFFFF)
  22                                 "U+%04X\n"
  23                               "U-%08X\n")
  24                             ucs)))
  25           (setq cell (1+ cell)))
  26         (setq row (1+ row))))
  27     (write-region (point-min)(point-max) filename)))
  28
  29 (defun dump-jis-x0212-to-ucs-table (filename)
  30   (interactive "Fdump JSP-to-UCS : ")
  31   (if (file-directory-p filename)
  32       (setq filename (expand-file-name "JSP-to-UCS.txt" filename)))
  33   (with-temp-buffer
  34     (let ((row 33)
  35           cell chr ucs ucs-j)
  36       (while (< row 127)
  37         (setq cell 33)
  38         (while (< cell 127)
  39           (when (and (setq chr (make-char 'japanese-jisx0212 row cell))
  40                      (setq ucs (or (get-char-attribute chr 'ucs)
  41                                    (get-char-attribute chr '=>ucs)
  42                                    (get-char-attribute chr '->ucs))))
  43             (setq ucs-j (or (get-char-attribute chr 'ucs-jis)
  44                             (get-char-attribute chr '=>ucs-jis)))
  45             (insert (format "JSP-%02X%02X" row cell))
  46             (if ucs-j
  47                 (insert (format "\tJU+%04X\t" ucs-j))
  48               (insert "\t "))
  49             (insert (format (if (<= ucs #xFFFF)
  50                                 "U+%04X\n"
  51                               "U-%08X\n")
  52                             ucs)))
  53           (setq cell (1+ cell)))
  54         (setq row (1+ row))))
  55     (write-region (point-min)(point-max) filename)))
  56
  57 (defun dump-jis-x0213-1-to-ucs-table (filename)
  58   (interactive "Fdump JX1-to-UCS : ")
  59   (if (file-directory-p filename)
  60       (setq filename (expand-file-name "JX1-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-jisx0213-1 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 "JX1-%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 (defun dump-jis-x0213-2-to-ucs-table (filename)
  86   (interactive "Fdump JX2-to-UCS : ")
  87   (if (file-directory-p filename)
  88       (setq filename (expand-file-name "JX2-to-UCS.txt" filename)))
  89   (with-temp-buffer
  90     (let ((row 33)
  91           cell chr ucs ucs-j)
  92       (while (< row 127)
  93         (setq cell 33)
  94         (while (< cell 127)
  95           (when (and (setq chr (make-char 'japanese-jisx0213-2 row cell))
  96                      (setq ucs (or (get-char-attribute chr 'ucs)
  97                                    (get-char-attribute chr '=>ucs)
  98                                    (get-char-attribute chr '->ucs))))
  99             (setq ucs-j (or (get-char-attribute chr 'ucs-jis)
 100                             (get-char-attribute chr '=>ucs-jis)))
 101             (insert (format "JX2-%02X%02X" row cell))
 102             (if ucs-j
 103                 (insert (format "\tJU+%04X\t" ucs-j))
 104               (insert "\t "))
 105             (insert (format (if (<= ucs #xFFFF)
 106                                 "U+%04X\n"
 107                               "U-%08X\n")
 108                             ucs)))
 109           (setq cell (1+ cell)))
 110         (setq row (1+ row))))
 111     (write-region (point-min)(point-max) filename)))
 112
 113 (defun dump-cns-11643-3-to-ucs-table (filename)
 114   (interactive "Fdump C3-to-UCS : ")
 115   (if (file-directory-p filename)
 116       (setq filename (expand-file-name "C3-to-UCS.txt" filename)))
 117   (with-temp-buffer
 118     (let ((row 33)
 119           cell chr ucs ucs-cns)
 120       (while (< row 127)
 121         (setq cell 33)
 122         (while (< cell 127)
 123           (when (and (setq chr (make-char 'chinese-cns11643-3 row cell))
 124                      (setq ucs (or (get-char-attribute chr 'ucs)
 125                                    (get-char-attribute chr '=>ucs)
 126                                    (get-char-attribute chr '->ucs))))
 127             (setq ucs-cns (or (get-char-attribute chr 'ucs-cns)
 128                               (get-char-attribute chr '=>ucs-cns)))
 129             (insert (format "C3-%02X%02X" row cell))
 130             (if ucs-cns
 131                 (insert (format "\tCU+%04X\t" ucs-cns))
 132               (insert "\t "))
 133             (insert (format (if (<= ucs #xFFFF)
 134                                 "U+%04X\n"
 135                               "U-%08X\n")
 136                             ucs)))
 137           (setq cell (1+ cell)))
 138         (setq row (1+ row))))
 139     (write-region (point-min)(point-max) filename)))
 140
 141 (defun dump-cns-11643-4-to-ucs-table (filename)
 142   (interactive "Fdump C4-to-UCS : ")
 143   (if (file-directory-p filename)
 144       (setq filename (expand-file-name "C4-to-UCS.txt" filename)))
 145   (with-temp-buffer
 146     (let ((row 33)
 147           cell chr ucs ucs-cns)
 148       (while (< row 127)
 149         (setq cell 33)
 150         (while (< cell 127)
 151           (when (and (setq chr (make-char 'chinese-cns11643-4 row cell))
 152                      (setq ucs (or (get-char-attribute chr 'ucs)
 153                                    (get-char-attribute chr '=>ucs)
 154                                    (get-char-attribute chr '->ucs))))
 155             (setq ucs-cns (or (get-char-attribute chr 'ucs-cns)
 156                               (get-char-attribute chr '=>ucs-cns)))
 157             (insert (format "C4-%02X%02X" row cell))
 158             (if ucs-cns
 159                 (insert (format "\tCU+%04X\t" ucs-cns))
 160               (insert "\t "))
 161             (insert (format (if (<= ucs #xFFFF)
 162                                 "U+%04X\n"
 163                               "U-%08X\n")
 164                             ucs)))
 165           (setq cell (1+ cell)))
 166         (setq row (1+ row))))
 167     (write-region (point-min)(point-max) filename)))
 168
 169 (defun dump-big5-to-ucs-table (filename)
 170   (interactive "Fdump B-to-UCS : ")
 171   (if (file-directory-p filename)
 172       (setq filename (expand-file-name "B-to-UCS.txt" filename)))
 173   (with-temp-buffer
 174     (let ((row #xA1)
 175           cell chr ucs ucs-big5)
 176       (while (<= row #xFE)
 177         (setq cell #x40)
 178         (while (< cell #xFE)
 179           (when (and (setq chr (make-char 'chinese-big5 row cell))
 180                      (setq ucs (or (get-char-attribute chr 'ucs)
 181                                    (get-char-attribute chr '=>ucs)
 182                                    (get-char-attribute chr '->ucs))))
 183             (setq ucs-big5 (or (get-char-attribute chr 'ucs-big5)
 184                                (get-char-attribute chr '=>ucs-big5)))
 185             (insert (format "B-%02X%02X" row cell))
 186             (if ucs-big5
 187                 (insert (format "\tBU+%04X\t" ucs-big5))
 188               (insert "\t "))
 189             (insert (format (if (<= ucs #xFFFF)
 190                                 "U+%04X\n"
 191                               "U-%08X\n")
 192                             ucs)))
 193           (setq cell (1+ cell)))
 194         (setq row (1+ row))))
 195     (write-region (point-min)(point-max) filename)))
 196
 197 (defun dump-jef-china3-to-ucs-table (filename)
 198   (interactive "Fdump JC3-to-UCS : ")
 199   (if (file-directory-p filename)
 200       (setq filename (expand-file-name "JC3-to-UCS.txt" filename)))
 201   (with-temp-buffer
 202     (let ((row #x41)
 203           cell chr ucs)
 204       (while (<= row #x9F)
 205         (setq cell #xA1)
 206         (while (< cell #xFE)
 207           (when (and (setq chr (make-char 'china3-jef row cell))
 208                      (setq ucs (or (get-char-attribute chr 'ucs)
 209                                    (get-char-attribute chr '=>ucs))))
 210             (insert (format "JC3-%02X%02X\t" row cell))
 211             (insert (format (if (<= ucs #xFFFF)
 212                                 "U+%04X\n"
 213                               "U-%08X\n")
 214                             ucs)))
 215           (setq cell (1+ cell)))
 216         (setq row (1+ row))))
 217     (write-region (point-min)(point-max) filename)))