Mercurial > emacs
comparison lisp/mail/sendmail.el @ 88155:d7ddb3e565de
sync with trunk
author | Henrik Enberg <henrik.enberg@telia.com> |
---|---|
date | Mon, 16 Jan 2006 00:03:54 +0000 |
parents | 0d8b17d428b5 |
children |
comparison
equal
deleted
inserted
replaced
88154:8ce476d3ba36 | 88155:d7ddb3e565de |
---|---|
1 ;;; sendmail.el --- mail sending commands for Emacs. -*- byte-compile-dynamic: t -*- | 1 ;;; sendmail.el --- mail sending commands for Emacs. -*- byte-compile-dynamic: t -*- |
2 | 2 |
3 ;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 98, 2000, 2001, 2002, 2003 | 3 ;; Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995, 1996, 1998, 2000, |
4 ;; Free Software Foundation, Inc. | 4 ;; 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. |
5 | 5 |
6 ;; Maintainer: FSF | 6 ;; Maintainer: FSF |
7 ;; Keywords: mail | 7 ;; Keywords: mail |
8 | 8 |
9 ;; This file is part of GNU Emacs. | 9 ;; This file is part of GNU Emacs. |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
19 ;; GNU General Public License for more details. | 19 ;; GNU General Public License for more details. |
20 | 20 |
21 ;; You should have received a copy of the GNU General Public License | 21 ;; You should have received a copy of the GNU General Public License |
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the | 22 ;; along with GNU Emacs; see the file COPYING. If not, write to the |
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | 23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
24 ;; Boston, MA 02111-1307, USA. | 24 ;; Boston, MA 02110-1301, USA. |
25 | 25 |
26 ;;; Commentary: | 26 ;;; Commentary: |
27 | 27 |
28 ;; This mode provides mail-sending facilities from within Emacs. It is | 28 ;; This mode provides mail-sending facilities from within Emacs. It is |
29 ;; documented in the Emacs user's manual. | 29 ;; documented in the Emacs user's manual. |
40 (defgroup sendmail nil | 40 (defgroup sendmail nil |
41 "Mail sending commands for Emacs." | 41 "Mail sending commands for Emacs." |
42 :prefix "mail-" | 42 :prefix "mail-" |
43 :group 'mail) | 43 :group 'mail) |
44 | 44 |
45 ;;;###autoload | 45 (defcustom mail-setup-with-from t |
46 (defcustom mail-from-style 'angles "\ | 46 "Non-nil means insert `From:' field when setting up the message." |
47 *Specifies how \"From:\" fields look. | 47 :type 'boolean |
48 :group 'sendmail | |
49 :version "22.1") | |
50 | |
51 ;;;###autoload | |
52 (defcustom mail-from-style 'angles | |
53 "Specifies how \"From:\" fields look. | |
48 | 54 |
49 If `nil', they contain just the return address like: | 55 If `nil', they contain just the return address like: |
50 king@grassland.com | 56 king@grassland.com |
51 If `parens', they look like: | 57 If `parens', they look like: |
52 king@grassland.com (Elvis Parsley) | 58 king@grassland.com (Elvis Parsley) |
64 :version "20.3" | 70 :version "20.3" |
65 :group 'sendmail) | 71 :group 'sendmail) |
66 | 72 |
67 ;;;###autoload | 73 ;;;###autoload |
68 (defcustom mail-specify-envelope-from nil | 74 (defcustom mail-specify-envelope-from nil |
69 "*If non-nil, specify the envelope-from address when sending mail. | 75 "If non-nil, specify the envelope-from address when sending mail. |
70 The value used to specify it is whatever is found in | 76 The value used to specify it is whatever is found in |
71 `mail-envelope-from', with `user-mail-address' as fallback. | 77 the variable `mail-envelope-from', with `user-mail-address' as fallback. |
72 | 78 |
73 On most systems, specifying the envelope-from address | 79 On most systems, specifying the envelope-from address is a |
74 is a privileged operation." | 80 privileged operation. This variable affects sendmail and |
81 smtpmail -- if you use feedmail to send mail, see instead the | |
82 variable `feedmail-deduce-envelope-from'." | |
75 :version "21.1" | 83 :version "21.1" |
76 :type 'boolean | 84 :type 'boolean |
77 :group 'sendmail) | 85 :group 'sendmail) |
78 | 86 |
79 (defcustom mail-envelope-from nil | 87 (defcustom mail-envelope-from nil |
80 "*If non-nil, designate the envelope-from address when sending mail. | 88 "If non-nil, designate the envelope-from address when sending mail. |
81 If this is nil while `mail-specify-envelope-from' is non-nil, the | 89 This only has an effect if `mail-specify-envelope-from' is non-nil. |
82 content of `user-mail-address' is used." | 90 The value should be either a string, or the symbol `header' (in |
91 which case the contents of the \"From\" header of the message | |
92 being sent is used), or nil (in which case the value of | |
93 `user-mail-address' is used)." | |
83 :version "21.1" | 94 :version "21.1" |
84 :type '(choice (string :tag "From-name") | 95 :type '(choice (string :tag "From-name") |
85 (const :tag "Use From: header from message" header) | 96 (const :tag "Use From: header from message" header) |
86 (const :tag "Use `user-mail-address'" nil)) | 97 (const :tag "Use `user-mail-address'" nil)) |
87 :group 'sendmail) | 98 :group 'sendmail) |
88 | 99 |
89 ;;;###autoload | 100 ;;;###autoload |
90 (defcustom mail-self-blind nil "\ | 101 (defcustom mail-self-blind nil |
91 *Non-nil means insert BCC to self in messages to be sent. | 102 "Non-nil means insert BCC to self in messages to be sent. |
92 This is done when the message is initialized, | 103 This is done when the message is initialized, |
93 so you can remove or alter the BCC field to override the default." | 104 so you can remove or alter the BCC field to override the default." |
94 :type 'boolean | 105 :type 'boolean |
95 :group 'sendmail) | 106 :group 'sendmail) |
96 | 107 |
97 ;;;###autoload | 108 ;;;###autoload |
98 (defcustom mail-interactive nil "\ | 109 (defcustom mail-interactive nil |
99 *Non-nil means when sending a message wait for and display errors. | 110 "Non-nil means when sending a message wait for and display errors. |
100 nil means let mailer mail back a message to report errors." | 111 nil means let mailer mail back a message to report errors." |
101 :type 'boolean | 112 :type 'boolean |
102 :group 'sendmail) | 113 :group 'sendmail) |
103 | 114 |
104 ;;;###autoload | 115 (defcustom mail-yank-ignored-headers |
105 (defcustom mail-yank-ignored-headers "^via:\\|^mail-from:\\|^origin:\\|^status:\\|^remailed\\|^received:\\|^message-id:\\|^summary-line:\\|^to:\\|^subject:\\|^in-reply-to:\\|^return-path:" "\ | 116 (concat "^" |
106 *Delete these headers from old message when it's inserted in a reply." | 117 (regexp-opt '("via" "mail-from" "origin" "status" "remailed" |
118 "received" "message-id" "summary-line" "to" "subject" | |
119 "in-reply-to" "return-path" "mail-reply-to" | |
120 "mail-followup-to") "\\(?:") | |
121 ":") | |
122 "Delete these headers from old message when it's inserted in a reply." | |
107 :type 'regexp | 123 :type 'regexp |
108 :group 'sendmail) | 124 :group 'sendmail) |
109 | 125 |
126 ;; Prevent problems with `window-system' not having the correct value | |
127 ;; when loaddefs.el is loaded. `custom-reevaluate-setting' needs the | |
128 ;; standard value. | |
129 ;;;###autoload | |
130 (put 'send-mail-function 'standard-value | |
131 '((if (and window-system (memq system-type '(darwin windows-nt))) | |
132 'mailclient-send-it | |
133 'sendmail-send-it))) | |
134 | |
110 ;; Useful to set in site-init.el | 135 ;; Useful to set in site-init.el |
111 ;;;###autoload | 136 ;;;###autoload |
112 (defcustom send-mail-function 'sendmail-send-it | 137 (defcustom send-mail-function |
138 (if (and window-system (memq system-type '(darwin windows-nt))) | |
139 'mailclient-send-it | |
140 'sendmail-send-it) | |
113 "Function to call to send the current buffer as mail. | 141 "Function to call to send the current buffer as mail. |
114 The headers should be delimited by a line which is | 142 The headers should be delimited by a line which is |
115 not a valid RFC822 header or continuation line, | 143 not a valid RFC822 header or continuation line, |
116 that matches the variable `mail-header-separator'. | 144 that matches the variable `mail-header-separator'. |
117 This is used by the default mail-sending commands. See also | 145 This is used by the default mail-sending commands. See also |
118 `message-send-mail-function' for use with the Message package." | 146 `message-send-mail-function' for use with the Message package." |
119 :type '(radio (function-item sendmail-send-it :tag "Use Sendmail package") | 147 :type '(radio (function-item sendmail-send-it :tag "Use Sendmail package") |
120 (function-item smtpmail-send-it :tag "Use SMTPmail package") | 148 (function-item smtpmail-send-it :tag "Use SMTPmail package") |
121 (function-item feedmail-send-it :tag "Use Feedmail package") | 149 (function-item feedmail-send-it :tag "Use Feedmail package") |
150 (function-item mailclient-send-it :tag "Use Mailclient package") | |
122 function) | 151 function) |
123 :group 'sendmail) | 152 :group 'sendmail) |
124 | 153 |
125 ;;;###autoload | 154 ;;;###autoload |
126 (defcustom mail-header-separator "--text follows this line--" "\ | 155 (defcustom mail-header-separator "--text follows this line--" |
127 *Line used to separate headers from text in messages being composed." | 156 "Line used to separate headers from text in messages being composed." |
128 :type 'string | 157 :type 'string |
129 :group 'sendmail) | 158 :group 'sendmail) |
130 | 159 |
131 ;; Set up mail-header-separator for use as a category text property. | 160 ;; Set up mail-header-separator for use as a category text property. |
132 (put 'mail-header-separator 'rear-nonsticky '(category)) | 161 (put 'mail-header-separator 'rear-nonsticky '(category)) |
133 ;;; This was a nice idea, for preventing accidental modification of | 162 ;; This was a nice idea, for preventing accidental modification of |
134 ;;; the separator. But I found it also prevented or obstructed | 163 ;; the separator. But I found it also prevented or obstructed |
135 ;;; certain deliberate operations, such as copying the separator line | 164 ;; certain deliberate operations, such as copying the separator line |
136 ;;; up to the top to send myself a copy of an already sent outgoing message | 165 ;; up to the top to send myself a copy of an already sent outgoing message |
137 ;;; and other things. So I turned it off. --rms. | 166 ;; and other things. So I turned it off. --rms. |
138 ;;;(put 'mail-header-separator 'read-only t) | 167 ;;(put 'mail-header-separator 'read-only t) |
139 | 168 |
140 ;;;###autoload | 169 ;;;###autoload |
141 (defcustom mail-archive-file-name nil "\ | 170 (defcustom mail-archive-file-name nil |
142 *Name of file to write all outgoing messages in, or nil for none. | 171 "Name of file to write all outgoing messages in, or nil for none. |
143 This can be an inbox file or an Rmail file." | 172 This can be an inbox file or an Rmail file." |
144 :type '(choice file (const nil)) | 173 :type '(choice file (const nil)) |
145 :group 'sendmail) | 174 :group 'sendmail) |
146 | 175 |
147 ;;;###autoload | 176 ;;;###autoload |
148 (defcustom mail-default-reply-to nil | 177 (defcustom mail-default-reply-to nil |
149 "*Address to insert as default Reply-to field of outgoing messages. | 178 "Address to insert as default Reply-to field of outgoing messages. |
150 If nil, it will be initialized from the REPLYTO environment variable | 179 If nil, it will be initialized from the REPLYTO environment variable |
151 when you first send mail." | 180 when you first send mail." |
152 :type '(choice (const nil) string) | 181 :type '(choice (const nil) string) |
153 :group 'sendmail) | 182 :group 'sendmail) |
154 | 183 |
155 ;;;###autoload | 184 ;;;###autoload |
156 (defcustom mail-alias-file nil | 185 (defcustom mail-alias-file nil |
157 "*If non-nil, the name of a file to use instead of `/usr/lib/aliases'. | 186 "If non-nil, the name of a file to use instead of `/usr/lib/aliases'. |
158 This file defines aliases to be expanded by the mailer; this is a different | 187 This file defines aliases to be expanded by the mailer; this is a different |
159 feature from that of defining aliases in `.mailrc' to be expanded in Emacs. | 188 feature from that of defining aliases in `.mailrc' to be expanded in Emacs. |
160 This variable has no effect unless your system uses sendmail as its mailer." | 189 This variable has no effect unless your system uses sendmail as its mailer." |
161 :type '(choice (const nil) file) | 190 :type '(choice (const nil) file) |
162 :group 'sendmail) | 191 :group 'sendmail) |
163 | 192 |
164 ;;;###autoload | 193 ;;;###autoload |
165 (defcustom mail-personal-alias-file "~/.mailrc" | 194 (defcustom mail-personal-alias-file "~/.mailrc" |
166 "*If non-nil, the name of the user's personal mail alias file. | 195 "If non-nil, the name of the user's personal mail alias file. |
167 This file typically should be in same format as the `.mailrc' file used by | 196 This file typically should be in same format as the `.mailrc' file used by |
168 the `Mail' or `mailx' program. | 197 the `Mail' or `mailx' program. |
169 This file need not actually exist." | 198 This file need not actually exist." |
170 :type '(choice (const nil) file) | 199 :type '(choice (const nil) file) |
171 :group 'sendmail) | 200 :group 'sendmail) |
172 | 201 |
202 ;;;###autoload | |
173 (defcustom mail-setup-hook nil | 203 (defcustom mail-setup-hook nil |
174 "Normal hook, run each time a new outgoing mail message is initialized. | 204 "Normal hook, run each time a new outgoing mail message is initialized. |
175 The function `mail-setup' runs this hook." | 205 The function `mail-setup' runs this hook." |
176 :type 'hook | 206 :type 'hook |
177 :options '(fortune-to-signature spook mail-abbrevs-setup) | 207 :options '(fortune-to-signature spook mail-abbrevs-setup) |
178 :group 'sendmail) | 208 :group 'sendmail) |
179 | 209 |
210 ;;;###autoload | |
180 (defvar mail-aliases t | 211 (defvar mail-aliases t |
181 "Alist of mail address aliases, | 212 "Alist of mail address aliases, |
182 or t meaning should be initialized from your mail aliases file. | 213 or t meaning should be initialized from your mail aliases file. |
183 \(The file's name is normally `~/.mailrc', but your MAILRC environment | 214 \(The file's name is normally `~/.mailrc', but `mail-personal-alias-file' |
184 variable can override that name.) | 215 can specify a different file name.) |
185 The alias definitions in the file have this form: | 216 The alias definitions in the file have this form: |
186 alias ALIAS MEANING") | 217 alias ALIAS MEANING") |
187 | 218 |
188 (defvar mail-alias-modtime nil | 219 (defvar mail-alias-modtime nil |
189 "The modification time of your mail alias file when it was last examined.") | 220 "The modification time of your mail alias file when it was last examined.") |
190 | 221 |
222 ;;;###autoload | |
191 (defcustom mail-yank-prefix nil | 223 (defcustom mail-yank-prefix nil |
192 "*Prefix insert on lines of yanked message being replied to. | 224 "Prefix insert on lines of yanked message being replied to. |
193 nil means use indentation." | 225 nil means use indentation." |
194 :type '(choice (const nil) string) | 226 :type '(choice (const nil) string) |
195 :group 'sendmail) | 227 :group 'sendmail) |
196 | 228 |
229 ;;;###autoload | |
197 (defcustom mail-indentation-spaces 3 | 230 (defcustom mail-indentation-spaces 3 |
198 "*Number of spaces to insert at the beginning of each cited line. | 231 "Number of spaces to insert at the beginning of each cited line. |
199 Used by `mail-yank-original' via `mail-indent-citation'." | 232 Used by `mail-yank-original' via `mail-indent-citation'." |
200 :type 'integer | 233 :type 'integer |
201 :group 'sendmail) | 234 :group 'sendmail) |
235 | |
202 (defvar mail-yank-hooks nil | 236 (defvar mail-yank-hooks nil |
203 "Obsolete hook for modifying a citation just inserted in the mail buffer. | 237 "Obsolete hook for modifying a citation just inserted in the mail buffer. |
204 Each hook function can find the citation between (point) and (mark t). | 238 Each hook function can find the citation between (point) and (mark t). |
205 And each hook function should leave point and mark around the citation | 239 And each hook function should leave point and mark around the citation |
206 text as modified. | 240 text as modified. |
207 | 241 |
208 This is a normal hook, misnamed for historical reasons. | 242 This is a normal hook, misnamed for historical reasons. |
209 It is semi-obsolete and mail agents should no longer use it.") | 243 It is semi-obsolete and mail agents should no longer use it.") |
210 | 244 |
245 ;;;###autoload | |
211 (defcustom mail-citation-hook nil | 246 (defcustom mail-citation-hook nil |
212 "*Hook for modifying a citation just inserted in the mail buffer. | 247 "Hook for modifying a citation just inserted in the mail buffer. |
213 Each hook function can find the citation between (point) and (mark t), | 248 Each hook function can find the citation between (point) and (mark t), |
214 and should leave point and mark around the citation text as modified. | 249 and should leave point and mark around the citation text as modified. |
215 The hook functions can find the header of the cited message | 250 The hook functions can find the header of the cited message |
216 in the variable `mail-citation-header', whether or not this is included | 251 in the variable `mail-citation-header', whether or not this is included |
217 in the cited portion of the message. | 252 in the cited portion of the message. |
224 (defvar mail-citation-header nil | 259 (defvar mail-citation-header nil |
225 "While running `mail-citation-hook', this variable holds the message header. | 260 "While running `mail-citation-hook', this variable holds the message header. |
226 This enables the hook functions to see the whole message header | 261 This enables the hook functions to see the whole message header |
227 regardless of what part of it (if any) is included in the cited text.") | 262 regardless of what part of it (if any) is included in the cited text.") |
228 | 263 |
264 ;;;###autoload | |
229 (defcustom mail-citation-prefix-regexp "[ \t]*[-a-z0-9A-Z]*>+[ \t]*\\|[ \t]*" | 265 (defcustom mail-citation-prefix-regexp "[ \t]*[-a-z0-9A-Z]*>+[ \t]*\\|[ \t]*" |
230 "*Regular expression to match a citation prefix plus whitespace. | 266 "Regular expression to match a citation prefix plus whitespace. |
231 It should match whatever sort of citation prefixes you want to handle, | 267 It should match whatever sort of citation prefixes you want to handle, |
232 with whitespace before and after; it should also match just whitespace. | 268 with whitespace before and after; it should also match just whitespace. |
233 The default value matches citations like `foo-bar>' plus whitespace." | 269 The default value matches citations like `foo-bar>' plus whitespace." |
234 :type 'regexp | 270 :type 'regexp |
235 :group 'sendmail | 271 :group 'sendmail |
236 :version "20.3") | 272 :version "20.3") |
237 | 273 |
238 (defvar mail-abbrevs-loaded nil) | 274 (defvar mail-abbrevs-loaded nil) |
239 (defvar mail-mode-map nil) | 275 (defvar mail-mode-map |
276 (let ((map (make-sparse-keymap))) | |
277 (define-key map "\M-\t" 'mail-complete) | |
278 (define-key map "\C-c?" 'describe-mode) | |
279 (define-key map "\C-c\C-f\C-t" 'mail-to) | |
280 (define-key map "\C-c\C-f\C-b" 'mail-bcc) | |
281 (define-key map "\C-c\C-f\C-f" 'mail-fcc) | |
282 (define-key map "\C-c\C-f\C-c" 'mail-cc) | |
283 (define-key map "\C-c\C-f\C-s" 'mail-subject) | |
284 (define-key map "\C-c\C-f\C-r" 'mail-reply-to) | |
285 (define-key map "\C-c\C-f\C-a" 'mail-mail-reply-to) ; author | |
286 (define-key map "\C-c\C-f\C-l" 'mail-mail-followup-to) ; list | |
287 (define-key map "\C-c\C-t" 'mail-text) | |
288 (define-key map "\C-c\C-y" 'mail-yank-original) | |
289 (define-key map "\C-c\C-r" 'mail-yank-region) | |
290 (define-key map [remap split-line] 'mail-split-line) | |
291 (define-key map "\C-c\C-q" 'mail-fill-yanked-message) | |
292 (define-key map "\C-c\C-w" 'mail-signature) | |
293 (define-key map "\C-c\C-v" 'mail-sent-via) | |
294 (define-key map "\C-c\C-c" 'mail-send-and-exit) | |
295 (define-key map "\C-c\C-s" 'mail-send) | |
296 (define-key map "\C-c\C-i" 'mail-attach-file) | |
297 | |
298 (define-key map [menu-bar mail] | |
299 (cons "Mail" (make-sparse-keymap "Mail"))) | |
300 | |
301 (define-key map [menu-bar mail fill] | |
302 '("Fill Citation" . mail-fill-yanked-message)) | |
303 | |
304 (define-key map [menu-bar mail yank] | |
305 '("Cite Original" . mail-yank-original)) | |
306 | |
307 (define-key map [menu-bar mail signature] | |
308 '("Insert Signature" . mail-signature)) | |
309 | |
310 (define-key map [menu-bar mail mail-sep] | |
311 '("--")) | |
312 | |
313 (define-key map [menu-bar mail cancel] | |
314 '("Cancel" . mail-dont-send)) | |
315 | |
316 (define-key map [menu-bar mail send-stay] | |
317 '("Send, Keep Editing" . mail-send)) | |
318 | |
319 (define-key map [menu-bar mail send] | |
320 '("Send Message" . mail-send-and-exit)) | |
321 | |
322 (define-key map [menu-bar headers] | |
323 (cons "Headers" (make-sparse-keymap "Move to Header"))) | |
324 | |
325 (define-key map [menu-bar headers text] | |
326 '("Text" . mail-text)) | |
327 | |
328 (define-key map [menu-bar headers expand-aliases] | |
329 '("Expand Aliases" . expand-mail-aliases)) | |
330 | |
331 (define-key map [menu-bar headers sent-via] | |
332 '("Sent Via" . mail-sent-via)) | |
333 | |
334 (define-key map [menu-bar headers mail-reply-to] | |
335 '("Mail Reply To" . mail-mail-reply-to)) | |
336 | |
337 (define-key map [menu-bar headers mail-followup-to] | |
338 '("Mail Followup To" . mail-mail-followup-to)) | |
339 | |
340 (define-key map [menu-bar headers reply-to] | |
341 '("Reply-To" . mail-reply-to)) | |
342 | |
343 (define-key map [menu-bar headers bcc] | |
344 '("Bcc" . mail-bcc)) | |
345 | |
346 (define-key map [menu-bar headers fcc] | |
347 '("Fcc" . mail-fcc)) | |
348 | |
349 (define-key map [menu-bar headers cc] | |
350 '("Cc" . mail-cc)) | |
351 | |
352 (define-key map [menu-bar headers subject] | |
353 '("Subject" . mail-subject)) | |
354 | |
355 (define-key map [menu-bar headers to] | |
356 '("To" . mail-to)) | |
357 | |
358 map)) | |
240 | 359 |
241 (autoload 'build-mail-aliases "mailalias" | 360 (autoload 'build-mail-aliases "mailalias" |
242 "Read mail aliases from user's personal aliases file and set `mail-aliases'." | 361 "Read mail aliases from user's personal aliases file and set `mail-aliases'." |
243 nil) | 362 nil) |
244 | 363 |
249 removed from alias expansions." | 368 removed from alias expansions." |
250 nil) | 369 nil) |
251 | 370 |
252 ;;;###autoload | 371 ;;;###autoload |
253 (defcustom mail-signature nil | 372 (defcustom mail-signature nil |
254 "*Text inserted at end of mail buffer when a message is initialized. | 373 "Text inserted at end of mail buffer when a message is initialized. |
255 If t, it means to insert the contents of the file `mail-signature-file'. | 374 If t, it means to insert the contents of the file `mail-signature-file'. |
256 If a string, that string is inserted. | 375 If a string, that string is inserted. |
257 (To make a proper signature, the string should begin with \\n\\n-- \\n, | 376 (To make a proper signature, the string should begin with \\n\\n-- \\n, |
258 which is the standard way to delimit a signature in a message.) | 377 which is the standard way to delimit a signature in a message.) |
259 Otherwise, it should be an expression; it is evaluated | 378 Otherwise, it should be an expression; it is evaluated |
263 (string :tag "String to insert") | 382 (string :tag "String to insert") |
264 (sexp :tag "Expression to evaluate")) | 383 (sexp :tag "Expression to evaluate")) |
265 :group 'sendmail) | 384 :group 'sendmail) |
266 (put 'mail-signature 'risky-local-variable t) | 385 (put 'mail-signature 'risky-local-variable t) |
267 | 386 |
387 ;;;###autoload | |
268 (defcustom mail-signature-file "~/.signature" | 388 (defcustom mail-signature-file "~/.signature" |
269 "*File containing the text inserted at end of mail buffer." | 389 "File containing the text inserted at end of mail buffer." |
270 :type 'file | 390 :type 'file |
271 :group 'sendmail) | 391 :group 'sendmail) |
272 | 392 |
273 ;;;###autoload | 393 ;;;###autoload |
274 (defcustom mail-default-directory "~/" | 394 (defcustom mail-default-directory "~/" |
275 "*Directory for mail buffers. | 395 "Directory for mail buffers. |
276 Value of `default-directory' for mail buffers. | 396 Value of `default-directory' for mail buffers. |
277 This directory is used for auto-save files of mail buffers." | 397 This directory is used for auto-save files of mail buffers." |
278 :type '(directory :tag "Directory") | 398 :type '(directory :tag "Directory") |
279 :group 'sendmail | 399 :group 'sendmail |
280 :version "21.4") | 400 :version "22.1") |
281 | 401 |
282 (defvar mail-reply-action nil) | 402 (defvar mail-reply-action nil) |
283 (defvar mail-send-actions nil | 403 (defvar mail-send-actions nil |
284 "A list of actions to be performed upon successful sending of a message.") | 404 "A list of actions to be performed upon successful sending of a message.") |
285 (put 'mail-reply-action 'permanent-local t) | 405 (put 'mail-reply-action 'permanent-local t) |
286 (put 'mail-send-actions 'permanent-local t) | 406 (put 'mail-send-actions 'permanent-local t) |
287 | 407 |
408 ;;;###autoload | |
288 (defcustom mail-default-headers nil | 409 (defcustom mail-default-headers nil |
289 "*A string containing header lines, to be inserted in outgoing messages. | 410 "A string containing header lines, to be inserted in outgoing messages. |
290 It is inserted before you edit the message, | 411 It is inserted before you edit the message, |
291 so you can edit or delete these lines." | 412 so you can edit or delete these lines." |
292 :type '(choice (const nil) string) | 413 :type '(choice (const nil) string) |
293 :group 'sendmail) | 414 :group 'sendmail) |
294 | 415 |
416 ;;;###autoload | |
295 (defcustom mail-bury-selects-summary t | 417 (defcustom mail-bury-selects-summary t |
296 "*If non-nil, try to show RMAIL summary buffer after returning from mail. | 418 "If non-nil, try to show RMAIL summary buffer after returning from mail. |
297 The functions \\[mail-send-on-exit] or \\[mail-dont-send] select | 419 The functions \\[mail-send-on-exit] or \\[mail-dont-send] select |
298 the RMAIL summary buffer before returning, if it exists and this variable | 420 the RMAIL summary buffer before returning, if it exists and this variable |
299 is non-nil." | 421 is non-nil." |
300 :type 'boolean | 422 :type 'boolean |
301 :group 'sendmail) | 423 :group 'sendmail) |
302 | 424 |
425 ;;;###autoload | |
303 (defcustom mail-send-nonascii 'mime | 426 (defcustom mail-send-nonascii 'mime |
304 "*Specify whether to allow sending non-ASCII characters in mail. | 427 "Specify whether to allow sending non-ASCII characters in mail. |
305 If t, that means do allow it. nil means don't allow it. | 428 If t, that means do allow it. nil means don't allow it. |
306 `query' means ask the user each time. | 429 `query' means ask the user each time. |
307 `mime' means add an appropriate MIME header if none already present. | 430 `mime' means add an appropriate MIME header if none already present. |
308 The default is `mime'. | 431 The default is `mime'. |
309 Including non-ASCII characters in a mail message can be problematical | 432 Including non-ASCII characters in a mail message can be problematical |
310 for the recipient, who may not know how to decode them properly." | 433 for the recipient, who may not know how to decode them properly." |
311 :type '(choice (const t) (const nil) (const query) (const mime)) | 434 :type '(choice (const t) (const nil) (const query) (const mime)) |
312 :group 'sendmail) | 435 :group 'sendmail) |
313 | 436 |
314 (defcustom mail-use-dsn nil | 437 (defcustom mail-use-dsn nil |
315 "*Ask MTA for notification of failed, delayed or successful delivery. | 438 "Ask MTA for notification of failed, delayed or successful delivery. |
316 Note that only some MTAs (currently only recent versions of Sendmail) | 439 Note that only some MTAs (currently only recent versions of Sendmail) |
317 support Delivery Status Notification." | 440 support Delivery Status Notification." |
318 :group 'sendmail | 441 :group 'sendmail |
319 :type '(repeat (radio (const :tag "Failure" failure) | 442 :type '(repeat (radio (const :tag "Failure" failure) |
320 (const :tag "Delay" delay) | 443 (const :tag "Delay" delay) |
321 (const :tag "Success" success))) | 444 (const :tag "Success" success))) |
322 :version "21.4") | 445 :version "22.1") |
323 | 446 |
324 ;; Note: could use /usr/ucb/mail instead of sendmail; | 447 ;; Note: could use /usr/ucb/mail instead of sendmail; |
325 ;; options -t, and -v if not interactive. | 448 ;; options -t, and -v if not interactive. |
326 (defvar mail-mailer-swallows-blank-line | 449 (defvar mail-mailer-swallows-blank-line |
327 (if (and (string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)" system-configuration) | 450 (if (and (string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)" system-configuration) |
328 (file-readable-p "/etc/sendmail.cf") | 451 (file-readable-p "/etc/sendmail.cf") |
329 (let ((buffer (get-buffer-create " *temp*"))) | 452 (with-temp-buffer |
330 (unwind-protect | 453 (insert-file-contents "/etc/sendmail.cf") |
331 (save-excursion | 454 (goto-char (point-min)) |
332 (set-buffer buffer) | 455 (let ((case-fold-search nil)) |
333 (insert-file-contents "/etc/sendmail.cf") | 456 (re-search-forward "^OR\\>" nil t)))) |
334 (goto-char (point-min)) | |
335 (let ((case-fold-search nil)) | |
336 (re-search-forward "^OR\\>" nil t))) | |
337 (kill-buffer buffer)))) | |
338 ;; According to RFC822, "The field-name must be composed of printable | 457 ;; According to RFC822, "The field-name must be composed of printable |
339 ;; ASCII characters (i.e. characters that have decimal values between | 458 ;; ASCII characters (i.e. characters that have decimal values between |
340 ;; 33 and 126, except colon)", i.e. any chars except ctl chars, | 459 ;; 33 and 126, except colon)", i.e. any chars except ctl chars, |
341 ;; space, or colon. | 460 ;; space, or colon. |
342 '(looking-at "[ \t]\\|[][!\"#$%&'()*+,-./0-9;<=>?@A-Z\\\\^_`a-z{|}~]+:")) | 461 '(looking-at "[ \t]\\|[][!\"#$%&'()*+,-./0-9;<=>?@A-Z\\\\^_`a-z{|}~]+:")) |
356 (eval-when-compile | 475 (eval-when-compile |
357 (let* ((cite-chars "[>|}]") | 476 (let* ((cite-chars "[>|}]") |
358 (cite-prefix "[:alpha:]") | 477 (cite-prefix "[:alpha:]") |
359 (cite-suffix (concat cite-prefix "0-9_.@-`'\""))) | 478 (cite-suffix (concat cite-prefix "0-9_.@-`'\""))) |
360 (list '("^\\(To\\|Newsgroups\\):" . font-lock-function-name-face) | 479 (list '("^\\(To\\|Newsgroups\\):" . font-lock-function-name-face) |
361 '("^\\(B?CC\\|Reply-to\\):" . font-lock-keyword-face) | 480 '("^\\(B?CC\\|Reply-to\\|Mail-\\(reply\\|followup\\)-to\\):" . font-lock-keyword-face) |
362 '("^\\(Subject:\\)[ \t]*\\(.+\\)?" | 481 '("^\\(Subject:\\)[ \t]*\\(.+\\)?" |
363 (1 font-lock-comment-face) (2 font-lock-type-face nil t)) | 482 (1 font-lock-comment-face) |
483 ;; (2 font-lock-type-face nil t) | |
484 ) | |
364 ;; Use EVAL to delay in case `mail-header-separator' gets changed. | 485 ;; Use EVAL to delay in case `mail-header-separator' gets changed. |
365 '(eval . | 486 '(eval . |
366 (let ((separator (if (zerop (length mail-header-separator)) | 487 (let ((separator (if (zerop (length mail-header-separator)) |
367 " \\`\\' " | 488 " \\`\\' " |
368 (regexp-quote mail-header-separator)))) | 489 (regexp-quote mail-header-separator)))) |
369 (cons (concat "^" separator "$") 'font-lock-warning-face))) | 490 (cons (concat "^" separator "$") 'font-lock-warning-face))) |
370 ;; Use MATCH-ANCHORED to effectively anchor the regexp left side. | 491 ;; Use MATCH-ANCHORED to effectively anchor the regexp left side. |
371 `(,cite-chars | 492 `(,cite-chars |
372 (,(concat "\\=[ \t]*" | 493 (,(concat "\\=[ \t]*" |
373 "\\(\\([" cite-prefix "]+[" cite-suffix "]*\\)?" | 494 "\\(\\(\\([" cite-prefix "]+[" cite-suffix "]*\\)?" |
374 "\\(" cite-chars "[ \t]*\\)\\)+" | 495 "\\(" cite-chars "[ \t]*\\)\\)+\\)" |
375 "\\(.*\\)") | 496 "\\(.*\\)") |
376 (beginning-of-line) (end-of-line) | 497 (beginning-of-line) (end-of-line) |
377 (2 font-lock-constant-face nil t) | 498 (1 font-lock-comment-delimiter-face nil t) |
378 (4 font-lock-comment-face nil t))) | 499 (5 font-lock-comment-face nil t))) |
379 '("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\):.*\\(\n[ \t]+.*\\)*$" | 500 '("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\):.*\\(\n[ \t]+.*\\)*$" |
380 . font-lock-string-face)))) | 501 . font-lock-string-face)))) |
381 "Additional expressions to highlight in Mail mode.") | 502 "Additional expressions to highlight in Mail mode.") |
382 | 503 |
383 | 504 |
384 (defun sendmail-sync-aliases () | 505 (defun sendmail-sync-aliases () |
385 (let ((modtime (nth 5 (file-attributes mail-personal-alias-file)))) | 506 (when mail-personal-alias-file |
386 (or (equal mail-alias-modtime modtime) | 507 (let ((modtime (nth 5 (file-attributes mail-personal-alias-file)))) |
387 (setq mail-alias-modtime modtime | 508 (or (equal mail-alias-modtime modtime) |
388 mail-aliases t)))) | 509 (setq mail-alias-modtime modtime |
510 mail-aliases t))))) | |
389 | 511 |
390 (defun mail-setup (to subject in-reply-to cc replybuffer actions) | 512 (defun mail-setup (to subject in-reply-to cc replybuffer actions) |
391 (or mail-default-reply-to | 513 (or mail-default-reply-to |
392 (setq mail-default-reply-to (getenv "REPLYTO"))) | 514 (setq mail-default-reply-to (getenv "REPLYTO"))) |
393 (sendmail-sync-aliases) | 515 (sendmail-sync-aliases) |
394 (if (eq mail-aliases t) | 516 (if (eq mail-aliases t) |
395 (progn | 517 (progn |
396 (setq mail-aliases nil) | 518 (setq mail-aliases nil) |
397 (if (file-exists-p mail-personal-alias-file) | 519 (when mail-personal-alias-file |
398 (build-mail-aliases)))) | 520 (if (file-exists-p mail-personal-alias-file) |
521 (build-mail-aliases))))) | |
399 ;; Don't leave this around from a previous message. | 522 ;; Don't leave this around from a previous message. |
400 (kill-local-variable 'buffer-file-coding-system) | 523 (kill-local-variable 'buffer-file-coding-system) |
401 ;; This doesn't work for enable-multibyte-characters. | 524 ;; This doesn't work for enable-multibyte-characters. |
402 ;; (kill-local-variable 'enable-multibyte-characters) | 525 ;; (kill-local-variable 'enable-multibyte-characters) |
403 (set-buffer-multibyte default-enable-multibyte-characters) | 526 (set-buffer-multibyte default-enable-multibyte-characters) |
404 (if current-input-method | 527 (if current-input-method |
405 (inactivate-input-method)) | 528 (inactivate-input-method)) |
406 (setq mail-send-actions actions) | 529 (setq mail-send-actions actions) |
407 (setq mail-reply-action replybuffer) | 530 (setq mail-reply-action replybuffer) |
408 (goto-char (point-min)) | 531 (goto-char (point-min)) |
532 (if mail-setup-with-from | |
533 (mail-insert-from-field)) | |
409 (insert "To: ") | 534 (insert "To: ") |
410 (save-excursion | 535 (save-excursion |
411 (if to | 536 (if to |
412 ;; Here removed code to extract names from within <...> | 537 ;; Here removed code to extract names from within <...> |
413 ;; on the assumption that mail-strip-quoted-names | 538 ;; on the assumption that mail-strip-quoted-names |
478 (defvar mail-mode-abbrev-table text-mode-abbrev-table) | 603 (defvar mail-mode-abbrev-table text-mode-abbrev-table) |
479 ;;;###autoload | 604 ;;;###autoload |
480 (define-derived-mode mail-mode text-mode "Mail" | 605 (define-derived-mode mail-mode text-mode "Mail" |
481 "Major mode for editing mail to be sent. | 606 "Major mode for editing mail to be sent. |
482 Like Text Mode but with these additional commands: | 607 Like Text Mode but with these additional commands: |
483 \\[mail-send] mail-send (send the message) \\[mail-send-and-exit] mail-send-and-exit | 608 |
609 \\[mail-send] mail-send (send the message) | |
610 \\[mail-send-and-exit] mail-send-and-exit (send the message and exit) | |
611 | |
484 Here are commands that move to a header field (and create it if there isn't): | 612 Here are commands that move to a header field (and create it if there isn't): |
485 \\[mail-to] move to To: \\[mail-subject] move to Subject: | 613 \\[mail-to] move to To: \\[mail-subject] move to Subject: |
486 \\[mail-cc] move to CC: \\[mail-bcc] move to BCC: | 614 \\[mail-cc] move to CC: \\[mail-bcc] move to BCC: |
487 \\[mail-fcc] move to FCC: \\[mail-reply-to] move to Reply-To: | 615 \\[mail-fcc] move to FCC: \\[mail-reply-to] move to Reply-To: |
616 \\[mail-mail-reply-to] move to Mail-Reply-To: | |
617 \\[mail-mail-followup-to] move to Mail-Followup-To: | |
488 \\[mail-text] mail-text (move to beginning of message text). | 618 \\[mail-text] mail-text (move to beginning of message text). |
489 \\[mail-signature] mail-signature (insert `mail-signature-file' file). | 619 \\[mail-signature] mail-signature (insert `mail-signature-file' file). |
490 \\[mail-yank-original] mail-yank-original (insert current message, in Rmail). | 620 \\[mail-yank-original] mail-yank-original (insert current message, in Rmail). |
491 \\[mail-fill-yanked-message] mail-fill-yanked-message (fill what was yanked). | 621 \\[mail-fill-yanked-message] mail-fill-yanked-message (fill what was yanked). |
492 \\[mail-sent-via] mail-sent-via (add a Sent-via field for each To or CC). | 622 \\[mail-sent-via] mail-sent-via (add a Sent-via field for each To or CC). |
496 (make-local-variable 'mail-send-actions) | 626 (make-local-variable 'mail-send-actions) |
497 (setq buffer-offer-save t) | 627 (setq buffer-offer-save t) |
498 (make-local-variable 'font-lock-defaults) | 628 (make-local-variable 'font-lock-defaults) |
499 (setq font-lock-defaults '(mail-font-lock-keywords t t)) | 629 (setq font-lock-defaults '(mail-font-lock-keywords t t)) |
500 (make-local-variable 'paragraph-separate) | 630 (make-local-variable 'paragraph-separate) |
501 (make-local-variable 'paragraph-start) | |
502 (make-local-variable 'normal-auto-fill-function) | 631 (make-local-variable 'normal-auto-fill-function) |
503 (setq normal-auto-fill-function 'mail-mode-auto-fill) | 632 (setq normal-auto-fill-function 'mail-mode-auto-fill) |
504 (make-local-variable 'fill-paragraph-function) | 633 (make-local-variable 'fill-paragraph-function) |
505 (setq fill-paragraph-function 'mail-mode-fill-paragraph) | 634 (setq fill-paragraph-function 'mail-mode-fill-paragraph) |
506 ;; Allow using comment commands to add/remove quoting (this only does | 635 ;; Allow using comment commands to add/remove quoting (this only does |
507 ;; anything if mail-yank-prefix is set to a non-nil value). | 636 ;; anything if mail-yank-prefix is set to a non-nil value). |
508 (set (make-local-variable 'comment-start) mail-yank-prefix) | 637 (set (make-local-variable 'comment-start) mail-yank-prefix) |
638 (if mail-yank-prefix | |
639 (set (make-local-variable 'comment-start-skip) | |
640 (concat "^" (regexp-quote mail-yank-prefix) "[ \t]*"))) | |
509 (make-local-variable 'adaptive-fill-regexp) | 641 (make-local-variable 'adaptive-fill-regexp) |
510 (setq adaptive-fill-regexp | 642 (setq adaptive-fill-regexp |
511 (concat "[ \t]*[-[:alnum:]]+>+[ \t]*\\|" | 643 (concat "[ \t]*[-[:alnum:]]+>+[ \t]*\\|" |
512 adaptive-fill-regexp)) | 644 adaptive-fill-regexp)) |
513 (make-local-variable 'adaptive-fill-first-line-regexp) | 645 (make-local-variable 'adaptive-fill-first-line-regexp) |
516 adaptive-fill-first-line-regexp)) | 648 adaptive-fill-first-line-regexp)) |
517 ;; `-- ' precedes the signature. `-----' appears at the start of the | 649 ;; `-- ' precedes the signature. `-----' appears at the start of the |
518 ;; lines that delimit forwarded messages. | 650 ;; lines that delimit forwarded messages. |
519 ;; Lines containing just >= 3 dashes, perhaps after whitespace, | 651 ;; Lines containing just >= 3 dashes, perhaps after whitespace, |
520 ;; are also sometimes used and should be separators. | 652 ;; are also sometimes used and should be separators. |
521 (setq paragraph-start (concat (regexp-quote mail-header-separator) | 653 (setq paragraph-separate (concat (regexp-quote mail-header-separator) |
522 "$\\|\t*\\([-|#;>* ]\\|(?[0-9]+[.)]\\)+$" | 654 "$\\|\t*\\([-|#;>* ]\\|(?[0-9]+[.)]\\)+$" |
523 "\\|[ \t]*[[:alnum:]]*>+[ \t]*$\\|[ \t]*$\\|" | 655 "\\|[ \t]*[[:alnum:]]*>+[ \t]*$\\|[ \t]*$\\|" |
524 "-- $\\|---+$\\|" | 656 "--\\( \\|-+\\)$\\|" |
525 page-delimiter)) | 657 page-delimiter))) |
526 (setq paragraph-separate paragraph-start)) | |
527 | 658 |
528 | 659 |
529 (defun mail-header-end () | 660 (defun mail-header-end () |
530 "Return the buffer location of the end of headers, as a number." | 661 "Return the buffer location of the end of headers, as a number." |
531 (save-restriction | 662 (save-restriction |
589 (goto-char beg) | 720 (goto-char beg) |
590 ;; If this field contains addresses, | 721 ;; If this field contains addresses, |
591 ;; make sure we can fill after each address. | 722 ;; make sure we can fill after each address. |
592 (if (member fieldname | 723 (if (member fieldname |
593 '("to" "cc" "bcc" "from" "reply-to" | 724 '("to" "cc" "bcc" "from" "reply-to" |
725 "mail-reply-to" "mail-followup-to" | |
594 "resent-to" "resent-cc" "resent-bcc" | 726 "resent-to" "resent-cc" "resent-bcc" |
595 "resent-from" "resent-reply-to")) | 727 "resent-from" "resent-reply-to")) |
596 (while (search-forward "," end t) | 728 (while (search-forward "," end t) |
597 (or (looking-at "[ \t]") | 729 (or (looking-at "[ \t]") |
598 (insert " ")))) | 730 (insert " ")))) |
599 (fill-region-as-paragraph beg end) | 731 (fill-region-as-paragraph beg end arg) |
600 ;; Mark all lines except the first as continuations. | 732 ;; Mark all lines except the first as continuations. |
601 (goto-char beg) | 733 (goto-char beg) |
602 (forward-line 1) | 734 (forward-line 1) |
603 (while (< (point) end) | 735 (while (< (point) end) |
604 (insert " ") | 736 (insert " ") |
605 (forward-line 1)) | 737 (forward-line 1)) |
606 (move-marker end nil) | 738 (move-marker end nil) |
607 t))) | 739 t))) |
608 | 740 |
609 ;;; Set up keymap. | |
610 | |
611 (if mail-mode-map | |
612 nil | |
613 (setq mail-mode-map (make-sparse-keymap)) | |
614 (define-key mail-mode-map "\M-\t" 'mail-complete) | |
615 (define-key mail-mode-map "\C-c?" 'describe-mode) | |
616 (define-key mail-mode-map "\C-c\C-f\C-t" 'mail-to) | |
617 (define-key mail-mode-map "\C-c\C-f\C-b" 'mail-bcc) | |
618 (define-key mail-mode-map "\C-c\C-f\C-f" 'mail-fcc) | |
619 (define-key mail-mode-map "\C-c\C-f\C-c" 'mail-cc) | |
620 (define-key mail-mode-map "\C-c\C-f\C-s" 'mail-subject) | |
621 (define-key mail-mode-map "\C-c\C-f\C-r" 'mail-reply-to) | |
622 (define-key mail-mode-map "\C-c\C-t" 'mail-text) | |
623 (define-key mail-mode-map "\C-c\C-y" 'mail-yank-original) | |
624 (define-key mail-mode-map "\C-c\C-r" 'mail-yank-region) | |
625 (define-key mail-mode-map [remap split-line] 'mail-split-line) | |
626 (define-key mail-mode-map "\C-c\C-q" 'mail-fill-yanked-message) | |
627 (define-key mail-mode-map "\C-c\C-w" 'mail-signature) | |
628 (define-key mail-mode-map "\C-c\C-v" 'mail-sent-via) | |
629 (define-key mail-mode-map "\C-c\C-c" 'mail-send-and-exit) | |
630 (define-key mail-mode-map "\C-c\C-s" 'mail-send) | |
631 (define-key mail-mode-map "\C-c\C-i" 'mail-attach-file)) | |
632 | |
633 (define-key mail-mode-map [menu-bar mail] | |
634 (cons "Mail" (make-sparse-keymap "Mail"))) | |
635 | |
636 (define-key mail-mode-map [menu-bar mail fill] | |
637 '("Fill Citation" . mail-fill-yanked-message)) | |
638 | |
639 (define-key mail-mode-map [menu-bar mail yank] | |
640 '("Cite Original" . mail-yank-original)) | |
641 | |
642 (define-key mail-mode-map [menu-bar mail signature] | |
643 '("Insert Signature" . mail-signature)) | |
644 | |
645 (define-key mail-mode-map [menu-bar mail mail-sep] | |
646 '("--")) | |
647 | |
648 (define-key mail-mode-map [menu-bar mail cancel] | |
649 '("Cancel" . mail-dont-send)) | |
650 | |
651 (define-key mail-mode-map [menu-bar mail send-stay] | |
652 '("Send, Keep Editing" . mail-send)) | |
653 | |
654 (define-key mail-mode-map [menu-bar mail send] | |
655 '("Send Message" . mail-send-and-exit)) | |
656 | |
657 (define-key mail-mode-map [menu-bar headers] | |
658 (cons "Headers" (make-sparse-keymap "Move to Header"))) | |
659 | |
660 (define-key mail-mode-map [menu-bar headers text] | |
661 '("Text" . mail-text)) | |
662 | |
663 (define-key mail-mode-map [menu-bar headers expand-aliases] | |
664 '("Expand Aliases" . expand-mail-aliases)) | |
665 | |
666 (define-key mail-mode-map [menu-bar headers sent-via] | |
667 '("Sent Via" . mail-sent-via)) | |
668 | |
669 (define-key mail-mode-map [menu-bar headers reply-to] | |
670 '("Reply-To" . mail-reply-to)) | |
671 | |
672 (define-key mail-mode-map [menu-bar headers bcc] | |
673 '("Bcc" . mail-bcc)) | |
674 | |
675 (define-key mail-mode-map [menu-bar headers fcc] | |
676 '("Fcc" . mail-fcc)) | |
677 | |
678 (define-key mail-mode-map [menu-bar headers cc] | |
679 '("Cc" . mail-cc)) | |
680 | |
681 (define-key mail-mode-map [menu-bar headers subject] | |
682 '("Subject" . mail-subject)) | |
683 | |
684 (define-key mail-mode-map [menu-bar headers to] | |
685 '("To" . mail-to)) | |
686 | |
687 ;; User-level commands for sending. | 741 ;; User-level commands for sending. |
688 | 742 |
689 (defun mail-send-and-exit (arg) | 743 (defun mail-send-and-exit (&optional arg) |
690 "Send message like `mail-send', then, if no errors, exit from mail buffer. | 744 "Send message like `mail-send', then, if no errors, exit from mail buffer. |
691 Prefix arg means don't delete this window." | 745 Prefix arg means don't delete this window." |
692 (interactive "P") | 746 (interactive "P") |
693 (mail-send) | 747 (mail-send) |
694 (mail-bury arg)) | 748 (mail-bury arg)) |
695 | 749 |
696 (defun mail-dont-send (arg) | 750 (defun mail-dont-send (&optional arg) |
697 "Don't send the message you have been editing. | 751 "Don't send the message you have been editing. |
698 Prefix arg means don't delete this window." | 752 Prefix arg means don't delete this window." |
699 (interactive "P") | 753 (interactive "P") |
700 (mail-bury arg)) | 754 (mail-bury arg)) |
701 | 755 |
702 (defun mail-bury (arg) | 756 (defun mail-bury (&optional arg) |
703 "Bury this mail buffer." | 757 "Bury this mail buffer." |
704 (let ((newbuf (other-buffer (current-buffer)))) | 758 (let ((newbuf (other-buffer (current-buffer)))) |
705 (bury-buffer (current-buffer)) | 759 (bury-buffer (current-buffer)) |
706 (if (and (or (window-dedicated-p (frame-selected-window)) | 760 (if (and (or (window-dedicated-p (frame-selected-window)) |
707 (cdr (assq 'mail-dedicated-frame (frame-parameters)))) | 761 (cdr (assq 'mail-dedicated-frame (frame-parameters)))) |
708 (not (null (delq (selected-frame) (visible-frame-list))))) | 762 (not (null (delq (selected-frame) (visible-frame-list))))) |
709 (delete-frame (selected-frame)) | 763 (progn |
764 (if (display-multi-frame-p) | |
765 (delete-frame (selected-frame)) | |
766 ;; The previous frame is where normally they have the | |
767 ;; RMAIL buffer displayed. | |
768 (other-frame -1))) | |
710 (let (rmail-flag summary-buffer) | 769 (let (rmail-flag summary-buffer) |
711 (and (not arg) | 770 (and (not arg) |
712 (not (one-window-p)) | 771 (not (one-window-p)) |
713 (save-excursion | 772 (with-current-buffer |
714 (set-buffer (window-buffer (next-window (selected-window) 'not))) | 773 (window-buffer (next-window (selected-window) 'not)) |
715 (setq rmail-flag (eq major-mode 'rmail-mode)) | 774 (setq rmail-flag (eq major-mode 'rmail-mode)) |
716 (setq summary-buffer | 775 (setq summary-buffer |
717 (and mail-bury-selects-summary | 776 (and mail-bury-selects-summary |
718 (boundp 'rmail-summary-buffer) | 777 (boundp 'rmail-summary-buffer) |
719 rmail-summary-buffer | 778 rmail-summary-buffer |
730 "Hook run just before sending mail with `mail-send'." | 789 "Hook run just before sending mail with `mail-send'." |
731 :type 'hook | 790 :type 'hook |
732 :options '(flyspell-mode-off) | 791 :options '(flyspell-mode-off) |
733 :group 'sendmail) | 792 :group 'sendmail) |
734 | 793 |
794 ;;;###autoload | |
795 (defcustom mail-mailing-lists nil "\ | |
796 *List of mailing list addresses the user is subscribed to. | |
797 | |
798 The variable is used to trigger insertion of the \"Mail-Followup-To\" | |
799 header when sending a message to a mailing list." | |
800 :type '(repeat string) | |
801 :group 'sendmail) | |
802 | |
803 | |
735 (defun mail-send () | 804 (defun mail-send () |
736 "Send the message in the current buffer. | 805 "Send the message in the current buffer. |
737 If `mail-interactive' is non-nil, wait for success indication | 806 If `mail-interactive' is non-nil, wait for success indication |
738 or error messages, and inform user. | 807 or error messages, and inform user. |
739 Otherwise any failure is reported in a message back to | 808 Otherwise any failure is reported in a message back to |
742 (if (if buffer-file-name | 811 (if (if buffer-file-name |
743 (y-or-n-p "Send buffer contents as mail message? ") | 812 (y-or-n-p "Send buffer contents as mail message? ") |
744 (or (buffer-modified-p) | 813 (or (buffer-modified-p) |
745 (y-or-n-p "Message already sent; resend? "))) | 814 (y-or-n-p "Message already sent; resend? "))) |
746 (let ((inhibit-read-only t) | 815 (let ((inhibit-read-only t) |
747 (opoint (point))) | 816 (opoint (point)) |
817 (ml (when mail-mailing-lists | |
818 ;; The surrounding regexp assumes the use of | |
819 ;; `mail-strip-quoted-names' on addresses before matching | |
820 ;; Cannot deal with full RFC 822 freedom, but that is | |
821 ;; unlikely to be problematic. | |
822 (concat "\\(?:[[:space:];,]\\|\\`\\)" | |
823 (regexp-opt mail-mailing-lists t) | |
824 "\\(?:[[:space:];,]\\|\\'\\)")))) | |
825 ;; If there are mailing lists defined | |
826 (when ml | |
827 (save-excursion | |
828 (let* ((to (mail-fetch-field "to" nil t)) | |
829 (cc (mail-fetch-field "cc" nil t)) | |
830 (new-header-values ; To: and Cc: | |
831 (mail-strip-quoted-names | |
832 (concat to (when cc (concat ", " cc)))))) | |
833 ;; If message goes to known mailing list ... | |
834 (when (string-match ml new-header-values) | |
835 ;; Add Mail-Followup-To if none yet | |
836 (unless (mail-fetch-field "mail-followup-to") | |
837 (goto-char (mail-header-end)) | |
838 (insert "Mail-Followup-To: " | |
839 (let ((l)) | |
840 (mapc | |
841 ;; remove duplicates | |
842 '(lambda (e) | |
843 (unless (member e l) | |
844 (push e l))) | |
845 (split-string new-header-values | |
846 ",[[:space:]]+" t)) | |
847 (mapconcat 'identity l ", ")) | |
848 "\n")) | |
849 ;; Add Mail-Reply-To if none yet | |
850 (unless (mail-fetch-field "mail-reply-to") | |
851 (goto-char (mail-header-end)) | |
852 (insert "Mail-Reply-To: " | |
853 (or (mail-fetch-field "reply-to") | |
854 user-mail-address) | |
855 "\n")))))) | |
748 (unless (memq mail-send-nonascii '(t mime)) | 856 (unless (memq mail-send-nonascii '(t mime)) |
749 (goto-char (point-min)) | 857 (goto-char (point-min)) |
750 (skip-chars-forward "\0-\177") | 858 (skip-chars-forward "\0-\177") |
751 (or (= (point) (point-max)) | 859 (or (= (point) (point-max)) |
752 (if (eq mail-send-nonascii 'query) | 860 (if (eq mail-send-nonascii 'query) |
800 ;;;###autoload | 908 ;;;###autoload |
801 (defvar default-sendmail-coding-system 'iso-latin-1 | 909 (defvar default-sendmail-coding-system 'iso-latin-1 |
802 "Default coding system for encoding the outgoing mail. | 910 "Default coding system for encoding the outgoing mail. |
803 This variable is used only when `sendmail-coding-system' is nil. | 911 This variable is used only when `sendmail-coding-system' is nil. |
804 | 912 |
805 This variable is set/changed by the command set-language-environment. | 913 This variable is set/changed by the command `set-language-environment'. |
806 User should not set this variable manually, | 914 User should not set this variable manually, |
807 instead use sendmail-coding-system to get a constant encoding | 915 instead use `sendmail-coding-system' to get a constant encoding |
808 of outgoing mails regardless of the current language environment. | 916 of outgoing mails regardless of the current language environment. |
809 See also the function `select-message-coding-system'.") | 917 See also the function `select-message-coding-system'.") |
918 | |
919 (defun mail-insert-from-field () | |
920 (let* ((login user-mail-address) | |
921 (fullname (user-full-name)) | |
922 (quote-fullname nil)) | |
923 (if (string-match "[^\0-\177]" fullname) | |
924 (setq fullname (rfc2047-encode-string fullname) | |
925 quote-fullname t)) | |
926 (cond ((eq mail-from-style 'angles) | |
927 (insert "From: " fullname) | |
928 (let ((fullname-start (+ (point-min) 6)) | |
929 (fullname-end (point-marker))) | |
930 (goto-char fullname-start) | |
931 ;; Look for a character that cannot appear unquoted | |
932 ;; according to RFC 822. | |
933 (if (or (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" | |
934 fullname-end 1) | |
935 quote-fullname) | |
936 (progn | |
937 ;; Quote fullname, escaping specials. | |
938 (goto-char fullname-start) | |
939 (insert "\"") | |
940 (while (re-search-forward "[\"\\]" | |
941 fullname-end 1) | |
942 (replace-match "\\\\\\&" t)) | |
943 (insert "\"")))) | |
944 (insert " <" login ">\n")) | |
945 ((eq mail-from-style 'parens) | |
946 (insert "From: " login " (") | |
947 (let ((fullname-start (point))) | |
948 (if quote-fullname | |
949 (insert "\"")) | |
950 (insert fullname) | |
951 (if quote-fullname | |
952 (insert "\"")) | |
953 (let ((fullname-end (point-marker))) | |
954 (goto-char fullname-start) | |
955 ;; RFC 822 says \ and nonmatching parentheses | |
956 ;; must be escaped in comments. | |
957 ;; Escape every instance of ()\ ... | |
958 (while (re-search-forward "[()\\]" fullname-end 1) | |
959 (replace-match "\\\\\\&" t)) | |
960 ;; ... then undo escaping of matching parentheses, | |
961 ;; including matching nested parentheses. | |
962 (goto-char fullname-start) | |
963 (while (re-search-forward | |
964 "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)" | |
965 fullname-end 1) | |
966 (replace-match "\\1(\\3)" t) | |
967 (goto-char fullname-start)))) | |
968 (insert ")\n")) | |
969 ((null mail-from-style) | |
970 (insert "From: " login "\n")) | |
971 ((eq mail-from-style 'system-default) | |
972 nil) | |
973 (t (error "Invalid value for `mail-from-style'"))))) | |
810 | 974 |
811 (defun sendmail-send-it () | 975 (defun sendmail-send-it () |
812 "Send the current mail buffer using the Sendmail package. | 976 "Send the current mail buffer using the Sendmail package. |
813 This is a suitable value for `send-mail-function'. It sends using the | 977 This is a suitable value for `send-mail-function'. It sends using the |
814 external program defined by `sendmail-program'." | 978 external program defined by `sendmail-program'." |
818 0)) | 982 0)) |
819 (tembuf (generate-new-buffer " sendmail temp")) | 983 (tembuf (generate-new-buffer " sendmail temp")) |
820 (multibyte enable-multibyte-characters) | 984 (multibyte enable-multibyte-characters) |
821 (case-fold-search nil) | 985 (case-fold-search nil) |
822 (selected-coding (select-message-coding-system)) | 986 (selected-coding (select-message-coding-system)) |
823 ;;; resend-to-addresses | 987 resend-to-addresses |
824 delimline | 988 delimline |
825 fcc-was-found | 989 fcc-was-found |
826 (mailbuf (current-buffer)) | 990 (mailbuf (current-buffer)) |
827 (program (if (boundp 'sendmail-program) | 991 (program (if (boundp 'sendmail-program) |
828 sendmail-program | 992 sendmail-program |
831 ;; local binding in the mail buffer will take effect. | 995 ;; local binding in the mail buffer will take effect. |
832 (envelope-from | 996 (envelope-from |
833 (and mail-specify-envelope-from | 997 (and mail-specify-envelope-from |
834 (or (mail-envelope-from) user-mail-address)))) | 998 (or (mail-envelope-from) user-mail-address)))) |
835 (unwind-protect | 999 (unwind-protect |
836 (save-excursion | 1000 (with-current-buffer tembuf |
837 (set-buffer tembuf) | |
838 (erase-buffer) | 1001 (erase-buffer) |
839 (unless multibyte | 1002 (unless multibyte |
840 (set-buffer-multibyte nil)) | 1003 (set-buffer-multibyte nil)) |
841 (insert-buffer-substring mailbuf) | 1004 (insert-buffer-substring mailbuf) |
842 (goto-char (point-max)) | 1005 (goto-char (point-max)) |
854 ;; Ignore any blank lines in the header | 1017 ;; Ignore any blank lines in the header |
855 (while (and (re-search-forward "\n\n\n*" delimline t) | 1018 (while (and (re-search-forward "\n\n\n*" delimline t) |
856 (< (point) delimline)) | 1019 (< (point) delimline)) |
857 (replace-match "\n")) | 1020 (replace-match "\n")) |
858 (goto-char (point-min)) | 1021 (goto-char (point-min)) |
1022 ;; Look for Resent- headers. They require sending | |
1023 ;; the message specially. | |
859 (let ((case-fold-search t)) | 1024 (let ((case-fold-search t)) |
860 ;;; (goto-char (point-min)) | 1025 (goto-char (point-min)) |
861 ;;; (while (re-search-forward "^Resent-\\(to\\|cc\\|bcc\\):" delimline t) | 1026 (while (re-search-forward "^Resent-\\(to\\|cc\\|bcc\\):" delimline t) |
862 ;;; (setq resend-to-addresses | 1027 ;; Put a list of such addresses in resend-to-addresses. |
863 ;;; (save-restriction | 1028 (setq resend-to-addresses |
864 ;;; (narrow-to-region (point) | 1029 (save-restriction |
865 ;;; (save-excursion | 1030 (narrow-to-region (point) |
866 ;;; (forward-line 1) | 1031 (save-excursion |
867 ;;; (while (looking-at "^[ \t]") | 1032 (forward-line 1) |
868 ;;; (forward-line 1)) | 1033 (while (looking-at "^[ \t]") |
869 ;;; (point))) | 1034 (forward-line 1)) |
870 ;;; (append (mail-parse-comma-list) | 1035 (point))) |
871 ;;; resend-to-addresses))) | 1036 (append (mail-parse-comma-list) |
872 ;;; ;; Delete Resent-BCC ourselves | 1037 resend-to-addresses))) |
873 ;;; (if (save-excursion (beginning-of-line) | 1038 ;; Delete Resent-BCC ourselves |
874 ;;; (looking-at "resent-bcc")) | 1039 (if (save-excursion (beginning-of-line) |
875 ;;; (delete-region (save-excursion (beginning-of-line) (point)) | 1040 (looking-at "resent-bcc")) |
876 ;;; (save-excursion (end-of-line) (1+ (point)))))) | 1041 (delete-region (save-excursion (beginning-of-line) (point)) |
877 ;;; Apparently this causes a duplicate Sender. | 1042 (save-excursion (end-of-line) (1+ (point)))))) |
878 ;;; ;; If the From is different than current user, insert Sender. | 1043 ;;; Apparently this causes a duplicate Sender. |
879 ;;; (goto-char (point-min)) | 1044 ;;; ;; If the From is different than current user, insert Sender. |
880 ;;; (and (re-search-forward "^From:" delimline t) | 1045 ;;; (goto-char (point-min)) |
881 ;;; (progn | 1046 ;;; (and (re-search-forward "^From:" delimline t) |
882 ;;; (require 'mail-utils) | 1047 ;;; (progn |
883 ;;; (not (string-equal | 1048 ;;; (require 'mail-utils) |
884 ;;; (mail-strip-quoted-names | 1049 ;;; (not (string-equal |
885 ;;; (save-restriction | 1050 ;;; (mail-strip-quoted-names |
886 ;;; (narrow-to-region (point-min) delimline) | 1051 ;;; (save-restriction |
887 ;;; (mail-fetch-field "From"))) | 1052 ;;; (narrow-to-region (point-min) delimline) |
888 ;;; (user-login-name)))) | 1053 ;;; (mail-fetch-field "From"))) |
889 ;;; (progn | 1054 ;;; (user-login-name)))) |
890 ;;; (forward-line 1) | 1055 ;;; (progn |
891 ;;; (insert "Sender: " (user-login-name) "\n"))) | 1056 ;;; (forward-line 1) |
1057 ;;; (insert "Sender: " (user-login-name) "\n"))) | |
892 ;; Don't send out a blank subject line | 1058 ;; Don't send out a blank subject line |
893 (goto-char (point-min)) | 1059 (goto-char (point-min)) |
894 (if (re-search-forward "^Subject:\\([ \t]*\n\\)+\\b" delimline t) | 1060 (if (re-search-forward "^Subject:\\([ \t]*\n\\)+\\b" delimline t) |
895 (replace-match "") | 1061 (replace-match "") |
896 ;; This one matches a Subject just before the header delimiter. | 1062 ;; This one matches a Subject just before the header delimiter. |
899 (replace-match ""))) | 1065 (replace-match ""))) |
900 ;; Put the "From:" field in unless for some odd reason | 1066 ;; Put the "From:" field in unless for some odd reason |
901 ;; they put one in themselves. | 1067 ;; they put one in themselves. |
902 (goto-char (point-min)) | 1068 (goto-char (point-min)) |
903 (if (not (re-search-forward "^From:" delimline t)) | 1069 (if (not (re-search-forward "^From:" delimline t)) |
904 (let* ((login user-mail-address) | 1070 (mail-insert-from-field)) |
905 (fullname (user-full-name)) | |
906 (quote-fullname nil)) | |
907 (if (string-match "[^\0-\177]" fullname) | |
908 (setq fullname (rfc2047-encode-string fullname) | |
909 quote-fullname t)) | |
910 (cond ((eq mail-from-style 'angles) | |
911 (insert "From: " fullname) | |
912 (let ((fullname-start (+ (point-min) 6)) | |
913 (fullname-end (point-marker))) | |
914 (goto-char fullname-start) | |
915 ;; Look for a character that cannot appear unquoted | |
916 ;; according to RFC 822. | |
917 (if (or (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" | |
918 fullname-end 1) | |
919 quote-fullname) | |
920 (progn | |
921 ;; Quote fullname, escaping specials. | |
922 (goto-char fullname-start) | |
923 (insert "\"") | |
924 (while (re-search-forward "[\"\\]" | |
925 fullname-end 1) | |
926 (replace-match "\\\\\\&" t)) | |
927 (insert "\"")))) | |
928 (insert " <" login ">\n")) | |
929 ((eq mail-from-style 'parens) | |
930 (insert "From: " login " (") | |
931 (let ((fullname-start (point))) | |
932 (if quote-fullname | |
933 (insert "\"")) | |
934 (insert fullname) | |
935 (if quote-fullname | |
936 (insert "\"")) | |
937 (let ((fullname-end (point-marker))) | |
938 (goto-char fullname-start) | |
939 ;; RFC 822 says \ and nonmatching parentheses | |
940 ;; must be escaped in comments. | |
941 ;; Escape every instance of ()\ ... | |
942 (while (re-search-forward "[()\\]" fullname-end 1) | |
943 (replace-match "\\\\\\&" t)) | |
944 ;; ... then undo escaping of matching parentheses, | |
945 ;; including matching nested parentheses. | |
946 (goto-char fullname-start) | |
947 (while (re-search-forward | |
948 "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)" | |
949 fullname-end 1) | |
950 (replace-match "\\1(\\3)" t) | |
951 (goto-char fullname-start)))) | |
952 (insert ")\n")) | |
953 ((null mail-from-style) | |
954 (insert "From: " login "\n")) | |
955 ((eq mail-from-style 'system-default) | |
956 nil) | |
957 (t (error "Invalid value for `mail-from-style'"))))) | |
958 ;; Possibly add a MIME header for the current coding system | 1071 ;; Possibly add a MIME header for the current coding system |
959 (let (charset) | 1072 (let (charset) |
960 (goto-char (point-min)) | 1073 (goto-char (point-min)) |
961 (and (eq mail-send-nonascii 'mime) | 1074 (and (eq mail-send-nonascii 'mime) |
962 (not (re-search-forward "^MIME-version:" delimline t)) | 1075 (not (re-search-forward "^MIME-version:" delimline t)) |
966 (setq charset | 1079 (setq charset |
967 (coding-system-get selected-coding 'mime-charset)) | 1080 (coding-system-get selected-coding 'mime-charset)) |
968 (goto-char delimline) | 1081 (goto-char delimline) |
969 (insert "MIME-version: 1.0\n" | 1082 (insert "MIME-version: 1.0\n" |
970 "Content-type: text/plain; charset=" | 1083 "Content-type: text/plain; charset=" |
971 (symbol-name charset) "\n" | 1084 (symbol-name charset) |
972 "Content-Transfer-Encoding: 8bit\n"))) | 1085 "\nContent-Transfer-Encoding: 8bit\n"))) |
973 ;; Insert an extra newline if we need it to work around | 1086 ;; Insert an extra newline if we need it to work around |
974 ;; Sun's bug that swallows newlines. | 1087 ;; Sun's bug that swallows newlines. |
975 (goto-char (1+ delimline)) | 1088 (goto-char (1+ delimline)) |
976 (if (eval mail-mailer-swallows-blank-line) | 1089 (if (eval mail-mailer-swallows-blank-line) |
977 (newline)) | 1090 (newline)) |
980 (if (re-search-forward "^FCC:" delimline t) | 1093 (if (re-search-forward "^FCC:" delimline t) |
981 (progn | 1094 (progn |
982 (setq fcc-was-found t) | 1095 (setq fcc-was-found t) |
983 (mail-do-fcc delimline))) | 1096 (mail-do-fcc delimline))) |
984 (if mail-interactive | 1097 (if mail-interactive |
985 (save-excursion | 1098 (with-current-buffer errbuf |
986 (set-buffer errbuf) | |
987 (erase-buffer)))) | 1099 (erase-buffer)))) |
988 (goto-char (point-min)) | 1100 (goto-char (point-min)) |
989 (if (let ((case-fold-search t)) | 1101 (if (let ((case-fold-search t)) |
990 (re-search-forward "^To:\\|^cc:\\|^bcc:\\|^resent-to:\ | 1102 (or resend-to-addresses |
991 \\|^resent-cc:\\|^resent-bcc:" | 1103 (re-search-forward "^To:\\|^cc:\\|^bcc:" |
992 delimline t)) | 1104 delimline t))) |
993 (let* ((default-directory "/") | 1105 (let* ((default-directory "/") |
994 (coding-system-for-write selected-coding) | 1106 (coding-system-for-write selected-coding) |
995 (args | 1107 (args |
996 (append (list (point-min) (point-max) | 1108 (append (list (point-min) (point-max) |
997 program | 1109 program |
1008 ;; and "deliver interactively" | 1120 ;; and "deliver interactively" |
1009 '("-oep" "-odi") | 1121 '("-oep" "-odi") |
1010 ;; These mean "report errors by mail" | 1122 ;; These mean "report errors by mail" |
1011 ;; and "deliver in background". | 1123 ;; and "deliver in background". |
1012 '("-oem" "-odb")) | 1124 '("-oem" "-odb")) |
1013 ;;; ;; Get the addresses from the message | 1125 ;; Get the addresses from the message |
1014 ;;; ;; unless this is a resend. | 1126 ;; unless this is a resend. |
1015 ;;; ;; We must not do that for a resend | 1127 ;; We must not do that for a resend |
1016 ;;; ;; because we would find the original addresses. | 1128 ;; because we would find the original addresses. |
1017 ;;; ;; For a resend, include the specific addresses. | 1129 ;; For a resend, include the specific addresses. |
1018 ;;; (or resend-to-addresses | 1130 (or resend-to-addresses |
1019 '("-t") | 1131 '("-t") |
1020 ;;; ) | 1132 ) |
1021 (if mail-use-dsn | 1133 (if mail-use-dsn |
1022 (list "-N" (mapconcat 'symbol-name | 1134 (list "-N" (mapconcat 'symbol-name |
1023 mail-use-dsn ","))) | 1135 mail-use-dsn ","))) |
1024 ) | 1136 ) |
1025 ) | 1137 ) |
1026 (exit-value (apply 'call-process-region args))) | 1138 (exit-value (apply 'call-process-region args))) |
1027 (or (null exit-value) (zerop exit-value) | 1139 (or (null exit-value) (eq 0 exit-value) |
1028 (error "Sending...failed with exit value %d" exit-value))) | 1140 (error "Sending...failed with exit value %d" exit-value))) |
1029 (or fcc-was-found | 1141 (or fcc-was-found |
1030 (error "No recipients"))) | 1142 (error "No recipients"))) |
1031 (if mail-interactive | 1143 (if mail-interactive |
1032 (save-excursion | 1144 (with-current-buffer errbuf |
1033 (set-buffer errbuf) | |
1034 (goto-char (point-min)) | 1145 (goto-char (point-min)) |
1035 (while (re-search-forward "\n\n* *" nil t) | 1146 (while (re-search-forward "\n\n* *" nil t) |
1036 (replace-match "; ")) | 1147 (replace-match "; ")) |
1037 (if (not (zerop (buffer-size))) | 1148 (if (not (zerop (buffer-size))) |
1038 (error "Sending...failed to %s" | 1149 (error "Sending...failed to %s" |
1040 (kill-buffer tembuf) | 1151 (kill-buffer tembuf) |
1041 (if (bufferp errbuf) | 1152 (if (bufferp errbuf) |
1042 (kill-buffer errbuf))))) | 1153 (kill-buffer errbuf))))) |
1043 | 1154 |
1044 (defun mail-do-fcc (header-end) | 1155 (defun mail-do-fcc (header-end) |
1156 (unless (markerp header-end) | |
1157 (error "Value of `header-end' must be a marker")) | |
1045 (let (fcc-list | 1158 (let (fcc-list |
1046 (rmailbuf (current-buffer)) | 1159 (rmailbuf (current-buffer)) |
1047 (time (current-time)) | 1160 (time (current-time)) |
1048 (tembuf (generate-new-buffer " rmail output")) | 1161 (tembuf (generate-new-buffer " rmail output")) |
1049 (case-fold-search t)) | 1162 (case-fold-search t)) |
1050 (unless (markerp header-end) | |
1051 (error "Value of `header-end' must be a marker")) | |
1052 (save-excursion | 1163 (save-excursion |
1053 (goto-char (point-min)) | 1164 (goto-char (point-min)) |
1054 (while (re-search-forward "^FCC:[ \t]*" header-end t) | 1165 (while (re-search-forward "^FCC:[ \t]*" header-end t) |
1055 (setq fcc-list (cons (buffer-substring (point) | 1166 (push (buffer-substring (point) |
1056 (progn | 1167 (progn |
1057 (end-of-line) | 1168 (end-of-line) |
1058 (skip-chars-backward " \t") | 1169 (skip-chars-backward " \t") |
1059 (point))) | 1170 (point))) |
1060 fcc-list)) | 1171 fcc-list) |
1061 (delete-region (match-beginning 0) | 1172 (delete-region (match-beginning 0) |
1062 (progn (forward-line 1) (point)))) | 1173 (progn (forward-line 1) (point)))) |
1063 (set-buffer tembuf) | 1174 (set-buffer tembuf) |
1064 (erase-buffer) | 1175 (erase-buffer) |
1065 ;; This initial newline is written out if the fcc file already exists. | 1176 ;; This initial newline is written out if the fcc file already exists. |
1081 ;; that "^[>]+From " be quoted in the same transparent way.) | 1192 ;; that "^[>]+From " be quoted in the same transparent way.) |
1082 (let ((case-fold-search nil)) | 1193 (let ((case-fold-search nil)) |
1083 (while (search-forward "\nFrom " nil t) | 1194 (while (search-forward "\nFrom " nil t) |
1084 (forward-char -5) | 1195 (forward-char -5) |
1085 (insert ?>))) | 1196 (insert ?>))) |
1086 (while fcc-list | 1197 (dolist (fcc fcc-list) |
1087 (let* ((buffer (find-buffer-visiting (car fcc-list))) | 1198 (let* ((buffer (find-buffer-visiting fcc)) |
1088 (curbuf (current-buffer)) | 1199 (curbuf (current-buffer)) |
1089 dont-write-the-file | 1200 dont-write-the-file |
1090 buffer-matches-file | 1201 buffer-matches-file |
1091 (beg (point-min)) (end (point-max)) | 1202 (beg (point-min)) (end (point-max)) |
1092 (beg2 (save-excursion (goto-char (point-min)) | 1203 (beg2 (save-excursion (goto-char (point-min)) |
1093 (forward-line 2) (point)))) | 1204 (forward-line 2) (point)))) |
1094 (if buffer | 1205 (if buffer |
1095 ;; File is present in a buffer => append to that buffer. | 1206 ;; File is present in a buffer => append to that buffer. |
1096 (save-excursion | 1207 (with-current-buffer buffer |
1097 (set-buffer buffer) | |
1098 (setq buffer-matches-file | 1208 (setq buffer-matches-file |
1099 (and (not (buffer-modified-p)) | 1209 (and (not (buffer-modified-p)) |
1100 (verify-visited-file-modtime buffer))) | 1210 (verify-visited-file-modtime buffer))) |
1101 ;; Keep the end of the accessible portion at the same place | 1211 ;; Keep the end of the accessible portion at the same place |
1102 ;; unless it is the end of the buffer. | 1212 ;; unless it is the end of the buffer. |
1133 (goto-char (point-max)) | 1243 (goto-char (point-max)) |
1134 (insert-buffer-substring curbuf beg end)) | 1244 (insert-buffer-substring curbuf beg end)) |
1135 (or buffer-matches-file | 1245 (or buffer-matches-file |
1136 (progn | 1246 (progn |
1137 (if (y-or-n-p (format "Save file %s? " | 1247 (if (y-or-n-p (format "Save file %s? " |
1138 (car fcc-list))) | 1248 fcc)) |
1139 (save-buffer)) | 1249 (save-buffer)) |
1140 (setq dont-write-the-file t)))) | 1250 (setq dont-write-the-file t)))) |
1141 (if max (narrow-to-region (point-min) max)))))) | 1251 (if max (narrow-to-region (point-min) max)))))) |
1142 ;; Append to the file directly, | 1252 ;; Append to the file directly, |
1143 ;; unless we've already taken care of it. | 1253 ;; unless we've already taken care of it. |
1144 (unless dont-write-the-file | 1254 (unless dont-write-the-file |
1145 (if (and (file-exists-p (car fcc-list)) | 1255 (if (and (file-exists-p fcc) |
1146 ;; Check that the file isn't empty. We don't | 1256 ;; Check that the file isn't empty. We don't |
1147 ;; want to insert a newline at the start of an | 1257 ;; want to insert a newline at the start of an |
1148 ;; empty file. | 1258 ;; empty file. |
1149 (not (zerop (nth 7 (file-attributes (car fcc-list))))) | 1259 (not (zerop (nth 7 (file-attributes fcc)))) |
1150 (mail-file-babyl-p (car fcc-list))) | 1260 (mail-file-babyl-p fcc)) |
1151 ;; If the file is a Babyl file, | 1261 ;; If the file is a Babyl file, |
1152 ;; convert the message to Babyl format. | 1262 ;; convert the message to Babyl format. |
1153 (let ((coding-system-for-write | 1263 (let ((coding-system-for-write |
1154 (or rmail-file-coding-system | 1264 (or rmail-file-coding-system |
1155 'emacs-mule))) | 1265 'emacs-mule))) |
1156 (save-excursion | 1266 (with-current-buffer (get-buffer-create " mail-temp") |
1157 (set-buffer (get-buffer-create " mail-temp")) | |
1158 (setq buffer-read-only nil) | 1267 (setq buffer-read-only nil) |
1159 (erase-buffer) | 1268 (erase-buffer) |
1160 (insert "\C-l\n0, unseen,,\n*** EOOH ***\n" | 1269 (insert "\C-l\n0, unseen,,\n*** EOOH ***\nDate: " |
1161 "Date: " (mail-rfc822-date) "\n") | 1270 (mail-rfc822-date) "\n") |
1162 (insert-buffer-substring curbuf beg2 end) | 1271 (insert-buffer-substring curbuf beg2 end) |
1163 (insert "\n\C-_") | 1272 (insert "\n\C-_") |
1164 (write-region (point-min) (point-max) (car fcc-list) t) | 1273 (write-region (point-min) (point-max) fcc t) |
1165 (erase-buffer))) | 1274 (erase-buffer))) |
1166 (write-region | 1275 (write-region |
1167 (1+ (point-min)) (point-max) (car fcc-list) t))) | 1276 (1+ (point-min)) (point-max) fcc t))) |
1168 (and buffer (not dont-write-the-file) | 1277 (and buffer (not dont-write-the-file) |
1169 (with-current-buffer buffer | 1278 (with-current-buffer buffer |
1170 (set-visited-file-modtime)))) | 1279 (set-visited-file-modtime)))))) |
1171 (setq fcc-list (cdr fcc-list)))) | |
1172 (kill-buffer tembuf))) | 1280 (kill-buffer tembuf))) |
1173 | 1281 |
1174 (defun mail-sent-via () | 1282 (defun mail-sent-via () |
1175 "Make a Sent-via header line from each To or CC header line." | 1283 "Make a Sent-via header line from each To or CC header line." |
1176 (interactive) | 1284 (interactive) |
1177 (save-excursion | 1285 (save-excursion |
1178 ;; put a marker at the end of the header | 1286 ;; put a marker at the end of the header |
1179 (let ((end (copy-marker (mail-header-end))) | 1287 (let ((end (copy-marker (mail-header-end))) |
1180 (case-fold-search t) | 1288 (case-fold-search t)) |
1181 to-line) | |
1182 (goto-char (point-min)) | 1289 (goto-char (point-min)) |
1183 ;; search for the To: lines and make Sent-via: lines from them | 1290 ;; search for the To: lines and make Sent-via: lines from them |
1184 ;; search for the next To: line | 1291 ;; search for the next To: line |
1185 (while (re-search-forward "^\\(to\\|cc\\):" end t) | 1292 (while (re-search-forward "^\\(to\\|cc\\):" end t) |
1186 ;; Grab this line plus all its continuations, sans the `to:'. | 1293 ;; Grab this line plus all its continuations, sans the `to:'. |
1233 (defun mail-reply-to () | 1340 (defun mail-reply-to () |
1234 "Move point to end of Reply-To-field. Create a Reply-To field if none." | 1341 "Move point to end of Reply-To-field. Create a Reply-To field if none." |
1235 (interactive) | 1342 (interactive) |
1236 (expand-abbrev) | 1343 (expand-abbrev) |
1237 (mail-position-on-field "Reply-To")) | 1344 (mail-position-on-field "Reply-To")) |
1345 | |
1346 (defun mail-mail-reply-to () | |
1347 "Move point to end of Mail-Reply-To field. | |
1348 Create a Mail-Reply-To field if none." | |
1349 (interactive) | |
1350 (expand-abbrev) | |
1351 (or (mail-position-on-field "mail-reply-to" t) | |
1352 (progn (mail-position-on-field "to") | |
1353 (insert "\nMail-Reply-To: ")))) | |
1354 | |
1355 (defun mail-mail-followup-to () | |
1356 "Move point to end of Mail-Followup-To field. | |
1357 Create a Mail-Followup-To field if none." | |
1358 (interactive) | |
1359 (expand-abbrev) | |
1360 (or (mail-position-on-field "mail-followup-to" t) | |
1361 (progn (mail-position-on-field "to") | |
1362 (insert "\nMail-Followup-To: ")))) | |
1238 | 1363 |
1239 (defun mail-position-on-field (field &optional soft) | 1364 (defun mail-position-on-field (field &optional soft) |
1240 (let (end | 1365 (let (end |
1241 (case-fold-search t)) | 1366 (case-fold-search t)) |
1242 (setq end (mail-header-end)) | 1367 (setq end (mail-header-end)) |
1322 (apply (car original) (cdr original)) | 1447 (apply (car original) (cdr original)) |
1323 ;; If the original message is in another window in the same frame, | 1448 ;; If the original message is in another window in the same frame, |
1324 ;; delete that window to save screen space. | 1449 ;; delete that window to save screen space. |
1325 ;; t means don't alter other frames. | 1450 ;; t means don't alter other frames. |
1326 (delete-windows-on original t) | 1451 (delete-windows-on original t) |
1327 (insert-buffer original) | 1452 (with-no-warnings |
1453 ;; We really want this to set mark. | |
1454 (insert-buffer original)) | |
1328 (set-text-properties (point) (mark t) nil)) | 1455 (set-text-properties (point) (mark t) nil)) |
1329 (if (consp arg) | 1456 (if (consp arg) |
1330 nil | 1457 nil |
1331 (goto-char start) | 1458 (goto-char start) |
1332 (let ((mail-indentation-spaces (if arg (prefix-numeric-value arg) | 1459 (let ((mail-indentation-spaces (if arg (prefix-numeric-value arg) |
1478 is inserted. | 1605 is inserted. |
1479 | 1606 |
1480 The normal hook `mail-setup-hook' is run after the message is | 1607 The normal hook `mail-setup-hook' is run after the message is |
1481 initialized. It can add more default fields to the message. | 1608 initialized. It can add more default fields to the message. |
1482 | 1609 |
1483 When calling from a program, the first argument if non-nil says | 1610 The first argument, NOERASE, determines what to do when there is |
1484 not to erase the existing contents of the `*mail*' buffer. | 1611 an existing modified `*mail*' buffer. If NOERASE is nil, the |
1612 existing mail buffer is used, and the user is prompted whether to | |
1613 keep the old contents or to erase them. If NOERASE has the value | |
1614 `new', a new mail buffer will be created instead of using the old | |
1615 one. Any other non-nil value means to always select the old | |
1616 buffer without erasing the contents. | |
1485 | 1617 |
1486 The second through fifth arguments, | 1618 The second through fifth arguments, |
1487 TO, SUBJECT, IN-REPLY-TO and CC, specify if non-nil | 1619 TO, SUBJECT, IN-REPLY-TO and CC, specify if non-nil |
1488 the initial contents of those header fields. | 1620 the initial contents of those header fields. |
1489 These arguments should not have final newlines. | 1621 These arguments should not have final newlines. |
1494 The seventh argument ACTIONS is a list of actions to take | 1626 The seventh argument ACTIONS is a list of actions to take |
1495 if/when the message is sent. Each action looks like (FUNCTION . ARGS); | 1627 if/when the message is sent. Each action looks like (FUNCTION . ARGS); |
1496 when the message is sent, we apply FUNCTION to ARGS. | 1628 when the message is sent, we apply FUNCTION to ARGS. |
1497 This is how Rmail arranges to mark messages `answered'." | 1629 This is how Rmail arranges to mark messages `answered'." |
1498 (interactive "P") | 1630 (interactive "P") |
1499 ;;; This is commented out because I found it was confusing in practice. | 1631 ;;; This is commented out because I found it was confusing in practice. |
1500 ;;; It is easy enough to rename *mail* by hand with rename-buffer | 1632 ;;; It is easy enough to rename *mail* by hand with rename-buffer |
1501 ;;; if you want to have multiple mail buffers. | 1633 ;;; if you want to have multiple mail buffers. |
1502 ;;; And then you can control which messages to save. --rms. | 1634 ;;; And then you can control which messages to save. --rms. |
1503 ;;; (let ((index 1) | 1635 ;;; (let ((index 1) |
1504 ;;; buffer) | 1636 ;;; buffer) |
1505 ;;; ;; If requested, look for a mail buffer that is modified and go to it. | 1637 ;;; ;; If requested, look for a mail buffer that is modified and go to it. |
1506 ;;; (if noerase | 1638 ;;; (if noerase |
1507 ;;; (progn | 1639 ;;; (progn |
1536 ;;; (mail-setup to subject in-reply-to cc replybuffer actions) | 1668 ;;; (mail-setup to subject in-reply-to cc replybuffer actions) |
1537 ;;; (if (and buffer-auto-save-file-name | 1669 ;;; (if (and buffer-auto-save-file-name |
1538 ;;; (file-exists-p buffer-auto-save-file-name)) | 1670 ;;; (file-exists-p buffer-auto-save-file-name)) |
1539 ;;; (message "Auto save file for draft message exists; consider M-x mail-recover")) | 1671 ;;; (message "Auto save file for draft message exists; consider M-x mail-recover")) |
1540 ;;; t)) | 1672 ;;; t)) |
1541 (pop-to-buffer "*mail*") | 1673 |
1674 (if (eq noerase 'new) | |
1675 (pop-to-buffer (generate-new-buffer "*mail*")) | |
1676 (and noerase | |
1677 (not (get-buffer "*mail*")) | |
1678 (setq noerase nil)) | |
1679 (pop-to-buffer "*mail*")) | |
1680 | |
1542 ;; Avoid danger that the auto-save file can't be written. | 1681 ;; Avoid danger that the auto-save file can't be written. |
1543 (let ((dir (expand-file-name | 1682 (let ((dir (expand-file-name |
1544 (file-name-as-directory mail-default-directory)))) | 1683 (file-name-as-directory mail-default-directory)))) |
1545 (if (file-exists-p dir) | 1684 (if (file-exists-p dir) |
1546 (setq default-directory dir))) | 1685 (setq default-directory dir))) |
1549 (and (not auto-save-default) buffer-auto-save-file-name)) | 1688 (and (not auto-save-default) buffer-auto-save-file-name)) |
1550 (auto-save-mode auto-save-default)) | 1689 (auto-save-mode auto-save-default)) |
1551 (mail-mode) | 1690 (mail-mode) |
1552 ;; Disconnect the buffer from its visited file | 1691 ;; Disconnect the buffer from its visited file |
1553 ;; (in case the user has actually visited a file *mail*). | 1692 ;; (in case the user has actually visited a file *mail*). |
1554 ; (set-visited-file-name nil) | 1693 ;;; (set-visited-file-name nil) |
1555 (let (initialized) | 1694 (let (initialized) |
1556 (and (not noerase) | 1695 (and (not (and noerase |
1696 (not (eq noerase 'new)))) | |
1557 (if buffer-file-name | 1697 (if buffer-file-name |
1558 (if (buffer-modified-p) | 1698 (if (buffer-modified-p) |
1559 (when (y-or-n-p "Buffer has unsaved changes; reinitialize it and discard them? ") | 1699 (when (y-or-n-p "Buffer has unsaved changes; reinitialize it and discard them? ") |
1560 (if (y-or-n-p "Disconnect buffer from visited file? ") | 1700 (if (y-or-n-p "Disconnect buffer from visited file? ") |
1561 (set-visited-file-name nil)) | 1701 (set-visited-file-name nil)) |
1716 (same-window-buffer-names nil) | 1856 (same-window-buffer-names nil) |
1717 (same-window-regexps nil)) | 1857 (same-window-regexps nil)) |
1718 (pop-to-buffer "*mail*")) | 1858 (pop-to-buffer "*mail*")) |
1719 (mail noerase to subject in-reply-to cc replybuffer sendactions)) | 1859 (mail noerase to subject in-reply-to cc replybuffer sendactions)) |
1720 | 1860 |
1721 ;;; Do not add anything but external entries on this page. | 1861 ;; Do not add anything but external entries on this page. |
1722 | 1862 |
1723 (provide 'sendmail) | 1863 (provide 'sendmail) |
1724 | 1864 |
1865 ;; arch-tag: 48bc1025-d993-4d31-8d81-2a29491f0626 | |
1725 ;;; sendmail.el ends here | 1866 ;;; sendmail.el ends here |