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