From: tomo <tomo>
Date: Mon, 22 May 2006 14:42:01 +0000 (+0000)
Subject: (www-page-display-thumbnails): Support `refs' feature about indirect
X-Git-Url: http://git.chise.org/gitweb/?p=elisp%2Falbum.git;a=commitdiff_plain;h=f02cad876bd26ae01f49a616bef8906f86544232

(www-page-display-thumbnails): Support `refs' feature about indirect
references.
(www-page-display-page): Support `ref' feature about indirect
reference.
---

diff --git a/www-page.el b/www-page.el
index 1682d09..324b807 100644
--- a/www-page.el
+++ b/www-page.el
@@ -69,6 +69,9 @@
 (defun www-page-display-thumbnails (url-dir &optional size image-root
 					     lang title parent-url)
   (setq url-dir (file-name-as-directory url-dir))
+  (princ "Content-Type: text/html; charset=UTF-8
+
+")
   (let* ((desc-file
 	  (expand-file-name "dir.desc"
 			    (expand-file-name url-dir image-root)))
@@ -77,8 +80,8 @@
 	    (when (file-exists-p desc-file)
 	      (insert-file-contents desc-file)
 	      (read (current-buffer)))))
-	 source-images
-	 file
+	 source-images ref-images
+	 file i ref-file prev-file next-file file-desc
 	 note)
     (when (setq title (assq 'title params))
       (setq title (cdr title)))
@@ -88,6 +91,8 @@
 	     (substring url-dir 0 (1- (length url-dir))))))
     (when (setq source-images (assq 'files params))
       (setq source-images (cdr source-images)))
+    (when (setq ref-images (assq 'refs params))
+      (setq ref-images (cdr ref-images)))
     (when (setq note (assq 'note params))
       (setq note (cdr note)))
     (when (setq parent-url (assq 'exit params))
@@ -121,6 +126,45 @@
 			file url-dir file))
 	(insert "</a>\n"))
 
+      (setq i 1)
+      (while ref-images
+	(setq ref-file (car ref-images))
+	(setq next-file
+	      (if (cdr ref-images)
+		  (format "%d" (1+ i))))
+	(setq file-desc
+	      (expand-file-name
+	       (format "%d.desc" i)
+	       (expand-file-name url-dir image-root)))
+	(unless (file-exists-p file-desc)
+	  (with-temp-buffer
+	    (insert "(")
+	    (if prev-file
+		(insert (format "(prev-file . %S)\n " prev-file)))
+            ;; (insert (format "(ref . \"%s%s\")\n "
+            ;;                 url-dir ref-file))
+	    (insert (format "(ref . \"%s\")\n "
+			    ref-file))
+	    (if next-file
+		(insert (format "(next-file . %S)\n " next-file)))
+	    (insert "))\n")
+	    (write-region (point-min)(point-max) file-desc)))
+	(setq file (file-name-nondirectory ref-file))
+	(insert "<a href=\"page.cgi?")
+	(insert url-dir)
+	(insert (format "%d.html.%s&size=%s\">"
+			i
+			(or lang 'en)
+			(or size 'VGA)))
+        ;; (insert (format "<img alt=\"%s\" src=\"page.cgi?%s%s&size=thumbnail\">"
+        ;;                 file url-dir ref-file))
+	(insert (format "<img alt=\"%s\" src=\"%s&size=thumbnail\">"
+			file ref-file))
+	(insert "</a>\n")
+	(setq prev-file (format "%d" i))
+	(setq i (1+ i)
+	      ref-images (cdr ref-images)))
+
       (when note
 	(insert "<p>")
 	(insert note))
@@ -137,9 +181,6 @@
 </html>
 ")
       (encode-coding-region (point-min)(point-max) www-page-coding-system)
-      (princ "Content-Type: text/html; charset=UTF-8
-
-")
       (princ (buffer-string))
       )))
 
@@ -173,6 +214,7 @@
 		(insert-file-contents desc-file)
 		(read (current-buffer)))))
 	   dir-desc-file
+	   image-file image-ref
 	   prev-file next-file
 	   prev-grade next-grade
 	   rest spec ret)
@@ -205,6 +247,9 @@
 	  (write-region (point-min)(point-max) desc-file)
           ;; (princ "\n")
 	  ))
+      (if (setq image-ref (assq 'ref params))
+	  (setq image-ref (cdr image-ref))
+	(setq image-file file))
       (if (setq prev-file (assq 'prev-file params))
 	  (setq prev-file (cdr prev-file)))
       (if (setq next-file (assq 'next-file params))
@@ -284,8 +329,12 @@
 			  (file-name-directory file) next-file
 			  (or lang 'en)
 			  size)))
-      (insert (format "<img alt=\"%s\" src=\"page.cgi?%s&size=%s\">"
-		      file file size))
+      (insert
+       (if image-ref
+	   (format "<img alt=\"%s\" src=\"%s&size=%s\">"
+		   file image-ref size)
+	 (format "<img alt=\"%s\" src=\"page.cgi?%s&size=%s\">"
+		 file image-file size)))
       (if next-file
 	  (insert "</a>"))
       (insert "