Commit 6c822cbb authored by MORIOKA Tomohiko's avatar MORIOKA Tomohiko
Browse files

(chise-json-separate-features): Abolished.

(concord-object-spec-to-json-ld-spec): Abolished.
(concord-object-get-json-ld-spec): Abolished.
(chise-json-api-character-get-spec): Abolished.
(chise-json-char-get-normalized-spec): New optional argument
`spec-alist'; ignore `general-category', `bidi-category' and
`mirrored'.
(chise-json-char-get-info): Add code to format `general-category',
`bidi-category' and `mirrored'.
(chise-batch-character-api): Abolish "get-spec".
(chise-json-api-object-get-spec): Abolished.
(chise-batch-object-api): Abolish "get-spec".
parent 83ac08ff
......@@ -507,53 +507,53 @@
(concord-object-spec-to-full-nested-form
spec-alist)))
(defun chise-json-separate-features (nested-spec)
(let ((case-fold-search nil)
ccs-spec
subsumption-spec
variant-spec
glyph-example-spec
other-rel-spec
other-spec
metadata-spec
key)
(dolist (cell nested-spec)
(setq key (car cell))
(if (find-charset key)
(setq ccs-spec (cons cell ccs-spec))
(setq key (symbol-name key))
(cond
((string-match "^=" key)
(setq ccs-spec (cons cell ccs-spec))
)
((string-match "^\\(<-\\|->\\)\\(denotational\\|subsumptive\\)" key)
(setq subsumption-spec (cons cell subsumption-spec))
)
((string-match "^<-HNG" key)
(setq subsumption-spec (cons cell subsumption-spec))
)
((string-match "^\\(<-\\|->\\)[A-Z][A-Z]" key)
(setq glyph-example-spec (cons cell glyph-example-spec))
)
((string-match "^\\(<-\\|->\\)[A-Z][a-z]" key)
(setq other-rel-spec (cons cell other-rel-spec))
)
((string-match "^\\(<-\\|->\\)" key)
(setq variant-spec (cons cell variant-spec))
)
((string-match "^\\*" key)
(setq metadata-spec (cons cell metadata-spec))
)
(t
(setq other-spec (cons cell other-spec))
))))
(vector other-spec
ccs-spec
subsumption-spec
other-rel-spec
variant-spec
glyph-example-spec
metadata-spec)))
;; (defun chise-json-separate-features (nested-spec)
;; (let ((case-fold-search nil)
;; ccs-spec
;; subsumption-spec
;; variant-spec
;; glyph-example-spec
;; other-rel-spec
;; other-spec
;; metadata-spec
;; key)
;; (dolist (cell nested-spec)
;; (setq key (car cell))
;; (if (find-charset key)
;; (setq ccs-spec (cons cell ccs-spec))
;; (setq key (symbol-name key))
;; (cond
;; ((string-match "^=" key)
;; (setq ccs-spec (cons cell ccs-spec))
;; )
;; ((string-match "^\\(<-\\|->\\)\\(denotational\\|subsumptive\\)" key)
;; (setq subsumption-spec (cons cell subsumption-spec))
;; )
;; ((string-match "^<-HNG" key)
;; (setq subsumption-spec (cons cell subsumption-spec))
;; )
;; ((string-match "^\\(<-\\|->\\)[A-Z][A-Z]" key)
;; (setq glyph-example-spec (cons cell glyph-example-spec))
;; )
;; ((string-match "^\\(<-\\|->\\)[A-Z][a-z]" key)
;; (setq other-rel-spec (cons cell other-rel-spec))
;; )
;; ((string-match "^\\(<-\\|->\\)" key)
;; (setq variant-spec (cons cell variant-spec))
;; )
;; ((string-match "^\\*" key)
;; (setq metadata-spec (cons cell metadata-spec))
;; )
;; (t
;; (setq other-spec (cons cell other-spec))
;; ))))
;; (vector other-spec
;; ccs-spec
;; subsumption-spec
;; other-rel-spec
;; variant-spec
;; glyph-example-spec
;; metadata-spec)))
(defun chise-json-encode-general-feature-pair (feature-pair)
(let ((feature-name (car feature-pair))
......@@ -898,75 +898,75 @@
(chise-json-encode-variant-feature-pair feature-pair char-id))
variant-spec)))
(defun concord-object-spec-to-json-ld-spec (spec-alist object)
(let ((obj-rep (chise-rdf-iri-encode-object object))
(ret (chise-json-separate-features spec-alist))
(genre (if (characterp object)
'character
(concord-object-genre object)))
general-spec id-spec
granularity-spec interscript-spec
variant-spec glyph-example-spec
metadata-spec
dest general-dest)
(setq general-spec (aref ret 0)
id-spec (aref ret 1)
granularity-spec (aref ret 2)
interscript-spec (aref ret 3)
variant-spec (aref ret 4)
glyph-example-spec (aref ret 5)
metadata-spec (aref ret 6))
(dolist (cell metadata-spec)
(setq dest
(cons (cons (chise-json-encode-feature-name (car cell))
(cdr cell))
dest)))
(setq dest (nreverse dest))
(if glyph-example-spec
(setq dest
(cons (chise-json-encode-variant-spec glyph-example-spec
obj-rep 'glyph-example)
dest)))
(if variant-spec
(setq dest
(cons (chise-json-encode-variant-spec variant-spec
obj-rep 'variant)
dest)))
(if interscript-spec
(setq dest
(cons (chise-json-encode-variant-spec interscript-spec
obj-rep 'interscript)
dest)))
(if granularity-spec
(setq dest
(cons (chise-json-encode-variant-spec granularity-spec
obj-rep 'intergranularity)
dest)))
(if id-spec
(setq dest
(cons (chise-json-encode-id-spec id-spec genre)
dest)))
(dolist (cell general-spec)
(setq general-dest
(cons (if (eq (car cell) 'name)
(chise-json-encode-name-feature-pair cell)
(chise-json-encode-general-feature-pair cell))
general-dest)))
(dolist (cell general-dest)
(setq dest (cons cell dest)))
(list*
(cons '@context "http://rdf.chise.org/contexts/chise.jsonld")
(cons '@id obj-rep)
dest)))
(defun concord-object-get-json-ld-spec (object &optional spec)
(concord-object-spec-to-json-ld-spec
(concord-object-spec-to-nested-form
(or spec
(if (characterp object)
(char-attribute-alist object)
(concord-object-spec object))))
object))
;; (defun concord-object-spec-to-json-ld-spec (spec-alist object)
;; (let ((obj-rep (chise-rdf-iri-encode-object object))
;; (ret (chise-json-separate-features spec-alist))
;; (genre (if (characterp object)
;; 'character
;; (concord-object-genre object)))
;; general-spec id-spec
;; granularity-spec interscript-spec
;; variant-spec glyph-example-spec
;; metadata-spec
;; dest general-dest)
;; (setq general-spec (aref ret 0)
;; id-spec (aref ret 1)
;; granularity-spec (aref ret 2)
;; interscript-spec (aref ret 3)
;; variant-spec (aref ret 4)
;; glyph-example-spec (aref ret 5)
;; metadata-spec (aref ret 6))
;; (dolist (cell metadata-spec)
;; (setq dest
;; (cons (cons (chise-json-encode-feature-name (car cell))
;; (cdr cell))
;; dest)))
;; (setq dest (nreverse dest))
;; (if glyph-example-spec
;; (setq dest
;; (cons (chise-json-encode-variant-spec glyph-example-spec
;; obj-rep 'glyph-example)
;; dest)))
;; (if variant-spec
;; (setq dest
;; (cons (chise-json-encode-variant-spec variant-spec
;; obj-rep 'variant)
;; dest)))
;; (if interscript-spec
;; (setq dest
;; (cons (chise-json-encode-variant-spec interscript-spec
;; obj-rep 'interscript)
;; dest)))
;; (if granularity-spec
;; (setq dest
;; (cons (chise-json-encode-variant-spec granularity-spec
;; obj-rep 'intergranularity)
;; dest)))
;; (if id-spec
;; (setq dest
;; (cons (chise-json-encode-id-spec id-spec genre)
;; dest)))
;; (dolist (cell general-spec)
;; (setq general-dest
;; (cons (if (eq (car cell) 'name)
;; (chise-json-encode-name-feature-pair cell)
;; (chise-json-encode-general-feature-pair cell))
;; general-dest)))
;; (dolist (cell general-dest)
;; (setq dest (cons cell dest)))
;; (list*
;; (cons '@context "http://rdf.chise.org/contexts/chise.jsonld")
;; (cons '@id obj-rep)
;; dest)))
;; (defun concord-object-get-json-ld-spec (object &optional spec)
;; (concord-object-spec-to-json-ld-spec
;; (concord-object-spec-to-nested-form
;; (or spec
;; (if (characterp object)
;; (char-attribute-alist object)
;; (concord-object-spec object))))
;; object))
(defun chise-json-api-character-decode (args)
(let (ccs cpos char format-type ret)
......@@ -1047,41 +1047,41 @@
(if (setq val (char-feature char feat))
(encode-coding-string (json-encode val) 'utf-8-mcs-er)))))
(defun chise-json-api-character-get-spec (args)
(let ((media-type "application/json")
char ret feature-format)
(when (and (setq char (assoc "character" args))
(setq char (cdr char))
(setq char (or (chise-rdf-iri-decode-object char)
(www-uri-decode-object 'character char))))
(when (setq ret (del-alist '*instance@ruimoku/bibliography/title
(del-alist '*instance@morpheme-entry/zh-classical
(del-alist 'ideographic-products
(char-attribute-alist char)))))
(if (setq feature-format (assoc "feature-format" args))
(setq feature-format (cdr feature-format)))
(cons (encode-coding-string
(json-encode
(cond
((equal feature-format "native")
(sort ret
(lambda (a b)
(string< (car a)(car b))))
)
((equal feature-format "json")
(mapcar (lambda (pair)
(cons (www-uri-encode-feature-name (car pair))
(cdr pair)))
(sort ret
(lambda (a b)
(string< (car a)(car b)))))
)
(t ; (equal feature-format "json-ld")
(setq media-type "application/ld+json")
(concord-object-get-json-ld-spec char ret)
)))
'utf-8-mcs-er)
media-type)))))
;; (defun chise-json-api-character-get-spec (args)
;; (let ((media-type "application/json")
;; char ret feature-format)
;; (when (and (setq char (assoc "character" args))
;; (setq char (cdr char))
;; (setq char (or (chise-rdf-iri-decode-object char)
;; (www-uri-decode-object 'character char))))
;; (when (setq ret (del-alist '*instance@ruimoku/bibliography/title
;; (del-alist '*instance@morpheme-entry/zh-classical
;; (del-alist 'ideographic-products
;; (char-attribute-alist char)))))
;; (if (setq feature-format (assoc "feature-format" args))
;; (setq feature-format (cdr feature-format)))
;; (cons (encode-coding-string
;; (json-encode
;; (cond
;; ((equal feature-format "native")
;; (sort ret
;; (lambda (a b)
;; (string< (car a)(car b))))
;; )
;; ((equal feature-format "json")
;; (mapcar (lambda (pair)
;; (cons (www-uri-encode-feature-name (car pair))
;; (cdr pair)))
;; (sort ret
;; (lambda (a b)
;; (string< (car a)(car b)))))
;; )
;; (t ; (equal feature-format "json-ld")
;; (setq media-type "application/ld+json")
;; (concord-object-get-json-ld-spec char ret)
;; )))
;; 'utf-8-mcs-er)
;; media-type)))))
(defun chise-json-api-character-ids-match (args)
(let ((media-type "application/json")
......@@ -1166,9 +1166,10 @@
mother))
char)))
(defun chise-json-char-get-normalized-spec (char &optional subnode)
(let ((spec-alist (char-attribute-alist char))
dest
(defun chise-json-char-get-normalized-spec (char &optional subnode spec-alist)
(unless spec-alist
(setq spec-alist (char-attribute-alist char)))
(let (dest
metadata-features
md-spec
fcell item-num body-vec)
......@@ -1177,6 +1178,7 @@
(memq (car cell) '(<-denotational
<-subsumptive)))
(memq (car cell) '(name
general-category bidi-category mirrored
*instance@ruimoku/bibliography/title
*instance@morpheme-entry/zh-classical
->HNG@CN/manuscript
......@@ -2172,11 +2174,10 @@
(defun chise-json-char-get-info (char &optional subnode without-CCS-spec)
(let ((json-encoding-pretty-print t)
(coding-system-for-write 'utf-8-mcs-er)
(char-info (chise-json-separate-normalized-spec
(chise-json-char-get-normalized-spec char subnode)
subnode))
(char-spec (char-attribute-alist char))
char-info
(title-info (chise-json-char-get-title-info char))
(name (get-char-attribute char 'name))
name general-category bidi-category mirrored
parents-spec ; domain-parents-alist
CCS-spec
structure-spec
......@@ -2192,6 +2193,13 @@
domain code
kangxi-radical kangxi-strokes total-strokes
dest)
(setq char-info (chise-json-separate-normalized-spec
(chise-json-char-get-normalized-spec char subnode char-spec)
subnode)
name (cdr (assq 'name char-spec))
general-category (cdr (assq 'general-category char-spec))
bidi-category (cdr (assq 'bidi-category char-spec))
mirrored (assq 'mirrored char-spec))
(setq parents-spec (aref char-info 0)
CCS-spec (sort (aref char-info 1)
(lambda (a b)
......@@ -2342,6 +2350,18 @@
dest))
))
)
(if mirrored
(setq dest
(cons (cons 'mirrored (or (cdr mirrored) :json-false))
dest)))
(if bidi-category
(setq dest
(cons (cons 'bidi-category bidi-category)
dest)))
(if general-category
(setq dest
(cons (cons 'general-category general-category)
dest)))
(if sound-spec
(setq dest
(cons (cons 'phonetic-value sound-spec)
......@@ -2570,9 +2590,9 @@
((equal method "get-info")
(setq ret (chise-json-api-character-get-info args))
)
((equal method "get-spec")
(setq ret (chise-json-api-character-get-spec args))
)
;; ((equal method "get-spec")
;; (setq ret (chise-json-api-character-get-spec args))
;; )
((equal method "ids-match")
(setq ret (chise-json-api-character-ids-match args))
))
......@@ -2672,37 +2692,37 @@ null
(if (setq val (concord-object-get obj feat))
(encode-coding-string (json-encode val) 'utf-8-mcs-er)))))
(defun chise-json-api-object-get-spec (args)
(let ((media-type "application/json")
obj ret feature-format)
(when (and (setq obj (assoc "object" args))
(setq obj (cdr obj))
(setq obj (chise-rdf-iri-decode-object obj)))
(when (setq ret (concord-object-spec obj))
(if (setq feature-format (assoc "feature-format" args))
(setq feature-format (cdr feature-format)))
(cons (encode-coding-string
(json-encode
(cond
((equal feature-format "native")
(sort ret
(lambda (a b)
(string< (car a)(car b))))
)
((equal feature-format "json")
(mapcar (lambda (pair)
(cons (www-uri-encode-feature-name (car pair))
(cdr pair)))
(sort ret
(lambda (a b)
(string< (car a)(car b)))))
)
(t ; (equal feature-format "json-ld")
(setq media-type "application/ld+json")
(concord-object-get-json-ld-spec obj ret)
)))
'utf-8-mcs-er)
media-type)))))
;; (defun chise-json-api-object-get-spec (args)
;; (let ((media-type "application/json")
;; obj ret feature-format)
;; (when (and (setq obj (assoc "object" args))
;; (setq obj (cdr obj))
;; (setq obj (chise-rdf-iri-decode-object obj)))
;; (when (setq ret (concord-object-spec obj))
;; (if (setq feature-format (assoc "feature-format" args))
;; (setq feature-format (cdr feature-format)))
;; (cons (encode-coding-string
;; (json-encode
;; (cond
;; ((equal feature-format "native")
;; (sort ret
;; (lambda (a b)
;; (string< (car a)(car b))))
;; )
;; ((equal feature-format "json")
;; (mapcar (lambda (pair)
;; (cons (www-uri-encode-feature-name (car pair))
;; (cdr pair)))
;; (sort ret
;; (lambda (a b)
;; (string< (car a)(car b)))))
;; )
;; (t ; (equal feature-format "json-ld")
;; (setq media-type "application/ld+json")
;; (concord-object-get-json-ld-spec obj ret)
;; )))
;; 'utf-8-mcs-er)
;; media-type)))))
(defun chise-batch-object-api ()
(setq debug-on-error t)
......@@ -2726,15 +2746,13 @@ null
((equal method "decode")
(setq ret (chise-json-api-object-decode args))
)
;; ((equal method "encode")
;; (setq ret (chise-json-api-object-encode args))
;; )
((equal method "get")
(setq ret (chise-json-api-object-get args))
)
((equal method "get-spec")
(setq ret (chise-json-api-object-get-spec args))
))
;; ((equal method "get-spec")
;; (setq ret (chise-json-api-object-get-spec args))
;; )
)
(cond
((consp ret)
(princ (format "Content-Type: %s
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment