;;;
;;; tm-gnus5.el --- tm-gnus module for Gnus 5.*
;;;
;;; Copyright (C) 1995 Free Software Foundation, Inc.
;;; Copyright (C) 1995 MORIOKA Tomohiko
;;;
;;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
;;; Keywords: news, MIME, multimedia, multilingual, encoded-word
;;;
;;; This file is part of tm (Tools for MIME).
;;;

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

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


;;; @ version
;;;

(defconst tm-gnus/RCS-ID
  "$Id: tm-gnus5.el,v 7.2 1995/10/05 12:57:53 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 "*"))
  )


;;; @ 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))


;;; @ for tm-view
;;;

(defun mime-viewer/quitting-method-for-gnus5 ()
  (mime-viewer/kill-buffer)
  (delete-other-windows)
  (gnus-article-show-summary)
  (gnus-summary-display-article (gnus-summary-article-number))
  )

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


;;; @ summary filter
;;;

(defun tm-gnus/decode-summary-from-and-subjects ()
  (mapcar (lambda (header)
	    (let ((from (mail-header-from header))
		  (subj (mail-header-subject header))
		  )
	      (mail-header-set-from
	       header
	       (if from
		   (mime/decode-encoded-words-string from)
		 ""))
	      (mail-header-set-subject
	       header
	       (if subj
		   (mime/decode-encoded-words-string subj)
		 ""))
	      ))
	  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 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)
		   (some-element
		    (lambda (field)
		      (rfc822/get-field-body field)
		      )
		    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
		(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))
    )))


;;; @ for mime.el
;;;

;;; by OKABE Yasuo <okabe@kudpc.kyoto-u.ac.jp>
;;;
;;; Please use following setting:
;;;	(setq gnus-mail-forward-method
;;;	      (function gnus-mail-forward-using-mhe-mime))

(defun gnus-mail-forward-using-mhe-mime (&optional buffer)
  "Forward the current message to another user using mh-e with mime-mode."
  ;; First of all, prepare mhe mail buffer.
  (let* ((to (read-string "To: "))
	 (cc (read-string "Cc: "))
	 (buffer (or buffer gnus-clean-article-buffer))
	 (config (current-window-configuration));; need to add this - erik
	 (subject (gnus-forward-make-subject buffer)))
    (setq mh-show-buffer buffer)
    (mh-find-path)
    (mh-send-sub to (or cc "") (or subject "(None)") config);; Erik Selberg 1/23/94
    (let ((draft (current-buffer))
	  (gnus-mail-buffer (current-buffer))
	  mail-buf)
      (gnus-configure-windows 'reply-yank)
      (setq mail-buf (eval (cdr (assq 'mail gnus-window-to-buffer))))
      (pop-to-buffer mail-buf);; always in the display, so won't have window probs
      (switch-to-buffer draft)
      )
    (save-excursion
      (goto-char (point-max))
      (insert (concat (mime-make-tag "message" "rfc822" nil "7bit") "\n"))
      (insert-buffer buffer)
      (setq mh-sent-from-folder buffer)
      (setq mh-sent-from-msg 1)
      (setq mh-previous-window-config config)
      (run-hooks 'gnus-mail-hook)
      )))


;;; @ end
;;;

(provide 'tm-gnus5)