2 ;;; tm-gnus5.el --- tm-gnus module for Gnus 5.*
4 ;;; Copyright (C) 1995 Free Software Foundation, Inc.
5 ;;; Copyright (C) 1995 MORIOKA Tomohiko
7 ;;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
8 ;;; Keywords: news, MIME, multimedia, multilingual, encoded-word
10 ;;; This file is part of tm (Tools for MIME).
19 (autoload 'mime/viewer-mode "tm-view" "View MIME message." t)
20 (autoload 'mime/decode-message-header
21 "tm-ew-d" "Decode MIME encoded-word." t)
22 (autoload 'mime/decode-encoded-words-string
23 "tm-ew-d" "Decode MIME encoded-word." t)
29 (defconst tm-gnus/RCS-ID
30 "$Id: tm-gnus5.el,v 7.2 1995/10/05 12:57:53 morioka Exp $")
32 (defconst tm-gnus/version
33 (concat (get-version-string tm-gnus/RCS-ID) " for GNUS 5"))
35 (defconst tm-gnus/automatic-MIME-preview-support
36 (cond ((boundp 'gnus-clean-article-buffer)
37 (defconst gnus-version (concat gnus-version " with tm patch"))
40 (defvar gnus-clean-article-buffer gnus-article-buffer)
44 (defvar tm-gnus/preview-buffer
45 (if tm-gnus/automatic-MIME-preview-support
46 (concat "*Preview-" gnus-clean-article-buffer "*"))
53 (defvar tm-gnus/original-article-display-hook gnus-article-display-hook)
55 (defvar tm-gnus/decode-all tm-gnus/automatic-MIME-preview-support
57 tm-gnus/automatic-MIME-preview-support is non-nil,
58 article is automatic MIME decoded.")
61 ;;; @ command functions
64 (defun tm-gnus/view-message (arg)
65 "MIME decode and play this message."
67 (let ((gnus-break-pages nil))
68 (gnus-summary-select-article t t)
70 (pop-to-buffer gnus-clean-article-buffer t)
71 (let (buffer-read-only)
72 (if (text-property-any (point-min) (point-max) 'invisible t)
73 (remove-text-properties (point-min) (point-max)
74 gnus-hidden-properties)
79 (defun tm-gnus/summary-scroll-down ()
80 "Scroll down one line current article."
82 (gnus-summary-scroll-up -1)
85 (define-key gnus-summary-mode-map "v" (function tm-gnus/view-message))
86 (define-key gnus-summary-mode-map
87 "\e\r" (function tm-gnus/summary-scroll-down))
93 (defun mime-viewer/quitting-method-for-gnus5 ()
94 (mime-viewer/kill-buffer)
95 (delete-other-windows)
96 (gnus-article-show-summary)
97 (gnus-summary-display-article (gnus-summary-article-number))
103 (set-alist 'mime-viewer/quitting-method-alist
105 (function mime-viewer/quitting-method-for-gnus5))
112 (defun tm-gnus/decode-summary-from-and-subjects ()
113 (mapcar (lambda (header)
114 (let ((from (mail-header-from header))
115 (subj (mail-header-subject header))
117 (mail-header-set-from
120 (mime/decode-encoded-words-string from)
122 (mail-header-set-subject
125 (mime/decode-encoded-words-string subj)
128 gnus-newsgroup-headers)
131 (add-hook 'gnus-select-group-hook
132 (function tm-gnus/decode-summary-from-and-subjects))
138 (setq gnus-show-mime-method (function mime/decode-message-header))
141 ;;; @ automatic MIME preview support
144 (defun tm-gnus/summary-toggle-header (&optional arg)
146 (if tm-gnus/decode-all
147 (let ((mime-viewer/ignored-field-list
148 (if (save-window-excursion
149 (switch-to-buffer tm-gnus/preview-buffer)
152 (rfc822/get-field-body field)
154 mime-viewer/ignored-field-list))
155 mime-viewer/ignored-field-list)))
156 (gnus-summary-select-article t t)
158 (gnus-summary-toggle-header arg)
161 (defun tm-gnus/set-mime-method (mode)
164 (setq gnus-show-mime nil)
165 (setq gnus-article-display-hook
166 (list (function (lambda ()
168 (gnus-set-mode-line 'article)
170 (set-alist 'gnus-window-to-buffer 'article tm-gnus/preview-buffer)
171 (setq gnus-article-buffer tm-gnus/preview-buffer)
173 (setq gnus-show-mime t)
174 (setq gnus-article-display-hook tm-gnus/original-article-display-hook)
175 (set-alist 'gnus-window-to-buffer 'article gnus-clean-article-buffer)
176 (setq gnus-article-buffer gnus-clean-article-buffer)
179 (defun tm-gnus/toggle-mime (arg)
180 "Toggle MIME processing mode.
181 With arg, turn MIME processing on if arg is positive."
183 (setq tm-gnus/decode-all
185 (not tm-gnus/decode-all)
187 (gnus-set-global-variables)
188 (tm-gnus/set-mime-method tm-gnus/decode-all)
189 (gnus-summary-select-article gnus-show-all-headers 'force)
192 (if tm-gnus/automatic-MIME-preview-support
194 (define-key gnus-summary-mode-map
195 "t" (function tm-gnus/summary-toggle-header))
196 (define-key gnus-summary-mode-map "\et" (function tm-gnus/toggle-mime))
198 (tm-gnus/set-mime-method tm-gnus/decode-all)
200 (add-hook 'gnus-exit-gnus-hook
202 (let ((buf (get-buffer tm-gnus/preview-buffer)))
207 (setq gnus-article-display-hook tm-gnus/original-article-display-hook)
208 (setq gnus-show-mime t)
219 (set-alist 'mime/message-sender-alist
221 (function gnus-inews-news))
228 ;;; by OKABE Yasuo <okabe@kudpc.kyoto-u.ac.jp>
230 ;;; Please use following setting:
231 ;;; (setq gnus-mail-forward-method
232 ;;; (function gnus-mail-forward-using-mhe-mime))
234 (defun gnus-mail-forward-using-mhe-mime (&optional buffer)
235 "Forward the current message to another user using mh-e with mime-mode."
236 ;; First of all, prepare mhe mail buffer.
237 (let* ((to (read-string "To: "))
238 (cc (read-string "Cc: "))
239 (buffer (or buffer gnus-clean-article-buffer))
240 (config (current-window-configuration));; need to add this - erik
241 (subject (gnus-forward-make-subject buffer)))
242 (setq mh-show-buffer buffer)
244 (mh-send-sub to (or cc "") (or subject "(None)") config);; Erik Selberg 1/23/94
245 (let ((draft (current-buffer))
246 (gnus-mail-buffer (current-buffer))
248 (gnus-configure-windows 'reply-yank)
249 (setq mail-buf (eval (cdr (assq 'mail gnus-window-to-buffer))))
250 (pop-to-buffer mail-buf);; always in the display, so won't have window probs
251 (switch-to-buffer draft)
254 (goto-char (point-max))
255 (insert (concat (mime-make-tag "message" "rfc822" nil "7bit") "\n"))
256 (insert-buffer buffer)
257 (setq mh-sent-from-folder buffer)
258 (setq mh-sent-from-msg 1)
259 (setq mh-previous-window-config config)
260 (run-hooks 'gnus-mail-hook)