1 ;;; album.el --- Photo album utility
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 (defun album-write-html (dest-dir
31 prev-file file next-file
32 prev-grade grade next-grade
37 "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
38 \"http://www.w3.org/TR/html4/loose.dtd\">\n")
41 (insert (format " lang=\"%s\"" lang)))
44 (insert (format "<title>%s</title>\n" file))
47 ;; (insert (format "<h1>%s</h1>\n" file))
50 (insert (format "<a href=\"%s.html\">" prev-file)))
57 (insert (format "<a href=\"%s.html\">" next-file)))
64 (insert (format "<a href=\"../%s/%s.html\">"
73 (insert (format "<a href=\"../%s/%s.html\">"
87 (format "../%s/%s.html" next-grade file)
89 (concat (file-name-as-directory image-url-prefix)
92 (concat "../fullsize/" file ".jpg"))))
94 (insert (format "<img alt=\"%s\" src=\"%s\">"
99 (file-name-as-directory image-url-prefix)
102 (or image-url (concat file ".jpg")))))
107 <a href=\"../index.html\">[index]</a>
112 (unless (file-exists-p
113 (expand-file-name (symbol-name grade) dest-dir))
115 (expand-file-name (symbol-name grade) dest-dir)))
116 (write-region (point-min)(point-max)
118 (concat file ".html")
119 (expand-file-name (symbol-name grade)
122 (defun album-convert-image (image-dest-dir
123 prev-file file next-file
124 lang image-url-prefix
126 (setq file (expand-file-name file))
127 (unless html-dest-dir
128 (setq html-dest-dir image-dest-dir))
131 (call-process "identify" nil t t file)
132 (goto-char (point-min))
133 (and (re-search-forward " \\([0-9]+\\)x\\([0-9]+\\) " nil t)
134 (cons (string-to-number (match-string 1))
135 (string-to-number (match-string 2))))))
138 (specs '((QVGA 320 240)
153 (unless (file-exists-p
154 (expand-file-name "thumbnail" image-dest-dir))
156 (expand-file-name "thumbnail" image-dest-dir)))
157 (call-process "convert" nil nil nil
162 (file-name-sans-extension
163 (file-name-nondirectory file)) ".jpg")
169 (setq spec (car rest))
170 (when (or (> width (nth 1 spec))
171 (> height (nth 2 spec)))
172 (album-write-html html-dest-dir
174 (file-name-sans-extension
175 (file-name-nondirectory prev-file)))
176 (file-name-sans-extension
177 (file-name-nondirectory file))
179 (file-name-sans-extension
180 (file-name-nondirectory next-file)))
182 (car spec) ; (aref spec 1)
184 ;; (aref (nth 1 rest) 1)
187 lang image-url-prefix)
188 (call-process "convert" nil nil nil
189 "-resize" (format "%dx%d>" (nth 1 spec)(nth 2 spec))
193 (file-name-sans-extension
194 (file-name-nondirectory file)) ".jpg")
196 (symbol-name (car spec))
198 (setq prev-grade (car spec)))
199 (setq rest (cdr rest)))
200 (unless (file-exists-p
201 (expand-file-name "fullsize" image-dest-dir))
203 (expand-file-name "fullsize" image-dest-dir)))
204 (if (string= (downcase (file-name-extension file))
206 (call-process "ln" nil nil nil
209 (expand-file-name "fullsize" image-dest-dir))
210 (call-process "convert" nil nil nil
214 (file-name-sans-extension
215 (file-name-nondirectory file)) ".jpg")
216 (expand-file-name "fullsize" image-dest-dir))))
219 (defun album-convert-images (image-dest-dir source-images
220 &optional lang title parent-url
221 image-url-prefix html-dest-dir)
222 (unless html-dest-dir
223 (setq html-dest-dir image-dest-dir))
224 ;; (if (and (consp (car source-images))
225 ;; (null (cdr source-images)))
226 ;; (setq source-images (car source-images)))
227 (album-make-thumbnails html-dest-dir source-images
228 lang title image-url-prefix parent-url)
229 (let (file prev-file)
231 (setq file (car source-images))
232 (album-convert-image image-dest-dir
233 prev-file file (nth 1 source-images)
234 lang image-url-prefix html-dest-dir)
236 source-images (cdr source-images)))))
238 (defun album-make-thumbnails (html-dest-dir
240 lang title image-url-prefix parent-url)
243 (file-name-nondirectory
244 (if (eq (aref html-dest-dir (1- (length html-dest-dir))) ?/)
245 (substring html-dest-dir 0 (1- (length html-dest-dir)))
250 "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
251 \"http://www.w3.org/TR/html4/loose.dtd\">\n")
254 (insert (format " lang=\"%s\"" lang)))
257 (insert (format "<title>%s</title>\n" title))
260 (insert (format "<h1>%s</h1>\n" title))
265 (dolist (image-file source-images)
266 (setq file (file-name-sans-extension
267 (file-name-nondirectory image-file)))
268 (insert "<a href=\"VGA/")
271 (insert (format "<img alt=\"%s\" src=\"thumbnail/%s.jpg\">"
275 image-url-prefix grade file)
283 (insert (format "[<a href=\"%s\">Return</a>]\n" parent-url)))
289 (write-region (point-min)(point-max)
290 (expand-file-name "index.html" html-dest-dir)))))
292 (defun album-convert-directory (image-dest-dir source-dir
295 lang title parent-url
296 image-url-prefix html-dest-dir)
299 (dolist (pat patterns)
302 (directory-files source-dir 'full pat))))
304 (let (case-fold-search)
307 ".+\\.\\(tiff\\|TIFF\\|jpg\\|JPG\\|jpeg\\|JPEG\\|gif\\|GIF\\|png\\|PNG\\)$"))))
308 (album-convert-images image-dest-dir files
309 lang title parent-url
310 image-url-prefix html-dest-dir)))
312 (defun album-make-selection-1 (image-dest-dir
313 prev-file file next-file
314 lang image-url-prefix
316 &optional image-url-spec)
317 (setq file (expand-file-name file))
318 (unless html-dest-dir
319 (setq html-dest-dir image-dest-dir))
320 (let* ((specs '((QVGA 320 240)
337 (setq spec (car rest))
338 (album-write-html html-dest-dir
340 (file-name-sans-extension
341 (file-name-nondirectory prev-file)))
342 (file-name-sans-extension
343 (file-name-nondirectory file))
345 (file-name-sans-extension
346 (file-name-nondirectory next-file)))
353 (nth 1 image-url-spec)
356 (nth 2 image-url-spec))
358 (setq prev-grade (car spec))
359 (setq rest (cdr rest)))
362 (defun album-make-selection (image-dest-dir source-images
363 &optional lang title parent-url
364 image-url-prefix html-dest-dir)
365 (unless html-dest-dir
366 (setq html-dest-dir image-dest-dir))
367 ;; (album-make-thumbnails html-dest-dir source-images
368 ;; lang title image-url-prefix parent-url)
370 image-url-spec prev-file)
372 (setq image-url-spec (car source-images))
373 (setq file (format "%d" i))
374 (album-make-selection-1 image-dest-dir
375 prev-file file (if (nth 1 source-images)
376 (format "%d" (1+ i)))
377 lang image-url-prefix html-dest-dir
380 source-images (cdr source-images))
386 ;;; album.el ends here