1 ;;; read-maps.el --- Read mapping-tables.
3 ;; Copyright (C) 2002,2003,2004 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.
28 (defun mapping-table-read-file (filename)
30 (interactive "fMapping table : ")
33 (insert-file-contents filename)
34 (goto-char (point-min))
35 (let (line ccs code ucs ucs-pat ucs-ccs ucs-code chr)
37 (cond ((looking-at "^J90-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)")
38 (setq ccs 'japanese-jisx0208-1990
39 code (string-to-int (match-string 1) 16)
40 ucs-pat "\tJU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)"
42 (goto-char (match-end 0))
44 ((looking-at "^JSP-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)")
45 (setq ccs 'japanese-jisx0212
46 code (string-to-int (match-string 1) 16)
47 ucs-pat "\tJU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)"
48 ucs-ccs '=ucs-jis-1990)
49 (goto-char (match-end 0))
51 ((looking-at "^JX1-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)")
52 (setq ccs '=jis-x0213-1-2000
53 code (string-to-int (match-string 1) 16)
54 ucs-pat "\tJU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)"
55 ucs-ccs '=ucs-jis-2000)
56 (goto-char (match-end 0))
58 ((looking-at "^JX2-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)")
59 (setq ccs '=jis-x0213-2-2000
60 code (string-to-int (match-string 1) 16)
61 ucs-pat "\tJU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)"
62 ucs-ccs '=ucs@jis-2000)
63 (goto-char (match-end 0))
65 ((looking-at "^C1-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)")
66 (setq ccs 'chinese-cns11643-1
67 code (string-to-int (match-string 1) 16)
68 ucs-pat "\tCU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)"
70 (goto-char (match-end 0))
72 ((looking-at "^C2-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)")
73 (setq ccs 'chinese-cns11643-2
74 code (string-to-int (match-string 1) 16)
75 ucs-pat "\tCU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)"
77 (goto-char (match-end 0))
79 ((looking-at "^C3-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)")
80 (setq ccs 'chinese-cns11643-3
81 code (string-to-int (match-string 1) 16)
82 ucs-pat "\tCU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)"
84 (goto-char (match-end 0))
86 ((looking-at "^C4-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)")
87 (setq ccs 'chinese-cns11643-4
88 code (string-to-int (match-string 1) 16)
89 ucs-pat "\tCU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)"
91 (goto-char (match-end 0))
93 ((looking-at "^B-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)")
94 (setq ccs 'chinese-big5
95 code (string-to-int (match-string 1) 16)
96 ucs-pat "\tBU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)"
98 (goto-char (match-end 0))
100 ((looking-at "^JC3-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)")
101 (setq ccs '=jef-china3
102 code (string-to-int (match-string 1) 16)
105 (goto-char (match-end 0))
115 (looking-at ucs-pat))
117 (string-to-int (match-string 1) 16)
118 (goto-char (match-end 0)))))
121 "[ \t]*U[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)")
122 (string-to-int (match-string 1) 16)))
123 (when (setq chr (decode-char ccs code))
124 (unless (eq (encode-char chr ccs 'defined-only)
126 (put-char-attribute chr ccs code))
128 (not (eq (or (encode-char chr ucs-ccs 'defined-only)
129 (char-feature chr '=>ucs))
131 (put-char-attribute chr ucs-ccs ucs-code))
133 (not (eq (or (encode-char chr '=ucs 'defined-only)
134 (and (not (memq ucs-ccs '(ucs-jis
139 (char-feature chr '=>ucs)))
141 (if (or ucs-code (null ucs-ccs))
142 (put-char-attribute chr '=>ucs ucs)
143 (unless (eq (encode-char chr ucs-ccs 'defined-only)
145 (put-char-attribute chr ucs-ccs ucs)))))
148 (defun jp-jouyou-read-file (filename)
149 (interactive "fjp-jouyou file : ")
151 (buffer-disable-undo)
152 (insert-file-contents filename)
153 (goto-char (point-min))
155 (while (re-search-forward "^[^\t\n ]+\t\\(.\\)\t*" nil t)
156 (setq char (aref (match-string 1) 0)
157 tchars (buffer-substring (match-end 0)
159 (when (> (length tchars) 0)
163 (split-string tchars " ")))
164 (unless (equal (char-feature char '<-simplified@JP/Jouyou)
166 (put-char-attribute char
167 '<-simplified@JP/Jouyou
169 ;; (put-char-attribute
170 ;; char 'script (adjoin
176 ;; (get-char-attribute char 'script)))))
181 ;;; read-maps.el ends here