|
4
|
1 ;;;
|
|
|
2 ;;; Copyright (C) 1995 Free Software Foundation, Inc.
|
|
|
3 ;;; Copyright (C) 1994 .. 1996 MORIOKA Tomohiko
|
|
|
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:
|
|
|
9 ;;; $Revision: 1.1.1.1 $
|
|
|
10 ;;; Keywords: mail, MIME, multimedia, multilingual, encoded-word
|
|
|
11 ;;;
|
|
|
12 ;;; This file is part of tm (Tools for MIME).
|
|
|
13 ;;;
|
|
|
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.
|
|
|
18 ;;;
|
|
|
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.
|
|
|
23 ;;;
|
|
|
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.
|
|
|
27 ;;;
|
|
|
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
|
|
|
43 "$Id: tm-rmail.el,v 1.1.1.1 1996/12/18 03:55:32 steve Exp $")
|
|
|
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
|
|
|
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))
|
|
|
128 )
|
|
|
129
|
|
|
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)))
|
|
|
134 (if win
|
|
|
135 (delete-window win)
|
|
|
136 )))
|
|
|
137 )
|
|
|
138
|
|
|
139 (defun tm-rmail/get-Content-Type-and-Content-Transfer-Encoding ()
|
|
|
140 (rmail-widen-to-current-msgbeg
|
|
|
141 (function
|
|
|
142 (lambda ()
|
|
|
143 (cons (mime/Content-Type)
|
|
|
144 (mime/Content-Transfer-Encoding "7bit")
|
|
|
145 )))))
|
|
|
146 )
|
|
|
147 (t
|
|
|
148 ;; for Emacs 18
|
|
|
149 (defun tm-rmail/get-Content-Type-and-Content-Transfer-Encoding ()
|
|
|
150 (save-restriction
|
|
|
151 (rmail-widen-to-current-msgbeg
|
|
|
152 (function
|
|
|
153 (lambda ()
|
|
|
154 (goto-char (point-min))
|
|
|
155 (narrow-to-region (or (and (re-search-forward "^.+:" nil t)
|
|
|
156 (match-beginning 0))
|
|
|
157 (point-min))
|
|
|
158 (point-max))
|
|
|
159 )))
|
|
|
160 (cons (mime/Content-Type)
|
|
|
161 (mime/Content-Transfer-Encoding "7bit")
|
|
|
162 )))
|
|
|
163 ))
|
|
|
164
|
|
|
165 (define-key rmail-mode-map "v" (function tm-rmail/preview-message))
|
|
|
166
|
|
|
167 (defun tm-rmail/setup ()
|
|
|
168 (local-set-key "v" (function
|
|
|
169 (lambda ()
|
|
|
170 (interactive)
|
|
|
171 (set-buffer rmail-buffer)
|
|
|
172 (tm-rmail/preview-message)
|
|
|
173 )))
|
|
|
174 )
|
|
|
175
|
|
|
176 (add-hook 'rmail-summary-mode-hook 'tm-rmail/setup)
|
|
|
177
|
|
|
178
|
|
|
179 ;;; @ over-to-* and quitting methods
|
|
|
180 ;;;
|
|
|
181
|
|
|
182 (defun tm-rmail/quitting-method-to-summary ()
|
|
|
183 (mime-viewer/kill-buffer)
|
|
|
184 (rmail-summary)
|
|
|
185 (delete-other-windows)
|
|
|
186 )
|
|
|
187
|
|
|
188 (defun tm-rmail/quitting-method-to-article ()
|
|
|
189 (setq tm-rmail/decode-all nil)
|
|
|
190 (mime-viewer/kill-buffer)
|
|
|
191 )
|
|
|
192
|
|
|
193 (defalias 'tm-rmail/quitting-method 'tm-rmail/quitting-method-to-article)
|
|
|
194
|
|
|
195
|
|
|
196 (defun tm-rmail/over-to-previous-method ()
|
|
|
197 (let (tm-rmail/decode-all)
|
|
|
198 (mime-viewer/quit)
|
|
|
199 )
|
|
|
200 (if (not (eq (rmail-next-undeleted-message -1) t))
|
|
|
201 (tm-rmail/preview-message)
|
|
|
202 )
|
|
|
203 )
|
|
|
204
|
|
|
205 (defun tm-rmail/over-to-next-method ()
|
|
|
206 (let (tm-rmail/decode-all)
|
|
|
207 (mime-viewer/quit)
|
|
|
208 )
|
|
|
209 (if (not (eq (rmail-next-undeleted-message 1) t))
|
|
|
210 (tm-rmail/preview-message)
|
|
|
211 )
|
|
|
212 )
|
|
|
213
|
|
|
214 (defun tm-rmail/show-summary-method ()
|
|
|
215 (save-excursion
|
|
|
216 (set-buffer mime::preview/article-buffer)
|
|
|
217 (rmail-summary)
|
|
|
218 ))
|
|
|
219
|
|
|
220 (call-after-loaded
|
|
|
221 'tm-view
|
|
|
222 (function
|
|
|
223 (lambda ()
|
|
|
224 (set-alist 'mime-viewer/quitting-method-alist
|
|
|
225 'rmail-mode
|
|
|
226 (function tm-rmail/quitting-method))
|
|
|
227
|
|
|
228 (set-alist 'mime-viewer/over-to-previous-method-alist
|
|
|
229 'rmail-mode
|
|
|
230 (function tm-rmail/over-to-previous-method))
|
|
|
231
|
|
|
232 (set-alist 'mime-viewer/over-to-next-method-alist
|
|
|
233 'rmail-mode
|
|
|
234 (function tm-rmail/over-to-next-method))
|
|
|
235
|
|
|
236 (set-alist 'mime-viewer/show-summary-method
|
|
|
237 'rmail-mode
|
|
|
238 (function tm-rmail/show-summary-method))
|
|
|
239 )))
|
|
|
240
|
|
|
241
|
|
|
242 ;;; @ for tm-partial
|
|
|
243 ;;;
|
|
|
244
|
|
|
245 (call-after-loaded
|
|
|
246 'tm-partial
|
|
|
247 (function
|
|
|
248 (lambda ()
|
|
|
249 (set-atype 'mime/content-decoding-condition
|
|
|
250 '((type . "message/partial")
|
|
|
251 (method . mime-article/grab-message/partials)
|
|
|
252 (major-mode . rmail-mode)
|
|
|
253 (summary-buffer-exp
|
|
|
254 . (progn
|
|
|
255 (rmail-summary)
|
|
|
256 (pop-to-buffer rmail-buffer)
|
|
|
257 rmail-summary-buffer))
|
|
|
258 ))
|
|
|
259 (set-alist 'tm-partial/preview-article-method-alist
|
|
|
260 'rmail-mode
|
|
|
261 (function
|
|
|
262 (lambda ()
|
|
|
263 (rmail-summary-goto-msg (count-lines 1 (point)))
|
|
|
264 (pop-to-buffer rmail-buffer)
|
|
|
265 (tm-rmail/preview-message)
|
|
|
266 )))
|
|
|
267 )))
|
|
|
268
|
|
|
269
|
|
|
270 ;;; @ for tm-edit
|
|
|
271 ;;;
|
|
|
272
|
|
|
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."
|
|
|
276 (interactive)
|
|
|
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)
|
|
|
280 (beginning nil)
|
|
|
281 (msgnum rmail-current-message)
|
|
|
282 (rmail-buffer (current-buffer))
|
|
|
283 (subject (concat "["
|
|
|
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.
|
|
|
291 (setq initialized
|
|
|
292 (if (one-window-p t)
|
|
|
293 (mail nil nil subject)
|
|
|
294 (mail-other-window nil nil subject)))
|
|
|
295 (save-excursion
|
|
|
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))
|
|
|
304 (forward-line 1)
|
|
|
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))
|
|
|
312 ))
|
|
|
313
|
|
|
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)
|
|
|
318 (beginning nil)
|
|
|
319 (forwarding-buffer (current-buffer))
|
|
|
320 (subject
|
|
|
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.
|
|
|
328 (setq initialized
|
|
|
329 (if (one-window-p t)
|
|
|
330 (mail nil nil subject)
|
|
|
331 (mail-other-window nil nil subject)))
|
|
|
332 (save-excursion
|
|
|
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)
|
|
|
339 )
|
|
|
340 (if (not initialized)
|
|
|
341 (goto-char beginning))
|
|
|
342 ))
|
|
|
343
|
|
|
344 (call-after-loaded
|
|
|
345 'mime-setup
|
|
|
346 (function
|
|
|
347 (lambda ()
|
|
|
348 (substitute-key-definition
|
|
|
349 'rmail-forward 'tm-rmail/forward rmail-mode-map)
|
|
|
350
|
|
|
351 ;; (setq gnus-mail-forward-method 'gnus-mail-forward-using-mail-mime)
|
|
|
352
|
|
|
353 (call-after-loaded
|
|
|
354 'tm-edit
|
|
|
355 (function
|
|
|
356 (lambda ()
|
|
|
357 (require 'tm-mail)
|
|
|
358 (set-alist 'mime-editor/message-inserter-alist
|
|
|
359 'mail-mode (function tm-mail/insert-message))
|
|
|
360 (set-alist 'mime-editor/split-message-sender-alist
|
|
|
361 'mail-mode (function
|
|
|
362 (lambda ()
|
|
|
363 (interactive)
|
|
|
364 (sendmail-send-it)
|
|
|
365 )))
|
|
|
366 )))
|
|
|
367 )))
|
|
|
368
|
|
|
369
|
|
|
370 ;;; @ for BBDB
|
|
|
371 ;;;
|
|
|
372
|
|
|
373 (call-after-loaded
|
|
|
374 'bbdb
|
|
|
375 (function
|
|
|
376 (lambda ()
|
|
|
377 (require 'tm-bbdb)
|
|
|
378 )))
|
|
|
379
|
|
|
380
|
|
|
381 ;;; @ end
|
|
|
382 ;;;
|
|
|
383
|
|
|
384 (provide 'tm-rmail)
|
|
|
385
|
|
|
386 (run-hooks 'tm-rmail-load-hook)
|
|
|
387
|
|
|
388 ;;; tm-rmail.el ends here.
|
