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