0
|
1 ;;; Mailing, forwarding, and replying commands for VM
|
70
|
2 ;;; Copyright (C) 1989, 1990, 1991, 1993, 1994, 1995 Kyle E. Jones
|
0
|
3 ;;;
|
|
4 ;;; This program is free software; you can redistribute it and/or modify
|
|
5 ;;; it under the terms of the GNU General Public License as published by
|
|
6 ;;; the Free Software Foundation; either version 1, or (at your option)
|
|
7 ;;; any later version.
|
|
8 ;;;
|
|
9 ;;; This program is distributed in the hope that it will be useful,
|
|
10 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
11 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
12 ;;; GNU General Public License for more details.
|
|
13 ;;;
|
|
14 ;;; You should have received a copy of the GNU General Public License
|
|
15 ;;; along with this program; if not, write to the Free Software
|
|
16 ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
17
|
|
18 (provide 'vm-reply)
|
|
19
|
|
20 (defun vm-do-reply (to-all include-text count)
|
|
21 (let ((mlist (vm-select-marked-or-prefixed-messages count))
|
|
22 (dir default-directory)
|
|
23 (message-pointer vm-message-pointer)
|
|
24 (case-fold-search t)
|
|
25 to cc subject mp in-reply-to references tmp tmp2 newsgroups)
|
|
26 (setq mp mlist)
|
|
27 (while mp
|
|
28 (cond
|
|
29 ((eq mlist mp)
|
|
30 (cond ((setq to
|
|
31 (let ((reply-to
|
70
|
32 (vm-get-header-contents (car mp) "Reply-To:")))
|
0
|
33 (if (vm-ignored-reply-to reply-to)
|
|
34 nil
|
|
35 reply-to ))))
|
70
|
36 ((setq to (vm-get-header-contents (car mp) "From:")))
|
0
|
37 ;; bad, but better than nothing for some
|
|
38 ((setq to (vm-grok-From_-author (car mp))))
|
|
39 (t (error "No From: or Reply-To: header in message")))
|
|
40 (setq subject (vm-get-header-contents (car mp) "Subject:")
|
|
41 in-reply-to
|
|
42 (and vm-in-reply-to-format
|
|
43 (let ((vm-summary-uninteresting-senders nil))
|
|
44 (vm-sprintf 'vm-in-reply-to-format (car mp))))
|
|
45 in-reply-to (and (not (equal "" in-reply-to)) in-reply-to))
|
|
46 (and subject vm-reply-subject-prefix
|
|
47 (let ((case-fold-search t))
|
|
48 (not
|
|
49 (equal
|
|
50 (string-match (regexp-quote vm-reply-subject-prefix)
|
|
51 subject)
|
|
52 0)))
|
|
53 (setq subject (concat vm-reply-subject-prefix subject))))
|
70
|
54 (t (cond ((setq tmp (vm-get-header-contents (car mp) "Reply-To:"))
|
0
|
55 (setq to (concat to "," tmp)))
|
70
|
56 ((setq tmp (vm-get-header-contents (car mp) "From:"))
|
0
|
57 (setq to (concat to "," tmp)))
|
|
58 ;; bad, but better than nothing for some
|
|
59 ((setq tmp (vm-grok-From_-author (car mp)))
|
|
60 (setq to (concat to "," tmp)))
|
|
61 (t (error "No From: or Reply-To: header in message")))))
|
|
62 (if to-all
|
|
63 (progn
|
70
|
64 (setq tmp (vm-get-header-contents (car mp) "To:"))
|
|
65 (setq tmp2 (vm-get-header-contents (car mp) "Cc:"))
|
0
|
66 (if tmp
|
|
67 (if cc
|
|
68 (setq cc (concat cc "," tmp))
|
|
69 (setq cc tmp)))
|
|
70 (if tmp2
|
|
71 (if cc
|
|
72 (setq cc (concat cc "," tmp2))
|
|
73 (setq cc tmp2)))))
|
|
74 (setq references
|
70
|
75 (cons (vm-get-header-contents (car mp) "References:")
|
|
76 (cons (vm-get-header-contents (car mp) "In-reply-to:")
|
|
77 (cons (vm-get-header-contents (car mp) "Message-ID:")
|
0
|
78 references))))
|
|
79 (setq newsgroups
|
70
|
80 (cons (or (and to-all (vm-get-header-contents (car mp) "Followup-To:"))
|
|
81 (vm-get-header-contents (car mp) "Newsgroups:"))
|
0
|
82 newsgroups))
|
|
83 (setq mp (cdr mp)))
|
|
84 (if vm-strip-reply-headers
|
|
85 (let ((mail-use-rfc822 t))
|
|
86 (and to (setq to (mail-strip-quoted-names to)))
|
|
87 (and cc (setq cc (mail-strip-quoted-names cc)))))
|
|
88 (setq to (vm-parse-addresses to)
|
|
89 cc (vm-parse-addresses cc))
|
|
90 (if vm-reply-ignored-addresses
|
|
91 (setq to (vm-strip-ignored-addresses to)
|
|
92 cc (vm-strip-ignored-addresses cc)))
|
|
93 (setq to (vm-delete-duplicates to nil t))
|
|
94 (setq cc (vm-delete-duplicates
|
|
95 (append (vm-delete-duplicates cc nil t)
|
|
96 to (copy-sequence to))
|
|
97 t t))
|
|
98 (and to (setq to (mapconcat 'identity to ",\n ")))
|
|
99 (and cc (setq cc (mapconcat 'identity cc ",\n ")))
|
|
100 (and (null to) (setq to cc cc nil))
|
|
101 (setq references (delq nil references)
|
|
102 references (mapconcat 'identity references " ")
|
|
103 references (vm-parse references "[^<]*\\(<[^>]+>\\)")
|
|
104 references (vm-delete-duplicates references)
|
|
105 references (if references (mapconcat 'identity references "\n\t")))
|
|
106 (setq newsgroups (delq nil newsgroups)
|
|
107 newsgroups (mapconcat 'identity newsgroups ",")
|
|
108 newsgroups (vm-parse newsgroups "[ \t\f\r\n,]*\\([^ \t\f\r\n,]+\\)")
|
|
109 newsgroups (vm-delete-duplicates newsgroups)
|
|
110 newsgroups (if newsgroups (mapconcat 'identity newsgroups ",")))
|
|
111 (vm-mail-internal
|
|
112 (format "reply to %s%s" (vm-su-full-name (car mlist))
|
|
113 (if (cdr mlist) ", ..." ""))
|
|
114 to subject in-reply-to cc references newsgroups)
|
|
115 (make-local-variable 'vm-reply-list)
|
|
116 (setq vm-system-state 'replying
|
|
117 vm-reply-list mlist
|
|
118 default-directory dir)
|
|
119 (if include-text
|
|
120 (save-excursion
|
|
121 (goto-char (point-min))
|
|
122 (let ((case-fold-search nil))
|
|
123 (re-search-forward
|
|
124 (concat "^" (regexp-quote mail-header-separator) "$") nil 0))
|
|
125 (forward-char 1)
|
|
126 (while mlist
|
70
|
127 (vm-yank-message (car mlist))
|
|
128 (goto-char (point-max))
|
0
|
129 (setq mlist (cdr mlist)))))
|
|
130 (run-hooks 'vm-reply-hook)
|
|
131 (run-hooks 'vm-mail-mode-hook)))
|
|
132
|
|
133 (defun vm-strip-ignored-addresses (addresses)
|
|
134 (setq addresses (copy-sequence addresses))
|
|
135 (let (re-list list addr-list)
|
|
136 (setq re-list vm-reply-ignored-addresses)
|
|
137 (while re-list
|
|
138 (setq addr-list addresses)
|
|
139 (while addr-list
|
|
140 (if (string-match (car re-list) (car addr-list))
|
|
141 (setq addresses (delq (car addr-list) addresses)))
|
|
142 (setq addr-list (cdr addr-list)))
|
|
143 (setq re-list (cdr re-list))))
|
|
144 addresses )
|
|
145
|
|
146 (defun vm-ignored-reply-to (reply-to)
|
|
147 (if reply-to
|
|
148 (let (re-list result)
|
|
149 (setq re-list vm-reply-ignored-reply-tos)
|
|
150 (while re-list
|
|
151 (if (string-match (car re-list) reply-to)
|
|
152 (setq result t re-list nil)
|
|
153 (setq re-list (cdr re-list))))
|
|
154 result )))
|
|
155
|
|
156 (defun vm-mail-yank-default (message)
|
|
157 (save-excursion
|
|
158 (vm-reorder-message-headers nil vm-included-text-headers
|
|
159 vm-included-text-discard-header-regexp)
|
|
160 ;; if all the headers are gone, delete the trailing blank line, too.
|
|
161 (if (eq (following-char) ?\n)
|
|
162 (delete-char 1))
|
|
163 (if vm-included-text-attribution-format
|
|
164 (let ((vm-summary-uninteresting-senders nil))
|
|
165 (insert (vm-sprintf 'vm-included-text-attribution-format message))))
|
|
166 ; turn off zmacs-regions for Lucid Emacs 19
|
|
167 ; and get around transient-mark-mode in FSF Emacs 19
|
|
168 ; all this so that (mark) does what it did in v18, sheesh.
|
|
169 (let* ((zmacs-regions nil)
|
|
170 (mark-even-if-inactive t)
|
|
171 (end (mark-marker)))
|
|
172 (while (< (point) end)
|
|
173 (insert vm-included-text-prefix)
|
|
174 (forward-line 1)))))
|
|
175
|
|
176 (defun vm-yank-message-other-folder (folder)
|
|
177 "Like vm-yank-message except the message is yanked from a folder other
|
|
178 than the one that spawned the current Mail mode buffer. The name of the
|
|
179 folder is read from the minibuffer.
|
|
180
|
|
181 Don't call this function from a program."
|
|
182 (interactive
|
|
183 (list
|
|
184 (let ((dir (if vm-folder-directory
|
|
185 (expand-file-name vm-folder-directory)
|
|
186 default-directory))
|
|
187 (last-command last-command)
|
|
188 (this-command this-command))
|
|
189 (read-file-name "Yank from folder: " dir nil t))))
|
|
190 (let ((b (current-buffer)) newbuf sumbuf default result prompt mp)
|
|
191 (set-buffer (or (vm-get-file-buffer folder) (find-file-noselect folder)))
|
|
192 (setq newbuf (current-buffer))
|
|
193 (if (not (eq major-mode 'vm-mode))
|
|
194 (vm-mode))
|
|
195 (if (null vm-message-pointer)
|
|
196 (error "No messages in folder %s" folder))
|
|
197 (setq default (vm-number-of (car vm-message-pointer)))
|
|
198 (save-excursion
|
|
199 (save-window-excursion
|
|
200 (save-window-excursion
|
|
201 (vm-summarize))
|
|
202 (vm-display vm-summary-buffer t '(vm-yank-message-other-folder)
|
|
203 '(vm-yank-message-other-folder composing-message))
|
|
204 (setq sumbuf (current-buffer))
|
|
205 (setq prompt (format "Yank message number: (default %s) " default)
|
|
206 result 0)
|
|
207 (while (zerop result)
|
|
208 (setq result (read-string prompt))
|
|
209 (and (string= result "") default (setq result default))
|
|
210 (setq result (string-to-int result)))
|
|
211 (if (null (setq mp (nthcdr (1- result) vm-message-list)))
|
|
212 (error "No such message."))))
|
|
213 (set-buffer b)
|
|
214 (unwind-protect
|
|
215 (let ((vm-mail-buffer newbuf))
|
|
216 (vm-yank-message (car mp)))
|
|
217 (vm-bury-buffer newbuf)
|
|
218 (vm-bury-buffer sumbuf))))
|
|
219
|
|
220 (defun vm-yank-message (message)
|
|
221 "Yank message number N into the current buffer at point.
|
|
222 When called interactively N is always read from the minibuffer. When
|
|
223 called non-interactively the first argument is expected to be a
|
|
224 message struct.
|
|
225
|
|
226 This command is meant to be used in VM created Mail mode buffers; the
|
|
227 yanked message comes from the mail buffer containing the message you
|
|
228 are replying to, forwarding, or invoked VM's mail command from.
|
|
229
|
|
230 All message headers are yanked along with the text. Point is
|
|
231 left before the inserted text, the mark after. Any hook
|
|
232 functions bound to mail-citation-hook are run, after inserting
|
|
233 the text and setting point and mark. For backward compatibility,
|
|
234 if mail-citation-hook is set to nil, `mail-yank-hooks' is run
|
|
235 instead.
|
|
236
|
|
237 If mail-citation-hook and mail-yank-hooks are both nil, this
|
|
238 default action is taken: the yanked headers are trimmed as
|
|
239 specified by vm-included-text-headers and
|
|
240 vm-included-text-discard-header-regexp, and the value of
|
|
241 vm-included-text-prefix is prepended to every yanked line."
|
|
242 (interactive
|
|
243 (list
|
|
244 ;; What we really want for the first argument is a message struct,
|
|
245 ;; but if called interactively, we let the user type in a message
|
|
246 ;; number instead.
|
|
247 (let (mp default
|
|
248 (result 0)
|
|
249 prompt
|
|
250 (last-command last-command)
|
|
251 (this-command this-command))
|
|
252 (save-excursion
|
|
253 (vm-select-folder-buffer)
|
|
254 (setq default (and vm-message-pointer
|
|
255 (vm-number-of (car vm-message-pointer)))
|
|
256 prompt (if default
|
|
257 (format "Yank message number: (default %s) "
|
|
258 default)
|
|
259 "Yank message number: "))
|
|
260 (while (zerop result)
|
|
261 (setq result (read-string prompt))
|
|
262 (and (string= result "") default (setq result default))
|
|
263 (setq result (string-to-int result)))
|
|
264 (if (null (setq mp (nthcdr (1- result) vm-message-list)))
|
|
265 (error "No such message.")))
|
|
266 (car mp))))
|
|
267 (if (not (bufferp vm-mail-buffer))
|
|
268 (error "This is not a VM Mail mode buffer."))
|
|
269 (if (null (buffer-name vm-mail-buffer))
|
|
270 (error "The folder buffer containing message %d has been killed."
|
|
271 (vm-number-of message)))
|
|
272 (vm-display nil nil '(vm-yank-message) '(vm-yank-message composing-message))
|
|
273 (setq message (vm-real-message-of message))
|
|
274 (let ((b (current-buffer)) (start (point)) end)
|
|
275 (save-restriction
|
|
276 (widen)
|
|
277 (save-excursion
|
70
|
278 (set-buffer (vm-buffer-of message))
|
|
279 (save-restriction
|
|
280 (widen)
|
|
281 (append-to-buffer b (vm-headers-of message) (vm-text-end-of message))
|
|
282 (setq end (vm-marker (+ start (- (vm-text-end-of message)
|
|
283 (vm-headers-of message))) b))))
|
0
|
284 (push-mark end)
|
|
285 (cond (mail-citation-hook (run-hooks 'mail-citation-hook))
|
|
286 (mail-yank-hooks (run-hooks 'mail-yank-hooks))
|
|
287 (t (vm-mail-yank-default message))))))
|
|
288
|
|
289 (defun vm-mail-send-and-exit (arg)
|
|
290 "Just like mail-send-and-exit except that VM flags the appropriate message(s)
|
|
291 as having been replied to, if appropriate."
|
|
292 (interactive "P")
|
|
293 (let ((b (current-buffer)))
|
|
294 (vm-mail-send)
|
|
295 (cond ((null (buffer-name b)) ;; dead buffer
|
|
296 (vm-display nil nil '(vm-mail-send-and-exit)
|
70
|
297 '(vm-mail-send-and-exit reading-message startup)))
|
0
|
298 (t
|
|
299 (vm-display b nil '(vm-mail-send-and-exit)
|
|
300 '(vm-mail-send-and-exit reading-message startup))
|
|
301 (vm-bury-buffer b)))))
|
|
302
|
|
303 (defun vm-keep-mail-buffer (buffer)
|
|
304 ;; keep this buffer if the user demands it
|
|
305 (if (memq buffer vm-kept-mail-buffers)
|
|
306 (setq vm-kept-mail-buffers
|
|
307 (delq buffer vm-kept-mail-buffers)))
|
|
308 (setq vm-kept-mail-buffers (cons buffer vm-kept-mail-buffers)
|
|
309 vm-kept-mail-buffers (vm-delete 'buffer-name
|
|
310 vm-kept-mail-buffers t))
|
|
311 (if (not (eq vm-keep-sent-messages t))
|
|
312 (let ((extras (nthcdr (or vm-keep-sent-messages 0)
|
|
313 vm-kept-mail-buffers)))
|
|
314 (mapcar (function
|
|
315 (lambda (b)
|
70
|
316 (and (buffer-name b) (kill-buffer b))))
|
0
|
317 extras)
|
|
318 (and vm-kept-mail-buffers extras
|
|
319 (setcdr (memq (car extras) vm-kept-mail-buffers) nil)))))
|
|
320
|
|
321 (defun vm-help-tale ()
|
|
322 (save-excursion
|
|
323 (goto-char (point-min))
|
|
324 (while (vm-match-header)
|
|
325 (if (not (vm-match-header "To:\\|Resent-To:\\|Cc:\\|Resent-Cc:"))
|
|
326 (goto-char (vm-matched-header-end))
|
|
327 (goto-char (vm-matched-header-contents-start))
|
|
328 (if (re-search-forward "[^, \t][ \t]*\n[ \t\n]+[^ \t\n]"
|
|
329 (vm-matched-header-contents-end)
|
|
330 t)
|
|
331 (error "tale is an idiot, and so are you. :-)"))
|
|
332 (goto-char (vm-matched-header-end))))))
|
|
333
|
|
334 (defun vm-mail-send ()
|
|
335 "Just like mail-send except that VM flags the appropriate message(s)
|
|
336 as replied to, forwarded, etc, if appropriate."
|
|
337 (interactive)
|
|
338 (if vm-tale-is-an-idiot
|
|
339 (vm-help-tale))
|
70
|
340 (if (and vm-confirm-mail-send
|
|
341 (not (y-or-n-p "Send the message? ")))
|
|
342 (error "Message not sent."))
|
0
|
343 ;; this to prevent Emacs 19 from asking whether a message that
|
|
344 ;; has already been sent should be sent again. VM renames mail
|
|
345 ;; buffers after the message has been sent, so the user should
|
|
346 ;; already know that the message has been sent.
|
|
347 (set-buffer-modified-p t)
|
70
|
348 ;; don't want a buffer change to occur here
|
|
349 ;; save-excursion to be sure.
|
|
350 (save-excursion
|
|
351 (mail-send))
|
|
352 (vm-rename-current-mail-buffer)
|
|
353 (cond ((eq vm-system-state 'replying)
|
|
354 (vm-mail-mark-replied))
|
|
355 ((eq vm-system-state 'forwarding)
|
|
356 (vm-mail-mark-forwarded))
|
|
357 ((eq vm-system-state 'redistributing)
|
|
358 (vm-mail-mark-redistributed)))
|
|
359 (vm-keep-mail-buffer (current-buffer))
|
|
360 (vm-display nil nil '(vm-mail-send) '(vm-mail-send)))
|
0
|
361
|
|
362 (defun vm-rename-current-mail-buffer ()
|
|
363 (if vm-rename-current-buffer-function
|
|
364 (funcall vm-rename-current-buffer-function)
|
|
365 (let ((case-fold-search nil))
|
|
366 (if (not (string-match "^sent " (buffer-name)))
|
|
367 (let (prefix name n)
|
|
368 (if (not (= ?* (aref (buffer-name) 0)))
|
|
369 (setq prefix (format "sent %s" (buffer-name)))
|
|
370 (let (recipients)
|
|
371 (cond ((not (zerop (length (setq recipients
|
|
372 (mail-fetch-field "To"))))))
|
|
373 ((not (zerop (length (setq recipients
|
|
374 (mail-fetch-field "Cc"))))))
|
|
375 ((not (zerop (length (setq recipients
|
|
376 (mail-fetch-field "Bcc"))))))
|
|
377 ; can't happen?!?
|
|
378 (t (setq recipients "the horse with no name")))
|
|
379 (setq prefix (format "sent mail to %s" recipients))))
|
|
380 (if (> (length prefix) 44)
|
|
381 (setq prefix (concat (substring prefix 0 40) " ...")))
|
|
382 (setq name prefix n 2)
|
|
383 (while (get-buffer name)
|
|
384 (setq name (format "%s<%d>" prefix n))
|
|
385 (vm-increment n))
|
|
386 (rename-buffer name))))))
|
|
387
|
|
388 (defun vm-mail-mark-replied ()
|
|
389 (save-excursion
|
|
390 (let ((mp vm-reply-list))
|
|
391 (while mp
|
|
392 (if (null (buffer-name (vm-buffer-of (car mp))))
|
|
393 ()
|
|
394 (set-buffer (vm-buffer-of (car mp)))
|
|
395 (cond ((and (memq (car mp) vm-message-list)
|
|
396 (null (vm-replied-flag (car mp))))
|
|
397 (vm-set-replied-flag (car mp) t))))
|
|
398 (setq mp (cdr mp)))
|
|
399 (vm-update-summary-and-mode-line))))
|
|
400
|
|
401 (defun vm-mail-mark-forwarded ()
|
|
402 (save-excursion
|
|
403 (let ((mp vm-forward-list))
|
|
404 (while mp
|
|
405 (if (null (buffer-name (vm-buffer-of (car mp))))
|
|
406 ()
|
|
407 (set-buffer (vm-buffer-of (car mp)))
|
|
408 (cond ((and (memq (car mp) vm-message-list)
|
|
409 (null (vm-forwarded-flag (car mp))))
|
|
410 (vm-set-forwarded-flag (car mp) t))))
|
|
411 (setq mp (cdr mp)))
|
|
412 (vm-update-summary-and-mode-line))))
|
|
413
|
|
414 (defun vm-mail-mark-redistributed ()
|
|
415 (save-excursion
|
|
416 (let ((mp vm-redistribute-list))
|
|
417 (while mp
|
|
418 (if (null (buffer-name (vm-buffer-of (car mp))))
|
|
419 ()
|
|
420 (set-buffer (vm-buffer-of (car mp)))
|
|
421 (cond ((and (memq (car mp) vm-message-list)
|
|
422 (null (vm-redistributed-flag (car mp))))
|
|
423 (vm-set-redistributed-flag (car mp) t))))
|
|
424 (setq mp (cdr mp)))
|
|
425 (vm-update-summary-and-mode-line))))
|
|
426
|
|
427 (defun vm-reply (count)
|
|
428 "Reply to the sender of the current message.
|
|
429 Numeric prefix argument N means to reply to the current message plus the
|
|
430 next N-1 messages. A negative N means reply to the current message and
|
|
431 the previous N-1 messages.
|
|
432
|
|
433 If invoked on marked messages (via vm-next-command-uses-marks),
|
|
434 all marked messages will be replied to.
|
|
435
|
|
436 You will be placed into a standard Emacs Mail mode buffer to compose and
|
|
437 send your message. See the documentation for the function `mail' for
|
|
438 more info.
|
|
439
|
|
440 Note that the normal binding of C-c C-y in the reply buffer is
|
|
441 automatically changed to vm-yank-message during a reply. This
|
|
442 allows you to yank any message from the current folder into a
|
|
443 reply.
|
|
444
|
|
445 Normal VM commands may be accessed in the reply buffer by prefixing them
|
|
446 with C-c C-v."
|
|
447 (interactive "p")
|
|
448 (vm-follow-summary-cursor)
|
|
449 (vm-select-folder-buffer)
|
|
450 (vm-check-for-killed-summary)
|
|
451 (vm-error-if-folder-empty)
|
|
452 (vm-do-reply nil nil count))
|
|
453
|
|
454 (defun vm-reply-include-text (count)
|
|
455 "Reply to the sender (only) of the current message and include text
|
|
456 from the message. See the documentation for function vm-reply for details."
|
|
457 (interactive "p")
|
|
458 (vm-follow-summary-cursor)
|
|
459 (vm-select-folder-buffer)
|
|
460 (vm-check-for-killed-summary)
|
|
461 (vm-error-if-folder-empty)
|
|
462 (vm-do-reply nil t count))
|
|
463
|
|
464 (defun vm-followup (count)
|
|
465 "Reply to all recipients of the current message.
|
|
466 See the documentation for the function vm-reply for details."
|
|
467 (interactive "p")
|
|
468 (vm-follow-summary-cursor)
|
|
469 (vm-select-folder-buffer)
|
|
470 (vm-check-for-killed-summary)
|
|
471 (vm-error-if-folder-empty)
|
|
472 (vm-do-reply t nil count))
|
|
473
|
|
474 (defun vm-followup-include-text (count)
|
|
475 "Reply to all recipients of the current message and include text from
|
|
476 the message. See the documentation for the function vm-reply for details."
|
|
477 (interactive "p")
|
|
478 (vm-follow-summary-cursor)
|
|
479 (vm-select-folder-buffer)
|
|
480 (vm-check-for-killed-summary)
|
|
481 (vm-error-if-folder-empty)
|
|
482 (vm-do-reply t t count))
|
|
483
|
|
484 (defun vm-forward-message-all-headers ()
|
|
485 "Like vm-forward-message but always forwards all the headers."
|
|
486 (interactive)
|
|
487 (let ((vm-forwarded-headers nil)
|
70
|
488 (vm-unforwarded-header-regexp "only-drop-this-header"))
|
0
|
489 (vm-forward-message)))
|
|
490
|
|
491 (defun vm-forward-message ()
|
|
492 "Forward the current message to one or more recipients.
|
|
493 You will be placed in a Mail mode buffer as you would with a
|
|
494 reply, but you must fill in the To: header and perhaps the
|
|
495 Subject: header manually."
|
|
496 (interactive)
|
|
497 (vm-follow-summary-cursor)
|
|
498 (vm-select-folder-buffer)
|
|
499 (vm-check-for-killed-summary)
|
|
500 (vm-error-if-folder-empty)
|
70
|
501 (if (eq last-command 'vm-next-command-uses-marks)
|
0
|
502 (let ((vm-digest-send-type vm-forwarding-digest-type))
|
|
503 (setq this-command 'vm-next-command-uses-marks)
|
|
504 (command-execute 'vm-send-digest))
|
|
505 (let ((dir default-directory)
|
70
|
506 (mp vm-message-pointer))
|
0
|
507 (save-restriction
|
|
508 (widen)
|
|
509 (vm-mail-internal
|
|
510 (format "forward of %s's note re: %s"
|
|
511 (vm-su-full-name (car vm-message-pointer))
|
|
512 (vm-su-subject (car vm-message-pointer)))
|
|
513 nil
|
|
514 (and vm-forwarding-subject-format
|
|
515 (let ((vm-summary-uninteresting-senders nil))
|
|
516 (vm-sprintf 'vm-forwarding-subject-format (car mp)))))
|
|
517 (make-local-variable 'vm-forward-list)
|
|
518 (setq vm-system-state 'forwarding
|
|
519 vm-forward-list (list (car mp))
|
|
520 default-directory dir)
|
70
|
521 (goto-char (point-min))
|
|
522 (re-search-forward
|
|
523 (concat "^" (regexp-quote mail-header-separator) "\n") nil 0)
|
|
524 (cond ((equal vm-forwarding-digest-type "rfc934")
|
0
|
525 (vm-rfc934-encapsulate-messages
|
|
526 vm-forward-list vm-forwarded-headers
|
|
527 vm-unforwarded-header-regexp))
|
|
528 ((equal vm-forwarding-digest-type "rfc1153")
|
|
529 (vm-rfc1153-encapsulate-messages
|
|
530 vm-forward-list vm-forwarded-headers
|
|
531 vm-unforwarded-header-regexp))
|
|
532 ((equal vm-forwarding-digest-type nil)
|
|
533 (vm-no-frills-encapsulate-message
|
|
534 (car vm-forward-list) vm-forwarded-headers
|
|
535 vm-unforwarded-header-regexp)))
|
|
536 (mail-position-on-field "To"))
|
|
537 (run-hooks 'vm-forward-message-hook)
|
|
538 (run-hooks 'vm-mail-mode-hook))))
|
|
539
|
|
540 (defun vm-resend-bounced-message ()
|
|
541 "Extract the original text from a bounced message and resend it.
|
|
542 You will be placed in a Mail mode buffer with the extracted message and
|
|
543 you can change the recipient address before resending the message."
|
|
544 (interactive)
|
|
545 (vm-follow-summary-cursor)
|
|
546 (vm-select-folder-buffer)
|
|
547 (vm-check-for-killed-summary)
|
|
548 (vm-error-if-folder-empty)
|
|
549 (let ((b (current-buffer)) start
|
|
550 (dir default-directory)
|
|
551 (lim (vm-text-end-of (car vm-message-pointer))))
|
|
552 (save-restriction
|
|
553 (widen)
|
70
|
554 (save-excursion
|
|
555 (goto-char (vm-text-of (car vm-message-pointer)))
|
|
556 (let ((case-fold-search t))
|
|
557 ;; What a wonderful world it would be if mailers used a single
|
|
558 ;; message encapsulation standard instead all the weird variants
|
|
559 ;; It is useless to try to cover them all.
|
|
560 ;; This simple rule should cover the sanest of the formats
|
|
561 (if (not (re-search-forward "^Received:" lim t))
|
|
562 (error "This doesn't look like a bounced message."))
|
|
563 (beginning-of-line)
|
|
564 (setq start (point))))
|
0
|
565 ;; briefly nullify vm-mail-header-from to keep vm-mail-internal
|
|
566 ;; from inserting another From header.
|
|
567 (let ((vm-mail-header-from nil))
|
|
568 (vm-mail-internal
|
|
569 (format "retry of bounce from %s"
|
|
570 (vm-su-from (car vm-message-pointer)))))
|
|
571 (goto-char (point-min))
|
70
|
572 (insert-buffer-substring b start lim)
|
0
|
573 (delete-region (point) (point-max))
|
|
574 (goto-char (point-min))
|
|
575 ;; delete all but pertinent headers
|
|
576 (vm-reorder-message-headers nil nil "\\(X-VM-\\|Status:\\|Sender:\\)")
|
|
577 (vm-reorder-message-headers nil vm-resend-bounced-headers
|
|
578 vm-resend-bounced-discard-header-regexp)
|
|
579 (if (search-forward "\n\n" nil t)
|
|
580 (replace-match "")
|
|
581 (goto-char (point-max)))
|
|
582 (insert ?\n mail-header-separator ?\n)
|
70
|
583 (mail-position-on-field "To")
|
0
|
584 (setq default-directory dir)))
|
|
585 (run-hooks 'vm-resend-bounced-message-hook)
|
|
586 (run-hooks 'vm-mail-mode-hook))
|
|
587
|
|
588 (defun vm-resend-message ()
|
|
589 "Resend the current message to someone else.
|
|
590 The current message will be copied to a Mail mode buffer and you
|
|
591 can edit the message and send it as usual.
|
|
592
|
70
|
593 NOTE: since you are doing a resend, a Resent-To header is
|
|
594 provided for you to fill in. If you don't fill it in, when you
|
|
595 send the message it will go to the original recipients listed in
|
|
596 the To and Cc headers. You may also create a Resent-Cc header."
|
0
|
597 (interactive)
|
|
598 (vm-follow-summary-cursor)
|
|
599 (vm-select-folder-buffer)
|
|
600 (vm-check-for-killed-summary)
|
|
601 (vm-error-if-folder-empty)
|
|
602 (save-restriction
|
|
603 (widen)
|
|
604 (let ((b (current-buffer))
|
|
605 (dir default-directory)
|
|
606 (vmp vm-message-pointer)
|
|
607 (start (vm-headers-of (car vm-message-pointer)))
|
|
608 (lim (vm-text-end-of (car vm-message-pointer))))
|
|
609 ;; briefly nullify vm-mail-header-from to keep vm-mail-internal
|
|
610 ;; from inserting another From header.
|
|
611 (let ((vm-mail-header-from nil))
|
|
612 (vm-mail-internal
|
|
613 (format "resend of %s's note re: %s"
|
|
614 (vm-su-full-name (car vm-message-pointer))
|
|
615 (vm-su-subject (car vm-message-pointer)))))
|
|
616 (goto-char (point-min))
|
|
617 (insert-buffer-substring b start lim)
|
|
618 (delete-region (point) (point-max))
|
|
619 (goto-char (point-min))
|
|
620 (if vm-mail-header-from
|
|
621 (insert "Resent-From: " vm-mail-header-from ?\n))
|
|
622 (insert "Resent-To: \n")
|
|
623 (if mail-self-blind
|
|
624 (insert "Bcc: " (user-login-name) ?\n))
|
|
625 (if mail-archive-file-name
|
|
626 (insert "FCC: " mail-archive-file-name ?\n))
|
|
627 ;; delete all but pertinent headers
|
|
628 (vm-reorder-message-headers nil nil "\\(X-VM-\\|Status:\\|Sender:\\)")
|
|
629 (vm-reorder-message-headers nil vm-resend-headers
|
|
630 vm-resend-discard-header-regexp)
|
|
631 (if (search-forward "\n\n" nil t)
|
|
632 (replace-match ""))
|
|
633 (insert ?\n mail-header-separator ?\n)
|
|
634 (goto-char (point-min))
|
|
635 (mail-position-on-field "Resent-To")
|
|
636 (make-local-variable 'vm-redistribute-list)
|
|
637 (setq vm-system-state 'redistributing
|
|
638 vm-redistribute-list (list (car vmp))
|
|
639 default-directory dir)
|
|
640 (run-hooks 'vm-resend-message-hook)
|
|
641 (run-hooks 'vm-mail-mode-hook))))
|
|
642
|
|
643 (defun vm-send-digest (&optional prefix)
|
|
644 "Send a digest of all messages in the current folder to recipients.
|
|
645 The type of the digest is specified by the variable vm-digest-send-type.
|
|
646 You will be placed in a Mail mode buffer as is usual with replies, but you
|
|
647 must fill in the To: and Subject: headers manually.
|
|
648
|
|
649 Prefix arg means to insert a list of preamble lines at the beginning of
|
|
650 the digest. One line is generated for each message being digestified.
|
|
651 The variable vm-digest-preamble-format determines the format of the
|
|
652 preamble lines.
|
|
653
|
|
654 If invoked on marked messages (via vm-next-command-uses-marks),
|
|
655 only marked messages will be put into the digest."
|
|
656 (interactive "P")
|
|
657 (vm-select-folder-buffer)
|
|
658 (vm-check-for-killed-summary)
|
|
659 (vm-error-if-folder-empty)
|
|
660 (let ((dir default-directory)
|
70
|
661 (mp vm-message-pointer)
|
0
|
662 ;; prefix arg doesn't have "normal" meaning here, so only call
|
|
663 ;; vm-select-marked-or-prefixed-messages if we're using marks.
|
|
664 (mlist (if (eq last-command 'vm-next-command-uses-marks)
|
|
665 (vm-select-marked-or-prefixed-messages 0)
|
|
666 vm-message-list))
|
70
|
667 start)
|
0
|
668 (save-restriction
|
|
669 (widen)
|
|
670 (vm-mail-internal (format "digest from %s" (buffer-name)))
|
|
671 (make-local-variable 'vm-forward-list)
|
|
672 (setq vm-system-state 'forwarding
|
|
673 vm-forward-list mlist
|
|
674 default-directory dir)
|
70
|
675 (goto-char (point-min))
|
|
676 (re-search-forward (concat "^" (regexp-quote mail-header-separator)
|
|
677 "\n"))
|
|
678 (goto-char (match-end 0))
|
|
679 (setq start (point)
|
|
680 mp mlist)
|
|
681 (vm-unsaved-message "Building %s digest..." vm-digest-send-type)
|
|
682 (cond ((equal vm-digest-send-type "rfc934")
|
0
|
683 (vm-rfc934-encapsulate-messages
|
|
684 mlist vm-rfc934-digest-headers
|
|
685 vm-rfc934-digest-discard-header-regexp))
|
|
686 ((equal vm-digest-send-type "rfc1153")
|
|
687 (vm-rfc1153-encapsulate-messages
|
|
688 mlist vm-rfc1153-digest-headers
|
76
|
689 vm-rfc1153-digest-discard-header-regexp)))
|
0
|
690 (goto-char start)
|
|
691 (setq mp mlist)
|
54
|
692 (if prefix
|
70
|
693 (progn
|
|
694 (vm-unsaved-message "Building digest preamble...")
|
54
|
695 (while mp
|
|
696 (let ((vm-summary-uninteresting-senders nil))
|
|
697 (insert (vm-sprintf 'vm-digest-preamble-format (car mp)) "\n"))
|
|
698 (if vm-digest-center-preamble
|
|
699 (progn
|
|
700 (forward-char -1)
|
|
701 (center-line)
|
|
702 (forward-char 1)))
|
|
703 (setq mp (cdr mp)))))
|
0
|
704 (mail-position-on-field "To")
|
|
705 (message "Building %s digest... done" vm-digest-send-type)))
|
|
706 (run-hooks 'vm-send-digest-hook)
|
|
707 (run-hooks 'vm-mail-mode-hook))
|
|
708
|
|
709 (defun vm-send-rfc934-digest (&optional preamble)
|
|
710 "Like vm-send-digest but always sends an RFC 934 digest."
|
|
711 (interactive "P")
|
|
712 (let ((vm-digest-send-type "rfc934"))
|
|
713 (vm-send-digest preamble)))
|
|
714
|
|
715 (defun vm-send-rfc1153-digest (&optional preamble)
|
|
716 "Like vm-send-digest but always sends an RFC 1153 digest."
|
|
717 (interactive "P")
|
|
718 (let ((vm-digest-send-type "rfc1153"))
|
|
719 (vm-send-digest preamble)))
|
|
720
|
|
721 (defun vm-continue-composing-message (&optional not-picky)
|
|
722 "Find and select the most recently used mail composition buffer.
|
|
723 If the selected buffer is already a Mail mode buffer then it is
|
|
724 buried before beginning the search. Non Mail mode buffers and
|
|
725 unmodified Mail buffers are skipped. Prefix arg means unmodified
|
|
726 Mail mode buffers are not skipped. If no suitable buffer is
|
|
727 found, the current buffer remains selected."
|
|
728 (interactive "P")
|
|
729 (if (eq major-mode 'mail-mode)
|
|
730 (vm-bury-buffer (current-buffer)))
|
|
731 (let ((b (vm-find-composition-buffer not-picky)))
|
|
732 (if (not (or (null b) (eq b (current-buffer))))
|
|
733 (progn
|
|
734 ;; avoid having the window configuration code choose a
|
|
735 ;; different composition buffer.
|
|
736 (vm-unbury-buffer b)
|
|
737 (set-buffer b)
|
70
|
738 (if (and vm-frame-per-composition (vm-multiple-frames-possible-p)
|
0
|
739 ;; only pop up a frame if there's an undisplay
|
|
740 ;; hook in place to make the frame go away.
|
|
741 vm-undisplay-buffer-hook)
|
|
742 (let ((w (vm-get-buffer-window b)))
|
|
743 (if (null w)
|
|
744 (vm-goto-new-frame 'composition)
|
|
745 (select-window w)
|
|
746 (and vm-warp-mouse-to-new-frame
|
|
747 (vm-warp-mouse-to-frame-maybe (vm-window-frame w))))
|
|
748 ;; need to do this here too, since XEmacs has per
|
|
749 ;; frame buffer lists.
|
|
750 (vm-unbury-buffer b)
|
|
751 (vm-set-hooks-for-frame-deletion)))
|
|
752 (vm-display b t '(vm-continue-composing-message)
|
|
753 '(vm-continue-composing-message composing-message)))
|
|
754 (message "No composition buffers found"))))
|
|
755
|
|
756 ;; to quiet the v19 byte compiler
|
|
757 (defvar mail-mode-map)
|
|
758 (defvar mail-aliases)
|
|
759 (defvar mail-default-reply-to)
|
|
760 (defvar mail-signature-file)
|
|
761
|
|
762 (defun vm-mail-internal
|
|
763 (&optional buffer-name to subject in-reply-to cc references newsgroups)
|
|
764 (let ((folder-buffer nil))
|
|
765 (if (memq major-mode '(vm-mode vm-virtual-mode))
|
|
766 (setq folder-buffer (current-buffer)))
|
|
767 (set-buffer (generate-new-buffer (or buffer-name "*VM-mail*")))
|
|
768 ;; avoid trying to write auto-save files in potentially
|
|
769 ;; unwritable directories.
|
|
770 (setq default-directory (or vm-folder-directory (expand-file-name "~/")))
|
|
771 (auto-save-mode (if auto-save-default 1 -1))
|
|
772 (mail-mode)
|
|
773 (use-local-map vm-mail-mode-map)
|
|
774 ;; make mail-mode-map the parent of this vm-mail-mode-map, if we can.
|
|
775 ;; do it only once.
|
|
776 (if (not vm-mail-mode-map-parented)
|
|
777 (cond ((fboundp 'set-keymap-parents)
|
70
|
778 (set-keymap-parents vm-mail-mode-map (list mail-mode-map)))
|
0
|
779 ((consp mail-mode-map)
|
|
780 (nconc vm-mail-mode-map mail-mode-map)
|
|
781 (setq vm-mail-mode-map-parented t))))
|
|
782 (setq vm-mail-buffer folder-buffer
|
70
|
783 mode-popup-menu (and vm-use-menus
|
0
|
784 (vm-menu-support-possible-p)
|
|
785 (vm-menu-mode-menu)))
|
70
|
786 ;; sets up popup menu for FSF Emacs
|
0
|
787 (and vm-use-menus (vm-menu-support-possible-p)
|
|
788 (vm-menu-install-mail-mode-menu))
|
|
789 (if (fboundp 'mail-aliases-setup) ; use mail-abbrevs.el if present
|
|
790 (mail-aliases-setup)
|
|
791 (if (eq mail-aliases t)
|
|
792 (progn
|
|
793 (setq mail-aliases nil)
|
70
|
794 (if (file-exists-p "~/.mailrc")
|
0
|
795 (build-mail-aliases)))))
|
|
796 (if (stringp vm-mail-header-from)
|
|
797 (insert "From: " vm-mail-header-from "\n"))
|
|
798 (insert "To: " (or to "") "\n")
|
|
799 (and cc (insert "Cc: " cc "\n"))
|
|
800 (insert "Subject: " (or subject "") "\n")
|
|
801 (and newsgroups (insert "Newsgroups: " newsgroups "\n"))
|
|
802 (and in-reply-to (insert "In-Reply-To: " in-reply-to "\n"))
|
|
803 (and references (insert "References: " references "\n"))
|
70
|
804 ;; REPLYTO support for FSF Emacs v19.29
|
|
805 (and (eq mail-default-reply-to t)
|
0
|
806 (setq mail-default-reply-to (getenv "REPLYTO")))
|
|
807 (if mail-default-reply-to
|
|
808 (insert "Reply-To: " mail-default-reply-to "\n"))
|
|
809 (if mail-self-blind
|
|
810 (insert "Bcc: " (user-login-name) "\n"))
|
|
811 (if mail-archive-file-name
|
|
812 (insert "FCC: " mail-archive-file-name "\n"))
|
|
813 (if mail-default-headers
|
|
814 (insert mail-default-headers))
|
|
815 (if (not (= (preceding-char) ?\n))
|
|
816 (insert ?\n))
|
|
817 (insert mail-header-separator "\n")
|
|
818 (cond ((stringp mail-signature)
|
|
819 (save-excursion
|
|
820 (insert mail-signature)))
|
|
821 ((eq mail-signature t)
|
|
822 (save-excursion
|
|
823 (insert "-- \n")
|
|
824 (insert-file-contents (or (and (boundp 'mail-signature-file)
|
|
825 (stringp mail-signature-file)
|
|
826 mail-signature-file)
|
|
827 "~/.signature")))))
|
|
828 ;; move this buffer to the head of the buffer list so window
|
|
829 ;; config stuff will select it as the composition buffer.
|
|
830 (vm-unbury-buffer (current-buffer))
|
|
831 ;; make a new frame if the user wants it.
|
70
|
832 (if (and vm-frame-per-composition (vm-multiple-frames-possible-p))
|
0
|
833 (progn
|
|
834 (vm-goto-new-frame 'composition)
|
|
835 (vm-set-hooks-for-frame-deletion)))
|
|
836 ;; now do window configuration
|
|
837 (vm-display (current-buffer) t
|
|
838 '(vm-mail
|
|
839 vm-mail-other-frame
|
|
840 vm-mail-other-window
|
|
841 vm-reply
|
|
842 vm-reply-other-frame
|
|
843 vm-reply-include-text
|
|
844 vm-reply-include-text-other-frame
|
|
845 vm-followup
|
|
846 vm-followup-other-frame
|
|
847 vm-followup-include-text
|
|
848 vm-followup-include-text-other-frame
|
|
849 vm-send-digest
|
|
850 vm-send-digest-other-frame
|
|
851 vm-send-rfc934-digest
|
|
852 vm-send-rfc934-digest-other-frame
|
|
853 vm-send-rfc1153-digest
|
|
854 vm-send-rfc1153-digest-other-frame
|
|
855 vm-forward-message
|
|
856 vm-forward-message-other-frame
|
|
857 vm-forward-message-all-headers
|
|
858 vm-forward-message-all-headers-other-frame
|
|
859 vm-resend-message
|
|
860 vm-resend-message-other-frame
|
|
861 vm-resend-bounced-message
|
|
862 vm-resend-bounced-message-other-frame)
|
|
863 (list this-command 'composing-message))
|
|
864 (if (null to)
|
|
865 (mail-position-on-field "To"))
|
|
866 (run-hooks 'mail-setup-hook)))
|
|
867
|
|
868 (defun vm-reply-other-frame (count)
|
|
869 "Like vm-reply, but run in a newly created frame."
|
|
870 (interactive "p")
|
|
871 (if (vm-multiple-frames-possible-p)
|
|
872 (vm-goto-new-frame 'composition))
|
|
873 (let ((vm-frame-per-composition nil)
|
|
874 (vm-search-other-frames nil))
|
|
875 (vm-reply count))
|
|
876 (if (vm-multiple-frames-possible-p)
|
|
877 (vm-set-hooks-for-frame-deletion)))
|
|
878
|
|
879 (defun vm-reply-include-text-other-frame (count)
|
|
880 "Like vm-reply-include-text, but run in a newly created frame."
|
|
881 (interactive "p")
|
|
882 (if (vm-multiple-frames-possible-p)
|
|
883 (vm-goto-new-frame 'composition))
|
|
884 (let ((vm-frame-per-composition nil)
|
|
885 (vm-search-other-frames nil))
|
|
886 (vm-reply-include-text count))
|
|
887 (if (vm-multiple-frames-possible-p)
|
|
888 (vm-set-hooks-for-frame-deletion)))
|
|
889
|
|
890 (defun vm-followup-other-frame (count)
|
|
891 "Like vm-followup, but run in a newly created frame."
|
|
892 (interactive "p")
|
|
893 (if (vm-multiple-frames-possible-p)
|
|
894 (vm-goto-new-frame 'composition))
|
|
895 (let ((vm-frame-per-composition nil)
|
|
896 (vm-search-other-frames nil))
|
|
897 (vm-followup count))
|
|
898 (if (vm-multiple-frames-possible-p)
|
|
899 (vm-set-hooks-for-frame-deletion)))
|
|
900
|
|
901 (defun vm-followup-include-text-other-frame (count)
|
|
902 "Like vm-followup-include-text, but run in a newly created frame."
|
|
903 (interactive "p")
|
|
904 (if (vm-multiple-frames-possible-p)
|
|
905 (vm-goto-new-frame 'composition))
|
|
906 (let ((vm-frame-per-composition nil)
|
|
907 (vm-search-other-frames nil))
|
|
908 (vm-followup-include-text count))
|
|
909 (if (vm-multiple-frames-possible-p)
|
|
910 (vm-set-hooks-for-frame-deletion)))
|
|
911
|
|
912 (defun vm-forward-message-all-headers-other-frame ()
|
|
913 "Like vm-forward-message-all-headers, but run in a newly created frame."
|
|
914 (interactive)
|
|
915 (if (vm-multiple-frames-possible-p)
|
|
916 (vm-goto-new-frame 'composition))
|
|
917 (let ((vm-frame-per-composition nil)
|
|
918 (vm-search-other-frames nil))
|
|
919 (vm-forward-message-all-headers))
|
|
920 (if (vm-multiple-frames-possible-p)
|
|
921 (vm-set-hooks-for-frame-deletion)))
|
|
922
|
|
923 (defun vm-forward-message-other-frame ()
|
|
924 "Like vm-forward-message, but run in a newly created frame."
|
|
925 (interactive)
|
|
926 (if (vm-multiple-frames-possible-p)
|
|
927 (vm-goto-new-frame 'composition))
|
|
928 (let ((vm-frame-per-composition nil)
|
|
929 (vm-search-other-frames nil))
|
|
930 (vm-forward-message))
|
|
931 (if (vm-multiple-frames-possible-p)
|
|
932 (vm-set-hooks-for-frame-deletion)))
|
|
933
|
|
934 (defun vm-resend-message-other-frame ()
|
|
935 "Like vm-resend-message, but run in a newly created frame."
|
|
936 (interactive)
|
|
937 (if (vm-multiple-frames-possible-p)
|
|
938 (vm-goto-new-frame 'composition))
|
|
939 (let ((vm-frame-per-composition nil)
|
|
940 (vm-search-other-frames nil))
|
|
941 (vm-resend-message))
|
|
942 (if (vm-multiple-frames-possible-p)
|
|
943 (vm-set-hooks-for-frame-deletion)))
|
|
944
|
|
945 (defun vm-resend-bounced-message-other-frame ()
|
|
946 "Like vm-resend-bounced-message, but run in a newly created frame."
|
|
947 (interactive)
|
|
948 (if (vm-multiple-frames-possible-p)
|
|
949 (vm-goto-new-frame 'composition))
|
|
950 (let ((vm-frame-per-composition nil)
|
|
951 (vm-search-other-frames nil))
|
|
952 (vm-resend-bounced-message))
|
|
953 (if (vm-multiple-frames-possible-p)
|
|
954 (vm-set-hooks-for-frame-deletion)))
|
|
955
|
|
956 (defun vm-send-digest-other-frame (&optional prefix)
|
|
957 "Like vm-send-digest, but run in a newly created frame."
|
|
958 (interactive "P")
|
|
959 (if (vm-multiple-frames-possible-p)
|
|
960 (vm-goto-new-frame 'composition))
|
|
961 (let ((vm-frame-per-composition nil)
|
|
962 (vm-search-other-frames nil))
|
|
963 (vm-send-digest prefix))
|
|
964 (if (vm-multiple-frames-possible-p)
|
|
965 (vm-set-hooks-for-frame-deletion)))
|
|
966
|
|
967 (defun vm-send-rfc934-digest-other-frame (&optional prefix)
|
|
968 "Like vm-send-rfc934-digest, but run in a newly created frame."
|
|
969 (interactive "P")
|
|
970 (if (vm-multiple-frames-possible-p)
|
|
971 (vm-goto-new-frame 'composition))
|
|
972 (let ((vm-frame-per-composition nil)
|
|
973 (vm-search-other-frames nil))
|
|
974 (vm-send-rfc934-digest prefix))
|
|
975 (if (vm-multiple-frames-possible-p)
|
|
976 (vm-set-hooks-for-frame-deletion)))
|
|
977
|
|
978 (defun vm-send-rfc1153-digest-other-frame (&optional prefix)
|
|
979 "Like vm-send-rfc1153-digest, but run in a newly created frame."
|
|
980 (interactive "P")
|
|
981 (if (vm-multiple-frames-possible-p)
|
|
982 (vm-goto-new-frame 'composition))
|
|
983 (let ((vm-frame-per-composition nil)
|
|
984 (vm-search-other-frames nil))
|
|
985 (vm-send-rfc1153-digest prefix))
|
|
986 (if (vm-multiple-frames-possible-p)
|
|
987 (vm-set-hooks-for-frame-deletion)))
|