From b36080479cb29820603706770818be821480fff1 Mon Sep 17 00:00:00 2001
From: MORIOKA Tomohiko <tomo.git@chise.org>
Date: Fri, 6 May 2016 04:18:16 +0900
Subject: [PATCH] (char-db-json-insert-ccs-feature): Modify layout.
 (char-db-json-insert-relation-feature): Likewise.
 (char-db-json-insert-char-features): Likewise; add
 "@context" and "@id".

---
 char-db-json.el |  279 +++++++++++++++++++------------------------------------
 1 file changed, 98 insertions(+), 181 deletions(-)

diff --git a/char-db-json.el b/char-db-json.el
index c38d39a..a8b897e 100644
--- a/char-db-json.el
+++ b/char-db-json.el
@@ -30,7 +30,7 @@
 
 (setq char-db-ignored-attributes
       '(ideographic-products
-	->HNG
+        ;; ->HNG
 	*instance@ruimoku/bibliography/title
 	*instance@morpheme-entry/zh-classical))
 
@@ -197,9 +197,9 @@
 		     =shinjigen/+p@rev ==shinjigen/+p@rev
 		     ===daikanwa/ho ==daikanwa/ho
 		     =daikanwa/ho =>>daikanwa/ho =>daikanwa/ho))
-	" %-18s  %4d,\t\"_comment\": \"%c")
+	" %-20s  %4d,\t\"_comment\": \"%c")
        ((eq name '=shinjigen@1ed/24pr)
-	" %-18s  %4d,\t\"_comment\": \"%c")
+	" %-20s  %4d,\t\"_comment\": \"%c")
        ((or
 	 (memq name
 	       '(===daikanwa
@@ -244,20 +244,20 @@
 		 ===hng-smk))
 	 ;; (string-match "^=adobe-" (symbol-name name))
 	 )
-	" %-18s %5d,\t\"_comment\": \"%c")
+	" %-20s %5d,\t\"_comment\": \"%c")
        ((memq name '(=hanyo-denshi/ks
 		     ==hanyo-denshi/ks ===hanyo-denshi/ks
 		     =>>hanyo-denshi/ks
 		     =koseki ==koseki
 		     =mj ==mj ===mj =>>mj =>mj
 		     =zihai mojikyo))
-	" %-18s %6d,\t\"_comment\": \"%c")
+	" %-19s %6d,\t\"_comment\": \"%c")
        ((memq name '(=hanyo-denshi/tk ==hanyo-denshi/tk))
-	" %-18s %8d,\t\"_comment\": \"%c")
+	" %-20s %8d,\t\"_comment\": \"%c")
        ((>= (charset-dimension name) 2)
-	" %-18s %5d,\t\"_comment\": \"%c")
+	" %-20s %5d,\t\"_comment\": \"%c")
        (t
-	" %-18s %3d,\t\"_comment\": \"%c"))
+	" %-20s   %3d,\t\"_comment\": \"%c"))
       (format "\"%s\":" name)
       (if (= (charset-iso-graphic-plane name) 1)
 	  (logior value
@@ -278,14 +278,14 @@
       (insert "\""))
     )
    (t
-    (insert (format " %-18s %s"
+    (insert (format " %-20s %s"
 		    (format "\"%s\":" name) value))
     ))
   )
 
 (defun char-db-json-insert-relation-feature (char name value line-breaking
 					     ccss readable)
-  (insert (format " %-18s [%s    "
+  (insert (format " %-20s [%s    "
 		  (format "\"%s\":" name) line-breaking))
   (let ((lbs (concat "\n" (make-string (current-column) ?\ )))
 	separator cell sources required-features
@@ -395,12 +395,13 @@
 					  for-sub-node)
   (unless column
     (setq column (current-column)))
-  (let (name value ; has-long-ccs-name
+  (let ((est-view-url-prefix "http://chise.org/est/view")
+	name value ; has-long-ccs-name
 	rest
 	radical strokes
 	(line-breaking
 	 (concat "\n" (make-string (1+ column) ?\ )))
-	(line-separator nil)
+	line-separator
 	lbs cell separator ret
 	key al cal
 	dest-ccss ; sources required-features
@@ -423,22 +424,26 @@
 			(push name atr-d)))
 		    atr-d)
 		  #'char-attribute-name<)))
-    (insert "{")
+    (insert
+     (format "{ \"@context\": \"%s/genre/character/context.json\""
+	     est-view-url-prefix))
+    (setq line-separator (format ",%s" line-breaking))
+    (insert (format "%s \"@id\": \"%s\""
+		    line-separator
+		    (www-uri-make-object-url char)))
     (when (memq '<-subsumptive attributes)
       (when (or readable (not for-sub-node))
 	(when (setq value (get-char-attribute char '<-subsumptive))
+	  (insert line-separator)
 	  (char-db-json-insert-relation-feature char '<-subsumptive value
 						line-breaking
 						ccss readable)
-	  (setq line-separator (format ",%s" line-breaking))
 	  ))
       (setq attributes (delq '<-subsumptive attributes))
       )
     (when (and (memq '<-denotational attributes)
 	       (setq value (get-char-attribute char '<-denotational)))
-      (if line-separator
-	  (insert line-separator)
-	(setq line-separator (format ",%s" line-breaking)))
+      (insert line-separator)
       (char-db-json-insert-relation-feature char '<-denotational value
 					    line-breaking
 					    ccss readable)
@@ -446,9 +451,7 @@
     (when (and (memq '<-denotational@component attributes)
 	       (setq value
 		     (get-char-attribute char '<-denotational@component)))
-      (if line-separator
-	  (insert line-separator)
-	(setq line-separator (format ",%s" line-breaking)))
+      (insert line-separator)
       (char-db-json-insert-relation-feature
        char '<-denotational@component value
        line-breaking
@@ -456,56 +459,45 @@
       (setq attributes (delq '<-denotational@component attributes)))
     (when (and (memq 'name attributes)
 	       (setq value (get-char-attribute char 'name)))
-      (if line-separator
-	  (insert line-separator)
-	(setq line-separator (format ",%s" line-breaking)))
+      (insert line-separator)
       (insert (format
 	       (if (> (+ (current-column) (length value)) 48)
-		   "\"name\": %S"
-		 "\"name\":               %S")
+		   " \"name\": %S"
+		 " \"name\":                 %S")
 	       value))
       (setq attributes (delq 'name attributes))
       )
     (when (and (memq 'name* attributes)
 	       (setq value (get-char-attribute char 'name*)))
-      (if line-separator
-	  (insert line-separator)
-	(setq line-separator (format ",%s" line-breaking)))
+      (insert line-separator)
       (insert (format
 	       (if (> (+ (current-column) (length value)) 48)
-		   "\"name*\": %S"
-		 "{\"name*\":               %S")
+		   " \"name*\": %S"
+		 " \"name*\":                 %S")
 	       value))
       (setq attributes (delq 'name* attributes))
       )
     (when (and (memq 'script attributes)
 	       (setq value (get-char-attribute char 'script)))
-      (if line-separator
-	  (insert line-separator)
-	(setq line-separator (format ",%s" line-breaking)))
-      (insert (format "{\"script\":\t\t%s}%s"
+      (insert line-separator)
+      (insert (format " \"script\":\t\t  %s"
 		      (mapconcat (function prin1-to-string)
-				 value " ")
-		      line-breaking))
+				 value " ")))
       (setq attributes (delq 'script attributes))
       )
     (dolist (name '(=>ucs =>ucs*))
       (when (and (memq name attributes)
 		 (setq value (get-char-attribute char name)))
-	(if line-separator
-	    (insert line-separator)
-	  (setq line-separator (format ",%s" line-breaking)))
-	(insert (format "{\"%-18s\":  #x%04X},\t\"_comment\": \"%c\"%s"
+	(insert line-separator)
+	(insert (format " \"%-20s\":  #x%04X,\t\"_comment\": \"%c\"%s"
 			name value (decode-char '=ucs value)
 			line-breaking))
 	(setq attributes (delq name attributes))))
     (dolist (name '(=>ucs@gb =>ucs@big5))
       (when (and (memq name attributes)
 		 (setq value (get-char-attribute char name)))
-	(if line-separator
-	    (insert line-separator)
-	  (setq line-separator (format ",%s" line-breaking)))
-	(insert (format "{\"%-18s\":  #x%04X},\t\"_comment\": \"%c\"%s"
+	(insert line-separator)
+	(insert (format " \"%-20s\":  #x%04X,\t\"_comment\": \"%c\"%s"
 			name value
 			(decode-char (intern
 				      (concat "="
@@ -517,11 +509,9 @@
 	))
     (when (and (memq 'general-category attributes)
 	       (setq value (get-char-attribute char 'general-category)))
-      (if line-separator
-	  (insert line-separator)
-	(setq line-separator (format ",%s" line-breaking)))
+      (insert line-separator)
       (insert (format
-	       "{\"general-category\":\t%s} // %s%s"
+	       " \"general-category\":\t [ %s ], \"_comment\": \"%s\""
 	       (mapconcat (lambda (cell)
 			    (format "%S" cell))
 			  value " ")
@@ -531,87 +521,64 @@
 		      "Informative Category")
 		     (t
 		      "Unknown Category"))
-	       line-breaking))
+	       ))
       (setq attributes (delq 'general-category attributes))
       )
     (when (and (memq 'bidi-category attributes)
 	       (setq value (get-char-attribute char 'bidi-category)))
-      (if line-separator
-	  (insert line-separator)
-	(setq line-separator (format ",%s" line-breaking)))
-      (insert (format "{\"bidi-category\":\t %S}%s"
-		      value
-		      line-breaking))
+      (insert line-separator)
+      (insert (format " \"bidi-category\":\t  %S"
+		      value))
       (setq attributes (delq 'bidi-category attributes))
       )
     (unless (or (not (memq 'mirrored attributes))
 		(eq (setq value (get-char-attribute char 'mirrored 'empty))
 		    'empty))
-      (if line-separator
-	  (insert line-separator)
-	(setq line-separator (format ",%s" line-breaking)))
-      (insert (format "{\"mirrored\":\t\t %S}%s"
-		      value
-		      line-breaking))
+      (insert line-separator)
+      (insert (format " \"mirrored\":\t\t  %S"
+		      value))
       (setq attributes (delq 'mirrored attributes))
       )
     (cond
      ((and (memq 'decimal-digit-value attributes)
 	   (setq value (get-char-attribute char 'decimal-digit-value)))
-      (if line-separator
-	  (insert line-separator)
-	(setq line-separator (format ",%s" line-breaking)))
-      (insert (format "{\"decimal-digit-value\":  %S}%s"
-		      value
-		      line-breaking))
+      (insert line-separator)
+      (insert (format " \"decimal-digit-value\":  %S"
+		      value))
       (setq attributes (delq 'decimal-digit-value attributes))
       (when (and (memq 'digit-value attributes)
 		 (setq value (get-char-attribute char 'digit-value)))
-	(if line-separator
-	    (insert line-separator)
-	  (setq line-separator (format ",%s" line-breaking)))
-	(insert (format "{\"digit-value\":\t  %S}%s"
-			value
-			line-breaking))
+	(insert line-separator)
+	(insert (format " \"digit-value\":\t    %S"
+			value))
 	(setq attributes (delq 'digit-value attributes))
 	)
       (when (and (memq 'numeric-value attributes)
 		 (setq value (get-char-attribute char 'numeric-value)))
-	(if line-separator
-	    (insert line-separator)
-	  (setq line-separator (format ",%s" line-breaking)))
-	(insert (format "{\"numeric-value\":\t  %S}%s"
-			value
-			line-breaking))
+	(insert line-separator)
+	(insert (format " \"numeric-value\":\t    %S"
+			value))
 	(setq attributes (delq 'numeric-value attributes))
 	)
       )
      (t
       (when (and (memq 'digit-value attributes)
 		 (setq value (get-char-attribute char 'digit-value)))
-	(if line-separator
-	    (insert line-separator)
-	  (setq line-separator (format ",%s" line-breaking)))
-	(insert (format "{\"digit-value\":\t %S}%s"
-			value
-			line-breaking))
+	(insert line-separator)
+	(insert (format " \"digit-value\":\t %S"
+			value))
 	(setq attributes (delq 'digit-value attributes))
 	)
       (when (and (memq 'numeric-value attributes)
 		 (setq value (get-char-attribute char 'numeric-value)))
-	(if line-separator
-	    (insert line-separator)
-	  (setq line-separator (format ",%s" line-breaking)))
-	(insert (format "{\"numeric-value\":\t %S}%s"
-			value
-			line-breaking))
+	(insert line-separator)
+	(insert (format " \"numeric-value\":\t %S"
+			value))
 	(setq attributes (delq 'numeric-value attributes))
 	)))
     (when (and (memq 'iso-10646-comment attributes)
 	       (setq value (get-char-attribute char 'iso-10646-comment)))
-      (if line-separator
-	  (insert line-separator)
-	(setq line-separator (format ",%s" line-breaking)))
+      (insert line-separator)
       (insert (format "{\"iso-10646-comment\":\t %S}%s"
 		      value
 		      line-breaking))
@@ -619,9 +586,7 @@
       )
     (when (and (memq 'morohashi-daikanwa attributes)
 	       (setq value (get-char-attribute char 'morohashi-daikanwa)))
-      (if line-separator
-	  (insert line-separator)
-	(setq line-separator (format ",%s" line-breaking)))
+      (insert line-separator)
       (insert (format "{\"morohashi-daikanwa\":\t%s}%s"
 		      (mapconcat (function prin1-to-string) value " ")
 		      line-breaking))
@@ -632,9 +597,7 @@
     (when (and (memq 'ideographic-radical attributes)
 	       (setq value (get-char-attribute char 'ideographic-radical)))
       (setq radical value)
-      (if line-separator
-	  (insert line-separator)
-	(setq line-separator (format ",%s" line-breaking)))
+      (insert line-separator)
       (insert (format " \"ideographic-radical\": %S,\t\"_comment\": \"%c\""
 		      radical
 		      (ideographic-radical radical)
@@ -643,13 +606,10 @@
       )
     (when (and (memq 'shuowen-radical attributes)
 	       (setq value (get-char-attribute char 'shuowen-radical)))
-      (if line-separator
-	  (insert line-separator)
-	(setq line-separator (format ",%s" line-breaking)))
-      (insert (format "{\"shuowen-radical\":\t %S},\t\"_comment\": \"%c\"%s"
+      (insert line-separator)
+      (insert (format " \"shuowen-radical\":\t %S,\t\"_comment\": \"%c\""
 		      value
-		      (shuowen-radical value)
-		      line-breaking))
+		      (shuowen-radical value)))
       (setq attributes (delq 'shuowen-radical attributes))
       )
     (let (key)
@@ -670,9 +630,7 @@
 	(when (and (memq key attributes)
 		   (setq value (get-char-attribute char key)))
 	  (setq radical value)
-	  (if line-separator
-	      (insert line-separator)
-	    (setq line-separator (format ",%s" line-breaking)))
+	  (insert line-separator)
 	  (insert (format "{\"%s\": %S},\t\"_comment\": \"%c\"%s"
 			  key
 			  radical
@@ -684,9 +642,7 @@
 	(when (and (memq key attributes)
 		   (setq value (get-char-attribute char key)))
 	  (setq strokes value)
-	  (if line-separator
-	      (insert line-separator)
-	    (setq line-separator (format ",%s" line-breaking)))
+	  (insert line-separator)
 	  (insert (format " \"%s\": %S"
 			  key
 			  strokes))
@@ -695,9 +651,7 @@
 	(setq key (intern (format "%s@%s" 'total-strokes domain)))
 	(when (and (memq key attributes)
 		   (setq value (get-char-attribute char key)))
-	  (if line-separator
-	      (insert line-separator)
-	    (setq line-separator (format ",%s" line-breaking)))
+	  (insert line-separator)
 	  (insert (format " \"%s\":       %S"
 			  key
 			  value
@@ -710,9 +664,7 @@
 	  (setq key (intern (format "%s@%s*sources" feature domain)))
 	  (when (and (memq key attributes)
 		     (setq value (get-char-attribute char key)))
-	    (if line-separator
-		(insert line-separator)
-	      (setq line-separator (format ",%s" line-breaking)))
+	    (insert line-separator)
 	    (insert (format " \"%s\":%s" key line-breaking))
 	    (dolist (cell value)
 	      (insert (format " %s" cell)))
@@ -722,9 +674,7 @@
     (when (and (memq 'ideographic-strokes attributes)
 	       (setq value (get-char-attribute char 'ideographic-strokes)))
       (setq strokes value)
-      (if line-separator
-	  (insert line-separator)
-	(setq line-separator (format ",%s" line-breaking)))
+      (insert line-separator)
       (insert (format " \"ideographic-strokes\": %S"
 		      strokes
 		      ))
@@ -733,9 +683,7 @@
     (when (and (memq 'kangxi-radical attributes)
 	       (setq value (get-char-attribute char 'kangxi-radical)))
       (unless (eq value radical)
-	(if line-separator
-	    (insert line-separator)
-	  (setq line-separator (format ",%s" line-breaking)))
+	(insert line-separator)
 	(insert (format "{\"kangxi-radical\":\t%S},\t\"_comment\": \"%c\"%s"
 			value
 			(ideographic-radical value)
@@ -747,9 +695,7 @@
     (when (and (memq 'kangxi-strokes attributes)
 	       (setq value (get-char-attribute char 'kangxi-strokes)))
       (unless (eq value strokes)
-	(if line-separator
-	    (insert line-separator)
-	  (setq line-separator (format ",%s" line-breaking)))
+	(insert line-separator)
 	(insert (format "{\"kangxi-strokes\":\t%S}%s"
 			value
 			line-breaking))
@@ -760,9 +706,7 @@
     (when (and (memq 'japanese-radical attributes)
 	       (setq value (get-char-attribute char 'japanese-radical)))
       (unless (eq value radical)
-	(if line-separator
-	    (insert line-separator)
-	  (setq line-separator (format ",%s" line-breaking)))
+	(insert line-separator)
 	(insert (format "{\"japanese-radical\":\t%S},\t\"_comment\": \"%c\"%s"
 			value
 			(ideographic-radical value)
@@ -774,9 +718,7 @@
     (when (and (memq 'japanese-strokes attributes)
 	       (setq value (get-char-attribute char 'japanese-strokes)))
       (unless (eq value strokes)
-	(if line-separator
-	    (insert line-separator)
-	  (setq line-separator (format ",%s" line-breaking)))
+	(insert line-separator)
 	(insert (format "{\"japanese-strokes\":\t%S}%s"
 			value
 			line-breaking))
@@ -786,9 +728,7 @@
       )
     (when (and (memq 'cns-radical attributes)
 	       (setq value (get-char-attribute char 'cns-radical)))
-      (if line-separator
-	  (insert line-separator)
-	(setq line-separator (format ",%s" line-breaking)))
+      (insert line-separator)
       (insert (format "{\"cns-radical\":\t%S},\t\"_comment\": \"%c\"%s"
 		      value
 		      (ideographic-radical value)
@@ -798,9 +738,7 @@
     (when (and (memq 'cns-strokes attributes)
 	       (setq value (get-char-attribute char 'cns-strokes)))
       (unless (eq value strokes)
-	(if line-separator
-	    (insert line-separator)
-	  (setq line-separator (format ",%s" line-breaking)))
+	(insert line-separator)
 	(insert (format "{\"cns-strokes\":\t%S}%s"
 			value
 			line-breaking))
@@ -810,9 +748,7 @@
       )
     (when (and (memq 'ideographic- attributes)
 	       (setq value (get-char-attribute char 'ideographic-)))
-      (if line-separator
-	  (insert line-separator)
-	(setq line-separator (format ",%s" line-breaking)))
+      (insert line-separator)
       (insert "{\"ideographic-\":       ")
       (setq lbs (concat "\n" (make-string (current-column) ?\ ))
 	    separator nil)
@@ -845,9 +781,7 @@
       (setq attributes (delq 'ideographic- attributes)))
     (when (and (memq 'total-strokes attributes)
 	       (setq value (get-char-attribute char 'total-strokes)))
-      (if line-separator
-	  (insert line-separator)
-	(setq line-separator (format ",%s" line-breaking)))
+      (insert line-separator)
       (insert (format " \"total-strokes\":       %S"
 		      value
 		      ))
@@ -855,9 +789,7 @@
       )
     (when (and (memq '->ideograph attributes)
 	       (setq value (get-char-attribute char '->ideograph)))
-      (if line-separator
-	  (insert line-separator)
-	(setq line-separator (format ",%s" line-breaking)))
+      (insert line-separator)
       (insert (format "{\"->ideograph\":\t%s}%s"
 		      (mapconcat (lambda (code)
 				   (cond ((symbolp code)
@@ -887,24 +819,18 @@
 	       (setq name (charset-name ret))
 	       (when (not (memq name dest-ccss))
 		 (setq dest-ccss (cons name dest-ccss))
-		 (if line-separator
-		     (insert line-separator)
-		   (setq line-separator (format ",%s" line-breaking)))
+		 (insert line-separator)
 		 (char-db-json-insert-ccs-feature name value line-breaking))
 	       )
 	      ((string-match "^=>ucs@" (symbol-name name))
-	       (if line-separator
-		   (insert line-separator)
-		 (setq line-separator (format ",%s" line-breaking)))
-	       (insert (format "{\"%-18s\": #x%04X},\t\"_comment\": \"%c\"%s"
+	       (insert line-separator)
+	       (insert (format "{\"%-20s\": #x%04X},\t\"_comment\": \"%c\"%s"
 			       name value (decode-char '=ucs value)
 			       line-breaking))
 	       )
 	      ((eq name 'jisx0208-1978/4X)
-	       (if line-separator
-		   (insert line-separator)
-		 (setq line-separator (format ",%s" line-breaking)))
-	       (insert (format "{\"%-18s\": #x%04X}%s"
+	       (insert line-separator)
+	       (insert (format "{\"%-20s\": #x%04X}%s"
 			       name value
 			       line-breaking))
 	       )
@@ -956,9 +882,7 @@
 		   (string-match "^\\(->\\|<-\\)[^*]*\\*sources$"
 				 (symbol-name name))
 		   )
-	       (if line-separator
-		   (insert line-separator)
-		 (setq line-separator (format ",%s" line-breaking)))
+	       (insert line-separator)
 	       (char-db-json-insert-relation-feature char name value
 						     line-breaking
 						     ccss readable))
@@ -971,10 +895,8 @@
 			    ideographic-variants
 			    ;; ideographic-different-form-of
 			    ))
-	       (if line-separator
-		   (insert line-separator)
-		 (setq line-separator (format ",%s" line-breaking)))
-	       (insert (format "{\"%-18s\":%s " name line-breaking))
+	       (insert line-separator)
+	       (insert (format "{\"%-20s\":%s " name line-breaking))
 	       (setq lbs (concat "\n" (make-string (current-column) ?\ ))
 		     separator nil)
 	       (while (consp value)
@@ -994,10 +916,9 @@
 	       (insert " }")
 	       (insert line-breaking))
 	      ((consp value)
-	       (if line-separator
-		   (insert line-separator)
-		 (setq line-separator (format ",%s" line-breaking)))
-	       (insert (format "{\"%-18s\": " name))
+	       (insert line-separator)
+	       (insert (format " %-20s [ "
+			       (format "\"%s\":" name)))
 	       (setq lbs (concat "\n" (make-string (current-column) ?\ ))
 		     separator nil)
 	       (while (consp value)
@@ -1035,27 +956,23 @@
 		   (insert ret)
 		   (setq separator " "))
 		 (setq value (cdr value)))
-	       (insert " }")
-	       (insert line-breaking))
+	       (insert " ]")
+	       )
 	      (t
-	       (if line-separator
-		   (insert line-separator)
-		 (setq line-separator (format ",%s" line-breaking)))
-	       (insert (format "{\"%-18s\":" name))
+	       (insert line-separator)
+	       (insert (format " %-20s "
+			       (format "\"%s\":" 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)
 	       )
 	      ))
       (setq attributes (cdr attributes)))
-    (insert " }")))
+    (insert "\n" (make-string column ?\ ) "}")))
 
 (defun char-db-json-char-data (char &optional readable
 				    attributes column)
-- 
1.7.10.4