sendmail.el 68.8 KB
Newer Older
1
;;; sendmail.el --- mail sending commands for Emacs.  -*- byte-compile-dynamic: t -*-
Eric S. Raymond's avatar
Eric S. Raymond committed
2

3
;; Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995, 1996, 1998, 2000,
Glenn Morris's avatar
Glenn Morris committed
4
;;   2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
5
;;   Free Software Foundation, Inc.
Eric S. Raymond's avatar
Eric S. Raymond committed
6

Eric S. Raymond's avatar
Eric S. Raymond committed
7
;; Maintainer: FSF
Eric S. Raymond's avatar
Eric S. Raymond committed
8
;; Keywords: mail
Eric S. Raymond's avatar
Eric S. Raymond committed
9

Richard M. Stallman's avatar
Richard M. Stallman committed
10 11
;; This file is part of GNU Emacs.

12
;; GNU Emacs is free software: you can redistribute it and/or modify
Richard M. Stallman's avatar
Richard M. Stallman committed
13
;; it under the terms of the GNU General Public License as published by
14 15
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Richard M. Stallman's avatar
Richard M. Stallman committed
16 17 18 19 20 21 22

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
23
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
Richard M. Stallman's avatar
Richard M. Stallman committed
24

25 26 27 28 29
;;; Commentary:

;; This mode provides mail-sending facilities from within Emacs.  It is
;; documented in the Emacs user's manual.

Eric S. Raymond's avatar
Eric S. Raymond committed
30
;;; Code:
Glenn Morris's avatar
Glenn Morris committed
31
(require 'mail-utils)
32

Dave Love's avatar
Dave Love committed
33 34
(autoload 'rfc2047-encode-string "rfc2047")

Stephen Eglen's avatar
Stephen Eglen committed
35 36 37 38
(defgroup sendmail nil
  "Mail sending commands for Emacs."
  :prefix "mail-"
  :group 'mail)
Richard M. Stallman's avatar
Richard M. Stallman committed
39

40 41
(defcustom mail-setup-with-from t
  "Non-nil means insert `From:' field when setting up the message."
42
  :type 'boolean
43 44 45
  :group 'sendmail
  :version "22.1")

46 47 48 49 50 51 52 53 54 55
(defcustom sendmail-program
  (cond
    ((file-exists-p "/usr/sbin/sendmail") "/usr/sbin/sendmail")
    ((file-exists-p "/usr/lib/sendmail") "/usr/lib/sendmail")
    ((file-exists-p "/usr/ucblib/sendmail") "/usr/ucblib/sendmail")
    (t "fakemail"))			;In ../etc, to interface to /bin/mail.
  "Program used to send messages."
  :group 'mail
  :type 'file)

56
;;;###autoload
57
(defcustom mail-from-style 'default
58
  "Specifies how \"From:\" fields look.
59 60 61 62 63 64

If `nil', they contain just the return address like:
	king@grassland.com
If `parens', they look like:
	king@grassland.com (Elvis Parsley)
If `angles', they look like:
65
	Elvis Parsley <king@grassland.com>
66 67 68 69 70 71 72 73

Otherwise, most addresses look like `angles', but they look like
`parens' if `angles' would need quoting and `parens' would not."
  ;; The value `system-default' is now deprecated.
  :type '(choice (const :tag "simple" nil)
		 (const parens)
		 (const angles)
		 (const default))
74
  :version "20.3"
Stephen Eglen's avatar
Stephen Eglen committed
75
  :group 'sendmail)
76

77
;;;###autoload
78
(defcustom mail-specify-envelope-from nil
79
  "If non-nil, specify the envelope-from address when sending mail.
80
The value used to specify it is whatever is found in
Kenichi Handa's avatar
Kenichi Handa committed
81
the variable `mail-envelope-from', with `user-mail-address' as fallback.
82

83
On most systems, specifying the envelope-from address is a
Kenichi Handa's avatar
Kenichi Handa committed
84 85 86
privileged operation.  This variable affects sendmail and
smtpmail -- if you use feedmail to send mail, see instead the
variable `feedmail-deduce-envelope-from'."
87 88 89 90
  :version "21.1"
  :type 'boolean
  :group 'sendmail)

91
(defcustom mail-envelope-from nil
92
  "If non-nil, designate the envelope-from address when sending mail.
93 94 95 96 97
This only has an effect if `mail-specify-envelope-from' is non-nil.
The value should be either a string, or the symbol `header' (in
which case the contents of the \"From\" header of the message
being sent is used), or nil (in which case the value of
`user-mail-address' is used)."
98
  :version "21.1"
99
  :type '(choice (string :tag "From-name")
100
		 (const :tag "Use From: header from message" header)
101
		 (const :tag "Use `user-mail-address'" nil))
102 103
  :group 'sendmail)

Richard M. Stallman's avatar
Richard M. Stallman committed
104
;;;###autoload
105 106
(defcustom mail-self-blind nil
  "Non-nil means insert BCC to self in messages to be sent.
Richard M. Stallman's avatar
Richard M. Stallman committed
107
This is done when the message is initialized,
Stephen Eglen's avatar
Stephen Eglen committed
108 109 110
so you can remove or alter the BCC field to override the default."
  :type 'boolean
  :group 'sendmail)
Richard M. Stallman's avatar
Richard M. Stallman committed
111 112

;;;###autoload
113 114 115 116 117
(defcustom mail-interactive t
  ;; We used to use a default of nil rather than t, but nowadays it is very
  ;; common for sendmail to be misconfigured, so one cannot rely on the
  ;; bounce message to be delivered anywhere, least of all to the
  ;; user's mailbox.
118
  "Non-nil means when sending a message wait for and display errors.
Glenn Morris's avatar
Glenn Morris committed
119
Otherwise, let mailer send back a message to report errors."
Stephen Eglen's avatar
Stephen Eglen committed
120
  :type 'boolean
121
  :version "23.1"			; changed from nil to t
Stephen Eglen's avatar
Stephen Eglen committed
122
  :group 'sendmail)
Richard M. Stallman's avatar
Richard M. Stallman committed
123

124 125 126 127 128
(defcustom mail-yank-ignored-headers
  (concat "^"
          (regexp-opt '("via" "mail-from" "origin" "status" "remailed"
                        "received" "message-id" "summary-line" "to" "subject"
                        "in-reply-to" "return-path" "mail-reply-to"
Glenn Morris's avatar
Glenn Morris committed
129 130 131 132
                        ;; Should really be rmail-attribute-header and
                        ;; rmail-keyword-header, but this file does not
                        ;; require rmail (at run time).
                        "x-rmail-attributes" "x-rmail-keywords"
133 134 135
                        "mail-followup-to") "\\(?:")
          ":")
  "Delete these headers from old message when it's inserted in a reply."
Stephen Eglen's avatar
Stephen Eglen committed
136
  :type 'regexp
Glenn Morris's avatar
Glenn Morris committed
137 138
  :group 'sendmail
  :version "23.1")
Richard M. Stallman's avatar
Richard M. Stallman committed
139

140
;; Prevent problems with `window-system' not having the correct value
141 142 143 144 145 146 147 148
;; when loaddefs.el is loaded. `custom-reevaluate-setting' needs the
;; standard value.
;;;###autoload
(put 'send-mail-function 'standard-value
     '((if (and window-system (memq system-type '(darwin windows-nt)))
	   'mailclient-send-it
	 'sendmail-send-it)))

Richard M. Stallman's avatar
Richard M. Stallman committed
149 150
;; Useful to set in site-init.el
;;;###autoload
151
(defcustom send-mail-function
152 153 154
  (if (and window-system (memq system-type '(darwin windows-nt)))
      'mailclient-send-it
    'sendmail-send-it)
Dave Love's avatar
Dave Love committed
155
  "Function to call to send the current buffer as mail.
156
The headers should be delimited by a line which is
157 158
not a valid RFC822 header or continuation line,
that matches the variable `mail-header-separator'.
Dave Love's avatar
Dave Love committed
159 160
This is used by the default mail-sending commands.  See also
`message-send-mail-function' for use with the Message package."
Dave Love's avatar
Dave Love committed
161 162 163
  :type '(radio (function-item sendmail-send-it :tag "Use Sendmail package")
		(function-item smtpmail-send-it :tag "Use SMTPmail package")
		(function-item feedmail-send-it :tag "Use Feedmail package")
164
		(function-item mailclient-send-it :tag "Use Mailclient package")
Dave Love's avatar
Dave Love committed
165
		function)
166
  :initialize 'custom-initialize-delay
Dave Love's avatar
Dave Love committed
167
  :group 'sendmail)
Richard M. Stallman's avatar
Richard M. Stallman committed
168

169 170
;;;###autoload(custom-initialize-delay 'send-mail-function nil)

Richard M. Stallman's avatar
Richard M. Stallman committed
171
;;;###autoload
172
(defcustom mail-header-separator (purecopy "--text follows this line--")
173
  "Line used to separate headers from text in messages being composed."
Stephen Eglen's avatar
Stephen Eglen committed
174 175
  :type 'string
  :group 'sendmail)
Richard M. Stallman's avatar
Richard M. Stallman committed
176

177 178
;; Set up mail-header-separator for use as a category text property.
(put 'mail-header-separator 'rear-nonsticky '(category))
179 180 181 182 183 184
;; This was a nice idea, for preventing accidental modification of
;; the separator.   But I found it also prevented or obstructed
;; certain deliberate operations, such as copying the separator line
;; up to the top to send myself a copy of an already sent outgoing message
;; and other things.  So I turned it off.  --rms.
;;(put 'mail-header-separator 'read-only t)
185

Richard M. Stallman's avatar
Richard M. Stallman committed
186
;;;###autoload
187 188
(defcustom mail-archive-file-name nil
  "Name of file to write all outgoing messages in, or nil for none.
189 190
This is normally an mbox file, but for backwards compatibility may also
be a Babyl file."
Stephen Eglen's avatar
Stephen Eglen committed
191 192
  :type '(choice file (const nil))
  :group 'sendmail)
Richard M. Stallman's avatar
Richard M. Stallman committed
193

194
;;;###autoload
Stephen Eglen's avatar
Stephen Eglen committed
195
(defcustom mail-default-reply-to nil
196
  "Address to insert as default Reply-to field of outgoing messages.
197
If nil, it will be initialized from the REPLYTO environment variable
Stephen Eglen's avatar
Stephen Eglen committed
198 199 200
when you first send mail."
  :type '(choice (const nil) string)
  :group 'sendmail)
Richard M. Stallman's avatar
Richard M. Stallman committed
201

Stephen Eglen's avatar
Stephen Eglen committed
202
(defcustom mail-alias-file nil
Glenn Morris's avatar
Glenn Morris committed
203
  "If non-nil, the name of a file to use instead of the sendmail default.
Richard M. Stallman's avatar
Richard M. Stallman committed
204 205
This file defines aliases to be expanded by the mailer; this is a different
feature from that of defining aliases in `.mailrc' to be expanded in Emacs.
Glenn Morris's avatar
Glenn Morris committed
206 207 208 209
This variable has no effect unless your system uses sendmail as its mailer.
The default file is defined in sendmail's configuration file, e.g.
`/etc/aliases'."
  :type '(choice (const :tag "Sendmail default" nil) file)
Stephen Eglen's avatar
Stephen Eglen committed
210
  :group 'sendmail)
Richard M. Stallman's avatar
Richard M. Stallman committed
211

212
;;;###autoload
213
(defcustom mail-personal-alias-file (purecopy "~/.mailrc")
214
  "If non-nil, the name of the user's personal mail alias file.
215 216
This file typically should be in same format as the `.mailrc' file used by
the `Mail' or `mailx' program.
Stephen Eglen's avatar
Stephen Eglen committed
217 218 219
This file need not actually exist."
  :type '(choice (const nil) file)
  :group 'sendmail)
220

221
;;;###autoload
Stephen Eglen's avatar
Stephen Eglen committed
222
(defcustom mail-setup-hook nil
223
  "Normal hook, run each time a new outgoing message is initialized."
Stephen Eglen's avatar
Stephen Eglen committed
224
  :type 'hook
225
  :options '(fortune-to-signature spook mail-abbrevs-setup)
Stephen Eglen's avatar
Stephen Eglen committed
226
  :group 'sendmail)
Karl Heuer's avatar
Karl Heuer committed
227

228
;;;###autoload
229
(defvar mail-aliases t
Richard M. Stallman's avatar
Richard M. Stallman committed
230
  "Alist of mail address aliases,
231
or t meaning should be initialized from your mail aliases file.
Kenichi Handa's avatar
Kenichi Handa committed
232 233
\(The file's name is normally `~/.mailrc', but `mail-personal-alias-file'
can specify a different file name.)
234
The alias definitions in the file have this form:
Richard M. Stallman's avatar
Richard M. Stallman committed
235
    alias ALIAS MEANING")
236

237
(defvar mail-alias-modtime nil
238
  "The modification time of your mail alias file when it was last examined.")
239

240
;;;###autoload
241
(defcustom mail-yank-prefix "> "
242
  "Prefix insert on lines of yanked message being replied to.
Glenn Morris's avatar
Glenn Morris committed
243
If this is nil, use indentation, as specified by `mail-indentation-spaces'."
Stephen Eglen's avatar
Stephen Eglen committed
244 245 246
  :type '(choice (const nil) string)
  :group 'sendmail)

247
;;;###autoload
Stephen Eglen's avatar
Stephen Eglen committed
248
(defcustom mail-indentation-spaces 3
249
  "Number of spaces to insert at the beginning of each cited line.
Stephen Eglen's avatar
Stephen Eglen committed
250 251 252
Used by `mail-yank-original' via `mail-indent-citation'."
  :type 'integer
  :group 'sendmail)
253

Glenn Morris's avatar
Glenn Morris committed
254
;; FIXME make it really obsolete.
255
(defvar mail-yank-hooks nil
256 257 258 259 260 261 262 263
  "Obsolete hook for modifying a citation just inserted in the mail buffer.
Each hook function can find the citation between (point) and (mark t).
And each hook function should leave point and mark around the citation
text as modified.

This is a normal hook, misnamed for historical reasons.
It is semi-obsolete and mail agents should no longer use it.")

264
;;;###autoload
Stephen Eglen's avatar
Stephen Eglen committed
265
(defcustom mail-citation-hook nil
266
  "Hook for modifying a citation just inserted in the mail buffer.
267 268 269 270 271
Each hook function can find the citation between (point) and (mark t),
and should leave point and mark around the citation text as modified.
The hook functions can find the header of the cited message
in the variable `mail-citation-header', whether or not this is included
in the cited portion of the message.
272

273
If this hook is entirely empty (nil), a default action is taken
Stephen Eglen's avatar
Stephen Eglen committed
274 275 276
instead of no action."
  :type 'hook
  :group 'sendmail)
Richard M. Stallman's avatar
Richard M. Stallman committed
277

278 279 280 281 282
(defvar mail-citation-header nil
  "While running `mail-citation-hook', this variable holds the message header.
This enables the hook functions to see the whole message header
regardless of what part of it (if any) is included in the cited text.")

283
;;;###autoload
284
(defcustom mail-citation-prefix-regexp
285
  (purecopy "\\([ \t]*\\(\\w\\|[_.]\\)+>+\\|[ \t]*[]>|]\\)+")
286
  "Regular expression to match a citation prefix plus whitespace.
287 288 289 290 291
It should match whatever sort of citation prefixes you want to handle,
with whitespace before and after; it should also match just whitespace.
The default value matches citations like `foo-bar>' plus whitespace."
  :type 'regexp
  :group 'sendmail
292
  :version "24.1")
293

Richard M. Stallman's avatar
Richard M. Stallman committed
294
(defvar mail-abbrevs-loaded nil)
295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316
(defvar mail-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map "\M-\t" 'mail-complete)
    (define-key map "\C-c?" 'describe-mode)
    (define-key map "\C-c\C-f\C-t" 'mail-to)
    (define-key map "\C-c\C-f\C-b" 'mail-bcc)
    (define-key map "\C-c\C-f\C-f" 'mail-fcc)
    (define-key map "\C-c\C-f\C-c" 'mail-cc)
    (define-key map "\C-c\C-f\C-s" 'mail-subject)
    (define-key map "\C-c\C-f\C-r" 'mail-reply-to)
    (define-key map "\C-c\C-f\C-a" 'mail-mail-reply-to)    ; author
    (define-key map "\C-c\C-f\C-l" 'mail-mail-followup-to) ; list
    (define-key map "\C-c\C-t" 'mail-text)
    (define-key map "\C-c\C-y" 'mail-yank-original)
    (define-key map "\C-c\C-r" 'mail-yank-region)
    (define-key map [remap split-line] 'mail-split-line)
    (define-key map "\C-c\C-q" 'mail-fill-yanked-message)
    (define-key map "\C-c\C-w" 'mail-signature)
    (define-key map "\C-c\C-v" 'mail-sent-via)
    (define-key map "\C-c\C-c" 'mail-send-and-exit)
    (define-key map "\C-c\C-s" 'mail-send)
    (define-key map "\C-c\C-i" 'mail-attach-file)
Glenn Morris's avatar
Glenn Morris committed
317 318
    ;; FIXME add this? "b" = bury buffer.  It's in the menu-bar.
;;;    (define-key map "\C-c\C-b" 'mail-dont-send)
319 320 321 322 323 324 325 326

    (define-key map [menu-bar mail]
      (cons "Mail" (make-sparse-keymap "Mail")))

    (define-key map [menu-bar mail fill]
      '("Fill Citation" . mail-fill-yanked-message))

    (define-key map [menu-bar mail yank]
Glenn Morris's avatar
Glenn Morris committed
327
      '(menu-item "Cite Original" mail-yank-original :enable mail-reply-action))
328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353

    (define-key map [menu-bar mail signature]
      '("Insert Signature" . mail-signature))

    (define-key map [menu-bar mail mail-sep]
      '("--"))

    (define-key map [menu-bar mail cancel]
      '("Cancel" . mail-dont-send))

    (define-key map [menu-bar mail send-stay]
      '("Send, Keep Editing" . mail-send))

    (define-key map [menu-bar mail send]
      '("Send Message" . mail-send-and-exit))

    (define-key map [menu-bar headers]
      (cons "Headers" (make-sparse-keymap "Move to Header")))

    (define-key map [menu-bar headers text]
      '("Text" . mail-text))

    (define-key map [menu-bar headers expand-aliases]
      '("Expand Aliases" . expand-mail-aliases))

    (define-key map [menu-bar headers sent-via]
Glenn Morris's avatar
Glenn Morris committed
354
      '("Sent-Via" . mail-sent-via))
355 356

    (define-key map [menu-bar headers mail-reply-to]
Glenn Morris's avatar
Glenn Morris committed
357
      '("Mail-Reply-To" . mail-mail-reply-to))
358 359

    (define-key map [menu-bar headers mail-followup-to]
Glenn Morris's avatar
Glenn Morris committed
360
      '("Mail-Followup-To" . mail-mail-followup-to))
361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380

    (define-key map [menu-bar headers reply-to]
      '("Reply-To" . mail-reply-to))

    (define-key map [menu-bar headers bcc]
      '("Bcc" . mail-bcc))

    (define-key map [menu-bar headers fcc]
      '("Fcc" . mail-fcc))

    (define-key map [menu-bar headers cc]
      '("Cc" . mail-cc))

    (define-key map [menu-bar headers subject]
      '("Subject" . mail-subject))

    (define-key map [menu-bar headers to]
      '("To" . mail-to))

    map))
Richard M. Stallman's avatar
Richard M. Stallman committed
381

382
(autoload 'build-mail-aliases "mailalias"
Glenn Morris's avatar
Glenn Morris committed
383
  "Read mail aliases from personal aliases file and set `mail-aliases'.
384
By default, this is the file specified by `mail-personal-alias-file'." t)
385

Jim Blandy's avatar
Jim Blandy committed
386
;;;###autoload
387
(defcustom mail-signature t
388
  "Text inserted at end of mail buffer when a message is initialized.
389 390 391 392 393 394
If t, it means to insert the contents of the file `mail-signature-file'.
If a string, that string is inserted.
 (To make a proper signature, the string should begin with \\n\\n-- \\n,
  which is the standard way to delimit a signature in a message.)
Otherwise, it should be an expression; it is evaluated
and should insert whatever you want to insert."
395
  :type '(choice (const :tag "None" nil)
396 397 398
		 (const :tag "Use `.signature' file" t)
		 (string :tag "String to insert")
		 (sexp :tag "Expression to evaluate"))
Stephen Eglen's avatar
Stephen Eglen committed
399
  :group 'sendmail)
400
(put 'mail-signature 'risky-local-variable t)
401

402
;;;###autoload
403
(defcustom mail-signature-file (purecopy "~/.signature")
404
  "File containing the text inserted at end of mail buffer."
Stephen Eglen's avatar
Stephen Eglen committed
405 406
  :type 'file
  :group 'sendmail)
Richard M. Stallman's avatar
Richard M. Stallman committed
407

408
;;;###autoload
409
(defcustom mail-default-directory (purecopy "~/")
410 411 412 413 414
  "Value of `default-directory' for Mail mode buffers.
This directory is used for auto-save files of Mail mode buffers.

Note that Message mode does not use this variable; it auto-saves
in `message-auto-save-directory'."
415
  :type '(directory :tag "Directory")
416
  :group 'sendmail
417
  :version "22.1")
418

419
(defvar mail-reply-action nil)
Richard M. Stallman's avatar
Richard M. Stallman committed
420 421
(defvar mail-send-actions nil
  "A list of actions to be performed upon successful sending of a message.")
422
(defvar mail-return-action nil)
Richard M. Stallman's avatar
Richard M. Stallman committed
423

424
;;;###autoload
Stephen Eglen's avatar
Stephen Eglen committed
425
(defcustom mail-default-headers nil
426
  "A string containing header lines, to be inserted in outgoing messages.
427 428
It can contain newlines, and should end in one.  It is inserted
before you edit the message, so you can edit or delete the lines."
Stephen Eglen's avatar
Stephen Eglen committed
429 430
  :type '(choice (const nil) string)
  :group 'sendmail)
Richard M. Stallman's avatar
Richard M. Stallman committed
431

Stephen Eglen's avatar
Stephen Eglen committed
432
(defcustom mail-bury-selects-summary t
433
  "If non-nil, try to show Rmail summary buffer after returning from mail.
434
The functions \\[mail-send-on-exit] or \\[mail-dont-send] select
435
the Rmail summary buffer before returning, if it exists and this variable
Stephen Eglen's avatar
Stephen Eglen committed
436 437 438
is non-nil."
  :type 'boolean
  :group 'sendmail)
439

440
(defcustom mail-send-nonascii 'mime
441
  "Specify whether to allow sending non-ASCII characters in mail.
442 443
If t, that means do allow it.  nil means don't allow it.
`query' means ask the user each time.
444 445
`mime' means add an appropriate MIME header if none already present.
The default is `mime'.
446
Including non-ASCII characters in a mail message can be problematical
Stephen Eglen's avatar
Stephen Eglen committed
447
for the recipient, who may not know how to decode them properly."
448
  :type '(choice (const t) (const nil) (const query) (const mime))
Stephen Eglen's avatar
Stephen Eglen committed
449
  :group 'sendmail)
450

451
(defcustom mail-use-dsn nil
452
  "Ask MTA for notification of failed, delayed or successful delivery.
453 454 455 456 457 458
Note that only some MTAs (currently only recent versions of Sendmail)
support Delivery Status Notification."
  :group 'sendmail
  :type '(repeat (radio (const :tag "Failure" failure)
			(const :tag "Delay" delay)
			(const :tag "Success" success)))
459
  :version "22.1")
460

461 462
;; Note: could use /usr/ucb/mail instead of sendmail;
;; options -t, and -v if not interactive.
Glenn Morris's avatar
Glenn Morris committed
463
(defvar mail-mailer-swallows-blank-line nil
464
  "Set this non-nil if the system's mailer runs the header and body together.
Glenn Morris's avatar
Glenn Morris committed
465 466 467 468 469 470 471 472
The actual value should be an expression to evaluate that returns
non-nil if the problem will actually occur.
\(As far as we know, this is not an issue on any system still supported
by Emacs.)")

(put 'mail-mailer-swallows-blank-line 'risky-local-variable t) ; gets evalled
(make-obsolete-variable 'mail-mailer-swallows-blank-line
			"no need to set this on any modern system." "24.1")
473

474
(defvar mail-mode-syntax-table
Glenn Morris's avatar
Glenn Morris committed
475
  ;; define-derived-mode will make it inherit from text-mode-syntax-table.
476
  (let ((st (make-syntax-table)))
Glenn Morris's avatar
Glenn Morris committed
477 478 479 480
    ;; FIXME this is probably very obsolete now ("percent hack").
    ;; sending.texi used to say:
    ;;   Mail mode defines the character `%' as a word separator; this
    ;;   is helpful for using the word commands to edit mail addresses.
481 482 483
    (modify-syntax-entry ?% ". " st)
    st)
  "Syntax table used while in `mail-mode'.")
Richard M. Stallman's avatar
Richard M. Stallman committed
484

485
(defvar mail-font-lock-keywords
486
  (eval-when-compile
487
    (let* ((cite-chars "[>|}]")
488
	   (cite-prefix "[:alpha:]")
489
	   (cite-suffix (concat cite-prefix "0-9_.@-`'\"")))
Simon Marshall's avatar
Simon Marshall committed
490
      (list '("^\\(To\\|Newsgroups\\):" . font-lock-function-name-face)
491
	    '("^\\(B?CC\\|Reply-to\\|Mail-\\(reply\\|followup\\)-to\\):" . font-lock-keyword-face)
492
	    '("^\\(Subject:\\)[ \t]*\\(.+\\)?"
493 494 495
	      (1 font-lock-comment-face)
;;	      (2 font-lock-type-face nil t)
	      )
496
	    ;; Use EVAL to delay in case `mail-header-separator' gets changed.
Simon Marshall's avatar
Simon Marshall committed
497
	    '(eval .
498
	      (let ((separator (if (zerop (length mail-header-separator))
499
				   " \\`\\' "
500 501
				 (regexp-quote mail-header-separator))))
		(cons (concat "^" separator "$") 'font-lock-warning-face)))
502 503 504
	    ;; Use MATCH-ANCHORED to effectively anchor the regexp left side.
	    `(,cite-chars
	      (,(concat "\\=[ \t]*"
505 506
			"\\(\\(\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
			"\\(" cite-chars "[ \t]*\\)\\)+\\)"
Simon Marshall's avatar
Simon Marshall committed
507
			"\\(.*\\)")
508
	       (beginning-of-line) (end-of-line)
509 510
	       (1 font-lock-comment-delimiter-face nil t)
	       (5 font-lock-comment-face nil t)))
511
	    '("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\):.*\\(\n[ \t]+.*\\)*$"
512
	      . font-lock-string-face))))
513 514
  "Additional expressions to highlight in Mail mode.")

515

516
(defun sendmail-sync-aliases ()
Kenichi Handa's avatar
Kenichi Handa committed
517 518 519 520 521
  (when mail-personal-alias-file
    (let ((modtime (nth 5 (file-attributes mail-personal-alias-file))))
      (or (equal mail-alias-modtime modtime)
	  (setq mail-alias-modtime modtime
		mail-aliases t)))))
522

523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562

;;;###autoload
(define-mail-user-agent 'sendmail-user-agent
  'sendmail-user-agent-compose
  'mail-send-and-exit)

;;;###autoload
(defun sendmail-user-agent-compose (&optional to subject other-headers
				    continue switch-function yank-action
				    send-actions return-action
				    &rest ignored)
  (if switch-function
      (let ((special-display-buffer-names nil)
	    (special-display-regexps nil)
	    (same-window-buffer-names nil)
	    (same-window-regexps nil))
	(funcall switch-function "*mail*")))
  (let ((cc (cdr (assoc-string "cc" other-headers t)))
	(in-reply-to (cdr (assoc-string "in-reply-to" other-headers t)))
	(body (cdr (assoc-string "body" other-headers t))))
    (or (mail continue to subject in-reply-to cc yank-action
	      send-actions return-action)
	continue
	(error "Message aborted"))
    (save-excursion
      (rfc822-goto-eoh)
      (while other-headers
	(unless (member-ignore-case (car (car other-headers))
				    '("in-reply-to" "cc" "body"))
	  (insert (car (car other-headers)) ": "
		  (cdr (car other-headers))
		  (if use-hard-newlines hard-newline "\n")))
	(setq other-headers (cdr other-headers)))
      (when body
	(forward-line 1)
	(insert body))
      t)))

(defun mail-setup (to subject in-reply-to cc replybuffer
		   actions return-action)
563
  (or mail-default-reply-to
564
      (setq mail-default-reply-to (getenv "REPLYTO")))
565
  (sendmail-sync-aliases)
Glenn Morris's avatar
Glenn Morris committed
566 567 568 569 570
  (when (eq mail-aliases t)
    (setq mail-aliases nil)
    (and mail-personal-alias-file
	 (file-exists-p mail-personal-alias-file)
	 (build-mail-aliases)))
571
  ;; Don't leave this around from a previous message.
572
  (kill-local-variable 'buffer-file-coding-system)
573 574
  ;; This doesn't work for enable-multibyte-characters.
  ;; (kill-local-variable 'enable-multibyte-characters)
575
  (set-buffer-multibyte (default-value 'enable-multibyte-characters))
576 577
  (if current-input-method
      (inactivate-input-method))
578 579

  ;; Local variables for Mail mode.
Richard M. Stallman's avatar
Richard M. Stallman committed
580
  (setq mail-send-actions actions)
581
  (setq mail-reply-action replybuffer)
582 583
  (setq mail-return-action return-action)

Richard M. Stallman's avatar
Richard M. Stallman committed
584
  (goto-char (point-min))
585 586
  (if mail-setup-with-from
      (mail-insert-from-field))
Richard M. Stallman's avatar
Richard M. Stallman committed
587 588 589
  (insert "To: ")
  (save-excursion
    (if to
590 591 592 593 594
	;; Here removed code to extract names from within <...>
	;; on the assumption that mail-strip-quoted-names
	;; has been called and has done so.
	(let ((fill-prefix "\t")
	      (address-start (point)))
Richard M. Stallman's avatar
Richard M. Stallman committed
595
	  (insert to "\n")
596 597 598 599
	  (fill-region-as-paragraph address-start (point-max))
	  (goto-char (point-max))
	  (unless (bolp)
	    (newline)))
Richard M. Stallman's avatar
Richard M. Stallman committed
600 601
      (newline))
    (if cc
602 603 604
	(let ((fill-prefix "\t")
	      (address-start (progn (insert "CC: ") (point))))
	  (insert cc "\n")
605 606 607 608
	  (fill-region-as-paragraph address-start (point-max))
	  (goto-char (point-max))
	  (unless (bolp)
	    (newline))))
Richard M. Stallman's avatar
Richard M. Stallman committed
609
    (if in-reply-to
610
	(let ((fill-prefix "\t")
611
	      (fill-column 78)
612 613
	      (address-start (point)))
	  (insert "In-reply-to: " in-reply-to "\n")
614 615 616 617
	  (fill-region-as-paragraph address-start (point-max))
	  (goto-char (point-max))
	  (unless (bolp)
	    (newline))))
Richard M. Stallman's avatar
Richard M. Stallman committed
618 619 620 621 622 623
    (insert "Subject: " (or subject "") "\n")
    (if mail-default-headers
	(insert mail-default-headers))
    (if mail-default-reply-to
	(insert "Reply-to: " mail-default-reply-to "\n"))
    (if mail-self-blind
624
	(insert "BCC: " user-mail-address "\n"))
Richard M. Stallman's avatar
Richard M. Stallman committed
625 626
    (if mail-archive-file-name
	(insert "FCC: " mail-archive-file-name "\n"))
627 628 629 630 631
    (put-text-property (point)
		       (progn
			 (insert mail-header-separator "\n")
			 (1- (point)))
		       'category 'mail-header-separator)
632 633
    ;; Insert the signature.  But remember the beginning of the message.
    (if to (setq to (point)))
Glenn Morris's avatar
Glenn Morris committed
634
    (if mail-signature (mail-signature t))
Richard M. Stallman's avatar
Richard M. Stallman committed
635 636
    (goto-char (point-max))
    (or (bolp) (newline)))
637
  (if to (goto-char to))
Richard M. Stallman's avatar
Richard M. Stallman committed
638 639 640
  (or to subject in-reply-to
      (set-buffer-modified-p nil))
  (run-hooks 'mail-setup-hook))
641

642
(defcustom mail-mode-hook nil
Glenn Morris's avatar
Glenn Morris committed
643 644 645
  "Hook run by Mail mode.
When composing a mail, this runs immediately after creating, or
switching to, the `*mail*' buffer.  See also `mail-setup-hook'."
646 647 648 649
  :group 'sendmail
  :type 'hook
  :options '(footnote-mode))

650
(defvar mail-mode-abbrev-table text-mode-abbrev-table)
Richard M. Stallman's avatar
Richard M. Stallman committed
651
;;;###autoload
652
(define-derived-mode mail-mode text-mode "Mail"
Richard M. Stallman's avatar
Richard M. Stallman committed
653 654
  "Major mode for editing mail to be sent.
Like Text Mode but with these additional commands:
Reiner Steib's avatar
Reiner Steib committed
655 656 657 658

\\[mail-send]  mail-send (send the message)
\\[mail-send-and-exit]  mail-send-and-exit (send the message and exit)

Karl Heuer's avatar
Karl Heuer committed
659
Here are commands that move to a header field (and create it if there isn't):
660 661
	 \\[mail-to]  move to To:	\\[mail-subject]  move to Subj:
	 \\[mail-bcc]  move to BCC:	\\[mail-cc]  move to CC:
662
	 \\[mail-fcc]  move to FCC:	\\[mail-reply-to] move to Reply-To:
663 664
         \\[mail-mail-reply-to]  move to Mail-Reply-To:
         \\[mail-mail-followup-to] move to Mail-Followup-To:
665
\\[mail-text]  move to message text.
Karl Heuer's avatar
Karl Heuer committed
666 667 668
\\[mail-signature]  mail-signature (insert `mail-signature-file' file).
\\[mail-yank-original]  mail-yank-original (insert current message, in Rmail).
\\[mail-fill-yanked-message]  mail-fill-yanked-message (fill what was yanked).
669
\\[mail-sent-via]  mail-sent-via (add a sent-via field for each To or CC).
Eli Zaretskii's avatar
Eli Zaretskii committed
670 671
Turning on Mail mode runs the normal hooks `text-mode-hook' and
`mail-mode-hook' (in that order)."
672
  (make-local-variable 'mail-reply-action)
Richard M. Stallman's avatar
Richard M. Stallman committed
673
  (make-local-variable 'mail-send-actions)
674
  (make-local-variable 'mail-return-action)
Richard M. Stallman's avatar
Richard M. Stallman committed
675
  (setq buffer-offer-save t)
676
  (make-local-variable 'font-lock-defaults)
677
  (setq font-lock-defaults '(mail-font-lock-keywords t t))
Richard M. Stallman's avatar
Richard M. Stallman committed
678
  (make-local-variable 'paragraph-separate)
679 680
  (make-local-variable 'normal-auto-fill-function)
  (setq normal-auto-fill-function 'mail-mode-auto-fill)
681
  (make-local-variable 'fill-paragraph-function)
682
  (setq fill-paragraph-function 'mail-mode-fill-paragraph)
683 684 685
  ;; Allow using comment commands to add/remove quoting (this only does
  ;; anything if mail-yank-prefix is set to a non-nil value).
  (set (make-local-variable 'comment-start) mail-yank-prefix)
Kenichi Handa's avatar
Kenichi Handa committed
686 687 688
  (if mail-yank-prefix
      (set (make-local-variable 'comment-start-skip)
	   (concat "^" (regexp-quote mail-yank-prefix) "[ \t]*")))
689 690
  (make-local-variable 'adaptive-fill-regexp)
  (setq adaptive-fill-regexp
691
	(concat "[ \t]*[-[:alnum:]]+>+[ \t]*\\|"
692
		adaptive-fill-regexp))
693
  (make-local-variable 'adaptive-fill-first-line-regexp)
694
  (setq adaptive-fill-first-line-regexp
695
	(concat "[ \t]*[-[:alnum:]]*>+[ \t]*\\|"
696
		adaptive-fill-first-line-regexp))
697 698 699 700
  ;; `-- ' precedes the signature.  `-----' appears at the start of the
  ;; lines that delimit forwarded messages.
  ;; Lines containing just >= 3 dashes, perhaps after whitespace,
  ;; are also sometimes used and should be separators.
701
  (setq paragraph-separate (concat (regexp-quote mail-header-separator)
702
				"$\\|\t*\\([-|#;>* ]\\|(?[0-9]+[.)]\\)+$"
703
				"\\|[ \t]*[[:alnum:]]*>+[ \t]*$\\|[ \t]*$\\|"
704 705
				"--\\( \\|-+\\)$\\|"
				page-delimiter)))
706

707 708 709

(defun mail-header-end ()
  "Return the buffer location of the end of headers, as a number."
710 711 712 713 714
  (save-restriction
    (widen)
    (save-excursion
      (rfc822-goto-eoh)
      (point))))
715 716 717

(defun mail-text-start ()
  "Return the buffer location of the start of text, as a number."
718 719 720 721 722 723
  (save-restriction
    (widen)
    (save-excursion
      (rfc822-goto-eoh)
      (forward-line 1)
      (point))))
724 725 726 727 728 729 730 731 732 733 734 735 736 737

(defun mail-sendmail-delimit-header ()
  "Set up whatever header delimiter convention sendmail will use.
Concretely: replace the first blank line in the header with the separator."
  (rfc822-goto-eoh)
  (insert mail-header-separator)
  (point))

(defun mail-sendmail-undelimit-header ()
  "Remove header separator to put the message in correct form for sendmail.
Leave point at the start of the delimiter line."
  (rfc822-goto-eoh)
  (delete-region (point) (progn (end-of-line) (point))))

738 739 740
(defun mail-mode-auto-fill ()
  "Carry out Auto Fill for Mail mode.
If within the headers, this makes the new lines into continuation lines."
741
  (if (< (point) (mail-header-end))
742
      (let ((old-line-start (line-beginning-position)))
743 744 745 746
	(if (do-auto-fill)
	    (save-excursion
	      (beginning-of-line)
	      (while (not (eq (point) old-line-start))
747 748 749
		;; Use insert-before-markers in case we're inserting
		;; before the saved value of point (which is common).
		(insert-before-markers "   ")
750 751 752
		(forward-line -1))
	      t)))
    (do-auto-fill)))
753 754 755

(defun mail-mode-fill-paragraph (arg)
  ;; Do something special only if within the headers.
756
  (if (< (point) (mail-header-end))
757
      (let (beg end fieldname)
758 759
	(when (prog1 (re-search-backward "^[-a-zA-Z]+:" nil 'yes)
		(setq beg (point)))
760
	(setq fieldname
761
		(downcase (buffer-substring beg (1- (match-end 0))))))
762 763 764 765 766 767 768 769 770 771 772
	(forward-line 1)
	;; Find continuation lines and get rid of their continuation markers.
	(while (looking-at "[ \t]")
	  (delete-horizontal-space)
	  (forward-line 1))
	(setq end (point-marker))
	(goto-char beg)
	;; If this field contains addresses,
	;; make sure we can fill after each address.
	(if (member fieldname
		    '("to" "cc" "bcc" "from" "reply-to"
773
		      "mail-reply-to" "mail-followup-to"
774 775 776 777 778
		      "resent-to" "resent-cc" "resent-bcc"
		      "resent-from" "resent-reply-to"))
	    (while (search-forward "," end t)
	      (or (looking-at "[ \t]")
		  (insert " "))))
779
	(fill-region-as-paragraph beg end arg)
780 781 782 783 784 785 786 787
	;; Mark all lines except the first as continuations.
	(goto-char beg)
	(forward-line 1)
	(while (< (point) end)
	  (insert "  ")
	  (forward-line 1))
	(move-marker end nil)
	t)))
788

789 790
;; User-level commands for sending.

791
(defun mail-send-and-exit (&optional arg)
Christopher Zaborsky's avatar
Christopher Zaborsky committed
792
  "Send message like `mail-send', then, if no errors, exit from mail buffer.
Richard M. Stallman's avatar
Richard M. Stallman committed
793 794 795
Prefix arg means don't delete this window."
  (interactive "P")
  (mail-send)
796 797
  (mail-bury arg))

798
(defun mail-dont-send (&optional arg)
799 800 801 802 803
  "Don't send the message you have been editing.
Prefix arg means don't delete this window."
  (interactive "P")
  (mail-bury arg))

804
(defun mail-bury (&optional arg)
805
  "Bury this mail buffer."
806 807
  (let ((newbuf (other-buffer (current-buffer))))
    (bury-buffer (current-buffer))
808 809 810
    (if (and (null arg) mail-return-action)
	(apply (car mail-return-action) (cdr mail-return-action))
      (switch-to-buffer newbuf))))
Richard M. Stallman's avatar
Richard M. Stallman committed
811

812
(defcustom mail-send-hook nil
813
  "Hook run just before sending a message."
814 815 816 817
  :type 'hook
  :options '(flyspell-mode-off)
  :group 'sendmail)

818
;;;###autoload
819 820
(defcustom mail-mailing-lists nil
"List of mailing list addresses the user is subscribed to.
821 822 823 824 825 826
The variable is used to trigger insertion of the \"Mail-Followup-To\"
header when sending a message to a mailing list."
  :type '(repeat string)
  :group 'sendmail)


Richard M. Stallman's avatar
Richard M. Stallman committed
827 828 829 830 831 832 833
(defun mail-send ()
  "Send the message in the current buffer.
If `mail-interactive' is non-nil, wait for success indication
or error messages, and inform user.
Otherwise any failure is reported in a message back to
the user from the mailer."
  (interactive)
834 835 836 837
  (if (if buffer-file-name
	  (y-or-n-p "Send buffer contents as mail message? ")
	(or (buffer-modified-p)
	    (y-or-n-p "Message already sent; resend? ")))
838
      (let ((inhibit-read-only t)
839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867
	    (opoint (point))
	    (ml (when mail-mailing-lists
                ;; The surrounding regexp assumes the use of
                ;; `mail-strip-quoted-names' on addresses before matching
                ;; Cannot deal with full RFC 822 freedom, but that is
                ;; unlikely to be problematic.
                (concat "\\(?:[[:space:];,]\\|\\`\\)"
                        (regexp-opt mail-mailing-lists t)
                        "\\(?:[[:space:];,]\\|\\'\\)"))))
	;; If there are mailing lists defined
	(when ml
	  (save-excursion
	    (let* ((to (mail-fetch-field "to" nil t))
		   (cc (mail-fetch-field "cc" nil t))
		   (new-header-values	; To: and Cc:
		    (mail-strip-quoted-names
		     (concat to (when cc (concat ", " cc))))))
	      ;; If message goes to known mailing list ...
	      (when (string-match ml new-header-values)
		;; Add Mail-Followup-To if none yet
		(unless (mail-fetch-field "mail-followup-to")
		  (goto-char (mail-header-end))
		  (insert "Mail-Followup-To: "
			  (let ((l))
			    (mapc
			     ;; remove duplicates
			     '(lambda (e)
				(unless (member e l)
				  (push e l)))
868 869
			     (split-string new-header-values
					   ",[[:space:]]+" t))
870 871 872 873 874 875 876 877 878
			    (mapconcat 'identity l ", "))
			  "\n"))
		;; Add Mail-Reply-To if none yet
		(unless (mail-fetch-field "mail-reply-to")
		  (goto-char (mail-header-end))
		  (insert "Mail-Reply-To: "
			  (or (mail-fetch-field "reply-to")
			      user-mail-address)
			  "\n"))))))
879
	(unless (memq mail-send-nonascii '(t mime))
880 881 882 883 884 885 886
	  (goto-char (point-min))
	  (skip-chars-forward "\0-\177")
	  (or (= (point) (point-max))
	      (if (eq mail-send-nonascii 'query)
		  (or (y-or-n-p "Message contains non-ASCII characters; send anyway? ")
		      (error "Aborted"))
		(error "Message contains non-ASCII characters"))))
887 888
	;; Complain about any invalid line.
	(goto-char (point-min))
889 890 891 892 893 894 895 896
	(re-search-forward (regexp-quote mail-header-separator) (point-max) t)
	(let ((header-end (or (match-beginning 0) (point-max))))
	  (goto-char (point-min))
	  (while (< (point) header-end)
	    (unless (looking-at "[ \t]\\|.*:\\|$")
	      (push-mark opoint)
	      (error "Invalid header line (maybe a continuation line lacks initial whitespace)"))
	    (forward-line 1)))
897
	(goto-char opoint)
Richard M. Stallman's avatar
Richard M. Stallman committed
898
	(run-hooks 'mail-send-hook)
899
	(message "Sending...")
Richard M. Stallman's avatar
Richard M. Stallman committed
900 901 902 903
	(funcall send-mail-function)
	;; Now perform actions on successful sending.
	(while mail-send-actions
	  (condition-case nil
904 905
	      (apply (car (car mail-send-actions))
		     (cdr (car mail-send-actions)))
Richard M. Stallman's avatar
Richard M. Stallman committed
906 907
	    (error))
	  (setq mail-send-actions (cdr mail-send-actions)))
908
	(message "Sending...done")
Karl Heuer's avatar
Karl Heuer committed
909
	;; If buffer has no file, mark it as unmodified and delete auto-save.
910 911 912 913
	(if (not buffer-file-name)
	    (progn
	      (set-buffer-modified-p nil)
	      (delete-auto-save-file-if-necessary t))))))
914 915 916 917 918 919 920 921

(defun mail-envelope-from ()
  "Return the envelope mail address to use when sending mail.
This function uses `mail-envelope-from'."
  (if (eq mail-envelope-from 'header)
      (nth 1 (mail-extract-address-components
 	      (mail-fetch-field "From")))
    mail-envelope-from))
922 923 924

;; This does the real work of sending a message via sendmail.
;; It is called via the variable send-mail-function.
Richard M. Stallman's avatar
Richard M. Stallman committed
925

926 927
;;;###autoload
(defvar sendmail-coding-system nil
928
  "*Coding system for encoding the outgoing mail.
929
This has higher priority than the default `buffer-file-coding-system'
930 931
and `default-sendmail-coding-system',
but lower priority than the local value of `buffer-file-coding-system'.
932
See also the function `select-message-coding-system'.")
933 934 935

;;;###autoload
(defvar default-sendmail-coding-system 'iso-latin-1
Andreas Schwab's avatar
Andreas Schwab committed
936
  "Default coding system for encoding the outgoing mail.
937 938
This variable is used only when `sendmail-coding-system' is nil.

939
This variable is set/changed by the command `set-language-environment'.
940
User should not set this variable manually,
941
instead use `sendmail-coding-system' to get a constant encoding
942
of outgoing mails regardless of the current language environment.
943
See also the function `select-message-coding-system'.")
944

945 946 947 948 949 950 951
(defun mail-insert-from-field ()
  (let* ((login user-mail-address)
	 (fullname (user-full-name))
	 (quote-fullname nil))
    (if (string-match "[^\0-\177]" fullname