From: tomo <tomo>
Date: Sat, 13 Nov 1999 13:22:28 +0000 (+0000)
Subject: (insert-char-data): Change order.
X-Git-Tag: r21-2-19-utf-2000-0_12-0~95
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=667a2b3a2dbea07c3c228e17d986110cc6a33084;p=chise%2Fxemacs-chise.git

(insert-char-data): Change order.
(insert-char-range-data): Insert variants.
(char-db-update-comment): Fix problem with ascii and
non-ISO-2022-sets; don't insert control-characters.
---

diff --git a/lisp/utf-2000/char-db-util.el b/lisp/utf-2000/char-db-util.el
index dc740d2..75a9326 100644
--- a/lisp/utf-2000/char-db-util.el
+++ b/lisp/utf-2000/char-db-util.el
@@ -158,30 +158,99 @@
 	    (setq data (del-alist 'numeric-value data))
 	    )
 	  )
-	(setq data (sort data
-			 (lambda (a b)
-			   (let ((ka (car a))
-				 (kb (car b)))
-			     (cond ((find-charset ka)
-				    (cond ((find-charset kb)
-					   (cond ((= (charset-dimension ka)
-						     (charset-dimension kb))
-						  (< (charset-final ka)
-						     (charset-final kb)))
-						 (t
-						  (< (charset-dimension ka)
-						     (charset-dimension kb))
-						  )))
-					  (t)))
-				   ((find-charset kb)
-				    t)
-				   ((symbolp ka)
-				    (cond ((symbolp kb)
-					   (string< (symbol-name ka)
-						    (symbol-name kb)))
-					  (t)))
-				   ((symbolp kb)
-				    nil))))))
+	(when (setq cell (assq '->decomposition data))
+	  (setq cell (cdr cell))
+	  (insert (format "(->decomposition\t%s)
+    "
+			  (mapconcat (lambda (code)
+				       (cond ((symbolp code)
+					      (symbol-name code))
+					     ((integerp code)
+					      (format "#x%04X" code))
+					     (t
+					      (format "\n     %S" code))))
+				     cell " ")))
+	  (setq data (del-alist '->decomposition data))
+	  )
+	(when (setq cell (assq '->uppercase data))
+	  (setq cell (cdr cell))
+	  (insert (format "(->uppercase\t%s)
+    "
+			  (mapconcat (lambda (code)
+				       (cond ((symbolp code)
+					      (symbol-name code))
+					     ((integerp code)
+					      (format "#x%04X" code))
+					     (t
+					      (format "\n     %S" code))))
+				     cell " ")))
+	  (setq data (del-alist '->uppercase data))
+	  )
+	(when (setq cell (assq '->titlecase data))
+	  (setq cell (cdr cell))
+	  (insert (format "(->titlecase\t%s)
+    "
+			  (mapconcat (lambda (code)
+				       (cond ((symbolp code)
+					      (symbol-name code))
+					     ((integerp code)
+					      (format "#x%04X" code))
+					     (t
+					      (format "\n     %S" code))))
+				     cell " ")))
+	  (setq data (del-alist '->titlecase data))
+	  )
+	(when (setq cell (assq '->lowercase data))
+	  (setq cell (cdr cell))
+	  (insert (format "(->lowercase\t%s)
+    "
+			  (mapconcat (lambda (code)
+				       (cond ((symbolp code)
+					      (symbol-name code))
+					     ((integerp code)
+					      (format "#x%04X" code))
+					     (t
+					      (format "\n     %S" code))))
+				     cell " ")))
+	  (setq data (del-alist '->lowercase data))
+	  )
+	(setq data
+	      (sort data
+		    (lambda (a b)
+		      (let ((ka (car a))
+			    (kb (car b)))
+			(cond ((find-charset ka)
+			       (cond ((find-charset kb)
+				      (cond ((= (charset-dimension ka)
+						(charset-dimension kb))
+					     (cond
+					      ((>= (charset-final ka) ?@)
+					       (if (>= (charset-final kb) ?@)
+						   (< (charset-final ka)
+						      (charset-final kb))
+						 t))
+					      ((>= (charset-final ka) ?0)
+					       (cond
+						((>= (charset-final kb) ?@)
+						 nil)
+						((>= (charset-final kb) ?0)
+						 (< (charset-final ka)
+						    (charset-final kb)))
+						(t)))))
+					    (t
+					     (< (charset-dimension ka)
+						(charset-dimension kb))
+					     )))
+				     (t)))
+			      ((find-charset kb)
+			       t)
+			      ((symbolp ka)
+			       (cond ((symbolp kb)
+				      (string< (symbol-name ka)
+					       (symbol-name kb)))
+				     (t)))
+			      ((symbolp kb)
+			       nil))))))
 	(setq rest data)
 	(while (and rest
 		    (progn
@@ -240,9 +309,16 @@
 	))))
 
 (defun insert-char-range-data (min max)
-  (let ((code min))
+  (let ((code min)
+	char
+	variants)
     (while (<= code max)
-      (insert-char-data (int-char code))
+      (setq char (int-char code))
+      (insert-char-data char)
+      (setq variants (char-variants char))
+      (while variants
+	(insert-char-data (car variants))
+	(setq variants (cdr variants)))
       (setq code (1+ code))
       )))
 
@@ -251,22 +327,32 @@
     (insert-char-range-data min max)
     (write-region (point-min)(point-max) file)))
 
+;;;###autoload
 (defun char-db-update-comment ()
   (interactive)
   (save-excursion
     (goto-char (point-min))
-    (let (cdef table)
+    (let (cdef table char)
       (while (re-search-forward "^[ \t]*\\(([^.()]+)\\)" nil t)
 	(goto-char (match-beginning 1))
 	(setq cdef (read (current-buffer)))
 	(when (find-charset (car cdef))
 	  (goto-char (match-end 0))
-	  (if (setq table (charset-mapping-table (car cdef)))
-	      (set-charset-mapping-table (car cdef) nil))
-	  (delete-region (point) (point-at-eol))
-	  (insert (format "\t; %c" (apply #'make-char cdef)))
-	  (if table
-	      (set-charset-mapping-table (car cdef) table))
+	  (setq char
+		(if (or (eq (car cdef) 'ascii)
+			(= (char-int (charset-final (car cdef))) 0))
+		    (apply (function make-char) cdef)
+		  (if (setq table (charset-mapping-table (car cdef)))
+		      (set-charset-mapping-table (car cdef) nil))
+		  (prog1
+		      (apply (function make-char) cdef)
+		    (if table
+			(set-charset-mapping-table (car cdef) table)))))
+	  (when (not (or (< (char-int char) 32)
+			 (and (<= (char-int char) 128)
+			      (< (char-int char) 160))))
+	    (delete-region (point) (point-at-eol))
+	    (insert (format "\t; %c" char)))
 	  )))))
 
 ;;;###autoload