;; -*- coding: utf-8-mcs-er -*-
(require 'cwiki-common)
+(defvar est-eval-list-feature-items-limit 20)
+
+(defun ruimoku-format-volume (spec value year lang)
+ (when (stringp spec)
+ (setq spec (car (read-from-string spec))))
+ (cond ((eq spec 'YY) (if (eq lang 'cjk)
+ (format "%d年" year)
+ (format "%d" year)))
+ ((eq spec 00) value)
+ ((eq spec 01) (concat value "期"))
+ ((eq spec 02) (concat value "巻"))
+ ((eq spec 03) (concat value "号"))
+ ((eq spec 04) (concat value "編"))
+ ((eq spec 05) (concat value "&HD-JA-4A53;"))
+ ((eq spec 06) (concat value "集"))
+ ((eq spec 07) (concat value "輯"))
+ ((eq spec 08) (concat value "部"))
+ ((eq spec 09) (concat value "部分"))
+ ((eq spec 10) (concat value "冊"))
+ ((eq spec 11) (concat value "分冊"))
+ ((eq spec 12) (concat value "次"))
+ ((eq spec 13) (concat value "月号"))
+ ((eq spec 14) (concat value "特集号"))
+ ((eq spec 15) (concat value "本"))
+ ((eq spec 16) (concat value "分"))
+ ((eq spec 51) (concat "Vol." value))
+ ((eq spec 52) (concat "No." value))
+ ((eq spec 53) (concat "Part " value))
+ ((eq spec 54) (concat "Issue " value))
+ ((eq spec 55) (concat "Tome " value))
+ ((eq spec 56) (concat "Tomo " value))
+ ((eq spec 57) (concat "Tomus " value))
+ ((eq spec 58) (concat "Fasc." value))
+ ((eq spec 59) (concat "Livre " value))
+ ((eq spec 60) (concat "Année " value))
+ ((eq spec 61) (concat "Bd." value))
+ ((eq spec 62) (concat "Heft " value))
+ ((eq spec 63) (concat "Nr." value))
+ ((eq spec 64) (concat "Jahrg." value))
+ ((eq spec 65) (concat "Jaarg." value))
+ ((eq spec 66) (concat "Trimestre" value))
+ (t "")
+ ))
+
+
;;; @ Feature value presentation
;;;
(defun est-eval-value-default (value)
(if (listp value)
- (list* 'list
- '(:separator " ")
- (mapcar
- (lambda (unit)
- (format "%S" unit))
- value))
+ (if (eq (car value) 'omitted)
+ value
+ (list* 'list
+ '(:separator " ")
+ (mapcar
+ (lambda (unit)
+ (format "%S" unit))
+ value)))
(est-eval-value-as-S-exp value)))
+;; (defun est-journal-volume-object-get-volume-format (spec feature)
+;; (when (integerp spec)
+;; (setq spec (format "%02d" spec)))
+;; (cond ((string= spec "YY") `((decimal (:feature
+;; ->published/date*year)) "年"))
+;; ((string= spec "00") `((decimal (:feature ,feature))))
+;; ((string= spec "01") `((decimal (:feature ,feature)) "期"))
+;; ((string= spec "02") `((decimal (:feature ,feature)) "巻"))
+;; ((string= spec "03") `((decimal (:feature ,feature)) "号"))
+;; ((string= spec "04") `((decimal (:feature ,feature)) "&HD-JA-4A54;"))
+;; ((string= spec "05") `((decimal (:feature ,feature)) "&HD-JA-4A53;"))
+;; ((string= spec "06") `((decimal (:feature ,feature)) "集"))
+;; ((string= spec "07") `((decimal (:feature ,feature)) "輯"))
+;; ((string= spec "08") `((decimal (:feature ,feature)) "部"))
+;; ((string= spec "09") `((decimal (:feature ,feature)) "部分"))
+;; ((string= spec "10") `((decimal (:feature ,feature)) "冊"))
+;; ((string= spec "11") `((decimal (:feature ,feature)) "分冊"))
+;; ((string= spec "12") `((decimal (:feature ,feature)) "次"))
+;; ((string= spec "13") `((decimal (:feature ,feature)) "月号"))
+;; ((string= spec "14") `((decimal (:feature ,feature)) "特集号"))
+;; ((string= spec "15") `((decimal (:feature ,feature)) "本"))
+;; ((string= spec "16") `((decimal (:feature ,feature)) "分"))
+;; ((string= spec "51") `("Vol." ((decimal (:feature ,feature)))))
+;; ((string= spec "52") `("No." ((decimal (:feature ,feature)))))
+;; ((string= spec "53") `("Part " ((decimal (:feature ,feature)))))
+;; ((string= spec "54") `("Issue " ((decimal (:feature ,feature)))))
+;; ((string= spec "55") `("Tome " ((decimal (:feature ,feature)))))
+;; ((string= spec "56") `("Tomo " ((decimal (:feature ,feature)))))
+;; ((string= spec "57") `("Tomus " ((decimal (:feature ,feature)))))
+;; ((string= spec "58") `("Fasc." ((decimal (:feature ,feature)))))
+;; ((string= spec "59") `("Livre " ((decimal (:feature ,feature)))))
+;; ((string= spec "60") `("Année " ((decimal (:feature ,feature)))))
+;; ((string= spec "61") `("Bd." ((decimal (:feature ,feature)))))
+;; ((string= spec "62") `("Heft " ((decimal (:feature ,feature)))))
+;; ((string= spec "63") `("Nr." ((decimal (:feature ,feature)))))
+;; ((string= spec "64") `("Jahrg." ((decimal (:feature ,feature)))))
+;; ((string= spec "65") `("Jaarg." ((decimal (:feature ,feature)))))
+;; ((string= spec "66") `("Trimestre" ((decimal (:feature ,feature)))))
+;; (t nil)
+;; ))
+
+(defun est-eval-value-as-journal-volume (value &optional short)
+ (let ((journal (car (or (concord-object-get value '<-journal/volume)
+ (concord-object-get value '<-volume))))
+ (vol-name (concord-object-get value '<-journal/volume*name))
+ volume-type number-type
+ year
+ dest ret title subtitle)
+ (cond
+ (journal
+ (if vol-name
+ (setq dest
+ (list
+ (list 'object (list :object value)
+ vol-name)))
+ (setq volume-type (concord-object-get journal 'volume/type/code)
+ number-type (concord-object-get journal 'number/type/code))
+ (setq year (or (concord-object-get value '->published/date*year)
+ (concord-object-get
+ (car (concord-object-get value 'date)) 'year)))
+ (setq dest
+ (list
+ (list 'object
+ (list :object value)
+ (ruimoku-format-volume
+ volume-type
+ (or (concord-object-get value '<-journal/volume*volume)
+ (concord-object-get value '<-volume*volume))
+ year 'cjk)
+ (ruimoku-format-volume
+ number-type
+ (or (concord-object-get value '<-journal/volume*number)
+ (concord-object-get value '<-volume*number))
+ year 'cjk))))
+ )
+ (unless short
+ (if (setq ret (est-eval-value-as-object journal))
+ (setq dest
+ (list* ret " " dest))))
+ (list* 'list '(:subtype sequence :separator "") dest)
+ )
+ ((setq title (concord-object-get value 'title))
+ (setq subtitle (concord-object-get value 'title/subtitle))
+ (list* 'object
+ (list :object value)
+ (if (eq (concord-object-get value 'writing-system) 'cjk)
+ (list
+ "「"
+ (list 'object (list :object value)
+ (if subtitle
+ (concat title " — " subtitle)
+ title))
+ "」")
+ (list
+ " ‘"
+ (list 'object (list :object value)
+ (if subtitle
+ (concat title " — " subtitle)
+ title))
+ "’")))
+ )
+ (t
+ (est-eval-value-default value)
+ ))
+ ;; (concat (concord-object-get journal 'name)
+ ;; " "
+ ;; (ruimoku-format-volume
+ ;; volume-type
+ ;; (or (concord-object-get value '<-journal/volume*volume)
+ ;; (concord-object-get value '<-volume*volume))
+ ;; year 'cjk)
+ ;; (ruimoku-format-volume
+ ;; number-type
+ ;; (or (concord-object-get value '<-journal/volume*number)
+ ;; (concord-object-get value '<-volume*number))
+ ;; year 'cjk))
+ ))
+
+(defun est-eval-value-as-article (value)
+ (let ((journal-volume (car (concord-object-get value '<-article)))
+ (page (concord-object-get value 'page))
+ date ret dest)
+ (when journal-volume
+ (setq date (car (concord-object-get journal-volume 'date)))
+ (if (and date
+ (setq ret (est-eval-value-as-object date)))
+ (setq dest (list ", " ret))))
+ (if page
+ (setq dest (list* ", pp." page dest)))
+ (when (and journal-volume
+ (setq ret (est-eval-value-as-journal-volume journal-volume)))
+ (setq dest (cons ret dest)))
+ (if (setq ret (est-eval-value-as-book value))
+ (setq dest (list* ret " " dest)))
+ (list* 'list '(:subtype sequence :separator "") dest))
+ ;; (let ((creators (concord-object-get value '->creator))
+ ;; (title (concord-object-get value 'title))
+ ;; creator-name creator-role)
+ ;; (concat
+ ;; (mapconcat
+ ;; (lambda (creator)
+ ;; (setq creator-name
+ ;; (concord-object-get
+ ;; (car (concord-object-get creator '->creator/name))
+ ;; '=name))
+ ;; (setq creator-role
+ ;; (or (concord-object-get creator 'role*name)
+ ;; (format "(%s)"
+ ;; (concord-object-get creator 'role*type))))
+ ;; (concat creator-name " " creator-role))
+ ;; creators ", ")
+ ;; (if (eq (concord-object-get value 'writing-system) 'cjk)
+ ;; (concat "「" title "」")
+ ;; (concat " ‘" title "’"))))
+ )
+
+(defun est-eval-value-as-book (value)
+ (let ((creators (concord-object-get value '->creator))
+ (title (concord-object-get value 'title))
+ (subtitle (concord-object-get value 'title/subtitle))
+ (series (concord-object-get value 'series))
+ (publisher (car (concord-object-get value 'publisher)))
+ (date (car (concord-object-get value 'date)))
+ ;; creator-name creator-role
+ dest ret)
+ (if (and date
+ (setq ret (est-eval-value-as-object date)))
+ (setq dest (list ", " ret)))
+ (if (and publisher
+ (setq ret (est-eval-value-as-object publisher)))
+ (setq dest (list* " " ret dest)))
+ (if series
+ (setq dest (list* series "," dest)))
+ (setq dest
+ (if title
+ (if (eq (concord-object-get value 'writing-system) 'cjk)
+ (list*
+ "「"
+ (list 'object (list :object value)
+ (if subtitle
+ (concat title " — " subtitle)
+ title))
+ "」" dest)
+ (list*
+ " ‘"
+ (list 'object (list :object value)
+ (if subtitle
+ (concat title " — " subtitle)
+ title))
+ "’" dest))
+ (list* " "
+ (list 'object (list :object value)
+ "(review)")
+ dest)))
+ (when (and creators
+ (setq ret (est-eval-value-as-creators-names creators)))
+ (setq dest (cons ret dest)))
+ (list* 'list '(:subtype sequence :separator "") dest)
+ ;; (concat
+ ;; (mapconcat
+ ;; (lambda (creator)
+ ;; (setq creator-name
+ ;; (concord-object-get
+ ;; (car (concord-object-get creator '->creator/name))
+ ;; '=name))
+ ;; (setq creator-role
+ ;; (or (concord-object-get creator 'role*name)
+ ;; (format "(%s)"
+ ;; (concord-object-get creator 'role*type))))
+ ;; (concat creator-name " " creator-role))
+ ;; creators ", ")
+ ;; (if (eq (concord-object-get value 'writing-system) 'cjk)
+ ;; (concat "「" title
+ ;; (if subtitle
+ ;; (concat " — " subtitle))
+ ;; "」")
+ ;; (concat " ‘" title
+ ;; (if subtitle
+ ;; (concat " — " subtitle))
+ ;; "’"))
+ ;; (if series
+ ;; (concat " " series))
+ ;; (if publisher
+ ;; (concat ", "
+ ;; (concord-object-get
+ ;; (car (concord-object-get
+ ;; publisher '->publisher/name))
+ ;; '=name)))
+ ;; (if date
+ ;; (concat ", " (concord-object-get date 'name)))))
+ ))
+
+;; (defun est-eval-creator (value)
+;; (est-eval-list
+;; '((value (:feature ->name))
+;; (string (:feature role*name)))
+;; value nil))
+
(defun est-eval-value-as-object (value)
(if (or (characterp value)
(concord-object-p value))
(list 'object (list :object value)
(if (characterp value)
(char-to-string value)
- (let ((genre-o (concord-decode-object
- '=id (concord-object-genre value)
- 'genre))
+ (let ((genre (concord-object-genre value))
+ genre-o
format)
- (or (and genre-o
- (setq format
- (concord-object-get
- genre-o 'object-representative-format))
- (est-eval-list format value nil))
- (www-get-feature-value
- value
- (or (and genre-o
- (www-get-feature-value
- genre-o 'object-representative-feature))
- 'name))
- (est-eval-value-default value)))))
+ (cond
+ ((eq genre 'journal-volume@ruimoku)
+ ;; (est-eval-list
+ ;; (est-journal-volume-get-object-format value)
+ ;; value nil)
+ (est-eval-value-as-journal-volume value)
+ )
+ ((eq genre 'article@ruimoku)
+ (est-eval-value-as-article value)
+ )
+ ((eq genre 'book@ruimoku)
+ (est-eval-value-as-book value)
+ )
+ ;; ((eq genre 'creator@ruimoku)
+ ;; (est-eval-creator value)
+ ;; )
+ (t
+ (setq genre-o (concord-decode-object '=id genre 'genre))
+ (or (and genre-o
+ (setq format
+ (concord-object-get
+ genre-o 'object-representative-format))
+ (est-eval-list format value nil))
+ (www-get-feature-value
+ value
+ (or (and genre-o
+ (www-get-feature-value
+ genre-o 'object-representative-feature))
+ 'name))
+ (www-get-feature-value value '=name)
+ (est-eval-value-default value))
+ ))
+ )))
(est-eval-value-default value)))
(defun est-eval-value-as-HEX (value)
(format "%c" (ideographic-radical value)))
(est-eval-value-as-S-exp value)))
-(defun est-eval-value-as-object-list (value &optional separator)
- (if (listp value)
- (list* 'list
- (if separator
- (list :separator separator))
- ;; (mapcar
- ;; (lambda (unit)
- ;; (if (characterp unit)
- ;; (list 'char-link nil (format "%c" unit))
- ;; (format "%s" unit)))
- ;; value)
- (mapcar #'est-eval-value-as-object value)
- )
+(defun est-eval-value-as-object-list (value &optional separator subtype)
+ (if (and (listp value)
+ (listp (cdr value)))
+ (condition-case nil
+ (let (props)
+ (if separator
+ (setq props (list :separator separator)))
+ (if subtype
+ (setq props (list* :subtype subtype props)))
+ (list* 'list props
+ (mapcar #'est-eval-value-as-object value)))
+ (error (format "%s" value)))
+ (format "%s" value)))
+
+(defun est-eval-value-as-composition-list (value &optional separator subtype)
+ (if (and (listp value)
+ (listp (cdr value)))
+ (condition-case nil
+ (let (props)
+ (if separator
+ (setq props (list :separator separator)))
+ (if subtype
+ (setq props (list* :subtype subtype props)))
+ (list* 'list props
+ (mapcar
+ (lambda (cell)
+ (list 'list nil
+ "+ "
+ (list 'object (list :object (car cell))
+ (format "U+%04X" (car cell)))
+ " : "
+ (est-eval-value-as-object (cdr cell))))
+ (sort value
+ (lambda (a b)
+ (< (car a)(car b)))))))
+ (error (format "%s" value)))
(format "%s" value)))
+(defun est-eval-value-as-decomposition-list (value)
+ (if (and (listp value)
+ (listp (cdr value)))
+ (condition-case nil
+ (let (props)
+ (list* 'list props
+ (mapconcat #'char-to-string value "")
+ (list
+ " ("
+ (list* 'list '(:separator " + ")
+ (mapcar
+ (lambda (chr)
+ (list 'object (list :object chr)
+ (format "U+%04X" chr)))
+ value))
+ ")")))
+ (error (format "%s" value)))
+ (format "%s" value)))
+
+;; (defun est-eval-value-as-ids (value)
+;; (if (listp value)
+;; (list 'ids nil (ideographic-structure-to-ids value))
+;; (format "%s" value)))
(defun est-eval-value-as-ids (value)
(if (listp value)
- (list 'ids nil (ideographic-structure-to-ids value))
- (format "%s" value)))
+ (list* 'ids
+ nil
+ (mapcar #'est-eval-value-as-object
+ (ideographic-structure-to-ids value))
+ )
+ (est-eval-value-default value)))
(defun est-eval-value-as-space-separated-ids (value)
(if (listp value)
'=id item 'article@ruimoku)
(intern unit)))))
)
- ((eq source 'zob1968)
+ ((memq source '(zob1959 zob1968))
(if (and (symbolp item)
(setq num (symbol-name item))
(string-match
(list (est-eval-value-as-object (intern unit))))
))
(list* 'res-link
- (list :source source :item item)
+ (list :separator " "
+ :source source :item item)
source-objs)
)
(t
value)))
(est-eval-value-default value)))
+(defun est-eval-value-as-creators-names (value &optional subtype)
+ (if (listp value)
+ (let (role-name)
+ (list* 'creator-name
+ (if subtype
+ '(:subtype unordered-list)
+ '(:separator " "))
+ (mapcar (lambda (creator)
+ (cond
+ ((concord-object-p creator)
+ (setq role-name
+ (concord-object-get
+ creator 'role*name))
+ (est-eval-list
+ (list
+ '(value (:feature ->creator/name))
+ (list
+ 'object (list :object creator)
+ (or role-name
+ (format "(%s)"
+ (concord-object-get creator
+ 'role*type)))))
+ creator nil)
+ )
+ (t creator)))
+ value)
+ ))
+ (est-eval-value-default value)))
+
+(defun est-eval-value-as-created-works (value &optional subtype)
+ (if (listp value)
+ (list* 'creator-name
+ (if subtype
+ '(:subtype unordered-list)
+ '(:separator " "))
+ (mapcar (lambda (creator)
+ (est-eval-list
+ '((value (:feature <-creator)))
+ creator nil))
+ value))
+ (est-eval-value-default value)))
+
+(defun est-eval-value-as-journal-volumes (value &optional subtype)
+ (if (listp value)
+ (list* 'journal-volumes
+ (if subtype
+ '(:subtype unordered-list)
+ '(:separator " "))
+ (mapcar (lambda (volume)
+ (if (concord-object-p volume)
+ (est-eval-value-as-journal-volume volume 'short)
+ volume))
+ value))
+ (est-eval-value-default value)))
+
;;; @ format evaluator
;;;
(est-eval-value-as-kangxi-radical value))
((eq format 'ids)
(est-eval-value-as-ids value))
+ ((eq format 'decomposition)
+ (est-eval-value-as-decomposition-list value))
+ ((eq format 'composition)
+ (est-eval-value-as-composition-list value))
((or (eq format 'space-separated)
(eq format 'space-separated-char-list))
(est-eval-value-as-object-list value " "))
+ ((eq format 'unordered-list)
+ (est-eval-value-as-object-list value nil 'unordered-list))
+ ((eq format 'unordered-composition-list)
+ (est-eval-value-as-composition-list value nil 'unordered-list))
((eq format 'space-separated-ids)
(est-eval-value-as-space-separated-ids value))
((eq format 'space-separated-domain-list)
(est-eval-value-as-domain-list value))
+ ((eq format 'space-separated-creator-name-list)
+ (est-eval-value-as-creators-names value))
+ ((eq format 'unordered-creator-name-list)
+ (est-eval-value-as-creators-names value 'unordered-list))
+ ((eq format 'space-separated-created-work-list)
+ (est-eval-value-as-created-works value))
+ ((eq format 'unordered-created-work-list)
+ (est-eval-value-as-created-works value 'unordered-list))
+ ((eq format 'journal-volume-list)
+ (est-eval-value-as-journal-volumes value))
(t
(est-eval-value-default value)
))
(setq value (www-get-feature-value object feature-name)))
(unless format
(setq format (www-feature-value-format feature-name)))
+ (if (and (consp value)
+ est-eval-list-feature-items-limit
+ (not (eq feature-name 'sources)))
+ (let ((ret (condition-case nil
+ (nthcdr est-eval-list-feature-items-limit value)
+ (error nil nil))))
+ (when ret
+ (setcdr ret
+ (list (list 'omitted
+ (list :object object :feature feature-name)
+ "..."))))))
(cond
((symbolp format)
(est-eval-apply-value object feature-name
)
((eq (car exp) 'name-url)
(let ((fn (plist-get (nth 1 exp) :feature))
+ (object (plist-get (nth 1 exp) :object))
domain domain-fn)
(when fn
(setq domain (char-feature-name-domain feature-name))
(setq feature-name domain-fn)))
(list 'name-url (list :feature feature-name)
(www-uri-make-feature-name-url
+ (est-object-genre object)
(www-uri-encode-feature-name feature-name)
uri-object))
)
(format "@%s" domain)
""))
)
+ ((eq (car exp) 'omitted)
+ (list 'omitted
+ (list :object object :feature feature-name)
+ "...")
+ )
((eq (car exp) 'prev-char)
(list 'prev-char
(list :object object :feature feature-name)