;;; -*- Emacs-Lisp -*- ;;; An interface to img2www script ;;; (c)1999, 2002, 2005 HIROSE Yuuji [yuuji@gentei.org] ;;; Last modified Mon Feb 25 06:30:06 2008 on firestorm ;;; Update count: 64 (defvar img2www:command "img2www") (defvar img2www:tmpindex "idx--" "吐き出し用に使うINDEXファイル名") (defvar img2www:begin nil "挿入位置") (defvar img2www:end nil "置換時の終了位置") (defvar img2www:default-background "white" "デフォルトのbgcolor") (defvar img2www:default-option "" "bgカラー以外のデフォルトオプション") (defvar img2www:current-buffer nil "処理を起動したバッファ") (defun img2www*filter (proc mes) "プロセスフィルタ" (if (and (stringp mes) (string-match "mini=\\([^,]+\\)," mes)) (let ((base (substring mes (match-beginning 1) (match-end 1)))) (message "処理中: %s" base)))) (defun img2www*sentinel (proc state) "終了通知" (cond ((string-match "^finished" state) (set-buffer img2www:current-buffer) (save-excursion (goto-char img2www:begin) (if img2www:end (delete-region (point) img2www:end)) (insert-file-contents img2www:tmpindex nil 1) (delete-file img2www:tmpindex) (set-marker img2www:begin nil) (if img2www:end (set-marker img2www:end nil)) (message "Done."))))) (defun img2www*current-bg () (save-excursion (goto-char (point-min)) (if (re-search-forward "bgcolor\\s *=\\s *\\(\"?\\)\\([A-Za-z#0-9]+\\)\\(\\1?\\)" nil t) (buffer-substring (match-beginning 2) (match-end 2)) img2www:default-background))) (defvar img2www:pop-window-height 10 "*POP up window's height") (defun img2www*pop-to-buffer (buffer) "Pop up BUFFER according to img2www:pop-window-height" (let ((sw (selected-window)) (height img2www:pop-window-height) (op (one-window-p t)) w) (if op (split-window (selected-window) (max (min (- (frame-height) (if (numberp height) (+ height 2) (/ (* (frame-height) (string-to-int height)) 100))) (- (frame-height) window-min-height 1)) window-min-height))) (select-window (next-window)) (switch-to-buffer buffer))) (defun img2www (arg) "ポイント位置にimg2wwwからのHTMLを挿入。 \\[universal-argument] を付けると現在のリジョンをimg2www出力で置換" (interactive "P") (if arg (setq img2www:begin (copy-marker (region-beginning)) img2www:end (copy-marker (region-end))) (setq img2www:begin (point-marker) img2www:end nil)) (setq img2www:current-buffer (current-buffer)) (let ((buf (get-buffer-create " *img2wwwtmp*")) (bg (img2www*current-bg)) other str jpgs (dir default-directory)) (setq other (read-string "img2www のオプション: " (concat "-bg " bg " " img2www:default-option))) (setq jpgs (read-string "処理対象: " "*jpg")) (save-excursion (find-file img2www:tmpindex) (setq buffer-read-only nil) (erase-buffer) (insert "\n") (basic-save-buffer) (kill-buffer nil)) (set-buffer buf) (cd dir) (setq default-directory dir) (setq buffer-read-only nil) (erase-buffer) (setq str (concat img2www:command " -ix " img2www:tmpindex " " other " " jpgs)) (set-process-filter (start-process "img2www" (current-buffer) shell-file-name shell-command-switch str) 'img2www*filter) (set-process-sentinel (get-buffer-process (current-buffer)) 'img2www*sentinel) (message "Staring [%s]" str))) (defvar img2www:tmpdir nil "Temporary directory for thumbnail images") (defvar img2www:convert-resize "convert -geometry" "*Convert command line for resizing") (defvar img2www:thumbnail-geometry "320x240" "*Thumbnail image geometry like XxY") (defvar img2www:fit-to-thumbnail-heigt t "*Non-nil means fit window height to thumbnail image") (defun img2www*thumbnail-image (file &optional reload) (interactive "f") (or img2www:tmpdir (set (make-local-variable 'img2www:tmpdir) (make-temp-name (format "/tmp/%s-img2www/" (user-login-name))))) (let*((buf "*img2www thumbnail*") (size img2www:thumbnail-geometry) (tmpdir img2www:tmpdir) (base (file-name-nondirectory file)) (tn (format "%s/tn_%s" tmpdir base)) data image (w (selected-window)) (process-coding-system-alist (cons (cons "." (cons 'no-conversion 'no-conversion)) process-coding-system-alist))) (make-directory tmpdir t) (if (and (file-exists-p tn) (null arg)) nil (message "Call convert...") (call-process shell-file-name nil ;INFILE t ;current-buffer nil ;no-display shell-command-switch (format "%s %s %s %s 2> /dev/null" img2www:convert-resize size file tn)) (message "Call convert...Done")) (unwind-protect (cond ((fboundp 'create-image) (setq image (create-image tn 'jpeg nil)) (img2www*pop-to-buffer buf) (buffer-disable-undo) (erase-buffer) (insert-image image) (add-text-properties (point-min) (point-max) '(invisible t)) (enlarge-window (- (ceiling (cdr (image-size image))) (window-height))) (select-window w)) (t (start-process "*img2www*preview*" buf shell-file-name shell-command-switch (format "display %s" tn)))) (or (member 'img2www*remove-thumbnails kill-buffer-hook) (set (make-local-variable 'kill-buffer-hook) (cons 'img2www*remove-thumbnails kill-buffer-hook)))))) (defun img2www*remove-thumbnails () (if (and img2www:tmpdir (file-exists-p img2www:tmpdir)) (let ((files (directory-files img2www:tmpdir nil "^tn_"))) (while files (delete-file (expand-file-name (car files) img2www:tmpdir)) (setq files (cdr files)))))) (defun img2www-check-this-image (arg) (interactive "P") (save-excursion (beginning-of-line) (let ((f (buffer-substring (point) (progn (skip-chars-forward "^ ,\t\n") (point))))) (if (file-exists-p f) (img2www*thumbnail-image f arg))))) (defun img2www-create-index (&optional noask) "Create current directory's index.html by calling img2www script. If optional argument NOASK is non-nil, do not ask thumbnail removal." (interactive "P") (let ((buf (get-buffer-create " *img2wwwtmp*")) (bg (img2www*current-bg)) (sw (selected-window)) other str jpgs (dir default-directory) proc) (setq other (read-string "img2www のオプション: " (concat "-bg " bg " " img2www:default-option))) (setq jpgs (read-string "処理対象: " "*jpg")) (let ((thumbs (directory-files "" nil "^tn_"))) (if thumbs (if (or noask (y-or-n-p "サムネイルファイルを消去しますか?")) (while thumbs (delete-file (car thumbs)) (setq thumbs (cdr thumbs)))))) (save-excursion (img2www*pop-to-buffer buf) (buffer-disable-undo) (erase-buffer) (save-excursion (insert " ")) (cd (setq default-directory dir)) (set-process-coding-system (setq proc (start-process "*img2www*" (current-buffer) shell-file-name shell-command-switch (format "%s %s %s %s" img2www:command img2www:default-option other jpgs))) 'euc-jp 'euc-jp) (set-marker (process-mark proc) (point-min))) (select-window sw))) (defvar img2www-mode-map nil "Keymap used in img2www-mode") (defvar img2www-mode-prefix-key "\C-c" "Prefix key-stroke of img2www-mode keymap") (defun img2www*define-key (key func) "Define key for img2www-mode" (define-key img2www-mode-map (concat img2www-mode-prefix-key key) func)) (if img2www-mode-map nil (setq img2www-mode-map (copy-keymap text-mode-map)) (img2www*define-key "\C-g" 'img2www-check-this-image) (img2www*define-key "\C-c" 'img2www-create-index)) (defun img2www-mode () "Major mode for editing img2www.txt image description file" (interactive) (setq major-mode 'img2www-mode mode-name "img2www") (use-local-map img2www-mode-map) (run-hooks 'img2www-mode-hook)) (run-hooks 'img2www-load-hook) (provide 'img2www)