projects / chise / xemacs-chise.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
update.
[chise/xemacs-chise.git] / lisp / utf-2000 / read-maps.el
diff --git a/lisp/utf-2000/read-maps.el b/lisp/utf-2000/read-maps.el
index 57e2d2c..fe02723 100644 (file)
--- 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 <tomo@kanji.zinbun.kyoto-u.ac.jp>
 ;; 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,14 +197,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