(setq char-db-ignored-attributes
'(ideographic-products
+ composition
;; ->HNG
*instance@ruimoku/bibliography/title
*instance@morpheme-entry/zh-classical))
(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
(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
(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))
(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)
(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)
(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)
))
(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)))
)
((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)
(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 [ "
;;;###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)
(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))