(album-write-html): Add new argument `lang'; add link for
authortomo <tomo>
Tue, 19 Apr 2005 05:43:34 +0000 (05:43 +0000)
committertomo <tomo>
Tue, 19 Apr 2005 05:43:34 +0000 (05:43 +0000)
"../index.html".
(album-convert-image): Add new argument `lang'; generate thumbnail
images.
(album-convert-images): Add new argument `lang'; call
`album-make-thumbnails'.
(album-make-thumbnails): New function.
(album-convert-directory): Add new argument `lang'.

album.el

index 529c188..4ab34eb 100644 (file)
--- a/album.el
+++ b/album.el
              (/ (* width percent) 100.0)
              (/ (* height percent) 100.0)))))
 
-(defun album-write-html (dest-dir image-url-prefix
+(defun album-write-html (dest-dir lang image-url-prefix
                         prev-file file next-file
                         prev-grade grade next-grade)
   (with-temp-buffer
     (insert
      "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
             \"http://www.w3.org/TR/html4/loose.dtd\">\n")
+    (insert "<html")
+    (if lang
+       (insert (format " lang=\"%s\"" lang)))
+    (insert " />\n")
     (insert "<head>\n")
     (insert (format "<title>%s</title>\n" file))
     (insert "</head>\n")
 
 <hr>
 
+<a href=\"../index.html\">[index]</a>
+
 </body>
 </html>
 ")
                   (expand-file-name (symbol-name grade)
                                     dest-dir)))))
 
-(defun album-convert-image (image-dest-dir html-dest-dir image-url-prefix
+(defun album-convert-image (image-dest-dir html-dest-dir lang
+                                          image-url-prefix
                                           prev-file file next-file)
   (setq file (expand-file-name file))
   (unless html-dest-dir
             (setq dest (cons ret dest)))
           (when (setq ret (album-make-spec-by-width width 640 'VGA))
             (setq dest (cons ret dest)))
+          (when (setq ret (album-make-spec-by-width width 160 'thumbnail))
+            (setq dest (cons ret dest)))
           )
          (t
           (when (setq ret (album-make-spec-by-height height 1536 'QXGA))
             (setq dest (cons ret dest)))
           (when (setq ret (album-make-spec-by-height height 480 'VGA))
             (setq dest (cons ret dest)))
+          (when (setq ret (album-make-spec-by-height height 160 'thumbnail))
+            (setq dest (cons ret dest)))
           ))
-    (setq rest dest)
+    (unless (file-exists-p
+            (expand-file-name "thumbnail" image-dest-dir))
+      (make-directory
+       (expand-file-name "thumbnail" image-dest-dir)))
+    (call-process "convert" nil nil nil
+                 "-resize" (format "%d%%" (aref (car dest) 0))
+                 file
+                 (expand-file-name
+                  (concat
+                   (file-name-sans-extension
+                    (file-name-nondirectory file)) ".jpg")
+                  (expand-file-name
+                   "thumbnail"
+                   image-dest-dir)))
+    (setq rest (cdr dest))
     (while rest
       (setq spec (car rest))
-      (album-write-html html-dest-dir image-url-prefix
+      (album-write-html html-dest-dir lang image-url-prefix
                        (if prev-file
                            (file-name-sans-extension
                             (file-name-nondirectory prev-file)))
                     (expand-file-name "fullsize" image-dest-dir))))
     dest))
 
-(defun album-convert-images (image-dest-dir html-dest-dir
+(defun album-convert-images (image-dest-dir html-dest-dir lang
                                            image-url-prefix
                                            &rest source-images)
+  (unless html-dest-dir
+    (setq html-dest-dir image-dest-dir))
   (if (and (consp (car source-images))
           (null (cdr source-images)))
       (setq source-images (car source-images)))
+  (album-make-thumbnails html-dest-dir lang image-url-prefix
+                        source-images)
   (let (file prev-file)
     (while source-images
       (setq file (car source-images))
-      (album-convert-image image-dest-dir html-dest-dir
+      (album-convert-image image-dest-dir html-dest-dir lang
                           image-url-prefix
                           prev-file file (nth 1 source-images))
       (setq prev-file file
            source-images (cdr source-images)))))
 
-(defun album-convert-directory (image-dest-dir html-dest-dir
+(defun album-make-thumbnails (html-dest-dir lang image-url-prefix
+                                           source-images)
+  (let ((album
+        (file-name-nondirectory
+         (if (eq (aref html-dest-dir (1- (length html-dest-dir))) ?/)
+             (substring html-dest-dir 0 (1- (length html-dest-dir)))
+           html-dest-dir)))
+       file)
+    (with-temp-buffer
+      (insert
+       "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
+            \"http://www.w3.org/TR/html4/loose.dtd\">\n")
+      (insert "<html")
+      (if lang
+         (insert (format " lang=\"%s\"" lang)))
+      (insert ">\n")
+      (insert "<head>\n")
+      (insert (format "<title>%s</title>\n" album))
+      (insert "</head>\n")
+      (insert "<body>\n")
+      (insert (format "<h1>%s</h1>\n" album))
+
+    (insert "
+<hr>
+")
+    (dolist (image-file source-images)
+      (setq file (file-name-sans-extension
+                 (file-name-nondirectory image-file)))
+      (insert "<a href=\"VGA/")
+      (insert file)
+      (insert ".html\">")
+      (insert (format "<img alt=\"%s\" src=\"thumbnail/%s.jpg\">"
+                     file
+                     (if image-url-prefix
+                         (format "%s/%s/%s"
+                                 image-url-prefix grade file)
+                       file)))
+      (insert "</a>\n"))
+    (insert "
+
+<hr>
+
+</body>
+</html>
+")
+    (write-region (point-min)(point-max)
+                 (expand-file-name "index.html" html-dest-dir)))))
+
+(defun album-convert-directory (image-dest-dir html-dest-dir lang
                                               image-url-prefix
                                               source-dir &rest patterns)
   (let (files)
              (directory-files
               source-dir 'full
               ".+\\.\\(tiff\\|jpg\\|JPG\\|jpeg\\|gif\\|png\\)$"))))
-    (album-convert-images image-dest-dir html-dest-dir
+    (album-convert-images image-dest-dir html-dest-dir lang
                          image-url-prefix files)))