1 ;;; read-maps.el --- Read mapping-tables.
3 ;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2008, 2012, 2014, 2015
6 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
7 ;; Keywords: mapping table, character, CCS, multiscript, multilingual
9 ;; This file is part of XEmacs CHISE.
11 ;; XEmacs CHISE is free software; you can redistribute it and/or
12 ;; modify it under the terms of the GNU General Public License as
13 ;; published by the Free Software Foundation; either version 2, or (at
14 ;; your option) any later version.
16 ;; XEmacs CHISE is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 ;; General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with XEmacs CHISE; see the file COPYING. If not, write to
23 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
28 (defvar mapping-table-ccs-setting-alist
30 "^J90-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16
32 "\tJU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)")
34 "^JSP-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16
36 "\tJU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)")
38 "^JX1-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16
40 "\tJU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)")
42 "^JX2-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16
44 "\tJU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)")
46 "^G0-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16
48 "\tGU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)")
50 "^C1-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16
52 "\tCU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)")
54 "^C2-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16
56 "\tCU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)")
58 "^C3-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16
60 "\tCU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)")
62 "^C4-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16
64 "\tCU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)")
66 "^C5-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16
68 "\tCU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)")
70 "^C6-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16
72 "\tCU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)")
74 "^C7-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16
76 "\tCU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)")
78 "^B-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16
80 "\tBU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)")
82 "^K0-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16
84 "\tKU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)")
86 "^JC3-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16
90 "*List of information about mapping table formats.
91 Elements are of the form
92 \(CCS CODE-REGEXP PAREN-EXP BASE UCS-CCS UCS-REGEXP).
94 CCS is a symbol, which is a name of a target coded-charset.
96 CODE-REGEXP is a regular expression to match against
97 the representation of the target coded-charset.
99 PAREN-EXP is a number specifies which parenthesized expression
102 BASE base of code in the string specified by CODE-REGEXP and
105 UCS-CCS is a symbol, which is a name of a UCS-CCS.
107 UCS-REGEXP is a regular expression to match against
108 the representation of the UCS-CCS.")
111 (defun mapping-table-read-file (filename)
112 "Read mapping table."
113 (interactive "fMapping table : ")
115 (buffer-disable-undo)
116 (insert-file-contents filename)
117 (goto-char (point-min))
118 (let (rest setting ccs code ucs ucs-pat ucs-ccs ucs-code chr
119 drep-chr drep-ccs drep-ucs-ccs)
121 (setq rest mapping-table-ccs-setting-alist)
124 (setq setting (car rest)
126 (when (looking-at (pop setting))
127 (setq code (string-to-int (match-string (pop setting))
129 ucs-ccs (pop setting)
130 ucs-pat (car setting)
131 drep-ccs (intern (format "=%s" ccs))
132 drep-ucs-ccs (intern (format "=%s" ucs-ccs)))
133 (unless (find-charset drep-ccs)
135 (unless (find-charset drep-ucs-ccs)
136 (setq drep-ucs-ccs nil))
137 (goto-char (match-end 0))
139 (setq rest (cdr rest)))
148 (looking-at ucs-pat))
150 (string-to-int (match-string 1) 16)
151 (goto-char (match-end 0)))))
154 "[ \t]*U[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)")
155 (string-to-int (match-string 1) 16)))
156 (if (and ucs-ccs ucs (not ucs-code))
159 (when (setq chr (decode-char ccs code))
160 (unless (eq (encode-char chr ccs 'defined-only)
162 (put-char-attribute chr ccs code))
166 (encode-char chr ucs-ccs 'defined-only)
168 ((memq ucs-ccs '(=ucs@jis
171 (encode-char chr '=ucs@jis/fw 'defined-only))
172 ((eq ucs-ccs '=ucs@gb)
173 (encode-char chr '=ucs@gb/fw 'defined-only))
174 ;; ((eq ucs-ccs '=ucs@cns)
175 ;; (encode-char chr '=ucs@cns/fw 'defined-only))
176 ;; ((eq ucs-ccs '=ucs@big5)
178 ;; ((eq ucs-ccs '=ucs@ks)
179 ;; (encode-char chr '=ucs@ks/fw 'defined-only))
181 (or (char-feature chr '=ucs)
182 (char-feature chr '=>ucs))
185 (put-char-attribute chr ucs-ccs ucs-code))
187 (not (eq (or (encode-char chr '=ucs 'defined-only)
188 (and (not (memq ucs-ccs '(=ucs@jis
196 (or (char-feature chr '=ucs)
197 (char-feature chr '=>ucs))
200 (if (or ucs-code (null ucs-ccs))
201 (unless (eq (or (char-feature chr '=ucs)
202 (char-feature chr '=>ucs))
204 (put-char-attribute chr '=>ucs ucs))
205 (unless (eq (encode-char chr ucs-ccs 'defined-only)
207 (put-char-attribute chr ucs-ccs ucs)))))
210 (setq drep-chr (decode-char drep-ccs code))
211 (not (eq drep-chr chr)))
212 (unless (eq (encode-char drep-chr drep-ccs 'defined-only)
214 (put-char-attribute drep-chr drep-ccs code))
216 (not (eq (encode-char drep-chr drep-ucs-ccs
219 (put-char-attribute drep-chr drep-ucs-ccs ucs-code))
221 (not (eq (and (not (memq drep-ucs-ccs '(==ucs@jis
227 (or (char-feature drep-chr '=ucs)
228 (char-feature drep-chr '=>ucs))
231 (not (eq (char-feature drep-chr '=>ucs*) ucs)))
232 (if (or ucs-code (null drep-ucs-ccs))
233 (unless (eq (or (char-feature drep-chr '=ucs)
234 (char-feature drep-chr '=>ucs))
236 (put-char-attribute drep-chr '=>ucs ucs))
237 (unless (eq (encode-char drep-chr drep-ucs-ccs 'defined-only)
239 (put-char-attribute drep-chr drep-ucs-ccs ucs)))))
243 (defun ucs-compat-read-file (filename)
244 (interactive "fUCS-compat file : ")
246 (buffer-disable-undo)
247 (insert-file-contents filename)
248 (goto-char (point-min))
250 (while (re-search-forward
251 "^ *U[---+]\\([0-9A-F]+\\)\t *U[---+]\\([0-9A-F]+\\)" nil t)
252 (setq ucs (string-to-int (match-string 1) 16)
253 ucs* (string-to-int (match-string 2) 16))
254 (put-char-attribute (decode-char '=ucs ucs) '=>ucs* ucs*)
258 (defun jp-jouyou-read-file (filename)
259 (interactive "fjp-jouyou file : ")
261 (buffer-disable-undo)
262 (insert-file-contents filename)
263 (goto-char (point-min))
265 (while (re-search-forward "^[^\t\n ]+\t\\(.\\)\t*" nil t)
266 (setq char (aref (match-string 1) 0)
267 tchars (buffer-substring (match-end 0)
269 (when (> (length tchars) 0)
273 (split-string tchars " ")))
274 (unless (or (equal (char-feature char '<-simplified@JP/Jouyou)
276 (and (equal (char-feature char '<-simplified)
279 (char-feature char '<-simplified*sources))))
280 (put-char-attribute char
281 '<-simplified@JP/Jouyou
283 ;; (put-char-attribute
284 ;; char 'script (adjoin
290 ;; (get-char-attribute char 'script)))))
295 ;;; read-maps.el ends here