Customized.
[bpt/emacs.git] / lisp / mail / sendmail.el
CommitLineData
c88ab9ce
ER
1;;; sendmail.el --- mail sending commands for Emacs.
2
9596811a 3;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96 Free Software Foundation, Inc.
3a801d0c 4
e5167999 5;; Maintainer: FSF
d7b4d18f 6;; Keywords: mail
e5167999 7
20a8832d
RS
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software; you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
e5167999 12;; the Free Software Foundation; either version 2, or (at your option)
20a8832d
RS
13;; any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
b578f267
EN
21;; along with GNU Emacs; see the file COPYING. If not, write to the
22;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23;; Boston, MA 02111-1307, USA.
20a8832d 24
d9ecc911
ER
25;;; Commentary:
26
27;; This mode provides mail-sending facilities from within Emacs. It is
28;; documented in the Emacs user's manual.
29
e5167999 30;;; Code:
20a8832d 31
ea9ceb34
KH
32;;;###autoload
33(defvar mail-from-style 'angles "\
34*Specifies how \"From:\" fields look.
35
36If `nil', they contain just the return address like:
37 king@grassland.com
38If `parens', they look like:
39 king@grassland.com (Elvis Parsley)
40If `angles', they look like:
41 Elvis Parsley <king@grassland.com>")
42
20a8832d 43;;;###autoload
92e0f87a 44(defvar mail-self-blind nil "\
9f3e5ddf 45*Non-nil means insert BCC to self in messages to be sent.
20a8832d
RS
46This is done when the message is initialized,
47so you can remove or alter the BCC field to override the default.")
48
49;;;###autoload
92e0f87a 50(defvar mail-interactive nil "\
9f3e5ddf 51*Non-nil means when sending a message wait for and display errors.
20a8832d
RS
52nil means let mailer mail back a message to report errors.")
53
54;;;###autoload
92e0f87a 55(defvar mail-yank-ignored-headers "^via:\\|^mail-from:\\|^origin:\\|^status:\\|^remailed\\|^received:\\|^message-id:\\|^summary-line:\\|^to:\\|^subject:\\|^in-reply-to:\\|^return-path:" "\
9f3e5ddf 56*Delete these headers from old message when it's inserted in a reply.")
20a8832d
RS
57
58;; Useful to set in site-init.el
59;;;###autoload
06b68294 60(defvar send-mail-function 'sendmail-send-it "\
20a8832d 61Function to call to send the current buffer as mail.
1bae7664
KH
62The headers should be delimited by a line whose contents
63match the variable `mail-header-separator'.")
20a8832d
RS
64
65;;;###autoload
66(defvar mail-header-separator "--text follows this line--" "\
67*Line used to separate headers from text in messages being composed.")
68
6737ae74
RS
69;; Set up mail-header-separator for use as a category text property.
70(put 'mail-header-separator 'rear-nonsticky '(category))
f869bab8
RS
71;;; This was a nice idea, for preventing accidental modification of
72;;; the separator. But I found it also prevented or obstructed
73;;; certain deliberate operations, such as copying the separator line
74;;; up to the top to send myself a copy of an already sent outgoing message
75;;; and other things. So I turned it off. --rms.
76;;;(put 'mail-header-separator 'read-only t)
6737ae74 77
20a8832d
RS
78;;;###autoload
79(defvar mail-archive-file-name nil "\
80*Name of file to write all outgoing messages in, or nil for none.
de01bf7d 81This can be an inbox file or an Rmail file.")
20a8832d 82
fe8c32a6 83;;;###autoload
235c2d35 84(defvar mail-default-reply-to nil
6da74aab
RS
85 "*Address to insert as default Reply-to field of outgoing messages.
86If nil, it will be initialized from the REPLYTO environment variable
87when you first send mail.")
20a8832d 88
a06d7943 89;;;###autoload
20a8832d
RS
90(defvar mail-alias-file nil
91 "*If non-nil, the name of a file to use instead of `/usr/lib/aliases'.
92This file defines aliases to be expanded by the mailer; this is a different
93feature from that of defining aliases in `.mailrc' to be expanded in Emacs.
94This variable has no effect unless your system uses sendmail as its mailer.")
95
8790b698
NF
96;;;###autoload
97(defvar mail-personal-alias-file "~/.mailrc"
98 "*If non-nil, the name of the user's personal mail alias file.
99This file typically should be in same format as the `.mailrc' file used by
100the `Mail' or `mailx' program.
101This file need not actually exist.")
102
8b262cbc
KH
103(defvar mail-setup-hook nil
104 "Normal hook, run each time a new outgoing mail message is initialized.
105The function `mail-setup' runs this hook.")
106
5ef9d627 107(defvar mail-aliases t
ade349a0 108 "Alist of mail address aliases,
de01bf7d
RS
109or t meaning should be initialized from your mail aliases file.
110\(The file's name is normally `~/.mailrc', but your MAILRC environment
111variable can override that name.)
112The alias definitions in the file have this form:
ade349a0 113 alias ALIAS MEANING")
5ef9d627 114
9cc75191 115(defvar mail-alias-modtime nil
de01bf7d 116 "The modification time of your mail alias file when it was last examined.")
9cc75191 117
20a8832d
RS
118(defvar mail-yank-prefix nil
119 "*Prefix insert on lines of yanked message being replied to.
120nil means use indentation.")
1c24b04a
RS
121(defvar mail-indentation-spaces 3
122 "*Number of spaces to insert at the beginning of each cited line.
42eda49c 123Used by `mail-yank-original' via `mail-indent-citation'.")
fa24a822 124(defvar mail-yank-hooks nil
015c5c55
RS
125 "Obsolete hook for modifying a citation just inserted in the mail buffer.
126Each hook function can find the citation between (point) and (mark t).
127And each hook function should leave point and mark around the citation
128text as modified.
129
130This is a normal hook, misnamed for historical reasons.
131It is semi-obsolete and mail agents should no longer use it.")
132
133(defvar mail-citation-hook nil
1c24b04a
RS
134 "*Hook for modifying a citation just inserted in the mail buffer.
135Each hook function can find the citation between (point) and (mark t).
136And each hook function should leave point and mark around the citation
137text as modified.
138
015c5c55
RS
139If this hook is entirely empty (nil), a default action is taken
140instead of no action.")
20a8832d
RS
141
142(defvar mail-abbrevs-loaded nil)
143(defvar mail-mode-map nil)
144
5ef9d627 145(autoload 'build-mail-aliases "mailalias"
8790b698 146 "Read mail aliases from user's personal aliases file and set `mail-aliases'."
5ef9d627
RS
147 nil)
148
149(autoload 'expand-mail-aliases "mailalias"
150 "Expand all mail aliases in suitable header fields found between BEG and END.
151Suitable header fields are `To', `Cc' and `Bcc' and their `Resent-' variants.
152Optional second arg EXCLUDE may be a regular expression defining text to be
153removed from alias expansions."
154 nil)
155
ef15f270 156;;;###autoload
547075d4
JB
157(defvar mail-signature nil
158 "*Text inserted at end of mail buffer when a message is initialized.
4ac2e032
RS
159If t, it means to insert the contents of the file `mail-signature-file'.")
160
161(defvar mail-signature-file "~/.signature"
162 "*File containing the text inserted at end of mail buffer.")
20a8832d 163
c8553837 164(defvar mail-reply-action nil)
20a8832d
RS
165(defvar mail-send-actions nil
166 "A list of actions to be performed upon successful sending of a message.")
c8553837 167(put 'mail-reply-action 'permanent-local t)
98bd608d 168(put 'mail-send-actions 'permanent-local t)
20a8832d
RS
169
170(defvar mail-default-headers nil
171 "*A string containing header lines, to be inserted in outgoing messages.
172It is inserted before you edit the message,
173so you can edit or delete these lines.")
174
1f7850dd
RS
175(defvar mail-bury-selects-summary t
176 "*If non-nil, try to show RMAIL summary buffer after returning from mail.
177The functions \\[mail-send-on-exit] or \\[mail-dont-send] select
178the RMAIL summary buffer before returning, if it exists and this variable
179is non-nil.")
180
ac9f0310
RS
181;; I find that this happens so often, for innocent reasons,
182;; that it is not acceptable to bother the user about it -- rms.
183(defvar mail-send-nonascii t
34153d76
RS
184 "*Specify whether to allow sending non-ASCII characters in mail.
185If t, that means do allow it. nil means don't allow it.
186`query' means ask the user each time.
187Including non-ASCII characters in a mail message can be problematical
188for the recipient, who may not know how to decode them properly.")
189
7c203051
RS
190;; Note: could use /usr/ucb/mail instead of sendmail;
191;; options -t, and -v if not interactive.
192(defvar mail-mailer-swallows-blank-line
01b5c04d 193 (if (and (string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)" system-configuration)
47c5e807 194 (file-readable-p "/etc/sendmail.cf")
01b5c04d
RS
195 (let ((buffer (get-buffer-create " *temp*")))
196 (unwind-protect
197 (save-excursion
198 (set-buffer buffer)
199 (insert-file-contents "/etc/sendmail.cf")
200 (goto-char (point-min))
201 (let ((case-fold-search nil))
5a853005 202 (re-search-forward "^OR\\>" nil t)))
01b5c04d 203 (kill-buffer buffer))))
9a41d08a
NF
204 ;; According to RFC822, "The field-name must be composed of printable
205 ;; ASCII characters (i.e. characters that have decimal values between
206 ;; 33 and 126, except colon)", i.e. any chars except ctl chars,
207 ;; space, or colon.
208 '(looking-at "[ \t]\\|[][!\"#$%&'()*+,-./0-9;<=>?@A-Z\\\\^_`a-z{|}~]+:"))
7c203051
RS
209 "Set this non-nil if the system's mailer runs the header and body together.
210\(This problem exists on Sunos 4 when sendmail is run in remote mode.)
211The value should be an expression to test whether the problem will
212actually occur.")
213
20a8832d
RS
214(defvar mail-mode-syntax-table nil
215 "Syntax table used while in mail mode.")
216
8b1f1a0c 217(if (not mail-mode-syntax-table)
20a8832d
RS
218 (progn
219 (setq mail-mode-syntax-table (copy-syntax-table text-mode-syntax-table))
220 (modify-syntax-entry ?% ". " mail-mode-syntax-table)))
221
8b1f1a0c 222(defvar mail-font-lock-keywords
70a302f8 223 (eval-when-compile
f1052d2e
SM
224 (let* ((cite-chars "[>|}]")
225 (cite-prefix "A-Za-z")
226 (cite-suffix (concat cite-prefix "0-9_.@-`'\"")))
3d51068d
SM
227 (list '("^\\(To\\|Newsgroups\\):" . font-lock-function-name-face)
228 '("^\\(B?CC\\|Reply-to\\):" . font-lock-keyword-face)
70a302f8
SM
229 '("^\\(Subject:\\)[ \t]*\\(.+\\)?"
230 (1 font-lock-comment-face) (2 font-lock-type-face nil t))
f1052d2e 231 ;; Use EVAL to delay in case `mail-header-separator' gets changed.
3d51068d
SM
232 '(eval .
233 (cons (concat "^" (regexp-quote mail-header-separator) "$")
234 'font-lock-warning-face))
f1052d2e
SM
235 ;; Use MATCH-ANCHORED to effectively anchor the regexp left side.
236 `(,cite-chars
237 (,(concat "\\=[ \t]*"
3d51068d
SM
238 "\\(\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
239 "\\(" cite-chars "[ \t]*\\)\\)+"
240 "\\(.*\\)")
f1052d2e 241 (beginning-of-line) (end-of-line)
3d51068d
SM
242 (2 font-lock-reference-face nil t)
243 (4 font-lock-comment-face nil t)))
70a302f8
SM
244 '("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\):.*"
245 . font-lock-string-face))))
8b1f1a0c
RS
246 "Additional expressions to highlight in Mail mode.")
247
da5667c6
RS
248(defvar mail-send-hook nil
249 "Normal hook run before sending mail, in Mail mode.")
5b6575b7 250\f
1498db18 251(defun sendmail-sync-aliases ()
8790b698 252 (let ((modtime (nth 5 (file-attributes mail-personal-alias-file))))
9cc75191
KH
253 (or (equal mail-alias-modtime modtime)
254 (setq mail-alias-modtime modtime
255 mail-aliases t))))
256
20a8832d 257(defun mail-setup (to subject in-reply-to cc replybuffer actions)
235c2d35 258 (or mail-default-reply-to
810163a3 259 (setq mail-default-reply-to (getenv "REPLYTO")))
1498db18 260 (sendmail-sync-aliases)
5ef9d627
RS
261 (if (eq mail-aliases t)
262 (progn
263 (setq mail-aliases nil)
8790b698 264 (if (file-exists-p mail-personal-alias-file)
5ef9d627 265 (build-mail-aliases))))
2813dcb9 266 ;; Don't leave this around from a previous message.
f8081291 267 (kill-local-variable 'buffer-file-coding-system)
8881c1ab
KH
268 (kill-local-variable 'enable-multibyte-characters)
269 (if current-input-method
270 (inactivate-input-method))
20a8832d 271 (setq mail-send-actions actions)
c8553837 272 (setq mail-reply-action replybuffer)
20a8832d
RS
273 (goto-char (point-min))
274 (insert "To: ")
275 (save-excursion
276 (if to
70ca75ae
RS
277 ;; Here removed code to extract names from within <...>
278 ;; on the assumption that mail-strip-quoted-names
279 ;; has been called and has done so.
280 (let ((fill-prefix "\t")
281 (address-start (point)))
20a8832d 282 (insert to "\n")
70ca75ae 283 (fill-region-as-paragraph address-start (point-max)))
20a8832d
RS
284 (newline))
285 (if cc
70ca75ae
RS
286 (let ((fill-prefix "\t")
287 (address-start (progn (insert "CC: ") (point))))
288 (insert cc "\n")
289 (fill-region-as-paragraph address-start (point-max))))
20a8832d 290 (if in-reply-to
9171f37f 291 (let ((fill-prefix "\t")
58cabff0 292 (fill-column 78)
34046d66
RS
293 (address-start (point)))
294 (insert "In-reply-to: " in-reply-to "\n")
9171f37f 295 (fill-region-as-paragraph address-start (point-max))))
20a8832d
RS
296 (insert "Subject: " (or subject "") "\n")
297 (if mail-default-headers
298 (insert mail-default-headers))
299 (if mail-default-reply-to
300 (insert "Reply-to: " mail-default-reply-to "\n"))
301 (if mail-self-blind
22c03d39 302 (insert "BCC: " user-mail-address "\n"))
20a8832d
RS
303 (if mail-archive-file-name
304 (insert "FCC: " mail-archive-file-name "\n"))
6737ae74
RS
305 (put-text-property (point)
306 (progn
307 (insert mail-header-separator "\n")
308 (1- (point)))
309 'category 'mail-header-separator)
874bdb5a
RS
310 ;; Insert the signature. But remember the beginning of the message.
311 (if to (setq to (point)))
547075d4 312 (cond ((eq mail-signature t)
4ac2e032 313 (if (file-exists-p mail-signature-file)
a5282b8f
RS
314 (progn
315 (insert "\n\n-- \n")
4ac2e032 316 (insert-file-contents mail-signature-file))))
547075d4
JB
317 (mail-signature
318 (insert mail-signature)))
20a8832d
RS
319 (goto-char (point-max))
320 (or (bolp) (newline)))
874bdb5a 321 (if to (goto-char to))
20a8832d
RS
322 (or to subject in-reply-to
323 (set-buffer-modified-p nil))
324 (run-hooks 'mail-setup-hook))
5b6575b7 325\f
20a8832d
RS
326;;;###autoload
327(defun mail-mode ()
328 "Major mode for editing mail to be sent.
329Like Text Mode but with these additional commands:
330C-c C-s mail-send (send the message) C-c C-c mail-send-and-exit
331C-c C-f move to a header field (and create it if there isn't):
330e9e11
KH
332 C-c C-f C-t move to To: C-c C-f C-s move to Subject:
333 C-c C-f C-c move to CC: C-c C-f C-b move to BCC:
f8b15b6e 334 C-c C-f C-f move to FCC:
330e9e11 335C-c C-t mail-text (move to beginning of message text).
4ac2e032 336C-c C-w mail-signature (insert `mail-signature-file' file).
20a8832d
RS
337C-c C-y mail-yank-original (insert current message, in Rmail).
338C-c C-q mail-fill-yanked-message (fill what was yanked).
330e9e11 339C-c C-v mail-sent-via (add a Sent-via field for each To or CC)."
20a8832d
RS
340 (interactive)
341 (kill-all-local-variables)
c8553837 342 (make-local-variable 'mail-reply-action)
20a8832d
RS
343 (make-local-variable 'mail-send-actions)
344 (set-syntax-table mail-mode-syntax-table)
345 (use-local-map mail-mode-map)
346 (setq local-abbrev-table text-mode-abbrev-table)
347 (setq major-mode 'mail-mode)
348 (setq mode-name "Mail")
349 (setq buffer-offer-save t)
2667df42
SM
350 (make-local-variable 'font-lock-defaults)
351 (setq font-lock-defaults '(mail-font-lock-keywords t))
20a8832d
RS
352 (make-local-variable 'paragraph-separate)
353 (make-local-variable 'paragraph-start)
5b6575b7
RS
354 (make-local-variable 'normal-auto-fill-function)
355 (setq normal-auto-fill-function 'mail-mode-auto-fill)
b5682230 356 (make-local-variable 'fill-paragraph-function)
c8553837 357 (setq fill-paragraph-function 'mail-mode-fill-paragraph)
1b8def58
RS
358 (make-local-variable 'adaptive-fill-regexp)
359 (setq adaptive-fill-regexp
12eb951f 360 (concat "[ \t]*[-a-z0-9A-Z]*>+[ \t]*\\|" adaptive-fill-regexp))
d78f466f 361 (make-local-variable 'adaptive-fill-first-line-regexp)
f03ca5f5 362 (setq adaptive-fill-first-line-regexp
12eb951f 363 (concat "[ \t]*[-a-z0-9A-Z]*>+[ \t]*\\|" adaptive-fill-first-line-regexp))
df0d89b1
RS
364 ;; `-- ' precedes the signature. `-----' appears at the start of the
365 ;; lines that delimit forwarded messages.
366 ;; Lines containing just >= 3 dashes, perhaps after whitespace,
367 ;; are also sometimes used and should be separators.
0408f0ac 368 (setq paragraph-start (concat (regexp-quote mail-header-separator)
6acf83d3 369 "$\\|[ \t]*[a-z0-9A-Z]*>+[ \t]*$\\|[ \t]*$\\|"
a8fb9940 370 page-delimiter))
a9842346 371 (setq paragraph-separate paragraph-start)
20a8832d 372 (run-hooks 'text-mode-hook 'mail-mode-hook))
5b6575b7
RS
373
374(defun mail-mode-auto-fill ()
375 "Carry out Auto Fill for Mail mode.
376If within the headers, this makes the new lines into continuation lines."
377 (if (< (point)
378 (save-excursion
379 (goto-char (point-min))
b3e13f5d
RS
380 (if (re-search-forward
381 (concat "^" (regexp-quote mail-header-separator) "$")
382 nil t)
5b6575b7
RS
383 (point)
384 0)))
385 (let ((old-line-start (save-excursion (beginning-of-line) (point))))
386 (if (do-auto-fill)
387 (save-excursion
388 (beginning-of-line)
389 (while (not (eq (point) old-line-start))
28afe199
RS
390 ;; Use insert-before-markers in case we're inserting
391 ;; before the saved value of point (which is common).
392 (insert-before-markers " ")
5b6575b7
RS
393 (forward-line -1))
394 t)))
395 (do-auto-fill)))
c8553837
RS
396
397(defun mail-mode-fill-paragraph (arg)
398 ;; Do something special only if within the headers.
399 (if (< (point)
400 (save-excursion
401 (goto-char (point-min))
b3e13f5d
RS
402 (if (re-search-forward
403 (concat "^" (regexp-quote mail-header-separator) "$")
404 nil t)
c8553837
RS
405 (point)
406 0)))
407 (let (beg end fieldname)
408 (re-search-backward "^[-a-zA-Z]+:" nil 'yes)
409 (setq beg (point))
410 (setq fieldname
411 (downcase (buffer-substring beg (1- (match-end 0)))))
412 (forward-line 1)
413 ;; Find continuation lines and get rid of their continuation markers.
414 (while (looking-at "[ \t]")
415 (delete-horizontal-space)
416 (forward-line 1))
417 (setq end (point-marker))
418 (goto-char beg)
419 ;; If this field contains addresses,
420 ;; make sure we can fill after each address.
421 (if (member fieldname
422 '("to" "cc" "bcc" "from" "reply-to"
423 "resent-to" "resent-cc" "resent-bcc"
424 "resent-from" "resent-reply-to"))
425 (while (search-forward "," end t)
426 (or (looking-at "[ \t]")
427 (insert " "))))
428 (fill-region-as-paragraph beg end)
429 ;; Mark all lines except the first as continuations.
430 (goto-char beg)
431 (forward-line 1)
432 (while (< (point) end)
433 (insert " ")
434 (forward-line 1))
435 (move-marker end nil)
436 t)))
299fdd8d
RS
437\f
438;;; Set up keymap.
20a8832d
RS
439
440(if mail-mode-map
441 nil
442 (setq mail-mode-map (nconc (make-sparse-keymap) text-mode-map))
c21b5781 443 (define-key mail-mode-map "\M-\t" 'mail-complete)
20a8832d
RS
444 (define-key mail-mode-map "\C-c?" 'describe-mode)
445 (define-key mail-mode-map "\C-c\C-f\C-t" 'mail-to)
446 (define-key mail-mode-map "\C-c\C-f\C-b" 'mail-bcc)
70ee42f7 447 (define-key mail-mode-map "\C-c\C-f\C-f" 'mail-fcc)
20a8832d
RS
448 (define-key mail-mode-map "\C-c\C-f\C-c" 'mail-cc)
449 (define-key mail-mode-map "\C-c\C-f\C-s" 'mail-subject)
3a3ffba4 450 (define-key mail-mode-map "\C-c\C-f\C-r" 'mail-reply-to)
20a8832d
RS
451 (define-key mail-mode-map "\C-c\C-t" 'mail-text)
452 (define-key mail-mode-map "\C-c\C-y" 'mail-yank-original)
e39e74c0 453 (define-key mail-mode-map "\C-c\C-r" 'mail-yank-region)
20a8832d
RS
454 (define-key mail-mode-map "\C-c\C-q" 'mail-fill-yanked-message)
455 (define-key mail-mode-map "\C-c\C-w" 'mail-signature)
456 (define-key mail-mode-map "\C-c\C-v" 'mail-sent-via)
457 (define-key mail-mode-map "\C-c\C-c" 'mail-send-and-exit)
f0aef6bf
RS
458 (define-key mail-mode-map "\C-c\C-s" 'mail-send)
459 (define-key mail-mode-map "\C-c\C-i" 'mail-attach-file))
299fdd8d
RS
460
461(define-key mail-mode-map [menu-bar mail]
462 (cons "Mail" (make-sparse-keymap "Mail")))
463
464(define-key mail-mode-map [menu-bar mail fill]
465 '("Fill Citation" . mail-fill-yanked-message))
466
467(define-key mail-mode-map [menu-bar mail yank]
468 '("Cite Original" . mail-yank-original))
469
470(define-key mail-mode-map [menu-bar mail signature]
471 '("Insert Signature" . mail-signature))
472
1abf89b8
SM
473(define-key mail-mode-map [menu-bar mail mail-sep]
474 '("--"))
475
1b6bb250
RS
476(define-key mail-mode-map [menu-bar mail cancel]
477 '("Cancel" . mail-dont-send))
478
299fdd8d
RS
479(define-key mail-mode-map [menu-bar mail send-stay]
480 '("Send, Keep Editing" . mail-send))
481
482(define-key mail-mode-map [menu-bar mail send]
483 '("Send Message" . mail-send-and-exit))
484
485(define-key mail-mode-map [menu-bar headers]
fa8afe42 486 (cons "Headers" (make-sparse-keymap "Move to Header")))
299fdd8d 487
1abf89b8
SM
488(define-key mail-mode-map [menu-bar headers text]
489 '("Text" . mail-text))
490
491(define-key mail-mode-map [menu-bar headers expand-aliases]
492 '("Expand Aliases" . expand-mail-aliases))
3a3ffba4 493
299fdd8d
RS
494(define-key mail-mode-map [menu-bar headers sent-via]
495 '("Sent Via" . mail-sent-via))
496
1abf89b8
SM
497(define-key mail-mode-map [menu-bar headers reply-to]
498 '("Reply-To" . mail-reply-to))
299fdd8d
RS
499
500(define-key mail-mode-map [menu-bar headers bcc]
501 '("Bcc" . mail-bcc))
502
503(define-key mail-mode-map [menu-bar headers fcc]
504 '("Fcc" . mail-fcc))
505
506(define-key mail-mode-map [menu-bar headers cc]
507 '("Cc" . mail-cc))
508
509(define-key mail-mode-map [menu-bar headers subject]
510 '("Subject" . mail-subject))
511
512(define-key mail-mode-map [menu-bar headers to]
513 '("To" . mail-to))
20a8832d 514\f
5b6575b7
RS
515;; User-level commands for sending.
516
20a8832d 517(defun mail-send-and-exit (arg)
33b4a308 518 "Send message like `mail-send', then, if no errors, exit from mail buffer.
20a8832d
RS
519Prefix arg means don't delete this window."
520 (interactive "P")
521 (mail-send)
1b6bb250
RS
522 (mail-bury arg))
523
524(defun mail-dont-send (arg)
525 "Don't send the message you have been editing.
526Prefix arg means don't delete this window."
527 (interactive "P")
528 (mail-bury arg))
529
530(defun mail-bury (arg)
531 "Bury this mail buffer."
e49ad9a5
RS
532 (let ((newbuf (other-buffer (current-buffer))))
533 (bury-buffer (current-buffer))
54feedaa 534 (if (and (or (window-dedicated-p (frame-selected-window))
b03a1621 535 (cdr (assq 'mail-dedicated-frame (frame-parameters))))
9320d421
RS
536 (not (null (delq (selected-frame) (visible-frame-list)))))
537 (delete-frame (selected-frame))
fdb90184
RS
538 (let (rmail-flag summary-buffer)
539 (and (not arg)
540 (not (one-window-p))
541 (save-excursion
542 (set-buffer (window-buffer (next-window (selected-window) 'not)))
543 (setq rmail-flag (eq major-mode 'rmail-mode))
544 (setq summary-buffer
1f7850dd
RS
545 (and mail-bury-selects-summary
546 (boundp 'rmail-summary-buffer)
6cfc977b 547 rmail-summary-buffer
fdb90184
RS
548 (buffer-name rmail-summary-buffer)
549 (not (get-buffer-window rmail-summary-buffer))
550 rmail-summary-buffer))))
551 (if rmail-flag
552 ;; If the Rmail buffer has a summary, show that.
553 (if summary-buffer (switch-to-buffer summary-buffer)
554 (delete-window))
555 (switch-to-buffer newbuf))))))
20a8832d
RS
556
557(defun mail-send ()
558 "Send the message in the current buffer.
559If `mail-interactive' is non-nil, wait for success indication
560or error messages, and inform user.
561Otherwise any failure is reported in a message back to
562the user from the mailer."
563 (interactive)
e11094e6
RS
564 (if (if buffer-file-name
565 (y-or-n-p "Send buffer contents as mail message? ")
566 (or (buffer-modified-p)
567 (y-or-n-p "Message already sent; resend? ")))
34153d76
RS
568 (let ((inhibit-read-only t)
569 (opoint (point)))
570 (when (and enable-multibyte-characters
571 (not (eq mail-send-nonascii t)))
572 (goto-char (point-min))
573 (skip-chars-forward "\0-\177")
574 (or (= (point) (point-max))
575 (if (eq mail-send-nonascii 'query)
576 (or (y-or-n-p "Message contains non-ASCII characters; send anyway? ")
577 (error "Aborted"))
578 (error "Message contains non-ASCII characters"))))
413d1aa2
RS
579 ;; Complain about any invalid line.
580 (goto-char (point-min))
581 (while (not (looking-at (regexp-quote mail-header-separator)))
582 (unless (looking-at "[ \t]\\|.*:\\|$")
583 (push-mark opoint)
584 (error "Invalid header line (maybe a continuation line lacks initial whitespace)"))
585 (forward-line 1))
34153d76 586 (goto-char opoint)
20a8832d 587 (run-hooks 'mail-send-hook)
da5667c6 588 (message "Sending...")
20a8832d
RS
589 (funcall send-mail-function)
590 ;; Now perform actions on successful sending.
591 (while mail-send-actions
592 (condition-case nil
d2561f34
RS
593 (apply (car (car mail-send-actions))
594 (cdr (car mail-send-actions)))
20a8832d
RS
595 (error))
596 (setq mail-send-actions (cdr mail-send-actions)))
d2561f34
RS
597 (message "Sending...done")
598 ;; If buffer has no file, mark it as unmodified and delete autosave.
599 (if (not buffer-file-name)
600 (progn
601 (set-buffer-modified-p nil)
602 (delete-auto-save-file-if-necessary t))))))
5b6575b7
RS
603\f
604;; This does the real work of sending a message via sendmail.
605;; It is called via the variable send-mail-function.
20a8832d 606
ae54d287
KH
607;;;###autoload
608(defvar sendmail-coding-system nil
5e7e990e 609 "Coding system to encode the outgoing mail.")
ee0a4f29 610
20a8832d 611(defun sendmail-send-it ()
8e183d5b 612 (require 'mail-utils)
20a8832d
RS
613 (let ((errbuf (if mail-interactive
614 (generate-new-buffer " sendmail errors")
615 0))
616 (tembuf (generate-new-buffer " sendmail temp"))
617 (case-fold-search nil)
bfc77306 618 resend-to-addresses
20a8832d 619 delimline
00365e98 620 fcc-was-found
8d0cab57 621 (mailbuf (current-buffer))
1d6af2e5
KH
622 (sendmail-coding-system
623 (if (local-variable-p 'buffer-file-coding-system)
624 buffer-file-coding-system
625 (or sendmail-coding-system
a92db45a
KH
626 default-buffer-file-coding-system
627 'iso-latin-1))))
5e7e990e
KH
628 (if (fboundp select-safe-coding-system-function)
629 (setq sendmail-coding-system
630 (funcall select-safe-coding-system-function
631 (point-min) (point-max) sendmail-coding-system)))
20a8832d
RS
632 (unwind-protect
633 (save-excursion
634 (set-buffer tembuf)
635 (erase-buffer)
636 (insert-buffer-substring mailbuf)
637 (goto-char (point-max))
638 ;; require one newline at the end.
639 (or (= (preceding-char) ?\n)
640 (insert ?\n))
641 ;; Change header-delimiter to be what sendmail expects.
642 (goto-char (point-min))
643 (re-search-forward
644 (concat "^" (regexp-quote mail-header-separator) "\n"))
645 (replace-match "\n")
646 (backward-char 1)
647 (setq delimline (point-marker))
1498db18 648 (sendmail-sync-aliases)
5ef9d627
RS
649 (if mail-aliases
650 (expand-mail-aliases (point-min) delimline))
20a8832d 651 (goto-char (point-min))
413d1aa2 652 ;; Ignore any blank lines in the header
20a8832d
RS
653 (while (and (re-search-forward "\n\n\n*" delimline t)
654 (< (point) delimline))
655 (replace-match "\n"))
413d1aa2 656 (goto-char (point-min))
20a8832d
RS
657 (let ((case-fold-search t))
658 (goto-char (point-min))
7e34da22 659 (while (re-search-forward "^Resent-\\(to\\|cc\\|bcc\\):" delimline t)
bfc77306
RS
660 (setq resend-to-addresses
661 (save-restriction
662 (narrow-to-region (point)
663 (save-excursion
cd47bdcc
KH
664 (forward-line 1)
665 (while (looking-at "^[ \t]")
666 (forward-line 1))
bfc77306
RS
667 (point)))
668 (append (mail-parse-comma-list)
7e34da22
KH
669 resend-to-addresses)))
670 ;; Delete Resent-BCC ourselves
671 (if (save-excursion (beginning-of-line)
672 (looking-at "resent-bcc"))
673 (delete-region (save-excursion (beginning-of-line) (point))
674 (save-excursion (end-of-line) (1+ (point))))))
53b0c109
RS
675;;; Apparently this causes a duplicate Sender.
676;;; ;; If the From is different than current user, insert Sender.
677;;; (goto-char (point-min))
678;;; (and (re-search-forward "^From:" delimline t)
679;;; (progn
680;;; (require 'mail-utils)
681;;; (not (string-equal
682;;; (mail-strip-quoted-names
683;;; (save-restriction
684;;; (narrow-to-region (point-min) delimline)
685;;; (mail-fetch-field "From")))
686;;; (user-login-name))))
687;;; (progn
688;;; (forward-line 1)
689;;; (insert "Sender: " (user-login-name) "\n")))
20a8832d
RS
690 ;; Don't send out a blank subject line
691 (goto-char (point-min))
66961910 692 (if (re-search-forward "^Subject:\\([ \t]*\n\\)+\\b" delimline t)
54115447
RS
693 (replace-match "")
694 ;; This one matches a Subject just before the header delimiter.
695 (if (and (re-search-forward "^Subject:\\([ \t]*\n\\)+" delimline t)
696 (= (match-end 0) delimline))
697 (replace-match "")))
ea9ceb34
KH
698 ;; Put the "From:" field in unless for some odd reason
699 ;; they put one in themselves.
700 (goto-char (point-min))
701 (if (not (re-search-forward "^From:" delimline t))
cbc9f037 702 (let* ((login user-mail-address)
0d15bc31
RS
703 (fullname (user-full-name))
704 (quote-fullname nil))
705 (if (string-match "[\200-\377]" fullname)
706 (setq fullname (mail-quote-printable fullname t)
707 quote-fullname t))
ea9ceb34 708 (cond ((eq mail-from-style 'angles)
7f1d5de2
RS
709 (insert "From: " fullname)
710 (let ((fullname-start (+ (point-min) 6))
711 (fullname-end (point-marker)))
712 (goto-char fullname-start)
713 ;; Look for a character that cannot appear unquoted
714 ;; according to RFC 822.
0d15bc31
RS
715 (if (or (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]"
716 fullname-end 1)
717 quote-fullname)
7f1d5de2
RS
718 (progn
719 ;; Quote fullname, escaping specials.
720 (goto-char fullname-start)
721 (insert "\"")
722 (while (re-search-forward "[\"\\]"
723 fullname-end 1)
724 (replace-match "\\\\\\&" t))
725 (insert "\""))))
726 (insert " <" login ">\n"))
ea9ceb34 727 ((eq mail-from-style 'parens)
7dad528a
RS
728 (insert "From: " login " (")
729 (let ((fullname-start (point)))
0d15bc31
RS
730 (if quote-fullname
731 (insert "\""))
7dad528a 732 (insert fullname)
0d15bc31
RS
733 (if quote-fullname
734 (insert "\""))
7dad528a
RS
735 (let ((fullname-end (point-marker)))
736 (goto-char fullname-start)
737 ;; RFC 822 says \ and nonmatching parentheses
738 ;; must be escaped in comments.
739 ;; Escape every instance of ()\ ...
740 (while (re-search-forward "[()\\]" fullname-end 1)
741 (replace-match "\\\\\\&" t))
742 ;; ... then undo escaping of matching parentheses,
743 ;; including matching nested parentheses.
744 (goto-char fullname-start)
745 (while (re-search-forward
746 "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"
747 fullname-end 1)
748 (replace-match "\\1(\\3)" t)
749 (goto-char fullname-start))))
7f1d5de2 750 (insert ")\n"))
ea9ceb34
KH
751 ((null mail-from-style)
752 (insert "From: " login "\n")))))
7c203051
RS
753 ;; Insert an extra newline if we need it to work around
754 ;; Sun's bug that swallows newlines.
755 (goto-char (1+ delimline))
756 (if (eval mail-mailer-swallows-blank-line)
757 (newline))
d6e000df
RS
758 ;; Find and handle any FCC fields.
759 (goto-char (point-min))
760 (if (re-search-forward "^FCC:" delimline t)
00365e98
RS
761 (progn
762 (setq fcc-was-found t)
763 (mail-do-fcc delimline)))
20a8832d
RS
764 (if mail-interactive
765 (save-excursion
766 (set-buffer errbuf)
767 (erase-buffer))))
00365e98
RS
768 (goto-char (point-min))
769 (if (let ((case-fold-search t))
770 (re-search-forward "^To:\\|^cc:\\|^bcc:\\|^resent-to:\
771\\|^resent-cc:\\|^resent-bcc:"
92976f67 772 delimline t))
ee0a4f29
KH
773 (let ((default-directory "/")
774 (coding-system-for-write sendmail-coding-system))
00365e98
RS
775 (apply 'call-process-region
776 (append (list (point-min) (point-max)
777 (if (boundp 'sendmail-program)
778 sendmail-program
779 "/usr/lib/sendmail")
780 nil errbuf nil "-oi")
781 ;; Always specify who from,
782 ;; since some systems have broken sendmails.
783 (list "-f" (user-login-name))
784 ;;; ;; Don't say "from root" if running under su.
785 ;;; (and (equal (user-real-login-name) "root")
786 ;;; (list "-f" (user-login-name)))
787 (and mail-alias-file
788 (list (concat "-oA" mail-alias-file)))
92976f67
EN
789 (if mail-interactive
790 ;; These mean "report errors to terminal"
791 ;; and "deliver interactively"
792 '("-oep" "-odi")
793 ;; These mean "report errors by mail"
794 ;; and "deliver in background".
795 '("-oem" "-odb"))
00365e98
RS
796 ;; Get the addresses from the message
797 ;; unless this is a resend.
798 ;; We must not do that for a resend
799 ;; because we would find the original addresses.
800 ;; For a resend, include the specific addresses.
801 (or resend-to-addresses
802 '("-t")))))
803 (or fcc-was-found
804 (error "No recipients")))
20a8832d
RS
805 (if mail-interactive
806 (save-excursion
807 (set-buffer errbuf)
808 (goto-char (point-min))
809 (while (re-search-forward "\n\n* *" nil t)
810 (replace-match "; "))
811 (if (not (zerop (buffer-size)))
812 (error "Sending...failed to %s"
813 (buffer-substring (point-min) (point-max)))))))
814 (kill-buffer tembuf)
815 (if (bufferp errbuf)
816 (kill-buffer errbuf)))))
817
818(defun mail-do-fcc (header-end)
819 (let (fcc-list
820 (rmailbuf (current-buffer))
facb137b 821 (time (current-time))
20a8832d
RS
822 (tembuf (generate-new-buffer " rmail output"))
823 (case-fold-search t))
824 (save-excursion
825 (goto-char (point-min))
826 (while (re-search-forward "^FCC:[ \t]*" header-end t)
827 (setq fcc-list (cons (buffer-substring (point)
828 (progn
829 (end-of-line)
830 (skip-chars-backward " \t")
831 (point)))
832 fcc-list))
833 (delete-region (match-beginning 0)
834 (progn (forward-line 1) (point))))
835 (set-buffer tembuf)
836 (erase-buffer)
fc23ca96
RS
837 ;; This initial newline is written out if the fcc file already exists.
838 (insert "\nFrom " (user-login-name) " "
facb137b 839 (current-time-string time) "\n")
847f73fd
RS
840 ;; Insert the time zone before the year.
841 (forward-char -1)
842 (forward-word -1)
f3098917
RS
843 (require 'mail-utils)
844 (insert (mail-rfc822-time-zone time) " ")
847f73fd 845 (goto-char (point-max))
20a8832d
RS
846 (insert-buffer-substring rmailbuf)
847 ;; Make sure messages are separated.
848 (goto-char (point-max))
849 (insert ?\n)
850 (goto-char 2)
851 ;; ``Quote'' "^From " as ">From "
852 ;; (note that this isn't really quoting, as there is no requirement
853 ;; that "^[>]+From " be quoted in the same transparent way.)
854 (let ((case-fold-search nil))
855 (while (search-forward "\nFrom " nil t)
856 (forward-char -5)
857 (insert ?>)))
858 (while fcc-list
89901917 859 (let* ((buffer (find-buffer-visiting (car fcc-list)))
3a3ffba4 860 (curbuf (current-buffer))
0d15bc31
RS
861 dont-write-the-file
862 buffer-matches-file
3a3ffba4
RS
863 (beg (point-min)) (end (point-max))
864 (beg2 (save-excursion (goto-char (point-min))
865 (forward-line 2) (point))))
20a8832d
RS
866 (if buffer
867 ;; File is present in a buffer => append to that buffer.
d6642dff
RS
868 (save-excursion
869 (set-buffer buffer)
0d15bc31
RS
870 (setq buffer-matches-file
871 (and (not (buffer-modified-p))
205d354f 872 (verify-visited-file-modtime buffer)))
d6642dff
RS
873 ;; Keep the end of the accessible portion at the same place
874 ;; unless it is the end of the buffer.
875 (let ((max (if (/= (1+ (buffer-size)) (point-max))
876 (point-max))))
877 (unwind-protect
878 ;; Code below lifted from rmailout.el
879 ;; function rmail-output-to-rmail-file:
880 (let ((buffer-read-only nil)
881 (msg (and (boundp 'rmail-current-message)
882 rmail-current-message)))
883 ;; If MSG is non-nil, buffer is in RMAIL mode.
884 (if msg
885 (progn
886 (rmail-maybe-set-message-counters)
887 (widen)
888 (narrow-to-region (point-max) (point-max))
889 (insert "\C-l\n0, unseen,,\n*** EOOH ***\n"
d6642dff
RS
890 "Date: " (mail-rfc822-date) "\n")
891 (insert-buffer-substring curbuf beg2 end)
892 (insert "\n\C-_")
893 (goto-char (point-min))
894 (widen)
895 (search-backward "\n\^_")
896 (narrow-to-region (point) (point-max))
897 (rmail-count-new-messages t)
898 (rmail-show-message msg)
899 (setq max nil))
900 ;; Output file not in rmail mode
901 ;; => just insert at the end.
902 (narrow-to-region (point-min) (1+ (buffer-size)))
903 (goto-char (point-max))
0d15bc31
RS
904 (insert-buffer-substring curbuf beg end))
905 (or buffer-matches-file
906 (progn
907 (if (y-or-n-p (format "Save file %s? "
908 (car fcc-list)))
909 (save-buffer))
910 (setq dont-write-the-file t))))
911 (if max (narrow-to-region (point-min) max))))))
912 ;; Append to the file directly,
913 ;; unless we've already taken care of it.
f6f4d690
KH
914 (unless dont-write-the-file
915 (if (and (file-exists-p (car fcc-list))
916 (mail-file-babyl-p (car fcc-list)))
917 ;; If the file is a Babyl file,
918 ;; convert the message to Babyl format.
919 (let ((coding-system-for-write
920 (or rmail-file-coding-system
921 'emacs-mule)))
922 (save-excursion
923 (set-buffer (get-buffer-create " mail-temp"))
924 (setq buffer-read-only nil)
925 (erase-buffer)
926 (insert "\C-l\n0, unseen,,\n*** EOOH ***\n"
927 "Date: " (mail-rfc822-date) "\n")
928 (insert-buffer-substring curbuf beg2 end)
929 (insert "\n\C-_")
930 (write-region (point-min) (point-max) (car fcc-list) t)
931 (erase-buffer)))
932 (write-region
933 (1+ (point-min)) (point-max) (car fcc-list) t)))
0d15bc31
RS
934 (and buffer (not dont-write-the-file)
935 (with-current-buffer buffer
936 (set-visited-file-modtime))))
20a8832d
RS
937 (setq fcc-list (cdr fcc-list))))
938 (kill-buffer tembuf)))
939
940(defun mail-sent-via ()
941 "Make a Sent-via header line from each To or CC header line."
942 (interactive)
943 (save-excursion
944 (goto-char (point-min))
945 ;; find the header-separator
946 (search-forward (concat "\n" mail-header-separator "\n"))
947 (forward-line -1)
948 ;; put a marker at the end of the header
949 (let ((end (point-marker))
950 (case-fold-search t)
951 to-line)
952 (goto-char (point-min))
953 ;; search for the To: lines and make Sent-via: lines from them
954 ;; search for the next To: line
955 (while (re-search-forward "^\\(to\\|cc\\):" end t)
956 ;; Grab this line plus all its continuations, sans the `to:'.
957 (let ((to-line
958 (buffer-substring (point)
959 (progn
960 (if (re-search-forward "^[^ \t\n]" end t)
961 (backward-char 1)
962 (goto-char end))
963 (point)))))
964 ;; Insert a copy, with altered header field name.
965 (insert-before-markers "Sent-via:" to-line))))))
966\f
967(defun mail-to ()
968 "Move point to end of To-field."
969 (interactive)
970 (expand-abbrev)
971 (mail-position-on-field "To"))
972
973(defun mail-subject ()
974 "Move point to end of Subject-field."
975 (interactive)
976 (expand-abbrev)
977 (mail-position-on-field "Subject"))
978
979(defun mail-cc ()
980 "Move point to end of CC-field. Create a CC field if none."
981 (interactive)
982 (expand-abbrev)
983 (or (mail-position-on-field "cc" t)
984 (progn (mail-position-on-field "to")
985 (insert "\nCC: "))))
986
987(defun mail-bcc ()
988 "Move point to end of BCC-field. Create a BCC field if none."
989 (interactive)
990 (expand-abbrev)
991 (or (mail-position-on-field "bcc" t)
992 (progn (mail-position-on-field "to")
993 (insert "\nBCC: "))))
994
5a31c2d2 995(defun mail-fcc (folder)
70ee42f7 996 "Add a new FCC field, with file name completion."
5a31c2d2 997 (interactive "FFolder carbon copy: ")
70ee42f7
JB
998 (expand-abbrev)
999 (or (mail-position-on-field "fcc" t) ;Put new field after exiting FCC.
1000 (mail-position-on-field "to"))
5a31c2d2 1001 (insert "\nFCC: " folder))
70ee42f7 1002
3a3ffba4
RS
1003(defun mail-reply-to ()
1004 "Move point to end of Reply-To-field."
1005 (interactive)
1006 (expand-abbrev)
1007 (mail-position-on-field "Reply-To"))
1008
20a8832d
RS
1009(defun mail-position-on-field (field &optional soft)
1010 (let (end
1011 (case-fold-search t))
1012 (goto-char (point-min))
5313d5f1 1013 (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
20a8832d
RS
1014 (setq end (match-beginning 0))
1015 (goto-char (point-min))
1016 (if (re-search-forward (concat "^" (regexp-quote field) ":") end t)
1017 (progn
1018 (re-search-forward "^[^ \t]" nil 'move)
1019 (beginning-of-line)
1020 (skip-chars-backward "\n")
1021 t)
1022 (or soft
1023 (progn (goto-char end)
08564963
JB
1024 (insert field ": \n")
1025 (skip-chars-backward "\n")))
20a8832d
RS
1026 nil)))
1027
1028(defun mail-text ()
330e9e11 1029 "Move point to beginning of message text."
20a8832d 1030 (interactive)
e3b671fc 1031 (expand-abbrev)
20a8832d
RS
1032 (goto-char (point-min))
1033 (search-forward (concat "\n" mail-header-separator "\n")))
1034\f
0d021ccf 1035(defun mail-signature (atpoint)
4ac2e032 1036 "Sign letter with contents of the file `mail-signature-file'.
e4f794ed 1037Prefix arg means put contents at point."
0d021ccf 1038 (interactive "P")
20a8832d 1039 (save-excursion
0d021ccf
ER
1040 (or atpoint
1041 (goto-char (point-max)))
20a8832d
RS
1042 (skip-chars-backward " \t\n")
1043 (end-of-line)
0d021ccf
ER
1044 (or atpoint
1045 (delete-region (point) (point-max)))
de3a72f6 1046 (insert "\n\n-- \n")
4ac2e032 1047 (insert-file-contents (expand-file-name mail-signature-file))))
20a8832d
RS
1048
1049(defun mail-fill-yanked-message (&optional justifyp)
1050 "Fill the paragraphs of a message yanked into this one.
1051Numeric argument means justify as well."
1052 (interactive "P")
1053 (save-excursion
1054 (goto-char (point-min))
1055 (search-forward (concat "\n" mail-header-separator "\n") nil t)
1056 (fill-individual-paragraphs (point)
1057 (point-max)
1058 justifyp
1059 t)))
1060
374bda6b 1061(defun mail-indent-citation ()
1c24b04a
RS
1062 "Modify text just inserted from a message to be cited.
1063The inserted text should be the region.
1064When this function returns, the region is again around the modified text.
1065
1066Normally, indent each nonblank line `mail-indentation-spaces' spaces.
1067However, if `mail-yank-prefix' is non-nil, insert that prefix on each line."
374bda6b 1068 (mail-yank-clear-headers (region-beginning) (region-end))
e39e74c0 1069 (if (null mail-yank-prefix)
374bda6b
RS
1070 (indent-rigidly (region-beginning) (region-end)
1071 mail-indentation-spaces)
e39e74c0 1072 (save-excursion
374bda6b
RS
1073 (let ((end (set-marker (make-marker) (region-end))))
1074 (goto-char (region-beginning))
1075 (while (< (point) end)
1076 (insert mail-yank-prefix)
1077 (forward-line 1))))))
1c24b04a 1078
20a8832d
RS
1079(defun mail-yank-original (arg)
1080 "Insert the message being replied to, if any (in rmail).
26adca1b 1081Puts point after the text and mark before.
20a8832d
RS
1082Normally, indents each nonblank line ARG spaces (default 3).
1083However, if `mail-yank-prefix' is non-nil, insert that prefix on each line.
1084
1085Just \\[universal-argument] as argument means don't indent, insert no prefix,
1086and don't delete any header fields."
1087 (interactive "P")
c8553837
RS
1088 (if mail-reply-action
1089 (let ((start (point))
1090 (original mail-reply-action))
1091 (and (consp original) (eq (car original) 'insert-buffer)
1092 (setq original (nth 1 original)))
1093 (if (consp original)
1094 (apply (car original) (cdr original))
1095 ;; If the original message is in another window in the same frame,
1096 ;; delete that window to save screen space.
1097 ;; t means don't alter other frames.
1098 (delete-windows-on original t)
1099 (insert-buffer original))
20a8832d
RS
1100 (if (consp arg)
1101 nil
1c24b04a
RS
1102 (goto-char start)
1103 (let ((mail-indentation-spaces (if arg (prefix-numeric-value arg)
ac9f0310
RS
1104 mail-indentation-spaces))
1105 (mark-even-if-inactive t))
015c5c55
RS
1106 (if mail-citation-hook
1107 (run-hooks 'mail-citation-hook)
fa24a822
RS
1108 (if mail-yank-hooks
1109 (run-hooks 'mail-yank-hooks)
374bda6b 1110 (mail-indent-citation)))))
3c280f48
RS
1111 ;; This is like exchange-point-and-mark, but doesn't activate the mark.
1112 ;; It is cleaner to avoid activation, even though the command
1113 ;; loop would deactivate the mark because we inserted text.
1114 (goto-char (prog1 (mark t)
1115 (set-marker (mark-marker) (point) (current-buffer))))
20a8832d
RS
1116 (if (not (eolp)) (insert ?\n)))))
1117
1118(defun mail-yank-clear-headers (start end)
e39e74c0
RS
1119 (if (< end start)
1120 (let (temp)
1121 (setq temp start start end end temp)))
2b3a206d
RS
1122 (if mail-yank-ignored-headers
1123 (save-excursion
1124 (goto-char start)
1125 (if (search-forward "\n\n" end t)
1126 (save-restriction
1127 (narrow-to-region start (point))
1128 (goto-char start)
1129 (while (let ((case-fold-search t))
1130 (re-search-forward mail-yank-ignored-headers nil t))
1131 (beginning-of-line)
1132 (delete-region (point)
1133 (progn (re-search-forward "\n[^ \t]")
1134 (forward-char -1)
1135 (point)))))))))
e39e74c0
RS
1136
1137(defun mail-yank-region (arg)
1138 "Insert the selected region from the message being replied to.
1139Puts point after the text and mark before.
1140Normally, indents each nonblank line ARG spaces (default 3).
1141However, if `mail-yank-prefix' is non-nil, insert that prefix on each line.
1142
1143Just \\[universal-argument] as argument means don't indent, insert no prefix,
1144and don't delete any header fields."
1145 (interactive "P")
1146 (and (consp mail-reply-action)
1147 (eq (car mail-reply-action) 'insert-buffer)
1148 (let ((buffer (nth 1 mail-reply-action))
1149 (start (point)))
1150 ;; Insert the citation text.
1151 (insert (with-current-buffer buffer
1152 (buffer-substring (point) (mark))))
1153 (push-mark start)
1154 ;; Indent or otherwise annotate the citation text.
1155 (if (consp arg)
1156 nil
1157 (let ((mail-indentation-spaces (if arg (prefix-numeric-value arg)
1158 mail-indentation-spaces)))
1159 (if mail-citation-hook
1160 (run-hooks 'mail-citation-hook)
1161 (if mail-yank-hooks
1162 (run-hooks 'mail-yank-hooks)
374bda6b 1163 (mail-indent-citation))))))))
20a8832d 1164\f
f0aef6bf
RS
1165(defun mail-attach-file (&optional file)
1166 "Insert a file at the end of the buffer, with separator lines around it."
1167 (interactive "fAttach file: ")
1168 (save-excursion
1169 (goto-char (point-max))
1170 (or (bolp) (newline))
1171 (newline)
1172 (let ((start (point))
1173 middle)
1174 (insert (format "===File %s===" file))
1175 (insert-char ?= (max 0 (- 60 (current-column))))
1176 (newline)
1177 (setq middle (point))
1178 (insert "============================================================\n")
1179 (push-mark)
1180 (goto-char middle)
1181 (insert-file-contents file)
1182 (or (bolp) (newline))
1183 (goto-char start))))
1184\f
699adcb2
RS
1185;; Put these commands last, to reduce chance of lossage from quitting
1186;; in middle of loading the file.
1187
1188;;;###autoload (add-hook 'same-window-buffer-names "*mail*")
20a8832d
RS
1189
1190;;;###autoload
1191(defun mail (&optional noerase to subject in-reply-to cc replybuffer actions)
e635fdf0
RS
1192 "Edit a message to be sent. Prefix arg means resume editing (don't erase).
1193When this function returns, the buffer `*mail*' is selected.
1194The value is t if the message was newly initialized; otherwise, nil.
20a8832d 1195
4ac2e032
RS
1196Optionally, the signature file `mail-signature-file' can be inserted at the
1197end; see the variable `mail-signature'.
20a8832d
RS
1198
1199\\<mail-mode-map>
1200While editing message, type \\[mail-send-and-exit] to send the message and exit.
1201
1202Various special commands starting with C-c are available in sendmail mode
1203to move to message header fields:
1204\\{mail-mode-map}
1205
1206If `mail-self-blind' is non-nil, a BCC to yourself is inserted
1207when the message is initialized.
1208
1209If `mail-default-reply-to' is non-nil, it should be an address (a string);
1210a Reply-to: field with that address is inserted.
1211
1212If `mail-archive-file-name' is non-nil, an FCC field with that file name
1213is inserted.
1214
8b262cbc
KH
1215The normal hook `mail-setup-hook' is run after the message is
1216initialized. It can add more default fields to the message.
20a8832d 1217
dfdac213
RS
1218When calling from a program, the first argument if non-nil says
1219not to erase the existing contents of the `*mail*' buffer.
1220
1221The second through fifth arguments,
1222 TO, SUBJECT, IN-REPLY-TO and CC, specify if non-nil
20a8832d
RS
1223 the initial contents of those header fields.
1224 These arguments should not have final newlines.
c8553837
RS
1225The sixth argument REPLYBUFFER is a buffer which contains an
1226 original message being replied to, or else an action
1227 of the form (FUNCTION . ARGS) which says how to insert the original.
1228 Or it can be nil, if not replying to anything.
20a8832d
RS
1229The seventh argument ACTIONS is a list of actions to take
1230 if/when the message is sent. Each action looks like (FUNCTION . ARGS);
1231 when the message is sent, we apply FUNCTION to ARGS.
1232 This is how Rmail arranges to mark messages `answered'."
1233 (interactive "P")
e635fdf0
RS
1234;;; This is commented out because I found it was confusing in practice.
1235;;; It is easy enough to rename *mail* by hand with rename-buffer
1236;;; if you want to have multiple mail buffers.
1237;;; And then you can control which messages to save. --rms.
1238;;; (let ((index 1)
1239;;; buffer)
1240;;; ;; If requested, look for a mail buffer that is modified and go to it.
1241;;; (if noerase
1242;;; (progn
1243;;; (while (and (setq buffer
1244;;; (get-buffer (if (= 1 index) "*mail*"
1245;;; (format "*mail*<%d>" index))))
1246;;; (not (buffer-modified-p buffer)))
1247;;; (setq index (1+ index)))
1248;;; (if buffer (switch-to-buffer buffer)
1249;;; ;; If none exists, start a new message.
1250;;; ;; This will never re-use an existing unmodified mail buffer
1251;;; ;; (since index is not 1 anymore). Perhaps it should.
1252;;; (setq noerase nil))))
1253;;; ;; Unless we found a modified message and are happy, start a new message.
1254;;; (if (not noerase)
1255;;; (progn
1256;;; ;; Look for existing unmodified mail buffer.
1257;;; (while (and (setq buffer
1258;;; (get-buffer (if (= 1 index) "*mail*"
1259;;; (format "*mail*<%d>" index))))
1260;;; (buffer-modified-p buffer))
1261;;; (setq index (1+ index)))
1262;;; ;; If none, make a new one.
1263;;; (or buffer
1264;;; (setq buffer (generate-new-buffer "*mail*")))
1265;;; ;; Go there and initialize it.
1266;;; (switch-to-buffer buffer)
1267;;; (erase-buffer)
1268;;; (setq default-directory (expand-file-name "~/"))
1269;;; (auto-save-mode auto-save-default)
1270;;; (mail-mode)
1271;;; (mail-setup to subject in-reply-to cc replybuffer actions)
1272;;; (if (and buffer-auto-save-file-name
1273;;; (file-exists-p buffer-auto-save-file-name))
1274;;; (message "Auto save file for draft message exists; consider M-x mail-recover"))
1275;;; t))
67a6988b 1276 (pop-to-buffer "*mail*")
321eb232
RS
1277 ;; Put the auto-save file in the home dir
1278 ;; to avoid any danger that it can't be written.
3943fa09
RS
1279 (if (file-exists-p (expand-file-name "~/"))
1280 (setq default-directory (expand-file-name "~/")))
1281 (auto-save-mode auto-save-default)
e635fdf0 1282 (mail-mode)
3b112b5e
MB
1283 ;; Disconnect the buffer from its visited file
1284 ;; (in case the user has actually visited a file *mail*).
e4fbad4b 1285; (set-visited-file-name nil)
e635fdf0
RS
1286 (let (initialized)
1287 (and (not noerase)
5e32e119
RS
1288 (if buffer-file-name
1289 (if (buffer-modified-p)
1290 (when (y-or-n-p "Buffer has unsaved changes; reinitialize it and discard them? ")
1291 (if (y-or-n-p "Disconnect buffer from visited file? ")
1292 (set-visited-file-name nil))
1293 t)
1294 (when (y-or-n-p "Reinitialize buffer, and disconnect it from the visited file? ")
1295 (set-visited-file-name nil)
1296 t))
1297 ;; A non-file-visiting buffer.
1298 (if (buffer-modified-p)
1299 (y-or-n-p "Unsent message being composed; erase it? ")
1300 t))
6737ae74
RS
1301 (let ((inhibit-read-only t))
1302 (erase-buffer)
1303 (mail-setup to subject in-reply-to cc replybuffer actions)
1304 (setq initialized t)))
e635fdf0
RS
1305 (if (and buffer-auto-save-file-name
1306 (file-exists-p buffer-auto-save-file-name))
1307 (message "Auto save file for draft message exists; consider M-x mail-recover"))
1308 initialized))
20a8832d
RS
1309
1310(defun mail-recover ()
1311 "Reread contents of current buffer from its last auto-save file."
1312 (interactive)
1313 (let ((file-name (make-auto-save-file-name)))
1314 (cond ((save-window-excursion
1315 (if (not (eq system-type 'vax-vms))
1316 (with-output-to-temp-buffer "*Directory*"
1317 (buffer-disable-undo standard-output)
dc8cec25
KH
1318 (let ((default-directory "/"))
1319 (call-process
1320 "ls" nil standard-output nil "-l" file-name))))
20a8832d
RS
1321 (yes-or-no-p (format "Recover auto save file %s? " file-name)))
1322 (let ((buffer-read-only nil))
1323 (erase-buffer)
1324 (insert-file-contents file-name nil)))
3b112b5e 1325 (t (error "mail-recover cancelled")))))
20a8832d
RS
1326
1327;;;###autoload
1328(defun mail-other-window (&optional noerase to subject in-reply-to cc replybuffer sendactions)
1329 "Like `mail' command, but display mail buffer in another window."
1330 (interactive "P")
67a6988b
RS
1331 (let ((pop-up-windows t)
1332 (special-display-buffer-names nil)
1333 (special-display-regexps nil)
1334 (same-window-buffer-names nil)
1335 (same-window-regexps nil))
20a8832d
RS
1336 (pop-to-buffer "*mail*"))
1337 (mail noerase to subject in-reply-to cc replybuffer sendactions))
1338
1339;;;###autoload
0cc89026
JB
1340(defun mail-other-frame (&optional noerase to subject in-reply-to cc replybuffer sendactions)
1341 "Like `mail' command, but display mail buffer in another frame."
20a8832d 1342 (interactive "P")
67a6988b
RS
1343 (let ((pop-up-frames t)
1344 (special-display-buffer-names nil)
1345 (special-display-regexps nil)
1346 (same-window-buffer-names nil)
1347 (same-window-regexps nil))
20a8832d
RS
1348 (pop-to-buffer "*mail*"))
1349 (mail noerase to subject in-reply-to cc replybuffer sendactions))
1350
20a8832d 1351;;; Do not add anything but external entries on this page.
49116ac0
JB
1352
1353(provide 'sendmail)
1354
c88ab9ce 1355;;; sendmail.el ends here