74
|
1 ;;; tm-rmail.el --- MIME extension for RMAIL
|
|
2
|
|
3 ;; Copyright (C) 1994,1995,1996 Free Software Foundation, Inc.
|
|
4
|
|
5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
|
|
6 ;; modified by KOBAYASHI Shuhei <shuhei-k@jaist.ac.jp>
|
|
7 ;; Created: 1994/8/30
|
|
8 ;; Version: $Revision: 1.1.1.2 $
|
|
9 ;; Keywords: mail, MIME, multimedia, multilingual, encoded-word
|
|
10
|
|
11 ;; This file is not part of tm (Tools for MIME).
|
|
12
|
|
13 ;; This program is free software; you can redistribute it and/or
|
|
14 ;; modify it under the terms of the GNU General Public License as
|
|
15 ;; published by the Free Software Foundation; either version 2, or (at
|
|
16 ;; your option) any later version.
|
|
17
|
|
18 ;; This program is distributed in the hope that it will be useful, but
|
|
19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
21 ;; General Public License for more details.
|
|
22
|
|
23 ;; You should have received a copy of the GNU General Public License
|
|
24 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
26 ;; Boston, MA 02111-1307, USA.
|
|
27
|
4
|
28 ;;; Code:
|
|
29
|
|
30 (require 'tl-list)
|
|
31 (require 'tl-misc)
|
|
32 (require 'rmail)
|
|
33
|
|
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)
|
|
37
|
|
38
|
|
39 ;;; @ variables
|
|
40 ;;;
|
|
41
|
|
42 (defconst tm-rmail/RCS-ID
|
74
|
43 "$Id: tm-rmail.el,v 1.1.1.2 1996/12/21 20:50:48 steve Exp $")
|
4
|
44 (defconst tm-rmail/version (get-version-string tm-rmail/RCS-ID))
|
|
45
|
|
46 (defvar tm-rmail/decode-all nil)
|
|
47
|
|
48
|
|
49 ;;; @ message filter
|
|
50 ;;;
|
|
51
|
|
52 (setq rmail-message-filter
|
|
53 (function
|
|
54 (lambda ()
|
|
55 (let ((mf (buffer-modified-p))
|
|
56 (buffer-read-only nil))
|
|
57 (mime/decode-message-header)
|
|
58 (set-buffer-modified-p mf)
|
|
59 ))))
|
|
60
|
|
61
|
|
62 ;;; @ MIME preview
|
|
63 ;;;
|
|
64
|
|
65 (defun tm-rmail/show-all-header-p ()
|
|
66 (save-restriction
|
|
67 (narrow-to-region (point-min)
|
|
68 (and (re-search-forward "^$" nil t)
|
|
69 (match-beginning 0)))
|
|
70 (goto-char (point-min))
|
|
71 (re-search-forward rmail-ignored-headers nil t)
|
|
72 ))
|
|
73
|
|
74 (defun tm-rmail/preview-message ()
|
|
75 (interactive)
|
|
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)
|
|
79 (save-excursion
|
|
80 (goto-char (point-max))
|
|
81 (if (and (re-search-backward "^\n")
|
|
82 (eq (match-end 0)(point-max)))
|
|
83 (match-beginning 0)
|
|
84 (point-max)
|
|
85 )))
|
|
86 (let ((abuf (current-buffer))
|
|
87 (buf-name (format "*Preview-%s [%d/%d]*"
|
|
88 (buffer-name)
|
|
89 rmail-current-message rmail-total-messages))
|
|
90 buf win)
|
|
91 (if (and mime::article/preview-buffer
|
|
92 (setq buf (get-buffer mime::article/preview-buffer))
|
|
93 )
|
|
94 (progn
|
|
95 (save-excursion
|
|
96 (set-buffer buf)
|
|
97 (rename-buffer buf-name)
|
|
98 )
|
|
99 (if (setq win (get-buffer-window buf))
|
|
100 (progn
|
|
101 (delete-window (get-buffer-window abuf))
|
|
102 (set-window-buffer win abuf)
|
|
103 (set-buffer abuf)
|
|
104 ))
|
|
105 ))
|
|
106 (setq win (get-buffer-window abuf))
|
|
107 (save-window-excursion
|
|
108 (mime/viewer-mode nil (car ret)(cdr ret) nil buf-name)
|
|
109 (or buf
|
|
110 (setq buf (current-buffer))
|
|
111 )
|
|
112 )
|
|
113 (set-window-buffer win buf)
|
|
114 )))
|
|
115
|
|
116 (defun tm-rmail/preview-message-if-you-need ()
|
|
117 (if tm-rmail/decode-all
|
|
118 (tm-rmail/preview-message)
|
|
119 ))
|
|
120
|
|
121 (add-hook 'rmail-show-message-hook 'tm-rmail/preview-message-if-you-need)
|
|
122
|
74
|
123 (load "rmailsum")
|
|
124
|
4
|
125 (cond ((fboundp 'rmail-summary-rmail-update)
|
|
126 ;; for Emacs 19 or later
|
|
127 (or (fboundp 'tm:rmail-summary-rmail-update)
|
|
128 (fset 'tm:rmail-summary-rmail-update
|
|
129 (symbol-function 'rmail-summary-rmail-update))
|
|
130 )
|
|
131
|
|
132 (defun rmail-summary-rmail-update ()
|
|
133 (tm:rmail-summary-rmail-update)
|
|
134 (if tm-rmail/decode-all
|
|
135 (let ((win (get-buffer-window rmail-buffer)))
|
|
136 (if win
|
|
137 (delete-window win)
|
|
138 )))
|
|
139 )
|
|
140
|
|
141 (defun tm-rmail/get-Content-Type-and-Content-Transfer-Encoding ()
|
|
142 (rmail-widen-to-current-msgbeg
|
|
143 (function
|
|
144 (lambda ()
|
|
145 (cons (mime/Content-Type)
|
|
146 (mime/Content-Transfer-Encoding "7bit")
|
|
147 )))))
|
|
148 )
|
|
149 (t
|
|
150 ;; for Emacs 18
|
|
151 (defun tm-rmail/get-Content-Type-and-Content-Transfer-Encoding ()
|
|
152 (save-restriction
|
|
153 (rmail-widen-to-current-msgbeg
|
|
154 (function
|
|
155 (lambda ()
|
|
156 (goto-char (point-min))
|
|
157 (narrow-to-region (or (and (re-search-forward "^.+:" nil t)
|
|
158 (match-beginning 0))
|
|
159 (point-min))
|
|
160 (point-max))
|
|
161 )))
|
|
162 (cons (mime/Content-Type)
|
|
163 (mime/Content-Transfer-Encoding "7bit")
|
|
164 )))
|
|
165 ))
|
|
166
|
|
167 (define-key rmail-mode-map "v" (function tm-rmail/preview-message))
|
|
168
|
|
169 (defun tm-rmail/setup ()
|
|
170 (local-set-key "v" (function
|
|
171 (lambda ()
|
|
172 (interactive)
|
|
173 (set-buffer rmail-buffer)
|
|
174 (tm-rmail/preview-message)
|
|
175 )))
|
|
176 )
|
|
177
|
|
178 (add-hook 'rmail-summary-mode-hook 'tm-rmail/setup)
|
|
179
|
|
180
|
|
181 ;;; @ over-to-* and quitting methods
|
|
182 ;;;
|
|
183
|
|
184 (defun tm-rmail/quitting-method-to-summary ()
|
|
185 (mime-viewer/kill-buffer)
|
|
186 (rmail-summary)
|
|
187 (delete-other-windows)
|
|
188 )
|
|
189
|
|
190 (defun tm-rmail/quitting-method-to-article ()
|
|
191 (setq tm-rmail/decode-all nil)
|
70
|
192 (mime-viewer/kill-buffer)
|
|
193 )
|
4
|
194
|
|
195 (defalias 'tm-rmail/quitting-method 'tm-rmail/quitting-method-to-article)
|
|
196
|
|
197
|
|
198 (defun tm-rmail/over-to-previous-method ()
|
|
199 (let (tm-rmail/decode-all)
|
|
200 (mime-viewer/quit)
|
|
201 )
|
|
202 (if (not (eq (rmail-next-undeleted-message -1) t))
|
|
203 (tm-rmail/preview-message)
|
|
204 )
|
|
205 )
|
|
206
|
|
207 (defun tm-rmail/over-to-next-method ()
|
|
208 (let (tm-rmail/decode-all)
|
|
209 (mime-viewer/quit)
|
|
210 )
|
|
211 (if (not (eq (rmail-next-undeleted-message 1) t))
|
|
212 (tm-rmail/preview-message)
|
|
213 )
|
|
214 )
|
|
215
|
|
216 (defun tm-rmail/show-summary-method ()
|
|
217 (save-excursion
|
|
218 (set-buffer mime::preview/article-buffer)
|
|
219 (rmail-summary)
|
|
220 ))
|
|
221
|
|
222 (call-after-loaded
|
|
223 'tm-view
|
|
224 (function
|
|
225 (lambda ()
|
|
226 (set-alist 'mime-viewer/quitting-method-alist
|
|
227 'rmail-mode
|
|
228 (function tm-rmail/quitting-method))
|
|
229
|
|
230 (set-alist 'mime-viewer/over-to-previous-method-alist
|
|
231 'rmail-mode
|
|
232 (function tm-rmail/over-to-previous-method))
|
|
233
|
|
234 (set-alist 'mime-viewer/over-to-next-method-alist
|
|
235 'rmail-mode
|
|
236 (function tm-rmail/over-to-next-method))
|
|
237
|
|
238 (set-alist 'mime-viewer/show-summary-method
|
|
239 'rmail-mode
|
|
240 (function tm-rmail/show-summary-method))
|
|
241 )))
|
|
242
|
|
243
|
|
244 ;;; @ for tm-partial
|
|
245 ;;;
|
|
246
|
|
247 (call-after-loaded
|
|
248 'tm-partial
|
|
249 (function
|
|
250 (lambda ()
|
|
251 (set-atype 'mime/content-decoding-condition
|
|
252 '((type . "message/partial")
|
|
253 (method . mime-article/grab-message/partials)
|
|
254 (major-mode . rmail-mode)
|
|
255 (summary-buffer-exp
|
|
256 . (progn
|
|
257 (rmail-summary)
|
|
258 (pop-to-buffer rmail-buffer)
|
|
259 rmail-summary-buffer))
|
|
260 ))
|
|
261 (set-alist 'tm-partial/preview-article-method-alist
|
|
262 'rmail-mode
|
|
263 (function
|
|
264 (lambda ()
|
|
265 (rmail-summary-goto-msg (count-lines 1 (point)))
|
|
266 (pop-to-buffer rmail-buffer)
|
|
267 (tm-rmail/preview-message)
|
|
268 )))
|
|
269 )))
|
|
270
|
|
271
|
|
272 ;;; @ for tm-edit
|
|
273 ;;;
|
|
274
|
|
275 (defun tm-rmail/forward ()
|
|
276 "Forward current message in message/rfc822 content-type message
|
|
277 from rmail. The message will be appended if being composed."
|
|
278 (interactive)
|
|
279 ;;>> this gets set even if we abort. Can't do anything about it, though.
|
|
280 (rmail-set-attribute "forwarded" t)
|
|
281 (let ((initialized nil)
|
|
282 (beginning nil)
|
|
283 (msgnum rmail-current-message)
|
|
284 (rmail-buffer (current-buffer))
|
|
285 (subject (concat "["
|
|
286 (mail-strip-quoted-names
|
|
287 (mail-fetch-field "From"))
|
|
288 ": " (or (mail-fetch-field "Subject") "") "]")))
|
|
289 ;; If only one window, use it for the mail buffer.
|
|
290 ;; Otherwise, use another window for the mail buffer
|
|
291 ;; so that the Rmail buffer remains visible
|
|
292 ;; and sending the mail will get back to it.
|
|
293 (setq initialized
|
|
294 (if (one-window-p t)
|
|
295 (mail nil nil subject)
|
|
296 (mail-other-window nil nil subject)))
|
|
297 (save-excursion
|
|
298 ;; following two variables are used in 19.29 or later.
|
|
299 (make-local-variable 'rmail-send-actions-rmail-buffer)
|
|
300 (make-local-variable 'rmail-send-actions-rmail-msg-number)
|
|
301 (make-local-variable 'mail-reply-buffer)
|
|
302 (setq rmail-send-actions-rmail-buffer rmail-buffer)
|
|
303 (setq rmail-send-actions-rmail-msg-number msgnum)
|
|
304 (setq mail-reply-buffer rmail-buffer)
|
|
305 (goto-char (point-max))
|
|
306 (forward-line 1)
|
|
307 (setq beginning (point))
|
|
308 (mime-editor/insert-tag "message" "rfc822")
|
|
309 ;; (insert-buffer rmail-buffer))
|
|
310 ;; (mime-editor/inserted-message-filter))
|
|
311 (tm-mail/insert-message))
|
|
312 (if (not initialized)
|
|
313 (goto-char beginning))
|
|
314 ))
|
|
315
|
|
316 (defun gnus-mail-forward-using-mail-mime ()
|
|
317 "Forward current article in message/rfc822 content-type message from
|
|
318 GNUS. The message will be appended if being composed."
|
|
319 (let ((initialized nil)
|
|
320 (beginning nil)
|
|
321 (forwarding-buffer (current-buffer))
|
|
322 (subject
|
|
323 (concat "[" gnus-newsgroup-name "] "
|
|
324 ;;(mail-strip-quoted-names (gnus-fetch-field "From")) ": "
|
|
325 (or (gnus-fetch-field "Subject") ""))))
|
|
326 ;; If only one window, use it for the mail buffer.
|
|
327 ;; Otherwise, use another window for the mail buffer
|
|
328 ;; so that the Rmail buffer remains visible
|
|
329 ;; and sending the mail will get back to it.
|
|
330 (setq initialized
|
|
331 (if (one-window-p t)
|
|
332 (mail nil nil subject)
|
|
333 (mail-other-window nil nil subject)))
|
|
334 (save-excursion
|
|
335 (goto-char (point-max))
|
|
336 (setq beginning (point))
|
|
337 (mime-editor/insert-tag "message" "rfc822")
|
|
338 (insert-buffer forwarding-buffer)
|
|
339 ;; You have a chance to arrange the message.
|
|
340 (run-hooks 'gnus-mail-forward-hook)
|
|
341 )
|
|
342 (if (not initialized)
|
|
343 (goto-char beginning))
|
|
344 ))
|
|
345
|
|
346 (call-after-loaded
|
|
347 'mime-setup
|
|
348 (function
|
|
349 (lambda ()
|
|
350 (substitute-key-definition
|
|
351 'rmail-forward 'tm-rmail/forward rmail-mode-map)
|
|
352
|
|
353 ;; (setq gnus-mail-forward-method 'gnus-mail-forward-using-mail-mime)
|
|
354
|
|
355 (call-after-loaded
|
|
356 'tm-edit
|
|
357 (function
|
|
358 (lambda ()
|
|
359 (require 'tm-mail)
|
|
360 (set-alist 'mime-editor/message-inserter-alist
|
|
361 'mail-mode (function tm-mail/insert-message))
|
|
362 (set-alist 'mime-editor/split-message-sender-alist
|
|
363 'mail-mode (function
|
|
364 (lambda ()
|
|
365 (interactive)
|
74
|
366 (funcall send-mail-function)
|
4
|
367 )))
|
|
368 )))
|
|
369 )))
|
|
370
|
|
371
|
|
372 ;;; @ for BBDB
|
|
373 ;;;
|
|
374
|
|
375 (call-after-loaded
|
|
376 'bbdb
|
|
377 (function
|
|
378 (lambda ()
|
|
379 (require 'tm-bbdb)
|
|
380 )))
|
|
381
|
|
382
|
|
383 ;;; @ end
|
|
384 ;;;
|
|
385
|
|
386 (provide 'tm-rmail)
|
|
387
|
|
388 (run-hooks 'tm-rmail-load-hook)
|
|
389
|
|
390 ;;; tm-rmail.el ends here.
|