X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=lisp%2Futf-2000%2Fread-maps.el;h=fe02723da65441b3e735933cb1a1443a5a5b8c8d;hp=3a6bb4a093cf50ba99096629a1ae1e85b44050a0;hb=895beaf1d01d129986a138ff6e15de174d46b0b9;hpb=1397fdf7970b11a6b10703739f6e3aa8f3b8af6c diff --git a/lisp/utf-2000/read-maps.el b/lisp/utf-2000/read-maps.el index 3a6bb4a..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,2006 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]+\\)") @@ -69,6 +70,10 @@ "^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 @@ -110,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 @@ -121,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)) @@ -142,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) @@ -164,7 +182,9 @@ UCS-REGEXP is a regular expression to match against ;; ((eq ucs-ccs '=ucs@ks) ;; (encode-char chr '=ucs@ks/fw 'defined-only)) (t - (char-feature chr '=>ucs)))) + (or (char-feature chr '=ucs) + (char-feature chr '=>ucs)) + ))) ucs-code))) (put-char-attribute chr ucs-ccs ucs-code)) (when (and ucs @@ -177,16 +197,68 @@ UCS-REGEXP is a regular expression to match against =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