From a3e92d18471fc496d7b9492ce02cc51dc82e1afd Mon Sep 17 00:00:00 2001 From: MORIOKA Tomohiko Date: Wed, 20 Jul 2016 20:37:54 +0900 Subject: [PATCH] (est-eval-value-as-image-resource): Add optional argument `accept-full-image'. (est-eval-value-as-image-object): New function. (est-eval-value-as-image-list): New function. (est-eval-apply-value): Use `est-eval-value-as-image-list' for format `image-list'. --- est-eval.el | 44 +++++++++++++++++++++++++++++++++++++------- 1 file changed, 37 insertions(+), 7 deletions(-) diff --git a/est-eval.el b/est-eval.el index 835d5b4..d327070 100644 --- a/est-eval.el +++ b/est-eval.el @@ -64,19 +64,33 @@ value))) (est-eval-value-as-S-exp value))) -(defun est-eval-value-as-image-resource (value) +(defun est-eval-value-as-image-resource (value &optional accept-full-image) (let ((name (concord-object-get value 'name))) - (if (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)))) - 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))) @@ -468,6 +482,20 @@ (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))) @@ -766,6 +794,8 @@ (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) -- 1.7.10.4