;;;
;;; tm-gnus4.el --- tm-gnus module for GNUS 4.*
;;;

(require 'tl-str)
(require 'tm-ognus)


;;; @ version
;;;

(defconst tm-gnus/RCS-ID
  "$Id: tm-gnus4.el,v 6.8 1995/09/05 01:10:25 morioka Exp $")

(defconst tm-gnus/version
  (concat (get-version-string tm-gnus/RCS-ID) " for GNUS 4"))


;;; @ for tm-view
;;;

(autoload 'mime/viewer-mode "tm-view" "View MIME message." t)

(defun tm-gnus/view-message (arg)
  "MIME decode and play this message."
  (interactive "P")
  (let ((gnus-break-pages nil))
    (gnus-summary-select-article t t)
    )
  (pop-to-buffer gnus-article-buffer t)
  (mime/viewer-mode)
  )

(defun tm-gnus/summary-scroll-down ()
  "Scroll down one line current article."
  (interactive)
  (gnus-summary-scroll-up -1)
  )

(defun mime-viewer/quitting-method-for-gnus4 ()
  (mime-viewer/kill-buffer)
  (delete-other-windows)
  (gnus-article-show-summary)
  (if (null gnus-have-all-headers)
      (gnus-summary-select-article nil t)
    ))

(call-after-loaded
 'tm-view
 (function
  (lambda ()
    (set-alist 'mime-viewer/quitting-method-alist
	       'gnus-article-mode
	       (function mime-viewer/quitting-method-for-gnus4))
    )))


;;; @ Summary decoding
;;;

(add-hook 'gnus-select-group-hook (function tm-gnus/decode-summary-subjects))


;;; @ set up
;;;

(define-key gnus-summary-mode-map
  "\et" (function tm-gnus/toggle-decoding-mode))
(define-key gnus-summary-mode-map "v" (function tm-gnus/view-message))
(define-key gnus-summary-mode-map
  "\e\r" (function tm-gnus/summary-scroll-down))

(fset 'gnus-article-set-mode-line 'tm-gnus/article-set-mode-line)
(add-hook 'gnus-article-mode-hook
	  (function tm-gnus/add-decoding-mode-to-mode-line))

(defun tm-gnus/decode-encoded-word-if-you-need ()
  (if (and tm-gnus/decoding-mode (not gnus-have-all-headers))
      (mime/decode-message-header)
    ))

(add-hook 'gnus-article-prepare-hook
	  (function tm-gnus/decode-encoded-word-if-you-need) t)


;;; @ for tm-comp
;;;

(defun tm-gnus4/message-before-send ()
  (let ((case-fold-search nil))
    (or (boundp 'mime/news-reply-mode-server-running)
	(make-variable-buffer-local 'mime/news-reply-mode-server-running))
    (setq mime/news-reply-mode-server-running (gnus-server-opened))
    (save-excursion
      (gnus-start-news-server)
      (widen)
      (goto-char (point-min))
      (run-hooks 'news-inews-hook)
      (save-restriction
	(narrow-to-region
	 (point-min)
	 (progn
	   (goto-char (point-min))
	   (search-forward (concat "\n" mail-header-separator "\n"))
	   (point)))
	
	(goto-char (point-min))
	(if (search-forward-regexp "^Newsgroups: +" nil t)
	    (save-restriction
	      (narrow-to-region
	       (point)
	       (if (re-search-forward "^[^ \t]" nil 'end)
		   (match-beginning 0)
		 (point-max)))
	      (goto-char (point-min))
	      (replace-regexp "\n[ \t]+" " ")
	      (goto-char (point-min))
	      (replace-regexp "[ \t\n]*,[ \t\n]*\\|[ \t]+" ",")
	      ))
	))))

(defun tm-gnus4/message-sender ()
  (interactive)
  (widen)
  (goto-char (point-min))
  (save-restriction
    (narrow-to-region
     (point-min)
     (progn
       (goto-char (point-min))
       (search-forward (concat "\n" mail-header-separator "\n"))
       (point)))
    ;; Mail the message too if To: or Cc: exists.
    (if (or (mail-fetch-field "to" nil t)
	    (mail-fetch-field "cc" nil t))
	(if gnus-mail-send-method
	    (progn
	      (message
	       (format "Sending (%d/%d) via mail..." (+ i 1) total))
	      (widen)
	      (funcall gnus-mail-send-method)
	      (message
	       (format "Sending (%d/%d) via mail... done" (+ i 1) total))
	      (ding)
	      (message
	       "No mailer defined.  To: and/or Cc: fields ignored.")
	      (sit-for 1)))))
  (message
   (format "Posting %d/%d to USENET..." (+ i 1) total))
  (if (gnus-inews-article)
      (message 
       (format "Posting %d/%d to USENET... done" (+ i 1) total))
    ;; We cannot signal an error.
    (ding)
    (message
     (format "Article %d/%d rejected: %s"
	     (+ i 1) total (gnus-status-message)))
    (sit-for 3))
  )

(defun tm-gnus4/message-after-send ()
  (or mime/news-reply-mode-server-running
      (gnus-close-server))
  (and (fboundp 'bury-buffer) (bury-buffer))
  )

(call-after-loaded
 'tm-comp
 (function
  (lambda ()
    (set-alist 'mime/message-before-send-hook-alist
	       'news-reply-mode
	       (function tm-gnus4/message-before-send))
    (set-alist 'mime/message-sender-alist
	       'news-reply-mode
	       (function tm-gnus4/message-sender))
    (set-alist 'mime/message-after-send-hook-alist
	       'news-reply-mode
	       (function tm-gnus4/message-after-send))
    )))


;;; @ end
;;;

(provide 'tm-gnus4)