;;; www-page.el --- Album page generator for page.cgi.
-;; Copyright (C) 2005,2006,2007 MORIOKA Tomohiko
+;; Copyright (C) 2005,2006,2007,2009,2010 MORIOKA Tomohiko
;; Keywords: Photo, image, album, HTML, WWW
;;; Code:
-(defconst www-page-version "0.3")
+(defconst www-page-version "0.5")
(defvar www-page-coding-system
(if (featurep 'chise)
(nreverse source-images)))
(defun www-page-display-dir (url-dir &optional size image-root
- lang title parent-url hide-cgi)
+ lang title parent-url hide-cgi
+ pivot-mode)
(setq url-dir (file-name-as-directory url-dir))
(princ "Content-Type: text/html; charset=UTF-8
(insert url-dir)
)
(insert file)
- (insert (format ".html.%s&size=%s\">"
+ (insert (format ".html.%s&size=%s&p=%s\">"
(or lang 'en)
- (or size 'VGA)))
+ (or size 'VGA)
+ (or pivot-mode t)))
(insert (format "<img alt=\"%s\" src=\"" file))
(unless hide-cgi
(insert (format "img.cgi?%s" url-dir)))
)))
(defun www-page-display-page (file &optional size image-root
- lang prev-file next-file hide-cgi)
+ lang prev-file next-file hide-cgi
+ pivot-mode)
(if (stringp size)
(setq size (intern size)))
+ (if (stringp pivot-mode)
+ (setq pivot-mode (intern pivot-mode)))
(if (stringp lang)
(setq lang (intern lang)))
(princ "Content-Type: text/html; charset=UTF-8
(insert "<a href=\"")
(unless hide-cgi
(insert (format "page.cgi?%s" (file-name-directory file))))
- (insert (format "%s.html.%s&size=%s\">"
+ (insert (format "%s.html.%s&size=%s&p=%s\">"
prev-file
(or lang 'en)
- size))
+ size
+ pivot-mode))
)
(cond ((eq lang 'ja)
(insert "[\e$BA0\e(B]")
(insert "<a href=\"")
(unless hide-cgi
(insert (format "page.cgi?%s" (file-name-directory file))))
- (insert (format "%s.html.%s&size=%s\">"
+ (insert (format "%s.html.%s&size=%s&p=%s\">"
next-file
(or lang 'en)
- size))
+ size
+ pivot-mode))
)
(cond ((eq lang 'ja)
(insert "[\e$B<!\e(B]")
(insert "<a href=\"")
(unless hide-cgi
(insert (format "page.cgi?%s" (file-name-directory file))))
- (insert (format "%s.html.%s&size=%s\">"
+ (insert (format "%s.html.%s&size=%s&p=%s\">"
(file-name-nondirectory file)
(or lang 'en)
- prev-grade))
+ prev-grade
+ pivot-mode))
)
(cond ((eq lang 'ja)
(insert "[\e$B=L>.\e(B]")
(insert "<a href=\"")
(unless hide-cgi
(insert (format "page.cgi?%s" (file-name-directory file))))
- (insert (format "%s.html.%s&size=%s\">"
+ (insert (format "%s.html.%s&size=%s&p=%s\">"
(file-name-nondirectory file)
(or lang 'en)
- next-grade))
+ next-grade
+ pivot-mode))
)
(cond ((eq lang 'ja)
(insert "[\e$B3HBg\e(B]")
(insert "<a href=\"")
(unless hide-cgi
(insert (format "page.cgi?%s" (file-name-directory file))))
- (insert (format "%s.html.%s&size=%s\">"
+ (insert (format "%s.html.%s&size=%s&p=%s\">"
next-file
(or lang 'en)
- size))
+ size
+ pivot-mode))
)
(cond
(image-ref
(insert
- (format "<img alt=\"%s\" src=\"%s&size=%s\">"
- file image-ref size))
+ (format "<img alt=\"%s\" src=\"%s&size=%s&p=%s\">"
+ file image-ref size pivot-mode))
)
(t ; (file-exists-p (expand-file-name image-file image-root))
(insert (format "<img alt=\"%s\" src=\"" file))
(unless hide-cgi
(insert (format "img.cgi?%s" (file-name-directory image-file))))
- (insert (format "%s&size=%s\">"
- (file-name-nondirectory image-file) size))
+ (insert (format "%s&size=%s&p=%s\">"
+ (file-name-nondirectory image-file)
+ size pivot-mode))
)
(t
(insert "<p>")
(insert "<a href=\"")
(unless hide-cgi
(insert (format "page.cgi?%s" (file-name-directory file))))
- (insert (format "&lang=%s&size=%s\">%s</a>"
+ (insert (format "&lang=%s&size=%s&p=%s\">%s</a>"
(or lang 'en)
size
+ pivot-mode
(cond ((eq lang 'ja)
"[index] \e$B$KLa$k\e(B")
(t
(princ (buffer-string))
))
-(defun www-page-display-image (file &optional size image-root)
+(defun www-page-display-image (file &optional size image-root pivot-mode)
+ (if (stringp pivot-mode)
+ (setq pivot-mode (intern pivot-mode)))
(setq file (expand-file-name file image-root))
(when (file-exists-p file)
(let (file-dir file-name
resized-file resized-dir
- spec width height)
+ spec width height
+ orig-width orig-height
+ size-opt)
+ (setq size (intern size))
(cond
- (size
+ ((and size
+ (setq spec (assq size www-page-size-specs))
+ (setq width (nth 1 spec))
+ (setq height (nth 2 spec)))
(setq file-dir (file-name-directory file)
file-name (file-name-nondirectory file))
+ (setq size-opt
+ (or (when (and (eq pivot-mode t)
+ (> width height))
+ (with-temp-buffer
+ (call-process "identify" nil t nil file)
+ (goto-char (point-min))
+ (if (re-search-forward
+ "^[^ ]+ [^ ]+ \\([0-9]+\\)x\\([0-9]+\\) " nil t)
+ (setq orig-width (string-to-int
+ (match-string 1))
+ orig-height (string-to-int
+ (match-string 2)))))
+ (if (> orig-height orig-width)
+ 'p))
+ ""))
(setq resized-file
- (expand-file-name
- file-name
- (setq resized-dir
- (expand-file-name
- size file-dir))))
+ (format "%s_%s%s.%s"
+ (file-name-sans-extension file)
+ size size-opt
+ (file-name-extension file)))
(unless (file-exists-p resized-file)
- (setq size (intern size))
- (if (and (setq spec (assq size www-page-size-specs))
- (setq width (nth 1 spec))
- (setq height (nth 2 spec)))
- (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>" width height)
- file resized-file)
- )
- (setq resized-file file)))
+ (setq resized-file
+ (expand-file-name
+ file-name
+ (setq resized-dir
+ (expand-file-name
+ (format "%s%s" size size-opt)
+ file-dir))))
+ (unless (file-exists-p resized-file)
+ (condition-case nil
+ (unless (file-exists-p resized-dir)
+ (make-directory resized-dir))
+ (error nil))
+ (call-process
+ "convert" nil nil nil
+ "-resize"
+ (if (eq size-opt 'p)
+ (format "%dx%d>" height width)
+ (format "%dx%d>" width height))
+ file resized-file)))
;; (princ resized-file)
(setq file resized-file)
)
;; '(iso-7 iso-8-2 utf-8 big5 shift-jis
;; iso-8-designate iso-8-1 iso-lock-shift no-conversion))
;; (set-coding-category-system 'utf-8 'utf-8-jp)
- (let (target params method size key image-root lang ret hide-cgi)
+ (let (target params method size pivot-mode key image-root lang ret hide-cgi)
(let ((rest (car command-line-args-left))
arg val)
(if rest
(null (file-name-extension target)))
'dir)))
;; (setq file (car (cdr (assoc "file" params))))
- (setq size (car (cdr (assoc "size" params))))
+ (setq size (or (car (cdr (assoc "size" params)))
+ 'VGA))
+ (setq pivot-mode t)
+ (if (setq ret (cdr (assoc "p" params)))
+ (setq pivot-mode (car ret)))
(if (setq ret (cdr (assoc "lang" params)))
(setq lang (car ret)))
(setq command-line-args-left (cdr command-line-args-left))
(setq command-line-args-left (cdr command-line-args-left))
(cond ((eq method 'dir)
(www-page-display-dir target size image-root lang
- nil nil hide-cgi)
+ nil nil hide-cgi pivot-mode)
)
((eq method 'page)
(www-page-display-page target size image-root lang
- nil nil hide-cgi)
+ nil nil hide-cgi pivot-mode)
)
(t
- (www-page-display-image target size image-root)
+ (www-page-display-image target size image-root pivot-mode)
)
)))
projects / elisp / album.git / blobdiff