X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Futf-2000%2Fchar-db-util.el;h=77ce5bac730e964b0df7dcec09bd286698e6c6fb;hb=71959e5dab1eec1d39b1de09d15df39256d724e7;hp=14182801767187a836c38d4564f0f49096022755;hpb=876a26161f77e559432f85ab13baf16bc21f759d;p=chise%2Fxemacs-chise.git.1

diff --git a/lisp/utf-2000/char-db-util.el b/lisp/utf-2000/char-db-util.el
index 1418280..77ce5ba 100644
--- a/lisp/utf-2000/char-db-util.el
+++ b/lisp/utf-2000/char-db-util.el
@@ -1,7 +1,7 @@
 ;;; char-db-util.el --- Character Database utility -*- coding: utf-8-er; -*-
 
 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
-;;   2007 MORIOKA Tomohiko.
+;;   2007, 2008, 2009, 2010, 2011, 2012, 2013 MORIOKA Tomohiko.
 
 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
 ;; Keywords: CHISE, Character Database, ISO/IEC 10646, UCS, Unicode, MULE.
@@ -25,7 +25,8 @@
 
 ;;; Code:
 
-(require 'alist)
+(require 'chise-subr)
+(require 'ideograph-subr)
 
 (defconst unidata-normative-category-alist
   '(("Lu" letter	uppercase)
@@ -62,17 +63,6 @@
     ("So" symbol	other)
     ))
 
-(defconst ideographic-radicals
-  (let ((v (make-vector 215 nil))
-	(i 1))
-    (while (< i 215)
-      (aset v i (decode-char '=ucs (+ #x2EFF i)))
-      (setq i (1+ i)))
-    v))
-
-(defun ideographic-radical (number)
-  (aref ideographic-radicals number))
-
 (defconst shuowen-radicals
   [?一 ?上 ?示 ?三 ?王 ?玉 ?玨 ?气 ?士 ?丨 ; 010
    ?屮 ?艸 ?蓐 ?茻 ?小 ?八 ?釆 ?半 ?牛 ?犛 ; 020
@@ -80,7 +70,7 @@
    ?正 ?是 ?辵 ?彳 ?廴 ?㢟 ?行 ?齒 ?牙 ?足 ; 040
    ?疋 ?品 ?龠 ?冊 ?㗊 ?舌 ?干 ?谷 ?只 ?㕯 ; 050
    ?句 ?丩 ?古 ?十 ?卅 ?言 ?誩 ?音 ?䇂 ?丵 ; 060
-   ?菐 ?𠬞 ?廾 ?共 ?異 ?舁 ?𦥑 ?䢅 ?爨 ?革 ; 070
+   ?菐 ?𠬞 ?𠬜 ?共 ?異 ?舁 ?𦥑 ?䢅 ?爨 ?革 ; 070
    ?鬲 ?䰜 ?爪 ?𠃨 ?鬥 ?又 ?𠂇 ?㕜 ?支 ?𦘒 ; 080
    ?聿 ?畫 ?隶 ?臤 ?臣 ?殳 ?殺 ?𠘧 ?寸 ?皮 ; 090
    ?㼱 ?攴 ?敎 ?卜 ?用 ?爻 ?㸚 ?𥄎 ?目 ?䀠 ; 100
@@ -90,6 +80,7 @@
    ?歺 ?死 ?冎 ?骨 ?肉 ?筋 ?刀 ?刃 ?㓞 ?丰 ; 140
    ?耒 ?𧢲 ?竹 ?箕 ?丌 ?左 ?工 ?㠭 ?巫 ?甘 ; 150
    ?曰 ?乃 ?丂 ?可 ?兮 ?号 ?亏 ?旨 ?喜 ?壴 ; 160
+;  ?旨 ?曰 ?乃 ?丂 ?可 ?兮 ?号 ?亏 ?喜 ?壴 ; 160
    ?鼓 ?豈 ?豆 ?豊 ?豐 ?䖒 ?虍 ?虎 ?虤 ?皿 ; 170
    ?𠙴 ?去 ?血 ?丶 ?丹 ?青 ?井 ?皀 ?鬯 ?食 ; 180
    ?亼 ?會 ?倉 ?入 ?缶 ?矢 ?高 ?冂 ?𩫏 ?京 ; 190
@@ -100,6 +91,10 @@
    ?日 ?旦 ?倝 ?㫃 ?冥 ?晶 ?月 ?有 ?明 ?囧 ; 240
    ?夕 ?多 ?毌 ?𢎘 ?𣐺 ?卣 ?齊 ?朿 ?片 ?鼎 ; 250
    ?克 ?彔 ?禾 ?秝 ?黍 ?香 ?米 ?毇 ?臼 ?凶 ; 260
+   ?𣎳 ?林 ?麻 ?尗 ?耑 ?韭 ?瓜 ?瓠 ?宀 ?宮 ; 270
+   ?呂 ?穴 ?㝱 ?𤕫 ?冖 ?𠔼 ?冃 ?㒳 ?网 ?襾 ; 280
+   ?巾 ?巿 ?帛 ?白 ?㡀 ?黹 ?人 ?𠤎 ?匕 ?从 ; 290
+   ?比 ?北 ?丘 ?㐺 ?𡈼 ?重 ?臥 ?身 ?㐆 ?衣 ; 300
    ])
 
 (defun shuowen-radical (number)
@@ -107,76 +102,8 @@
 
 (defvar char-db-file-coding-system 'utf-8-mcs-er)
 
-(defvar char-db-feature-domains
-  '(ucs ucs/compat daikanwa cns gt jis jis/alt jis/a jis/b
-	jis-x0212 jis-x0213 cdp shinjigen misc unknown))
-
 (defvar char-db-ignored-attributes '(ideographic-products))
 
-(defun char-attribute-name< (ka kb)
-  (cond
-   ((eq '->denotational kb)
-    t)
-   ((eq '->subsumptive kb)
-    (not (eq '->denotational ka)))
-   ((eq '->denotational ka)
-    nil)
-   ((eq '->subsumptive ka)
-    nil)
-   ((and (symbolp ka)
-	 (string-match "^->" (symbol-name ka)))
-    (cond ((and (symbolp kb)
-		(string-match "^->" (symbol-name kb)))
-	   (string< (symbol-name ka)
-		    (symbol-name kb))
-	   ))
-    )
-   ((and (symbolp kb)
-	 (string-match "^->" (symbol-name kb)))
-    t)
-   ((and (symbolp ka)
-	 (string-match "^<-" (symbol-name ka)))
-    (cond ((symbolp kb)
-	   (cond ((string-match "^<-" (symbol-name kb))
-		  (string< (symbol-name ka)
-			   (symbol-name kb))
-		  )
-                 ;; ((string-match "^->" (symbol-name kb))
-                 ;;  t)
-		 )))
-    )
-   ((and (symbolp kb)
-	 (string-match "^<-" (symbol-name kb)))
-    t
-    ;; (not (string-match "^->" (symbol-name ka)))
-    )
-   ((find-charset ka)
-    (if (find-charset kb)
-	(if (<= (charset-id ka) 1)
-	    (if (<= (charset-id kb) 1)
-		(cond
-		 ((= (charset-dimension ka)
-		     (charset-dimension kb))
-		  (> (charset-id ka)(charset-id kb)))
-		 (t
-		  (> (charset-dimension ka)
-		     (charset-dimension kb))
-		  ))
-	      t)
-	  (if (<= (charset-id kb) 1)
-	      nil
-	    (< (charset-id ka)(charset-id kb))))
-      nil))
-   ((find-charset kb)
-    t)
-   ((symbolp ka)
-    (cond ((symbolp kb)
-	   (string< (symbol-name ka)
-		    (symbol-name kb)))
-	  (t)))
-   ((symbolp kb)
-    nil)))
-
 (defvar char-db-coded-charset-priority-list
   '(ascii
     control-1
@@ -189,6 +116,13 @@
     cyrillic-iso8859-5
     greek-iso8859-7
     thai-tis620
+    =adobe-japan1-0
+    =adobe-japan1-1
+    =adobe-japan1-2
+    =adobe-japan1-3
+    =adobe-japan1-4
+    =adobe-japan1-5
+    =adobe-japan1-6
     =jis-x0208
     =jis-x0208@1978
     =jis-x0208@1983
@@ -202,8 +136,10 @@
     chinese-cns11643-5
     chinese-cns11643-6
     chinese-cns11643-7
-    =jis-x0213-1-2000
-    =jis-x0213-2-2000
+    =jis-x0213-1
+    =jis-x0213-1@2000
+    =jis-x0213-1@2004
+    =jis-x0213-2
     korean-ksc5601
     chinese-isoir165
     katakana-jisx0201
@@ -212,9 +148,21 @@
     latin-viscii
     ethiopic-ucs
     =big5-cdp
+    =hanyo-denshi/ja
+    =hanyo-denshi/jb
+    =hanyo-denshi/jc
+    =hanyo-denshi/jd
+    =hanyo-denshi/ft
+    =hanyo-denshi/ia
+    =hanyo-denshi/ib
+    =hanyo-denshi/hg
+    =hanyo-denshi/jt
+    =hanyo-denshi/ks
     =gt
-    ideograph-daikanwa-2
-    ideograph-daikanwa
+    =gt-k
+    =daikanwa
+    =daikanwa@rev2
+    =daikanwa@rev1
     =cbeta
     ideograph-hanziku-1
     ideograph-hanziku-2
@@ -228,15 +176,103 @@
     ideograph-hanziku-10
     ideograph-hanziku-11
     ideograph-hanziku-12
-    =gt-k
+    =>>>adobe-japan1-0
+    =>>>adobe-japan1-1
+    =>>>adobe-japan1-2
+    =>>>adobe-japan1-3
+    =>>>adobe-japan1-4
+    =>>>adobe-japan1-5
+    =>>>adobe-japan1-6
+    =>>>jis-x0208
+    =>>>jis-x0213-1
+    =>>>jis-x0213-2
+    =>>>hanyo-denshi/ja
+    =>>>hanyo-denshi/jb
+    =>>>hanyo-denshi/jc
+    =>>>hanyo-denshi/ft
+    =>>>hanyo-denshi/ib
+    =>>>hanyo-denshi/hg
+    =>>>hanyo-denshi/jt
+    =>>>hanyo-denshi/ks
+    =>>>gt
+    =>>adobe-japan1-0
+    =>>adobe-japan1-1
+    =>>adobe-japan1-2
+    =>>adobe-japan1-3
+    =>>adobe-japan1-4
+    =>>adobe-japan1-5
+    =>>adobe-japan1-6
+    =>>jis-x0208
+    =>>jis-x0213-1
+    =>>jis-x0213-1@2000
+    =>>jis-x0213-1@2004
+    =>>jis-x0213-2
+    =>>jis-x0208@1978
+    =>>hanyo-denshi/ft
+    =>>hanyo-denshi/jt
+    =>>hanyo-denshi/ks
+    =>>gt
+    =>>daikanwa
+    =+>jis-x0208
+    =+>jis-x0213-1
+    =+>jis-x0213-2
+    =+>adobe-japan1-0
+    =+>adobe-japan1-1
+    =+>adobe-japan1-2
+    =+>adobe-japan1-3
+    =+>adobe-japan1-4
+    =+>adobe-japan1-5
+    =+>adobe-japan1-6
+    =+>jis-x0208@1978
+    =>jis-x0208
+    =>jis-x0208@1997
+    =>jis-x0213-1
+    =>jis-x0213-1@2000
+    =>jis-x0213-1@2004
+    =>jis-x0213-2
+    ==>ucs@bucs
+    =>ucs@iso
+    =>ucs@unicode
+    =>ucs@jis
+    =>ucs@cns
+    =>ucs@ks
+    =+>ucs@iso
+    =+>ucs@unicode
+    =+>ucs@jis
+    =+>ucs@jis/1990
+    =+>ucs@cns
+    =+>ucs@ks
+    =>>ucs@iso
+    =>>ucs@unicode
+    =>>ucs@jis
+    =>>ucs@cns
+    =>>>ucs@iso
+    =>>>ucs@unicode
     =ucs@iso
     =ucs@unicode
+    =>>big5-cdp
+    =>>gt-k
+    =+>gt
+    =>gt
+    =>big5-cdp
+    =>daikanwa
+    =>daikanwa/ho
+    =>cns11643-7
     =big5
     =big5-eten
-    =jis-x0208@1997
+    =>gt-k
     =zinbun-oracle
+    =>zinbun-oracle
     =ruimoku-v6
-    =jef-china3))
+    =>>ruimoku-v6
+    =jef-china3
+    =shinjigen
+    =big5-cdp-var-3
+    =big5-cdp-var-5))
+
+
+;;; @ char-db formatters
+;;;
 
 (defun char-db-make-char-spec (char)
   (let (ret char-spec)
@@ -251,6 +287,26 @@
 			 (setq char-spec (cons (cons 'name* ret) char-spec))
 			 ))
 		  )
+		 ((encode-char char '=adobe-japan1 'defined-only)
+		  (setq char-spec nil)
+		  (dolist (ccs (charset-list))
+		    (if (and (or (memq ccs
+				       '(=adobe-japan1-0
+					 =adobe-japan1-1
+					 =adobe-japan1-2
+					 =adobe-japan1-3
+					 =adobe-japan1-4
+					 =adobe-japan1-5
+					 =adobe-japan1-6
+					 ))
+                                 ;; (eq (charset-property ccs 'iso-ir) 177)
+				 (string-match "=ucs@" (symbol-name ccs))
+				 )
+			     (setq ccs (charset-name ccs))
+			     (null (assq ccs char-spec))
+			     (setq ret (encode-char char ccs 'defined-only)))
+			(setq char-spec (cons (cons ccs ret) char-spec))))
+		  )
 		 ((setq ret
 			(catch 'tag
 			  (let ((rest char-db-coded-charset-priority-list)
@@ -271,7 +327,10 @@
 					 =daikanwa@rev2
 					 ;; =gt-k
 					 =jis-x0208@1997
-					 )))
+					 ))
+                                 (eq (charset-property ccs 'iso-ir) 177)
+				 ;; (string-match "=ucs@" (symbol-name ccs))
+				 )
 			     (setq ccs (charset-name ccs))
 			     (null (assq ccs char-spec))
 			     (setq ret (encode-char char ccs 'defined-only)))
@@ -284,6 +343,12 @@
 			((setq ret (get-char-attribute char 'name*))
 			 (setq char-spec (cons (cons 'name* ret) char-spec))
 			 ))
+		  )
+		 ((setq ret (get-char-attribute
+			     char 'ideographic-combination))
+		  (setq char-spec
+			(cons (cons 'ideographic-combination ret)
+			      char-spec))
 		  ))
 	   char-spec)
 	  ((consp char)
@@ -308,7 +373,8 @@
     (insert-char-attributes char
 			    readable
                             (union (mapcar #'car char-spec)
-				   required-features))
+				   required-features)
+			    nil 'for-sub-node)
     (when temp-char
       ;; undefine temporary character
       ;;   Current implementation is dirty.
@@ -349,7 +415,7 @@
 		   (insert-char-attributes ret
 					   readable
 					   (or al 'none) ; cal
-					   ))
+					   nil 'for-sub-node))
 	       (insert (prin1-to-string value)))
 	     (insert ")")
 	     (insert line-breaking))
@@ -381,7 +447,7 @@
 		     (insert-char-attributes ret
 					     readable
 					     al ; cal
-					     )
+					     nil 'for-sub-node)
 		     (setq separator lbs))
 		 (if separator
 		     (insert separator))
@@ -464,36 +530,72 @@
 (defvar char-db-convert-obsolete-format t)
 
 (defun char-db-insert-ccs-feature (name value line-breaking)
-  (insert
-   (format
-    (cond ((or (memq name '(=daikanwa
-			    =daikanwa@rev1 =daikanwa@rev2
-			    =gt =gt-k =cbeta =zinbun-oracle))
-	       (string-match "^=adobe-" (symbol-name name)))
-	   "(%-18s . %05d)\t; %c")
-	  ((eq name '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 =>>daikanwa/ho =>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/+p
+			 =daikanwa/+2p =>>daikanwa/+2p
+			 =gt =>>>gt =>>gt =+>gt =>gt
+			 =gt-k =>>gt-k =>gt-k
+			 =adobe-japan1-0 =>>>adobe-japan1-0
+			 =adobe-japan1-1 =>>>adobe-japan1-1
+			 =adobe-japan1-2 =>>>adobe-japan1-2
+			 =adobe-japan1-3 =>>>adobe-japan1-3
+			 =adobe-japan1-4 =>>>adobe-japan1-4
+			 =adobe-japan1-5 =>>>adobe-japan1-5
+			 =adobe-japan1-6 =>>>adobe-japan1-6
+			 =>>adobe-japan1-0 =+>adobe-japan1-0
+			 =>>adobe-japan1-1 =+>adobe-japan1-1
+			 =>>adobe-japan1-2 =+>adobe-japan1-2
+			 =>>adobe-japan1-3 =+>adobe-japan1-3
+			 =>>adobe-japan1-4 =+>adobe-japan1-4
+			 =>>adobe-japan1-5 =+>adobe-japan1-5
+			 =>>adobe-japan1-6 =+>adobe-japan1-6
+			 =cbeta =>>cbeta
+			 =zinbun-oracle =>zinbun-oracle))
+            ;; (string-match "^=adobe-" (symbol-name name))
+	    )
+	"(%-18s . %05d)\t; %c")
+       ((memq name '(=hanyo-denshi/ks
+		     =>>>hanyo-denshi/ks =>>hanyo-denshi/ks
+		     =zihai 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
@@ -519,7 +621,7 @@
 	  (let ((char-db-ignored-attributes
 		 (cons '<-subsumptive
 		       char-db-ignored-attributes)))
-	    (insert-char-attributes cell readable))
+	    (insert-char-attributes cell readable nil nil 'for-sub-node))
 	  (setq separator lbs))
 	)
        ((characterp cell)
@@ -529,16 +631,23 @@
 	(setq required-features nil)
 	(dolist (source sources)
 	  (cond
-	   ((memq source '(JP JP/Jouyou shinjigen-1))
+	   ((memq source '(JP
+			   JP/Jouyou
+			   shinjigen shinjigen@1ed shinjigen@rev))
 	    (setq required-features
 		  (union required-features
 			 '(=jis-x0208
 			   =jis-x0208@1990
-			   =jis-x0213-1-2000
-			   =jis-x0213-2-2000
+			   =jis-x0213-1@2000
+			   =jis-x0213-1@2004
+			   =jis-x0213-2
 			   =jis-x0212
 			   =jis-x0208@1983
-			   =jis-x0208@1978))))
+			   =jis-x0208@1978
+			   =shinjigen
+			   =shinjigen@1ed
+			   =shinjigen@rev
+			   =shinjigen/+p@rev))))
 	   ((eq source 'CN)
 	    (setq required-features
 		  (union required-features
@@ -591,7 +700,8 @@
     (insert ")")
     (insert line-breaking)))
 
-(defun insert-char-attributes (char &optional readable attributes column)
+(defun insert-char-attributes (char &optional readable attributes column
+				    for-sub-node)
   (unless column
     (setq column (current-column)))
   (let (name value ; has-long-ccs-name
@@ -623,7 +733,7 @@
 		  #'char-attribute-name<)))
     (insert "(")
     (when (memq '<-subsumptive attributes)
-      (when readable
+      (when (or readable (not for-sub-node))
 	(when (setq value (get-char-attribute char '<-subsumptive))
 	  (char-db-insert-relation-feature char '<-subsumptive value
 					   line-breaking
@@ -668,7 +778,7 @@
 			name value (decode-char '=ucs value)
 			line-breaking))
 	(setq attributes (delq name attributes))))
-    (dolist (name '(=>ucs@gb =>ucs@cns =>ucs@jis =>ucs@ks =>ucs@big5))
+    (dolist (name '(=>ucs@gb =>ucs@big5))
       (when (and (memq name attributes)
 		 (setq value (get-char-attribute char name)))
 	(insert (format "(%-18s . #x%04X)\t; %c%s"
@@ -681,21 +791,21 @@
 			line-breaking))
 	(setq attributes (delq name attributes))
 	))
-    (dolist (name '(=>daikanwa))
-      (when (and (memq name attributes)
-		 (setq value (get-char-attribute char name)))
-	(insert
-	 (if (integerp value)
-	     (format "(%-18s . %05d)\t; %c%s"
-		     name value (decode-char '=daikanwa value)
-		     line-breaking)
-	   (format "(%-18s %s)\t; %c%s"
-		   name
-		   (mapconcat (function prin1-to-string)
-			      value " ")
-		   (char-representative-of-daikanwa char)
-		   line-breaking)))
-	(setq attributes (delq name attributes))))
+    ;; (dolist (name '(=>daikanwa))
+    ;;   (when (and (memq name attributes)
+    ;;              (setq value (get-char-attribute char name)))
+    ;;     (insert
+    ;;      (if (integerp value)
+    ;;          (format "(%-18s . %05d)\t; %c%s"
+    ;;                  name value (decode-char '=daikanwa value)
+    ;;                  line-breaking)
+    ;;        (format "(%-18s %s)\t; %c%s"
+    ;;                name
+    ;;                (mapconcat (function prin1-to-string)
+    ;;                           value " ")
+    ;;                (char-representative-of-daikanwa char)
+    ;;                line-breaking)))
+    ;;     (setq attributes (delq name attributes))))
     (when (and (memq 'general-category attributes)
 	       (setq value (get-char-attribute char 'general-category)))
       (insert (format
@@ -923,17 +1033,17 @@
 	    (setq strokes value)))
       (setq attributes (delq 'cns-strokes attributes))
       )
-    (when (and (memq 'shinjigen-1-radical attributes)
-	       (setq value (get-char-attribute char 'shinjigen-1-radical)))
-      (unless (eq value radical)
-	(insert (format "(shinjigen-1-radical . %S)\t; %c%s"
-			value
-			(ideographic-radical value)
-			line-breaking))
-	(or radical
-	    (setq radical value)))
-      (setq attributes (delq 'shinjigen-1-radical attributes))
-      )
+    ;; (when (and (memq 'shinjigen-1-radical attributes)
+    ;;            (setq value (get-char-attribute char 'shinjigen-1-radical)))
+    ;;   (unless (eq value radical)
+    ;;     (insert (format "(shinjigen-1-radical . %S)\t; %c%s"
+    ;;                     value
+    ;;                     (ideographic-radical value)
+    ;;                     line-breaking))
+    ;;     (or radical
+    ;;         (setq radical value)))
+    ;;   (setq attributes (delq 'shinjigen-1-radical attributes))
+    ;;   )
     (when (and (memq 'ideographic- attributes)
 	       (setq value (get-char-attribute char 'ideographic-)))
       (insert "(ideographic-       ")
@@ -1043,155 +1153,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)
-		     (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)
-			 (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 ")")))
 
@@ -1302,6 +1415,10 @@
 		what-character-original-window-configuration)
 	       (signal (car err) (cdr err)))))))
 
+
+;;; @ end
+;;;
+
 (provide 'char-db-util)
 
 ;;; char-db-util.el ends here