annotate lisp/vm/vm-reply.el @ 76:c0c698873ce1 r20-0b33

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