;;; -*- Emacs-Lisp -*-
;;; An interface to img2www script
;;; (c)1999, 2002, 2005, 2017 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-number 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)