;;; ids-dump.el --- Dump utility of IDS-* files
-;; Copyright (C) 2002 MORIOKA Tomohiko
+;; Copyright (C) 2002,2003,2004,2005,2009,2011,2019,2022 MORIOKA Tomohiko
;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
;; Keywords: IDS, IDC, Ideographs, UCS, Unicode
(require 'ids)
+(defun ids-dump-format-list (ids-list)
+ (if ids-list
+ (let (ucs)
+ (mapconcat
+ (lambda (c)
+ (char-to-string
+ (if (setq ucs
+ (unless (encode-char c '=ucs 'defined-only)
+ (or (get-char-attribute c '=ucs@unicode)
+ (get-char-attribute c '=ucs@iso))))
+ (decode-char '=ucs ucs)
+ c)))
+ (ids-format-list ids-list) ""))))
+
(defun ids-dump-insert-line (ccs line-spec code)
(let ((chr (decode-char ccs code))
id-list)
(insert (format line-spec
code (decode-builtin-char ccs code)
(if id-list
- (ids-format-list id-list)
+ (ids-dump-format-list id-list)
(char-to-string chr)))))))
(defun ids-dump-insert-ccs-ranges (ccs line-spec &rest ranges)
(t (error 'wrong-type-argument range)))
(setq ranges (cdr ranges)))))
+(defun ids-dump-insert-94x94-ccs-ranges (ccs line-spec &rest ranges)
+ (let (range code max-code l)
+ (while ranges
+ (setq range (car ranges))
+ (cond ((consp range)
+ (setq code (car range)
+ max-code (cdr range))
+ (while (<= code max-code)
+ (setq l (logand code 255))
+ (if (and (<= #x21 l)(<= l #x7E))
+ (ids-dump-insert-line ccs line-spec code))
+ (setq code (1+ code))))
+ ((integerp range)
+ (ids-dump-insert-line ccs line-spec range))
+ (t (error 'wrong-type-argument range)))
+ (setq ranges (cdr ranges)))))
+
(defun ids-dump-insert-daikanwa (start end)
(let ((i start)
mdh-alist
(insert
(format "M-%05d \t%c\t%s\n"
i (decode-builtin-char 'ideograph-daikanwa i)
- (or (ids-format-list
+ (or (ids-dump-format-list
(get-char-attribute chr 'ideographic-structure))
""))))
(when (setq sal (assq i mdh-alist))
(insert
(format "M-%05d'\t%c\t%s\n"
i chr
- (or (ids-format-list
+ (or (ids-dump-format-list
(get-char-attribute chr 'ideographic-structure))
""))))
(when (setq chr (assq 2 sal))
(insert
(format "M-%05d\"\t%c\t%s\n"
i chr
- (ids-format-list
+ (ids-dump-format-list
(get-char-attribute chr 'ideographic-structure)))))
)
(setq i (1+ i)))))
(format "MH-%04d \t%c\t%s\n"
(car cell)
chr
- (ids-format-list
- (get-char-attribute chr 'ideographic-structure)))))))
+ (or (ids-dump-format-list
+ (get-char-attribute chr 'ideographic-structure))
+ ""))))))
(defun ids-dump-insert-jis-x0208-1990 ()
(let ((row 16)
h l
(decode-builtin-char 'japanese-jisx0208-1990
(logior (lsh h 8) l))
- (or (ids-format-list
+ (or (ideographic-structure-to-ids
(get-char-attribute chr 'ideographic-structure))
"")))
(setq cell (1+ cell)))
h l
(decode-builtin-char 'japanese-jisx0208-1990
(logior (lsh h 8) l))
- (or (ids-format-list
+ (or (ideographic-structure-to-ids
(get-char-attribute chr 'ideographic-structure))
"")))
(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-insert-big5-pua (ccs prefix)
+ (let ((line-spec (concat prefix "%04X\t%c\t%s\n"))
+ (h #x81)
+ l)
+ (while (<= h #xA0)
+ (setq l #x40)
+ (while (<= l #x7E)
+ (ids-dump-insert-line ccs line-spec (logior (lsh h 8) l))
+ (setq l (1+ l)))
+ (setq l #xA1)
+ (while (<= l #xFE)
+ (ids-dump-insert-line ccs line-spec (logior (lsh h 8) l))
+ (setq l (1+ l)))
+ (setq h (1+ h)))
+ (setq h #xC6)
+ (setq l #xDE)
+ (while (<= l #xFE)
+ (ids-dump-insert-line ccs line-spec (logior (lsh h 8) l))
+ (setq l (1+ l)))
+ (setq h #xC7)
+ (while (<= h #xC8)
+ (setq l #x40)
+ (while (<= l #x7E)
+ (ids-dump-insert-line ccs line-spec (logior (lsh h 8) l))
+ (setq l (1+ l)))
+ (setq l #xA1)
+ (while (<= l #xFE)
+ (ids-dump-insert-line ccs line-spec (logior (lsh h 8) l))
+ (setq l (1+ l)))
+ (setq h (1+ h)))
+ (setq h #xFA)
+ (while (<= h #xFE)
+ (setq l #x40)
+ (while (<= l #x7E)
+ (ids-dump-insert-line ccs line-spec (logior (lsh h 8) l))
+ (setq l (1+ l)))
+ (setq l #xA1)
+ (while (<= l #xFE)
+ (ids-dump-insert-line ccs line-spec (logior (lsh h 8) l))
+ (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))
(interactive "Fdump IDS-UCS-Basic : ")
(ids-dump-range "IDS-UCS-Basic.txt" filename
#'ids-dump-insert-ccs-ranges 'ucs "U+%04X\t%c\t%s\n"
+ '(#x4E00 . #x9FEA)))
+
+;;;###autoload
+(defun ids-dump-ucs-basic@unicode (filename)
+ (interactive "Fdump IDS-UCS-Basic : ")
+ (ids-dump-range "IDS-UCS-Basic_u.txt" filename
+ #'ids-dump-insert-ccs-ranges '=ucs@unicode
+ "UU+%04X\t%c\t%s\n"
'(#x4E00 . #x9FA5)))
;;;###autoload
'(#x2F800 . #x2FA1D)))
;;;###autoload
+(defun ids-dump-ucs-ext-h (filename)
+ (interactive "Fdump IDS-UCS-Ext-H : ")
+ (ids-dump-range "IDS-UCS-Ext-H.txt" filename
+ #'ids-dump-insert-ccs-ranges 'ucs "U+%04X\t%c\t%s\n"
+ '(#x31350 . #x323AF)))
+
+;;;###autoload
+(defun ids-dump-cns11643-1 (filename)
+ (interactive "Fdump IDS-CNS-1 : ")
+ (ids-dump-range "IDS-CNS-1.txt" filename
+ #'ids-dump-insert-94x94-ccs-ranges
+ 'chinese-cns11643-1 "C1-%04X\t%c\t%s\n"
+ '(#x4421 . #x7D4B)))
+
+;;;###autoload
+(defun ids-dump-cns11643-2 (filename)
+ (interactive "Fdump IDS-CNS-2 : ")
+ (ids-dump-range "IDS-CNS-2.txt" filename
+ #'ids-dump-insert-94x94-ccs-ranges
+ 'chinese-cns11643-2 "C2-%04X\t%c\t%s\n"
+ '(#x2121 . #x7244)))
+
+;;;###autoload
+(defun ids-dump-cns11643-3 (filename)
+ (interactive "Fdump IDS-CNS-3 : ")
+ (ids-dump-range "IDS-CNS-3.txt" filename
+ #'ids-dump-insert-94x94-ccs-ranges
+ 'chinese-cns11643-3 "C3-%04X\t%c\t%s\n"
+ '(#x2121 . #x6246)))
+
+;;;###autoload
(defun ids-dump-daikanwa-01 (filename)
(interactive "Fdump IDS-Daikanwa-01 : ")
(ids-dump-range "IDS-Daikanwa-01.txt" filename
(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-pua
+ '=big5-cdp "CDP-"))
+
;;; @ End.
;;;
projects / chise / ids.git / blobdiff