1 ;;; read-maps.el --- Read mapping-tables.
3 ;; Copyright (C) 2002 MORIOKA Tomohiko
5 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
6 ;; Keywords: UTF-2000, UCS-4, character, CCS, multiscript, multilingual
8 ;; This file is part of XEmacs UTF-2000.
10 ;; XEmacs UTF-2000 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 UTF-2000 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 UTF-2000; 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 (defun mapping-table-read-file (filename)
28 (interactive "fMapping table : ")
31 (insert-file-contents filename)
32 (goto-char (point-min))
33 (let (line ccs code ucs ucs-pat ucs-ccs ucs-code chr)
35 (cond ((looking-at "^J90-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)")
36 (setq ccs 'japanese-jisx0208-1990
37 code (string-to-int (match-string 1) 16)
38 ucs-pat "\tJU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)"
40 (goto-char (match-end 0))
42 ((looking-at "^JSP-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)")
43 (setq ccs 'japanese-jisx0212
44 code (string-to-int (match-string 1) 16)
45 ucs-pat "\tJU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)"
47 (goto-char (match-end 0))
49 ((looking-at "^JX1-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)")
50 (setq ccs 'japanese-jisx0213-1
51 code (string-to-int (match-string 1) 16)
52 ucs-pat "\tJU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)"
54 (goto-char (match-end 0))
56 ((looking-at "^JX2-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)")
57 (setq ccs 'japanese-jisx0213-2
58 code (string-to-int (match-string 1) 16)
59 ucs-pat "\tJU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)"
61 (goto-char (match-end 0))
63 ((looking-at "^C3-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)")
64 (setq ccs 'chinese-cns11643-3
65 code (string-to-int (match-string 1) 16)
66 ucs-pat "\tCU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)"
68 (goto-char (match-end 0))
70 ((looking-at "^C4-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)")
71 (setq ccs 'chinese-cns11643-4
72 code (string-to-int (match-string 1) 16)
73 ucs-pat "\tCU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)"
75 (goto-char (match-end 0))
77 ((looking-at "^B-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)")
78 (setq ccs 'chinese-big5
79 code (string-to-int (match-string 1) 16)
80 ucs-pat "\tBU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)"
82 (goto-char (match-end 0))
84 ((looking-at "^JC3-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)")
86 code (string-to-int (match-string 1) 16)
89 (goto-char (match-end 0))
101 (string-to-int (match-string 1) 16)
102 (goto-char (match-end 0)))))
105 "[ \t]*U[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)")
106 (string-to-int (match-string 1) 16)))
107 (when (setq chr (decode-char ccs code))
108 (unless (eq (encode-char chr ccs 'defined-only)
109 ;; (get-char-attribute chr ccs)
111 (put-char-attribute chr ccs code))
113 (not (eq (or (get-char-attribute chr ucs-ccs)
114 (get-char-attribute chr 'ucs)
115 (get-char-attribute chr '=>ucs))
117 (put-char-attribute chr ucs-ccs ucs-code))
119 (not (eq (or (get-char-attribute chr 'ucs)
120 (get-char-attribute chr '=>ucs))
122 (put-char-attribute chr
130 (dolist (file '("J90-to-UCS.txt" "JSP-to-UCS.txt"
131 "JX1-to-UCS.txt" "JX2-to-UCS.txt"
132 "C3-to-UCS.txt" ; "C4-to-UCS.txt"
133 "B-to-UCS.txt" "JC3-to-UCS.txt"))
134 (mapping-table-read-file (expand-file-name file "../etc/char-data/")))
136 ;;; read-maps.el ends here