1 ;;; read-maps.el --- Read mapping-tables.
3 ;; Copyright (C) 2002,2003,2004,2005,2006,2008,2012 MORIOKA Tomohiko
5 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
6 ;; Keywords: mapping table, character, CCS, multiscript, multilingual
8 ;; This file is part of XEmacs CHISE.
10 ;; XEmacs CHISE 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.
15 ;; XEmacs CHISE is distributed in the hope that it will be useful,
16 ;; but 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.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with XEmacs CHISE; 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.
27 (defvar mapping-table-ccs-setting-alist
29 "^J90-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16
31 "\tJU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)")
33 "^JSP-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16
35 "\tJU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)")
37 "^JX1-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16
39 "\tJU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)")
41 "^JX2-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16
43 "\tJU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)")
45 "^G0-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16
47 "\tGU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)")
49 "^C1-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16
51 "\tCU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)")
53 "^C2-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16
55 "\tCU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)")
57 "^C3-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16
59 "\tCU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)")
61 "^C4-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16
63 "\tCU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)")
65 "^C5-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16
67 "\tCU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)")
69 "^C6-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16
71 "\tCU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)")
73 "^C7-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16
75 "\tCU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)")
77 "^B-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16
79 "\tBU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)")
81 "^K0-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16
83 "\tKU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)")
85 "^JC3-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16
89 "*List of information about mapping table formats.
90 Elements are of the form
91 \(CCS CODE-REGEXP PAREN-EXP BASE UCS-CCS UCS-REGEXP).
93 CCS is a symbol, which is a name of a target coded-charset.
95 CODE-REGEXP is a regular expression to match against
96 the representation of the target coded-charset.
98 PAREN-EXP is a number specifies which parenthesized expression
101 BASE base of code in the string specified by CODE-REGEXP and
104 UCS-CCS is a symbol, which is a name of a UCS-CCS.
106 UCS-REGEXP is a regular expression to match against
107 the representation of the UCS-CCS.")
110 (defun mapping-table-read-file (filename)
111 "Read mapping table."
112 (interactive "fMapping table : ")
114 (buffer-disable-undo)
115 (insert-file-contents filename)
116 (goto-char (point-min))
117 (let (rest setting ccs code ucs ucs-pat ucs-ccs ucs-code chr)
119 (setq rest mapping-table-ccs-setting-alist)
122 (setq setting (car rest)
124 (when (looking-at (pop setting))
125 (setq code (string-to-int (match-string (pop setting))
127 ucs-ccs (pop setting)
128 ucs-pat (car setting))
129 (goto-char (match-end 0))
131 (setq rest (cdr rest)))
138 (looking-at ucs-pat))
140 (string-to-int (match-string 1) 16)
141 (goto-char (match-end 0)))))
144 "[ \t]*U[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)")
145 (string-to-int (match-string 1) 16)))
146 (if (and ucs-ccs ucs (not ucs-code))
149 (when (setq chr (decode-char ccs code))
150 (unless (eq (encode-char chr ccs 'defined-only)
152 (put-char-attribute chr ccs code))
156 (encode-char chr ucs-ccs 'defined-only)
158 ((memq ucs-ccs '(=ucs@jis
161 (encode-char chr '=ucs@jis/fw 'defined-only))
162 ((eq ucs-ccs '=ucs@gb)
163 (encode-char chr '=ucs@gb/fw 'defined-only))
164 ;; ((eq ucs-ccs '=ucs@cns)
165 ;; (encode-char chr '=ucs@cns/fw 'defined-only))
166 ;; ((eq ucs-ccs '=ucs@big5)
168 ;; ((eq ucs-ccs '=ucs@ks)
169 ;; (encode-char chr '=ucs@ks/fw 'defined-only))
171 (char-feature chr '=>ucs))))
173 (put-char-attribute chr ucs-ccs ucs-code))
175 (not (eq (or (encode-char chr '=ucs 'defined-only)
176 (and (not (memq ucs-ccs '(=ucs@jis
184 (char-feature chr '=>ucs)))
186 (if (or ucs-code (null ucs-ccs))
187 (unless (eq (char-feature chr '=>ucs) ucs)
188 (put-char-attribute chr '=>ucs ucs))
189 (unless (eq (encode-char chr ucs-ccs 'defined-only)
191 (put-char-attribute chr ucs-ccs ucs)))))
195 (defun ucs-compat-read-file (filename)
196 (interactive "fUCS-compat file : ")
198 (buffer-disable-undo)
199 (insert-file-contents filename)
200 (goto-char (point-min))
202 (while (re-search-forward
203 "^ *U[---+]\\([0-9A-F]+\\)\t *U[---+]\\([0-9A-F]+\\)" nil t)
204 (setq ucs (string-to-int (match-string 1) 16)
205 ucs* (string-to-int (match-string 2) 16))
206 (put-char-attribute (decode-char '=ucs ucs) '=>ucs* ucs*)
210 (defun jp-jouyou-read-file (filename)
211 (interactive "fjp-jouyou file : ")
213 (buffer-disable-undo)
214 (insert-file-contents filename)
215 (goto-char (point-min))
217 (while (re-search-forward "^[^\t\n ]+\t\\(.\\)\t*" nil t)
218 (setq char (aref (match-string 1) 0)
219 tchars (buffer-substring (match-end 0)
221 (when (> (length tchars) 0)
225 (split-string tchars " ")))
226 (unless (or (equal (char-feature char '<-simplified@JP/Jouyou)
228 (and (equal (char-feature char '<-simplified)
231 (char-feature char '<-simplified*sources))))
232 (put-char-attribute char
233 '<-simplified@JP/Jouyou
235 ;; (put-char-attribute
236 ;; char 'script (adjoin
242 ;; (get-char-attribute char 'script)))))
247 ;;; read-maps.el ends here