projects / elisp / album.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
update.
[elisp/album.git] / www-page.el
diff --git a/www-page.el b/www-page.el
index 02d6a1d..2c50727 100644 (file)
--- a/www-page.el
+++ b/www-page.el
@@ -27,6 +27,8 @@
 
 ;;; Code:
 
 
 ;;; Code:
 
+(defconst www-page-version "0.4")
+
 (defvar www-page-coding-system
   (if (featurep 'chise)
       'utf-8-jp-er
 (defvar www-page-coding-system
   (if (featurep 'chise)
       'utf-8-jp-er
@@ -67,20 +69,32 @@
         (concat dest (substring string i))
         coding-system))))
 
         (concat dest (substring string i))
         coding-system))))
 
+(defun www-page-open-dir (url-dir &optional image-root)
+  (let* ((path (expand-file-name url-dir image-root))
+        (desc-file (expand-file-name "dir.desc" path)))
+    (cons (cons 'location path)
+         (with-temp-buffer
+           (when (file-exists-p desc-file)
+             (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
 (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
 
 ")
   (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)))
-        (params
-         (with-temp-buffer
-           (when (file-exists-p desc-file)
-             (insert-file-contents desc-file)
-             (read (current-buffer)))))
+  (let* ((params (www-page-open-dir url-dir image-root))
         source-images ref-images
         file i ref-file prev-file next-file file-desc
         note)
         source-images ref-images
         file i ref-file prev-file next-file file-desc
         note)
@@ -96,8 +110,7 @@
       (setq ref-images (cdr ref-images)))
     (unless (or source-images ref-images)
       (setq source-images
       (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))
     (when (setq note (assq 'note params))
       (setq note (cdr note)))
     (when (setq parent-url (assq 'exit params))
@@ -115,10 +128,19 @@
       (insert "</head>\n")
       (insert "<body>\n")
       (insert (format "<h1>%s</h1>\n" title))
       (insert "</head>\n")
       (insert "<body>\n")
       (insert (format "<h1>%s</h1>\n" title))
-
       (insert "
 <hr>
 ")
       (insert "
 <hr>
 ")
+      (cond
+       ((or (eq lang 'ja)
+           (string= lang "ja"))
+       (insert
+        "[Note] \e$B%5%`%M%$%k$r%/%j%C%/$9$k$HBg$-$J2hA|$,I=<($5$l$^$9\e(B
+<hr>
+")
+       )
+       (t
+       (insert (format "lang = %s<br>\n" lang))))
       (dolist (image-file source-images)
        (setq file (file-name-nondirectory image-file))
        (insert "<a href=\"")
       (dolist (image-file source-images)
        (setq file (file-name-nondirectory image-file))
        (insert "<a href=\"")
@@ -127,9 +149,10 @@
          (insert url-dir)
          )
        (insert file)
          (insert url-dir)
          )
        (insert file)
-       (insert (format ".html.%s&size=%s\">"
+       (insert (format ".html.%s&size=%s&p=%s\">"
                        (or lang 'en)
                        (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)))
         (insert (format "<img alt=\"%s\" src=\"" file))
        (unless hide-cgi
          (insert (format "img.cgi?%s"  url-dir)))
@@ -190,6 +213,9 @@
       (if parent-url
          (insert (format "[<a href=\"%s\">Return</a>]\n" parent-url)))
       
       (if parent-url
          (insert (format "[<a href=\"%s\">Return</a>]\n" parent-url)))
       
+      (insert 
+       (format "<hr>
+Powered by MnjAlbum WWW-Page Version %s." www-page-version))
       (insert "
 </body>
 </html>
       (insert "
 </body>
 </html>
@@ -199,9 +225,12 @@
       )))
 
 (defun www-page-display-page (file &optional size image-root
       )))
 
 (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 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
   (if (stringp lang)
       (setq lang (intern lang)))
   (princ "Content-Type: text/html; charset=UTF-8
@@ -227,29 +256,29 @@
              (when (file-exists-p desc-file)
                (insert-file-contents desc-file)
                (read (current-buffer)))))
              (when (file-exists-p desc-file)
                (insert-file-contents desc-file)
                (read (current-buffer)))))
-          dir-desc-file
+           ;; dir-desc-file
           image-file image-ref
           prev-file next-file
           prev-grade next-grade
           rest spec ret)
       (unless params
           image-file image-ref
           prev-file next-file
           prev-grade next-grade
           rest spec ret)
       (unless params
-       (setq dir-desc-file
-             (expand-file-name "dir.desc"
-                               (expand-file-name (file-name-directory file)
-                                                 image-root)))
+        ;; (setq dir-desc-file
+        ;;       (expand-file-name "dir.desc"
+        ;;                         (expand-file-name (file-name-directory file)
+        ;;                                           image-root)))
        (setq params
        (setq params
-             (with-temp-buffer
-               (when (file-exists-p dir-desc-file)
-                 (insert-file-contents dir-desc-file)
-                 (read (current-buffer)))))
+             (www-page-open-dir (file-name-directory file) image-root)
+              ;; (with-temp-buffer
+              ;;   (when (file-exists-p dir-desc-file)
+              ;;     (insert-file-contents dir-desc-file)
+              ;;     (read (current-buffer))))
+             )
        (unless (assq 'refs params)
          (if (setq rest (assq 'files params))
              (setq rest (cdr rest))
            (setq rest
        (unless (assq 'refs params)
          (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)))
          (setq ret (file-name-nondirectory file))
          (while (and rest
                      (not (string= (car rest) ret)))
@@ -286,10 +315,11 @@
         (insert "<a href=\"")
        (unless hide-cgi
          (insert (format "page.cgi?%s" (file-name-directory file))))
         (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)
                        prev-file
                        (or lang 'en)
-                       size))
+                       size
+                       pivot-mode))
        )
       (cond ((eq lang 'ja)
             (insert "[\e$BA0\e(B]")
        )
       (cond ((eq lang 'ja)
             (insert "[\e$BA0\e(B]")
@@ -305,10 +335,11 @@
         (insert "<a href=\"")
        (unless hide-cgi
          (insert (format "page.cgi?%s" (file-name-directory file))))
         (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)
                        next-file
                        (or lang 'en)
-                       size))
+                       size
+                       pivot-mode))
        )
       (cond ((eq lang 'ja)
             (insert "[\e$B<!\e(B]")
        )
       (cond ((eq lang 'ja)
             (insert "[\e$B<!\e(B]")
@@ -324,10 +355,11 @@
        (insert "<a href=\"")
        (unless hide-cgi
          (insert (format "page.cgi?%s" (file-name-directory file))))
        (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)
                        (file-name-nondirectory file)
                        (or lang 'en)
-                       prev-grade))
+                       prev-grade
+                       pivot-mode))
        )
       (cond ((eq lang 'ja)
             (insert "[\e$B=L>.\e(B]")
        )
       (cond ((eq lang 'ja)
             (insert "[\e$B=L>.\e(B]")
@@ -343,10 +375,11 @@
         (insert "<a href=\"")
        (unless hide-cgi
          (insert (format "page.cgi?%s" (file-name-directory file))))
         (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)
                        (file-name-nondirectory file)
                        (or lang 'en)
-                       next-grade))
+                       next-grade
+                       pivot-mode))
        )
       (cond ((eq lang 'ja)
             (insert "[\e$B3HBg\e(B]")
        )
       (cond ((eq lang 'ja)
             (insert "[\e$B3HBg\e(B]")
@@ -365,23 +398,25 @@
        (insert "<a href=\"")
        (unless hide-cgi
          (insert (format "page.cgi?%s" (file-name-directory file))))
        (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)
                        next-file
                        (or lang 'en)
-                       size))
+                       size
+                       pivot-mode))
        )
       (cond
        (image-ref
        (insert
        )
       (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))))
        )
        (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>")
        )
        (t
        (insert "<p>")
@@ -408,9 +443,22 @@
     (insert "<a href=\"")
     (unless hide-cgi
       (insert (format "page.cgi?%s" (file-name-directory file))))
     (insert "<a href=\"")
     (unless hide-cgi
       (insert (format "page.cgi?%s" (file-name-directory file))))
-    (insert (format "&lang=%s&size=%s\">[index]</a>"
+    (insert (format "&lang=%s&size=%s&p=%s\">%s</a>"
                    (or lang 'en)
                    (or lang 'en)
-                   size))
+                   size
+                   pivot-mode
+                   (cond ((eq lang 'ja)
+                          "[index] \e$B$KLa$k\e(B")
+                         (t
+                          "[index]"))))
+    (insert
+     (cond ((eq lang 'ja)
+           "\e$B!JJQ99$7$?Bg$-$5$O0];}$5$l$^$9!K\e(B")
+          (t
+           "")))
+    (insert 
+     (format "<hr>
+Powered by MnjAlbum WWW-Page Version %s." www-page-version))
     (insert "
 </body>
 </html>
     (insert "
 </body>
 </html>
@@ -419,38 +467,62 @@
     (princ (buffer-string))
     ))
 
     (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
   (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
       (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 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
        (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)
        (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)
        )
        ;; (princ resized-file)
        (setq file resized-file)
        )
@@ -474,7 +546,7 @@
   ;;  '(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)
   ;;  '(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
     (let ((rest (car command-line-args-left))
          arg val)
       (if rest
@@ -510,6 +582,9 @@
            'dir)))
     ;; (setq file (car (cdr (assoc "file" params))))
     (setq size (car (cdr (assoc "size" params))))
            '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))
     (if (setq ret (cdr (assoc "lang" params)))
        (setq lang (car ret)))
     (setq command-line-args-left (cdr command-line-args-left))
@@ -522,14 +597,14 @@
     (setq command-line-args-left (cdr command-line-args-left))
     (cond ((eq method 'dir)
           (www-page-display-dir target size image-root lang
     (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
           )
          ((eq method 'page)
           (www-page-display-page target size image-root lang
-                                 nil nil hide-cgi)
+                                 nil nil hide-cgi pivot-mode)
           )
          (t
           )
          (t
-          (www-page-display-image target size image-root)
+          (www-page-display-image target size image-root pivot-mode)
           )
          )))
 
           )
          )))