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