- Add/compact/modify/fix some IDSs.
[chise/ids.git] / ids-read.el
1 ;;; ids-read.el --- Reader for IDS-* files
2
3 ;; Copyright (C) 2002,2003,2004 MORIOKA Tomohiko
4
5 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
6 ;; Keywords: IDS, IDC, Ideographs, UCS, Unicode
7
8 ;; This file is a part of IDS.
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 (require 'ids)
28
29 ;;;###autoload
30 (defun ids-read-buffer (buffer &optional simplify soft)
31   (interactive "bBuffer = \nP")
32   (save-excursion
33     (set-buffer buffer)
34     (goto-char (point-min))
35     (let (line chs ids code char u-char structure)
36       (while (not (eobp))
37         (unless (looking-at ";")
38           (setq line
39                 (split-string
40                  (buffer-substring (point-at-bol)(point-at-eol))
41                  "\t"))
42           (setq chs (car line)
43                 ids (nth 2 line)
44                 u-char nil)
45           (setq char
46                 (cond
47                  ((string-match "U[-+]\\([0-9A-F]+\\)" chs)
48                   (setq code (string-to-int (match-string 1 chs) 16))
49                   (setq u-char (decode-char '=ucs@unicode code))
50                   (decode-char 'ucs code))
51                  ((string-match "J90-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)"
52                                 chs)
53                   (decode-char 'japanese-jisx0208-1990
54                                (string-to-int (match-string 1 chs) 16)))
55                  ((string-match
56                    "C\\([1-7]\\)-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)"
57                    chs)
58                   (decode-char
59                    (intern
60                     (concat "chinese-cns11643-" (match-string 1 chs)))
61                    (string-to-int (match-string 2 chs) 16)))
62                  ((string-match "CDP-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)"
63                                 chs)
64                   (decode-char '=big5-cdp
65                                (string-to-int (match-string 1 chs) 16)))
66                  ((string-match
67                    "HZK\\([0-9][0-9]\\)-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)"
68                    chs)
69                   (decode-char (intern
70                                 (format "=hanziku-%d"
71                                         (string-to-int (match-string 1 chs))))
72                                (string-to-int (match-string 2 chs) 16)))
73                  ((string-match "M-\\([0-9]+\\)'" chs)
74                   (setq code (string-to-int (match-string 1 chs)))
75                   (map-char-attribute
76                    (lambda (key val)
77                      (if (and (eq (car val) code)
78                               (eq (nth 1 val) 1)
79                               (null (nthcdr 2 val)))
80                          key))
81                    'morohashi-daikanwa))
82                  ((string-match "M-\\([0-9]+\\)\"" chs)
83                   (setq code (string-to-int (match-string 1 chs)))
84                   (map-char-attribute
85                    (lambda (key val)
86                      (if (and (eq (car val) code)
87                               (eq (nth 1 val) 2)
88                               (null (nthcdr 2 val)))
89                          key))
90                    'morohashi-daikanwa))
91                  ((string-match "M-\\([0-9]+\\)" chs)
92                   (decode-char 'ideograph-daikanwa
93                                (string-to-int (match-string 1 chs))))
94                  ((string-match "MH-\\([0-9]+\\)" chs)
95                   (setq code (string-to-int (match-string 1 chs)))
96                   (map-char-attribute
97                    (lambda (key val)
98                      (if (and (eq (car val) 'ho)
99                               (eq (nth 1 val) code)
100                               (null (nthcdr 2 val)))
101                          key))
102                    'morohashi-daikanwa))
103                  ((string-match "CB\\([0-9]+\\)" chs)
104                   (decode-char 'ideograph-cbeta
105                                (string-to-int (match-string 1 chs))))
106                  ))
107           (when (and char
108                      (>= (length ids) 3)
109                      (not (string-match "\\?" ids))
110                      (consp (setq structure (ids-parse-string ids simplify))))
111             (when (or (not soft)
112                       (null
113                        (get-char-attribute char 'ideographic-structure)))
114               (put-char-attribute char
115                                   'ideographic-structure
116                                   (cdr (car structure))))
117             (when (and u-char
118                        (not (eq char u-char))
119                        (or (not soft)
120                            (null
121                             (get-char-attribute
122                              u-char 'ideographic-structure))))
123               (put-char-attribute
124                u-char 'ideographic-structure
125                (ideographic-structure-convert-to-domain
126                 (cdr (car structure)) 'unicode)))
127             )
128           )
129         (forward-line)
130         ))))
131
132 ;;;###autoload
133 (defun ids-read-file (file &optional simplify soft)
134   (interactive "fIDS file = \nP")
135   (with-temp-buffer
136     (insert-file-contents file)
137     (ids-read-buffer (current-buffer) simplify soft)))
138
139
140 ;;; @ End.
141 ;;;
142
143 (provide 'ids-read)
144
145 ;;; ids-read.el ends here