(album-write-html): Change order of argument.
authortomo <tomo>
Thu, 21 Apr 2005 15:10:19 +0000 (15:10 +0000)
committertomo <tomo>
Thu, 21 Apr 2005 15:10:19 +0000 (15:10 +0000)
(album-convert-image): Likewise; add QVGA grade.
(album-convert-images): Change order of argument; don't use &rest for
`source-images'; change arguments `image-url-prefix', `html-dest-dir'
and `lang' to optional; add new optional arguments `title' and
`parent-url'.
(album-make-thumbnails): Change order of argument; add new optional
arguments `title' and `parent-url'.
(album-convert-directory): Change order of argument; use &optional
instead of &rest for `patterns'; change arguments `image-url-prefix',
`html-dest-dir' and `lang' to optional; add new optional arguments
`title' and `parent-url'.

album.el

index 4ab34eb..caa2201 100644 (file)
--- a/album.el
+++ b/album.el
              (/ (* width percent) 100.0)
              (/ (* height percent) 100.0)))))
 
-(defun album-write-html (dest-dir lang image-url-prefix
+(defun album-write-html (dest-dir
                         prev-file file next-file
-                        prev-grade grade next-grade)
+                        prev-grade grade next-grade
+                        lang image-url-prefix)
   (with-temp-buffer
     (insert
      "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
                   (expand-file-name (symbol-name grade)
                                     dest-dir)))))
 
-(defun album-convert-image (image-dest-dir html-dest-dir lang
-                                          image-url-prefix
-                                          prev-file file next-file)
+(defun album-convert-image (image-dest-dir
+                           prev-file file next-file
+                           lang image-url-prefix
+                           html-dest-dir)
   (setq file (expand-file-name file))
   (unless html-dest-dir
     (setq html-dest-dir image-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 320 'QVGA))
+            (setq dest (cons ret dest)))
           (when (setq ret (album-make-spec-by-width width 160 'thumbnail))
             (setq dest (cons ret dest)))
           )
             (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 240 'QVGA))
+            (setq dest (cons ret dest)))
           (when (setq ret (album-make-spec-by-height height 160 'thumbnail))
             (setq dest (cons ret dest)))
           ))
     (setq rest (cdr dest))
     (while rest
       (setq spec (car rest))
-      (album-write-html html-dest-dir lang image-url-prefix
+      (album-write-html html-dest-dir
                        (if prev-file
                            (file-name-sans-extension
                             (file-name-nondirectory prev-file)))
                        prev-grade
                        (aref spec 1)
                        (if (nth 1 rest)
-                           (aref (nth 1 rest) 1)))
+                           (aref (nth 1 rest) 1))
+                       lang image-url-prefix)
       (call-process "convert" nil nil nil
                    "-resize" (format "%d%%" (aref spec 0))
                    file
                     (expand-file-name "fullsize" image-dest-dir))))
     dest))
 
-(defun album-convert-images (image-dest-dir html-dest-dir lang
-                                           image-url-prefix
-                                           &rest source-images)
+(defun album-convert-images (image-dest-dir source-images
+                            &optional lang title parent-url
+                            image-url-prefix html-dest-dir)
   (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)
+  ;; (if (and (consp (car source-images))
+  ;;          (null (cdr source-images)))
+  ;;     (setq source-images (car source-images)))
+  (album-make-thumbnails html-dest-dir source-images
+                        lang title image-url-prefix parent-url)
   (let (file prev-file)
     (while source-images
       (setq file (car source-images))
-      (album-convert-image image-dest-dir html-dest-dir lang
-                          image-url-prefix
-                          prev-file file (nth 1 source-images))
+      (album-convert-image image-dest-dir
+                          prev-file file (nth 1 source-images)
+                          lang image-url-prefix html-dest-dir)
       (setq prev-file file
            source-images (cdr source-images)))))
 
-(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)
+(defun album-make-thumbnails (html-dest-dir
+                             source-images
+                             lang title image-url-prefix parent-url)
+  (unless title
+    (setq title
+         (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))))
+  (let (file)
     (with-temp-buffer
       (insert
        "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
          (insert (format " lang=\"%s\"" lang)))
       (insert ">\n")
       (insert "<head>\n")
-      (insert (format "<title>%s</title>\n" album))
+      (insert (format "<title>%s</title>\n" title))
       (insert "</head>\n")
       (insert "<body>\n")
-      (insert (format "<h1>%s</h1>\n" album))
+      (insert (format "<h1>%s</h1>\n" title))
 
     (insert "
 <hr>
     (insert "
 
 <hr>
+")
+    (if parent-url
+       (insert (format "[<a href=\"%s\">Return</a>]\n" parent-url)))
 
+    (insert "
 </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)
+(defun album-convert-directory (image-dest-dir source-dir
+                               &optional
+                               patterns
+                               lang title parent-url
+                               image-url-prefix html-dest-dir)
   (let (files)
     (if patterns
        (dolist (pat patterns)
            (let (case-fold-search)
              (directory-files
               source-dir 'full
-              ".+\\.\\(tiff\\|jpg\\|JPG\\|jpeg\\|gif\\|png\\)$"))))
-    (album-convert-images image-dest-dir html-dest-dir lang
-                         image-url-prefix files)))
+              ".+\\.\\(tiff\\|TIFF\\|jpg\\|JPG\\|jpeg\\|JPEG\\|gif\\|GIF\\|png\\|PNG\\)$"))))
+    (album-convert-images image-dest-dir files
+                         lang title parent-url
+                         image-url-prefix html-dest-dir)))
 
 
 (provide 'album)