From 74cfa43c5a24a110067795bc29094fa5a58f551c Mon Sep 17 00:00:00 2001 From: tomo Date: Tue, 23 Jul 2002 09:55:11 +0000 Subject: [PATCH] New file. --- lisp/utf-2000/read-maps.el | 122 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 122 insertions(+) create mode 100644 lisp/utf-2000/read-maps.el diff --git a/lisp/utf-2000/read-maps.el b/lisp/utf-2000/read-maps.el new file mode 100644 index 0000000..5d00cf3 --- /dev/null +++ b/lisp/utf-2000/read-maps.el @@ -0,0 +1,122 @@ +;;; read-maps.el --- Read mapping-tables. + +;; Copyright (C) 2002 MORIOKA Tomohiko + +;; Author: MORIOKA Tomohiko +;; Keywords: UTF-2000, UCS-4, character, CCS, multiscript, multilingual + +;; This file is part of XEmacs UTF-2000. + +;; XEmacs UTF-2000 is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or (at +;; your option) any later version. + +;; XEmacs UTF-2000 is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with XEmacs UTF-2000; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Code: + +(with-temp-buffer + (buffer-disable-undo) + (dolist (file '("J90-to-UCS.txt" "JSP-to-UCS.txt" + "JX1-to-UCS.txt" "JX2-to-UCS.txt" + ;; "C3-to-UCS.txt" ; "C4-to-UCS.txt" + "B-to-UCS.txt")) + (insert-file-contents (expand-file-name file "../etc/char-data/")) + (goto-char (point-min)) + (let (line ccs code ucs ucs-pat ucs-ccs ucs-code chr) + (while (not (eobp)) + (cond ((looking-at "^J90-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)") + (setq ccs 'japanese-jisx0208-1990 + code (string-to-int (match-string 1) 16) + ucs-pat "\tJU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)" + ucs-ccs 'ucs-jis) + (goto-char (match-end 0)) + ) + ((looking-at "^JSP-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)") + (setq ccs 'japanese-jisx0212 + code (string-to-int (match-string 1) 16) + ucs-pat "\tJU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)" + ucs-ccs 'ucs-jis) + (goto-char (match-end 0)) + ) + ((looking-at "^JX1-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)") + (setq ccs 'japanese-jisx0213-1 + code (string-to-int (match-string 1) 16) + ucs-pat "\tJU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)" + ucs-ccs 'ucs-jis) + (goto-char (match-end 0)) + ) + ((looking-at "^JX2-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)") + (setq ccs 'japanese-jisx0213-2 + code (string-to-int (match-string 1) 16) + ucs-pat "\tJU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)" + ucs-ccs 'ucs-jis) + (goto-char (match-end 0)) + ) + ((looking-at "^C3-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)") + (setq ccs 'chinese-cns11643-3 + code (string-to-int (match-string 1) 16) + ucs-pat "\tCU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)" + ucs-ccs 'ucs-cns) + (goto-char (match-end 0)) + ) + ((looking-at "^C4-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)") + (setq ccs 'chinese-cns11643-4 + code (string-to-int (match-string 1) 16) + ucs-pat "\tCU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)" + ucs-ccs 'ucs-cns) + (goto-char (match-end 0)) + ) + ((looking-at "^B-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)") + (setq ccs 'chinese-big5 + code (string-to-int (match-string 1) 16) + ucs-pat "\tBU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)" + ucs-ccs 'ucs-big5) + (goto-char (match-end 0)) + ) + (t + (setq ccs nil + code nil + ucs-pat nil + ucs-ccs nil) + )) + (setq ucs-code + (if (looking-at ucs-pat) + (prog1 + (string-to-int (match-string 1) 16) + (goto-char (match-end 0))))) + (setq ucs + (if (looking-at + "[ \t]*U[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)") + (string-to-int (match-string 1) 16))) + (when (setq chr (decode-char ccs code)) + (unless (eq (get-char-attribute chr ccs) code) + (put-char-attribute chr ccs code)) + (when (and ucs-code + (not (eq (or (get-char-attribute chr ucs-ccs) + (get-char-attribute chr 'ucs) + (get-char-attribute chr '=>ucs) + (get-char-attribute chr '->ucs)) + ucs-code))) + (put-char-attribute chr ucs-ccs ucs-code)) + (when (and ucs + (not (eq (or (get-char-attribute chr 'ucs) + (get-char-attribute chr '=>ucs) + (get-char-attribute chr '->ucs)) + ucs))) + (put-char-attribute chr (if ucs-code + '=>ucs + ucs-ccs) ucs))) + (forward-line))) + (erase-buffer))) + +;;; read-maps.el ends here -- 1.7.10.4