From 2a125af3fd43d24fddb0bd97b974146d31d071ba Mon Sep 17 00:00:00 2001 From: tomo Date: Sun, 21 Oct 2007 02:04:23 +0000 Subject: [PATCH] (www-page-version): Update to 0.4. (www-page-display-dir): Add new optional argument `pivot-mode'. (www-page-display-page): Likewise. (www-page-display-image): Likewise. (www-page-batch-get): Support `pivot-mode'. --- www-page.el | 133 ++++++++++++++++++++++++++++++++++++++--------------------- 1 file changed, 86 insertions(+), 47 deletions(-) diff --git a/www-page.el b/www-page.el index c3cc4f1..2c50727 100644 --- a/www-page.el +++ b/www-page.el @@ -27,7 +27,7 @@ ;;; Code: -(defconst www-page-version "0.3") +(defconst www-page-version "0.4") (defvar www-page-coding-system (if (featurep 'chise) @@ -88,7 +88,8 @@ (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 @@ -148,9 +149,10 @@ (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 "\"%s\"" + (insert (format "%s.html.%s&size=%s&p=%s\">" prev-file (or lang 'en) - size)) + size + pivot-mode)) ) (cond ((eq lang 'ja) (insert "[前]") @@ -329,10 +335,11 @@ Powered by MnjAlbum WWW-Page Version %s." www-page-version)) (insert "" + (insert (format "%s.html.%s&size=%s&p=%s\">" next-file (or lang 'en) - size)) + size + pivot-mode)) ) (cond ((eq lang 'ja) (insert "[次]") @@ -348,10 +355,11 @@ Powered by MnjAlbum WWW-Page Version %s." www-page-version)) (insert "" + (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 "[縮小]") @@ -367,10 +375,11 @@ Powered by MnjAlbum WWW-Page Version %s." www-page-version)) (insert "" + (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 "[拡大]") @@ -389,23 +398,25 @@ Powered by MnjAlbum WWW-Page Version %s." www-page-version)) (insert "" + (insert (format "%s.html.%s&size=%s&p=%s\">" next-file (or lang 'en) - size)) + size + pivot-mode)) ) (cond (image-ref (insert - (format "\"%s\"" - file image-ref size)) + (format "\"%s\"" + file image-ref size pivot-mode)) ) (t ; (file-exists-p (expand-file-name image-file image-root)) (insert (format "\"%s\"" - (file-name-nondirectory image-file) size)) + (insert (format "%s&size=%s&p=%s\">" + (file-name-nondirectory image-file) + size pivot-mode)) ) (t (insert "

") @@ -432,9 +443,10 @@ Powered by MnjAlbum WWW-Page Version %s." www-page-version)) (insert "%s" + (insert (format "&lang=%s&size=%s&p=%s\">%s" (or lang 'en) size + pivot-mode (cond ((eq lang 'ja) "[index] に戻る") (t @@ -455,38 +467,62 @@ Powered by MnjAlbum WWW-Page Version %s." www-page-version)) (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) (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 pivot-mode + (> 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) ) @@ -510,7 +546,7 @@ Powered by MnjAlbum WWW-Page Version %s." www-page-version)) ;; '(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 @@ -546,6 +582,9 @@ Powered by MnjAlbum WWW-Page Version %s." www-page-version)) 'dir))) ;; (setq file (car (cdr (assoc "file" params)))) (setq size (car (cdr (assoc "size" params)))) + (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)) @@ -558,14 +597,14 @@ Powered by MnjAlbum WWW-Page Version %s." www-page-version)) (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) ) ))) -- 1.7.10.4