X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Futf-2000%2Fread-maps.el;h=40371c637c2b27884e30f15d8e5412c62817c5db;hb=d9c4acf61a249a81ac0d9ff1cddaad50d49c75d3;hp=a7e571b2945b3ede5d55b5fe0b14dae77cfa7f6b;hpb=48a973ddc4ccab71f686c72d7a4df54fee412a50;p=chise%2Fxemacs-chise.git.1

diff --git a/lisp/utf-2000/read-maps.el b/lisp/utf-2000/read-maps.el
index a7e571b..40371c6 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,2008 MORIOKA Tomohiko
+;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2008, 2012, 2014, 2015
+;;   MORIOKA Tomohiko
 
 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
 ;; Keywords: mapping table, character, CCS, multiscript, multilingual
@@ -33,11 +34,11 @@
      "^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]+\\)")
@@ -114,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
@@ -125,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))
@@ -168,7 +178,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
@@ -181,14 +193,50 @@ 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