From: tomo <tomo>
Date: Mon, 16 Feb 2004 17:21:49 +0000 (+0000)
Subject: (insert-char-attributes): Check each character specified in
X-Git-Tag: r21-4-14-chise-0_21-25^2~37
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=eac9f8a3dc4114ba0cacf27dfad0efe6887c2f6c;p=chise%2Fxemacs-chise.git

(insert-char-attributes): Check each character specified in
`->subsumptive' with `char-db-ignored-attributes'.
---

diff --git a/lisp/utf-2000/char-db-util.el b/lisp/utf-2000/char-db-util.el
index 01f6894..5c3aac5 100644
--- a/lisp/utf-2000/char-db-util.el
+++ b/lisp/utf-2000/char-db-util.el
@@ -419,20 +419,6 @@
 (defvar char-db-convert-obsolete-format t)
 
 (defun insert-char-attributes (char &optional readable attributes column)
-  (let (atr-d)
-    (setq attributes
-	  (sort (if attributes
-		    (if (consp attributes)
-			(progn
-			  (dolist (name attributes)
-			    (unless (memq name char-db-ignored-attributes)
-			      (push name atr-d)))
-			  atr-d))
-		  (dolist (name (char-attribute-list))
-		    (unless (memq name char-db-ignored-attributes)
-		      (push name atr-d)))
-		  atr-d)
-		#'char-attribute-name<)))
   (unless column
     (setq column (current-column)))
   (let (name value has-long-ccs-name rest
@@ -442,7 +428,26 @@
 	lbs cell separator ret
 	key al cal
 	dest-ccss
-	sources required-features)
+	sources required-features
+	ccss)
+    (let (atr-d)
+      (setq attributes
+	    (sort (if attributes
+		      (if (consp attributes)
+			  (progn
+			    (dolist (name attributes)
+			      (unless (memq name char-db-ignored-attributes)
+				(if (find-charset name)
+				    (push name ccss))
+				(push name atr-d)))
+			    atr-d))
+		    (dolist (name (char-attribute-list))
+		      (unless (memq name char-db-ignored-attributes)
+			(if (find-charset name)
+			    (push name ccss))
+			(push name atr-d)))
+		    atr-d)
+		  #'char-attribute-name<)))
     (insert "(")
     (when (and (memq 'name attributes)
 	       (setq value (get-char-attribute char 'name)))
@@ -932,13 +937,22 @@
                    (if (integerp cell)
 		       (setq cell (decode-char '=ucs cell)))
 		   (cond ((eq name '->subsumptive)
-			  (if separator
-			      (insert lbs))
-			  (let ((char-db-ignored-attributes
-				 (cons '<-subsumptive
-				       char-db-ignored-attributes)))
-			    (insert-char-attributes cell readable))
-			  (setq separator lbs))
+			  (when (or (not
+				     (some (lambda (atr)
+					     (get-char-attribute cell atr))
+					   char-db-ignored-attributes))
+				    (some (lambda (ccs)
+					    (encode-char cell ccs
+							 'defined-only))
+					  ccss))
+			    (if separator
+				(insert lbs))
+			    (let ((char-db-ignored-attributes
+				   (cons '<-subsumptive
+					 char-db-ignored-attributes)))
+			      (insert-char-attributes cell readable))
+			    (setq separator lbs))
+			  )
 			 ((characterp cell)
 			  (setq sources
 				(get-char-attribute