1 ;;; www-page.el --- Album page generator for page.cgi.
3 ;; Copyright (C) 2005,2006,2007 MORIOKA Tomohiko
5 ;; Keywords: Photo, image, album, HTML, WWW
7 ;; This file is part of Album.
9 ;; Album is free software; you can redistribute it and/or modify it
10 ;; under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; Album is distributed in the hope that it will be useful, but
15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 ;; General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA.
26 ;; It requires `convert' and `identify' of ImageMagick.
30 (defconst www-page-version "0.3")
32 (defvar www-page-coding-system
37 (defvar www-page-default-base-directory
40 (defvar www-page-size-specs
57 (defun decode-url-string (string &optional coding-system)
58 (if (> (length string) 0)
61 (while (string-match "%\\([0-9A-F][0-9A-F]\\)" string i)
62 (setq dest (concat dest
63 (substring string i (match-beginning 0))
66 (string-to-int (match-string 1 string) 16))))
69 (concat dest (substring string i))
72 (defun www-page-open-dir (url-dir &optional image-root)
73 (let* ((path (expand-file-name url-dir image-root))
74 (desc-file (expand-file-name "dir.desc" path)))
75 (cons (cons 'location path)
77 (when (file-exists-p desc-file)
78 (insert-file-contents desc-file)
79 (read (current-buffer)))))))
81 (defun www-page-directory-image-files (url-dir image-root)
83 (dolist (file (directory-files (expand-file-name url-dir image-root)
84 nil "\\.\\(jpg\\|JPG\\)$" nil t))
85 (unless (string-match "_[^_]+GA[^_]*$"
86 (file-name-sans-extension file))
87 (setq source-images (cons file source-images))))
88 (nreverse source-images)))
90 (defun www-page-display-dir (url-dir &optional size image-root
91 lang title parent-url hide-cgi)
92 (setq url-dir (file-name-as-directory url-dir))
93 (princ "Content-Type: text/html; charset=UTF-8
96 (let* ((params (www-page-open-dir url-dir image-root))
97 source-images ref-images
98 file i ref-file prev-file next-file file-desc
100 (when (setq title (assq 'title params))
101 (setq title (cdr title)))
104 (file-name-nondirectory
105 (substring url-dir 0 (1- (length url-dir))))))
106 (when (setq source-images (assq 'files params))
107 (setq source-images (cdr source-images)))
108 (when (setq ref-images (assq 'refs params))
109 (setq ref-images (cdr ref-images)))
110 (unless (or source-images ref-images)
112 (www-page-directory-image-files url-dir image-root)))
113 (when (setq note (assq 'note params))
114 (setq note (cdr note)))
115 (when (setq parent-url (assq 'exit params))
116 (setq parent-url (cdr parent-url)))
119 "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
120 \"http://www.w3.org/TR/html4/loose.dtd\">\n")
123 (insert (format " lang=\"%s\"" lang)))
126 (insert (format "<title>%s</title>\n" title))
129 (insert (format "<h1>%s</h1>\n" title))
137 "[Note]
\e$B%5%`%M%$%k$r%/%j%C%/$9$k$HBg$-$J2hA|$,I=<($5$l$^$9
\e(B
142 (insert (format "lang = %s<br>\n" lang))))
143 (dolist (image-file source-images)
144 (setq file (file-name-nondirectory image-file))
145 (insert "<a href=\"")
151 (insert (format ".html.%s&size=%s\">"
154 (insert (format "<img alt=\"%s\" src=\"" file))
156 (insert (format "img.cgi?%s" url-dir)))
158 (insert "&size=thumbnail\">")
163 (setq ref-file (car ref-images))
166 (format "%d" (1+ i))))
170 (expand-file-name url-dir image-root)))
171 (unless (file-exists-p file-desc)
175 (insert (format "(prev-file . %S)\n " prev-file)))
176 ;; (insert (format "(ref . \"%s%s\")\n "
177 ;; url-dir ref-file))
178 (insert (format "(ref . \"%s\")\n "
181 (insert (format "(next-file . %S)\n " next-file)))
183 (write-region (point-min)(point-max) file-desc)))
184 (setq file (file-name-nondirectory ref-file))
185 (insert "<a href=\"")
190 (insert (format "%d.html.%s&size=%s\">"
194 ;; (insert (format "<img alt=\"%s\" src=\"page.cgi?%s%s&size=thumbnail\">"
195 ;; file url-dir ref-file))
196 (insert (format "<img alt=\"%s\" src=\"%s&size=thumbnail\">"
199 (setq prev-file (format "%d" i))
201 ref-images (cdr ref-images)))
212 (insert (format "[<a href=\"%s\">Return</a>]\n" parent-url)))
216 Powered by MnjAlbum WWW-Page Version %s." www-page-version))
221 (encode-coding-region (point-min)(point-max) www-page-coding-system)
222 (princ (buffer-string))
225 (defun www-page-display-page (file &optional size image-root
226 lang prev-file next-file hide-cgi)
228 (setq size (intern size)))
230 (setq lang (intern lang)))
231 (princ "Content-Type: text/html; charset=UTF-8
236 "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
237 \"http://www.w3.org/TR/html4/loose.dtd\">\n")
240 (insert (format " lang=\"%s\"" lang)))
243 (insert (format "<title>%s</title>\n" file))
246 ;; (insert (format "<h1>%s</h1>\n" file))
248 (let* ((desc-file (expand-file-name (concat file ".desc") image-root))
251 (when (file-exists-p desc-file)
252 (insert-file-contents desc-file)
253 (read (current-buffer)))))
257 prev-grade next-grade
260 ;; (setq dir-desc-file
261 ;; (expand-file-name "dir.desc"
262 ;; (expand-file-name (file-name-directory file)
265 (www-page-open-dir (file-name-directory file) image-root)
267 ;; (when (file-exists-p dir-desc-file)
268 ;; (insert-file-contents dir-desc-file)
269 ;; (read (current-buffer))))
271 (unless (assq 'refs params)
272 (if (setq rest (assq 'files params))
273 (setq rest (cdr rest))
275 (www-page-directory-image-files
276 (file-name-directory file) image-root)))
277 (setq ret (file-name-nondirectory file))
279 (not (string= (car rest) ret)))
280 (setq prev-file (car rest)
282 (setq next-file (car (cdr rest)))
284 (setq params (list (cons 'prev-file prev-file))))
286 (setq params (cons (cons 'next-file next-file)
288 (if (file-directory-p (file-name-directory desc-file))
290 (insert (format "%S" params))
291 ;; (princ "X-XEmacs-Message: ")
292 (write-region (point-min)(point-max) desc-file)
295 (if (setq image-ref (assq 'ref params))
296 (setq image-ref (cdr image-ref))
297 (setq image-file file))
298 (if (setq prev-file (assq 'prev-file params))
299 (setq prev-file (cdr prev-file)))
300 (if (setq next-file (assq 'next-file params))
301 (setq next-file (cdr next-file)))
302 (setq rest www-page-size-specs)
304 (setq spec (car rest))
305 (not (eq (car spec) size)))
306 (setq prev-grade (car spec)
308 (setq next-grade (car (car (cdr rest))))
310 (insert "<a href=\"")
312 (insert (format "page.cgi?%s" (file-name-directory file))))
313 (insert (format "%s.html.%s&size=%s\">"
319 (insert "[
\e$BA0
\e(B]")
322 (insert "[Previous]")
329 (insert "<a href=\"")
331 (insert (format "page.cgi?%s" (file-name-directory file))))
332 (insert (format "%s.html.%s&size=%s\">"
338 (insert "[
\e$B<!
\e(B]")
348 (insert "<a href=\"")
350 (insert (format "page.cgi?%s" (file-name-directory file))))
351 (insert (format "%s.html.%s&size=%s\">"
352 (file-name-nondirectory file)
357 (insert "[
\e$B=L>.
\e(B]")
367 (insert "<a href=\"")
369 (insert (format "page.cgi?%s" (file-name-directory file))))
370 (insert (format "%s.html.%s&size=%s\">"
371 (file-name-nondirectory file)
376 (insert "[
\e$B3HBg
\e(B]")
389 (insert "<a href=\"")
391 (insert (format "page.cgi?%s" (file-name-directory file))))
392 (insert (format "%s.html.%s&size=%s\">"
400 (format "<img alt=\"%s\" src=\"%s&size=%s\">"
401 file image-ref size))
403 (t ; (file-exists-p (expand-file-name image-file image-root))
404 (insert (format "<img alt=\"%s\" src=\"" file))
406 (insert (format "img.cgi?%s" (file-name-directory image-file))))
407 (insert (format "%s&size=%s\">"
408 (file-name-nondirectory image-file) size))
415 "
\e$B2hA|%U%!%$%k
\e(B %s
\e$B$,8+IU$+$j$^$;$s!#
\e(B\n")
417 "Image file %s is not found.\n"))
428 ;; (format "<a href=\"page.cgi?%s&lang=%s&size=%s\">[index]</a>"
429 ;; (file-name-directory file)
432 (insert "<a href=\"")
434 (insert (format "page.cgi?%s" (file-name-directory file))))
435 (insert (format "&lang=%s&size=%s\">%s</a>"
439 "[index]
\e$B$KLa$k
\e(B")
444 "
\e$B!JJQ99$7$?Bg$-$5$O0];}$5$l$^$9!K
\e(B")
449 Powered by MnjAlbum WWW-Page Version %s." www-page-version))
454 (encode-coding-region (point-min)(point-max) www-page-coding-system)
455 (princ (buffer-string))
458 (defun www-page-display-image (file &optional size image-root)
459 (setq file (expand-file-name file image-root))
460 (when (file-exists-p file)
461 (let (file-dir file-name
462 resized-file resized-dir
466 (setq file-dir (file-name-directory file)
467 file-name (file-name-nondirectory file))
474 (unless (file-exists-p resized-file)
475 (setq size (intern size))
476 (if (and (setq spec (assq size www-page-size-specs))
477 (setq width (nth 1 spec))
478 (setq height (nth 2 spec)))
481 (unless (file-exists-p resized-dir)
482 (make-directory resized-dir))
485 "convert" nil nil nil
486 "-resize" (format "%dx%d>" width height)
489 (setq resized-file file)))
490 ;; (princ resized-file)
491 (setq file resized-file)
496 (princ (format "Content-Type: %s"
503 (let ((coding-system-for-read 'binary)
504 (coding-system-for-write 'binary))
505 (insert-file-contents-literally file))
506 (buffer-string)))))))
508 (defun www-page-batch-get ()
509 ;; (set-coding-priority-list
510 ;; '(iso-7 iso-8-2 utf-8 big5 shift-jis
511 ;; iso-8-designate iso-8-1 iso-lock-shift no-conversion))
512 ;; (set-coding-category-system 'utf-8 'utf-8-jp)
513 (let (target params method size key image-root lang ret hide-cgi)
514 (let ((rest (car command-line-args-left))
517 (setq rest (split-string rest "&")))
518 (setq target (car rest)
521 (when (and (string-match "=" (setq arg (car rest)))
522 (> (length (setq val (substring arg (match-end 0)))) 0))
523 (setq key (substring arg 0 (match-beginning 0)))
526 (cons (decode-url-string val www-page-coding-system)
527 (cdr (assoc key params)))))
528 (setq rest (cdr rest))))
531 ((string-match "\\.html\\(\\.\\([a-z]+\\)\\)?$" target)
532 (setq lang (match-string 2 target))
533 (setq target (substring target 0 (match-beginning 0)))
534 (cond ((string= (file-name-nondirectory
535 ;; (substring target 0 (match-beginning 0))
539 (setq target (file-name-directory target))
544 ((or (string= (file-name-nondirectory target) "")
545 (null (file-name-extension target)))
547 ;; (setq file (car (cdr (assoc "file" params))))
548 (setq size (car (cdr (assoc "size" params))))
549 (if (setq ret (cdr (assoc "lang" params)))
550 (setq lang (car ret)))
551 (setq command-line-args-left (cdr command-line-args-left))
552 (setq hide-cgi (string= (car command-line-args-left) "hide-cgi"))
553 (setq command-line-args-left (cdr command-line-args-left))
554 (setq image-root (or (car command-line-args-left)
556 www-page-default-base-directory
558 (setq command-line-args-left (cdr command-line-args-left))
559 (cond ((eq method 'dir)
560 (www-page-display-dir target size image-root lang
564 (www-page-display-page target size image-root lang
568 (www-page-display-image target size image-root)
575 ;;; www-page.el ends here