X-Git-Url: http://git.chise.org/gitweb/?p=elisp%2Falbum.git;a=blobdiff_plain;f=www-page.el;h=0b29a411288ef5105c64912d29eb2711b33263ea;hp=d06d497a3a26ff84d2b2e2370ddbd4ceaade39b9;hb=97aae194eb5410ff8dd962e0f903ee6a777bf8d6;hpb=887eb63ca7a5981c0dadf60c6a17fee51d2303cd

diff --git a/www-page.el b/www-page.el
index d06d497..0b29a41 100644
--- a/www-page.el
+++ b/www-page.el
@@ -27,7 +27,7 @@
 
 ;;; Code:
 
-(defconst www-page-version "0.3")
+(defconst www-page-version "0.4")
 
 (defvar www-page-coding-system
   (if (featurep 'chise)
@@ -78,8 +78,18 @@
 	      (insert-file-contents desc-file)
 	      (read (current-buffer)))))))
 
+(defun www-page-directory-image-files (url-dir image-root)
+  (let (source-images)
+    (dolist (file (directory-files (expand-file-name url-dir image-root)
+				   nil "\\.\\(jpg\\|JPG\\)$" nil t))
+      (unless (string-match "_[^_]+GA[^_]*$"
+			    (file-name-sans-extension file))
+	(setq source-images (cons file source-images))))
+    (nreverse source-images)))
+      
 (defun www-page-display-dir (url-dir &optional size image-root
-				     lang title parent-url hide-cgi)
+				     lang title parent-url hide-cgi
+				     pivot-mode)
   (setq url-dir (file-name-as-directory url-dir))
   (princ "Content-Type: text/html; charset=UTF-8
 
@@ -100,8 +110,7 @@
       (setq ref-images (cdr ref-images)))
     (unless (or source-images ref-images)
       (setq source-images
-	    (directory-files (expand-file-name url-dir image-root)
-			     nil "\\.\\(jpg\\|JPG\\)$" nil t)))
+	    (www-page-directory-image-files url-dir image-root)))
     (when (setq note (assq 'note params))
       (setq note (cdr note)))
     (when (setq parent-url (assq 'exit params))
@@ -140,9 +149,10 @@
 	  (insert url-dir)
 	  )
 	(insert file)
-	(insert (format ".html.%s&size=%s\">"
+	(insert (format ".html.%s&size=%s&p=%s\">"
 			(or lang 'en)
-			(or size 'VGA)))
+			(or size 'VGA)
+			(or pivot-mode t)))
         (insert (format "<img alt=\"%s\" src=\"" file))
 	(unless hide-cgi
 	  (insert (format "img.cgi?%s"  url-dir)))
@@ -215,9 +225,12 @@ Powered by MnjAlbum WWW-Page Version %s." www-page-version))
       )))
 
 (defun www-page-display-page (file &optional size image-root
-				   lang prev-file next-file hide-cgi)
+				   lang prev-file next-file hide-cgi
+				   pivot-mode)
   (if (stringp size)
       (setq size (intern size)))
+  (if (stringp pivot-mode)
+      (setq pivot-mode (intern pivot-mode)))
   (if (stringp lang)
       (setq lang (intern lang)))
   (princ "Content-Type: text/html; charset=UTF-8
@@ -264,10 +277,8 @@ Powered by MnjAlbum WWW-Page Version %s." www-page-version))
 	  (if (setq rest (assq 'files params))
 	      (setq rest (cdr rest))
 	    (setq rest
-		  (directory-files
-		   (expand-file-name (file-name-directory file)
-				     image-root)
-		   nil "\\.\\(jpg\\|JPG\\)$" nil t)))
+		  (www-page-directory-image-files
+		   (file-name-directory file) image-root)))
 	  (setq ret (file-name-nondirectory file))
 	  (while (and rest
 		      (not (string= (car rest) ret)))
@@ -304,10 +315,11 @@ Powered by MnjAlbum WWW-Page Version %s." www-page-version))
         (insert "<a href=\"")
 	(unless hide-cgi
 	  (insert (format "page.cgi?%s" (file-name-directory file))))
-	(insert (format "%s.html.%s&size=%s\">"
+	(insert (format "%s.html.%s&size=%s&p=%s\">"
 			prev-file
 			(or lang 'en)
-			size))
+			size
+			pivot-mode))
 	)
       (cond ((eq lang 'ja)
 	     (insert "[前]")
@@ -323,10 +335,11 @@ Powered by MnjAlbum WWW-Page Version %s." www-page-version))
         (insert "<a href=\"")
 	(unless hide-cgi
 	  (insert (format "page.cgi?%s" (file-name-directory file))))
-	(insert (format "%s.html.%s&size=%s\">"
+	(insert (format "%s.html.%s&size=%s&p=%s\">"
 			next-file
 			(or lang 'en)
-			size))
+			size
+			pivot-mode))
 	)
       (cond ((eq lang 'ja)
 	     (insert "[次]")
@@ -342,10 +355,11 @@ Powered by MnjAlbum WWW-Page Version %s." www-page-version))
 	(insert "<a href=\"")
 	(unless hide-cgi
 	  (insert (format "page.cgi?%s" (file-name-directory file))))
-	(insert (format "%s.html.%s&size=%s\">"
+	(insert (format "%s.html.%s&size=%s&p=%s\">"
 			(file-name-nondirectory file)
 			(or lang 'en)
-			prev-grade))
+			prev-grade
+			pivot-mode))
 	)
       (cond ((eq lang 'ja)
 	     (insert "[縮小]")
@@ -361,10 +375,11 @@ Powered by MnjAlbum WWW-Page Version %s." www-page-version))
         (insert "<a href=\"")
 	(unless hide-cgi
 	  (insert (format "page.cgi?%s" (file-name-directory file))))
-	(insert (format "%s.html.%s&size=%s\">"
+	(insert (format "%s.html.%s&size=%s&p=%s\">"
 			(file-name-nondirectory file)
 			(or lang 'en)
-			next-grade))
+			next-grade
+			pivot-mode))
 	)
       (cond ((eq lang 'ja)
 	     (insert "[拡大]")
@@ -383,23 +398,25 @@ Powered by MnjAlbum WWW-Page Version %s." www-page-version))
 	(insert "<a href=\"")
 	(unless hide-cgi
 	  (insert (format "page.cgi?%s" (file-name-directory file))))
-	(insert (format "%s.html.%s&size=%s\">"
+	(insert (format "%s.html.%s&size=%s&p=%s\">"
 			next-file
 			(or lang 'en)
-			size))
+			size
+			pivot-mode))
 	)
       (cond
        (image-ref
 	(insert
-	 (format "<img alt=\"%s\" src=\"%s&size=%s\">"
-		 file image-ref size))
+	 (format "<img alt=\"%s\" src=\"%s&size=%s&p=%s\">"
+		 file image-ref size pivot-mode))
 	)
        (t ; (file-exists-p (expand-file-name image-file image-root))
 	(insert (format "<img alt=\"%s\" src=\"" file))
 	(unless hide-cgi
 	  (insert (format "img.cgi?%s" (file-name-directory image-file))))
-	(insert (format "%s&size=%s\">"
-			(file-name-nondirectory image-file) size))
+	(insert (format "%s&size=%s&p=%s\">"
+			(file-name-nondirectory image-file)
+			size pivot-mode))
 	)
        (t
 	(insert "<p>")
@@ -426,9 +443,10 @@ Powered by MnjAlbum WWW-Page Version %s." www-page-version))
     (insert "<a href=\"")
     (unless hide-cgi
       (insert (format "page.cgi?%s" (file-name-directory file))))
-    (insert (format "&lang=%s&size=%s\">%s</a>"
+    (insert (format "&lang=%s&size=%s&p=%s\">%s</a>"
 		    (or lang 'en)
 		    size
+		    pivot-mode
 		    (cond ((eq lang 'ja)
 			   "[index] に戻る")
 			  (t
@@ -449,38 +467,64 @@ Powered by MnjAlbum WWW-Page Version %s." www-page-version))
     (princ (buffer-string))
     ))
 
-(defun www-page-display-image (file &optional size image-root)
+(defun www-page-display-image (file &optional size image-root pivot-mode)
+  (if (stringp pivot-mode)
+      (setq pivot-mode (intern pivot-mode)))
   (setq file (expand-file-name file image-root))
   (when (file-exists-p file)
     (let (file-dir file-name
 		   resized-file resized-dir
-		   spec width height)
+		   spec width height
+		   orig-width orig-height
+		   size-opt)
+      (setq size (intern size))
       (cond
-       (size
+       ((and size
+	     (setq spec (assq size www-page-size-specs))
+	     (setq width (nth 1 spec))
+	     (setq height (nth 2 spec)))
 	(setq file-dir (file-name-directory file)
 	      file-name (file-name-nondirectory file))
+	(setq size-opt
+	      (or (when (and (eq pivot-mode t)
+			     (> width height))
+		    (with-temp-buffer
+		      (call-process "identify" nil t nil file)
+		      (goto-char (point-min))
+		      (if (re-search-forward
+			   "^[^ ]+ [^ ]+ \\([0-9]+\\)x\\([0-9]+\\) " nil t)
+			  (setq orig-width (string-to-int
+					    (match-string 1))
+				orig-height (string-to-int
+					     (match-string 2)))))
+		    (if (> orig-height orig-width)
+			'p))
+		  ""))
 	(setq resized-file
-	      (expand-file-name
-	       file-name
-	       (setq resized-dir
-		     (expand-file-name
-		      size file-dir))))
+	      (format "%s_%s%s.%s"
+		      (file-name-sans-extension file)
+		      size size-opt
+		      (file-name-extension file)))
 	(unless (file-exists-p resized-file)
-	  (setq size (intern size))
-	  (if (and (setq spec (assq size www-page-size-specs))
-		   (setq width (nth 1 spec))
-		   (setq height (nth 2 spec)))
-	      (progn
-		(condition-case nil
-		    (unless (file-exists-p resized-dir)
-		      (make-directory resized-dir))
-		  (error nil))
-		(call-process
-		 "convert" nil nil nil
-		 "-resize" (format "%dx%d>" width height)
-		 file resized-file)
-		)
-	    (setq resized-file file)))
+	  (setq resized-file
+		(expand-file-name
+		 file-name
+		 (setq resized-dir
+		       (expand-file-name
+			(format "%s%s" size size-opt)
+			file-dir))))
+	  (unless (file-exists-p resized-file)
+	    (condition-case nil
+		(unless (file-exists-p resized-dir)
+		  (make-directory resized-dir))
+	      (error nil))
+	    (call-process
+	     "convert" nil nil nil
+	     "-resize"
+	     (if (eq size-opt 'p)
+		 (format "%dx%d>" height width)
+	       (format "%dx%d>" width height))
+	     file resized-file)))
 	;; (princ resized-file)
 	(setq file resized-file)
 	)
@@ -504,7 +548,7 @@ Powered by MnjAlbum WWW-Page Version %s." www-page-version))
   ;;  '(iso-7 iso-8-2 utf-8 big5 shift-jis
   ;;          iso-8-designate iso-8-1 iso-lock-shift no-conversion))
   ;; (set-coding-category-system 'utf-8 'utf-8-jp)
-  (let (target params method size key image-root lang ret hide-cgi)
+  (let (target params method size pivot-mode key image-root lang ret hide-cgi)
     (let ((rest (car command-line-args-left))
 	  arg val)
       (if rest
@@ -539,7 +583,11 @@ Powered by MnjAlbum WWW-Page Version %s." www-page-version))
 		(null (file-name-extension target)))
 	    'dir)))
     ;; (setq file (car (cdr (assoc "file" params))))
-    (setq size (car (cdr (assoc "size" params))))
+    (setq size (or (car (cdr (assoc "size" params)))
+		   'VGA))
+    (setq pivot-mode t)
+    (if (setq ret (cdr (assoc "p" params)))
+	(setq pivot-mode (car ret)))
     (if (setq ret (cdr (assoc "lang" params)))
 	(setq lang (car ret)))
     (setq command-line-args-left (cdr command-line-args-left))
@@ -552,14 +600,14 @@ Powered by MnjAlbum WWW-Page Version %s." www-page-version))
     (setq command-line-args-left (cdr command-line-args-left))
     (cond ((eq method 'dir)
 	   (www-page-display-dir target size image-root lang
-				 nil nil hide-cgi)
+				 nil nil hide-cgi pivot-mode)
 	   )
 	  ((eq method 'page)
 	   (www-page-display-page target size image-root lang
-				  nil nil hide-cgi)
+				  nil nil hide-cgi pivot-mode)
 	   )
 	  (t
-	   (www-page-display-image target size image-root)
+	   (www-page-display-image target size image-root pivot-mode)
 	   )
 	  )))