(www-page-version): Update to 0.4.
authortomo <tomo>
Sun, 21 Oct 2007 02:04:23 +0000 (02:04 +0000)
committertomo <tomo>
Sun, 21 Oct 2007 02:04:23 +0000 (02:04 +0000)
(www-page-display-dir): Add new optional argument `pivot-mode'.
(www-page-display-page): Likewise.
(www-page-display-image): Likewise.
(www-page-batch-get): Support `pivot-mode'.

www-page.el

index c3cc4f1..2c50727 100644 (file)
@@ -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)
@@ -88,7 +88,8 @@
     (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
 
          (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)))
@@ -223,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
@@ -310,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 "[\e$BA0\e(B]")
@@ -329,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 "[\e$B<!\e(B]")
@@ -348,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 "[\e$B=L>.\e(B]")
@@ -367,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 "[\e$B3HBg\e(B]")
@@ -389,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>")
@@ -432,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] \e$B$KLa$k\e(B")
                          (t
@@ -455,38 +467,62 @@ 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)
   (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 pivot-mode
+                            (> 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)
        )
@@ -510,7 +546,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
@@ -546,6 +582,9 @@ Powered by MnjAlbum WWW-Page Version %s." www-page-version))
            'dir)))
     ;; (setq file (car (cdr (assoc "file" params))))
     (setq size (car (cdr (assoc "size" params))))
+    (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))
@@ -558,14 +597,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)
           )
          )))