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