comparison lisp/mail/sendmail.el @ 88155:d7ddb3e565de

sync with trunk
author Henrik Enberg <henrik.enberg@telia.com>
date Mon, 16 Jan 2006 00:03:54 +0000
parents 0d8b17d428b5
children
comparison
equal deleted inserted replaced
88154:8ce476d3ba36 88155:d7ddb3e565de
1 ;;; sendmail.el --- mail sending commands for Emacs. -*- byte-compile-dynamic: t -*- 1 ;;; sendmail.el --- mail sending commands for Emacs. -*- byte-compile-dynamic: t -*-
2 2
3 ;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 98, 2000, 2001, 2002, 2003 3 ;; Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995, 1996, 1998, 2000,
4 ;; Free Software Foundation, Inc. 4 ;; 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
5 5
6 ;; Maintainer: FSF 6 ;; Maintainer: FSF
7 ;; Keywords: mail 7 ;; Keywords: mail
8 8
9 ;; This file is part of GNU Emacs. 9 ;; This file is part of GNU Emacs.
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details. 19 ;; GNU General Public License for more details.
20 20
21 ;; You should have received a copy of the GNU General Public License 21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the 22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24 ;; Boston, MA 02111-1307, USA. 24 ;; Boston, MA 02110-1301, USA.
25 25
26 ;;; Commentary: 26 ;;; Commentary:
27 27
28 ;; This mode provides mail-sending facilities from within Emacs. It is 28 ;; This mode provides mail-sending facilities from within Emacs. It is
29 ;; documented in the Emacs user's manual. 29 ;; documented in the Emacs user's manual.
40 (defgroup sendmail nil 40 (defgroup sendmail nil
41 "Mail sending commands for Emacs." 41 "Mail sending commands for Emacs."
42 :prefix "mail-" 42 :prefix "mail-"
43 :group 'mail) 43 :group 'mail)
44 44
45 ;;;###autoload 45 (defcustom mail-setup-with-from t
46 (defcustom mail-from-style 'angles "\ 46 "Non-nil means insert `From:' field when setting up the message."
47 *Specifies how \"From:\" fields look. 47 :type 'boolean
48 :group 'sendmail
49 :version "22.1")
50
51 ;;;###autoload
52 (defcustom mail-from-style 'angles
53 "Specifies how \"From:\" fields look.
48 54
49 If `nil', they contain just the return address like: 55 If `nil', they contain just the return address like:
50 king@grassland.com 56 king@grassland.com
51 If `parens', they look like: 57 If `parens', they look like:
52 king@grassland.com (Elvis Parsley) 58 king@grassland.com (Elvis Parsley)
64 :version "20.3" 70 :version "20.3"
65 :group 'sendmail) 71 :group 'sendmail)
66 72
67 ;;;###autoload 73 ;;;###autoload
68 (defcustom mail-specify-envelope-from nil 74 (defcustom mail-specify-envelope-from nil
69 "*If non-nil, specify the envelope-from address when sending mail. 75 "If non-nil, specify the envelope-from address when sending mail.
70 The value used to specify it is whatever is found in 76 The value used to specify it is whatever is found in
71 `mail-envelope-from', with `user-mail-address' as fallback. 77 the variable `mail-envelope-from', with `user-mail-address' as fallback.
72 78
73 On most systems, specifying the envelope-from address 79 On most systems, specifying the envelope-from address is a
74 is a privileged operation." 80 privileged operation. This variable affects sendmail and
81 smtpmail -- if you use feedmail to send mail, see instead the
82 variable `feedmail-deduce-envelope-from'."
75 :version "21.1" 83 :version "21.1"
76 :type 'boolean 84 :type 'boolean
77 :group 'sendmail) 85 :group 'sendmail)
78 86
79 (defcustom mail-envelope-from nil 87 (defcustom mail-envelope-from nil
80 "*If non-nil, designate the envelope-from address when sending mail. 88 "If non-nil, designate the envelope-from address when sending mail.
81 If this is nil while `mail-specify-envelope-from' is non-nil, the 89 This only has an effect if `mail-specify-envelope-from' is non-nil.
82 content of `user-mail-address' is used." 90 The value should be either a string, or the symbol `header' (in
91 which case the contents of the \"From\" header of the message
92 being sent is used), or nil (in which case the value of
93 `user-mail-address' is used)."
83 :version "21.1" 94 :version "21.1"
84 :type '(choice (string :tag "From-name") 95 :type '(choice (string :tag "From-name")
85 (const :tag "Use From: header from message" header) 96 (const :tag "Use From: header from message" header)
86 (const :tag "Use `user-mail-address'" nil)) 97 (const :tag "Use `user-mail-address'" nil))
87 :group 'sendmail) 98 :group 'sendmail)
88 99
89 ;;;###autoload 100 ;;;###autoload
90 (defcustom mail-self-blind nil "\ 101 (defcustom mail-self-blind nil
91 *Non-nil means insert BCC to self in messages to be sent. 102 "Non-nil means insert BCC to self in messages to be sent.
92 This is done when the message is initialized, 103 This is done when the message is initialized,
93 so you can remove or alter the BCC field to override the default." 104 so you can remove or alter the BCC field to override the default."
94 :type 'boolean 105 :type 'boolean
95 :group 'sendmail) 106 :group 'sendmail)
96 107
97 ;;;###autoload 108 ;;;###autoload
98 (defcustom mail-interactive nil "\ 109 (defcustom mail-interactive nil
99 *Non-nil means when sending a message wait for and display errors. 110 "Non-nil means when sending a message wait for and display errors.
100 nil means let mailer mail back a message to report errors." 111 nil means let mailer mail back a message to report errors."
101 :type 'boolean 112 :type 'boolean
102 :group 'sendmail) 113 :group 'sendmail)
103 114
104 ;;;###autoload 115 (defcustom mail-yank-ignored-headers
105 (defcustom mail-yank-ignored-headers "^via:\\|^mail-from:\\|^origin:\\|^status:\\|^remailed\\|^received:\\|^message-id:\\|^summary-line:\\|^to:\\|^subject:\\|^in-reply-to:\\|^return-path:" "\ 116 (concat "^"
106 *Delete these headers from old message when it's inserted in a reply." 117 (regexp-opt '("via" "mail-from" "origin" "status" "remailed"
118 "received" "message-id" "summary-line" "to" "subject"
119 "in-reply-to" "return-path" "mail-reply-to"
120 "mail-followup-to") "\\(?:")
121 ":")
122 "Delete these headers from old message when it's inserted in a reply."
107 :type 'regexp 123 :type 'regexp
108 :group 'sendmail) 124 :group 'sendmail)
109 125
126 ;; Prevent problems with `window-system' not having the correct value
127 ;; when loaddefs.el is loaded. `custom-reevaluate-setting' needs the
128 ;; standard value.
129 ;;;###autoload
130 (put 'send-mail-function 'standard-value
131 '((if (and window-system (memq system-type '(darwin windows-nt)))
132 'mailclient-send-it
133 'sendmail-send-it)))
134
110 ;; Useful to set in site-init.el 135 ;; Useful to set in site-init.el
111 ;;;###autoload 136 ;;;###autoload
112 (defcustom send-mail-function 'sendmail-send-it 137 (defcustom send-mail-function
138 (if (and window-system (memq system-type '(darwin windows-nt)))
139 'mailclient-send-it
140 'sendmail-send-it)
113 "Function to call to send the current buffer as mail. 141 "Function to call to send the current buffer as mail.
114 The headers should be delimited by a line which is 142 The headers should be delimited by a line which is
115 not a valid RFC822 header or continuation line, 143 not a valid RFC822 header or continuation line,
116 that matches the variable `mail-header-separator'. 144 that matches the variable `mail-header-separator'.
117 This is used by the default mail-sending commands. See also 145 This is used by the default mail-sending commands. See also
118 `message-send-mail-function' for use with the Message package." 146 `message-send-mail-function' for use with the Message package."
119 :type '(radio (function-item sendmail-send-it :tag "Use Sendmail package") 147 :type '(radio (function-item sendmail-send-it :tag "Use Sendmail package")
120 (function-item smtpmail-send-it :tag "Use SMTPmail package") 148 (function-item smtpmail-send-it :tag "Use SMTPmail package")
121 (function-item feedmail-send-it :tag "Use Feedmail package") 149 (function-item feedmail-send-it :tag "Use Feedmail package")
150 (function-item mailclient-send-it :tag "Use Mailclient package")
122 function) 151 function)
123 :group 'sendmail) 152 :group 'sendmail)
124 153
125 ;;;###autoload 154 ;;;###autoload
126 (defcustom mail-header-separator "--text follows this line--" "\ 155 (defcustom mail-header-separator "--text follows this line--"
127 *Line used to separate headers from text in messages being composed." 156 "Line used to separate headers from text in messages being composed."
128 :type 'string 157 :type 'string
129 :group 'sendmail) 158 :group 'sendmail)
130 159
131 ;; Set up mail-header-separator for use as a category text property. 160 ;; Set up mail-header-separator for use as a category text property.
132 (put 'mail-header-separator 'rear-nonsticky '(category)) 161 (put 'mail-header-separator 'rear-nonsticky '(category))
133 ;;; This was a nice idea, for preventing accidental modification of 162 ;; This was a nice idea, for preventing accidental modification of
134 ;;; the separator. But I found it also prevented or obstructed 163 ;; the separator. But I found it also prevented or obstructed
135 ;;; certain deliberate operations, such as copying the separator line 164 ;; certain deliberate operations, such as copying the separator line
136 ;;; up to the top to send myself a copy of an already sent outgoing message 165 ;; up to the top to send myself a copy of an already sent outgoing message
137 ;;; and other things. So I turned it off. --rms. 166 ;; and other things. So I turned it off. --rms.
138 ;;;(put 'mail-header-separator 'read-only t) 167 ;;(put 'mail-header-separator 'read-only t)
139 168
140 ;;;###autoload 169 ;;;###autoload
141 (defcustom mail-archive-file-name nil "\ 170 (defcustom mail-archive-file-name nil
142 *Name of file to write all outgoing messages in, or nil for none. 171 "Name of file to write all outgoing messages in, or nil for none.
143 This can be an inbox file or an Rmail file." 172 This can be an inbox file or an Rmail file."
144 :type '(choice file (const nil)) 173 :type '(choice file (const nil))
145 :group 'sendmail) 174 :group 'sendmail)
146 175
147 ;;;###autoload 176 ;;;###autoload
148 (defcustom mail-default-reply-to nil 177 (defcustom mail-default-reply-to nil
149 "*Address to insert as default Reply-to field of outgoing messages. 178 "Address to insert as default Reply-to field of outgoing messages.
150 If nil, it will be initialized from the REPLYTO environment variable 179 If nil, it will be initialized from the REPLYTO environment variable
151 when you first send mail." 180 when you first send mail."
152 :type '(choice (const nil) string) 181 :type '(choice (const nil) string)
153 :group 'sendmail) 182 :group 'sendmail)
154 183
155 ;;;###autoload 184 ;;;###autoload
156 (defcustom mail-alias-file nil 185 (defcustom mail-alias-file nil
157 "*If non-nil, the name of a file to use instead of `/usr/lib/aliases'. 186 "If non-nil, the name of a file to use instead of `/usr/lib/aliases'.
158 This file defines aliases to be expanded by the mailer; this is a different 187 This file defines aliases to be expanded by the mailer; this is a different
159 feature from that of defining aliases in `.mailrc' to be expanded in Emacs. 188 feature from that of defining aliases in `.mailrc' to be expanded in Emacs.
160 This variable has no effect unless your system uses sendmail as its mailer." 189 This variable has no effect unless your system uses sendmail as its mailer."
161 :type '(choice (const nil) file) 190 :type '(choice (const nil) file)
162 :group 'sendmail) 191 :group 'sendmail)
163 192
164 ;;;###autoload 193 ;;;###autoload
165 (defcustom mail-personal-alias-file "~/.mailrc" 194 (defcustom mail-personal-alias-file "~/.mailrc"
166 "*If non-nil, the name of the user's personal mail alias file. 195 "If non-nil, the name of the user's personal mail alias file.
167 This file typically should be in same format as the `.mailrc' file used by 196 This file typically should be in same format as the `.mailrc' file used by
168 the `Mail' or `mailx' program. 197 the `Mail' or `mailx' program.
169 This file need not actually exist." 198 This file need not actually exist."
170 :type '(choice (const nil) file) 199 :type '(choice (const nil) file)
171 :group 'sendmail) 200 :group 'sendmail)
172 201
202 ;;;###autoload
173 (defcustom mail-setup-hook nil 203 (defcustom mail-setup-hook nil
174 "Normal hook, run each time a new outgoing mail message is initialized. 204 "Normal hook, run each time a new outgoing mail message is initialized.
175 The function `mail-setup' runs this hook." 205 The function `mail-setup' runs this hook."
176 :type 'hook 206 :type 'hook
177 :options '(fortune-to-signature spook mail-abbrevs-setup) 207 :options '(fortune-to-signature spook mail-abbrevs-setup)
178 :group 'sendmail) 208 :group 'sendmail)
179 209
210 ;;;###autoload
180 (defvar mail-aliases t 211 (defvar mail-aliases t
181 "Alist of mail address aliases, 212 "Alist of mail address aliases,
182 or t meaning should be initialized from your mail aliases file. 213 or t meaning should be initialized from your mail aliases file.
183 \(The file's name is normally `~/.mailrc', but your MAILRC environment 214 \(The file's name is normally `~/.mailrc', but `mail-personal-alias-file'
184 variable can override that name.) 215 can specify a different file name.)
185 The alias definitions in the file have this form: 216 The alias definitions in the file have this form:
186 alias ALIAS MEANING") 217 alias ALIAS MEANING")
187 218
188 (defvar mail-alias-modtime nil 219 (defvar mail-alias-modtime nil
189 "The modification time of your mail alias file when it was last examined.") 220 "The modification time of your mail alias file when it was last examined.")
190 221
222 ;;;###autoload
191 (defcustom mail-yank-prefix nil 223 (defcustom mail-yank-prefix nil
192 "*Prefix insert on lines of yanked message being replied to. 224 "Prefix insert on lines of yanked message being replied to.
193 nil means use indentation." 225 nil means use indentation."
194 :type '(choice (const nil) string) 226 :type '(choice (const nil) string)
195 :group 'sendmail) 227 :group 'sendmail)
196 228
229 ;;;###autoload
197 (defcustom mail-indentation-spaces 3 230 (defcustom mail-indentation-spaces 3
198 "*Number of spaces to insert at the beginning of each cited line. 231 "Number of spaces to insert at the beginning of each cited line.
199 Used by `mail-yank-original' via `mail-indent-citation'." 232 Used by `mail-yank-original' via `mail-indent-citation'."
200 :type 'integer 233 :type 'integer
201 :group 'sendmail) 234 :group 'sendmail)
235
202 (defvar mail-yank-hooks nil 236 (defvar mail-yank-hooks nil
203 "Obsolete hook for modifying a citation just inserted in the mail buffer. 237 "Obsolete hook for modifying a citation just inserted in the mail buffer.
204 Each hook function can find the citation between (point) and (mark t). 238 Each hook function can find the citation between (point) and (mark t).
205 And each hook function should leave point and mark around the citation 239 And each hook function should leave point and mark around the citation
206 text as modified. 240 text as modified.
207 241
208 This is a normal hook, misnamed for historical reasons. 242 This is a normal hook, misnamed for historical reasons.
209 It is semi-obsolete and mail agents should no longer use it.") 243 It is semi-obsolete and mail agents should no longer use it.")
210 244
245 ;;;###autoload
211 (defcustom mail-citation-hook nil 246 (defcustom mail-citation-hook nil
212 "*Hook for modifying a citation just inserted in the mail buffer. 247 "Hook for modifying a citation just inserted in the mail buffer.
213 Each hook function can find the citation between (point) and (mark t), 248 Each hook function can find the citation between (point) and (mark t),
214 and should leave point and mark around the citation text as modified. 249 and should leave point and mark around the citation text as modified.
215 The hook functions can find the header of the cited message 250 The hook functions can find the header of the cited message
216 in the variable `mail-citation-header', whether or not this is included 251 in the variable `mail-citation-header', whether or not this is included
217 in the cited portion of the message. 252 in the cited portion of the message.
224 (defvar mail-citation-header nil 259 (defvar mail-citation-header nil
225 "While running `mail-citation-hook', this variable holds the message header. 260 "While running `mail-citation-hook', this variable holds the message header.
226 This enables the hook functions to see the whole message header 261 This enables the hook functions to see the whole message header
227 regardless of what part of it (if any) is included in the cited text.") 262 regardless of what part of it (if any) is included in the cited text.")
228 263
264 ;;;###autoload
229 (defcustom mail-citation-prefix-regexp "[ \t]*[-a-z0-9A-Z]*>+[ \t]*\\|[ \t]*" 265 (defcustom mail-citation-prefix-regexp "[ \t]*[-a-z0-9A-Z]*>+[ \t]*\\|[ \t]*"
230 "*Regular expression to match a citation prefix plus whitespace. 266 "Regular expression to match a citation prefix plus whitespace.
231 It should match whatever sort of citation prefixes you want to handle, 267 It should match whatever sort of citation prefixes you want to handle,
232 with whitespace before and after; it should also match just whitespace. 268 with whitespace before and after; it should also match just whitespace.
233 The default value matches citations like `foo-bar>' plus whitespace." 269 The default value matches citations like `foo-bar>' plus whitespace."
234 :type 'regexp 270 :type 'regexp
235 :group 'sendmail 271 :group 'sendmail
236 :version "20.3") 272 :version "20.3")
237 273
238 (defvar mail-abbrevs-loaded nil) 274 (defvar mail-abbrevs-loaded nil)
239 (defvar mail-mode-map nil) 275 (defvar mail-mode-map
276 (let ((map (make-sparse-keymap)))
277 (define-key map "\M-\t" 'mail-complete)
278 (define-key map "\C-c?" 'describe-mode)
279 (define-key map "\C-c\C-f\C-t" 'mail-to)
280 (define-key map "\C-c\C-f\C-b" 'mail-bcc)
281 (define-key map "\C-c\C-f\C-f" 'mail-fcc)
282 (define-key map "\C-c\C-f\C-c" 'mail-cc)
283 (define-key map "\C-c\C-f\C-s" 'mail-subject)
284 (define-key map "\C-c\C-f\C-r" 'mail-reply-to)
285 (define-key map "\C-c\C-f\C-a" 'mail-mail-reply-to) ; author
286 (define-key map "\C-c\C-f\C-l" 'mail-mail-followup-to) ; list
287 (define-key map "\C-c\C-t" 'mail-text)
288 (define-key map "\C-c\C-y" 'mail-yank-original)
289 (define-key map "\C-c\C-r" 'mail-yank-region)
290 (define-key map [remap split-line] 'mail-split-line)
291 (define-key map "\C-c\C-q" 'mail-fill-yanked-message)
292 (define-key map "\C-c\C-w" 'mail-signature)
293 (define-key map "\C-c\C-v" 'mail-sent-via)
294 (define-key map "\C-c\C-c" 'mail-send-and-exit)
295 (define-key map "\C-c\C-s" 'mail-send)
296 (define-key map "\C-c\C-i" 'mail-attach-file)
297
298 (define-key map [menu-bar mail]
299 (cons "Mail" (make-sparse-keymap "Mail")))
300
301 (define-key map [menu-bar mail fill]
302 '("Fill Citation" . mail-fill-yanked-message))
303
304 (define-key map [menu-bar mail yank]
305 '("Cite Original" . mail-yank-original))
306
307 (define-key map [menu-bar mail signature]
308 '("Insert Signature" . mail-signature))
309
310 (define-key map [menu-bar mail mail-sep]
311 '("--"))
312
313 (define-key map [menu-bar mail cancel]
314 '("Cancel" . mail-dont-send))
315
316 (define-key map [menu-bar mail send-stay]
317 '("Send, Keep Editing" . mail-send))
318
319 (define-key map [menu-bar mail send]
320 '("Send Message" . mail-send-and-exit))
321
322 (define-key map [menu-bar headers]
323 (cons "Headers" (make-sparse-keymap "Move to Header")))
324
325 (define-key map [menu-bar headers text]
326 '("Text" . mail-text))
327
328 (define-key map [menu-bar headers expand-aliases]
329 '("Expand Aliases" . expand-mail-aliases))
330
331 (define-key map [menu-bar headers sent-via]
332 '("Sent Via" . mail-sent-via))
333
334 (define-key map [menu-bar headers mail-reply-to]
335 '("Mail Reply To" . mail-mail-reply-to))
336
337 (define-key map [menu-bar headers mail-followup-to]
338 '("Mail Followup To" . mail-mail-followup-to))
339
340 (define-key map [menu-bar headers reply-to]
341 '("Reply-To" . mail-reply-to))
342
343 (define-key map [menu-bar headers bcc]
344 '("Bcc" . mail-bcc))
345
346 (define-key map [menu-bar headers fcc]
347 '("Fcc" . mail-fcc))
348
349 (define-key map [menu-bar headers cc]
350 '("Cc" . mail-cc))
351
352 (define-key map [menu-bar headers subject]
353 '("Subject" . mail-subject))
354
355 (define-key map [menu-bar headers to]
356 '("To" . mail-to))
357
358 map))
240 359
241 (autoload 'build-mail-aliases "mailalias" 360 (autoload 'build-mail-aliases "mailalias"
242 "Read mail aliases from user's personal aliases file and set `mail-aliases'." 361 "Read mail aliases from user's personal aliases file and set `mail-aliases'."
243 nil) 362 nil)
244 363
249 removed from alias expansions." 368 removed from alias expansions."
250 nil) 369 nil)
251 370
252 ;;;###autoload 371 ;;;###autoload
253 (defcustom mail-signature nil 372 (defcustom mail-signature nil
254 "*Text inserted at end of mail buffer when a message is initialized. 373 "Text inserted at end of mail buffer when a message is initialized.
255 If t, it means to insert the contents of the file `mail-signature-file'. 374 If t, it means to insert the contents of the file `mail-signature-file'.
256 If a string, that string is inserted. 375 If a string, that string is inserted.
257 (To make a proper signature, the string should begin with \\n\\n-- \\n, 376 (To make a proper signature, the string should begin with \\n\\n-- \\n,
258 which is the standard way to delimit a signature in a message.) 377 which is the standard way to delimit a signature in a message.)
259 Otherwise, it should be an expression; it is evaluated 378 Otherwise, it should be an expression; it is evaluated
263 (string :tag "String to insert") 382 (string :tag "String to insert")
264 (sexp :tag "Expression to evaluate")) 383 (sexp :tag "Expression to evaluate"))
265 :group 'sendmail) 384 :group 'sendmail)
266 (put 'mail-signature 'risky-local-variable t) 385 (put 'mail-signature 'risky-local-variable t)
267 386
387 ;;;###autoload
268 (defcustom mail-signature-file "~/.signature" 388 (defcustom mail-signature-file "~/.signature"
269 "*File containing the text inserted at end of mail buffer." 389 "File containing the text inserted at end of mail buffer."
270 :type 'file 390 :type 'file
271 :group 'sendmail) 391 :group 'sendmail)
272 392
273 ;;;###autoload 393 ;;;###autoload
274 (defcustom mail-default-directory "~/" 394 (defcustom mail-default-directory "~/"
275 "*Directory for mail buffers. 395 "Directory for mail buffers.
276 Value of `default-directory' for mail buffers. 396 Value of `default-directory' for mail buffers.
277 This directory is used for auto-save files of mail buffers." 397 This directory is used for auto-save files of mail buffers."
278 :type '(directory :tag "Directory") 398 :type '(directory :tag "Directory")
279 :group 'sendmail 399 :group 'sendmail
280 :version "21.4") 400 :version "22.1")
281 401
282 (defvar mail-reply-action nil) 402 (defvar mail-reply-action nil)
283 (defvar mail-send-actions nil 403 (defvar mail-send-actions nil
284 "A list of actions to be performed upon successful sending of a message.") 404 "A list of actions to be performed upon successful sending of a message.")
285 (put 'mail-reply-action 'permanent-local t) 405 (put 'mail-reply-action 'permanent-local t)
286 (put 'mail-send-actions 'permanent-local t) 406 (put 'mail-send-actions 'permanent-local t)
287 407
408 ;;;###autoload
288 (defcustom mail-default-headers nil 409 (defcustom mail-default-headers nil
289 "*A string containing header lines, to be inserted in outgoing messages. 410 "A string containing header lines, to be inserted in outgoing messages.
290 It is inserted before you edit the message, 411 It is inserted before you edit the message,
291 so you can edit or delete these lines." 412 so you can edit or delete these lines."
292 :type '(choice (const nil) string) 413 :type '(choice (const nil) string)
293 :group 'sendmail) 414 :group 'sendmail)
294 415
416 ;;;###autoload
295 (defcustom mail-bury-selects-summary t 417 (defcustom mail-bury-selects-summary t
296 "*If non-nil, try to show RMAIL summary buffer after returning from mail. 418 "If non-nil, try to show RMAIL summary buffer after returning from mail.
297 The functions \\[mail-send-on-exit] or \\[mail-dont-send] select 419 The functions \\[mail-send-on-exit] or \\[mail-dont-send] select
298 the RMAIL summary buffer before returning, if it exists and this variable 420 the RMAIL summary buffer before returning, if it exists and this variable
299 is non-nil." 421 is non-nil."
300 :type 'boolean 422 :type 'boolean
301 :group 'sendmail) 423 :group 'sendmail)
302 424
425 ;;;###autoload
303 (defcustom mail-send-nonascii 'mime 426 (defcustom mail-send-nonascii 'mime
304 "*Specify whether to allow sending non-ASCII characters in mail. 427 "Specify whether to allow sending non-ASCII characters in mail.
305 If t, that means do allow it. nil means don't allow it. 428 If t, that means do allow it. nil means don't allow it.
306 `query' means ask the user each time. 429 `query' means ask the user each time.
307 `mime' means add an appropriate MIME header if none already present. 430 `mime' means add an appropriate MIME header if none already present.
308 The default is `mime'. 431 The default is `mime'.
309 Including non-ASCII characters in a mail message can be problematical 432 Including non-ASCII characters in a mail message can be problematical
310 for the recipient, who may not know how to decode them properly." 433 for the recipient, who may not know how to decode them properly."
311 :type '(choice (const t) (const nil) (const query) (const mime)) 434 :type '(choice (const t) (const nil) (const query) (const mime))
312 :group 'sendmail) 435 :group 'sendmail)
313 436
314 (defcustom mail-use-dsn nil 437 (defcustom mail-use-dsn nil
315 "*Ask MTA for notification of failed, delayed or successful delivery. 438 "Ask MTA for notification of failed, delayed or successful delivery.
316 Note that only some MTAs (currently only recent versions of Sendmail) 439 Note that only some MTAs (currently only recent versions of Sendmail)
317 support Delivery Status Notification." 440 support Delivery Status Notification."
318 :group 'sendmail 441 :group 'sendmail
319 :type '(repeat (radio (const :tag "Failure" failure) 442 :type '(repeat (radio (const :tag "Failure" failure)
320 (const :tag "Delay" delay) 443 (const :tag "Delay" delay)
321 (const :tag "Success" success))) 444 (const :tag "Success" success)))
322 :version "21.4") 445 :version "22.1")
323 446
324 ;; Note: could use /usr/ucb/mail instead of sendmail; 447 ;; Note: could use /usr/ucb/mail instead of sendmail;
325 ;; options -t, and -v if not interactive. 448 ;; options -t, and -v if not interactive.
326 (defvar mail-mailer-swallows-blank-line 449 (defvar mail-mailer-swallows-blank-line
327 (if (and (string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)" system-configuration) 450 (if (and (string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)" system-configuration)
328 (file-readable-p "/etc/sendmail.cf") 451 (file-readable-p "/etc/sendmail.cf")
329 (let ((buffer (get-buffer-create " *temp*"))) 452 (with-temp-buffer
330 (unwind-protect 453 (insert-file-contents "/etc/sendmail.cf")
331 (save-excursion 454 (goto-char (point-min))
332 (set-buffer buffer) 455 (let ((case-fold-search nil))
333 (insert-file-contents "/etc/sendmail.cf") 456 (re-search-forward "^OR\\>" nil t))))
334 (goto-char (point-min))
335 (let ((case-fold-search nil))
336 (re-search-forward "^OR\\>" nil t)))
337 (kill-buffer buffer))))
338 ;; According to RFC822, "The field-name must be composed of printable 457 ;; According to RFC822, "The field-name must be composed of printable
339 ;; ASCII characters (i.e. characters that have decimal values between 458 ;; ASCII characters (i.e. characters that have decimal values between
340 ;; 33 and 126, except colon)", i.e. any chars except ctl chars, 459 ;; 33 and 126, except colon)", i.e. any chars except ctl chars,
341 ;; space, or colon. 460 ;; space, or colon.
342 '(looking-at "[ \t]\\|[][!\"#$%&'()*+,-./0-9;<=>?@A-Z\\\\^_`a-z{|}~]+:")) 461 '(looking-at "[ \t]\\|[][!\"#$%&'()*+,-./0-9;<=>?@A-Z\\\\^_`a-z{|}~]+:"))
356 (eval-when-compile 475 (eval-when-compile
357 (let* ((cite-chars "[>|}]") 476 (let* ((cite-chars "[>|}]")
358 (cite-prefix "[:alpha:]") 477 (cite-prefix "[:alpha:]")
359 (cite-suffix (concat cite-prefix "0-9_.@-`'\""))) 478 (cite-suffix (concat cite-prefix "0-9_.@-`'\"")))
360 (list '("^\\(To\\|Newsgroups\\):" . font-lock-function-name-face) 479 (list '("^\\(To\\|Newsgroups\\):" . font-lock-function-name-face)
361 '("^\\(B?CC\\|Reply-to\\):" . font-lock-keyword-face) 480 '("^\\(B?CC\\|Reply-to\\|Mail-\\(reply\\|followup\\)-to\\):" . font-lock-keyword-face)
362 '("^\\(Subject:\\)[ \t]*\\(.+\\)?" 481 '("^\\(Subject:\\)[ \t]*\\(.+\\)?"
363 (1 font-lock-comment-face) (2 font-lock-type-face nil t)) 482 (1 font-lock-comment-face)
483 ;; (2 font-lock-type-face nil t)
484 )
364 ;; Use EVAL to delay in case `mail-header-separator' gets changed. 485 ;; Use EVAL to delay in case `mail-header-separator' gets changed.
365 '(eval . 486 '(eval .
366 (let ((separator (if (zerop (length mail-header-separator)) 487 (let ((separator (if (zerop (length mail-header-separator))
367 " \\`\\' " 488 " \\`\\' "
368 (regexp-quote mail-header-separator)))) 489 (regexp-quote mail-header-separator))))
369 (cons (concat "^" separator "$") 'font-lock-warning-face))) 490 (cons (concat "^" separator "$") 'font-lock-warning-face)))
370 ;; Use MATCH-ANCHORED to effectively anchor the regexp left side. 491 ;; Use MATCH-ANCHORED to effectively anchor the regexp left side.
371 `(,cite-chars 492 `(,cite-chars
372 (,(concat "\\=[ \t]*" 493 (,(concat "\\=[ \t]*"
373 "\\(\\([" cite-prefix "]+[" cite-suffix "]*\\)?" 494 "\\(\\(\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
374 "\\(" cite-chars "[ \t]*\\)\\)+" 495 "\\(" cite-chars "[ \t]*\\)\\)+\\)"
375 "\\(.*\\)") 496 "\\(.*\\)")
376 (beginning-of-line) (end-of-line) 497 (beginning-of-line) (end-of-line)
377 (2 font-lock-constant-face nil t) 498 (1 font-lock-comment-delimiter-face nil t)
378 (4 font-lock-comment-face nil t))) 499 (5 font-lock-comment-face nil t)))
379 '("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\):.*\\(\n[ \t]+.*\\)*$" 500 '("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\):.*\\(\n[ \t]+.*\\)*$"
380 . font-lock-string-face)))) 501 . font-lock-string-face))))
381 "Additional expressions to highlight in Mail mode.") 502 "Additional expressions to highlight in Mail mode.")
382 503
383 504
384 (defun sendmail-sync-aliases () 505 (defun sendmail-sync-aliases ()
385 (let ((modtime (nth 5 (file-attributes mail-personal-alias-file)))) 506 (when mail-personal-alias-file
386 (or (equal mail-alias-modtime modtime) 507 (let ((modtime (nth 5 (file-attributes mail-personal-alias-file))))
387 (setq mail-alias-modtime modtime 508 (or (equal mail-alias-modtime modtime)
388 mail-aliases t)))) 509 (setq mail-alias-modtime modtime
510 mail-aliases t)))))
389 511
390 (defun mail-setup (to subject in-reply-to cc replybuffer actions) 512 (defun mail-setup (to subject in-reply-to cc replybuffer actions)
391 (or mail-default-reply-to 513 (or mail-default-reply-to
392 (setq mail-default-reply-to (getenv "REPLYTO"))) 514 (setq mail-default-reply-to (getenv "REPLYTO")))
393 (sendmail-sync-aliases) 515 (sendmail-sync-aliases)
394 (if (eq mail-aliases t) 516 (if (eq mail-aliases t)
395 (progn 517 (progn
396 (setq mail-aliases nil) 518 (setq mail-aliases nil)
397 (if (file-exists-p mail-personal-alias-file) 519 (when mail-personal-alias-file
398 (build-mail-aliases)))) 520 (if (file-exists-p mail-personal-alias-file)
521 (build-mail-aliases)))))
399 ;; Don't leave this around from a previous message. 522 ;; Don't leave this around from a previous message.
400 (kill-local-variable 'buffer-file-coding-system) 523 (kill-local-variable 'buffer-file-coding-system)
401 ;; This doesn't work for enable-multibyte-characters. 524 ;; This doesn't work for enable-multibyte-characters.
402 ;; (kill-local-variable 'enable-multibyte-characters) 525 ;; (kill-local-variable 'enable-multibyte-characters)
403 (set-buffer-multibyte default-enable-multibyte-characters) 526 (set-buffer-multibyte default-enable-multibyte-characters)
404 (if current-input-method 527 (if current-input-method
405 (inactivate-input-method)) 528 (inactivate-input-method))
406 (setq mail-send-actions actions) 529 (setq mail-send-actions actions)
407 (setq mail-reply-action replybuffer) 530 (setq mail-reply-action replybuffer)
408 (goto-char (point-min)) 531 (goto-char (point-min))
532 (if mail-setup-with-from
533 (mail-insert-from-field))
409 (insert "To: ") 534 (insert "To: ")
410 (save-excursion 535 (save-excursion
411 (if to 536 (if to
412 ;; Here removed code to extract names from within <...> 537 ;; Here removed code to extract names from within <...>
413 ;; on the assumption that mail-strip-quoted-names 538 ;; on the assumption that mail-strip-quoted-names
478 (defvar mail-mode-abbrev-table text-mode-abbrev-table) 603 (defvar mail-mode-abbrev-table text-mode-abbrev-table)
479 ;;;###autoload 604 ;;;###autoload
480 (define-derived-mode mail-mode text-mode "Mail" 605 (define-derived-mode mail-mode text-mode "Mail"
481 "Major mode for editing mail to be sent. 606 "Major mode for editing mail to be sent.
482 Like Text Mode but with these additional commands: 607 Like Text Mode but with these additional commands:
483 \\[mail-send] mail-send (send the message) \\[mail-send-and-exit] mail-send-and-exit 608
609 \\[mail-send] mail-send (send the message)
610 \\[mail-send-and-exit] mail-send-and-exit (send the message and exit)
611
484 Here are commands that move to a header field (and create it if there isn't): 612 Here are commands that move to a header field (and create it if there isn't):
485 \\[mail-to] move to To: \\[mail-subject] move to Subject: 613 \\[mail-to] move to To: \\[mail-subject] move to Subject:
486 \\[mail-cc] move to CC: \\[mail-bcc] move to BCC: 614 \\[mail-cc] move to CC: \\[mail-bcc] move to BCC:
487 \\[mail-fcc] move to FCC: \\[mail-reply-to] move to Reply-To: 615 \\[mail-fcc] move to FCC: \\[mail-reply-to] move to Reply-To:
616 \\[mail-mail-reply-to] move to Mail-Reply-To:
617 \\[mail-mail-followup-to] move to Mail-Followup-To:
488 \\[mail-text] mail-text (move to beginning of message text). 618 \\[mail-text] mail-text (move to beginning of message text).
489 \\[mail-signature] mail-signature (insert `mail-signature-file' file). 619 \\[mail-signature] mail-signature (insert `mail-signature-file' file).
490 \\[mail-yank-original] mail-yank-original (insert current message, in Rmail). 620 \\[mail-yank-original] mail-yank-original (insert current message, in Rmail).
491 \\[mail-fill-yanked-message] mail-fill-yanked-message (fill what was yanked). 621 \\[mail-fill-yanked-message] mail-fill-yanked-message (fill what was yanked).
492 \\[mail-sent-via] mail-sent-via (add a Sent-via field for each To or CC). 622 \\[mail-sent-via] mail-sent-via (add a Sent-via field for each To or CC).
496 (make-local-variable 'mail-send-actions) 626 (make-local-variable 'mail-send-actions)
497 (setq buffer-offer-save t) 627 (setq buffer-offer-save t)
498 (make-local-variable 'font-lock-defaults) 628 (make-local-variable 'font-lock-defaults)
499 (setq font-lock-defaults '(mail-font-lock-keywords t t)) 629 (setq font-lock-defaults '(mail-font-lock-keywords t t))
500 (make-local-variable 'paragraph-separate) 630 (make-local-variable 'paragraph-separate)
501 (make-local-variable 'paragraph-start)
502 (make-local-variable 'normal-auto-fill-function) 631 (make-local-variable 'normal-auto-fill-function)
503 (setq normal-auto-fill-function 'mail-mode-auto-fill) 632 (setq normal-auto-fill-function 'mail-mode-auto-fill)
504 (make-local-variable 'fill-paragraph-function) 633 (make-local-variable 'fill-paragraph-function)
505 (setq fill-paragraph-function 'mail-mode-fill-paragraph) 634 (setq fill-paragraph-function 'mail-mode-fill-paragraph)
506 ;; Allow using comment commands to add/remove quoting (this only does 635 ;; Allow using comment commands to add/remove quoting (this only does
507 ;; anything if mail-yank-prefix is set to a non-nil value). 636 ;; anything if mail-yank-prefix is set to a non-nil value).
508 (set (make-local-variable 'comment-start) mail-yank-prefix) 637 (set (make-local-variable 'comment-start) mail-yank-prefix)
638 (if mail-yank-prefix
639 (set (make-local-variable 'comment-start-skip)
640 (concat "^" (regexp-quote mail-yank-prefix) "[ \t]*")))
509 (make-local-variable 'adaptive-fill-regexp) 641 (make-local-variable 'adaptive-fill-regexp)
510 (setq adaptive-fill-regexp 642 (setq adaptive-fill-regexp
511 (concat "[ \t]*[-[:alnum:]]+>+[ \t]*\\|" 643 (concat "[ \t]*[-[:alnum:]]+>+[ \t]*\\|"
512 adaptive-fill-regexp)) 644 adaptive-fill-regexp))
513 (make-local-variable 'adaptive-fill-first-line-regexp) 645 (make-local-variable 'adaptive-fill-first-line-regexp)
516 adaptive-fill-first-line-regexp)) 648 adaptive-fill-first-line-regexp))
517 ;; `-- ' precedes the signature. `-----' appears at the start of the 649 ;; `-- ' precedes the signature. `-----' appears at the start of the
518 ;; lines that delimit forwarded messages. 650 ;; lines that delimit forwarded messages.
519 ;; Lines containing just >= 3 dashes, perhaps after whitespace, 651 ;; Lines containing just >= 3 dashes, perhaps after whitespace,
520 ;; are also sometimes used and should be separators. 652 ;; are also sometimes used and should be separators.
521 (setq paragraph-start (concat (regexp-quote mail-header-separator) 653 (setq paragraph-separate (concat (regexp-quote mail-header-separator)
522 "$\\|\t*\\([-|#;>* ]\\|(?[0-9]+[.)]\\)+$" 654 "$\\|\t*\\([-|#;>* ]\\|(?[0-9]+[.)]\\)+$"
523 "\\|[ \t]*[[:alnum:]]*>+[ \t]*$\\|[ \t]*$\\|" 655 "\\|[ \t]*[[:alnum:]]*>+[ \t]*$\\|[ \t]*$\\|"
524 "-- $\\|---+$\\|" 656 "--\\( \\|-+\\)$\\|"
525 page-delimiter)) 657 page-delimiter)))
526 (setq paragraph-separate paragraph-start))
527 658
528 659
529 (defun mail-header-end () 660 (defun mail-header-end ()
530 "Return the buffer location of the end of headers, as a number." 661 "Return the buffer location of the end of headers, as a number."
531 (save-restriction 662 (save-restriction
589 (goto-char beg) 720 (goto-char beg)
590 ;; If this field contains addresses, 721 ;; If this field contains addresses,
591 ;; make sure we can fill after each address. 722 ;; make sure we can fill after each address.
592 (if (member fieldname 723 (if (member fieldname
593 '("to" "cc" "bcc" "from" "reply-to" 724 '("to" "cc" "bcc" "from" "reply-to"
725 "mail-reply-to" "mail-followup-to"
594 "resent-to" "resent-cc" "resent-bcc" 726 "resent-to" "resent-cc" "resent-bcc"
595 "resent-from" "resent-reply-to")) 727 "resent-from" "resent-reply-to"))
596 (while (search-forward "," end t) 728 (while (search-forward "," end t)
597 (or (looking-at "[ \t]") 729 (or (looking-at "[ \t]")
598 (insert " ")))) 730 (insert " "))))
599 (fill-region-as-paragraph beg end) 731 (fill-region-as-paragraph beg end arg)
600 ;; Mark all lines except the first as continuations. 732 ;; Mark all lines except the first as continuations.
601 (goto-char beg) 733 (goto-char beg)
602 (forward-line 1) 734 (forward-line 1)
603 (while (< (point) end) 735 (while (< (point) end)
604 (insert " ") 736 (insert " ")
605 (forward-line 1)) 737 (forward-line 1))
606 (move-marker end nil) 738 (move-marker end nil)
607 t))) 739 t)))
608 740
609 ;;; Set up keymap.
610
611 (if mail-mode-map
612 nil
613 (setq mail-mode-map (make-sparse-keymap))
614 (define-key mail-mode-map "\M-\t" 'mail-complete)
615 (define-key mail-mode-map "\C-c?" 'describe-mode)
616 (define-key mail-mode-map "\C-c\C-f\C-t" 'mail-to)
617 (define-key mail-mode-map "\C-c\C-f\C-b" 'mail-bcc)
618 (define-key mail-mode-map "\C-c\C-f\C-f" 'mail-fcc)
619 (define-key mail-mode-map "\C-c\C-f\C-c" 'mail-cc)
620 (define-key mail-mode-map "\C-c\C-f\C-s" 'mail-subject)
621 (define-key mail-mode-map "\C-c\C-f\C-r" 'mail-reply-to)
622 (define-key mail-mode-map "\C-c\C-t" 'mail-text)
623 (define-key mail-mode-map "\C-c\C-y" 'mail-yank-original)
624 (define-key mail-mode-map "\C-c\C-r" 'mail-yank-region)
625 (define-key mail-mode-map [remap split-line] 'mail-split-line)
626 (define-key mail-mode-map "\C-c\C-q" 'mail-fill-yanked-message)
627 (define-key mail-mode-map "\C-c\C-w" 'mail-signature)
628 (define-key mail-mode-map "\C-c\C-v" 'mail-sent-via)
629 (define-key mail-mode-map "\C-c\C-c" 'mail-send-and-exit)
630 (define-key mail-mode-map "\C-c\C-s" 'mail-send)
631 (define-key mail-mode-map "\C-c\C-i" 'mail-attach-file))
632
633 (define-key mail-mode-map [menu-bar mail]
634 (cons "Mail" (make-sparse-keymap "Mail")))
635
636 (define-key mail-mode-map [menu-bar mail fill]
637 '("Fill Citation" . mail-fill-yanked-message))
638
639 (define-key mail-mode-map [menu-bar mail yank]
640 '("Cite Original" . mail-yank-original))
641
642 (define-key mail-mode-map [menu-bar mail signature]
643 '("Insert Signature" . mail-signature))
644
645 (define-key mail-mode-map [menu-bar mail mail-sep]
646 '("--"))
647
648 (define-key mail-mode-map [menu-bar mail cancel]
649 '("Cancel" . mail-dont-send))
650
651 (define-key mail-mode-map [menu-bar mail send-stay]
652 '("Send, Keep Editing" . mail-send))
653
654 (define-key mail-mode-map [menu-bar mail send]
655 '("Send Message" . mail-send-and-exit))
656
657 (define-key mail-mode-map [menu-bar headers]
658 (cons "Headers" (make-sparse-keymap "Move to Header")))
659
660 (define-key mail-mode-map [menu-bar headers text]
661 '("Text" . mail-text))
662
663 (define-key mail-mode-map [menu-bar headers expand-aliases]
664 '("Expand Aliases" . expand-mail-aliases))
665
666 (define-key mail-mode-map [menu-bar headers sent-via]
667 '("Sent Via" . mail-sent-via))
668
669 (define-key mail-mode-map [menu-bar headers reply-to]
670 '("Reply-To" . mail-reply-to))
671
672 (define-key mail-mode-map [menu-bar headers bcc]
673 '("Bcc" . mail-bcc))
674
675 (define-key mail-mode-map [menu-bar headers fcc]
676 '("Fcc" . mail-fcc))
677
678 (define-key mail-mode-map [menu-bar headers cc]
679 '("Cc" . mail-cc))
680
681 (define-key mail-mode-map [menu-bar headers subject]
682 '("Subject" . mail-subject))
683
684 (define-key mail-mode-map [menu-bar headers to]
685 '("To" . mail-to))
686
687 ;; User-level commands for sending. 741 ;; User-level commands for sending.
688 742
689 (defun mail-send-and-exit (arg) 743 (defun mail-send-and-exit (&optional arg)
690 "Send message like `mail-send', then, if no errors, exit from mail buffer. 744 "Send message like `mail-send', then, if no errors, exit from mail buffer.
691 Prefix arg means don't delete this window." 745 Prefix arg means don't delete this window."
692 (interactive "P") 746 (interactive "P")
693 (mail-send) 747 (mail-send)
694 (mail-bury arg)) 748 (mail-bury arg))
695 749
696 (defun mail-dont-send (arg) 750 (defun mail-dont-send (&optional arg)
697 "Don't send the message you have been editing. 751 "Don't send the message you have been editing.
698 Prefix arg means don't delete this window." 752 Prefix arg means don't delete this window."
699 (interactive "P") 753 (interactive "P")
700 (mail-bury arg)) 754 (mail-bury arg))
701 755
702 (defun mail-bury (arg) 756 (defun mail-bury (&optional arg)
703 "Bury this mail buffer." 757 "Bury this mail buffer."
704 (let ((newbuf (other-buffer (current-buffer)))) 758 (let ((newbuf (other-buffer (current-buffer))))
705 (bury-buffer (current-buffer)) 759 (bury-buffer (current-buffer))
706 (if (and (or (window-dedicated-p (frame-selected-window)) 760 (if (and (or (window-dedicated-p (frame-selected-window))
707 (cdr (assq 'mail-dedicated-frame (frame-parameters)))) 761 (cdr (assq 'mail-dedicated-frame (frame-parameters))))
708 (not (null (delq (selected-frame) (visible-frame-list))))) 762 (not (null (delq (selected-frame) (visible-frame-list)))))
709 (delete-frame (selected-frame)) 763 (progn
764 (if (display-multi-frame-p)
765 (delete-frame (selected-frame))
766 ;; The previous frame is where normally they have the
767 ;; RMAIL buffer displayed.
768 (other-frame -1)))
710 (let (rmail-flag summary-buffer) 769 (let (rmail-flag summary-buffer)
711 (and (not arg) 770 (and (not arg)
712 (not (one-window-p)) 771 (not (one-window-p))
713 (save-excursion 772 (with-current-buffer
714 (set-buffer (window-buffer (next-window (selected-window) 'not))) 773 (window-buffer (next-window (selected-window) 'not))
715 (setq rmail-flag (eq major-mode 'rmail-mode)) 774 (setq rmail-flag (eq major-mode 'rmail-mode))
716 (setq summary-buffer 775 (setq summary-buffer
717 (and mail-bury-selects-summary 776 (and mail-bury-selects-summary
718 (boundp 'rmail-summary-buffer) 777 (boundp 'rmail-summary-buffer)
719 rmail-summary-buffer 778 rmail-summary-buffer
730 "Hook run just before sending mail with `mail-send'." 789 "Hook run just before sending mail with `mail-send'."
731 :type 'hook 790 :type 'hook
732 :options '(flyspell-mode-off) 791 :options '(flyspell-mode-off)
733 :group 'sendmail) 792 :group 'sendmail)
734 793
794 ;;;###autoload
795 (defcustom mail-mailing-lists nil "\
796 *List of mailing list addresses the user is subscribed to.
797
798 The variable is used to trigger insertion of the \"Mail-Followup-To\"
799 header when sending a message to a mailing list."
800 :type '(repeat string)
801 :group 'sendmail)
802
803
735 (defun mail-send () 804 (defun mail-send ()
736 "Send the message in the current buffer. 805 "Send the message in the current buffer.
737 If `mail-interactive' is non-nil, wait for success indication 806 If `mail-interactive' is non-nil, wait for success indication
738 or error messages, and inform user. 807 or error messages, and inform user.
739 Otherwise any failure is reported in a message back to 808 Otherwise any failure is reported in a message back to
742 (if (if buffer-file-name 811 (if (if buffer-file-name
743 (y-or-n-p "Send buffer contents as mail message? ") 812 (y-or-n-p "Send buffer contents as mail message? ")
744 (or (buffer-modified-p) 813 (or (buffer-modified-p)
745 (y-or-n-p "Message already sent; resend? "))) 814 (y-or-n-p "Message already sent; resend? ")))
746 (let ((inhibit-read-only t) 815 (let ((inhibit-read-only t)
747 (opoint (point))) 816 (opoint (point))
817 (ml (when mail-mailing-lists
818 ;; The surrounding regexp assumes the use of
819 ;; `mail-strip-quoted-names' on addresses before matching
820 ;; Cannot deal with full RFC 822 freedom, but that is
821 ;; unlikely to be problematic.
822 (concat "\\(?:[[:space:];,]\\|\\`\\)"
823 (regexp-opt mail-mailing-lists t)
824 "\\(?:[[:space:];,]\\|\\'\\)"))))
825 ;; If there are mailing lists defined
826 (when ml
827 (save-excursion
828 (let* ((to (mail-fetch-field "to" nil t))
829 (cc (mail-fetch-field "cc" nil t))
830 (new-header-values ; To: and Cc:
831 (mail-strip-quoted-names
832 (concat to (when cc (concat ", " cc))))))
833 ;; If message goes to known mailing list ...
834 (when (string-match ml new-header-values)
835 ;; Add Mail-Followup-To if none yet
836 (unless (mail-fetch-field "mail-followup-to")
837 (goto-char (mail-header-end))
838 (insert "Mail-Followup-To: "
839 (let ((l))
840 (mapc
841 ;; remove duplicates
842 '(lambda (e)
843 (unless (member e l)
844 (push e l)))
845 (split-string new-header-values
846 ",[[:space:]]+" t))
847 (mapconcat 'identity l ", "))
848 "\n"))
849 ;; Add Mail-Reply-To if none yet
850 (unless (mail-fetch-field "mail-reply-to")
851 (goto-char (mail-header-end))
852 (insert "Mail-Reply-To: "
853 (or (mail-fetch-field "reply-to")
854 user-mail-address)
855 "\n"))))))
748 (unless (memq mail-send-nonascii '(t mime)) 856 (unless (memq mail-send-nonascii '(t mime))
749 (goto-char (point-min)) 857 (goto-char (point-min))
750 (skip-chars-forward "\0-\177") 858 (skip-chars-forward "\0-\177")
751 (or (= (point) (point-max)) 859 (or (= (point) (point-max))
752 (if (eq mail-send-nonascii 'query) 860 (if (eq mail-send-nonascii 'query)
800 ;;;###autoload 908 ;;;###autoload
801 (defvar default-sendmail-coding-system 'iso-latin-1 909 (defvar default-sendmail-coding-system 'iso-latin-1
802 "Default coding system for encoding the outgoing mail. 910 "Default coding system for encoding the outgoing mail.
803 This variable is used only when `sendmail-coding-system' is nil. 911 This variable is used only when `sendmail-coding-system' is nil.
804 912
805 This variable is set/changed by the command set-language-environment. 913 This variable is set/changed by the command `set-language-environment'.
806 User should not set this variable manually, 914 User should not set this variable manually,
807 instead use sendmail-coding-system to get a constant encoding 915 instead use `sendmail-coding-system' to get a constant encoding
808 of outgoing mails regardless of the current language environment. 916 of outgoing mails regardless of the current language environment.
809 See also the function `select-message-coding-system'.") 917 See also the function `select-message-coding-system'.")
918
919 (defun mail-insert-from-field ()
920 (let* ((login user-mail-address)
921 (fullname (user-full-name))
922 (quote-fullname nil))
923 (if (string-match "[^\0-\177]" fullname)
924 (setq fullname (rfc2047-encode-string fullname)
925 quote-fullname t))
926 (cond ((eq mail-from-style 'angles)
927 (insert "From: " fullname)
928 (let ((fullname-start (+ (point-min) 6))
929 (fullname-end (point-marker)))
930 (goto-char fullname-start)
931 ;; Look for a character that cannot appear unquoted
932 ;; according to RFC 822.
933 (if (or (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]"
934 fullname-end 1)
935 quote-fullname)
936 (progn
937 ;; Quote fullname, escaping specials.
938 (goto-char fullname-start)
939 (insert "\"")
940 (while (re-search-forward "[\"\\]"
941 fullname-end 1)
942 (replace-match "\\\\\\&" t))
943 (insert "\""))))
944 (insert " <" login ">\n"))
945 ((eq mail-from-style 'parens)
946 (insert "From: " login " (")
947 (let ((fullname-start (point)))
948 (if quote-fullname
949 (insert "\""))
950 (insert fullname)
951 (if quote-fullname
952 (insert "\""))
953 (let ((fullname-end (point-marker)))
954 (goto-char fullname-start)
955 ;; RFC 822 says \ and nonmatching parentheses
956 ;; must be escaped in comments.
957 ;; Escape every instance of ()\ ...
958 (while (re-search-forward "[()\\]" fullname-end 1)
959 (replace-match "\\\\\\&" t))
960 ;; ... then undo escaping of matching parentheses,
961 ;; including matching nested parentheses.
962 (goto-char fullname-start)
963 (while (re-search-forward
964 "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"
965 fullname-end 1)
966 (replace-match "\\1(\\3)" t)
967 (goto-char fullname-start))))
968 (insert ")\n"))
969 ((null mail-from-style)
970 (insert "From: " login "\n"))
971 ((eq mail-from-style 'system-default)
972 nil)
973 (t (error "Invalid value for `mail-from-style'")))))
810 974
811 (defun sendmail-send-it () 975 (defun sendmail-send-it ()
812 "Send the current mail buffer using the Sendmail package. 976 "Send the current mail buffer using the Sendmail package.
813 This is a suitable value for `send-mail-function'. It sends using the 977 This is a suitable value for `send-mail-function'. It sends using the
814 external program defined by `sendmail-program'." 978 external program defined by `sendmail-program'."
818 0)) 982 0))
819 (tembuf (generate-new-buffer " sendmail temp")) 983 (tembuf (generate-new-buffer " sendmail temp"))
820 (multibyte enable-multibyte-characters) 984 (multibyte enable-multibyte-characters)
821 (case-fold-search nil) 985 (case-fold-search nil)
822 (selected-coding (select-message-coding-system)) 986 (selected-coding (select-message-coding-system))
823 ;;; resend-to-addresses 987 resend-to-addresses
824 delimline 988 delimline
825 fcc-was-found 989 fcc-was-found
826 (mailbuf (current-buffer)) 990 (mailbuf (current-buffer))
827 (program (if (boundp 'sendmail-program) 991 (program (if (boundp 'sendmail-program)
828 sendmail-program 992 sendmail-program
831 ;; local binding in the mail buffer will take effect. 995 ;; local binding in the mail buffer will take effect.
832 (envelope-from 996 (envelope-from
833 (and mail-specify-envelope-from 997 (and mail-specify-envelope-from
834 (or (mail-envelope-from) user-mail-address)))) 998 (or (mail-envelope-from) user-mail-address))))
835 (unwind-protect 999 (unwind-protect
836 (save-excursion 1000 (with-current-buffer tembuf
837 (set-buffer tembuf)
838 (erase-buffer) 1001 (erase-buffer)
839 (unless multibyte 1002 (unless multibyte
840 (set-buffer-multibyte nil)) 1003 (set-buffer-multibyte nil))
841 (insert-buffer-substring mailbuf) 1004 (insert-buffer-substring mailbuf)
842 (goto-char (point-max)) 1005 (goto-char (point-max))
854 ;; Ignore any blank lines in the header 1017 ;; Ignore any blank lines in the header
855 (while (and (re-search-forward "\n\n\n*" delimline t) 1018 (while (and (re-search-forward "\n\n\n*" delimline t)
856 (< (point) delimline)) 1019 (< (point) delimline))
857 (replace-match "\n")) 1020 (replace-match "\n"))
858 (goto-char (point-min)) 1021 (goto-char (point-min))
1022 ;; Look for Resent- headers. They require sending
1023 ;; the message specially.
859 (let ((case-fold-search t)) 1024 (let ((case-fold-search t))
860 ;;; (goto-char (point-min)) 1025 (goto-char (point-min))
861 ;;; (while (re-search-forward "^Resent-\\(to\\|cc\\|bcc\\):" delimline t) 1026 (while (re-search-forward "^Resent-\\(to\\|cc\\|bcc\\):" delimline t)
862 ;;; (setq resend-to-addresses 1027 ;; Put a list of such addresses in resend-to-addresses.
863 ;;; (save-restriction 1028 (setq resend-to-addresses
864 ;;; (narrow-to-region (point) 1029 (save-restriction
865 ;;; (save-excursion 1030 (narrow-to-region (point)
866 ;;; (forward-line 1) 1031 (save-excursion
867 ;;; (while (looking-at "^[ \t]") 1032 (forward-line 1)
868 ;;; (forward-line 1)) 1033 (while (looking-at "^[ \t]")
869 ;;; (point))) 1034 (forward-line 1))
870 ;;; (append (mail-parse-comma-list) 1035 (point)))
871 ;;; resend-to-addresses))) 1036 (append (mail-parse-comma-list)
872 ;;; ;; Delete Resent-BCC ourselves 1037 resend-to-addresses)))
873 ;;; (if (save-excursion (beginning-of-line) 1038 ;; Delete Resent-BCC ourselves
874 ;;; (looking-at "resent-bcc")) 1039 (if (save-excursion (beginning-of-line)
875 ;;; (delete-region (save-excursion (beginning-of-line) (point)) 1040 (looking-at "resent-bcc"))
876 ;;; (save-excursion (end-of-line) (1+ (point)))))) 1041 (delete-region (save-excursion (beginning-of-line) (point))
877 ;;; Apparently this causes a duplicate Sender. 1042 (save-excursion (end-of-line) (1+ (point))))))
878 ;;; ;; If the From is different than current user, insert Sender. 1043 ;;; Apparently this causes a duplicate Sender.
879 ;;; (goto-char (point-min)) 1044 ;;; ;; If the From is different than current user, insert Sender.
880 ;;; (and (re-search-forward "^From:" delimline t) 1045 ;;; (goto-char (point-min))
881 ;;; (progn 1046 ;;; (and (re-search-forward "^From:" delimline t)
882 ;;; (require 'mail-utils) 1047 ;;; (progn
883 ;;; (not (string-equal 1048 ;;; (require 'mail-utils)
884 ;;; (mail-strip-quoted-names 1049 ;;; (not (string-equal
885 ;;; (save-restriction 1050 ;;; (mail-strip-quoted-names
886 ;;; (narrow-to-region (point-min) delimline) 1051 ;;; (save-restriction
887 ;;; (mail-fetch-field "From"))) 1052 ;;; (narrow-to-region (point-min) delimline)
888 ;;; (user-login-name)))) 1053 ;;; (mail-fetch-field "From")))
889 ;;; (progn 1054 ;;; (user-login-name))))
890 ;;; (forward-line 1) 1055 ;;; (progn
891 ;;; (insert "Sender: " (user-login-name) "\n"))) 1056 ;;; (forward-line 1)
1057 ;;; (insert "Sender: " (user-login-name) "\n")))
892 ;; Don't send out a blank subject line 1058 ;; Don't send out a blank subject line
893 (goto-char (point-min)) 1059 (goto-char (point-min))
894 (if (re-search-forward "^Subject:\\([ \t]*\n\\)+\\b" delimline t) 1060 (if (re-search-forward "^Subject:\\([ \t]*\n\\)+\\b" delimline t)
895 (replace-match "") 1061 (replace-match "")
896 ;; This one matches a Subject just before the header delimiter. 1062 ;; This one matches a Subject just before the header delimiter.
899 (replace-match ""))) 1065 (replace-match "")))
900 ;; Put the "From:" field in unless for some odd reason 1066 ;; Put the "From:" field in unless for some odd reason
901 ;; they put one in themselves. 1067 ;; they put one in themselves.
902 (goto-char (point-min)) 1068 (goto-char (point-min))
903 (if (not (re-search-forward "^From:" delimline t)) 1069 (if (not (re-search-forward "^From:" delimline t))
904 (let* ((login user-mail-address) 1070 (mail-insert-from-field))
905 (fullname (user-full-name))
906 (quote-fullname nil))
907 (if (string-match "[^\0-\177]" fullname)
908 (setq fullname (rfc2047-encode-string fullname)
909 quote-fullname t))
910 (cond ((eq mail-from-style 'angles)
911 (insert "From: " fullname)
912 (let ((fullname-start (+ (point-min) 6))
913 (fullname-end (point-marker)))
914 (goto-char fullname-start)
915 ;; Look for a character that cannot appear unquoted
916 ;; according to RFC 822.
917 (if (or (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]"
918 fullname-end 1)
919 quote-fullname)
920 (progn
921 ;; Quote fullname, escaping specials.
922 (goto-char fullname-start)
923 (insert "\"")
924 (while (re-search-forward "[\"\\]"
925 fullname-end 1)
926 (replace-match "\\\\\\&" t))
927 (insert "\""))))
928 (insert " <" login ">\n"))
929 ((eq mail-from-style 'parens)
930 (insert "From: " login " (")
931 (let ((fullname-start (point)))
932 (if quote-fullname
933 (insert "\""))
934 (insert fullname)
935 (if quote-fullname
936 (insert "\""))
937 (let ((fullname-end (point-marker)))
938 (goto-char fullname-start)
939 ;; RFC 822 says \ and nonmatching parentheses
940 ;; must be escaped in comments.
941 ;; Escape every instance of ()\ ...
942 (while (re-search-forward "[()\\]" fullname-end 1)
943 (replace-match "\\\\\\&" t))
944 ;; ... then undo escaping of matching parentheses,
945 ;; including matching nested parentheses.
946 (goto-char fullname-start)
947 (while (re-search-forward
948 "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"
949 fullname-end 1)
950 (replace-match "\\1(\\3)" t)
951 (goto-char fullname-start))))
952 (insert ")\n"))
953 ((null mail-from-style)
954 (insert "From: " login "\n"))
955 ((eq mail-from-style 'system-default)
956 nil)
957 (t (error "Invalid value for `mail-from-style'")))))
958 ;; Possibly add a MIME header for the current coding system 1071 ;; Possibly add a MIME header for the current coding system
959 (let (charset) 1072 (let (charset)
960 (goto-char (point-min)) 1073 (goto-char (point-min))
961 (and (eq mail-send-nonascii 'mime) 1074 (and (eq mail-send-nonascii 'mime)
962 (not (re-search-forward "^MIME-version:" delimline t)) 1075 (not (re-search-forward "^MIME-version:" delimline t))
966 (setq charset 1079 (setq charset
967 (coding-system-get selected-coding 'mime-charset)) 1080 (coding-system-get selected-coding 'mime-charset))
968 (goto-char delimline) 1081 (goto-char delimline)
969 (insert "MIME-version: 1.0\n" 1082 (insert "MIME-version: 1.0\n"
970 "Content-type: text/plain; charset=" 1083 "Content-type: text/plain; charset="
971 (symbol-name charset) "\n" 1084 (symbol-name charset)
972 "Content-Transfer-Encoding: 8bit\n"))) 1085 "\nContent-Transfer-Encoding: 8bit\n")))
973 ;; Insert an extra newline if we need it to work around 1086 ;; Insert an extra newline if we need it to work around
974 ;; Sun's bug that swallows newlines. 1087 ;; Sun's bug that swallows newlines.
975 (goto-char (1+ delimline)) 1088 (goto-char (1+ delimline))
976 (if (eval mail-mailer-swallows-blank-line) 1089 (if (eval mail-mailer-swallows-blank-line)
977 (newline)) 1090 (newline))
980 (if (re-search-forward "^FCC:" delimline t) 1093 (if (re-search-forward "^FCC:" delimline t)
981 (progn 1094 (progn
982 (setq fcc-was-found t) 1095 (setq fcc-was-found t)
983 (mail-do-fcc delimline))) 1096 (mail-do-fcc delimline)))
984 (if mail-interactive 1097 (if mail-interactive
985 (save-excursion 1098 (with-current-buffer errbuf
986 (set-buffer errbuf)
987 (erase-buffer)))) 1099 (erase-buffer))))
988 (goto-char (point-min)) 1100 (goto-char (point-min))
989 (if (let ((case-fold-search t)) 1101 (if (let ((case-fold-search t))
990 (re-search-forward "^To:\\|^cc:\\|^bcc:\\|^resent-to:\ 1102 (or resend-to-addresses
991 \\|^resent-cc:\\|^resent-bcc:" 1103 (re-search-forward "^To:\\|^cc:\\|^bcc:"
992 delimline t)) 1104 delimline t)))
993 (let* ((default-directory "/") 1105 (let* ((default-directory "/")
994 (coding-system-for-write selected-coding) 1106 (coding-system-for-write selected-coding)
995 (args 1107 (args
996 (append (list (point-min) (point-max) 1108 (append (list (point-min) (point-max)
997 program 1109 program
1008 ;; and "deliver interactively" 1120 ;; and "deliver interactively"
1009 '("-oep" "-odi") 1121 '("-oep" "-odi")
1010 ;; These mean "report errors by mail" 1122 ;; These mean "report errors by mail"
1011 ;; and "deliver in background". 1123 ;; and "deliver in background".
1012 '("-oem" "-odb")) 1124 '("-oem" "-odb"))
1013 ;;; ;; Get the addresses from the message 1125 ;; Get the addresses from the message
1014 ;;; ;; unless this is a resend. 1126 ;; unless this is a resend.
1015 ;;; ;; We must not do that for a resend 1127 ;; We must not do that for a resend
1016 ;;; ;; because we would find the original addresses. 1128 ;; because we would find the original addresses.
1017 ;;; ;; For a resend, include the specific addresses. 1129 ;; For a resend, include the specific addresses.
1018 ;;; (or resend-to-addresses 1130 (or resend-to-addresses
1019 '("-t") 1131 '("-t")
1020 ;;; ) 1132 )
1021 (if mail-use-dsn 1133 (if mail-use-dsn
1022 (list "-N" (mapconcat 'symbol-name 1134 (list "-N" (mapconcat 'symbol-name
1023 mail-use-dsn ","))) 1135 mail-use-dsn ",")))
1024 ) 1136 )
1025 ) 1137 )
1026 (exit-value (apply 'call-process-region args))) 1138 (exit-value (apply 'call-process-region args)))
1027 (or (null exit-value) (zerop exit-value) 1139 (or (null exit-value) (eq 0 exit-value)
1028 (error "Sending...failed with exit value %d" exit-value))) 1140 (error "Sending...failed with exit value %d" exit-value)))
1029 (or fcc-was-found 1141 (or fcc-was-found
1030 (error "No recipients"))) 1142 (error "No recipients")))
1031 (if mail-interactive 1143 (if mail-interactive
1032 (save-excursion 1144 (with-current-buffer errbuf
1033 (set-buffer errbuf)
1034 (goto-char (point-min)) 1145 (goto-char (point-min))
1035 (while (re-search-forward "\n\n* *" nil t) 1146 (while (re-search-forward "\n\n* *" nil t)
1036 (replace-match "; ")) 1147 (replace-match "; "))
1037 (if (not (zerop (buffer-size))) 1148 (if (not (zerop (buffer-size)))
1038 (error "Sending...failed to %s" 1149 (error "Sending...failed to %s"
1040 (kill-buffer tembuf) 1151 (kill-buffer tembuf)
1041 (if (bufferp errbuf) 1152 (if (bufferp errbuf)
1042 (kill-buffer errbuf))))) 1153 (kill-buffer errbuf)))))
1043 1154
1044 (defun mail-do-fcc (header-end) 1155 (defun mail-do-fcc (header-end)
1156 (unless (markerp header-end)
1157 (error "Value of `header-end' must be a marker"))
1045 (let (fcc-list 1158 (let (fcc-list
1046 (rmailbuf (current-buffer)) 1159 (rmailbuf (current-buffer))
1047 (time (current-time)) 1160 (time (current-time))
1048 (tembuf (generate-new-buffer " rmail output")) 1161 (tembuf (generate-new-buffer " rmail output"))
1049 (case-fold-search t)) 1162 (case-fold-search t))
1050 (unless (markerp header-end)
1051 (error "Value of `header-end' must be a marker"))
1052 (save-excursion 1163 (save-excursion
1053 (goto-char (point-min)) 1164 (goto-char (point-min))
1054 (while (re-search-forward "^FCC:[ \t]*" header-end t) 1165 (while (re-search-forward "^FCC:[ \t]*" header-end t)
1055 (setq fcc-list (cons (buffer-substring (point) 1166 (push (buffer-substring (point)
1056 (progn 1167 (progn
1057 (end-of-line) 1168 (end-of-line)
1058 (skip-chars-backward " \t") 1169 (skip-chars-backward " \t")
1059 (point))) 1170 (point)))
1060 fcc-list)) 1171 fcc-list)
1061 (delete-region (match-beginning 0) 1172 (delete-region (match-beginning 0)
1062 (progn (forward-line 1) (point)))) 1173 (progn (forward-line 1) (point))))
1063 (set-buffer tembuf) 1174 (set-buffer tembuf)
1064 (erase-buffer) 1175 (erase-buffer)
1065 ;; This initial newline is written out if the fcc file already exists. 1176 ;; This initial newline is written out if the fcc file already exists.
1081 ;; that "^[>]+From " be quoted in the same transparent way.) 1192 ;; that "^[>]+From " be quoted in the same transparent way.)
1082 (let ((case-fold-search nil)) 1193 (let ((case-fold-search nil))
1083 (while (search-forward "\nFrom " nil t) 1194 (while (search-forward "\nFrom " nil t)
1084 (forward-char -5) 1195 (forward-char -5)
1085 (insert ?>))) 1196 (insert ?>)))
1086 (while fcc-list 1197 (dolist (fcc fcc-list)
1087 (let* ((buffer (find-buffer-visiting (car fcc-list))) 1198 (let* ((buffer (find-buffer-visiting fcc))
1088 (curbuf (current-buffer)) 1199 (curbuf (current-buffer))
1089 dont-write-the-file 1200 dont-write-the-file
1090 buffer-matches-file 1201 buffer-matches-file
1091 (beg (point-min)) (end (point-max)) 1202 (beg (point-min)) (end (point-max))
1092 (beg2 (save-excursion (goto-char (point-min)) 1203 (beg2 (save-excursion (goto-char (point-min))
1093 (forward-line 2) (point)))) 1204 (forward-line 2) (point))))
1094 (if buffer 1205 (if buffer
1095 ;; File is present in a buffer => append to that buffer. 1206 ;; File is present in a buffer => append to that buffer.
1096 (save-excursion 1207 (with-current-buffer buffer
1097 (set-buffer buffer)
1098 (setq buffer-matches-file 1208 (setq buffer-matches-file
1099 (and (not (buffer-modified-p)) 1209 (and (not (buffer-modified-p))
1100 (verify-visited-file-modtime buffer))) 1210 (verify-visited-file-modtime buffer)))
1101 ;; Keep the end of the accessible portion at the same place 1211 ;; Keep the end of the accessible portion at the same place
1102 ;; unless it is the end of the buffer. 1212 ;; unless it is the end of the buffer.
1133 (goto-char (point-max)) 1243 (goto-char (point-max))
1134 (insert-buffer-substring curbuf beg end)) 1244 (insert-buffer-substring curbuf beg end))
1135 (or buffer-matches-file 1245 (or buffer-matches-file
1136 (progn 1246 (progn
1137 (if (y-or-n-p (format "Save file %s? " 1247 (if (y-or-n-p (format "Save file %s? "
1138 (car fcc-list))) 1248 fcc))
1139 (save-buffer)) 1249 (save-buffer))
1140 (setq dont-write-the-file t)))) 1250 (setq dont-write-the-file t))))
1141 (if max (narrow-to-region (point-min) max)))))) 1251 (if max (narrow-to-region (point-min) max))))))
1142 ;; Append to the file directly, 1252 ;; Append to the file directly,
1143 ;; unless we've already taken care of it. 1253 ;; unless we've already taken care of it.
1144 (unless dont-write-the-file 1254 (unless dont-write-the-file
1145 (if (and (file-exists-p (car fcc-list)) 1255 (if (and (file-exists-p fcc)
1146 ;; Check that the file isn't empty. We don't 1256 ;; Check that the file isn't empty. We don't
1147 ;; want to insert a newline at the start of an 1257 ;; want to insert a newline at the start of an
1148 ;; empty file. 1258 ;; empty file.
1149 (not (zerop (nth 7 (file-attributes (car fcc-list))))) 1259 (not (zerop (nth 7 (file-attributes fcc))))
1150 (mail-file-babyl-p (car fcc-list))) 1260 (mail-file-babyl-p fcc))
1151 ;; If the file is a Babyl file, 1261 ;; If the file is a Babyl file,
1152 ;; convert the message to Babyl format. 1262 ;; convert the message to Babyl format.
1153 (let ((coding-system-for-write 1263 (let ((coding-system-for-write
1154 (or rmail-file-coding-system 1264 (or rmail-file-coding-system
1155 'emacs-mule))) 1265 'emacs-mule)))
1156 (save-excursion 1266 (with-current-buffer (get-buffer-create " mail-temp")
1157 (set-buffer (get-buffer-create " mail-temp"))
1158 (setq buffer-read-only nil) 1267 (setq buffer-read-only nil)
1159 (erase-buffer) 1268 (erase-buffer)
1160 (insert "\C-l\n0, unseen,,\n*** EOOH ***\n" 1269 (insert "\C-l\n0, unseen,,\n*** EOOH ***\nDate: "
1161 "Date: " (mail-rfc822-date) "\n") 1270 (mail-rfc822-date) "\n")
1162 (insert-buffer-substring curbuf beg2 end) 1271 (insert-buffer-substring curbuf beg2 end)
1163 (insert "\n\C-_") 1272 (insert "\n\C-_")
1164 (write-region (point-min) (point-max) (car fcc-list) t) 1273 (write-region (point-min) (point-max) fcc t)
1165 (erase-buffer))) 1274 (erase-buffer)))
1166 (write-region 1275 (write-region
1167 (1+ (point-min)) (point-max) (car fcc-list) t))) 1276 (1+ (point-min)) (point-max) fcc t)))
1168 (and buffer (not dont-write-the-file) 1277 (and buffer (not dont-write-the-file)
1169 (with-current-buffer buffer 1278 (with-current-buffer buffer
1170 (set-visited-file-modtime)))) 1279 (set-visited-file-modtime))))))
1171 (setq fcc-list (cdr fcc-list))))
1172 (kill-buffer tembuf))) 1280 (kill-buffer tembuf)))
1173 1281
1174 (defun mail-sent-via () 1282 (defun mail-sent-via ()
1175 "Make a Sent-via header line from each To or CC header line." 1283 "Make a Sent-via header line from each To or CC header line."
1176 (interactive) 1284 (interactive)
1177 (save-excursion 1285 (save-excursion
1178 ;; put a marker at the end of the header 1286 ;; put a marker at the end of the header
1179 (let ((end (copy-marker (mail-header-end))) 1287 (let ((end (copy-marker (mail-header-end)))
1180 (case-fold-search t) 1288 (case-fold-search t))
1181 to-line)
1182 (goto-char (point-min)) 1289 (goto-char (point-min))
1183 ;; search for the To: lines and make Sent-via: lines from them 1290 ;; search for the To: lines and make Sent-via: lines from them
1184 ;; search for the next To: line 1291 ;; search for the next To: line
1185 (while (re-search-forward "^\\(to\\|cc\\):" end t) 1292 (while (re-search-forward "^\\(to\\|cc\\):" end t)
1186 ;; Grab this line plus all its continuations, sans the `to:'. 1293 ;; Grab this line plus all its continuations, sans the `to:'.
1233 (defun mail-reply-to () 1340 (defun mail-reply-to ()
1234 "Move point to end of Reply-To-field. Create a Reply-To field if none." 1341 "Move point to end of Reply-To-field. Create a Reply-To field if none."
1235 (interactive) 1342 (interactive)
1236 (expand-abbrev) 1343 (expand-abbrev)
1237 (mail-position-on-field "Reply-To")) 1344 (mail-position-on-field "Reply-To"))
1345
1346 (defun mail-mail-reply-to ()
1347 "Move point to end of Mail-Reply-To field.
1348 Create a Mail-Reply-To field if none."
1349 (interactive)
1350 (expand-abbrev)
1351 (or (mail-position-on-field "mail-reply-to" t)
1352 (progn (mail-position-on-field "to")
1353 (insert "\nMail-Reply-To: "))))
1354
1355 (defun mail-mail-followup-to ()
1356 "Move point to end of Mail-Followup-To field.
1357 Create a Mail-Followup-To field if none."
1358 (interactive)
1359 (expand-abbrev)
1360 (or (mail-position-on-field "mail-followup-to" t)
1361 (progn (mail-position-on-field "to")
1362 (insert "\nMail-Followup-To: "))))
1238 1363
1239 (defun mail-position-on-field (field &optional soft) 1364 (defun mail-position-on-field (field &optional soft)
1240 (let (end 1365 (let (end
1241 (case-fold-search t)) 1366 (case-fold-search t))
1242 (setq end (mail-header-end)) 1367 (setq end (mail-header-end))
1322 (apply (car original) (cdr original)) 1447 (apply (car original) (cdr original))
1323 ;; If the original message is in another window in the same frame, 1448 ;; If the original message is in another window in the same frame,
1324 ;; delete that window to save screen space. 1449 ;; delete that window to save screen space.
1325 ;; t means don't alter other frames. 1450 ;; t means don't alter other frames.
1326 (delete-windows-on original t) 1451 (delete-windows-on original t)
1327 (insert-buffer original) 1452 (with-no-warnings
1453 ;; We really want this to set mark.
1454 (insert-buffer original))
1328 (set-text-properties (point) (mark t) nil)) 1455 (set-text-properties (point) (mark t) nil))
1329 (if (consp arg) 1456 (if (consp arg)
1330 nil 1457 nil
1331 (goto-char start) 1458 (goto-char start)
1332 (let ((mail-indentation-spaces (if arg (prefix-numeric-value arg) 1459 (let ((mail-indentation-spaces (if arg (prefix-numeric-value arg)
1478 is inserted. 1605 is inserted.
1479 1606
1480 The normal hook `mail-setup-hook' is run after the message is 1607 The normal hook `mail-setup-hook' is run after the message is
1481 initialized. It can add more default fields to the message. 1608 initialized. It can add more default fields to the message.
1482 1609
1483 When calling from a program, the first argument if non-nil says 1610 The first argument, NOERASE, determines what to do when there is
1484 not to erase the existing contents of the `*mail*' buffer. 1611 an existing modified `*mail*' buffer. If NOERASE is nil, the
1612 existing mail buffer is used, and the user is prompted whether to
1613 keep the old contents or to erase them. If NOERASE has the value
1614 `new', a new mail buffer will be created instead of using the old
1615 one. Any other non-nil value means to always select the old
1616 buffer without erasing the contents.
1485 1617
1486 The second through fifth arguments, 1618 The second through fifth arguments,
1487 TO, SUBJECT, IN-REPLY-TO and CC, specify if non-nil 1619 TO, SUBJECT, IN-REPLY-TO and CC, specify if non-nil
1488 the initial contents of those header fields. 1620 the initial contents of those header fields.
1489 These arguments should not have final newlines. 1621 These arguments should not have final newlines.
1494 The seventh argument ACTIONS is a list of actions to take 1626 The seventh argument ACTIONS is a list of actions to take
1495 if/when the message is sent. Each action looks like (FUNCTION . ARGS); 1627 if/when the message is sent. Each action looks like (FUNCTION . ARGS);
1496 when the message is sent, we apply FUNCTION to ARGS. 1628 when the message is sent, we apply FUNCTION to ARGS.
1497 This is how Rmail arranges to mark messages `answered'." 1629 This is how Rmail arranges to mark messages `answered'."
1498 (interactive "P") 1630 (interactive "P")
1499 ;;; This is commented out because I found it was confusing in practice. 1631 ;;; This is commented out because I found it was confusing in practice.
1500 ;;; It is easy enough to rename *mail* by hand with rename-buffer 1632 ;;; It is easy enough to rename *mail* by hand with rename-buffer
1501 ;;; if you want to have multiple mail buffers. 1633 ;;; if you want to have multiple mail buffers.
1502 ;;; And then you can control which messages to save. --rms. 1634 ;;; And then you can control which messages to save. --rms.
1503 ;;; (let ((index 1) 1635 ;;; (let ((index 1)
1504 ;;; buffer) 1636 ;;; buffer)
1505 ;;; ;; If requested, look for a mail buffer that is modified and go to it. 1637 ;;; ;; If requested, look for a mail buffer that is modified and go to it.
1506 ;;; (if noerase 1638 ;;; (if noerase
1507 ;;; (progn 1639 ;;; (progn
1536 ;;; (mail-setup to subject in-reply-to cc replybuffer actions) 1668 ;;; (mail-setup to subject in-reply-to cc replybuffer actions)
1537 ;;; (if (and buffer-auto-save-file-name 1669 ;;; (if (and buffer-auto-save-file-name
1538 ;;; (file-exists-p buffer-auto-save-file-name)) 1670 ;;; (file-exists-p buffer-auto-save-file-name))
1539 ;;; (message "Auto save file for draft message exists; consider M-x mail-recover")) 1671 ;;; (message "Auto save file for draft message exists; consider M-x mail-recover"))
1540 ;;; t)) 1672 ;;; t))
1541 (pop-to-buffer "*mail*") 1673
1674 (if (eq noerase 'new)
1675 (pop-to-buffer (generate-new-buffer "*mail*"))
1676 (and noerase
1677 (not (get-buffer "*mail*"))
1678 (setq noerase nil))
1679 (pop-to-buffer "*mail*"))
1680
1542 ;; Avoid danger that the auto-save file can't be written. 1681 ;; Avoid danger that the auto-save file can't be written.
1543 (let ((dir (expand-file-name 1682 (let ((dir (expand-file-name
1544 (file-name-as-directory mail-default-directory)))) 1683 (file-name-as-directory mail-default-directory))))
1545 (if (file-exists-p dir) 1684 (if (file-exists-p dir)
1546 (setq default-directory dir))) 1685 (setq default-directory dir)))
1549 (and (not auto-save-default) buffer-auto-save-file-name)) 1688 (and (not auto-save-default) buffer-auto-save-file-name))
1550 (auto-save-mode auto-save-default)) 1689 (auto-save-mode auto-save-default))
1551 (mail-mode) 1690 (mail-mode)
1552 ;; Disconnect the buffer from its visited file 1691 ;; Disconnect the buffer from its visited file
1553 ;; (in case the user has actually visited a file *mail*). 1692 ;; (in case the user has actually visited a file *mail*).
1554 ; (set-visited-file-name nil) 1693 ;;; (set-visited-file-name nil)
1555 (let (initialized) 1694 (let (initialized)
1556 (and (not noerase) 1695 (and (not (and noerase
1696 (not (eq noerase 'new))))
1557 (if buffer-file-name 1697 (if buffer-file-name
1558 (if (buffer-modified-p) 1698 (if (buffer-modified-p)
1559 (when (y-or-n-p "Buffer has unsaved changes; reinitialize it and discard them? ") 1699 (when (y-or-n-p "Buffer has unsaved changes; reinitialize it and discard them? ")
1560 (if (y-or-n-p "Disconnect buffer from visited file? ") 1700 (if (y-or-n-p "Disconnect buffer from visited file? ")
1561 (set-visited-file-name nil)) 1701 (set-visited-file-name nil))
1716 (same-window-buffer-names nil) 1856 (same-window-buffer-names nil)
1717 (same-window-regexps nil)) 1857 (same-window-regexps nil))
1718 (pop-to-buffer "*mail*")) 1858 (pop-to-buffer "*mail*"))
1719 (mail noerase to subject in-reply-to cc replybuffer sendactions)) 1859 (mail noerase to subject in-reply-to cc replybuffer sendactions))
1720 1860
1721 ;;; Do not add anything but external entries on this page. 1861 ;; Do not add anything but external entries on this page.
1722 1862
1723 (provide 'sendmail) 1863 (provide 'sendmail)
1724 1864
1865 ;; arch-tag: 48bc1025-d993-4d31-8d81-2a29491f0626
1725 ;;; sendmail.el ends here 1866 ;;; sendmail.el ends here