X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Futf-2000%2Fread-maps.el;h=fe02723da65441b3e735933cb1a1443a5a5b8c8d;hb=0f491c1083161c021800689e467902d140758cdc;hp=52585050641fc9a3c8fd19d2ad9d6db9693a2612;hpb=a14e6b331abbdfae7e25bc4f4bef8f13fb5c4f76;p=chise%2Fxemacs-chise.git.1 diff --git a/lisp/utf-2000/read-maps.el b/lisp/utf-2000/read-maps.el index 5258505..fe02723 100644 --- a/lisp/utf-2000/read-maps.el +++ b/lisp/utf-2000/read-maps.el @@ -1,6 +1,7 @@ ;;; read-maps.el --- Read mapping-tables. -;; Copyright (C) 2002,2003,2004,2005 MORIOKA Tomohiko +;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2008, 2012, 2014, 2015, 2017 +;; MORIOKA Tomohiko ;; Author: MORIOKA Tomohiko ;; Keywords: mapping table, character, CCS, multiscript, multilingual @@ -27,17 +28,17 @@ (defvar mapping-table-ccs-setting-alist '((=jis-x0208@1990 "^J90-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16 - =ucs@jis + =ucs@jis/1990 "\tJU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)") (=jis-x0212 "^JSP-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16 =ucs@jis/1990 "\tJU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)") - (=jis-x0213-1-2000 + (=jis-x0213-1@2000 "^JX1-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16 =ucs@jis/2000 "\tJU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)") - (=jis-x0213-2-2000 + (=jis-x0213-2 "^JX2-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16 =ucs@jis/2000 "\tJU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)") @@ -65,10 +66,22 @@ "^C5-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16 =ucs@cns "\tCU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)") + (=cns11643-6 + "^C6-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16 + =ucs@cns + "\tCU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)") + (=cns11643-7 + "^C7-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16 + =ucs@cns + "\tCU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)") (=big5 "^B-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16 =ucs@big5 "\tBU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)") + (=ks-x1001 + "^K0-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16 + =ucs@ks + "\tKU[+-]\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]+\\)") (=jef-china3 "^JC3-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" 1 16 nil @@ -102,7 +115,8 @@ UCS-REGEXP is a regular expression to match against (buffer-disable-undo) (insert-file-contents filename) (goto-char (point-min)) - (let (rest setting ccs code ucs ucs-pat ucs-ccs ucs-code chr) + (let (rest setting ccs code ucs ucs-pat ucs-ccs ucs-code chr + drep-chr drep-ccs drep-ucs-ccs) (while (not (eobp)) (setq rest mapping-table-ccs-setting-alist) (catch 'matched @@ -113,14 +127,22 @@ UCS-REGEXP is a regular expression to match against (setq code (string-to-int (match-string (pop setting)) (pop setting)) ucs-ccs (pop setting) - ucs-pat (car setting)) + ucs-pat (car setting) + drep-ccs (intern (format "=%s" ccs)) + drep-ucs-ccs (intern (format "=%s" ucs-ccs))) + (unless (find-charset drep-ccs) + (setq drep-ccs nil)) + (unless (find-charset drep-ucs-ccs) + (setq drep-ucs-ccs nil)) (goto-char (match-end 0)) (throw 'matched t)) (setq rest (cdr rest))) (setq ccs nil code nil ucs-pat nil - ucs-ccs nil)) + ucs-ccs nil + drep-ccs nil + drep-ucs-ccs nil)) (setq ucs-code (if (and ucs-pat (looking-at ucs-pat)) @@ -134,6 +156,10 @@ UCS-REGEXP is a regular expression to match against (if (and ucs-ccs ucs (not ucs-code)) (setq ucs-code ucs ucs nil)) + (if (and (eq ccs '=jef-china3) + (eq ucs #xFA66)) + (setq ucs-ccs '=ucs@JP + drep-ucs-ccs '==ucs@JP)) (when (setq chr (decode-char ccs code)) (unless (eq (encode-char chr ccs 'defined-only) code) @@ -149,10 +175,16 @@ UCS-REGEXP is a regular expression to match against (encode-char chr '=ucs@jis/fw 'defined-only)) ((eq ucs-ccs '=ucs@gb) (encode-char chr '=ucs@gb/fw 'defined-only)) + ;; ((eq ucs-ccs '=ucs@cns) + ;; (encode-char chr '=ucs@cns/fw 'defined-only)) ;; ((eq ucs-ccs '=ucs@big5) ;; nil) - (t - (char-feature chr '=>ucs)))) + ;; ((eq ucs-ccs '=ucs@ks) + ;; (encode-char chr '=ucs@ks/fw 'defined-only)) + (t + (or (char-feature chr '=ucs) + (char-feature chr '=>ucs)) + ))) ucs-code))) (put-char-attribute chr ucs-ccs ucs-code)) (when (and ucs @@ -161,18 +193,72 @@ UCS-REGEXP is a regular expression to match against =ucs@jis/1990 =ucs@jis/2000 =ucs@gb + =ucs@cns =ucs@big5 + =ucs@ks ))) - (char-feature chr '=>ucs))) + (or (char-feature chr '=ucs) + (char-feature chr '=>ucs)) + )) ucs))) (if (or ucs-code (null ucs-ccs)) - (unless (eq (char-feature chr '=>ucs) ucs) + (unless (eq (or (char-feature chr '=ucs) + (char-feature chr '=>ucs)) + ucs) (put-char-attribute chr '=>ucs ucs)) (unless (eq (encode-char chr ucs-ccs 'defined-only) ucs) (put-char-attribute chr ucs-ccs ucs))))) + + (when (and drep-ccs + (setq drep-chr (decode-char drep-ccs code)) + (not (eq drep-chr chr))) + (unless (eq (encode-char drep-chr drep-ccs 'defined-only) + code) + (put-char-attribute drep-chr drep-ccs code)) + (when (and ucs-code + (not (eq (encode-char drep-chr drep-ucs-ccs + 'defined-only) + ucs-code))) + (put-char-attribute drep-chr drep-ucs-ccs ucs-code)) + (when (and ucs + (not (eq (and (not (memq drep-ucs-ccs '(==ucs@jis + ==ucs@jis/1990 + ==ucs@jis/2000 + ==ucs@gb + ==ucs@cns + ==ucs@ks))) + (or (char-feature drep-chr '=ucs) + (char-feature drep-chr '=>ucs)) + ) + ucs)) + (not (eq (char-feature drep-chr '=>ucs*) ucs))) + (if (or ucs-code (null drep-ucs-ccs)) + (unless (eq (or (char-feature drep-chr '=ucs) + (char-feature drep-chr '=>ucs)) + ucs) + (put-char-attribute drep-chr '=>ucs ucs)) + (unless (eq (encode-char drep-chr drep-ucs-ccs 'defined-only) + ucs) + (put-char-attribute drep-chr drep-ucs-ccs ucs))))) (forward-line))))) +;;;###autoload +(defun ucs-compat-read-file (filename) + (interactive "fUCS-compat file : ") + (with-temp-buffer + (buffer-disable-undo) + (insert-file-contents filename) + (goto-char (point-min)) + (let (ucs ucs*) + (while (re-search-forward + "^ *U[---+]\\([0-9A-F]+\\)\t *U[---+]\\([0-9A-F]+\\)" nil t) + (setq ucs (string-to-int (match-string 1) 16) + ucs* (string-to-int (match-string 2) 16)) + (put-char-attribute (decode-char '=ucs ucs) '=>ucs* ucs*) + )))) + +;;;###autoload (defun jp-jouyou-read-file (filename) (interactive "fjp-jouyou file : ") (with-temp-buffer