Mercurial > hg > xemacs-beta

comparison lisp/tm/tm-rmail.el @ 4:b82b59fe008d r19-15b3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b3
author cvs
date Mon, 13 Aug 2007 08:46:56 +0200
parents
children 4b173ad71786
comparison
equal deleted inserted replaced
3:30df88044ec6 4:b82b59fe008d
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.