Merge from emacs--rel--22, gnus--devo--0
[bpt/emacs.git] / lisp / mail / sendmail.el
CommitLineData
f70de9d4 1;;; sendmail.el --- mail sending commands for Emacs. -*- byte-compile-dynamic: t -*-
c88ab9ce 2
e84b4b86 3;; Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995, 1996, 1998, 2000,
d7a0267c 4;; 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
3a801d0c 5
e5167999 6;; Maintainer: FSF
d7b4d18f 7;; Keywords: mail
e5167999 8
20a8832d
RS
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
ceaeecb0 13;; the Free Software Foundation; either version 3, or (at your option)
20a8832d
RS
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
b578f267 22;; along with GNU Emacs; see the file COPYING. If not, write to the
3a35cf56
LK
23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24;; Boston, MA 02110-1301, USA.
20a8832d 25
d9ecc911
ER
26;;; Commentary:
27
28;; This mode provides mail-sending facilities from within Emacs. It is
29;; documented in the Emacs user's manual.
30
e5167999 31;;; Code:
be0b8d69 32(eval-when-compile
bf61662d
GM
33 ;; Necessary to avoid recursive `require's.
34 (provide 'sendmail)
be0b8d69
DL
35 (require 'rmail)
36 (require 'mailalias))
37
67ad9438
DL
38(autoload 'rfc2047-encode-string "rfc2047")
39
0b5bb3ec
SE
40(defgroup sendmail nil
41 "Mail sending commands for Emacs."
42 :prefix "mail-"
43 :group 'mail)
20a8832d 44
1938b566
RS
45(defcustom mail-setup-with-from t
46 "Non-nil means insert `From:' field when setting up the message."
1287f53f 47 :type 'boolean
1938b566
RS
48 :group 'sendmail
49 :version "22.1")
50
82695714
CY
51(defcustom sendmail-program
52 (cond
53 ((file-exists-p "/usr/sbin/sendmail") "/usr/sbin/sendmail")
54 ((file-exists-p "/usr/lib/sendmail") "/usr/lib/sendmail")
55 ((file-exists-p "/usr/ucblib/sendmail") "/usr/ucblib/sendmail")
56 (t "fakemail")) ;In ../etc, to interface to /bin/mail.
57 "Program used to send messages."
58 :group 'mail
59 :type 'file)
60
ea9ceb34 61;;;###autoload
95fe848e
SM
62(defcustom mail-from-style 'angles
63 "Specifies how \"From:\" fields look.
ea9ceb34
KH
64
65If `nil', they contain just the return address like:
66 king@grassland.com
67If `parens', they look like:
68 king@grassland.com (Elvis Parsley)
69If `angles', they look like:
cc674186 70 Elvis Parsley <king@grassland.com>
32afb744
KH
71If `system-default', allows the mailer to insert its default From field
72derived from the envelope-from address.
73
74In old versions of Emacs, the `system-default' setting also caused
75Emacs to pass the proper email address from `user-mail-address'
76to the mailer to specify the envelope-from address. But that is now
77controlled by a separate variable, `mail-specify-envelope-from'."
9a97e073
RS
78 :type '(choice (const nil) (const parens) (const angles)
79 (const system-default))
2a42d160 80 :version "20.3"
0b5bb3ec 81 :group 'sendmail)
ea9ceb34 82
32afb744 83;;;###autoload
3d04071d 84(defcustom mail-specify-envelope-from nil
95fe848e 85 "If non-nil, specify the envelope-from address when sending mail.
c1a1fd60 86The value used to specify it is whatever is found in
00164828 87the variable `mail-envelope-from', with `user-mail-address' as fallback.
32afb744 88
01bb608e 89On most systems, specifying the envelope-from address is a
00164828
GM
90privileged operation. This variable affects sendmail and
91smtpmail -- if you use feedmail to send mail, see instead the
92variable `feedmail-deduce-envelope-from'."
32afb744
KH
93 :version "21.1"
94 :type 'boolean
95 :group 'sendmail)
96
c1a1fd60 97(defcustom mail-envelope-from nil
95fe848e 98 "If non-nil, designate the envelope-from address when sending mail.
01bb608e
GM
99This only has an effect if `mail-specify-envelope-from' is non-nil.
100The value should be either a string, or the symbol `header' (in
101which case the contents of the \"From\" header of the message
102being sent is used), or nil (in which case the value of
103`user-mail-address' is used)."
c1a1fd60 104 :version "21.1"
00417fac 105 :type '(choice (string :tag "From-name")
56e5818f 106 (const :tag "Use From: header from message" header)
00417fac 107 (const :tag "Use `user-mail-address'" nil))
c1a1fd60
GM
108 :group 'sendmail)
109
20a8832d 110;;;###autoload
95fe848e
SM
111(defcustom mail-self-blind nil
112 "Non-nil means insert BCC to self in messages to be sent.
20a8832d 113This is done when the message is initialized,
0b5bb3ec
SE
114so you can remove or alter the BCC field to override the default."
115 :type 'boolean
116 :group 'sendmail)
20a8832d
RS
117
118;;;###autoload
95fe848e
SM
119(defcustom mail-interactive nil
120 "Non-nil means when sending a message wait for and display errors.
0b5bb3ec
SE
121nil means let mailer mail back a message to report errors."
122 :type 'boolean
123 :group 'sendmail)
20a8832d 124
95fe848e
SM
125(defcustom mail-yank-ignored-headers
126 (concat "^"
127 (regexp-opt '("via" "mail-from" "origin" "status" "remailed"
128 "received" "message-id" "summary-line" "to" "subject"
129 "in-reply-to" "return-path" "mail-reply-to"
130 "mail-followup-to") "\\(?:")
131 ":")
132 "Delete these headers from old message when it's inserted in a reply."
0b5bb3ec
SE
133 :type 'regexp
134 :group 'sendmail)
20a8832d 135
4adc30a4 136;; Prevent problems with `window-system' not having the correct value
5e7f11bc
LT
137;; when loaddefs.el is loaded. `custom-reevaluate-setting' needs the
138;; standard value.
139;;;###autoload
140(put 'send-mail-function 'standard-value
141 '((if (and window-system (memq system-type '(darwin windows-nt)))
142 'mailclient-send-it
143 'sendmail-send-it)))
144
20a8832d
RS
145;; Useful to set in site-init.el
146;;;###autoload
95fe848e 147(defcustom send-mail-function
255d8b22
RS
148 (if (and window-system (memq system-type '(darwin windows-nt)))
149 'mailclient-send-it
150 'sendmail-send-it)
67ad9438 151 "Function to call to send the current buffer as mail.
51d541d4 152The headers should be delimited by a line which is
e04233aa
GM
153not a valid RFC822 header or continuation line,
154that matches the variable `mail-header-separator'.
67ad9438
DL
155This is used by the default mail-sending commands. See also
156`message-send-mail-function' for use with the Message package."
c5dfddb6
DL
157 :type '(radio (function-item sendmail-send-it :tag "Use Sendmail package")
158 (function-item smtpmail-send-it :tag "Use SMTPmail package")
159 (function-item feedmail-send-it :tag "Use Feedmail package")
5c290b9e 160 (function-item mailclient-send-it :tag "Use Mailclient package")
40fa0008
DL
161 function)
162 :group 'sendmail)
20a8832d
RS
163
164;;;###autoload
95fe848e
SM
165(defcustom mail-header-separator "--text follows this line--"
166 "Line used to separate headers from text in messages being composed."
0b5bb3ec
SE
167 :type 'string
168 :group 'sendmail)
20a8832d 169
6737ae74
RS
170;; Set up mail-header-separator for use as a category text property.
171(put 'mail-header-separator 'rear-nonsticky '(category))
95fe848e
SM
172;; This was a nice idea, for preventing accidental modification of
173;; the separator. But I found it also prevented or obstructed
174;; certain deliberate operations, such as copying the separator line
175;; up to the top to send myself a copy of an already sent outgoing message
176;; and other things. So I turned it off. --rms.
177;;(put 'mail-header-separator 'read-only t)
6737ae74 178
20a8832d 179;;;###autoload
95fe848e
SM
180(defcustom mail-archive-file-name nil
181 "Name of file to write all outgoing messages in, or nil for none.
0b5bb3ec
SE
182This can be an inbox file or an Rmail file."
183 :type '(choice file (const nil))
184 :group 'sendmail)
20a8832d 185
fe8c32a6 186;;;###autoload
0b5bb3ec 187(defcustom mail-default-reply-to nil
95fe848e 188 "Address to insert as default Reply-to field of outgoing messages.
6da74aab 189If nil, it will be initialized from the REPLYTO environment variable
0b5bb3ec
SE
190when you first send mail."
191 :type '(choice (const nil) string)
192 :group 'sendmail)
20a8832d 193
a06d7943 194;;;###autoload
0b5bb3ec 195(defcustom mail-alias-file nil
95fe848e 196 "If non-nil, the name of a file to use instead of `/usr/lib/aliases'.
20a8832d
RS
197This file defines aliases to be expanded by the mailer; this is a different
198feature from that of defining aliases in `.mailrc' to be expanded in Emacs.
0b5bb3ec
SE
199This variable has no effect unless your system uses sendmail as its mailer."
200 :type '(choice (const nil) file)
201 :group 'sendmail)
20a8832d 202
8790b698 203;;;###autoload
0b5bb3ec 204(defcustom mail-personal-alias-file "~/.mailrc"
95fe848e 205 "If non-nil, the name of the user's personal mail alias file.
8790b698
NF
206This file typically should be in same format as the `.mailrc' file used by
207the `Mail' or `mailx' program.
0b5bb3ec
SE
208This file need not actually exist."
209 :type '(choice (const nil) file)
210 :group 'sendmail)
8790b698 211
214d5640 212;;;###autoload
0b5bb3ec 213(defcustom mail-setup-hook nil
8b262cbc 214 "Normal hook, run each time a new outgoing mail message is initialized.
0b5bb3ec
SE
215The function `mail-setup' runs this hook."
216 :type 'hook
f70de9d4 217 :options '(fortune-to-signature spook mail-abbrevs-setup)
0b5bb3ec 218 :group 'sendmail)
8b262cbc 219
214d5640 220;;;###autoload
5ef9d627 221(defvar mail-aliases t
ade349a0 222 "Alist of mail address aliases,
de01bf7d 223or t meaning should be initialized from your mail aliases file.
911ebffa
RS
224\(The file's name is normally `~/.mailrc', but `mail-personal-alias-file'
225can specify a different file name.)
de01bf7d 226The alias definitions in the file have this form:
ade349a0 227 alias ALIAS MEANING")
5ef9d627 228
9cc75191 229(defvar mail-alias-modtime nil
de01bf7d 230 "The modification time of your mail alias file when it was last examined.")
9cc75191 231
214d5640 232;;;###autoload
0b5bb3ec 233(defcustom mail-yank-prefix nil
95fe848e 234 "Prefix insert on lines of yanked message being replied to.
0b5bb3ec
SE
235nil means use indentation."
236 :type '(choice (const nil) string)
237 :group 'sendmail)
238
214d5640 239;;;###autoload
0b5bb3ec 240(defcustom mail-indentation-spaces 3
95fe848e 241 "Number of spaces to insert at the beginning of each cited line.
0b5bb3ec
SE
242Used by `mail-yank-original' via `mail-indent-citation'."
243 :type 'integer
244 :group 'sendmail)
214d5640 245
fa24a822 246(defvar mail-yank-hooks nil
015c5c55
RS
247 "Obsolete hook for modifying a citation just inserted in the mail buffer.
248Each hook function can find the citation between (point) and (mark t).
249And each hook function should leave point and mark around the citation
250text as modified.
251
252This is a normal hook, misnamed for historical reasons.
253It is semi-obsolete and mail agents should no longer use it.")
254
3ca0be33 255;;;###autoload
0b5bb3ec 256(defcustom mail-citation-hook nil
95fe848e 257 "Hook for modifying a citation just inserted in the mail buffer.
d6bccf09
RS
258Each hook function can find the citation between (point) and (mark t),
259and should leave point and mark around the citation text as modified.
260The hook functions can find the header of the cited message
261in the variable `mail-citation-header', whether or not this is included
262in the cited portion of the message.
1c24b04a 263
015c5c55 264If this hook is entirely empty (nil), a default action is taken
0b5bb3ec
SE
265instead of no action."
266 :type 'hook
267 :group 'sendmail)
20a8832d 268
d6bccf09
RS
269(defvar mail-citation-header nil
270 "While running `mail-citation-hook', this variable holds the message header.
271This enables the hook functions to see the whole message header
272regardless of what part of it (if any) is included in the cited text.")
273
214d5640 274;;;###autoload
706e3d85 275(defcustom mail-citation-prefix-regexp "[ \t]*[-a-z0-9A-Z]*>+[ \t]*\\|[ \t]*"
95fe848e 276 "Regular expression to match a citation prefix plus whitespace.
706e3d85
RS
277It should match whatever sort of citation prefixes you want to handle,
278with whitespace before and after; it should also match just whitespace.
279The default value matches citations like `foo-bar>' plus whitespace."
280 :type 'regexp
281 :group 'sendmail
282 :version "20.3")
283
20a8832d 284(defvar mail-abbrevs-loaded nil)
95fe848e
SM
285(defvar mail-mode-map
286 (let ((map (make-sparse-keymap)))
287 (define-key map "\M-\t" 'mail-complete)
288 (define-key map "\C-c?" 'describe-mode)
289 (define-key map "\C-c\C-f\C-t" 'mail-to)
290 (define-key map "\C-c\C-f\C-b" 'mail-bcc)
291 (define-key map "\C-c\C-f\C-f" 'mail-fcc)
292 (define-key map "\C-c\C-f\C-c" 'mail-cc)
293 (define-key map "\C-c\C-f\C-s" 'mail-subject)
294 (define-key map "\C-c\C-f\C-r" 'mail-reply-to)
295 (define-key map "\C-c\C-f\C-a" 'mail-mail-reply-to) ; author
296 (define-key map "\C-c\C-f\C-l" 'mail-mail-followup-to) ; list
297 (define-key map "\C-c\C-t" 'mail-text)
298 (define-key map "\C-c\C-y" 'mail-yank-original)
299 (define-key map "\C-c\C-r" 'mail-yank-region)
300 (define-key map [remap split-line] 'mail-split-line)
301 (define-key map "\C-c\C-q" 'mail-fill-yanked-message)
302 (define-key map "\C-c\C-w" 'mail-signature)
303 (define-key map "\C-c\C-v" 'mail-sent-via)
304 (define-key map "\C-c\C-c" 'mail-send-and-exit)
305 (define-key map "\C-c\C-s" 'mail-send)
306 (define-key map "\C-c\C-i" 'mail-attach-file)
307
308 (define-key map [menu-bar mail]
309 (cons "Mail" (make-sparse-keymap "Mail")))
310
311 (define-key map [menu-bar mail fill]
312 '("Fill Citation" . mail-fill-yanked-message))
313
314 (define-key map [menu-bar mail yank]
315 '("Cite Original" . mail-yank-original))
316
317 (define-key map [menu-bar mail signature]
318 '("Insert Signature" . mail-signature))
319
320 (define-key map [menu-bar mail mail-sep]
321 '("--"))
322
323 (define-key map [menu-bar mail cancel]
324 '("Cancel" . mail-dont-send))
325
326 (define-key map [menu-bar mail send-stay]
327 '("Send, Keep Editing" . mail-send))
328
329 (define-key map [menu-bar mail send]
330 '("Send Message" . mail-send-and-exit))
331
332 (define-key map [menu-bar headers]
333 (cons "Headers" (make-sparse-keymap "Move to Header")))
334
335 (define-key map [menu-bar headers text]
336 '("Text" . mail-text))
337
338 (define-key map [menu-bar headers expand-aliases]
339 '("Expand Aliases" . expand-mail-aliases))
340
341 (define-key map [menu-bar headers sent-via]
342 '("Sent Via" . mail-sent-via))
343
344 (define-key map [menu-bar headers mail-reply-to]
345 '("Mail Reply To" . mail-mail-reply-to))
346
347 (define-key map [menu-bar headers mail-followup-to]
348 '("Mail Followup To" . mail-mail-followup-to))
349
350 (define-key map [menu-bar headers reply-to]
351 '("Reply-To" . mail-reply-to))
352
353 (define-key map [menu-bar headers bcc]
354 '("Bcc" . mail-bcc))
355
356 (define-key map [menu-bar headers fcc]
357 '("Fcc" . mail-fcc))
358
359 (define-key map [menu-bar headers cc]
360 '("Cc" . mail-cc))
361
362 (define-key map [menu-bar headers subject]
363 '("Subject" . mail-subject))
364
365 (define-key map [menu-bar headers to]
366 '("To" . mail-to))
367
368 map))
20a8832d 369
5ef9d627 370(autoload 'build-mail-aliases "mailalias"
8790b698 371 "Read mail aliases from user's personal aliases file and set `mail-aliases'."
5ef9d627
RS
372 nil)
373
374(autoload 'expand-mail-aliases "mailalias"
375 "Expand all mail aliases in suitable header fields found between BEG and END.
376Suitable header fields are `To', `Cc' and `Bcc' and their `Resent-' variants.
377Optional second arg EXCLUDE may be a regular expression defining text to be
378removed from alias expansions."
379 nil)
380
ef15f270 381;;;###autoload
0b5bb3ec 382(defcustom mail-signature nil
95fe848e 383 "Text inserted at end of mail buffer when a message is initialized.
f13c1dae
RS
384If t, it means to insert the contents of the file `mail-signature-file'.
385If a string, that string is inserted.
386 (To make a proper signature, the string should begin with \\n\\n-- \\n,
387 which is the standard way to delimit a signature in a message.)
388Otherwise, it should be an expression; it is evaluated
389and should insert whatever you want to insert."
eb1213c1 390 :type '(choice (const :tag "None" nil)
f13c1dae
RS
391 (const :tag "Use `.signature' file" t)
392 (string :tag "String to insert")
393 (sexp :tag "Expression to evaluate"))
0b5bb3ec 394 :group 'sendmail)
f13c1dae 395(put 'mail-signature 'risky-local-variable t)
4ac2e032 396
214d5640 397;;;###autoload
0b5bb3ec 398(defcustom mail-signature-file "~/.signature"
95fe848e 399 "File containing the text inserted at end of mail buffer."
0b5bb3ec
SE
400 :type 'file
401 :group 'sendmail)
20a8832d 402
eb1213c1
MR
403;;;###autoload
404(defcustom mail-default-directory "~/"
95fe848e 405 "Directory for mail buffers.
eb1213c1
MR
406Value of `default-directory' for mail buffers.
407This directory is used for auto-save files of mail buffers."
408 :type '(directory :tag "Directory")
65280ff3 409 :group 'sendmail
bf247b6e 410 :version "22.1")
eb1213c1 411
c8553837 412(defvar mail-reply-action nil)
20a8832d
RS
413(defvar mail-send-actions nil
414 "A list of actions to be performed upon successful sending of a message.")
c8553837 415(put 'mail-reply-action 'permanent-local t)
98bd608d 416(put 'mail-send-actions 'permanent-local t)
20a8832d 417
214d5640 418;;;###autoload
0b5bb3ec 419(defcustom mail-default-headers nil
95fe848e 420 "A string containing header lines, to be inserted in outgoing messages.
20a8832d 421It is inserted before you edit the message,
0b5bb3ec
SE
422so you can edit or delete these lines."
423 :type '(choice (const nil) string)
424 :group 'sendmail)
20a8832d 425
214d5640 426;;;###autoload
0b5bb3ec 427(defcustom mail-bury-selects-summary t
95fe848e 428 "If non-nil, try to show RMAIL summary buffer after returning from mail.
1f7850dd
RS
429The functions \\[mail-send-on-exit] or \\[mail-dont-send] select
430the RMAIL summary buffer before returning, if it exists and this variable
0b5bb3ec
SE
431is non-nil."
432 :type 'boolean
433 :group 'sendmail)
1f7850dd 434
214d5640 435;;;###autoload
baaa1f19 436(defcustom mail-send-nonascii 'mime
95fe848e 437 "Specify whether to allow sending non-ASCII characters in mail.
34153d76
RS
438If t, that means do allow it. nil means don't allow it.
439`query' means ask the user each time.
baaa1f19
GM
440`mime' means add an appropriate MIME header if none already present.
441The default is `mime'.
34153d76 442Including non-ASCII characters in a mail message can be problematical
0b5bb3ec 443for the recipient, who may not know how to decode them properly."
baaa1f19 444 :type '(choice (const t) (const nil) (const query) (const mime))
0b5bb3ec 445 :group 'sendmail)
34153d76 446
0b0b4ce7 447(defcustom mail-use-dsn nil
95fe848e 448 "Ask MTA for notification of failed, delayed or successful delivery.
0b0b4ce7
RS
449Note that only some MTAs (currently only recent versions of Sendmail)
450support Delivery Status Notification."
451 :group 'sendmail
452 :type '(repeat (radio (const :tag "Failure" failure)
453 (const :tag "Delay" delay)
454 (const :tag "Success" success)))
bf247b6e 455 :version "22.1")
0b0b4ce7 456
7c203051
RS
457;; Note: could use /usr/ucb/mail instead of sendmail;
458;; options -t, and -v if not interactive.
459(defvar mail-mailer-swallows-blank-line
01b5c04d 460 (if (and (string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)" system-configuration)
47c5e807 461 (file-readable-p "/etc/sendmail.cf")
95fe848e
SM
462 (with-temp-buffer
463 (insert-file-contents "/etc/sendmail.cf")
464 (goto-char (point-min))
465 (let ((case-fold-search nil))
466 (re-search-forward "^OR\\>" nil t))))
9a41d08a
NF
467 ;; According to RFC822, "The field-name must be composed of printable
468 ;; ASCII characters (i.e. characters that have decimal values between
469 ;; 33 and 126, except colon)", i.e. any chars except ctl chars,
470 ;; space, or colon.
471 '(looking-at "[ \t]\\|[][!\"#$%&'()*+,-./0-9;<=>?@A-Z\\\\^_`a-z{|}~]+:"))
7c203051
RS
472 "Set this non-nil if the system's mailer runs the header and body together.
473\(This problem exists on Sunos 4 when sendmail is run in remote mode.)
474The value should be an expression to test whether the problem will
475actually occur.")
476
f81b71c7
SM
477(defvar mail-mode-syntax-table
478 (let ((st (make-syntax-table)))
479 ;; define-derived-mode will make it inherit from text-mode-syntax-table.
480 (modify-syntax-entry ?% ". " st)
481 st)
482 "Syntax table used while in `mail-mode'.")
20a8832d 483
8b1f1a0c 484(defvar mail-font-lock-keywords
70a302f8 485 (eval-when-compile
f1052d2e 486 (let* ((cite-chars "[>|}]")
0eafc06c 487 (cite-prefix "[:alpha:]")
f1052d2e 488 (cite-suffix (concat cite-prefix "0-9_.@-`'\"")))
3d51068d 489 (list '("^\\(To\\|Newsgroups\\):" . font-lock-function-name-face)
3ca0be33 490 '("^\\(B?CC\\|Reply-to\\|Mail-\\(reply\\|followup\\)-to\\):" . font-lock-keyword-face)
70a302f8 491 '("^\\(Subject:\\)[ \t]*\\(.+\\)?"
b795df2b
RS
492 (1 font-lock-comment-face)
493;; (2 font-lock-type-face nil t)
494 )
f1052d2e 495 ;; Use EVAL to delay in case `mail-header-separator' gets changed.
3d51068d 496 '(eval .
e69d810c 497 (let ((separator (if (zerop (length mail-header-separator))
8646fe22 498 " \\`\\' "
e69d810c
SM
499 (regexp-quote mail-header-separator))))
500 (cons (concat "^" separator "$") 'font-lock-warning-face)))
f1052d2e
SM
501 ;; Use MATCH-ANCHORED to effectively anchor the regexp left side.
502 `(,cite-chars
503 (,(concat "\\=[ \t]*"
d2f29015
RS
504 "\\(\\(\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
505 "\\(" cite-chars "[ \t]*\\)\\)+\\)"
3d51068d 506 "\\(.*\\)")
f1052d2e 507 (beginning-of-line) (end-of-line)
d2f29015
RS
508 (1 font-lock-comment-delimiter-face nil t)
509 (5 font-lock-comment-face nil t)))
c034acdf 510 '("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\):.*\\(\n[ \t]+.*\\)*$"
70a302f8 511 . font-lock-string-face))))
8b1f1a0c
RS
512 "Additional expressions to highlight in Mail mode.")
513
5b6575b7 514\f
1498db18 515(defun sendmail-sync-aliases ()
74f8a333
RS
516 (when mail-personal-alias-file
517 (let ((modtime (nth 5 (file-attributes mail-personal-alias-file))))
518 (or (equal mail-alias-modtime modtime)
519 (setq mail-alias-modtime modtime
520 mail-aliases t)))))
9cc75191 521
20a8832d 522(defun mail-setup (to subject in-reply-to cc replybuffer actions)
235c2d35 523 (or mail-default-reply-to
810163a3 524 (setq mail-default-reply-to (getenv "REPLYTO")))
1498db18 525 (sendmail-sync-aliases)
5ef9d627
RS
526 (if (eq mail-aliases t)
527 (progn
528 (setq mail-aliases nil)
74f8a333
RS
529 (when mail-personal-alias-file
530 (if (file-exists-p mail-personal-alias-file)
531 (build-mail-aliases)))))
2813dcb9 532 ;; Don't leave this around from a previous message.
f8081291 533 (kill-local-variable 'buffer-file-coding-system)
9be82109
KH
534 ;; This doesn't work for enable-multibyte-characters.
535 ;; (kill-local-variable 'enable-multibyte-characters)
536 (set-buffer-multibyte default-enable-multibyte-characters)
8881c1ab
KH
537 (if current-input-method
538 (inactivate-input-method))
20a8832d 539 (setq mail-send-actions actions)
c8553837 540 (setq mail-reply-action replybuffer)
20a8832d 541 (goto-char (point-min))
1938b566
RS
542 (if mail-setup-with-from
543 (mail-insert-from-field))
20a8832d
RS
544 (insert "To: ")
545 (save-excursion
546 (if to
70ca75ae
RS
547 ;; Here removed code to extract names from within <...>
548 ;; on the assumption that mail-strip-quoted-names
549 ;; has been called and has done so.
550 (let ((fill-prefix "\t")
551 (address-start (point)))
15575807 552 (insert to "\n")
118a3c04
RS
553 (fill-region-as-paragraph address-start (point-max))
554 (goto-char (point-max))
555 (unless (bolp)
556 (newline)))
20a8832d
RS
557 (newline))
558 (if cc
70ca75ae
RS
559 (let ((fill-prefix "\t")
560 (address-start (progn (insert "CC: ") (point))))
15575807 561 (insert cc "\n")
118a3c04
RS
562 (fill-region-as-paragraph address-start (point-max))
563 (goto-char (point-max))
564 (unless (bolp)
565 (newline))))
20a8832d 566 (if in-reply-to
118a3c04 567 (let ((fill-prefix "\t")
58cabff0 568 (fill-column 78)
34046d66 569 (address-start (point)))
15575807 570 (insert "In-reply-to: " in-reply-to "\n")
118a3c04
RS
571 (fill-region-as-paragraph address-start (point-max))
572 (goto-char (point-max))
573 (unless (bolp)
574 (newline))))
15575807 575 (insert "Subject: " (or subject "") "\n")
20a8832d
RS
576 (if mail-default-headers
577 (insert mail-default-headers))
578 (if mail-default-reply-to
15575807 579 (insert "Reply-to: " mail-default-reply-to "\n"))
20a8832d 580 (if mail-self-blind
15575807 581 (insert "BCC: " user-mail-address "\n"))
20a8832d 582 (if mail-archive-file-name
15575807 583 (insert "FCC: " mail-archive-file-name "\n"))
6737ae74
RS
584 (put-text-property (point)
585 (progn
15575807 586 (insert mail-header-separator "\n")
6737ae74
RS
587 (1- (point)))
588 'category 'mail-header-separator)
874bdb5a
RS
589 ;; Insert the signature. But remember the beginning of the message.
590 (if to (setq to (point)))
547075d4 591 (cond ((eq mail-signature t)
4ac2e032 592 (if (file-exists-p mail-signature-file)
a5282b8f 593 (progn
15575807 594 (insert "\n\n-- \n")
4ac2e032 595 (insert-file-contents mail-signature-file))))
f13c1dae
RS
596 ((stringp mail-signature)
597 (insert mail-signature))
598 (t
599 (eval mail-signature)))
20a8832d
RS
600 (goto-char (point-max))
601 (or (bolp) (newline)))
874bdb5a 602 (if to (goto-char to))
20a8832d
RS
603 (or to subject in-reply-to
604 (set-buffer-modified-p nil))
605 (run-hooks 'mail-setup-hook))
5b6575b7 606\f
be0b8d69
DL
607(defcustom mail-mode-hook nil
608 "Hook run by Mail mode."
609 :group 'sendmail
610 :type 'hook
611 :options '(footnote-mode))
612
567bb3dd 613(defvar mail-mode-abbrev-table text-mode-abbrev-table)
20a8832d 614;;;###autoload
f81b71c7 615(define-derived-mode mail-mode text-mode "Mail"
20a8832d
RS
616 "Major mode for editing mail to be sent.
617Like Text Mode but with these additional commands:
e8f4db18
RS
618
619\\[mail-send] mail-send (send the message)
620\\[mail-send-and-exit] mail-send-and-exit (send the message and exit)
621
d3db616e 622Here are commands that move to a header field (and create it if there isn't):
5d838629
CY
623 \\[mail-to] move to To: \\[mail-subject] move to Subj:
624 \\[mail-bcc] move to BCC: \\[mail-cc] move to CC:
0678d779 625 \\[mail-fcc] move to FCC: \\[mail-reply-to] move to Reply-To:
3ca0be33
RS
626 \\[mail-mail-reply-to] move to Mail-Reply-To:
627 \\[mail-mail-followup-to] move to Mail-Followup-To:
5d838629 628\\[mail-text] move to message text.
d3db616e
KH
629\\[mail-signature] mail-signature (insert `mail-signature-file' file).
630\\[mail-yank-original] mail-yank-original (insert current message, in Rmail).
631\\[mail-fill-yanked-message] mail-fill-yanked-message (fill what was yanked).
5d838629 632\\[mail-sent-via] mail-sent-via (add a sent-via field for each To or CC).
4deb3ba9
EZ
633Turning on Mail mode runs the normal hooks `text-mode-hook' and
634`mail-mode-hook' (in that order)."
c8553837 635 (make-local-variable 'mail-reply-action)
20a8832d 636 (make-local-variable 'mail-send-actions)
20a8832d 637 (setq buffer-offer-save t)
2667df42 638 (make-local-variable 'font-lock-defaults)
117e4b0c 639 (setq font-lock-defaults '(mail-font-lock-keywords t t))
20a8832d 640 (make-local-variable 'paragraph-separate)
5b6575b7
RS
641 (make-local-variable 'normal-auto-fill-function)
642 (setq normal-auto-fill-function 'mail-mode-auto-fill)
b5682230 643 (make-local-variable 'fill-paragraph-function)
c8553837 644 (setq fill-paragraph-function 'mail-mode-fill-paragraph)
eba52a1a
MB
645 ;; Allow using comment commands to add/remove quoting (this only does
646 ;; anything if mail-yank-prefix is set to a non-nil value).
647 (set (make-local-variable 'comment-start) mail-yank-prefix)
fc2a68b5
SM
648 (if mail-yank-prefix
649 (set (make-local-variable 'comment-start-skip)
650 (concat "^" (regexp-quote mail-yank-prefix) "[ \t]*")))
1b8def58
RS
651 (make-local-variable 'adaptive-fill-regexp)
652 (setq adaptive-fill-regexp
567a1c29 653 (concat "[ \t]*[-[:alnum:]]+>+[ \t]*\\|"
f81b71c7 654 adaptive-fill-regexp))
d78f466f 655 (make-local-variable 'adaptive-fill-first-line-regexp)
f03ca5f5 656 (setq adaptive-fill-first-line-regexp
40035487 657 (concat "[ \t]*[-[:alnum:]]*>+[ \t]*\\|"
f81b71c7 658 adaptive-fill-first-line-regexp))
df0d89b1
RS
659 ;; `-- ' precedes the signature. `-----' appears at the start of the
660 ;; lines that delimit forwarded messages.
661 ;; Lines containing just >= 3 dashes, perhaps after whitespace,
662 ;; are also sometimes used and should be separators.
f3e95b0d 663 (setq paragraph-separate (concat (regexp-quote mail-header-separator)
75e4db34 664 "$\\|\t*\\([-|#;>* ]\\|(?[0-9]+[.)]\\)+$"
0eafc06c 665 "\\|[ \t]*[[:alnum:]]*>+[ \t]*$\\|[ \t]*$\\|"
f3e95b0d
SM
666 "--\\( \\|-+\\)$\\|"
667 page-delimiter)))
5b6575b7 668
51d541d4
RS
669
670(defun mail-header-end ()
671 "Return the buffer location of the end of headers, as a number."
66191b7e
RS
672 (save-restriction
673 (widen)
674 (save-excursion
675 (rfc822-goto-eoh)
676 (point))))
51d541d4
RS
677
678(defun mail-text-start ()
679 "Return the buffer location of the start of text, as a number."
66191b7e
RS
680 (save-restriction
681 (widen)
682 (save-excursion
683 (rfc822-goto-eoh)
684 (forward-line 1)
685 (point))))
51d541d4
RS
686
687(defun mail-sendmail-delimit-header ()
688 "Set up whatever header delimiter convention sendmail will use.
689Concretely: replace the first blank line in the header with the separator."
690 (rfc822-goto-eoh)
691 (insert mail-header-separator)
692 (point))
693
694(defun mail-sendmail-undelimit-header ()
695 "Remove header separator to put the message in correct form for sendmail.
696Leave point at the start of the delimiter line."
697 (rfc822-goto-eoh)
698 (delete-region (point) (progn (end-of-line) (point))))
699
5b6575b7
RS
700(defun mail-mode-auto-fill ()
701 "Carry out Auto Fill for Mail mode.
702If within the headers, this makes the new lines into continuation lines."
51d541d4 703 (if (< (point) (mail-header-end))
5b6575b7
RS
704 (let ((old-line-start (save-excursion (beginning-of-line) (point))))
705 (if (do-auto-fill)
706 (save-excursion
707 (beginning-of-line)
708 (while (not (eq (point) old-line-start))
28afe199
RS
709 ;; Use insert-before-markers in case we're inserting
710 ;; before the saved value of point (which is common).
711 (insert-before-markers " ")
5b6575b7
RS
712 (forward-line -1))
713 t)))
714 (do-auto-fill)))
c8553837
RS
715
716(defun mail-mode-fill-paragraph (arg)
717 ;; Do something special only if within the headers.
51d541d4 718 (if (< (point) (mail-header-end))
a1506d29 719 (let (beg end fieldname)
8fcbbf7d
GM
720 (when (prog1 (re-search-backward "^[-a-zA-Z]+:" nil 'yes)
721 (setq beg (point)))
c8553837 722 (setq fieldname
8fcbbf7d 723 (downcase (buffer-substring beg (1- (match-end 0))))))
c8553837
RS
724 (forward-line 1)
725 ;; Find continuation lines and get rid of their continuation markers.
726 (while (looking-at "[ \t]")
727 (delete-horizontal-space)
728 (forward-line 1))
729 (setq end (point-marker))
730 (goto-char beg)
731 ;; If this field contains addresses,
732 ;; make sure we can fill after each address.
733 (if (member fieldname
734 '("to" "cc" "bcc" "from" "reply-to"
3ca0be33 735 "mail-reply-to" "mail-followup-to"
c8553837
RS
736 "resent-to" "resent-cc" "resent-bcc"
737 "resent-from" "resent-reply-to"))
738 (while (search-forward "," end t)
739 (or (looking-at "[ \t]")
740 (insert " "))))
95fe848e 741 (fill-region-as-paragraph beg end arg)
c8553837
RS
742 ;; Mark all lines except the first as continuations.
743 (goto-char beg)
744 (forward-line 1)
745 (while (< (point) end)
746 (insert " ")
747 (forward-line 1))
748 (move-marker end nil)
749 t)))
299fdd8d 750\f
5b6575b7
RS
751;; User-level commands for sending.
752
2c1e2995 753(defun mail-send-and-exit (&optional arg)
33b4a308 754 "Send message like `mail-send', then, if no errors, exit from mail buffer.
20a8832d
RS
755Prefix arg means don't delete this window."
756 (interactive "P")
757 (mail-send)
1b6bb250
RS
758 (mail-bury arg))
759
8451b5e9 760(defun mail-dont-send (&optional arg)
1b6bb250
RS
761 "Don't send the message you have been editing.
762Prefix arg means don't delete this window."
763 (interactive "P")
764 (mail-bury arg))
765
8451b5e9 766(defun mail-bury (&optional arg)
1b6bb250 767 "Bury this mail buffer."
e49ad9a5
RS
768 (let ((newbuf (other-buffer (current-buffer))))
769 (bury-buffer (current-buffer))
e32725a7
RS
770 (if (and (or nil
771 ;; In this case, we need to go to a different frame.
772 (window-dedicated-p (frame-selected-window))
773 ;; In this mode of operation, the frame was probably
774 ;; made for this buffer, so the user probably wants
775 ;; to delete it now.
776 (and pop-up-frames (one-window-p))
b03a1621 777 (cdr (assq 'mail-dedicated-frame (frame-parameters))))
9320d421 778 (not (null (delq (selected-frame) (visible-frame-list)))))
6f60853a
EZ
779 (progn
780 (if (display-multi-frame-p)
781 (delete-frame (selected-frame))
782 ;; The previous frame is where normally they have the
783 ;; RMAIL buffer displayed.
784 (other-frame -1)))
fdb90184
RS
785 (let (rmail-flag summary-buffer)
786 (and (not arg)
787 (not (one-window-p))
95fe848e
SM
788 (with-current-buffer
789 (window-buffer (next-window (selected-window) 'not))
fdb90184
RS
790 (setq rmail-flag (eq major-mode 'rmail-mode))
791 (setq summary-buffer
1f7850dd
RS
792 (and mail-bury-selects-summary
793 (boundp 'rmail-summary-buffer)
6cfc977b 794 rmail-summary-buffer
fdb90184
RS
795 (buffer-name rmail-summary-buffer)
796 (not (get-buffer-window rmail-summary-buffer))
797 rmail-summary-buffer))))
798 (if rmail-flag
799 ;; If the Rmail buffer has a summary, show that.
800 (if summary-buffer (switch-to-buffer summary-buffer)
801 (delete-window))
802 (switch-to-buffer newbuf))))))
20a8832d 803
be0b8d69
DL
804(defcustom mail-send-hook nil
805 "Hook run just before sending mail with `mail-send'."
806 :type 'hook
807 :options '(flyspell-mode-off)
808 :group 'sendmail)
809
3ca0be33
RS
810;;;###autoload
811(defcustom mail-mailing-lists nil "\
812*List of mailing list addresses the user is subscribed to.
813
814The variable is used to trigger insertion of the \"Mail-Followup-To\"
815header when sending a message to a mailing list."
816 :type '(repeat string)
817 :group 'sendmail)
818
819
20a8832d
RS
820(defun mail-send ()
821 "Send the message in the current buffer.
822If `mail-interactive' is non-nil, wait for success indication
823or error messages, and inform user.
824Otherwise any failure is reported in a message back to
825the user from the mailer."
826 (interactive)
e11094e6
RS
827 (if (if buffer-file-name
828 (y-or-n-p "Send buffer contents as mail message? ")
829 (or (buffer-modified-p)
830 (y-or-n-p "Message already sent; resend? ")))
34153d76 831 (let ((inhibit-read-only t)
3ca0be33
RS
832 (opoint (point))
833 (ml (when mail-mailing-lists
834 ;; The surrounding regexp assumes the use of
835 ;; `mail-strip-quoted-names' on addresses before matching
836 ;; Cannot deal with full RFC 822 freedom, but that is
837 ;; unlikely to be problematic.
838 (concat "\\(?:[[:space:];,]\\|\\`\\)"
839 (regexp-opt mail-mailing-lists t)
840 "\\(?:[[:space:];,]\\|\\'\\)"))))
841 ;; If there are mailing lists defined
842 (when ml
843 (save-excursion
844 (let* ((to (mail-fetch-field "to" nil t))
845 (cc (mail-fetch-field "cc" nil t))
846 (new-header-values ; To: and Cc:
847 (mail-strip-quoted-names
848 (concat to (when cc (concat ", " cc))))))
849 ;; If message goes to known mailing list ...
850 (when (string-match ml new-header-values)
851 ;; Add Mail-Followup-To if none yet
852 (unless (mail-fetch-field "mail-followup-to")
853 (goto-char (mail-header-end))
854 (insert "Mail-Followup-To: "
855 (let ((l))
856 (mapc
857 ;; remove duplicates
858 '(lambda (e)
859 (unless (member e l)
860 (push e l)))
6f0de615
EZ
861 (split-string new-header-values
862 ",[[:space:]]+" t))
3ca0be33 863 (mapconcat 'identity l ", "))
15575807 864 "\n"))
3ca0be33
RS
865 ;; Add Mail-Reply-To if none yet
866 (unless (mail-fetch-field "mail-reply-to")
867 (goto-char (mail-header-end))
868 (insert "Mail-Reply-To: "
869 (or (mail-fetch-field "reply-to")
870 user-mail-address)
15575807 871 "\n"))))))
42d305db 872 (unless (memq mail-send-nonascii '(t mime))
34153d76
RS
873 (goto-char (point-min))
874 (skip-chars-forward "\0-\177")
875 (or (= (point) (point-max))
876 (if (eq mail-send-nonascii 'query)
877 (or (y-or-n-p "Message contains non-ASCII characters; send anyway? ")
878 (error "Aborted"))
879 (error "Message contains non-ASCII characters"))))
413d1aa2
RS
880 ;; Complain about any invalid line.
881 (goto-char (point-min))
c43d7539
CY
882 (re-search-forward (regexp-quote mail-header-separator) (point-max) t)
883 (let ((header-end (or (match-beginning 0) (point-max))))
884 (goto-char (point-min))
885 (while (< (point) header-end)
886 (unless (looking-at "[ \t]\\|.*:\\|$")
887 (push-mark opoint)
888 (error "Invalid header line (maybe a continuation line lacks initial whitespace)"))
889 (forward-line 1)))
34153d76 890 (goto-char opoint)
20a8832d 891 (run-hooks 'mail-send-hook)
da5667c6 892 (message "Sending...")
20a8832d
RS
893 (funcall send-mail-function)
894 ;; Now perform actions on successful sending.
895 (while mail-send-actions
896 (condition-case nil
d2561f34
RS
897 (apply (car (car mail-send-actions))
898 (cdr (car mail-send-actions)))
20a8832d
RS
899 (error))
900 (setq mail-send-actions (cdr mail-send-actions)))
d2561f34 901 (message "Sending...done")
4e0c8650 902 ;; If buffer has no file, mark it as unmodified and delete auto-save.
d2561f34
RS
903 (if (not buffer-file-name)
904 (progn
905 (set-buffer-modified-p nil)
906 (delete-auto-save-file-if-necessary t))))))
56e5818f
SJ
907
908(defun mail-envelope-from ()
909 "Return the envelope mail address to use when sending mail.
910This function uses `mail-envelope-from'."
911 (if (eq mail-envelope-from 'header)
912 (nth 1 (mail-extract-address-components
913 (mail-fetch-field "From")))
914 mail-envelope-from))
5b6575b7
RS
915\f
916;; This does the real work of sending a message via sendmail.
917;; It is called via the variable send-mail-function.
20a8832d 918
ae54d287
KH
919;;;###autoload
920(defvar sendmail-coding-system nil
da241b5c 921 "*Coding system for encoding the outgoing mail.
265f03bc 922This has higher priority than `default-buffer-file-coding-system'
da241b5c
KH
923and `default-sendmail-coding-system',
924but lower priority than the local value of `buffer-file-coding-system'.
0b64a3da 925See also the function `select-message-coding-system'.")
da241b5c
KH
926
927;;;###autoload
928(defvar default-sendmail-coding-system 'iso-latin-1
265f03bc 929 "Default coding system for encoding the outgoing mail.
da241b5c
KH
930This variable is used only when `sendmail-coding-system' is nil.
931
27f667c0 932This variable is set/changed by the command `set-language-environment'.
da241b5c 933User should not set this variable manually,
27f667c0 934instead use `sendmail-coding-system' to get a constant encoding
da241b5c 935of outgoing mails regardless of the current language environment.
0b64a3da 936See also the function `select-message-coding-system'.")
ee0a4f29 937
1938b566
RS
938(defun mail-insert-from-field ()
939 (let* ((login user-mail-address)
940 (fullname (user-full-name))
941 (quote-fullname nil))
942 (if (string-match "[^\0-\177]" fullname)
943 (setq fullname (rfc2047-encode-string fullname)
944 quote-fullname t))
945 (cond ((eq mail-from-style 'angles)
946 (insert "From: " fullname)
947 (let ((fullname-start (+ (point-min) 6))
948 (fullname-end (point-marker)))
949 (goto-char fullname-start)
950 ;; Look for a character that cannot appear unquoted
951 ;; according to RFC 822.
952 (if (or (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]"
953 fullname-end 1)
954 quote-fullname)
955 (progn
956 ;; Quote fullname, escaping specials.
957 (goto-char fullname-start)
958 (insert "\"")
959 (while (re-search-forward "[\"\\]"
960 fullname-end 1)
961 (replace-match "\\\\\\&" t))
962 (insert "\""))))
15575807 963 (insert " <" login ">\n"))
1938b566
RS
964 ((eq mail-from-style 'parens)
965 (insert "From: " login " (")
966 (let ((fullname-start (point)))
967 (if quote-fullname
968 (insert "\""))
969 (insert fullname)
970 (if quote-fullname
971 (insert "\""))
972 (let ((fullname-end (point-marker)))
973 (goto-char fullname-start)
974 ;; RFC 822 says \ and nonmatching parentheses
975 ;; must be escaped in comments.
976 ;; Escape every instance of ()\ ...
977 (while (re-search-forward "[()\\]" fullname-end 1)
978 (replace-match "\\\\\\&" t))
979 ;; ... then undo escaping of matching parentheses,
980 ;; including matching nested parentheses.
981 (goto-char fullname-start)
982 (while (re-search-forward
983 "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"
984 fullname-end 1)
985 (replace-match "\\1(\\3)" t)
986 (goto-char fullname-start))))
15575807 987 (insert ")\n"))
1938b566 988 ((null mail-from-style)
15575807 989 (insert "From: " login "\n"))
1938b566
RS
990 ((eq mail-from-style 'system-default)
991 nil)
992 (t (error "Invalid value for `mail-from-style'")))))
993
78205dab
SS
994;; Normally you will not need to modify these options unless you are
995;; using some non-genuine substitute for sendmail which does not
996;; implement each and every option that the original supports.
997;; E.g., ssmtp does not support "-odb", so, if your site uses it,
998;; you will need to modify `sendmail-error-reporting-non-interactive'
999;; in your site-init.el.
1000(defvar sendmail-error-reporting-interactive
1001 ;; These mean "report errors to terminal" and "deliver interactively"
1002 '("-oep" "-odi"))
1003(defvar sendmail-error-reporting-non-interactive
1004 ;; These mean "report errors by mail" and "deliver in background".
1005 '("-oem" "-odb"))
1006
20a8832d 1007(defun sendmail-send-it ()
67ad9438
DL
1008 "Send the current mail buffer using the Sendmail package.
1009This is a suitable value for `send-mail-function'. It sends using the
1010external program defined by `sendmail-program'."
8e183d5b 1011 (require 'mail-utils)
20a8832d
RS
1012 (let ((errbuf (if mail-interactive
1013 (generate-new-buffer " sendmail errors")
538b9847 1014 0))
20a8832d 1015 (tembuf (generate-new-buffer " sendmail temp"))
c86237b2 1016 (multibyte enable-multibyte-characters)
20a8832d 1017 (case-fold-search nil)
a80d7290 1018 (selected-coding (select-message-coding-system))
3ca0be33 1019 resend-to-addresses
20a8832d 1020 delimline
00365e98 1021 fcc-was-found
3ff0518e
GM
1022 (mailbuf (current-buffer))
1023 (program (if (boundp 'sendmail-program)
1024 sendmail-program
31bc27f6 1025 "/usr/lib/sendmail"))
00417fac
RS
1026 ;; Examine these variables now, so that
1027 ;; local binding in the mail buffer will take effect.
1028 (envelope-from
1029 (and mail-specify-envelope-from
56e5818f 1030 (or (mail-envelope-from) user-mail-address))))
20a8832d 1031 (unwind-protect
95fe848e 1032 (with-current-buffer tembuf
20a8832d 1033 (erase-buffer)
c86237b2
RS
1034 (unless multibyte
1035 (set-buffer-multibyte nil))
20a8832d
RS
1036 (insert-buffer-substring mailbuf)
1037 (goto-char (point-max))
1038 ;; require one newline at the end.
1039 (or (= (preceding-char) ?\n)
15575807 1040 (insert ?\n))
20a8832d 1041 ;; Change header-delimiter to be what sendmail expects.
51d541d4
RS
1042 (goto-char (mail-header-end))
1043 (delete-region (point) (progn (end-of-line) (point)))
20a8832d 1044 (setq delimline (point-marker))
1498db18 1045 (sendmail-sync-aliases)
5ef9d627
RS
1046 (if mail-aliases
1047 (expand-mail-aliases (point-min) delimline))
20a8832d 1048 (goto-char (point-min))
413d1aa2 1049 ;; Ignore any blank lines in the header
20a8832d
RS
1050 (while (and (re-search-forward "\n\n\n*" delimline t)
1051 (< (point) delimline))
15575807 1052 (replace-match "\n"))
413d1aa2 1053 (goto-char (point-min))
3ca0be33
RS
1054 ;; Look for Resent- headers. They require sending
1055 ;; the message specially.
20a8832d 1056 (let ((case-fold-search t))
3ca0be33
RS
1057 (goto-char (point-min))
1058 (while (re-search-forward "^Resent-\\(to\\|cc\\|bcc\\):" delimline t)
1059 ;; Put a list of such addresses in resend-to-addresses.
1060 (setq resend-to-addresses
1061 (save-restriction
1062 (narrow-to-region (point)
1063 (save-excursion
1064 (forward-line 1)
1065 (while (looking-at "^[ \t]")
1066 (forward-line 1))
1067 (point)))
1068 (append (mail-parse-comma-list)
1069 resend-to-addresses)))
1070 ;; Delete Resent-BCC ourselves
1071 (if (save-excursion (beginning-of-line)
1072 (looking-at "resent-bcc"))
1073 (delete-region (save-excursion (beginning-of-line) (point))
1074 (save-excursion (end-of-line) (1+ (point))))))
1075;;; Apparently this causes a duplicate Sender.
1076;;; ;; If the From is different than current user, insert Sender.
1077;;; (goto-char (point-min))
1078;;; (and (re-search-forward "^From:" delimline t)
1079;;; (progn
1080;;; (require 'mail-utils)
1081;;; (not (string-equal
1082;;; (mail-strip-quoted-names
1083;;; (save-restriction
1084;;; (narrow-to-region (point-min) delimline)
1085;;; (mail-fetch-field "From")))
1086;;; (user-login-name))))
1087;;; (progn
1088;;; (forward-line 1)
1089;;; (insert "Sender: " (user-login-name) "\n")))
20a8832d
RS
1090 ;; Don't send out a blank subject line
1091 (goto-char (point-min))
66961910 1092 (if (re-search-forward "^Subject:\\([ \t]*\n\\)+\\b" delimline t)
54115447
RS
1093 (replace-match "")
1094 ;; This one matches a Subject just before the header delimiter.
1095 (if (and (re-search-forward "^Subject:\\([ \t]*\n\\)+" delimline t)
1096 (= (match-end 0) delimline))
1097 (replace-match "")))
ea9ceb34
KH
1098 ;; Put the "From:" field in unless for some odd reason
1099 ;; they put one in themselves.
1100 (goto-char (point-min))
1101 (if (not (re-search-forward "^From:" delimline t))
1938b566 1102 (mail-insert-from-field))
baaa1f19 1103 ;; Possibly add a MIME header for the current coding system
5ddcadb8 1104 (let (charset)
baaa1f19
GM
1105 (goto-char (point-min))
1106 (and (eq mail-send-nonascii 'mime)
1107 (not (re-search-forward "^MIME-version:" delimline t))
1108 (progn (skip-chars-forward "\0-\177")
1109 (/= (point) (point-max)))
a80d7290 1110 selected-coding
baaa1f19 1111 (setq charset
5ddcadb8 1112 (coding-system-get selected-coding 'mime-charset))
baaa1f19 1113 (goto-char delimline)
15575807 1114 (insert "MIME-version: 1.0\n"
baaa1f19 1115 "Content-type: text/plain; charset="
15575807
CY
1116 (symbol-name charset)
1117 "\nContent-Transfer-Encoding: 8bit\n")))
7c203051
RS
1118 ;; Insert an extra newline if we need it to work around
1119 ;; Sun's bug that swallows newlines.
1120 (goto-char (1+ delimline))
1121 (if (eval mail-mailer-swallows-blank-line)
1122 (newline))
d6e000df
RS
1123 ;; Find and handle any FCC fields.
1124 (goto-char (point-min))
1125 (if (re-search-forward "^FCC:" delimline t)
00365e98
RS
1126 (progn
1127 (setq fcc-was-found t)
1128 (mail-do-fcc delimline)))
20a8832d 1129 (if mail-interactive
95fe848e 1130 (with-current-buffer errbuf
20a8832d 1131 (erase-buffer))))
00365e98
RS
1132 (goto-char (point-min))
1133 (if (let ((case-fold-search t))
3ca0be33
RS
1134 (or resend-to-addresses
1135 (re-search-forward "^To:\\|^cc:\\|^bcc:"
1136 delimline t)))
63b89616 1137 (let* ((default-directory "/")
a80d7290 1138 (coding-system-for-write selected-coding)
a1506d29 1139 (args
63b89616 1140 (append (list (point-min) (point-max)
3ff0518e 1141 program
63b89616 1142 nil errbuf nil "-oi")
00417fac
RS
1143 (and envelope-from
1144 (list "-f" envelope-from))
63b89616
KH
1145;;; ;; Don't say "from root" if running under su.
1146;;; (and (equal (user-real-login-name) "root")
1147;;; (list "-f" (user-login-name)))
1148 (and mail-alias-file
1149 (list (concat "-oA" mail-alias-file)))
1150 (if mail-interactive
78205dab
SS
1151 sendmail-error-reporting-interactive
1152 sendmail-error-reporting-non-interactive)
3ca0be33
RS
1153 ;; Get the addresses from the message
1154 ;; unless this is a resend.
1155 ;; We must not do that for a resend
1156 ;; because we would find the original addresses.
1157 ;; For a resend, include the specific addresses.
1158 (or resend-to-addresses
180d5509 1159 '("-t")
3ca0be33 1160 )
0b0b4ce7
RS
1161 (if mail-use-dsn
1162 (list "-N" (mapconcat 'symbol-name
1163 mail-use-dsn ",")))
180d5509
GM
1164 )
1165 )
63b89616 1166 (exit-value (apply 'call-process-region args)))
15502042 1167 (or (null exit-value) (eq 0 exit-value)
63b89616 1168 (error "Sending...failed with exit value %d" exit-value)))
00365e98
RS
1169 (or fcc-was-found
1170 (error "No recipients")))
20a8832d 1171 (if mail-interactive
95fe848e 1172 (with-current-buffer errbuf
20a8832d
RS
1173 (goto-char (point-min))
1174 (while (re-search-forward "\n\n* *" nil t)
1175 (replace-match "; "))
1176 (if (not (zerop (buffer-size)))
1177 (error "Sending...failed to %s"
1178 (buffer-substring (point-min) (point-max)))))))
1179 (kill-buffer tembuf)
1180 (if (bufferp errbuf)
1181 (kill-buffer errbuf)))))
1182
1183(defun mail-do-fcc (header-end)
95fe848e
SM
1184 (unless (markerp header-end)
1185 (error "Value of `header-end' must be a marker"))
20a8832d
RS
1186 (let (fcc-list
1187 (rmailbuf (current-buffer))
facb137b 1188 (time (current-time))
20a8832d
RS
1189 (tembuf (generate-new-buffer " rmail output"))
1190 (case-fold-search t))
1191 (save-excursion
1192 (goto-char (point-min))
1193 (while (re-search-forward "^FCC:[ \t]*" header-end t)
95fe848e
SM
1194 (push (buffer-substring (point)
1195 (progn
1196 (end-of-line)
1197 (skip-chars-backward " \t")
1198 (point)))
1199 fcc-list)
20a8832d
RS
1200 (delete-region (match-beginning 0)
1201 (progn (forward-line 1) (point))))
1202 (set-buffer tembuf)
1203 (erase-buffer)
fc23ca96 1204 ;; This initial newline is written out if the fcc file already exists.
15575807
CY
1205 (insert "\nFrom " (user-login-name) " "
1206 (current-time-string time) "\n")
847f73fd
RS
1207 ;; Insert the time zone before the year.
1208 (forward-char -1)
1209 (forward-word -1)
f3098917
RS
1210 (require 'mail-utils)
1211 (insert (mail-rfc822-time-zone time) " ")
847f73fd 1212 (goto-char (point-max))
20a8832d
RS
1213 (insert-buffer-substring rmailbuf)
1214 ;; Make sure messages are separated.
1215 (goto-char (point-max))
15575807 1216 (insert ?\n)
20a8832d
RS
1217 (goto-char 2)
1218 ;; ``Quote'' "^From " as ">From "
1219 ;; (note that this isn't really quoting, as there is no requirement
1220 ;; that "^[>]+From " be quoted in the same transparent way.)
1221 (let ((case-fold-search nil))
1222 (while (search-forward "\nFrom " nil t)
1223 (forward-char -5)
1224 (insert ?>)))
95fe848e
SM
1225 (dolist (fcc fcc-list)
1226 (let* ((buffer (find-buffer-visiting fcc))
3a3ffba4 1227 (curbuf (current-buffer))
0d15bc31
RS
1228 dont-write-the-file
1229 buffer-matches-file
3a3ffba4
RS
1230 (beg (point-min)) (end (point-max))
1231 (beg2 (save-excursion (goto-char (point-min))
1232 (forward-line 2) (point))))
20a8832d
RS
1233 (if buffer
1234 ;; File is present in a buffer => append to that buffer.
95fe848e 1235 (with-current-buffer buffer
0d15bc31
RS
1236 (setq buffer-matches-file
1237 (and (not (buffer-modified-p))
205d354f 1238 (verify-visited-file-modtime buffer)))
d6642dff
RS
1239 ;; Keep the end of the accessible portion at the same place
1240 ;; unless it is the end of the buffer.
1241 (let ((max (if (/= (1+ (buffer-size)) (point-max))
1242 (point-max))))
1243 (unwind-protect
1244 ;; Code below lifted from rmailout.el
1245 ;; function rmail-output-to-rmail-file:
1246 (let ((buffer-read-only nil)
1247 (msg (and (boundp 'rmail-current-message)
1248 rmail-current-message)))
1249 ;; If MSG is non-nil, buffer is in RMAIL mode.
1250 (if msg
1251 (progn
e04233aa
GM
1252 ;; Append to an ordinary buffer as a
1253 ;; Unix mail message.
d6642dff
RS
1254 (rmail-maybe-set-message-counters)
1255 (widen)
1256 (narrow-to-region (point-max) (point-max))
15575807
CY
1257 (insert "\C-l\n0, unseen,,\n*** EOOH ***\n"
1258 "Date: " (mail-rfc822-date) "\n")
d6642dff 1259 (insert-buffer-substring curbuf beg2 end)
15575807 1260 (insert "\n\C-_")
d6642dff
RS
1261 (goto-char (point-min))
1262 (widen)
1263 (search-backward "\n\^_")
1264 (narrow-to-region (point) (point-max))
1265 (rmail-count-new-messages t)
1266 (rmail-show-message msg)
1267 (setq max nil))
1268 ;; Output file not in rmail mode
1269 ;; => just insert at the end.
1270 (narrow-to-region (point-min) (1+ (buffer-size)))
1271 (goto-char (point-max))
0d15bc31
RS
1272 (insert-buffer-substring curbuf beg end))
1273 (or buffer-matches-file
1274 (progn
1275 (if (y-or-n-p (format "Save file %s? "
95fe848e 1276 fcc))
0d15bc31
RS
1277 (save-buffer))
1278 (setq dont-write-the-file t))))
1279 (if max (narrow-to-region (point-min) max))))))
1280 ;; Append to the file directly,
1281 ;; unless we've already taken care of it.
f6f4d690 1282 (unless dont-write-the-file
95fe848e 1283 (if (and (file-exists-p fcc)
faeb73d4
GM
1284 ;; Check that the file isn't empty. We don't
1285 ;; want to insert a newline at the start of an
1286 ;; empty file.
95fe848e
SM
1287 (not (zerop (nth 7 (file-attributes fcc))))
1288 (mail-file-babyl-p fcc))
f6f4d690
KH
1289 ;; If the file is a Babyl file,
1290 ;; convert the message to Babyl format.
1291 (let ((coding-system-for-write
1292 (or rmail-file-coding-system
1293 'emacs-mule)))
95fe848e 1294 (with-current-buffer (get-buffer-create " mail-temp")
f6f4d690
KH
1295 (setq buffer-read-only nil)
1296 (erase-buffer)
15575807
CY
1297 (insert "\C-l\n0, unseen,,\n*** EOOH ***\nDate: "
1298 (mail-rfc822-date) "\n")
f6f4d690 1299 (insert-buffer-substring curbuf beg2 end)
15575807 1300 (insert "\n\C-_")
95fe848e 1301 (write-region (point-min) (point-max) fcc t)
f6f4d690
KH
1302 (erase-buffer)))
1303 (write-region
95fe848e 1304 (1+ (point-min)) (point-max) fcc t)))
0d15bc31
RS
1305 (and buffer (not dont-write-the-file)
1306 (with-current-buffer buffer
95fe848e 1307 (set-visited-file-modtime))))))
20a8832d
RS
1308 (kill-buffer tembuf)))
1309
1310(defun mail-sent-via ()
1311 "Make a Sent-via header line from each To or CC header line."
1312 (interactive)
1313 (save-excursion
20a8832d 1314 ;; put a marker at the end of the header
81f5ed32 1315 (let ((end (copy-marker (mail-header-end)))
95fe848e 1316 (case-fold-search t))
20a8832d
RS
1317 (goto-char (point-min))
1318 ;; search for the To: lines and make Sent-via: lines from them
1319 ;; search for the next To: line
1320 (while (re-search-forward "^\\(to\\|cc\\):" end t)
1321 ;; Grab this line plus all its continuations, sans the `to:'.
1322 (let ((to-line
1323 (buffer-substring (point)
1324 (progn
1325 (if (re-search-forward "^[^ \t\n]" end t)
1326 (backward-char 1)
1327 (goto-char end))
1328 (point)))))
1329 ;; Insert a copy, with altered header field name.
1330 (insert-before-markers "Sent-via:" to-line))))))
1331\f
1332(defun mail-to ()
1333 "Move point to end of To-field."
1334 (interactive)
1335 (expand-abbrev)
1336 (mail-position-on-field "To"))
1337
1338(defun mail-subject ()
1339 "Move point to end of Subject-field."
1340 (interactive)
1341 (expand-abbrev)
1342 (mail-position-on-field "Subject"))
1343
1344(defun mail-cc ()
1345 "Move point to end of CC-field. Create a CC field if none."
1346 (interactive)
1347 (expand-abbrev)
1348 (or (mail-position-on-field "cc" t)
1349 (progn (mail-position-on-field "to")
15575807 1350 (insert "\nCC: "))))
20a8832d
RS
1351
1352(defun mail-bcc ()
1353 "Move point to end of BCC-field. Create a BCC field if none."
1354 (interactive)
1355 (expand-abbrev)
1356 (or (mail-position-on-field "bcc" t)
1357 (progn (mail-position-on-field "to")
15575807 1358 (insert "\nBCC: "))))
20a8832d 1359
5a31c2d2 1360(defun mail-fcc (folder)
70ee42f7 1361 "Add a new FCC field, with file name completion."
5a31c2d2 1362 (interactive "FFolder carbon copy: ")
70ee42f7
JB
1363 (expand-abbrev)
1364 (or (mail-position-on-field "fcc" t) ;Put new field after exiting FCC.
1365 (mail-position-on-field "to"))
15575807 1366 (insert "\nFCC: " folder))
70ee42f7 1367
a1506d29 1368(defun mail-reply-to ()
e04233aa 1369 "Move point to end of Reply-To-field. Create a Reply-To field if none."
3a3ffba4
RS
1370 (interactive)
1371 (expand-abbrev)
1372 (mail-position-on-field "Reply-To"))
1373
3ca0be33
RS
1374(defun mail-mail-reply-to ()
1375 "Move point to end of Mail-Reply-To field.
1376Create a Mail-Reply-To field if none."
1377 (interactive)
1378 (expand-abbrev)
1379 (or (mail-position-on-field "mail-reply-to" t)
1380 (progn (mail-position-on-field "to")
15575807 1381 (insert "\nMail-Reply-To: "))))
3ca0be33
RS
1382
1383(defun mail-mail-followup-to ()
1384 "Move point to end of Mail-Followup-To field.
1385Create a Mail-Followup-To field if none."
1386 (interactive)
1387 (expand-abbrev)
1388 (or (mail-position-on-field "mail-followup-to" t)
1389 (progn (mail-position-on-field "to")
15575807 1390 (insert "\nMail-Followup-To: "))))
3ca0be33 1391
20a8832d
RS
1392(defun mail-position-on-field (field &optional soft)
1393 (let (end
1394 (case-fold-search t))
51d541d4 1395 (setq end (mail-header-end))
20a8832d
RS
1396 (goto-char (point-min))
1397 (if (re-search-forward (concat "^" (regexp-quote field) ":") end t)
1398 (progn
1399 (re-search-forward "^[^ \t]" nil 'move)
1400 (beginning-of-line)
1401 (skip-chars-backward "\n")
1402 t)
1403 (or soft
1404 (progn (goto-char end)
15575807 1405 (insert field ": \n")
08564963 1406 (skip-chars-backward "\n")))
20a8832d
RS
1407 nil)))
1408
1409(defun mail-text ()
5d838629 1410 "Move point to beginning of text field."
20a8832d 1411 (interactive)
e3b671fc 1412 (expand-abbrev)
51d541d4 1413 (goto-char (mail-text-start)))
20a8832d 1414\f
e04233aa 1415(defun mail-signature (&optional atpoint)
287ef00f 1416 "Sign letter with signature based on `mail-signature-file'.
e4f794ed 1417Prefix arg means put contents at point."
0d021ccf 1418 (interactive "P")
20a8832d 1419 (save-excursion
0d021ccf
ER
1420 (or atpoint
1421 (goto-char (point-max)))
20a8832d
RS
1422 (skip-chars-backward " \t\n")
1423 (end-of-line)
0d021ccf
ER
1424 (or atpoint
1425 (delete-region (point) (point-max)))
287ef00f
RS
1426 (if (stringp mail-signature)
1427 (insert mail-signature)
15575807 1428 (insert "\n\n-- \n")
287ef00f 1429 (insert-file-contents (expand-file-name mail-signature-file)))))
20a8832d
RS
1430
1431(defun mail-fill-yanked-message (&optional justifyp)
1432 "Fill the paragraphs of a message yanked into this one.
1433Numeric argument means justify as well."
1434 (interactive "P")
1435 (save-excursion
51d541d4 1436 (goto-char (mail-text-start))
20a8832d
RS
1437 (fill-individual-paragraphs (point)
1438 (point-max)
1439 justifyp
706e3d85 1440 mail-citation-prefix-regexp)))
20a8832d 1441
374bda6b 1442(defun mail-indent-citation ()
1c24b04a
RS
1443 "Modify text just inserted from a message to be cited.
1444The inserted text should be the region.
1445When this function returns, the region is again around the modified text.
1446
1447Normally, indent each nonblank line `mail-indentation-spaces' spaces.
1448However, if `mail-yank-prefix' is non-nil, insert that prefix on each line."
374bda6b 1449 (mail-yank-clear-headers (region-beginning) (region-end))
e39e74c0 1450 (if (null mail-yank-prefix)
374bda6b
RS
1451 (indent-rigidly (region-beginning) (region-end)
1452 mail-indentation-spaces)
e39e74c0 1453 (save-excursion
374bda6b
RS
1454 (let ((end (set-marker (make-marker) (region-end))))
1455 (goto-char (region-beginning))
1456 (while (< (point) end)
1457 (insert mail-yank-prefix)
1458 (forward-line 1))))))
1c24b04a 1459
20a8832d
RS
1460(defun mail-yank-original (arg)
1461 "Insert the message being replied to, if any (in rmail).
26adca1b 1462Puts point after the text and mark before.
20a8832d
RS
1463Normally, indents each nonblank line ARG spaces (default 3).
1464However, if `mail-yank-prefix' is non-nil, insert that prefix on each line.
1465
1466Just \\[universal-argument] as argument means don't indent, insert no prefix,
1467and don't delete any header fields."
1468 (interactive "P")
c8553837
RS
1469 (if mail-reply-action
1470 (let ((start (point))
1471 (original mail-reply-action))
1472 (and (consp original) (eq (car original) 'insert-buffer)
1473 (setq original (nth 1 original)))
1474 (if (consp original)
1475 (apply (car original) (cdr original))
1476 ;; If the original message is in another window in the same frame,
1477 ;; delete that window to save screen space.
1478 ;; t means don't alter other frames.
1479 (delete-windows-on original t)
c7c93bd9
RS
1480 (with-no-warnings
1481 ;; We really want this to set mark.
1482 (insert-buffer original))
75e4db34 1483 (set-text-properties (point) (mark t) nil))
20a8832d
RS
1484 (if (consp arg)
1485 nil
1c24b04a
RS
1486 (goto-char start)
1487 (let ((mail-indentation-spaces (if arg (prefix-numeric-value arg)
ac9f0310 1488 mail-indentation-spaces))
8761c2c4
RS
1489 ;; Avoid error in Transient Mark mode
1490 ;; on account of mark's being inactive.
ac9f0310 1491 (mark-even-if-inactive t))
e04233aa
GM
1492 (cond (mail-citation-hook
1493 ;; Bind mail-citation-header to the inserted
1494 ;; message's header.
1495 (let ((mail-citation-header
1496 (buffer-substring-no-properties
1497 start
1498 (save-excursion
1499 (save-restriction
1500 (narrow-to-region start (point-max))
1501 (goto-char start)
1502 (rfc822-goto-eoh)
1503 (point))))))
1504 (run-hooks 'mail-citation-hook)))
1505 (mail-yank-hooks
1506 (run-hooks 'mail-yank-hooks))
1507 (t
1508 (mail-indent-citation)))))
3c280f48
RS
1509 ;; This is like exchange-point-and-mark, but doesn't activate the mark.
1510 ;; It is cleaner to avoid activation, even though the command
1511 ;; loop would deactivate the mark because we inserted text.
1512 (goto-char (prog1 (mark t)
1513 (set-marker (mark-marker) (point) (current-buffer))))
15575807 1514 (if (not (eolp)) (insert ?\n)))))
20a8832d
RS
1515
1516(defun mail-yank-clear-headers (start end)
e39e74c0
RS
1517 (if (< end start)
1518 (let (temp)
1519 (setq temp start start end end temp)))
2b3a206d
RS
1520 (if mail-yank-ignored-headers
1521 (save-excursion
1522 (goto-char start)
1523 (if (search-forward "\n\n" end t)
1524 (save-restriction
1525 (narrow-to-region start (point))
1526 (goto-char start)
1527 (while (let ((case-fold-search t))
1528 (re-search-forward mail-yank-ignored-headers nil t))
1529 (beginning-of-line)
1530 (delete-region (point)
1531 (progn (re-search-forward "\n[^ \t]")
1532 (forward-char -1)
1533 (point)))))))))
e39e74c0
RS
1534
1535(defun mail-yank-region (arg)
1536 "Insert the selected region from the message being replied to.
1537Puts point after the text and mark before.
1538Normally, indents each nonblank line ARG spaces (default 3).
1539However, if `mail-yank-prefix' is non-nil, insert that prefix on each line.
1540
1541Just \\[universal-argument] as argument means don't indent, insert no prefix,
1542and don't delete any header fields."
1543 (interactive "P")
1544 (and (consp mail-reply-action)
1545 (eq (car mail-reply-action) 'insert-buffer)
75e4db34
RS
1546 (with-current-buffer (nth 1 mail-reply-action)
1547 (or (mark t)
1548 (error "No mark set: %S" (current-buffer))))
e39e74c0 1549 (let ((buffer (nth 1 mail-reply-action))
8761c2c4
RS
1550 (start (point))
1551 ;; Avoid error in Transient Mark mode
1552 ;; on account of mark's being inactive.
1553 (mark-even-if-inactive t))
e39e74c0
RS
1554 ;; Insert the citation text.
1555 (insert (with-current-buffer buffer
d6bccf09 1556 (buffer-substring-no-properties (point) (mark))))
e39e74c0
RS
1557 (push-mark start)
1558 ;; Indent or otherwise annotate the citation text.
1559 (if (consp arg)
1560 nil
1561 (let ((mail-indentation-spaces (if arg (prefix-numeric-value arg)
1562 mail-indentation-spaces)))
1563 (if mail-citation-hook
d6bccf09
RS
1564 ;; Bind mail-citation-hook to the original message's header.
1565 (let ((mail-citation-header
1566 (with-current-buffer buffer
1567 (buffer-substring-no-properties
1568 (point-min)
1569 (save-excursion
1570 (goto-char (point-min))
1571 (rfc822-goto-eoh)
1572 (point))))))
1573 (run-hooks 'mail-citation-hook))
e39e74c0
RS
1574 (if mail-yank-hooks
1575 (run-hooks 'mail-yank-hooks)
374bda6b 1576 (mail-indent-citation))))))))
8ba7cd40
KS
1577
1578(defun mail-split-line ()
1579 "Split current line, moving portion beyond point vertically down.
1580If the current line has `mail-yank-prefix', insert it on the new line."
1581 (interactive "*")
1582 (split-line mail-yank-prefix))
1583
20a8832d 1584\f
f0aef6bf
RS
1585(defun mail-attach-file (&optional file)
1586 "Insert a file at the end of the buffer, with separator lines around it."
1587 (interactive "fAttach file: ")
1588 (save-excursion
1589 (goto-char (point-max))
1590 (or (bolp) (newline))
1591 (newline)
1592 (let ((start (point))
1593 middle)
1594 (insert (format "===File %s===" file))
1595 (insert-char ?= (max 0 (- 60 (current-column))))
1596 (newline)
1597 (setq middle (point))
15575807 1598 (insert "============================================================\n")
f0aef6bf
RS
1599 (push-mark)
1600 (goto-char middle)
1601 (insert-file-contents file)
1602 (or (bolp) (newline))
1603 (goto-char start))))
1604\f
699adcb2
RS
1605;; Put these commands last, to reduce chance of lossage from quitting
1606;; in middle of loading the file.
1607
1608;;;###autoload (add-hook 'same-window-buffer-names "*mail*")
20a8832d
RS
1609
1610;;;###autoload
1611(defun mail (&optional noerase to subject in-reply-to cc replybuffer actions)
e635fdf0
RS
1612 "Edit a message to be sent. Prefix arg means resume editing (don't erase).
1613When this function returns, the buffer `*mail*' is selected.
1614The value is t if the message was newly initialized; otherwise, nil.
20a8832d 1615
4ac2e032
RS
1616Optionally, the signature file `mail-signature-file' can be inserted at the
1617end; see the variable `mail-signature'.
20a8832d
RS
1618
1619\\<mail-mode-map>
1620While editing message, type \\[mail-send-and-exit] to send the message and exit.
1621
1622Various special commands starting with C-c are available in sendmail mode
1623to move to message header fields:
1624\\{mail-mode-map}
1625
1626If `mail-self-blind' is non-nil, a BCC to yourself is inserted
1627when the message is initialized.
1628
1629If `mail-default-reply-to' is non-nil, it should be an address (a string);
1630a Reply-to: field with that address is inserted.
1631
1632If `mail-archive-file-name' is non-nil, an FCC field with that file name
1633is inserted.
1634
8b262cbc
KH
1635The normal hook `mail-setup-hook' is run after the message is
1636initialized. It can add more default fields to the message.
20a8832d 1637
1db2d450
CY
1638The first argument, NOERASE, determines what to do when there is
1639an existing modified `*mail*' buffer. If NOERASE is nil, the
1640existing mail buffer is used, and the user is prompted whether to
1641keep the old contents or to erase them. If NOERASE has the value
1642`new', a new mail buffer will be created instead of using the old
1643one. Any other non-nil value means to always select the old
1644buffer without erasing the contents.
dfdac213
RS
1645
1646The second through fifth arguments,
1647 TO, SUBJECT, IN-REPLY-TO and CC, specify if non-nil
20a8832d
RS
1648 the initial contents of those header fields.
1649 These arguments should not have final newlines.
c8553837
RS
1650The sixth argument REPLYBUFFER is a buffer which contains an
1651 original message being replied to, or else an action
1652 of the form (FUNCTION . ARGS) which says how to insert the original.
1653 Or it can be nil, if not replying to anything.
20a8832d
RS
1654The seventh argument ACTIONS is a list of actions to take
1655 if/when the message is sent. Each action looks like (FUNCTION . ARGS);
1656 when the message is sent, we apply FUNCTION to ARGS.
1657 This is how Rmail arranges to mark messages `answered'."
1658 (interactive "P")
95fe848e
SM
1659;;; This is commented out because I found it was confusing in practice.
1660;;; It is easy enough to rename *mail* by hand with rename-buffer
1661;;; if you want to have multiple mail buffers.
1662;;; And then you can control which messages to save. --rms.
e635fdf0
RS
1663;;; (let ((index 1)
1664;;; buffer)
1665;;; ;; If requested, look for a mail buffer that is modified and go to it.
1666;;; (if noerase
1667;;; (progn
1668;;; (while (and (setq buffer
1669;;; (get-buffer (if (= 1 index) "*mail*"
1670;;; (format "*mail*<%d>" index))))
1671;;; (not (buffer-modified-p buffer)))
1672;;; (setq index (1+ index)))
1673;;; (if buffer (switch-to-buffer buffer)
1674;;; ;; If none exists, start a new message.
1675;;; ;; This will never re-use an existing unmodified mail buffer
1676;;; ;; (since index is not 1 anymore). Perhaps it should.
1677;;; (setq noerase nil))))
1678;;; ;; Unless we found a modified message and are happy, start a new message.
1679;;; (if (not noerase)
1680;;; (progn
1681;;; ;; Look for existing unmodified mail buffer.
1682;;; (while (and (setq buffer
1683;;; (get-buffer (if (= 1 index) "*mail*"
1684;;; (format "*mail*<%d>" index))))
1685;;; (buffer-modified-p buffer))
1686;;; (setq index (1+ index)))
1687;;; ;; If none, make a new one.
1688;;; (or buffer
1689;;; (setq buffer (generate-new-buffer "*mail*")))
1690;;; ;; Go there and initialize it.
1691;;; (switch-to-buffer buffer)
1692;;; (erase-buffer)
1693;;; (setq default-directory (expand-file-name "~/"))
1694;;; (auto-save-mode auto-save-default)
1695;;; (mail-mode)
1696;;; (mail-setup to subject in-reply-to cc replybuffer actions)
1697;;; (if (and buffer-auto-save-file-name
1698;;; (file-exists-p buffer-auto-save-file-name))
1699;;; (message "Auto save file for draft message exists; consider M-x mail-recover"))
1700;;; t))
1db2d450
CY
1701
1702 (if (eq noerase 'new)
1703 (pop-to-buffer (generate-new-buffer "*mail*"))
09c9e6bb
CY
1704 (and noerase
1705 (not (get-buffer "*mail*"))
1706 (setq noerase nil))
1db2d450
CY
1707 (pop-to-buffer "*mail*"))
1708
eb1213c1
MR
1709 ;; Avoid danger that the auto-save file can't be written.
1710 (let ((dir (expand-file-name
1711 (file-name-as-directory mail-default-directory))))
1712 (if (file-exists-p dir)
1713 (setq default-directory dir)))
2e78575e
RS
1714 ;; Only call auto-save-mode if necessary, to avoid changing auto-save file.
1715 (if (or (and auto-save-default (not buffer-auto-save-file-name))
1716 (and (not auto-save-default) buffer-auto-save-file-name))
1717 (auto-save-mode auto-save-default))
e635fdf0 1718 (mail-mode)
3b112b5e
MB
1719 ;; Disconnect the buffer from its visited file
1720 ;; (in case the user has actually visited a file *mail*).
95fe848e 1721;;; (set-visited-file-name nil)
e635fdf0 1722 (let (initialized)
09c9e6bb
CY
1723 (and (not (and noerase
1724 (not (eq noerase 'new))))
5e32e119
RS
1725 (if buffer-file-name
1726 (if (buffer-modified-p)
1727 (when (y-or-n-p "Buffer has unsaved changes; reinitialize it and discard them? ")
1728 (if (y-or-n-p "Disconnect buffer from visited file? ")
1729 (set-visited-file-name nil))
1730 t)
1731 (when (y-or-n-p "Reinitialize buffer, and disconnect it from the visited file? ")
1732 (set-visited-file-name nil)
1733 t))
1734 ;; A non-file-visiting buffer.
1735 (if (buffer-modified-p)
1736 (y-or-n-p "Unsent message being composed; erase it? ")
1737 t))
6737ae74
RS
1738 (let ((inhibit-read-only t))
1739 (erase-buffer)
1740 (mail-setup to subject in-reply-to cc replybuffer actions)
1741 (setq initialized t)))
e635fdf0
RS
1742 (if (and buffer-auto-save-file-name
1743 (file-exists-p buffer-auto-save-file-name))
1744 (message "Auto save file for draft message exists; consider M-x mail-recover"))
1745 initialized))
20a8832d 1746
73e72da4
DN
1747(declare-function dired-view-file "dired" ())
1748(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep))
1749
6cd4cfc5 1750(defun mail-recover-1 ()
918c7db7 1751 "Pop up a list of auto-saved draft messages so you can recover one of them."
6cd4cfc5
EZ
1752 (interactive)
1753 (let ((file-name (make-auto-save-file-name))
1754 (ls-lisp-support-shell-wildcards t)
1755 non-random-len wildcard)
1756 ;; Remove the random part from the auto-save-file-name, and
1757 ;; create a wildcard which matches possible candidates.
1758 ;; Note: this knows that make-auto-save-file-name appends
1759 ;; "#<RANDOM-STUFF>#" to the buffer name, where RANDOM-STUFF
1760 ;; is the result of (make-temp-name "").
1761 (setq non-random-len
d41eb0aa 1762 (- (length file-name) (length (make-temp-name "")) 1))
6cd4cfc5
EZ
1763 (setq wildcard (concat (substring file-name 0 non-random-len) "*"))
1764 (if (null (file-expand-wildcards wildcard))
1765 (message "There are no auto-saved drafts to recover")
1766 ;; Bind dired-trivial-filenames to t because all auto-save file
1767 ;; names are normally ``trivial'', so Dired will set point after
1768 ;; all the files, at buffer bottom. We want it on the first
1769 ;; file instead.
1770 (let ((dired-trivial-filenames t))
1771 (dired-other-window wildcard (concat dired-listing-switches "t")))
1772 (rename-buffer "*Auto-saved Drafts*" t)
1773 (save-excursion
1774 (goto-char (point-min))
1775 (or (looking-at " Move to the draft file you want to recover,")
1776 (let ((inhibit-read-only t))
1777 ;; Each line starts with a space so that Font Lock mode
1778 ;; won't highlight the first character.
1779 (insert "\
1780 Move to the draft file you want to recover, then type C-c C-c
1781 to recover text of message whose composition was interrupted.
1782 To browse text of a draft, type v on the draft file's line.
1783
1784 You can also delete some of these files;
1785 type d on a line to mark that file for deletion.
1786
1787 List of possible auto-save files for recovery:
1788
1789"))))
1790 (use-local-map
1791 (let ((map (make-sparse-keymap)))
1792 (set-keymap-parent map (current-local-map))
1793 map))
1794 (define-key (current-local-map) "v"
1795 (lambda ()
1796 (interactive)
1797 (let ((coding-system-for-read 'emacs-mule-unix))
1798 (dired-view-file))))
1799 (define-key (current-local-map) "\C-c\C-c"
1800 (lambda ()
1801 (interactive)
1802 (let ((fname (dired-get-filename))
1803 ;; Auto-saved files are written in the internal
1804 ;; representation, so they should be read accordingly.
1805 (coding-system-for-read 'emacs-mule-unix))
1806 (switch-to-buffer-other-window "*mail*")
1807 (let ((buffer-read-only nil))
1808 (erase-buffer)
1809 (insert-file-contents fname nil)
1810 ;; insert-file-contents will set buffer-file-coding-system
1811 ;; to emacs-mule, which is probably not what they want to
1812 ;; use for sending the message. But we don't know what
1813 ;; was its value before the buffer was killed or Emacs
1814 ;; crashed. We therefore reset buffer-file-coding-system
1815 ;; to the default value, so that either the default does
1816 ;; TRT, or the user will get prompted for the right
1817 ;; encoding when they send the message.
1818 (setq buffer-file-coding-system
1819 default-buffer-file-coding-system))))))))
1820
2b54af74
DN
1821(declare-function dired-move-to-filename "dired" (&optional raise-error eol))
1822(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep))
1823(declare-function dired-view-file "dired" ())
1824
20a8832d 1825(defun mail-recover ()
918c7db7
EZ
1826 "Recover interrupted mail composition from auto-save files.
1827
1828If the mail buffer has a current valid auto-save file,
1829the command recovers that file. Otherwise, it displays a
1830buffer showing the existing auto-saved draft messages;
1831you can move to one of them and type C-c C-c to recover that one."
20a8832d 1832 (interactive)
6cd4cfc5
EZ
1833 ;; In case they invoke us from some random buffer...
1834 (switch-to-buffer "*mail*")
1835 ;; If *mail* didn't exist, set its directory, so that auto-saved
1836 ;; drafts will be found.
eb1213c1
MR
1837 (let ((dir (expand-file-name
1838 (file-name-as-directory mail-default-directory))))
1839 (if (file-exists-p dir)
1840 (setq default-directory dir)))
6cd4cfc5
EZ
1841 (or (eq major-mode 'mail-mode)
1842 (mail-mode))
1843 (let ((file-name buffer-auto-save-file-name))
1844 (cond ((and file-name (file-exists-p file-name))
1845 (let ((dispbuf
1846 ;; This used to invoke `ls' via call-process, but
1847 ;; dired-noselect is more portable to systems where
1848 ;; `ls' is not a standard program (it will use
1849 ;; ls-lisp instead).
1850 (dired-noselect file-name
1851 (concat dired-listing-switches "t"))))
8366cfb5
RS
1852 (save-selected-window
1853 (select-window (display-buffer dispbuf t))
1854 (goto-char (point-min))
1855 (forward-line 2)
1856 (dired-move-to-filename)
1857 (setq dispbuf (rename-buffer "*Directory*" t)))
6cd4cfc5
EZ
1858 (if (not (yes-or-no-p
1859 (format "Recover mail draft from auto save file %s? "
1860 file-name)))
1861 (error "mail-recover cancelled")
1862 (let ((buffer-read-only nil)
1863 (buffer-coding buffer-file-coding-system)
1864 ;; Auto-save files are written in internal
1865 ;; representation of non-ASCII characters.
1866 (coding-system-for-read 'emacs-mule-unix))
1867 (erase-buffer)
1868 (insert-file-contents file-name nil)
1869 (setq buffer-file-coding-system buffer-coding)))))
1870 (t (mail-recover-1)))))
20a8832d
RS
1871
1872;;;###autoload
1873(defun mail-other-window (&optional noerase to subject in-reply-to cc replybuffer sendactions)
1874 "Like `mail' command, but display mail buffer in another window."
1875 (interactive "P")
67a6988b
RS
1876 (let ((pop-up-windows t)
1877 (special-display-buffer-names nil)
1878 (special-display-regexps nil)
1879 (same-window-buffer-names nil)
1880 (same-window-regexps nil))
20a8832d
RS
1881 (pop-to-buffer "*mail*"))
1882 (mail noerase to subject in-reply-to cc replybuffer sendactions))
1883
1884;;;###autoload
0cc89026
JB
1885(defun mail-other-frame (&optional noerase to subject in-reply-to cc replybuffer sendactions)
1886 "Like `mail' command, but display mail buffer in another frame."
20a8832d 1887 (interactive "P")
67a6988b
RS
1888 (let ((pop-up-frames t)
1889 (special-display-buffer-names nil)
1890 (special-display-regexps nil)
1891 (same-window-buffer-names nil)
1892 (same-window-regexps nil))
20a8832d
RS
1893 (pop-to-buffer "*mail*"))
1894 (mail noerase to subject in-reply-to cc replybuffer sendactions))
1895
95fe848e 1896;; Do not add anything but external entries on this page.
49116ac0
JB
1897
1898(provide 'sendmail)
1899
95fe848e 1900;; arch-tag: 48bc1025-d993-4d31-8d81-2a29491f0626
c88ab9ce 1901;;; sendmail.el ends here