;;;
;;; tm-gnus5.el --- tm-gnus module for GNUS 5.*
;;;

(require 'tl-str)
(require 'tl-list)
(require 'gnus)


;;; @ version
;;;

(defconst tm-gnus/RCS-ID
  "$Id: tm-gnus5.el,v 6.18 1995/08/31 20:19:42 morioka Exp $")

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

(defconst tm-gnus/automatic-MIME-preview-support
  (cond ((boundp 'gnus-clean-article-buffer)
	 (defconst gnus-version (concat gnus-version " with tm patch"))
	 t)
	(t
	 (defvar gnus-clean-article-buffer gnus-article-buffer)
	 nil)
	))

(defvar tm-gnus/preview-buffer
  (if tm-gnus/automatic-MIME-preview-support
      (concat "*Preview-" gnus-clean-article-buffer "*"))
  )


;;; @ autoload
;;;

(autoload 'mime/viewer-mode "tm-view" "View MIME message." t)
(autoload 'mime/decode-message-header
  "tiny-mime" "Decode MIME encoded-word." t)
(autoload 'mime/decode-string "tiny-mime" "Decode MIME encoded-word." t)


;;; @ variables
;;;

(defvar tm-gnus/original-article-display-hook gnus-article-display-hook)

(defvar tm-gnus/decode-all tm-gnus/automatic-MIME-preview-support
  "If it is non-nil and
tm-gnus/automatic-MIME-preview-support is non-nil,
article is automatic MIME decoded.")


;;; @ command functions
;;;

(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-clean-article-buffer t)
  (let (buffer-read-only)
    (if (text-property-any (point-min) (point-max) 'invisible t)
	(remove-text-properties (point-min) (point-max)
				gnus-hidden-properties)
      ))
  (mime/viewer-mode)
  )

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

(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))


;;; @ summary filter
;;;

(defun tm-gnus/decode-summary-from-and-subjects ()
  (mapcar (function
	   (lambda (header)
	     (mail-header-set-from
	      header
	      (mime/decode-string (or (mail-header-from header) ""))
	      )
	     (mail-header-set-subject
	      header
	      (mime/decode-string (or (mail-header-subject header) ""))
	      )
	     ))
	  gnus-newsgroup-headers)
  )

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


;;; @ article filter
;;;

(setq gnus-show-mime-method
	  (function
	   (lambda ()
	     (let (buffer-read-only)
	       (mime/decode-message-header)
	       ))))


;;; @ automatic MIME preview support
;;;

(defun tm-gnus/summary-toggle-header (&optional arg)
  (interactive "P")
  (if tm-gnus/decode-all
      (let ((mime-viewer/ignored-field-list
	     (if (save-window-excursion
		   (switch-to-buffer tm-gnus/preview-buffer)
		   (goto-char (point-min))
		   (message/get-field-body
		    (car mime-viewer/ignored-field-list)
		    ))
		 mime-viewer/ignored-field-list)
	     ))
	(gnus-summary-select-article t t)
	)
    (gnus-summary-toggle-header arg)
    ))

(defun tm-gnus/set-mime-method (mode)
  (if mode
      (progn
	(setq gnus-show-mime nil)
	(setq gnus-article-display-hook
	      (list (function (lambda ()
				(mime/viewer-mode)
				(gnus-set-mode-line 'article)
				))))
	(set-alist 'gnus-window-to-buffer 'article tm-gnus/preview-buffer)
	(setq gnus-article-buffer tm-gnus/preview-buffer)
	)
    (setq gnus-show-mime t)
    (setq gnus-article-display-hook tm-gnus/original-article-display-hook)
    (set-alist 'gnus-window-to-buffer 'article gnus-clean-article-buffer)
    (setq gnus-article-buffer gnus-clean-article-buffer)
    ))

(defun tm-gnus/toggle-mime (arg)
  "Toggle MIME processing mode.
With arg, turn MIME processing on if arg is positive."
  (interactive "P")
  (setq tm-gnus/decode-all
	(if (null arg)
	    (not tm-gnus/decode-all)
	  arg))
  (gnus-set-global-variables)
  (tm-gnus/set-mime-method tm-gnus/decode-all)
  (gnus-summary-select-article gnus-show-all-headers 'force)
  )

(if tm-gnus/automatic-MIME-preview-support
    (progn
      (define-key gnus-summary-mode-map
	"t" (function tm-gnus/summary-toggle-header))
      (define-key gnus-summary-mode-map "\et" (function tm-gnus/toggle-mime))
      
      (tm-gnus/set-mime-method tm-gnus/decode-all)
      
      (add-hook 'gnus-exit-gnus-hook
		(function
		 (lambda ()
		   (let ((buf (get-buffer tm-gnus/preview-buffer)))
		     (if buf
			 (kill-buffer buf)
		       )))))
      )
  (setq gnus-article-display-hook tm-gnus/original-article-display-hook)
  (setq gnus-show-mime t)
  )


;;; @ for tm-comp
;;;

(call-after-loaded
 'tm-comp
 (function
  (lambda ()
    (set-alist 'mime/message-sender-alist
	       'news-reply-mode
	       (function gnus-inews-news))
    )))


;;; @ end
;;;

(provide 'tm-gnus5)