X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Futf-2000%2Fchar-db-util.el;h=acbc639538ec1e6bb026e57553f03905ba922d5f;hb=e40ab1bdc7396453aef3a93c748aaf58d2c6f4e3;hp=3add8f94561263ed945e601a72ae48c13b1e5166;hpb=3a22dcb3b6189c92c4a6841585f8bd1fea3f37d8;p=chise%2Fxemacs-chise.git-

diff --git a/lisp/utf-2000/char-db-util.el b/lisp/utf-2000/char-db-util.el
index 3add8f9..acbc639 100644
--- a/lisp/utf-2000/char-db-util.el
+++ b/lisp/utf-2000/char-db-util.el
@@ -115,7 +115,8 @@
 
 (defun insert-char-data (char)
   (let ((data (char-attribute-alist char))
-	cell ret has-long-ccs-name rest)
+	cell ret has-long-ccs-name rest
+	radical strokes)
     (when data
       (save-restriction
 	(narrow-to-region (point)(point))
@@ -152,9 +153,9 @@
 	  )
 	(when (setq cell (assq '->ucs data))
 	  (setq cell (cdr cell))
-	  (insert (format "(->ucs\t\t. #x%04X)
+	  (insert (format "(->ucs\t\t. #x%04X)\t; %c
     "
-			  cell))
+			  cell (decode-char 'ucs cell)))
 	  (setq data (del-alist '->ucs data))
 	  )
 	(when (setq cell (assq 'general-category data))
@@ -240,28 +241,77 @@
 			  (mapconcat (function prin1-to-string) cell " ")))
 	  (setq data (del-alist 'morohashi-daikanwa data))
 	  )
+	(setq radical nil)
 	(when (setq cell (assq 'ideographic-radical data))
-	  (setq cell (cdr cell))
+	  (setq radical (cdr cell))
 	  (insert (format "(ideographic-radical . %S)\t; %c
     "
+			  radical
+			  (aref ideographic-radicals radical)))
+	  (setq data (del-alist 'ideographic-radical data))
+	  )
+	(when (setq cell (assq 'kangxi-radical data))
+	  (setq cell (cdr cell))
+	  (unless (eq cell radical)
+	    (insert (format "(kangxi-radical\t . %S)\t; %c
+    "
+			    cell
+			    (aref ideographic-radicals cell)))
+	    (setq radical cell))
+	  (setq data (del-alist 'kangxi-radical data))
+	  )
+	(when (setq cell (assq 'japanese-radical data))
+	  (setq cell (cdr cell))
+	  (unless (eq cell radical)
+	    (insert (format "(japanese-radical . %S)\t; %c
+    "
+			    cell
+			    (aref ideographic-radicals cell)))
+	    (setq radical cell))
+	  (setq data (del-alist 'japanese-radical data))
+	  )
+	(when (setq cell (assq 'cns-radical data))
+	  (setq cell (cdr cell))
+	  (insert (format "(cns-radical\t . %S)\t; %c
+    "
 			  cell
 			  (aref ideographic-radicals cell)))
-	  (setq data (del-alist 'ideographic-radical data))
+	  (setq data (del-alist 'cns-radical data))
 	  )
+	(setq strokes nil)
 	(cond
 	 ((setq cell (assq 'ideographic-strokes data))
-	  (setq cell (cdr cell))
+	  (setq strokes (cdr cell))
 	  (insert (format "(ideographic-strokes . %S)
     "
-			  cell))
+			  strokes))
 	  (setq data (del-alist 'ideographic-strokes data))
+	  (when (setq cell (assq 'kangxi-strokes data))
+	    (setq cell (cdr cell))
+	    (unless (eq cell strokes)
+	      (insert (format "(kangxi-strokes\t . %S)
+    "
+			      cell))
+	      (setq strokes cell))
+	    (setq data (del-alist 'kangxi-strokes data))
+	    )
+	  (when (setq cell (assq 'japanese-strokes data))
+	    (setq cell (cdr cell))
+	    (unless (eq cell strokes)
+	      (insert (format "(japanese-strokes\t . %S)
+    "
+			      cell))
+	      (setq strokes cell))
+	    (setq data (del-alist 'japanese-strokes data))
+	    )
 	  (when (setq cell (assq 'total-strokes data))
 	    (setq cell (cdr cell))
 	    (insert (format "(total-strokes\t . %S)
     "
 			    cell))
 	    (setq data (del-alist 'total-strokes data))
-	    ))
+	    )
+	  )
 	 ((setq cell (assq 'total-strokes data))
 	  (setq cell (cdr cell))
 	  (insert (format "(total-strokes\t. %S)
@@ -347,19 +397,30 @@
 		 (insert
 		  (format
 		   (if has-long-ccs-name
-		       "(%-26s %s)
+		       (if (eq ret (find-charset 'ideograph-daikanwa))
+			   "(%-26s . %05d)\t; %c
     "
-		     "(%-18s %s)
+			 "(%-26s . #x%X)\t; %c
     "
-		     )
+			 )
+		     (if (eq ret (find-charset 'ideograph-daikanwa))
+			 "(%-18s . %05d)\t; %c
+    "
+		       "(%-18s . #x%X)\t; %c
+    "
+		       ))
 		   (charset-name ret)
-		   (mapconcat
-		    (lambda (b)
-		      (format "#x%02X"
-			      (if (= (charset-iso-graphic-plane ret) 1)
-				  (logior b 128)
-				b)))
-		    (cdr cell) " "))))
+		   (if (= (charset-iso-graphic-plane ret) 1)
+		       (logior (cdr cell)
+			       (cond ((= (charset-dimension ret) 1)
+				      #x80)
+				     ((= (charset-dimension ret) 2)
+				      #x8080)
+				     ((= (charset-dimension ret) 3)
+				      #x808080)
+				     (t 0)))
+		     (cdr cell))
+		   (decode-builtin-char ret (cdr cell)))))
 		((string-match "^->" (symbol-name (car cell)))
 		 (insert
 		  (format "(%-18s %s)
@@ -393,6 +454,25 @@
 	(tabify (point-min)(point-max))
 	))))
 
+(defun decode-builtin-char (charset code-point)
+  (setq charset (get-charset charset))
+  (if (and (not (eq (charset-name charset) 'ideograph-daikanwa))
+	   (or (memq (charset-name charset)
+		     '(ascii latin-viscii-upper
+			     latin-viscii-lower
+			     arabic-iso8859-6
+			     japanese-jisx0213-1
+			     japanese-jisx0213-2))
+	       (= (char-int (charset-iso-final-char charset)) 0)))
+      (decode-char charset code-point)
+    (let ((table (charset-mapping-table charset)))
+      (if table
+	  (prog2
+	      (set-charset-mapping-table charset nil)
+	      (decode-char charset code-point)
+	    (set-charset-mapping-table charset table))
+	(decode-char charset code-point)))))
+
 ;;;###autoload
 (defun char-db-update-comment ()
   (interactive)
@@ -405,10 +485,15 @@
 	(when (find-charset (car cdef))
 	  (goto-char (match-end 0))
 	  (setq char
-		(if (or (memq (car cdef) '(ascii latin-viscii-upper
-						 latin-viscii-lower
-						 arabic-iso8859-6))
-			(= (char-int (charset-iso-final-char (car cdef))) 0))
+		(if (and
+		     (not (eq (car cdef) 'ideograph-daikanwa))
+		     (or (memq (car cdef) '(ascii latin-viscii-upper
+						  latin-viscii-lower
+						  arabic-iso8859-6
+						  japanese-jisx0213-1
+						  japanese-jisx0213-2))
+			 (= (char-int (charset-iso-final-char (car cdef)))
+			    0)))
 		    (apply (function make-char) cdef)
 		  (if (setq table (charset-mapping-table (car cdef)))
 		      (set-charset-mapping-table (car cdef) nil))
@@ -425,7 +510,10 @@
 
 (defun insert-char-data-with-variant (char)
   (insert-char-data char)
-  (let ((variants (char-variants char)))
+  (let ((variants (or (char-variants char)
+		      (let ((ucs (get-char-attribute char '->ucs)))
+			(if ucs
+			    (delete char (char-variants (int-char ucs))))))))
     (while variants
       (insert-char-data (car variants))
       (setq variants (cdr variants))
@@ -441,9 +529,10 @@
       )))
 
 (defun write-char-range-data-to-file (min max file)
-  (with-temp-buffer
-    (insert-char-range-data min max)
-    (write-region (point-min)(point-max) file)))
+  (let ((coding-system-for-write 'utf-8))
+    (with-temp-buffer
+      (insert-char-range-data min max)
+      (write-region (point-min)(point-max) file))))
 
 (defvar what-character-original-window-configuration)
 
@@ -461,7 +550,7 @@
     (condition-case err
 	(progn
 	  (insert-char-data-with-variant char)
-	  (char-db-update-comment)
+          ;; (char-db-update-comment)
 	  (set-buffer-modified-p nil)
 	  (view-mode the-buf (lambda (buf)
 			       (set-window-configuration