;;;
;;; 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)
(require 'tm-view)


;;; @ version
;;;

(defconst tm-gnus/RCS-ID
  "$Id: tm-gnus5.el,v 7.9 1995/11/15 10:41:02 morioka Exp $")

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


;;; @ variables
;;;

(defvar tm-gnus/original-article-buffer " *Original Article*")

(defvar tm-gnus/automatic-mime-preview t
  "*If non-nil, show MIME processed article.
This variable is set to `gnus-show-mime'.")

(setq gnus-show-mime tm-gnus/automatic-mime-preview)


;;; @ command functions
;;;

(defun tm-gnus/view-message (arg)
  "MIME decode and play this message."
  (interactive "P")
  (if (save-excursion
	(set-buffer gnus-article-buffer)
	(eq major-mode 'mime/viewer-mode)
	)
      (pop-to-buffer gnus-article-buffer t)
    (let ((gnus-break-pages nil))
      (gnus-summary-select-article t t)
      )
    (pop-to-buffer gnus-article-buffer t)
    (let (buffer-read-only)
      (remove-text-properties (point-min) (point-max) '(face nil))
      (if (get-buffer tm-gnus/original-article-buffer)
	    (kill-buffer tm-gnus/original-article-buffer)
	  )
      (rename-buffer tm-gnus/original-article-buffer)
      (mime/viewer-mode nil nil nil
			tm-gnus/original-article-buffer
			gnus-article-buffer)
      ))
  )

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

(defun tm-gnus/summary-toggle-header (&optional arg)
  (interactive "P")
  (if (and gnus-show-mime
	   (or (not gnus-strict-mime)
	       (save-excursion
		 (set-buffer gnus-article-buffer)
		 (gnus-fetch-field "Mime-Version")
		 )))
      (let ((mime-viewer/ignored-field-regexp
	     (if (save-excursion
		   (set-buffer gnus-article-buffer)
		   (some-element
		    (lambda (field)
		      (rfc822/get-field-body field)
		      )
		    mime-viewer/ignored-field-list))
		 mime-viewer/ignored-field-regexp
	       "^:$")))
	(gnus-summary-select-article t t)
	)
    (gnus-summary-toggle-header arg)
    ))

(define-key gnus-summary-mode-map "v" (function tm-gnus/view-message))
(define-key gnus-summary-mode-map "t" (function tm-gnus/summary-toggle-header))
(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))
   ))


;;; @ for tm-partial
;;;

(call-after-loaded
 'tm-partial
 (function
  (lambda ()
    (set-atype 'mime/content-decoding-condition
	       '((type . "message/partial")
		 (method . mime-article/grab-message/partials)
		 (major-mode . gnus-article-mode)
		 (summary-buffer-exp . gnus-summary-buffer)
		 ))
    
    (set-alist 'tm-partial/preview-article-method-alist
	       'gnus-article-mode
	       (function
		(lambda ()
		  (tm-gnus/view-message (gnus-summary-article-number))
		  )))
    )))


;;; @ summary filter
;;;

(cond ((not (boundp 'nnheader-encoded-words-decoding))
       (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-eword/decode-string from)
			""))
		     (mail-header-set-subject
		      header
		      (if subj
			  (mime-eword/decode-string subj)
			""))
		     ))
		 gnus-newsgroup-headers)
	 )
       (add-hook 'gnus-select-group-hook
		 (function tm-gnus/decode-summary-from-and-subjects))
       ))


;;; @ article filter
;;;

(defun tm-gnus/preview-article ()
  (if (get-buffer tm-gnus/original-article-buffer)
      (kill-buffer tm-gnus/original-article-buffer)
    )
  (rename-buffer tm-gnus/original-article-buffer)
  (gnus-article-mode)
  (set-buffer (get-buffer-create gnus-article-buffer))
  (make-local-variable 'tm:mother-button-dispatcher)
  (setq tm:mother-button-dispatcher
	(function gnus-article-push-button))
  (mime/viewer-mode
   nil nil nil tm-gnus/original-article-buffer gnus-article-buffer)
  (run-hooks 'tm-gnus/article-prepare-hook)
  )

(or (fboundp 'tm::gnus-article-setup-buffer)
    (fset 'tm::gnus-article-setup-buffer
	  (symbol-function 'gnus-article-setup-buffer)
	  ))

(defun gnus-article-setup-buffer ()
  "Initialize article mode buffer."
  ;; Returns the article buffer.
  (if (get-buffer gnus-article-buffer)
      (save-excursion
	(set-buffer gnus-article-buffer)
	(buffer-disable-undo (current-buffer))
	(setq buffer-read-only t)
	(gnus-add-current-to-buffer-list)
	(or (eq major-mode 'gnus-article-mode)
	    (eq major-mode 'mime/viewer-mode)
	    (gnus-article-mode))
	(current-buffer))
    (save-excursion
      (set-buffer (get-buffer-create gnus-article-buffer))
      (gnus-add-current-to-buffer-list)
      (gnus-article-mode)
      (current-buffer)
      )))

(setq gnus-show-mime-method (function tm-gnus/preview-article))

(or (fboundp 'tm::gnus-article-hide-headers-if-wanted)
    (fset 'tm::gnus-article-hide-headers-if-wanted
	  (symbol-function 'gnus-article-hide-headers-if-wanted))
    )

(defun gnus-article-hide-headers-if-wanted ()
  (or (and gnus-show-mime
	   (or (not gnus-strict-mime)
	       (gnus-fetch-field "Mime-Version")
	       ))
      (tm::gnus-article-hide-headers-if-wanted)
      ))


;;; @ for mh-e
;;;

(call-after-loaded
 'tm-mh-e
 (function
  (lambda ()

;;; by OKABE Yasuo <okabe@kudpc.kyoto-u.ac.jp>
;;;
;; Please use following setting:
;;
;;	(autoload 'gnus-mail-forward-using-mhe-mime "tm-mh-e"
;;	          "Forward using mh-e with tm-edit." t)
;;	(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.
  (require 'mh-comp)
  (require 'tm-edit)
  (let* ((to (read-string "To: "))
	 (cc (read-string "Cc: "))
	 (buffer (save-excursion
		   (set-buffer gnus-article-buffer)
		   (if (eq major-mode 'mime/viewer-mode)
		       mime::preview/article-buffer
		     (current-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)
      )))

)))


;;; @ for BBDB
;;;

(defun tm-gnus/bbdb-setup ()
  (if (memq 'bbdb/gnus-update-record gnus-article-prepare-hook)
      (progn
	(remove-hook 'gnus-article-prepare-hook 'bbdb/gnus-update-record)
	(add-hook 'tm-gnus/article-prepare-hook 'bbdb/gnus-update-record)
	)))

(add-hook 'gnus-startup-hook 'tm-gnus/bbdb-setup t)

(tm-gnus/bbdb-setup)


;;; @ end
;;;

(provide 'tm-gnus5)