Commit d382c06c authored by MORIOKA Tomohiko's avatar MORIOKA Tomohiko
Browse files

(chise-json-char-get-normalized-spec): Ignore `name'.

(chise-json-normalized-feature<): New function.
(chise-json-other-spec-get-sound): Fix typo.
(chise-json-make-char-ref-object): Add new argument `name'; output
`name' if it exists.
(chise-json-char-get-ref-info): Modify for
`chise-json-make-char-ref-object'.
(chise-json-char-get-info):
- Use `phonetic-value' instead of `sound'.
- Modify for `chise-json-make-char-ref-object'.
- Fix problem of fallback predicate with nil domain in children-spec.
- Sort relation-spec.
- Sort other-spec and put it before CCS-spec.
parent dedeafa4
......@@ -1176,7 +1176,8 @@
(when (if (or (and subnode
(memq (car cell) '(<-denotational
<-subsumptive)))
(memq (car cell) '(*instance@ruimoku/bibliography/title
(memq (car cell) '(name
*instance@ruimoku/bibliography/title
*instance@morpheme-entry/zh-classical
->HNG@CN/manuscript
<-HNG@CN/manuscript
......@@ -1308,6 +1309,13 @@
relation-spec
other-spec)))
(defun chise-json-normalized-feature< (a b)
(cond
((string< (caar a) (caar b))
)
((eq (caar a) (caar b))
(string< (cdar a) (cdar b)))))
(defun chise-json-other-spec-get-radical-strokes (other-spec)
(let (domain-rs-alist
radical
......@@ -1505,7 +1513,7 @@
)
((memq domain '(ja/on ja/on/conventional ja/kun ja/kun/name))
(setq domain-sound-alist
(cons (cons (intern (format "'chise:domain/%s" domain))
(cons (cons (intern (format "chise:domain/%s" domain))
(mapvector (lambda (item)
(nconc
(chise-json-make-ja-romaji-spec
......@@ -2093,7 +2101,7 @@
))))
dest))))
(defun chise-json-make-char-ref-object (id title-info)
(defun chise-json-make-char-ref-object (id title-info name)
(let (title image dest)
(setq dest
(list* (cons 'granularity (format "chise:glyph-granularity/%s" (nth 2 title-info)))
......@@ -2102,12 +2110,16 @@
(if (setq title (car title-info))
(setq dest (cons (cons 'title title)
dest)))
(if name
(setq dest (cons (cons 'name name)
dest)))
(cons (cons '@id id)
dest)))
(defun chise-json-char-get-ref-info (char)
(chise-json-make-char-ref-object (chise-json-char-get-id char)
(chise-json-char-get-title-info char)))
(chise-json-char-get-title-info char)
(get-char-attribute char 'name)))
(defun chise-json-dump-get-path (id)
(let (len path ccs code ccs-obj dim)
......@@ -2164,6 +2176,7 @@
(chise-json-char-get-normalized-spec char subnode)
subnode))
(title-info (chise-json-char-get-title-info char))
(name (get-char-attribute char 'name))
parents-spec ; domain-parents-alist
CCS-spec
structure-spec
......@@ -2207,6 +2220,8 @@
'unified-in-usage)
((equal (car cell) '(->denotational . component))
'unified-as-component)
((null (cdar cell))
(caar cell))
(t
(format "%s@%s" (caar cell)(cdar cell))))
(if (< (length (setq ret (cdr (assq 'body (cdr cell))))) 5)
......@@ -2257,9 +2272,37 @@
spec)))
(cdr (assq 'body (cdr cell))))))
(del-alist 'body (cdr cell)))))
relation-spec))
(sort relation-spec
#'chise-json-normalized-feature<)))
dest)))
(dolist (cell other-spec)
(if (and (not without-CCS-spec)
CCS-spec)
(setq dest
(cons
(cons 'unify
(mapcar
(lambda (cell)
(setq code (cdr (assq 'body (cdr cell))))
(setq ret (chise-split-ccs-name (car cell)))
(setq node-id (chise-json-make-char-id (car cell) code))
(setq ret
(list*
(cons 'CCS (format "ccs:%s" (car ret)))
(cons 'granularity (format "chise:glyph-granularity/%s"
(nth 1 ret)))
(cons 'domain (format "chise:domain/%s"
(or (nth 2 ret) "common")))
(cons 'code-point code)
(del-alist 'body (cdr cell))))
(cons (car cell)
(cons (cons '@id node-id)
ret))
)
CCS-spec))
dest)))
(dolist (cell (sort other-spec
(lambda (a b)
(chise-json-normalized-feature< b a))))
(cond
((memq (caar cell) '(composition abstract-glyph ideographic-products))
)
......@@ -2278,11 +2321,6 @@
(cdr (assq 'body (cdr cell)))))
dest))
)
;; ((eq (caar cell) 'total-strokes)
;; (setq dest (cons (cons 'total-strokes
;; (cdr (assq 'body (cdr cell))))
;; dest))
;; )
((eq (caar cell) '*references)
(setq dest (cons (cons 'citation
(mapvector
......@@ -2304,34 +2342,9 @@
dest))
))
)
(if (and (not without-CCS-spec)
CCS-spec)
(setq dest
(cons
(cons 'unify
(mapcar
(lambda (cell)
(setq code (cdr (assq 'body (cdr cell))))
(setq ret (chise-split-ccs-name (car cell)))
(setq node-id (chise-json-make-char-id (car cell) code))
(setq ret
(list*
(cons 'CCS (format "ccs:%s" (car ret)))
(cons 'granularity (format "chise:glyph-granularity/%s"
(nth 1 ret)))
(cons 'domain (format "chise:domain/%s"
(or (nth 2 ret) "common")))
(cons 'code-point code)
(del-alist 'body (cdr cell))))
(cons (car cell)
(cons (cons '@id node-id)
ret))
)
CCS-spec))
dest)))
(if sound-spec
(setq dest
(cons (cons 'sound sound-spec)
(cons (cons 'phonetic-value sound-spec)
dest)))
(if radical-strokes-spec
(setq dest
......@@ -2390,7 +2403,7 @@
(cdr (assq 'body (cdr cell)))))
dest)))
(setq dest
(append (chise-json-make-char-ref-object id title-info)
(append (chise-json-make-char-ref-object id title-info name)
dest))
dest))
......
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