From: MORIOKA Tomohiko <tomo.git@chise.org>
Date: Wed, 20 Jul 2016 11:37:54 +0000 (+0900)
Subject: (est-eval-value-as-image-resource): Add optional argument
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=a3e92d18471fc496d7b9492ce02cc51dc82e1afd;p=chise%2Fest.git

(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'.
---

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)