X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fest.git;a=blobdiff_plain;f=char-db-json.el;h=2da62e51b16a498572e8d4ea8b801d376b6c00ad;hp=a8b897e3a4c607e297cfb744fa5b8d1381ad5530;hb=HEAD;hpb=b36080479cb29820603706770818be821480fff1 diff --git a/char-db-json.el b/char-db-json.el index a8b897e..2da62e5 100644 --- a/char-db-json.el +++ b/char-db-json.el @@ -30,6 +30,7 @@ (setq char-db-ignored-attributes '(ideographic-products + composition ;; ->HNG *instance@ruimoku/bibliography/title *instance@morpheme-entry/zh-classical)) @@ -290,6 +291,8 @@ (let ((lbs (concat "\n" (make-string (current-column) ?\ ))) separator cell sources required-features ret) + (if (characterp value) + (setq value (list value))) (while (consp value) (setq cell (car value)) (if (integerp cell) @@ -367,11 +370,14 @@ (if separator (insert separator) (setq separator (format ",%s" lbs))) - (if readable - (insert (format "%S" cell)) - (char-db-json-insert-char-spec cell readable - nil - required-features)) + ;; (if readable + ;; (insert (format "%S" cell)) + ;; (char-db-json-insert-char-spec cell readable + ;; nil + ;; required-features)) + (char-db-json-insert-char-spec cell readable + nil + required-features) ) ((consp cell) (if separator @@ -396,6 +402,7 @@ (unless column (setq column (current-column))) (let ((est-view-url-prefix "http://chise.org/est/view") + id obj-id type name value ; has-long-ccs-name rest radical strokes @@ -428,9 +435,31 @@ (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))) + (setq id (www-uri-make-object-url char)) + (insert (format "%s \"@id\": \"%s\"" line-separator id)) + (setq obj-id (file-name-nondirectory id)) + (setq type + (cond + ((string-match "^a2\\." obj-id) + "chise:super-abstract-character") + ((string-match "^a\\." obj-id) + "chise:abstract-character") + ((string-match "^o\\." obj-id) + "chise:unified-glyph") + ((string-match "^rep\\." obj-id) + "chise:abstract-glyph") + ((string-match "^g\\." obj-id) + "chise:detailed-glyph") + ((string-match "^g2\\." obj-id) + "chise:abstract-glyph-form") + ((string-match "^gi\\." obj-id) + "chise:abstract-glyph-form") + ((string-match "^repi\\." obj-id) + "chise:glyph-image") + (t + "chise:character") + )) + (insert (format "%s \"@type\": \"%s\"" line-separator type)) (when (memq '<-subsumptive attributes) (when (or readable (not for-sub-node)) (when (setq value (get-char-attribute char '<-subsumptive)) @@ -489,9 +518,8 @@ (when (and (memq name attributes) (setq value (get-char-attribute char name))) (insert line-separator) - (insert (format " \"%-20s\": #x%04X,\t\"_comment\": \"%c\"%s" - name value (decode-char '=ucs value) - line-breaking)) + (insert (format " \"%-20s\": #x%04X,\t\"_comment\": \"%c\"" + name value (decode-char '=ucs value))) (setq attributes (delq name attributes)))) (dolist (name '(=>ucs@gb =>ucs@big5)) (when (and (memq name attributes) @@ -703,18 +731,6 @@ (setq strokes value))) (setq attributes (delq 'kangxi-strokes attributes)) ) - (when (and (memq 'japanese-radical attributes) - (setq value (get-char-attribute char 'japanese-radical))) - (unless (eq value radical) - (insert line-separator) - (insert (format "{\"japanese-radical\":\t%S},\t\"_comment\": \"%c\"%s" - value - (ideographic-radical value) - line-breaking)) - (or radical - (setq radical value))) - (setq attributes (delq 'japanese-radical attributes)) - ) (when (and (memq 'japanese-strokes attributes) (setq value (get-char-attribute char 'japanese-strokes))) (unless (eq value strokes) @@ -746,39 +762,6 @@ (setq strokes value))) (setq attributes (delq 'cns-strokes attributes)) ) - (when (and (memq 'ideographic- attributes) - (setq value (get-char-attribute char 'ideographic-))) - (insert line-separator) - (insert "{\"ideographic-\": ") - (setq lbs (concat "\n" (make-string (current-column) ?\ )) - separator nil) - (while (consp value) - (setq cell (car value)) - (if (integerp cell) - (setq cell (decode-char '=ucs cell))) - (cond ((characterp cell) - (if separator - (insert lbs)) - (if readable - (insert (format "%S" cell)) - (char-db-json-insert-char-spec cell readable)) - (setq separator lbs)) - ((consp cell) - (if separator - (insert lbs)) - (if (consp (car cell)) - (char-db-json-insert-char-spec cell readable) - (char-db-json-insert-char-reference cell readable)) - (setq separator lbs)) - (t - (if separator - (insert separator)) - (insert (prin1-to-string cell)) - (setq separator " "))) - (setq value (cdr value))) - (insert " }") - (insert line-breaking) - (setq attributes (delq 'ideographic- attributes))) (when (and (memq 'total-strokes attributes) (setq value (get-char-attribute char 'total-strokes))) (insert line-separator) @@ -787,22 +770,6 @@ )) (setq attributes (delq 'total-strokes attributes)) ) - (when (and (memq '->ideograph attributes) - (setq value (get-char-attribute char '->ideograph))) - (insert line-separator) - (insert (format "{\"->ideograph\":\t%s}%s" - (mapconcat (lambda (code) - (cond ((symbolp code) - (symbol-name code)) - ((integerp code) - (format "#x%04X" code)) - (t - (format "%s %S" - line-breaking code)))) - value " ") - line-breaking)) - (setq attributes (delq '->ideograph attributes)) - ) (if (equal (get-char-attribute char '->titlecase) (get-char-attribute char '->uppercase)) (setq attributes (delq '->titlecase attributes))) @@ -872,7 +839,7 @@ ) ((or (eq name 'ideographic-structure) (eq name 'ideographic-combination) - (eq name 'ideographic-) + ;; (eq name 'ideographic-) (eq name '=decomposition) (char-feature-base-name= '=decomposition name) (char-feature-base-name= '=>decomposition name) @@ -886,35 +853,6 @@ (char-db-json-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 line-separator) - (insert (format "{\"%-20s\":%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-json-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 line-separator) (insert (format " %-20s [ " @@ -1053,7 +991,8 @@ ;;;###autoload (defun what-char-definition-json (char) (interactive (list (char-after))) - (let ((buf (get-buffer-create "*Character Description*")) + (let ((est-hide-cgi-mode t) + (buf (get-buffer-create "*Character Description*")) (the-buf (current-buffer)) (win-conf (current-window-configuration))) (pop-to-buffer buf) @@ -1063,7 +1002,7 @@ (erase-buffer) (condition-case err (progn - (char-db-json-char-data-with-variant char nil) + (char-db-json-char-data-with-variant char 'printable) (unless (char-attribute-alist char) (insert (format "// = %c\n" (let* ((rest (split-char char))