;;; www-page.el --- Album page generator for page.cgi.
-;; Copyright (C) 2005,2006 MORIOKA Tomohiko
+;; Copyright (C) 2005,2006,2007,2009,2010 MORIOKA Tomohiko
;; Keywords: Photo, image, album, HTML, WWW
;;; Code:
+(defconst www-page-version "0.5")
+
(defvar www-page-coding-system
(if (featurep 'chise)
'utf-8-jp-er
(WUXGA 1920 1200)
(QXGA 2048 1536)
(WQXGA 2560 1600)
+ (original nil nil)
))
(defun decode-url-string (string &optional coding-system)
(concat dest (substring string i))
coding-system))))
+(defun www-page-open-dir (url-dir &optional image-root)
+ (let* ((path (expand-file-name url-dir image-root))
+ (desc-file (expand-file-name "dir.desc" path)))
+ (cons (cons 'location path)
+ (with-temp-buffer
+ (when (file-exists-p desc-file)
+ (insert-file-contents desc-file)
+ (read (current-buffer)))))))
+
+(defun www-page-directory-image-files (url-dir image-root)
+ (let (source-images)
+ (dolist (file (directory-files (expand-file-name url-dir image-root)
+ nil "\\.\\(jpg\\|JPG\\)$" nil t))
+ (unless (string-match "_[^_]+GA[^_]*$"
+ (file-name-sans-extension file))
+ (setq source-images (cons file source-images))))
+ (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
")
- (let* ((desc-file
- (expand-file-name "dir.desc"
- (expand-file-name url-dir image-root)))
- (params
- (with-temp-buffer
- (when (file-exists-p desc-file)
- (insert-file-contents desc-file)
- (read (current-buffer)))))
+ (let* ((params (www-page-open-dir url-dir image-root))
source-images ref-images
file i ref-file prev-file next-file file-desc
note)
(setq source-images (cdr source-images)))
(when (setq ref-images (assq 'refs params))
(setq ref-images (cdr ref-images)))
+ (unless (or source-images ref-images)
+ (setq source-images
+ (www-page-directory-image-files url-dir image-root)))
(when (setq note (assq 'note params))
(setq note (cdr note)))
(when (setq parent-url (assq 'exit params))
(insert "</head>\n")
(insert "<body>\n")
(insert (format "<h1>%s</h1>\n" title))
-
(insert "
<hr>
")
+ (cond
+ ((or (eq lang 'ja)
+ (string= lang "ja"))
+ (insert
+ "[Note] \e$B%5%`%M%$%k$r%/%j%C%/$9$k$HBg$-$J2hA|$,I=<($5$l$^$9\e(B
+<hr>
+")
+ )
+ (t
+ (insert (format "lang = %s<br>\n" lang))))
(dolist (image-file source-images)
(setq file (file-name-nondirectory image-file))
(insert "<a href=\"")
(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)))
(if parent-url
(insert (format "[<a href=\"%s\">Return</a>]\n" parent-url)))
+ (insert
+ (format "<hr>
+Powered by MnjAlbum WWW-Page Version %s." www-page-version))
(insert "
</body>
</html>
)))
(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
(when (file-exists-p desc-file)
(insert-file-contents desc-file)
(read (current-buffer)))))
- dir-desc-file
+ ;; dir-desc-file
image-file image-ref
prev-file next-file
prev-grade next-grade
rest spec ret)
(unless params
- (setq dir-desc-file
- (expand-file-name "dir.desc"
- (expand-file-name (file-name-directory file)
- image-root)))
+ ;; (setq dir-desc-file
+ ;; (expand-file-name "dir.desc"
+ ;; (expand-file-name (file-name-directory file)
+ ;; image-root)))
(setq params
- (with-temp-buffer
- (when (file-exists-p dir-desc-file)
- (insert-file-contents dir-desc-file)
- (read (current-buffer)))))
+ (www-page-open-dir (file-name-directory file) image-root)
+ ;; (with-temp-buffer
+ ;; (when (file-exists-p dir-desc-file)
+ ;; (insert-file-contents dir-desc-file)
+ ;; (read (current-buffer))))
+ )
(unless (assq 'refs params)
- (when (setq rest (assq 'files params))
- (setq rest (cdr rest)))
+ (if (setq rest (assq 'files params))
+ (setq rest (cdr rest))
+ (setq rest
+ (www-page-directory-image-files
+ (file-name-directory file) image-root)))
(setq ret (file-name-nondirectory file))
(while (and rest
(not (string= (car rest) ret)))
(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\">[index]</a>"
+ (insert (format "&lang=%s&size=%s&p=%s\">%s</a>"
(or lang 'en)
- size))
+ size
+ pivot-mode
+ (cond ((eq lang 'ja)
+ "[index] \e$B$KLa$k\e(B")
+ (t
+ "[index]"))))
+ (insert
+ (cond ((eq lang 'ja)
+ "\e$B!JJQ99$7$?Bg$-$5$O0];}$5$l$^$9!K\e(B")
+ (t
+ "")))
+ (insert
+ (format "<hr>
+Powered by MnjAlbum WWW-Page Version %s." www-page-version))
(insert "
</body>
</html>
(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)
+ 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 (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)))
+ (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