((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 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;分"))
+ ((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 "&MJ013520;号"))
+ ((eq spec 13) (concat value "月号"))
((eq spec 14) (concat value "特集号"))
((eq spec 15) (concat value "本"))
((eq spec 16) (concat 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)) "&HD-JA-4A54;"))
-;; ((string= spec "05") `((decimal (:feature ,feature)) "&HD-JA-4A53;"))
+;; ((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;分"))
+;; ((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)) "&MJ013520;号"))
+;; ((string= spec "13") `((decimal (:feature ,feature)) "月号"))
;; ((string= spec "14") `((decimal (:feature ,feature)) "特集号"))
;; ((string= spec "15") `((decimal (:feature ,feature)) "本"))
;; ((string= spec "16") `((decimal (:feature ,feature)) "分"))
;; ((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
)))
(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-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))
(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)))
(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)
'(: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)))
((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)
)
((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)
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)))