From: tomo <tomo>
Date: Fri, 22 Jul 2011 13:08:21 +0000 (+0000)
Subject: (char-db-insert-ccs-feature): Accept non-integer value.
X-Git-Tag: r21-4-22-chise-0_25-10^20~302
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=e2a758d3f9da17dcc4184b570c5e0777b13f05cc;p=chise%2Fxemacs-chise.git

(char-db-insert-ccs-feature): Accept non-integer value.
(insert-char-attributes): Accept nil as value.
---

diff --git a/lisp/utf-2000/char-db-util.el b/lisp/utf-2000/char-db-util.el
index b5df1e9..0e4839b 100644
--- a/lisp/utf-2000/char-db-util.el
+++ b/lisp/utf-2000/char-db-util.el
@@ -461,48 +461,55 @@
 (defvar char-db-convert-obsolete-format t)
 
 (defun char-db-insert-ccs-feature (name value line-breaking)
-  (insert
-   (format
-    (cond ((memq name '(=shinjigen
-			=shinjigen@1ed
-			=shinjigen@rev =shinjigen/+p@rev
-			=daikanwa/ho))
-	   "(%-18s .  %04d)\t; %c")
-	  ((eq name '=shinjigen@1ed/24pr)
-	   "(%-18s . %04d)\t; %c")
-	  ((or (memq name '(=daikanwa =>>daikanwa =>daikanwa
-			    =daikanwa@rev1 =daikanwa@rev2
-			    =daikanwa/+p =daikanwa/+2p
-			    =gt =>>>gt =>>gt =>gt
-			    =gt-k =>>gt-k =>gt-k
-			    =>>adobe-japan1
-			    =cbeta =>>cbeta
-			    =zinbun-oracle =>zinbun-oracle))
-	       (string-match "^=adobe-" (symbol-name name)))
-	   "(%-18s . %05d)\t; %c")
-	  ((memq name '(=hanyo-denshi/ks =>>hanyo-denshi/ks mojikyo))
-	   "(%-18s . %06d)\t; %c")
-	  ((>= (charset-dimension name) 2)
-	   "(%-18s . #x%04X)\t; %c")
-	  (t
-	   "(%-18s . #x%02X)\t; %c"))
-    name
-    (if (= (charset-iso-graphic-plane name) 1)
-	(logior value
-		(cond ((= (charset-dimension name) 1)
-		       #x80)
-		      ((= (charset-dimension name) 2)
-		       #x8080)
-		      ((= (charset-dimension name) 3)
-		       #x808080)
-		      (t 0)))
-      value)
-    (char-db-decode-isolated-char name value)))
-  (if (and (= (charset-chars name) 94)
-	   (= (charset-dimension name) 2))
-      (insert (format " [%02d-%02d]"
-		      (- (lsh value -8) 32)
-		      (- (logand value 255) 32))))
+  (cond
+   ((integerp value)
+    (insert
+     (format
+      (cond
+       ((memq name '(=shinjigen
+		     =shinjigen@1ed
+		     =shinjigen@rev =shinjigen/+p@rev
+		     =daikanwa/ho))
+	"(%-18s .  %04d)\t; %c")
+       ((eq name '=shinjigen@1ed/24pr)
+	"(%-18s . %04d)\t; %c")
+       ((or (memq name '(=daikanwa =>>daikanwa =>daikanwa
+			 =daikanwa@rev1 =daikanwa@rev2
+			 =daikanwa/+p =daikanwa/+2p
+			 =gt =>>>gt =>>gt =>gt
+			 =gt-k =>>gt-k =>gt-k
+			 =>>adobe-japan1
+			 =cbeta =>>cbeta
+			 =zinbun-oracle =>zinbun-oracle))
+	    (string-match "^=adobe-" (symbol-name name)))
+	"(%-18s . %05d)\t; %c")
+       ((memq name '(=hanyo-denshi/ks =>>hanyo-denshi/ks mojikyo))
+	"(%-18s . %06d)\t; %c")
+       ((>= (charset-dimension name) 2)
+	"(%-18s . #x%04X)\t; %c")
+       (t
+	"(%-18s . #x%02X)\t; %c"))
+      name
+      (if (= (charset-iso-graphic-plane name) 1)
+	  (logior value
+		  (cond ((= (charset-dimension name) 1)
+			 #x80)
+			((= (charset-dimension name) 2)
+			 #x8080)
+			((= (charset-dimension name) 3)
+			 #x808080)
+			(t 0)))
+	value)
+      (char-db-decode-isolated-char name value)))
+    (if (and (= (charset-chars name) 94)
+	     (= (charset-dimension name) 2))
+	(insert (format " [%02d-%02d]"
+			(- (lsh value -8) 32)
+			(- (logand value 255) 32))))
+    )
+   (t
+    (insert (format "(%-18s . %s)" name value))
+    ))
   (insert line-breaking))
 
 (defun char-db-insert-relation-feature (char name value line-breaking
@@ -1057,159 +1064,158 @@
 	(setq attributes (delq ignored attributes))))
     (while attributes
       (setq name (car attributes))
-      (if (setq value (get-char-attribute char name))
-	  (cond ((setq ret (find-charset name))
-		 (setq name (charset-name ret))
-		 (if (and (not (memq name dest-ccss))
-			  (prog1
-			      (setq value (get-char-attribute char name))
-			    (setq dest-ccss (cons name dest-ccss))))
-		     (char-db-insert-ccs-feature name value line-breaking))
-		 )
-		((string-match "^=>ucs@" (symbol-name name))
-		 (insert (format "(%-18s . #x%04X)\t; %c%s"
-				 name value (decode-char '=ucs value)
-				 line-breaking))
-		 )
-		((eq name 'jisx0208-1978/4X)
-		 (insert (format "(%-18s . #x%04X)%s"
-				 name value
-				 line-breaking))
-		 )
-		((and
-		  (not readable)
-		  (not (eq name '->subsumptive))
-		  (not (eq name '->uppercase))
-		  (not (eq name '->lowercase))
-		  (not (eq name '->titlecase))
-		  (not (eq name '->canonical))
-		  (not (eq name '->Bopomofo))
-		  (not (eq name '->mistakable))
-		  (not (eq name '->ideographic-variants))
-		  (null (get-char-attribute
-			 char (intern (format "%s*sources" name))))
-		  (not (string-match "\\*sources$" (symbol-name name)))
-		  (null (get-char-attribute
-			 char (intern (format "%s*note" name))))
-		  (not (string-match "\\*note$" (symbol-name name)))
-		  (or (eq name '<-identical)
-		      (eq name '<-uppercase)
-		      (eq name '<-lowercase)
-		      (eq name '<-titlecase)
-		      (eq name '<-canonical)
-		      (eq name '<-ideographic-variants)
-                      ;; (eq name '<-synonyms)
-		      (string-match "^<-synonyms" (symbol-name name))
-		      (eq name '<-mistakable)
-		      (when (string-match "^->" (symbol-name name))
-			(cond
-			 ((string-match "^->fullwidth" (symbol-name name))
-			  (not (and (consp value)
-				    (characterp (car value))
-				    (encode-char
-				     (car value) '=ucs 'defined-only)))
-			  )
-			 (t)))
-		      ))
-		 )
-		((or (eq name 'ideographic-structure)
-		     (eq name 'ideographic-combination)
-		     (eq name 'ideographic-)
-		     (eq name '=decomposition)
-		     (char-feature-base-name= '=decomposition name)
-                     (char-feature-base-name= '=>decomposition name)
-                     ;; (string-match "^=>*decomposition\\(@[^*]+\\)?$"
-                     ;;               (symbol-name name))
-		     (string-match "^\\(->\\|<-\\)[^*]*$" (symbol-name name))
-		     (string-match "^\\(->\\|<-\\)[^*]*\\*sources$"
-				   (symbol-name name))
-		     )
-		 (char-db-insert-relation-feature char name value
-						  line-breaking
-						  ccss readable))
-		((memq name '(ideograph=
-			      original-ideograph-of
-			      ancient-ideograph-of
-			      vulgar-ideograph-of
-			      wrong-ideograph-of
-                              ;; simplified-ideograph-of
-			      ideographic-variants
-                              ;; ideographic-different-form-of
-			      ))
-		 (insert (format "(%-18s%s " name line-breaking))
-		 (setq lbs (concat "\n" (make-string (current-column) ?\ ))
-		       separator nil)
-		 (while (consp value)
-		   (setq cell (car value))
-		   (if (and (consp cell)
-			    (consp (car cell)))
-		       (progn
-			 (if separator
-			     (insert lbs))
-			 (char-db-insert-alist cell readable)
-			 (setq separator lbs))
-		     (if separator
-			 (insert separator))
-		     (insert (prin1-to-string cell))
-		     (setq separator " "))
-		   (setq value (cdr value)))
-		 (insert ")")
-		 (insert line-breaking))
-                ((consp value)
-		 (insert (format "(%-18s " name))
-		 (setq lbs (concat "\n" (make-string (current-column) ?\ ))
-		       separator nil)
-		 (while (consp value)
-		   (setq cell (car value))
-		   (if (and (consp cell)
-			    (consp (car cell))
-			    (setq ret (condition-case nil
-					  (find-char cell)
-					(error nil))))
-		       (progn
-			 (setq rest cell
-			       al nil
-			       cal nil)
-			 (while rest
-			   (setq key (car (car rest)))
-			   (if (find-charset key)
-			       (setq cal (cons key cal))
-			     (setq al (cons key al)))
-			   (setq rest (cdr rest)))
-			 (if separator
-			     (insert lbs))
-			 (insert-char-attributes ret
-						 readable
-						 al ; cal
-						 nil 'for-sub-node)
-			 (setq separator lbs))
-		     (setq ret (prin1-to-string cell))
-		     (if separator
-			 (if (< (+ (current-column)
-				   (length ret)
-				   (length separator))
-				76)
-			     (insert separator)
-			   (insert lbs)))
-		     (insert ret)
-		     (setq separator " "))
-		   (setq value (cdr value)))
-		 (insert ")")
+      (unless (eq (setq value (get-char-attribute char name 'value-is-empty))
+		  'value-is-empty)
+	(cond ((setq ret (find-charset name))
+	       (setq name (charset-name ret))
+	       (when (not (memq name dest-ccss))
+		 (setq dest-ccss (cons name dest-ccss))
+		 (char-db-insert-ccs-feature name value line-breaking))
+	       )
+	      ((string-match "^=>ucs@" (symbol-name name))
+	       (insert (format "(%-18s . #x%04X)\t; %c%s"
+			       name value (decode-char '=ucs value)
+			       line-breaking))
+	       )
+	      ((eq name 'jisx0208-1978/4X)
+	       (insert (format "(%-18s . #x%04X)%s"
+			       name value
+			       line-breaking))
+	       )
+	      ((and
+		(not readable)
+		(not (eq name '->subsumptive))
+		(not (eq name '->uppercase))
+		(not (eq name '->lowercase))
+		(not (eq name '->titlecase))
+		(not (eq name '->canonical))
+		(not (eq name '->Bopomofo))
+		(not (eq name '->mistakable))
+		(not (eq name '->ideographic-variants))
+		(null (get-char-attribute
+		       char (intern (format "%s*sources" name))))
+		(not (string-match "\\*sources$" (symbol-name name)))
+		(null (get-char-attribute
+		       char (intern (format "%s*note" name))))
+		(not (string-match "\\*note$" (symbol-name name)))
+		(or (eq name '<-identical)
+		    (eq name '<-uppercase)
+		    (eq name '<-lowercase)
+		    (eq name '<-titlecase)
+		    (eq name '<-canonical)
+		    (eq name '<-ideographic-variants)
+		    ;; (eq name '<-synonyms)
+		    (string-match "^<-synonyms" (symbol-name name))
+		    (eq name '<-mistakable)
+		    (when (string-match "^->" (symbol-name name))
+		      (cond
+		       ((string-match "^->fullwidth" (symbol-name name))
+			(not (and (consp value)
+				  (characterp (car value))
+				  (encode-char
+				   (car value) '=ucs 'defined-only)))
+			)
+		       (t)))
+		    ))
+	       )
+	      ((or (eq name 'ideographic-structure)
+		   (eq name 'ideographic-combination)
+		   (eq name 'ideographic-)
+		   (eq name '=decomposition)
+		   (char-feature-base-name= '=decomposition name)
+		   (char-feature-base-name= '=>decomposition name)
+		   ;; (string-match "^=>*decomposition\\(@[^*]+\\)?$"
+		   ;;               (symbol-name name))
+		   (string-match "^\\(->\\|<-\\)[^*]*$" (symbol-name name))
+		   (string-match "^\\(->\\|<-\\)[^*]*\\*sources$"
+				 (symbol-name name))
+		   )
+	       (char-db-insert-relation-feature char name value
+						line-breaking
+						ccss readable))
+	      ((memq name '(ideograph=
+			    original-ideograph-of
+			    ancient-ideograph-of
+			    vulgar-ideograph-of
+			    wrong-ideograph-of
+			    ;; simplified-ideograph-of
+			    ideographic-variants
+			    ;; ideographic-different-form-of
+			    ))
+	       (insert (format "(%-18s%s " name line-breaking))
+	       (setq lbs (concat "\n" (make-string (current-column) ?\ ))
+		     separator nil)
+	       (while (consp value)
+		 (setq cell (car value))
+		 (if (and (consp cell)
+			  (consp (car cell)))
+		     (progn
+		       (if separator
+			   (insert lbs))
+		       (char-db-insert-alist cell readable)
+		       (setq separator lbs))
+		   (if separator
+		       (insert separator))
+		   (insert (prin1-to-string cell))
+		   (setq separator " "))
+		 (setq value (cdr value)))
+	       (insert ")")
+	       (insert line-breaking))
+	      ((consp value)
+	       (insert (format "(%-18s " name))
+	       (setq lbs (concat "\n" (make-string (current-column) ?\ ))
+		     separator nil)
+	       (while (consp value)
+		 (setq cell (car value))
+		 (if (and (consp cell)
+			  (consp (car cell))
+			  (setq ret (condition-case nil
+					(find-char cell)
+				      (error nil))))
+		     (progn
+		       (setq rest cell
+			     al nil
+			     cal nil)
+		       (while rest
+			 (setq key (car (car rest)))
+			 (if (find-charset key)
+			     (setq cal (cons key cal))
+			   (setq al (cons key al)))
+			 (setq rest (cdr rest)))
+		       (if separator
+			   (insert lbs))
+		       (insert-char-attributes ret
+					       readable
+					       al ; cal
+					       nil 'for-sub-node)
+		       (setq separator lbs))
+		   (setq ret (prin1-to-string cell))
+		   (if separator
+		       (if (< (+ (current-column)
+				 (length ret)
+				 (length separator))
+			      76)
+			   (insert separator)
+			 (insert lbs)))
+		   (insert ret)
+		   (setq separator " "))
+		 (setq value (cdr value)))
+	       (insert ")")
+	       (insert line-breaking))
+	      (t
+	       (insert (format "(%-18s" name))
+	       (setq ret (prin1-to-string value))
+	       (unless (< (+ (current-column)
+			     (length ret)
+			     3)
+			  76)
 		 (insert line-breaking))
-		(t
-                 (insert (format "(%-18s" name))
-		 (setq ret (prin1-to-string value))
-		 (unless (< (+ (current-column)
-			       (length ret)
-			       3)
-			    76)
-		   (insert line-breaking))
-		 (insert " . " ret ")" line-breaking)
-		 ;; (insert (format "(%-18s . %S)%s"
-                 ;;                 name value
-                 ;;                 line-breaking))
-		 )
-		))
+	       (insert " . " ret ")" line-breaking)
+	       ;; (insert (format "(%-18s . %S)%s"
+	       ;;                 name value
+	       ;;                 line-breaking))
+	       )
+	      ))
       (setq attributes (cdr attributes)))
     (insert ")")))