1 ;;; www-image.el --- Album page generator for image.cgi.
3 ;; Copyright (C) 2005,2006 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 (defvar www-image-coding-system
35 (defvar www-image-default-base-directory
38 (defvar www-image-size-specs
54 (defun decode-url-string (string &optional coding-system)
55 (if (> (length string) 0)
58 (while (string-match "%\\([0-9A-F][0-9A-F]\\)" string i)
59 (setq dest (concat dest
60 (substring string i (match-beginning 0))
63 (string-to-int (match-string 1 string) 16))))
66 (concat dest (substring string i))
69 (defun www-image-display-thumbnails (url-dir &optional size image-root
70 lang title parent-url)
71 (setq url-dir (file-name-as-directory url-dir))
73 (expand-file-name "dir.desc"
74 (expand-file-name url-dir image-root)))
77 (when (file-exists-p desc-file)
78 (insert-file-contents desc-file)
79 (read (current-buffer)))))
83 (when (setq title (assq 'title params))
84 (setq title (cdr title)))
87 (file-name-nondirectory
88 (substring url-dir 0 (1- (length url-dir))))))
89 (when (setq source-images (assq 'files params))
90 (setq source-images (cdr source-images)))
91 (when (setq note (assq 'note params))
92 (setq note (cdr note)))
93 (when (setq parent-url (assq 'exit params))
94 (setq parent-url (cdr parent-url)))
97 "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
98 \"http://www.w3.org/TR/html4/loose.dtd\">\n")
101 (insert (format " lang=\"%s\"" lang)))
104 (insert (format "<title>%s</title>\n" title))
107 (insert (format "<h1>%s</h1>\n" title))
112 (dolist (image-file source-images)
113 (setq file (file-name-nondirectory image-file))
114 (insert "<a href=\"image.cgi?page=")
117 (insert (format "&size=%s&lang=%s\">"
120 (insert (format "<img alt=\"%s\" src=\"image.cgi?file=%s%s&size=thumbnail\">"
133 (insert (format "[<a href=\"%s\">Return</a>]\n" parent-url)))
139 (encode-coding-region (point-min)(point-max) www-image-coding-system)
140 (princ "Content-Type: text/html; charset=UTF-8
143 (princ (buffer-string))
146 (defun www-image-display-page (file &optional size image-root
147 lang prev-file next-file)
149 (setq size (intern size)))
151 (setq lang (intern lang)))
152 (princ "Content-Type: text/html; charset=UTF-8
157 "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
158 \"http://www.w3.org/TR/html4/loose.dtd\">\n")
161 (insert (format " lang=\"%s\"" lang)))
164 (insert (format "<title>%s</title>\n" file))
167 ;; (insert (format "<h1>%s</h1>\n" file))
169 (let* ((desc-file (expand-file-name (concat file ".desc") image-root))
172 (when (file-exists-p desc-file)
173 (insert-file-contents desc-file)
174 (read (current-buffer)))))
177 prev-grade next-grade
181 (expand-file-name "dir.desc"
182 (expand-file-name (file-name-directory file)
186 (when (file-exists-p dir-desc-file)
187 (insert-file-contents dir-desc-file)
188 (read (current-buffer)))))
189 (when (setq rest (assq 'files params))
190 (setq rest (cdr rest)))
191 (setq ret (file-name-nondirectory file))
193 (not (string= (car rest) ret)))
194 (setq prev-file (car rest)
196 (setq next-file (car (cdr rest)))
198 (setq params (list (cons 'prev-file prev-file))))
200 (setq params (cons (cons 'next-file next-file)
203 (insert (format "%S" params))
204 ;; (princ "X-XEmacs-Message: ")
205 (write-region (point-min)(point-max) desc-file)
208 (if (setq prev-file (assq 'prev-file params))
209 (setq prev-file (cdr prev-file)))
210 (if (setq next-file (assq 'next-file params))
211 (setq next-file (cdr next-file)))
212 (setq rest www-image-size-specs)
214 (setq spec (car rest))
215 (not (eq (car spec) size)))
216 (setq prev-grade (car spec)
218 (setq next-grade (car (car (cdr rest))))
220 (insert (format "<a href=\"image.cgi?page=%s%s&size=%s&lang=%s\">"
221 (file-name-directory file) prev-file size
224 (insert "[
\e$BA0
\e(B]")
227 (insert "[Previous]")
234 (insert (format "<a href=\"image.cgi?page=%s%s&size=%s&lang=%s\">"
235 (file-name-directory file) next-file size
238 (insert "[
\e$B<!
\e(B]")
248 (insert (format "<a href=\"image.cgi?page=%s&size=%s&lang=%s\">"
252 (insert "[
\e$B=L>.
\e(B]")
262 (insert (format "<a href=\"image.cgi?page=%s&size=%s&lang=%s\">"
266 (insert "[
\e$B3HBg
\e(B]")
279 (insert (format "<a href=\"image.cgi?page=%s%s&size=%s&lang=%s\">"
280 (file-name-directory file) next-file size
282 (insert (format "<img alt=\"%s\" src=\"image.cgi?file=%s&size=%s\">"
291 (format "<a href=\"image.cgi?dir=%s&size=%s&lang=%s\">[index]</a>"
292 (file-name-directory file) size (or lang 'en)))
297 (encode-coding-region (point-min)(point-max) www-image-coding-system)
298 (princ (buffer-string))
301 (defun www-image-display-image (file &optional size image-root)
302 (setq file (expand-file-name file image-root))
303 (let (file-dir file-name
304 resized-file resized-dir
308 (setq file-dir (file-name-directory file)
309 file-name (file-name-nondirectory file))
316 (unless (file-exists-p resized-file)
317 (setq size (intern size))
318 (if (setq spec (assq size www-image-size-specs))
321 (unless (file-exists-p resized-dir)
322 (make-directory resized-dir))
325 "convert" nil nil nil
326 "-resize" (format "%dx%d>" (nth 1 spec)(nth 2 spec))
329 (setq resized-file file)))
330 ;; (princ resized-file)
331 (setq file resized-file)
336 (princ (format "Content-Type: %s"
343 (let ((coding-system-for-read 'binary)
344 (coding-system-for-write 'binary))
345 (insert-file-contents-literally file))
348 (defun www-image-batch-get ()
349 ;; (set-coding-priority-list
350 ;; '(iso-7 iso-8-2 utf-8 big5 shift-jis
351 ;; iso-8-designate iso-8-1 iso-lock-shift no-conversion))
352 ;; (set-coding-category-system 'utf-8 'utf-8-jp)
353 (let (params file size key image-root lang)
354 (let ((rest (car command-line-args-left))
357 (setq rest (split-string rest "&")))
359 (when (and (string-match "=" (setq arg (car rest)))
360 (> (length (setq val (substring arg (match-end 0)))) 0))
361 (setq key (substring arg 0 (match-beginning 0)))
364 (cons (decode-url-string val www-image-coding-system)
365 (cdr (assoc key params)))))
366 (setq rest (cdr rest))))
367 (setq file (car (cdr (assoc "file" params))))
368 (setq size (car (cdr (assoc "size" params))))
369 (setq lang (car (cdr (assoc "lang" params))))
370 (setq command-line-args-left (cdr command-line-args-left))
371 (setq image-root (or (car command-line-args-left)
373 www-image-default-base-directory
375 (setq command-line-args-left (cdr command-line-args-left))
377 (www-image-display-image file size image-root)
379 ((setq file (car (cdr (assoc "page" params))))
380 (www-image-display-page file size image-root lang)
382 ((setq file (car (cdr (assoc "dir" params))))
383 (www-image-display-thumbnails file size image-root lang)
389 ;;; www-image.el ends here