(VGA 640 480)
(SVGA 800 600)
(XGA 1024 768)
- (WXGA 1280 768)
+ (WXGA 1280 800)
(SXGA 1280 1024)
(SXGA+ 1400 1050)
(WSXGA+ 1680 1050)
(concat dest (substring string i))
coding-system))))
-(defun www-page-display-thumbnails (url-dir &optional size image-root
+(defun www-page-display-dir (url-dir &optional size image-root
lang title parent-url)
(setq url-dir (file-name-as-directory url-dir))
+ (princ "Content-Type: text/html; charset=UTF-8
+
+")
(let* ((desc-file
(expand-file-name "dir.desc"
(expand-file-name url-dir image-root)))
(when (file-exists-p desc-file)
(insert-file-contents desc-file)
(read (current-buffer)))))
- source-images
- file
+ source-images ref-images
+ file i ref-file prev-file next-file file-desc
note)
(when (setq title (assq 'title params))
(setq title (cdr title)))
(substring url-dir 0 (1- (length url-dir))))))
(when (setq source-images (assq 'files params))
(setq source-images (cdr source-images)))
+ (when (setq ref-images (assq 'refs params))
+ (setq ref-images (cdr ref-images)))
(when (setq note (assq 'note params))
(setq note (cdr note)))
(when (setq parent-url (assq 'exit params))
(insert (format ".html.%s&size=%s\">"
(or lang 'en)
(or size 'VGA)))
- (insert (format "<img alt=\"%s\" src=\"page.cgi?%s%s&size=thumbnail\">"
+ (insert (format "<img alt=\"%s\" src=\"img.cgi?%s%s&size=thumbnail\">"
file url-dir file))
(insert "</a>\n"))
+ (setq i 1)
+ (while ref-images
+ (setq ref-file (car ref-images))
+ (setq next-file
+ (if (cdr ref-images)
+ (format "%d" (1+ i))))
+ (setq file-desc
+ (expand-file-name
+ (format "%d.desc" i)
+ (expand-file-name url-dir image-root)))
+ (unless (file-exists-p file-desc)
+ (with-temp-buffer
+ (insert "(")
+ (if prev-file
+ (insert (format "(prev-file . %S)\n " prev-file)))
+ ;; (insert (format "(ref . \"%s%s\")\n "
+ ;; url-dir ref-file))
+ (insert (format "(ref . \"%s\")\n "
+ ref-file))
+ (if next-file
+ (insert (format "(next-file . %S)\n " next-file)))
+ (insert "))\n")
+ (write-region (point-min)(point-max) file-desc)))
+ (setq file (file-name-nondirectory ref-file))
+ (insert "<a href=\"page.cgi?")
+ (insert url-dir)
+ (insert (format "%d.html.%s&size=%s\">"
+ i
+ (or lang 'en)
+ (or size 'VGA)))
+ ;; (insert (format "<img alt=\"%s\" src=\"page.cgi?%s%s&size=thumbnail\">"
+ ;; file url-dir ref-file))
+ (insert (format "<img alt=\"%s\" src=\"%s&size=thumbnail\">"
+ file ref-file))
+ (insert "</a>\n")
+ (setq prev-file (format "%d" i))
+ (setq i (1+ i)
+ ref-images (cdr ref-images)))
+
(when note
(insert "<p>")
(insert note))
</html>
")
(encode-coding-region (point-min)(point-max) www-page-coding-system)
- (princ "Content-Type: text/html; charset=UTF-8
-
-")
(princ (buffer-string))
)))
(insert-file-contents desc-file)
(read (current-buffer)))))
dir-desc-file
+ image-file image-ref
prev-file next-file
prev-grade next-grade
rest spec ret)
(when (file-exists-p dir-desc-file)
(insert-file-contents dir-desc-file)
(read (current-buffer)))))
- (when (setq rest (assq 'files params))
- (setq rest (cdr rest)))
- (setq ret (file-name-nondirectory file))
- (while (and rest
- (not (string= (car rest) ret)))
- (setq prev-file (car rest)
- rest (cdr rest)))
- (setq next-file (car (cdr rest)))
- (if prev-file
- (setq params (list (cons 'prev-file prev-file))))
- (if next-file
- (setq params (cons (cons 'next-file next-file)
- params)))
- (with-temp-buffer
- (insert (format "%S" params))
- ;; (princ "X-XEmacs-Message: ")
- (write-region (point-min)(point-max) desc-file)
- ;; (princ "\n")
- ))
+ (unless (assq 'refs params)
+ (when (setq rest (assq 'files params))
+ (setq rest (cdr rest)))
+ (setq ret (file-name-nondirectory file))
+ (while (and rest
+ (not (string= (car rest) ret)))
+ (setq prev-file (car rest)
+ rest (cdr rest)))
+ (setq next-file (car (cdr rest)))
+ (if prev-file
+ (setq params (list (cons 'prev-file prev-file))))
+ (if next-file
+ (setq params (cons (cons 'next-file next-file)
+ params)))
+ (if (file-directory-p (file-name-directory desc-file))
+ (with-temp-buffer
+ (insert (format "%S" params))
+ ;; (princ "X-XEmacs-Message: ")
+ (write-region (point-min)(point-max) desc-file)
+ ;; (princ "\n")
+ ))))
+ (if (setq image-ref (assq 'ref params))
+ (setq image-ref (cdr image-ref))
+ (setq image-file file))
(if (setq prev-file (assq 'prev-file params))
(setq prev-file (cdr prev-file)))
(if (setq next-file (assq 'next-file params))
(file-name-directory file) next-file
(or lang 'en)
size)))
- (insert (format "<img alt=\"%s\" src=\"page.cgi?%s&size=%s\">"
- file file size))
- (if next-file
- (insert "</a>"))
- (insert "
+ (if image-ref
+ (insert
+ (format "<img alt=\"%s\" src=\"%s&size=%s\">"
+ file image-ref size))
+ (if (file-exists-p (expand-file-name image-file image-root))
+ (insert
+ (format "<img alt=\"%s\" src=\"img.cgi?%s&size=%s\">"
+ file image-file size))
+ (insert "<p>")
+ (insert (format
+ (cond
+ ((eq lang 'ja)
+ "\e$B2hA|%U%!%$%k\e(B %s \e$B$,8+IU$+$j$^$;$s!#\e(B\n")
+ (t
+ "Image file %s is not found.\n"))
+ file))))
+
+ (if next-file
+ (insert "</a>"))
+ )
+ (insert "
<hr>
")
- (insert
- (format "<a href=\"page.cgi?%s&lang=%s&size=%s\">[index]</a>"
- (file-name-directory file)
- (or lang 'en)
- size))
- (insert "
+ (insert
+ (format "<a href=\"page.cgi?%s&lang=%s&size=%s\">[index]</a>"
+ (file-name-directory file)
+ (or lang 'en)
+ size))
+ (insert "
</body>
</html>
-"))
+")
(encode-coding-region (point-min)(point-max) www-page-coding-system)
(princ (buffer-string))
))
(defun www-page-display-image (file &optional size image-root)
(setq file (expand-file-name file image-root))
- (let (file-dir file-name
- resized-file resized-dir
- spec)
- (cond
- (size
- (setq file-dir (file-name-directory file)
- file-name (file-name-nondirectory file))
- (setq resized-file
- (expand-file-name
- file-name
- (setq resized-dir
- (expand-file-name
- size file-dir))))
- (unless (file-exists-p resized-file)
- (setq size (intern size))
- (if (setq spec (assq size www-page-size-specs))
- (progn
- (condition-case nil
- (unless (file-exists-p resized-dir)
- (make-directory resized-dir))
- (error nil))
- (call-process
- "convert" nil nil nil
- "-resize" (format "%dx%d>" (nth 1 spec)(nth 2 spec))
- file resized-file)
- )
- (setq resized-file file)))
- ;; (princ resized-file)
- (setq file resized-file)
- )
- (t
- ;; (princ file)
- ))
- (princ (format "Content-Type: %s"
- (with-temp-buffer
- (call-process
- "file"
- nil t t
- "-b" "--mime" file)
- (insert "\n")
- (let ((coding-system-for-read 'binary)
- (coding-system-for-write 'binary))
- (insert-file-contents-literally file))
- (buffer-string))))))
+ (when (file-exists-p file)
+ (let (file-dir file-name
+ resized-file resized-dir
+ spec)
+ (cond
+ (size
+ (setq file-dir (file-name-directory file)
+ file-name (file-name-nondirectory file))
+ (setq resized-file
+ (expand-file-name
+ file-name
+ (setq resized-dir
+ (expand-file-name
+ size file-dir))))
+ (unless (file-exists-p resized-file)
+ (setq size (intern size))
+ (if (setq spec (assq size www-page-size-specs))
+ (progn
+ (condition-case nil
+ (unless (file-exists-p resized-dir)
+ (make-directory resized-dir))
+ (error nil))
+ (call-process
+ "convert" nil nil nil
+ "-resize" (format "%dx%d>" (nth 1 spec)(nth 2 spec))
+ file resized-file)
+ )
+ (setq resized-file file)))
+ ;; (princ resized-file)
+ (setq file resized-file)
+ )
+ (t
+ ;; (princ file)
+ ))
+ (princ (format "Content-Type: %s"
+ (with-temp-buffer
+ (call-process
+ "file"
+ nil t t
+ "-b" "--mime" file)
+ (insert "\n")
+ (let ((coding-system-for-read 'binary)
+ (coding-system-for-write 'binary))
+ (insert-file-contents-literally file))
+ (buffer-string)))))))
(defun www-page-batch-get ()
;; (set-coding-priority-list
default-directory)))
(setq command-line-args-left (cdr command-line-args-left))
(cond ((eq method 'dir)
- (www-page-display-thumbnails target size image-root lang)
+ (www-page-display-dir target size image-root lang)
)
((eq method 'page)
(www-page-display-page target size image-root lang)
projects / elisp / album.git / blobdiff