X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Futf-2000%2Fmaps-conf.el;h=8b12263576f5ca066c27d9d758313a6c73984933;hb=af08411166821c8a07e6779d98dbae2d46bcb68c;hp=bb888262f18e3add17c67a33711dc94d541cd46c;hpb=b7c21d3ef6d8c8abcf377a2475935370fca34d56;p=chise%2Fxemacs-chise.git.1

diff --git a/lisp/utf-2000/maps-conf.el b/lisp/utf-2000/maps-conf.el
index bb88826..8b12263 100644
--- a/lisp/utf-2000/maps-conf.el
+++ b/lisp/utf-2000/maps-conf.el
@@ -4,7 +4,7 @@
 		"JX1-to-UCS.txt" "JX2-to-UCS.txt"
 		"K0-to-UCS.txt"
 		"G0-to-UCS.txt"
-		"C2-to-UCS.txt"
+		"C1-to-UCS.txt" "C2-to-UCS.txt"
 		"C3-to-UCS.txt" "C4-to-UCS.txt"
 		"C5-to-UCS.txt" "C6-to-UCS.txt"
 		"C7-to-UCS.txt"
@@ -94,7 +94,8 @@
 	#x5A45 #x4754 #x343A #x3B36 #x4658
 	#x3749 #x3F74 #x4528 #x4030 #x5A4C
 	#x507B #x507E #x5353 #x5A44 #x6E2B
-	#x5B30 #x4C40 #x376E #x6067))
+	#x5B30 #x4C40 #x376E #x6067 #x4E28
+	#x6425))
 
 (map-char-attribute
  (lambda (c v)
@@ -104,6 +105,13 @@
    nil)
  '=gt-pj-1)
 
+(let ((i 1)
+      chr)
+  (while (<= i 67547)
+    (when (setq chr (decode-char '=gt i))
+      (put-char-attribute chr '=gt i))
+    (setq i (1+ i))))
+
 (let ((default-coded-charset-priority-list
 	'(=gt-pj-1
 	  =gt-pj-2
@@ -231,13 +239,14 @@
 	    (put-char-attribute char '=ucs@jis/2004 ucs)))
 	)
        (rep-char
-	(put-char-attribute rep-char '==jis-x0213-1@2000 code)
-	(remove-char-attribute rep-char '==jis-x0213-1)
-	(remove-char-attribute rep-char '==jis-x0213-1@2004)
-	(setq ucs (or (encode-char rep-char '==ucs@jis/2000)
-		      ucs))
-	(remove-char-attribute rep-char '==ucs@jis)
-	(remove-char-attribute rep-char '==ucs@jis/2004)
+	(unless (and (= ku 47)(= ten 64))
+	  (put-char-attribute rep-char '==jis-x0213-1@2000 code)
+	  (remove-char-attribute rep-char '==jis-x0213-1)
+	  (remove-char-attribute rep-char '==jis-x0213-1@2004)
+	  (setq ucs (or (encode-char rep-char '==ucs@jis/2000)
+			ucs))
+	  (remove-char-attribute rep-char '==ucs@jis)
+	  (remove-char-attribute rep-char '==ucs@jis/2004))
 	(when (setq rep-char (decode-char '==jis-x0213-1@2004 code))
 	  (unless (eq (encode-char rep-char '==ucs@jis/2004) ucs)
 	    (put-char-attribute rep-char '==ucs@jis/2004 ucs)))
@@ -256,3 +265,216 @@
      (put-char-attribute c '=>jis-x0213-1 v))
    nil)
  '=>jis-x0208)
+
+(let (dg-chr)
+  (map-char-attribute
+   (lambda (c v)
+     (when (setq dg-chr (decode-char '===jis-x0212 v))
+       (unless (eq c dg-chr)
+	 (put-char-attribute dg-chr '===hanyo-denshi/jb v)))
+     nil)
+   '==hanyo-denshi/jb)
+  (map-char-attribute
+   (lambda (c v)
+     (when (setq dg-chr (decode-char '===jis-x0213-1@2000 v))
+       (unless (eq c dg-chr)
+	 (put-char-attribute dg-chr '===hanyo-denshi/jc v)))
+     nil)
+   '==hanyo-denshi/jc)
+  (map-char-attribute
+   (lambda (c v)
+     (when (setq dg-chr (decode-char '===jis-x0213-2 v))
+       (unless (eq c dg-chr)
+	 (put-char-attribute dg-chr '===hanyo-denshi/jd v)))
+     nil)
+   '==hanyo-denshi/jd)
+  )
+
+(let (j-chr)
+  (map-char-attribute
+   (lambda (c v)
+     (if (and (setq j-chr (decode-char '=ucs@JP v))
+	      (not (eq j-chr c))
+	      (null (encode-char c '=ucs)))
+	 (put-char-attribute c '=ucs@JP/hanazono nil))
+     nil)
+   '=ucs@unicode)
+  (map-char-attribute
+   (lambda (c v)
+     (if (and (setq j-chr (decode-char '==ucs@JP v))
+	      (not (eq j-chr c)))
+	 (put-char-attribute c '==ucs@JP/hanazono nil))
+     nil)
+   '==ucs@unicode)
+  )
+
+(defun glyph-form-feature-to-glyph-image-char-spec (dg-fn
+						    code-point
+						    &optional
+						    rep-gi-fn dg-char)
+  (unless rep-gi-fn
+    (setq rep-gi-fn (intern (format "=%s" dg-fn))))
+  (unless dg-char
+    (setq dg-char (decode-char dg-fn code-point)))
+  (let (code)
+    (when (find-charset rep-gi-fn)
+      (cons (cons rep-gi-fn code-point)
+	    (cond
+	     ((eq dg-fn '==gt)
+	      (if (setq code (encode-char dg-char '==gt-k))
+		  (list (cons '===gt-k code)))
+	      )
+	     ((eq dg-fn '==hanyo-denshi/jc)
+	      (cond ((encode-char dg-char '==jis-x0213-1)
+		     (list (cons '===jis-x0213-1 code-point))
+		     )
+		    ((encode-char dg-char '==jis-x0213-1@2000)
+		     (list (cons '===jis-x0213-1@2000 code-point))
+		     ))
+	      )
+	     ((eq dg-fn '==hanyo-denshi/jd)
+	      (list (cons '===jis-x0213-2 code-point))
+	      )
+	     ((eq dg-fn '==jis-x0208)
+	      (cond ((encode-char dg-char '==jis-x0213-1)
+		     (list (cons '===jis-x0213-1 code-point))
+		     )
+		    ((encode-char dg-char '==jis-x0213-1@2000)
+		     (list (cons '===jis-x0213-1@2000 code-point))
+		     ))
+	      )
+	     ((eq dg-fn '==ks-x1001)
+	      (if (setq code (encode-char dg-char '==ucs@ks))
+		  (list (cons '===ucs@ks code)))
+	      ))))))
+
+(let (dest rep-gi-fn rep-gi spec target-dg-fns)
+  (dolist (fn (char-attribute-list))
+    (when (and (find-charset fn)
+	       (string-match "^==[^*=>]+$" (symbol-name fn)))
+      (setq dest (cons fn dest))))
+  (setq dest (sort dest
+		   (lambda (a b)
+		     (cond ((eq a '==daikanwa)
+			    t)
+			   ((eq a '==daikanwa/+p)
+			    t)
+			   ((eq a '==daikanwa/ho)
+			    t)
+			   ((eq a '==jis-x0208)
+			    (cond ((memq b '(==daikanwa
+					     ==daikanwa/+p ==daikanwa/ho))
+				   nil)
+				  (t)))
+			   ((eq a '==jis-x0208@1978)
+			    (cond ((memq b '(==daikanwa
+					     ==daikanwa/+p ==daikanwa/ho
+					     ==jis-x0208))
+				   nil)
+				  (t)))
+			   ((eq a '==jis-x0208@1983)
+			    (cond ((memq b '(==daikanwa
+					     ==daikanwa/+p ==daikanwa/ho
+					     ==jis-x0208
+					     ==jis-x0208@1978))
+				   nil)
+				  (t)))
+			   ((eq a '==jis-x0208@1990)
+			    (cond ((memq b '(==daikanwa
+					     ==daikanwa/+p ==daikanwa/ho
+					     ==jis-x0208
+					     ==jis-x0208@1978
+					     ==jis-x0208@1983))
+				   nil)
+				  (t)))
+			   ((eq a '==jis-x0212)
+			    (cond ((memq b '(==daikanwa
+					     ==daikanwa/+p ==daikanwa/ho
+					     ==jis-x0208
+					     ==jis-x0208@1978
+					     ==jis-x0208@1983 ==jis-x0208@1990))
+				   nil)
+				  (t)))
+			   ((eq a '==jis-x0213-1)
+			    (cond ((memq b '(==daikanwa
+					     ==daikanwa/+p ==daikanwa/ho
+					     ==jis-x0208
+					     ==jis-x0208@1978
+					     ==jis-x0208@1983 ==jis-x0208@1990
+					     ==jis-x0212))
+				   nil)
+				  (t)))
+			   ((eq a '==jis-x0213-2)
+			    (cond ((memq b '(==daikanwa
+					     ==daikanwa/+p ==daikanwa/ho
+					     ==jis-x0208
+					     ==jis-x0208@1978
+					     ==jis-x0208@1983 ==jis-x0208@1990
+					     ==jis-x0212 ==jis-x0213-1))
+				   nil)
+				  (t)))
+			   (t
+			    (cond ((memq b '(==daikanwa
+					     ==daikanwa/+p ==daikanwa/ho
+					     ==jis-x0208
+					     ==jis-x0208@1978
+					     ==jis-x0208@1983 ==jis-x0208@1990
+					     ==jis-x0212
+					     ==jis-x0213-1 ==jis-x0213-2))
+				   nil)
+				  (t
+				   (string< (symbol-name a)(symbol-name b)))))))))
+  (dolist (dg-fn dest)
+    (setq rep-gi-fn (intern (format "=%s" dg-fn)))
+    (when (find-charset rep-gi-fn)
+      (map-char-attribute
+       (lambda (c v)
+	 (setq rep-gi (decode-char rep-gi-fn v))
+	 (unless (or (and (eq dg-fn '==jis-x0208)
+			  (eq (get-char-attribute
+			       (decode-char '===jis-x0208@1990 v)
+			       '===jis-x0208@1990)
+			      v))
+		     (and (eq dg-fn '==jis-x0213-1)
+			  (eq (get-char-attribute
+			       (decode-char '===jis-x0213-1@2000 v)
+			       '===jis-x0213-1@2000)
+			     v))
+		     (and rep-gi
+			  (not (eq c rep-gi))))
+	   (if (get-char-attribute c '->subsumptive)
+	       (if (setq rep-gi
+			 (define-char
+                           (glyph-form-feature-to-glyph-image-char-spec
+			    dg-fn v rep-gi-fn c)
+			   ;; (list (cons rep-gi-fn v))
+			   ))
+		   (put-char-attribute rep-gi '<-subsumptive (list c)))
+	     (setq spec (char-attribute-alist c))
+	     (setq target-dg-fns nil)
+	     (dolist (fp spec)
+	       (unless (memq (car fp)
+			     '(==ks-x1001
+			       ==hanyo-denshi/jb
+			       ==hanyo-denshi/jc ==hanyo-denshi/jd
+			       ==gt-k))
+		 (when (find-charset (intern (format "=%s" (car fp))))
+		   (setq target-dg-fns (cons (car fp) target-dg-fns)))))
+	     (when (cdr target-dg-fns)
+	       (setq rep-gi
+		     (define-char
+		       (glyph-form-feature-to-glyph-image-char-spec
+			dg-fn v rep-gi-fn c)))
+	       (if rep-gi
+		   (put-char-attribute rep-gi '<-subsumptive (list c))))))
+	 nil)
+       dg-fn))))
+
+(let (chr ucs)
+  (map-char-attribute
+   (lambda (c v)
+     (when (and (setq chr (decode-char '=ks-x1001 v))
+		(setq ucs (encode-char chr '=ucs@ks)))
+       (put-char-attribute c '===ucs@ks ucs))
+     nil)
+   '===ks-x1001))