;; -*- 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))))
((eq spec 01) (concat value "期"))
((eq spec 02) (concat value "巻"))
((eq spec 03) (concat value "号"))
- ((eq spec 04) (concat value ">-35694;"))
- ((eq spec 05) (concat value ">-33870;"))
- ((eq spec 06) (concat value ">-56392;"))
+ ((eq spec 04) (concat value "編"))
+ ((eq spec 05) (concat value "&MJ019590;"))
+ ((eq spec 06) (concat value "集"))
((eq spec 07) (concat value "輯"))
- ((eq spec 08) (concat value ">-53119;"))
- ((eq spec 09) (concat value ">-53119;&AJ1-03580;"))
+ ((eq spec 08) (concat value "部"))
+ ((eq spec 09) (concat value "部分"))
((eq spec 10) (concat value "冊"))
- ((eq spec 11) (concat value "&AJ1-03580;冊"))
- ((eq spec 12) (concat value "&J90-3C21;"))
- ((eq spec 13) (concat value ">-18140;号"))
- ((eq spec 14) (concat value "特>-56392;号"))
+ ((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 "&AJ1-03580;"))
+ ((eq spec 16) (concat value "分"))
((eq spec 51) (concat "Vol." value))
((eq spec 52) (concat "No." value))
((eq spec 53) (concat "Part " value))
value)))
(est-eval-value-as-S-exp value)))
+(defun est-eval-value-as-image-resource (value &optional accept-full-image)
+ (let ((name (concord-object-get value 'name)))
+ (cond
+ ((concord-object-get value 'image-offset-x)
+ (list 'img (list* :src (or (concord-object-get value '=location@iiif)
+ (concord-object-get value '=location))
+ (if name
+ (list :alt name))))
+ )
+ (accept-full-image
+ (list 'img (list* :src (concord-object-get value '=location)
+ (if name
+ (list :alt name))))
+ )
+ (t
+ name))))
+
+(defun est-eval-value-as-glyph-image (value)
+ (let ((image-resource (car (concord-object-get value '->image-resource))))
+ (est-eval-value-as-image-resource image-resource)))
+
+(defun est-eval-value-as-image-object (value)
+ (let ((image-resource (car (concord-object-get value '->image-resource))))
+ (list 'object (list :object value)
+ (est-eval-value-as-image-resource
+ image-resource 'accept-full-image))))
+
;; (defun est-journal-volume-object-get-volume-format (spec feature)
;; (when (integerp spec)
;; (setq spec (format "%02d" spec)))
;; ((string= spec "01") `((decimal (:feature ,feature)) "期"))
;; ((string= spec "02") `((decimal (:feature ,feature)) "巻"))
;; ((string= spec "03") `((decimal (:feature ,feature)) "号"))
-;; ((string= spec "04") `((decimal (:feature ,feature)) ">-35694;"))
-;; ((string= spec "05") `((decimal (:feature ,feature)) ">-33870;"))
-;; ((string= spec "06") `((decimal (:feature ,feature)) ">-56392;"))
+;; ((string= spec "04") `((decimal (:feature ,feature)) "&AJ1-03620;"))
+;; ((string= spec "05") `((decimal (:feature ,feature)) "&MJ019590;"))
+;; ((string= spec "06") `((decimal (:feature ,feature)) "集"))
;; ((string= spec "07") `((decimal (:feature ,feature)) "輯"))
-;; ((string= spec "08") `((decimal (:feature ,feature)) ">-53119;"))
-;; ((string= spec "09") `((decimal (:feature ,feature)) ">-53119;&AJ1-03580;"))
+;; ((string= spec "08") `((decimal (:feature ,feature)) "部"))
+;; ((string= spec "09") `((decimal (:feature ,feature)) "部分"))
;; ((string= spec "10") `((decimal (:feature ,feature)) "冊"))
-;; ((string= spec "11") `((decimal (:feature ,feature)) "&AJ1-03580;冊"))
-;; ((string= spec "12") `((decimal (:feature ,feature)) "&J90-3C21;"))
-;; ((string= spec "13") `((decimal (:feature ,feature)) ">-18140;号"))
-;; ((string= spec "14") `((decimal (:feature ,feature)) "特>-56392;号"))
+;; ((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)) "&AJ1-03580;"))
+;; ((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)))))
;; (t nil)
;; ))
-(defun est-eval-value-as-journal-volume (value)
+(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)
- (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)))
- ;; (append (list (concord-object-get journal 'name))
- ;; (est-journal-volume-object-get-volume-format
- ;; volume-type '<-volume*volume)
- ;; (est-journal-volume-object-get-volume-format
- ;; number-type '<-volume*number)
- ;; )
- (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))
+ 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 ((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 "’")))))
+ (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))
(series (concord-object-get value 'series))
(publisher (car (concord-object-get value 'publisher)))
(date (car (concord-object-get value 'date)))
- 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
- (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))))))
+ ;; 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
;; ((eq genre 'creator@ruimoku)
;; (est-eval-creator value)
;; )
- (t
+ ((eq genre 'image-resource)
+ (est-eval-value-as-image-resource value)
+ )
+ ((eq genre 'glyph-image)
+ (est-eval-value-as-glyph-image value)
+ )
+ (t
(setq genre-o (concord-decode-object '=id genre 'genre))
(or (and genre-o
(setq format
genre-o 'object-representative-feature))
'name))
(www-get-feature-value value '=name)
+ (www-get-feature-value value '=title)
(est-eval-value-default value))
))
)))
(est-eval-value-default value)))
+(defun est-eval-value-as-character (value)
+ (let (ret)
+ (if (and (concord-object-p value)
+ (setq ret (concord-object-get value 'character)))
+ (list 'object (list :object value)
+ (mapconcat #'char-to-string ret ""))
+ (est-eval-value-as-object value))))
+
+(defun est-eval-value-as-object-with-description (value
+ object feature-name
+ &optional lang uri-object list-props)
+ (let (ret)
+ (cond
+ ((characterp value)
+ (setq ret (or (get-char-attribute value 'description)
+ (get-char-attribute value 'hdic-syp-description)
+ (get-char-attribute value 'hdic-ktb-description)))
+ )
+ ((concord-object-p value)
+ (setq ret (concord-object-get value 'description))
+ ))
+ (if ret
+ (list 'list nil
+ (est-eval-value-as-object value)
+ (est-eval-list ret
+ object feature-name
+ lang uri-object list-props))
+ (est-eval-value-as-object value))))
+
+(defun est-eval-value-as-hdic-tsj-character-with-description (value
+ object feature-name
+ &optional
+ lang uri-object list-props)
+ (let (word desc ret)
+ (cond
+ ((characterp value)
+ (when (setq word (get-char-attribute value 'hdic-tsj-word))
+ (if (and (= (length word) 1)
+ (setq ret (get-char-attribute value '<-HDIC-TSJ))
+ (memq (aref word 0) ret))
+ (setq desc (or (get-char-attribute value 'hdic-tsj-word-description)
+ (get-char-attribute value 'description)))
+ (setq desc (list "(" word ")"))))
+ )
+ ((concord-object-p value)
+ (setq desc (concord-object-get value 'description))
+ ))
+ (if desc
+ (list 'list nil
+ (est-eval-value-as-object value)
+ (est-eval-list (append desc '(" "))
+ object feature-name
+ lang uri-object list-props))
+ (est-eval-value-as-object value))))
+
+(defun est-eval-value-as-location (value)
+ (let (ret)
+ (if (and (concord-object-p value)
+ (setq ret (concord-object-get value '=location)))
+ (list 'object (list :object value)
+ ret)
+ (est-eval-value-as-object value))))
+
+(defun est-eval-value-as-name (value)
+ (let (ret)
+ (if (and (concord-object-p value)
+ (setq ret (concord-object-get value 'name)))
+ (list 'object (list :object value)
+ ret)
+ (est-eval-value-as-object value))))
+
(defun est-eval-value-as-HEX (value)
(if (integerp value)
(list 'HEX nil (format "%X" value))
(format "%c" (ideographic-radical value)))
(est-eval-value-as-S-exp value)))
+(defun est-eval-value-as-shuowen-radical (value)
+ (if (and (integerp value)
+ (<= 0 value)
+ (<= value 540))
+ (list 'shuowen-radical
+ nil
+ (format "%c" (shuowen-radical value)))
+ (est-eval-value-as-S-exp value)))
+
+(defun daijiten-page-number-to-ndl-950498 (page)
+ (+ (/ page 2)
+ (cond ((< page 229)
+ 23)
+ ((< page 261)
+ 24)
+ ((< page 263)
+ 25)
+ ((< page 516) ; 284=285
+ 26)
+ (t
+ 27))))
+
+(defun est-eval-value-as-daijiten-page (value)
+ (if (integerp value)
+ (list 'link
+ (list :ref
+ (format "http://image.chise.org/tify/?manifest=https://www.dl.ndl.go.jp/api/iiif/950498/manifest.json&tify={%%22pages%%22:[%d]}"
+ (daijiten-page-number-to-ndl-950498 value)))
+ value)))
+
+(defun est-eval-value-as-ndl-page-by-tify (value)
+ (if (symbolp value)
+ (setq value (symbol-name value)))
+ (if (stringp value)
+ (if (string-match "/" value)
+ (format "http://image.chise.org/tify/?manifest=https://www.dl.ndl.go.jp/api/iiif/%s/manifest.json&tify={%%22pages%%22:[%s]}"
+ (substring value 0 (match-beginning 0))
+ (substring value (match-end 0)))
+ (format "http://image.chise.org/tify/?manifest=https://www.dl.ndl.go.jp/api/iiif/%s/manifest.json"
+ value))
+ value))
+
+(defun est-eval-value-as-Web-yunzi-char (value)
+ (if (char-or-char-int-p value)
+ (list 'link
+ (list :ref
+ (format "http://suzukish.s252.xrea.com/search/inkyo/yunzi/%c"
+ value))
+ (format "/%s/" (char-to-string value)))))
+
+(defun est-eval-value-as-HDIC-Yuanben-Yupian-volume-leaf-line-number (value)
+ (if (symbolp value)
+ (setq value (symbol-name value)))
+ (if (and (stringp value)
+ (string-match
+ "^Y\\([0-9][0-9]\\)\\([0-9][0-9][0-9]\\)\\([0-9][0-9][0-9]\\)-\\([0-9]\\)$"
+ value))
+ (format "%d巻 %d紙 %d列 %d字目 (%s)"
+ (string-to-int (match-string 1 value))
+ (string-to-int (match-string 2 value))
+ (string-to-int (match-string 3 value))
+ (string-to-int (match-string 4 value))
+ value)
+ value))
+
(defun est-eval-value-as-object-list (value &optional separator subtype)
(if (and (listp value)
(listp (cdr value)))
- (condition-case err
+ (condition-case nil
(let (props)
(if separator
(setq props (list :separator separator)))
(setq props (list* :subtype subtype props)))
(list* 'list props
(mapcar #'est-eval-value-as-object value)))
- (error err (format "%s" value)))
+ (error (format "%s" value)))
+ (format "%s" value)))
+
+(defun est-eval-value-as-char-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-character value)))
+ (error (format "%s" value)))
+ (format "%s" value)))
+
+(defun est-eval-value-as-location-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-location value)))
+ (error (format "%s" value)))
+ (format "%s" value)))
+
+(defun est-eval-value-as-name-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-name value)))
+ (error (format "%s" value)))
+ (format "%s" value)))
+
+(defun est-eval-value-as-image-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* 'image-list props
+ (mapcar #'est-eval-value-as-image-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-entry-character-list (value
+ object feature-name
+ &optional separator subtype
+ lang uri-object list-props)
+ (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)
+ (est-eval-value-as-object-with-description
+ cell
+ object feature-name
+ lang uri-object list-props))
+ value)))
+ (error (format "%s" value)))
(format "%s" value)))
+(defun est-eval-value-as-hdic-tsj-entry-character-list (value
+ object feature-name
+ &optional separator subtype
+ lang uri-object list-props)
+ (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)
+ (est-eval-value-as-hdic-tsj-character-with-description
+ cell
+ object feature-name
+ lang uri-object list-props))
+ 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-sources (value)
+ (if (listp value)
+ (let (unit-str
+ source item source-objs source0 start end num
+ source-cobj title)
+ (list* 'res-list
+ '(:separator " ")
+ (mapcar
+ (lambda (unit)
+ (setq unit-str
+ (if (symbolp unit)
+ (symbol-name unit)
+ (format "%s" unit)))
+ (if (string-match "=" unit-str)
+ (setq source (intern
+ (substring unit-str 0 (match-beginning 0)))
+ item (car (read-from-string
+ (substring unit-str (match-end 0)))))
+ (setq source unit
+ item nil))
+ (cond
+ ((and (setq source-cobj (concord-decode-object
+ '=chise-bib-id source 'bibliography))
+ (setq title (concord-object-get source-cobj '=title)))
+ (setq source-objs
+ (if item
+ (list (est-eval-value-as-object source-cobj)
+ "="
+ item)
+ (list (est-eval-value-as-object source-cobj))))
+ )
+ ((eq source 'bos)
+ (setq source-objs
+ (list
+ (est-eval-value-as-object
+ (or (concord-decode-object
+ '=id item 'book@ruimoku)
+ (concord-decode-object
+ '=id item 'article@ruimoku)
+ unit))))
+ )
+ ((memq source '(zob1959 zob1968))
+ (if (and (symbolp item)
+ (setq num (symbol-name item))
+ (string-match
+ "^\\([0-9]+\\)-\\([0-9]+\\)$" num))
+ (setq start (string-to-number
+ (match-string 1 num))
+ end (string-to-number
+ (match-string 2 num)))
+ (setq start item
+ end item))
+ (if (not (numberp start))
+ (setq source-objs
+ (list
+ (est-eval-value-as-object unit)))
+ (if (eq source source0)
+ (setq source-objs
+ (list
+ (list 'link
+ (list :ref
+ (format "http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d"
+ start))
+ start)))
+ (setq source0 source)
+ (setq source-objs
+ (list
+ (list 'link
+ (list :ref
+ (format "http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d"
+ start))
+ start)
+ "="
+ '(link
+ (:ref "http://chise.zinbun.kyoto-u.ac.jp/koukotsu/")
+ "\u4EAC大人\u6587研甲\u9AA8")))
+ )
+ (setq num (1+ start))
+ (while (<= num end)
+ (setq source-objs
+ (cons
+ (list 'link
+ (list :ref
+ (format "http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d"
+ num))
+ num)
+ source-objs))
+ (setq num (1+ num)))
+ (setq source-objs (nreverse source-objs)))
+ )
+ (t
+ (setq source-objs
+ (list (est-eval-value-as-object unit)))
+ ))
+ (list* 'res-link
+ (list :separator " "
+ :source source :item item)
+ source-objs)
+ )
+ value)))
+ (est-eval-value-default value)))
+
+(defun est-eval-value-as-daijiten-page-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-daijiten-page value)))
+ (error (format "%s" value)))
+ (format "%s" value)))
+
+(defun est-eval-value-as-Web-yunzi-char-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-Web-yunzi-char value)))
+ (error (format "%s" value)))
+ (format "%s" value)))
+
(defun est-eval-value-as-creators-names (value &optional subtype)
(if (listp value)
(let (role-name)
'(:subtype unordered-list)
'(:separator " "))
(mapcar (lambda (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)
- )
+ (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)))
'(:subtype unordered-list)
'(:separator " "))
(mapcar (lambda (creator)
- (est-eval-list
- '((value (:feature <-creator)))
- creator nil))
+ (if (concord-object-p creator)
+ (est-eval-list
+ '((value (:feature <-creator)))
+ creator nil)
+ (est-eval-value-default creator)))
+ 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)))
((eq format 'wiki-text)
(est-eval-list value object feature-name nil uri-object)
)
+ ((eq format 'unordered-link-list)
+ (est-eval-list value object feature-name nil uri-object
+ '(:subtype unordered-list :separator " "))
+ )
((eq format 'S-exp)
(est-eval-value-as-S-exp value)
)
(est-eval-value-as-kuten value))
((eq format 'kangxi-radical)
(est-eval-value-as-kangxi-radical value))
+ ((eq format 'tify-url-for-ndl)
+ (est-eval-value-as-ndl-page-by-tify value)
+ )
+ ((eq format 'hdic-yy-readable)
+ (est-eval-value-as-HDIC-Yuanben-Yupian-volume-leaf-line-number value)
+ )
+ ((eq format 'shuowen-radical)
+ (est-eval-value-as-shuowen-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 'char-list)
+ (est-eval-value-as-char-list value nil))
+ ((eq format 'location-list)
+ (est-eval-value-as-location-list value nil))
+ ((eq format 'name-list)
+ (est-eval-value-as-name-list value nil))
+ ((eq format 'image-list)
+ (est-eval-value-as-image-list value nil))
((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 'entry-character-list)
+ (est-eval-value-as-entry-character-list
+ value
+ object feature-name
+ nil nil
+ lang uri-object list-props))
+ ((eq format 'unordered-entry-character-list)
+ (est-eval-value-as-entry-character-list
+ value
+ object feature-name
+ nil 'unordered-list
+ lang uri-object list-props))
+ ((eq format 'hdic-tsj-entry-character-list)
+ (est-eval-value-as-hdic-tsj-entry-character-list
+ value
+ object feature-name
+ nil nil
+ lang uri-object list-props))
((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))
+ ;; (est-eval-value-as-domain-list value)
+ (est-eval-value-as-sources value))
+ ((eq format 'space-separated-source-list)
+ (est-eval-value-as-sources 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-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))
+ ((eq format 'space-separated-daijiten-page-list)
+ (est-eval-value-as-daijiten-page-list value " "))
+ ((eq format 'space-separated-Web-yunzi-char-list)
+ (est-eval-value-as-Web-yunzi-char-list 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 (consp value)
+ (if (and (consp value)
+ est-eval-list-feature-items-limit
+ (not (eq feature-name 'sources)))
(let ((ret (condition-case nil
- (nthcdr 127 value)
+ (nthcdr est-eval-list-feature-items-limit value)
(error nil nil))))
(when ret
(setcdr ret
((null exp) "")
((consp exp)
(cond
- ((memq (car exp) '(value decimal hex HEX ku-ten kangxi-radical
- S-exp string default))
+ ((memq (car exp) '(value decimal hex HEX ku-ten
+ kangxi-radical shuowen-radical
+ S-exp string default
+ tify-url-for-ndl hdic-yy-readable))
(let ((fn (plist-get (nth 1 exp) :feature))
domain domain-fn ret)
(when fn
exp)))))
(defun est-eval-list (format-list object feature-name
- &optional lang uri-object)
+ &optional lang uri-object list-props)
(if (consp format-list)
(let ((ret
(mapcar
(est-eval-unit exp object feature-name lang uri-object nil))
format-list)))
(if (cdr ret)
- (list* 'list nil ret)
+ (list* 'list list-props ret)
(car ret)))
(est-eval-unit format-list object feature-name lang uri-object nil)))