(ids-dump-insert-big5): New function.

[chise/ids.git] / ids-dump.el

diff --git a/ids-dump.el b/ids-dump.el
index de48c6e..0f33074 100644 (file)
--- a/ids-dump.el
+++ b/ids-dump.el
@@ -1,6 +1,6 @@
 ;;; ids-dump.el --- Dump utility of IDS-* files
 
-;; Copyright (C) 2002 MORIOKA Tomohiko
+;; Copyright (C) 2002,2003 MORIOKA Tomohiko
 
 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
 ;; Keywords: IDS, IDC, Ideographs, UCS, Unicode
@@ -71,8 +71,9 @@
        (insert
         (format "M-%05d \t%c\t%s\n"
                 i (decode-builtin-char 'ideograph-daikanwa i)
-                (ids-format-list
-                 (get-char-attribute chr 'ideographic-structure)))))
+                (or (ids-format-list
+                     (get-char-attribute chr 'ideographic-structure))
+                    ""))))
       (when (setq sal (assq i mdh-alist))
        (setq sal (cdr sal))
        (when (setq chr (assq 1 sal))
@@ -80,8 +81,9 @@
          (insert
           (format "M-%05d'\t%c\t%s\n"
                   i chr
-                  (ids-format-list
-                   (get-char-attribute chr 'ideographic-structure)))))
+                  (or (ids-format-list
+                       (get-char-attribute chr 'ideographic-structure))
+                      ""))))
        (when (setq chr (assq 2 sal))
          (setq chr (cdr chr))
          (insert
@@ -145,6 +147,42 @@
                   "")))
       (setq cell (1+ cell)))))
 
+(defun ids-dump-insert-big5 (ccs prefix)
+  (let ((h #x81)
+       l code chr structure)
+    (while (<= h #xFE)
+      (setq l #x40)
+      (while (<= l #x7E)
+       (setq chr (make-char ccs h l))
+       (setq structure nil)
+       (when (setq structure
+                   (get-char-attribute chr 'ideographic-structure))
+         (insert
+          (format "%s%02X%02X\t%c\t%s\n"
+                  prefix h l
+                  (decode-builtin-char ccs
+                                       (logior (lsh h 8) l))
+                  (or (ids-format-list
+                       (get-char-attribute chr 'ideographic-structure))
+                      ""))))
+       (setq l (1+ l)))
+      (setq l #xA1)
+      (while (<= l #xFE)
+       (setq chr (make-char ccs h l))
+       (setq structure nil)
+       (when (setq structure
+                   (get-char-attribute chr 'ideographic-structure))
+         (insert
+          (format "%s%02X%02X\t%c\t%s\n"
+                  prefix h l
+                  (decode-builtin-char ccs
+                                       (logior (lsh h 8) l))
+                  (or (ids-format-list
+                       (get-char-attribute chr 'ideographic-structure))
+                      ""))))
+       (setq l (1+ l)))
+      (setq h (1+ h)))))
+
 (defun ids-dump-range (file path func &rest args)
   (with-temp-buffer
     (let* ((coding-system-for-write 'utf-8-mcs-er))
@@ -322,6 +360,13 @@
   (ids-dump-range "IDS-JIS-X0208-1990.txt" filename
                  #'ids-dump-insert-jis-x0208-1990))
 
+;;;###autoload
+(defun ids-dump-big5-cdp (filename)
+  (interactive "Fdump IDS-CDP : ")
+  (ids-dump-range "IDS-CDP.txt" filename
+                 #'ids-dump-insert-big5
+                 '=big5-cdp "CDP-"))
+
     
 ;;; @ End.
 ;;;