2 ;;; Copyright (C) 1995 Free Software Foundation, Inc.
3 ;;; Copyright (C) 1994,1995 MORIOKA Tomohiko
5 ;;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
6 ;;; modified by KOBAYASHI Shuhei <shuhei-k@jaist.ac.jp>
10 ;;; Keywords: mail, MIME, multimedia, multilingual, encoded-word
12 ;;; This file is part of tm (Tools for MIME).
14 ;;; This program is free software; you can redistribute it and/or
15 ;;; modify it under the terms of the GNU General Public License as
16 ;;; published by the Free Software Foundation; either version 2, or
17 ;;; (at your option) any later version.
19 ;;; This program is distributed in the hope that it will be useful,
20 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
22 ;;; General Public License for more details.
24 ;;; You should have received a copy of the GNU General Public License
25 ;;; along with This program. If not, write to the Free Software
26 ;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
34 (autoload 'mime/viewer-mode "tm-view" "View MIME message." t)
35 (autoload 'mime/Content-Type "tm-view" "parse Content-Type field.")
36 (autoload 'mime/decode-message-header "tm-ew-d" "Decode MIME encoded-word." t)
42 (defconst tm-rmail/RCS-ID
43 "$Id: tm-rmail.el,v 7.24 1996/04/16 18:24:58 morioka Exp $")
44 (defconst tm-rmail/version (get-version-string tm-rmail/RCS-ID))
46 (defvar tm-rmail/decode-all nil)
52 (setq rmail-message-filter
55 (let ((mf (buffer-modified-p))
56 (buffer-read-only nil))
57 (mime/decode-message-header)
58 (set-buffer-modified-p mf)
65 (defun tm-rmail/show-all-header-p ()
67 (narrow-to-region (point-min)
68 (and (re-search-forward "^$" nil t)
70 (goto-char (point-min))
71 (re-search-forward rmail-ignored-headers nil t)
74 (defun tm-rmail/preview-message ()
76 (setq tm-rmail/decode-all t)
77 (let ((ret (tm-rmail/get-Content-Type-and-Content-Transfer-Encoding)))
78 (narrow-to-region (point-min)
80 (goto-char (point-max))
81 (if (and (re-search-backward "^\n")
82 (eq (match-end 0)(point-max)))
86 (let ((abuf (current-buffer))
87 (buf-name (format "*Preview-%s [%d/%d]*"
89 rmail-current-message rmail-total-messages))
91 (if (and mime::article/preview-buffer
92 (setq buf (get-buffer mime::article/preview-buffer))
97 (rename-buffer buf-name)
99 (if (setq win (get-buffer-window buf))
101 (delete-window (get-buffer-window abuf))
102 (set-window-buffer win abuf)
106 (setq win (get-buffer-window abuf))
107 (save-window-excursion
108 (mime/viewer-mode nil (car ret)(cdr ret) nil buf-name)
110 (setq buf (current-buffer))
113 (set-window-buffer win buf)
116 (defun tm-rmail/preview-message-if-you-need ()
117 (if tm-rmail/decode-all
118 (tm-rmail/preview-message)
121 (add-hook 'rmail-show-message-hook 'tm-rmail/preview-message-if-you-need)
123 (cond ((fboundp 'rmail-summary-rmail-update)
124 ;; for Emacs 19 or later
125 (or (fboundp 'tm:rmail-summary-rmail-update)
126 (fset 'tm:rmail-summary-rmail-update
127 (symbol-function 'rmail-summary-rmail-update))
130 (defun rmail-summary-rmail-update ()
131 (tm:rmail-summary-rmail-update)
132 (if tm-rmail/decode-all
133 (let ((win (get-buffer-window rmail-buffer)))
139 (defun tm-rmail/get-Content-Type-and-Content-Transfer-Encoding ()
140 (rmail-widen-to-current-msgbeg
143 (cons (mime/Content-Type)
144 (mime/Content-Transfer-Encoding "7bit")
149 (defun tm-rmail/get-Content-Type-and-Content-Transfer-Encoding ()
151 (rmail-widen-to-current-msgbeg
154 (goto-char (point-min))
155 (narrow-to-region (or (and (re-search-forward "^.+:" nil t)
160 (cons (mime/Content-Type)
161 (mime/Content-Transfer-Encoding "7bit")
165 (define-key rmail-mode-map "v" (function tm-rmail/preview-message))
167 (defun tm-rmail/setup ()
168 (local-set-key "v" (function
171 (set-buffer rmail-buffer)
172 (tm-rmail/preview-message)
176 (add-hook 'rmail-summary-mode-hook 'tm-rmail/setup)
179 ;;; @ over-to-* and quitting methods
182 (defun tm-rmail/quitting-method-to-summary ()
183 (mime-viewer/kill-buffer)
185 (delete-other-windows)
188 (defun tm-rmail/quitting-method-to-article ()
189 (setq tm-rmail/decode-all nil)
190 (mime-viewer/kill-buffer)
193 (defalias 'tm-rmail/quitting-method 'tm-rmail/quitting-method-to-article)
196 (defun tm-rmail/over-to-previous-method ()
197 (let (tm-rmail/decode-all)
200 (if (not (eq (rmail-next-undeleted-message -1) t))
201 (tm-rmail/preview-message)
205 (defun tm-rmail/over-to-next-method ()
206 (let (tm-rmail/decode-all)
209 (if (not (eq (rmail-next-undeleted-message 1) t))
210 (tm-rmail/preview-message)
214 (defun tm-rmail/show-summary-method ()
216 (set-buffer mime::preview/article-buffer)
224 (set-alist 'mime-viewer/quitting-method-alist
226 (function tm-rmail/quitting-method))
228 (set-alist 'mime-viewer/over-to-previous-method-alist
230 (function tm-rmail/over-to-previous-method))
232 (set-alist 'mime-viewer/over-to-next-method-alist
234 (function tm-rmail/over-to-next-method))
236 (set-alist 'mime-viewer/show-summary-method
238 (function tm-rmail/show-summary-method))
249 (set-atype 'mime/content-decoding-condition
250 '((type . "message/partial")
251 (method . mime-article/grab-message/partials)
252 (major-mode . rmail-mode)
256 (pop-to-buffer rmail-buffer)
257 rmail-summary-buffer))
259 (set-alist 'tm-partial/preview-article-method-alist
263 (rmail-summary-goto-msg (count-lines 1 (point)))
264 (pop-to-buffer rmail-buffer)
265 (tm-rmail/preview-message)
273 (defun tm-rmail/forward ()
274 "Forward current message in message/rfc822 content-type message
275 from rmail. The message will be appended if being composed."
277 ;;>> this gets set even if we abort. Can't do anything about it, though.
278 (rmail-set-attribute "forwarded" t)
279 (let ((initialized nil)
281 (msgnum rmail-current-message)
282 (rmail-buffer (current-buffer))
284 (mail-strip-quoted-names
285 (mail-fetch-field "From"))
286 ": " (or (mail-fetch-field "Subject") "") "]")))
287 ;; If only one window, use it for the mail buffer.
288 ;; Otherwise, use another window for the mail buffer
289 ;; so that the Rmail buffer remains visible
290 ;; and sending the mail will get back to it.
293 (mail nil nil subject)
294 (mail-other-window nil nil subject)))
296 ;; following two variables are used in 19.29 or later.
297 (make-local-variable 'rmail-send-actions-rmail-buffer)
298 (make-local-variable 'rmail-send-actions-rmail-msg-number)
299 (make-local-variable 'mail-reply-buffer)
300 (setq rmail-send-actions-rmail-buffer rmail-buffer)
301 (setq rmail-send-actions-rmail-msg-number msgnum)
302 (setq mail-reply-buffer rmail-buffer)
303 (goto-char (point-max))
305 (setq beginning (point))
306 (mime-editor/insert-tag "message" "rfc822")
307 ;; (insert-buffer rmail-buffer))
308 ;; (mime-editor/inserted-message-filter))
309 (tm-mail/insert-message))
310 (if (not initialized)
311 (goto-char beginning))
314 (defun gnus-mail-forward-using-mail-mime ()
315 "Forward current article in message/rfc822 content-type message from
316 GNUS. The message will be appended if being composed."
317 (let ((initialized nil)
319 (forwarding-buffer (current-buffer))
321 (concat "[" gnus-newsgroup-name "] "
322 ;;(mail-strip-quoted-names (gnus-fetch-field "From")) ": "
323 (or (gnus-fetch-field "Subject") ""))))
324 ;; If only one window, use it for the mail buffer.
325 ;; Otherwise, use another window for the mail buffer
326 ;; so that the Rmail buffer remains visible
327 ;; and sending the mail will get back to it.
330 (mail nil nil subject)
331 (mail-other-window nil nil subject)))
333 (goto-char (point-max))
334 (setq beginning (point))
335 (mime-editor/insert-tag "message" "rfc822")
336 (insert-buffer forwarding-buffer)
337 ;; You have a chance to arrange the message.
338 (run-hooks 'gnus-mail-forward-hook)
340 (if (not initialized)
341 (goto-char beginning))
348 (substitute-key-definition
349 'rmail-forward 'tm-rmail/forward rmail-mode-map)
351 ;; (setq gnus-mail-forward-method 'gnus-mail-forward-using-mail-mime)
358 (set-alist 'mime-editor/message-inserter-alist
359 'mail-mode (function tm-mail/insert-message))
380 (run-hooks 'tm-rmail-load-hook)
382 ;;; tm-rmail.el ends here.