;;; www-page.el --- Album page generator for page.cgi.
-;; Copyright (C) 2005,2006 MORIOKA Tomohiko
+;; Copyright (C) 2005,2006,2007 MORIOKA Tomohiko
;; Keywords: Photo, image, album, HTML, WWW
;;; Code:
+(defconst www-page-version "0.3")
+
(defvar www-page-coding-system
(if (featurep 'chise)
'utf-8-jp-er
(WUXGA 1920 1200)
(QXGA 2048 1536)
(WQXGA 2560 1600)
+ (original nil nil)
))
(defun decode-url-string (string &optional coding-system)
(concat dest (substring string i))
coding-system))))
-(defun www-page-display-thumbnails (url-dir &optional size image-root
- lang title parent-url)
+(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
+ lang title parent-url hide-cgi)
(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)
(setq source-images (cdr source-images)))
(when (setq ref-images (assq 'refs params))
(setq ref-images (cdr ref-images)))
+ (unless (or source-images ref-images)
+ (setq source-images
+ (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))
(insert "</head>\n")
(insert "<body>\n")
(insert (format "<h1>%s</h1>\n" title))
-
(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=\"page.cgi?")
- (insert url-dir)
+ (insert "<a href=\"")
+ (unless hide-cgi
+ (insert "page.cgi?")
+ (insert url-dir)
+ )
(insert file)
(insert (format ".html.%s&size=%s\">"
(or lang 'en)
(or size 'VGA)))
- (insert (format "<img alt=\"%s\" src=\"page.cgi?%s%s&size=thumbnail\">"
- file url-dir file))
+ (insert (format "<img alt=\"%s\" src=\"" file))
+ (unless hide-cgi
+ (insert (format "img.cgi?%s" url-dir)))
+ (insert file)
+ (insert "&size=thumbnail\">")
(insert "</a>\n"))
(setq i 1)
(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 "<a href=\"")
+ (unless hide-cgi
+ (insert "page.cgi?")
+ (insert url-dir)
+ )
(insert (format "%d.html.%s&size=%s\">"
i
(or lang 'en)
(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>
)))
(defun www-page-display-page (file &optional size image-root
- lang prev-file next-file)
+ lang prev-file next-file hide-cgi)
(if (stringp size)
(setq size (intern size)))
(if (stringp lang)
(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
- (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
- (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)
- (when (setq rest (assq 'files params))
- (setq rest (cdr rest)))
+ (if (setq rest (assq 'files params))
+ (setq rest (cdr rest))
+ (setq rest
+ (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 prev-grade (car spec)
rest (cdr rest)))
(setq next-grade (car (car (cdr rest))))
- (if prev-file
- (insert (format "<a href=\"page.cgi?%s%s.html.%s&size=%s\">"
- (file-name-directory file) prev-file
- (or lang 'en)
- size)))
+ (when prev-file
+ (insert "<a href=\"")
+ (unless hide-cgi
+ (insert (format "page.cgi?%s" (file-name-directory file))))
+ (insert (format "%s.html.%s&size=%s\">"
+ prev-file
+ (or lang 'en)
+ size))
+ )
(cond ((eq lang 'ja)
(insert "[\e$BA0\e(B]")
)
(insert "</a>"))
(insert "\n")
- (if next-file
- (insert (format "<a href=\"page.cgi?%s%s.html.%s&size=%s\">"
- (file-name-directory file) next-file
- (or lang 'en)
- size)))
+ (when next-file
+ (insert "<a href=\"")
+ (unless hide-cgi
+ (insert (format "page.cgi?%s" (file-name-directory file))))
+ (insert (format "%s.html.%s&size=%s\">"
+ next-file
+ (or lang 'en)
+ size))
+ )
(cond ((eq lang 'ja)
(insert "[\e$B<!\e(B]")
)
(insert "</a>"))
(insert "\n")
- (if prev-grade
- (insert (format "<a href=\"page.cgi?%s.html.%s&size=%s\">"
- file
- (or lang 'en)
- prev-grade)))
+ (when prev-grade
+ (insert "<a href=\"")
+ (unless hide-cgi
+ (insert (format "page.cgi?%s" (file-name-directory file))))
+ (insert (format "%s.html.%s&size=%s\">"
+ (file-name-nondirectory file)
+ (or lang 'en)
+ prev-grade))
+ )
(cond ((eq lang 'ja)
(insert "[\e$B=L>.\e(B]")
)
(insert "</a>"))
(insert "\n")
- (if next-grade
- (insert (format "<a href=\"page.cgi?%s.html.%s&size=%s\">"
- file
- (or lang 'en)
- next-grade)))
+ (when next-grade
+ (insert "<a href=\"")
+ (unless hide-cgi
+ (insert (format "page.cgi?%s" (file-name-directory file))))
+ (insert (format "%s.html.%s&size=%s\">"
+ (file-name-nondirectory file)
+ (or lang 'en)
+ next-grade))
+ )
(cond ((eq lang 'ja)
(insert "[\e$B3HBg\e(B]")
)
(insert "
<hr>
")
+ (when next-file
+ (insert "<a href=\"")
+ (unless hide-cgi
+ (insert (format "page.cgi?%s" (file-name-directory file))))
+ (insert (format "%s.html.%s&size=%s\">"
+ next-file
+ (or lang 'en)
+ size))
+ )
+ (cond
+ (image-ref
+ (insert
+ (format "<img alt=\"%s\" src=\"%s&size=%s\">"
+ file image-ref size))
+ )
+ (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))
+ )
+ (t
+ (insert "<p>")
+ (insert (format
+ (cond
+ ((eq lang 'ja)
+ "\e$B2hA|%U%!%$%k\e(B %s \e$B$,8+IU$+$j$^$;$s!#\e(B\n")
+ (t
+ "Image file %s is not found.\n"))
+ file))))
+
(if next-file
- (insert (format "<a href=\"page.cgi?%s%s.html.%s&size=%s\">"
- (file-name-directory file) next-file
- (or lang 'en)
- size)))
- (if image-ref
- (insert
- (format "<img alt=\"%s\" src=\"%s&size=%s\">"
- file image-ref size))
- (if (file-exists-p (expand-file-name image-file image-root))
- (insert
- (format "<img alt=\"%s\" src=\"page.cgi?%s&size=%s\">"
- file image-file size))
- (insert "<p>")
- (insert (format
- (cond
- ((eq lang 'ja)
- "\e$B2hA|%U%!%$%k\e(B %s \e$B$,8+IU$+$j$^$;$s!#\e(B\n")
- (t
- "Image file %s is not found.\n"))
- file))))
-
- (if next-file
- (insert "</a>"))
- )
+ (insert "</a>"))
+ )
(insert "
<hr>
")
+ ;; (insert
+ ;; (format "<a href=\"page.cgi?%s&lang=%s&size=%s\">[index]</a>"
+ ;; (file-name-directory file)
+ ;; (or lang 'en)
+ ;; size))
+ (insert "<a href=\"")
+ (unless hide-cgi
+ (insert (format "page.cgi?%s" (file-name-directory file))))
+ (insert (format "&lang=%s&size=%s\">%s</a>"
+ (or lang 'en)
+ size
+ (cond ((eq lang 'ja)
+ "[index] \e$B$KLa$k\e(B")
+ (t
+ "[index]"))))
(insert
- (format "<a href=\"page.cgi?%s&lang=%s&size=%s\">[index]</a>"
- (file-name-directory file)
- (or lang 'en)
- size))
+ (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>
(defun www-page-display-image (file &optional size image-root)
(setq file (expand-file-name file image-root))
- (let (file-dir file-name
- resized-file resized-dir
- spec)
- (cond
- (size
- (setq file-dir (file-name-directory file)
- file-name (file-name-nondirectory file))
- (setq resized-file
- (expand-file-name
- file-name
- (setq resized-dir
- (expand-file-name
- size file-dir))))
- (unless (file-exists-p resized-file)
- (setq size (intern size))
- (if (setq spec (assq size www-page-size-specs))
- (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>" (nth 1 spec)(nth 2 spec))
- file resized-file)
- )
- (setq resized-file file)))
- ;; (princ resized-file)
- (setq file resized-file)
- )
- (t
- ;; (princ file)
- ))
- (princ (format "Content-Type: %s"
- (with-temp-buffer
- (call-process
- "file"
- nil t t
- "-b" "--mime" file)
- (insert "\n")
- (let ((coding-system-for-read 'binary)
- (coding-system-for-write 'binary))
- (insert-file-contents-literally file))
- (buffer-string))))))
+ (when (file-exists-p file)
+ (let (file-dir file-name
+ resized-file resized-dir
+ spec width height)
+ (cond
+ (size
+ (setq file-dir (file-name-directory file)
+ file-name (file-name-nondirectory file))
+ (setq resized-file
+ (expand-file-name
+ file-name
+ (setq resized-dir
+ (expand-file-name
+ size file-dir))))
+ (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)))
+ ;; (princ resized-file)
+ (setq file resized-file)
+ )
+ (t
+ ;; (princ file)
+ ))
+ (princ (format "Content-Type: %s"
+ (with-temp-buffer
+ (call-process
+ "file"
+ nil t t
+ "-b" "--mime" file)
+ (insert "\n")
+ (let ((coding-system-for-read 'binary)
+ (coding-system-for-write 'binary))
+ (insert-file-contents-literally file))
+ (buffer-string)))))))
(defun www-page-batch-get ()
;; (set-coding-priority-list
;; '(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)
+ (let (target params method size key image-root lang ret hide-cgi)
(let ((rest (car command-line-args-left))
arg val)
(if rest
(if (setq ret (cdr (assoc "lang" params)))
(setq lang (car ret)))
(setq command-line-args-left (cdr command-line-args-left))
+ (setq hide-cgi (string= (car command-line-args-left) "hide-cgi"))
+ (setq command-line-args-left (cdr command-line-args-left))
(setq image-root (or (car command-line-args-left)
(expand-file-name
www-page-default-base-directory
default-directory)))
(setq command-line-args-left (cdr command-line-args-left))
(cond ((eq method 'dir)
- (www-page-display-thumbnails target size image-root lang)
+ (www-page-display-dir target size image-root lang
+ nil nil hide-cgi)
)
((eq method 'page)
- (www-page-display-page target size image-root lang)
+ (www-page-display-page target size image-root lang
+ nil nil hide-cgi)
)
(t
(www-page-display-image target size image-root)