;;;
;;; tm-sgnus.el --- tm-gnus module for September GNUS
;;;
;;; 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 'gnus)


;;; @ version
;;;

(defconst tm-gnus/RCS-ID
  "$Id: tm-sgnus.el,v 7.0 1995/10/03 05:09:53 morioka Exp $")

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


;;; @ autoload
;;;

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


;;; @ variables
;;;

(defvar tm-gnus/decode-all t
  "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-original-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-sgnus ()
  (mime-viewer/kill-buffer)
  (delete-other-windows)
  (gnus-article-show-summary)
  (gnus-summary-display-article (gnus-summary-article-number))
  )

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


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

(defun tm-gnus/preview-article ()
  (let (mime-viewer/ignored-field-list)
    (make-local-variable 'tm:mother-button-dispatcher)
    (setq tm:mother-button-dispatcher
	  (function gnus-article-push-button))
    (mime/viewer-mode nil nil nil gnus-original-article-buffer
		      gnus-article-buffer)
    ))

(defun tm-gnus/set-mime-method (mode)
  (setq gnus-show-mime-method
	(if mode
	    (function tm-gnus/preview-article)
	  (function mime/decode-message-header)
	  )))

(tm-gnus/set-mime-method tm-gnus/decode-all)

(setq gnus-show-mime t)


;;; @ for tm-comp
;;;

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


;;; @ end
;;;

(provide 'tm-sgnus)