Commit | Line | Data |
---|---|---|
9e30862d | 1 | ;;; message.el --- composing mail and news messages -*- coding: iso-latin-1 -*- |
43273f39 | 2 | ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 |
16409b0b | 3 | ;; Free Software Foundation, Inc. |
eec82323 | 4 | |
6748645f | 5 | ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
eec82323 LMI |
6 | ;; Keywords: mail, news |
7 | ||
8 | ;; This file is part of GNU Emacs. | |
9 | ||
10 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
11 | ;; it under the terms of the GNU General Public License as published by | |
12 | ;; the Free Software Foundation; either version 2, or (at your option) | |
13 | ;; any later version. | |
14 | ||
15 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;; GNU General Public License for more details. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
21 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
22 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
23 | ;; Boston, MA 02111-1307, USA. | |
24 | ||
25 | ;;; Commentary: | |
26 | ||
27 | ;; This mode provides mail-sending facilities from within Emacs. It | |
28 | ;; consists mainly of large chunks of code from the sendmail.el, | |
29 | ;; gnus-msg.el and rnewspost.el files. | |
30 | ||
31 | ;;; Code: | |
32 | ||
16409b0b GM |
33 | (eval-when-compile |
34 | (require 'cl) | |
35 | (defvar gnus-list-identifiers)) ; gnus-sum is required where necessary | |
eec82323 | 36 | (require 'mailheader) |
eec82323 | 37 | (require 'nnheader) |
16409b0b GM |
38 | ;; This is apparently necessary even though things are autoloaded: |
39 | (if (featurep 'xemacs) | |
40 | (require 'mail-abbrevs)) | |
41 | (require 'mail-parse) | |
42 | (require 'mml) | |
eec82323 LMI |
43 | |
44 | (defgroup message '((user-mail-address custom-variable) | |
45 | (user-full-name custom-variable)) | |
46 | "Mail and news message composing." | |
47 | :link '(custom-manual "(message)Top") | |
48 | :group 'mail | |
49 | :group 'news) | |
50 | ||
51 | (put 'user-mail-address 'custom-type 'string) | |
52 | (put 'user-full-name 'custom-type 'string) | |
53 | ||
54 | (defgroup message-various nil | |
55 | "Various Message Variables" | |
56 | :link '(custom-manual "(message)Various Message Variables") | |
57 | :group 'message) | |
58 | ||
59 | (defgroup message-buffers nil | |
60 | "Message Buffers" | |
61 | :link '(custom-manual "(message)Message Buffers") | |
62 | :group 'message) | |
63 | ||
64 | (defgroup message-sending nil | |
65 | "Message Sending" | |
66 | :link '(custom-manual "(message)Sending Variables") | |
67 | :group 'message) | |
68 | ||
69 | (defgroup message-interface nil | |
70 | "Message Interface" | |
71 | :link '(custom-manual "(message)Interface") | |
72 | :group 'message) | |
73 | ||
74 | (defgroup message-forwarding nil | |
75 | "Message Forwarding" | |
76 | :link '(custom-manual "(message)Forwarding") | |
77 | :group 'message-interface) | |
78 | ||
79 | (defgroup message-insertion nil | |
80 | "Message Insertion" | |
81 | :link '(custom-manual "(message)Insertion") | |
82 | :group 'message) | |
83 | ||
84 | (defgroup message-headers nil | |
85 | "Message Headers" | |
86 | :link '(custom-manual "(message)Message Headers") | |
87 | :group 'message) | |
88 | ||
89 | (defgroup message-news nil | |
90 | "Composing News Messages" | |
91 | :group 'message) | |
92 | ||
93 | (defgroup message-mail nil | |
94 | "Composing Mail Messages" | |
95 | :group 'message) | |
96 | ||
97 | (defgroup message-faces nil | |
98 | "Faces used for message composing." | |
99 | :group 'message | |
100 | :group 'faces) | |
101 | ||
102 | (defcustom message-directory "~/Mail/" | |
103 | "*Directory from which all other mail file variables are derived." | |
104 | :group 'message-various | |
105 | :type 'directory) | |
106 | ||
107 | (defcustom message-max-buffers 10 | |
108 | "*How many buffers to keep before starting to kill them off." | |
109 | :group 'message-buffers | |
110 | :type 'integer) | |
111 | ||
112 | (defcustom message-send-rename-function nil | |
113 | "Function called to rename the buffer after sending it." | |
114 | :group 'message-buffers | |
7d829636 | 115 | :type '(choice function (const nil))) |
eec82323 LMI |
116 | |
117 | (defcustom message-fcc-handler-function 'message-output | |
118 | "*A function called to save outgoing articles. | |
119 | This function will be called with the name of the file to store the | |
120 | article in. The default function is `message-output' which saves in Unix | |
121 | mailbox format." | |
122 | :type '(radio (function-item message-output) | |
123 | (function :tag "Other")) | |
124 | :group 'message-sending) | |
125 | ||
126 | (defcustom message-courtesy-message | |
127 | "The following message is a courtesy copy of an article\nthat has been posted to %s as well.\n\n" | |
128 | "*This is inserted at the start of a mailed copy of a posted message. | |
129 | If the string contains the format spec \"%s\", the Newsgroups | |
130 | the article has been posted to will be inserted there. | |
131 | If this variable is nil, no such courtesy message will be added." | |
132 | :group 'message-sending | |
133 | :type 'string) | |
134 | ||
135 | (defcustom message-ignored-bounced-headers "^\\(Received\\|Return-Path\\):" | |
136 | "*Regexp that matches headers to be removed in resent bounced mail." | |
137 | :group 'message-interface | |
138 | :type 'regexp) | |
139 | ||
140 | ;;;###autoload | |
141 | (defcustom message-from-style 'default | |
142 | "*Specifies how \"From\" headers look. | |
143 | ||
7d829636 | 144 | If nil, they contain just the return address like: |
eec82323 LMI |
145 | king@grassland.com |
146 | If `parens', they look like: | |
147 | king@grassland.com (Elvis Parsley) | |
148 | If `angles', they look like: | |
149 | Elvis Parsley <king@grassland.com> | |
150 | ||
151 | Otherwise, most addresses look like `angles', but they look like | |
152 | `parens' if `angles' would need quoting and `parens' would not." | |
153 | :type '(choice (const :tag "simple" nil) | |
154 | (const parens) | |
155 | (const angles) | |
156 | (const default)) | |
157 | :group 'message-headers) | |
158 | ||
159 | (defcustom message-syntax-checks nil | |
16409b0b | 160 | ;; Guess this one shouldn't be easy to customize... |
6748645f | 161 | "*Controls what syntax checks should not be performed on outgoing posts. |
eec82323 LMI |
162 | To disable checking of long signatures, for instance, add |
163 | `(signature . disabled)' to this list. | |
164 | ||
165 | Don't touch this variable unless you really know what you're doing. | |
166 | ||
7d829636 DL |
167 | Checks include `subject-cmsg', `multiple-headers', `sendsys', |
168 | `message-id', `from', `long-lines', `control-chars', `size', | |
169 | `new-text', `quoting-style', `redirected-followup', `signature', | |
170 | `approved', `sender', `empty', `empty-headers', `message-id', `from', | |
171 | `subject', `shorten-followup-to', `existing-newsgroups', | |
172 | `buffer-file-name', `unchanged', `newsgroups'." | |
16409b0b | 173 | :group 'message-news |
7d829636 | 174 | :type '(repeat sexp)) ; Fixme: improve this |
eec82323 LMI |
175 | |
176 | (defcustom message-required-news-headers | |
177 | '(From Newsgroups Subject Date Message-ID | |
178 | (optional . Organization) Lines | |
16409b0b | 179 | (optional . User-Agent)) |
6748645f | 180 | "*Headers to be generated or prompted for when posting an article. |
eec82323 LMI |
181 | RFC977 and RFC1036 require From, Date, Newsgroups, Subject, |
182 | Message-ID. Organization, Lines, In-Reply-To, Expires, and | |
16409b0b | 183 | User-Agent are optional. If don't you want message to insert some |
eec82323 LMI |
184 | header, remove it from this list." |
185 | :group 'message-news | |
186 | :group 'message-headers | |
187 | :type '(repeat sexp)) | |
188 | ||
189 | (defcustom message-required-mail-headers | |
190 | '(From Subject Date (optional . In-Reply-To) Message-ID Lines | |
16409b0b | 191 | (optional . User-Agent)) |
6748645f | 192 | "*Headers to be generated or prompted for when mailing a message. |
eec82323 | 193 | RFC822 required that From, Date, To, Subject and Message-ID be |
16409b0b | 194 | included. Organization, Lines and User-Agent are optional." |
eec82323 LMI |
195 | :group 'message-mail |
196 | :group 'message-headers | |
197 | :type '(repeat sexp)) | |
198 | ||
199 | (defcustom message-deletable-headers '(Message-ID Date Lines) | |
200 | "Headers to be deleted if they already exist and were generated by message previously." | |
201 | :group 'message-headers | |
202 | :type 'sexp) | |
203 | ||
204 | (defcustom message-ignored-news-headers | |
6748645f | 205 | "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:" |
eec82323 LMI |
206 | "*Regexp of headers to be removed unconditionally before posting." |
207 | :group 'message-news | |
208 | :group 'message-headers | |
209 | :type 'regexp) | |
210 | ||
6748645f | 211 | (defcustom message-ignored-mail-headers "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:" |
eec82323 LMI |
212 | "*Regexp of headers to be removed unconditionally before mailing." |
213 | :group 'message-mail | |
214 | :group 'message-headers | |
215 | :type 'regexp) | |
216 | ||
16409b0b | 217 | (defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:" |
eec82323 LMI |
218 | "*Header lines matching this regexp will be deleted before posting. |
219 | It's best to delete old Path and Date headers before posting to avoid | |
220 | any confusion." | |
221 | :group 'message-interface | |
222 | :type 'regexp) | |
223 | ||
6748645f LMI |
224 | (defcustom message-subject-re-regexp "^[ \t]*\\([Rr][Ee]:[ \t]*\\)*[ \t]*" |
225 | "*Regexp matching \"Re: \" in the subject line." | |
226 | :group 'message-various | |
227 | :type 'regexp) | |
228 | ||
eec82323 LMI |
229 | ;;;###autoload |
230 | (defcustom message-signature-separator "^-- *$" | |
231 | "Regexp matching the signature separator." | |
232 | :type 'regexp | |
233 | :group 'message-various) | |
234 | ||
16409b0b | 235 | (defcustom message-elide-ellipsis "\n[...]\n\n" |
6748645f LMI |
236 | "*The string which is inserted for elided text." |
237 | :type 'string | |
238 | :group 'message-various) | |
eec82323 LMI |
239 | |
240 | (defcustom message-interactive nil | |
241 | "Non-nil means when sending a message wait for and display errors. | |
242 | nil means let mailer mail back a message to report errors." | |
243 | :group 'message-sending | |
244 | :group 'message-mail | |
245 | :type 'boolean) | |
246 | ||
16409b0b | 247 | (defcustom message-generate-new-buffers 'unique |
7d829636 | 248 | "*Non-nil means create a new message buffer whenever `message-setup' is called. |
eec82323 LMI |
249 | If this is a function, call that function with three parameters: The type, |
250 | the to address and the group name. (Any of these may be nil.) The function | |
251 | should return the new buffer name." | |
252 | :group 'message-buffers | |
253 | :type '(choice (const :tag "off" nil) | |
16409b0b GM |
254 | (const :tag "unique" unique) |
255 | (const :tag "unsent" unsent) | |
eec82323 LMI |
256 | (function fun))) |
257 | ||
258 | (defcustom message-kill-buffer-on-exit nil | |
259 | "*Non-nil means that the message buffer will be killed after sending a message." | |
260 | :group 'message-buffers | |
261 | :type 'boolean) | |
262 | ||
534aa266 DL |
263 | (eval-when-compile |
264 | (defvar gnus-local-organization)) | |
eec82323 LMI |
265 | (defcustom message-user-organization |
266 | (or (and (boundp 'gnus-local-organization) | |
267 | (stringp gnus-local-organization) | |
268 | gnus-local-organization) | |
269 | (getenv "ORGANIZATION") | |
270 | t) | |
271 | "*String to be used as an Organization header. | |
272 | If t, use `message-user-organization-file'." | |
273 | :group 'message-headers | |
274 | :type '(choice string | |
275 | (const :tag "consult file" t))) | |
276 | ||
277 | ;;;###autoload | |
278 | (defcustom message-user-organization-file "/usr/lib/news/organization" | |
279 | "*Local news organization file." | |
280 | :type 'file | |
281 | :group 'message-headers) | |
282 | ||
6748645f LMI |
283 | (defcustom message-make-forward-subject-function |
284 | 'message-forward-subject-author-subject | |
7d829636 | 285 | "*List of functions called to generate subject headers for forwarded messages. |
6748645f LMI |
286 | The subject generated by the previous function is passed into each |
287 | successive function. | |
288 | ||
289 | The provided functions are: | |
290 | ||
7d829636 | 291 | * `message-forward-subject-author-subject' (Source of article (author or |
6748645f | 292 | newsgroup)), in brackets followed by the subject |
7d829636 | 293 | * `message-forward-subject-fwd' (Subject of article with 'Fwd:' prepended |
6748645f | 294 | to it." |
16409b0b GM |
295 | :group 'message-forwarding |
296 | :type '(radio (function-item message-forward-subject-author-subject) | |
7d829636 DL |
297 | (function-item message-forward-subject-fwd) |
298 | (repeat :tag "List of functions" function))) | |
16409b0b GM |
299 | |
300 | (defcustom message-forward-as-mime t | |
301 | "*If non-nil, forward messages as an inline/rfc822 MIME section. Otherwise, directly inline the old message in the forwarded message." | |
2d447df6 | 302 | :version "21.1" |
16409b0b GM |
303 | :group 'message-forwarding |
304 | :type 'boolean) | |
305 | ||
306 | (defcustom message-forward-show-mml t | |
307 | "*If non-nil, forward messages are shown as mml. Otherwise, forward messages are unchanged." | |
88818fbe | 308 | :version "21.1" |
16409b0b GM |
309 | :group 'message-forwarding |
310 | :type 'boolean) | |
311 | ||
312 | (defcustom message-forward-before-signature t | |
313 | "*If non-nil, put forwarded message before signature, else after." | |
314 | :group 'message-forwarding | |
315 | :type 'boolean) | |
6748645f LMI |
316 | |
317 | (defcustom message-wash-forwarded-subjects nil | |
318 | "*If non-nil, try to remove as much old cruft as possible from the subject of messages before generating the new subject of a forward." | |
319 | :group 'message-forwarding | |
320 | :type 'boolean) | |
321 | ||
16409b0b | 322 | (defcustom message-ignored-resent-headers "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:" |
eec82323 LMI |
323 | "*All headers that match this regexp will be deleted when resending a message." |
324 | :group 'message-interface | |
325 | :type 'regexp) | |
326 | ||
16409b0b GM |
327 | (defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus" |
328 | "*All headers that match this regexp will be deleted when forwarding a message." | |
2d447df6 | 329 | :version "21.1" |
16409b0b GM |
330 | :group 'message-forwarding |
331 | :type '(choice (const :tag "None" nil) | |
332 | regexp)) | |
333 | ||
eec82323 LMI |
334 | (defcustom message-ignored-cited-headers "." |
335 | "*Delete these headers from the messages you yank." | |
336 | :group 'message-insertion | |
337 | :type 'regexp) | |
338 | ||
16409b0b | 339 | (defcustom message-cancel-message "I am canceling my own article.\n" |
eec82323 LMI |
340 | "Message to be inserted in the cancel message." |
341 | :group 'message-interface | |
342 | :type 'string) | |
343 | ||
344 | ;; Useful to set in site-init.el | |
345 | ;;;###autoload | |
346 | (defcustom message-send-mail-function 'message-send-mail-with-sendmail | |
347 | "Function to call to send the current buffer as mail. | |
348 | The headers should be delimited by a line whose contents match the | |
349 | variable `mail-header-separator'. | |
350 | ||
16409b0b | 351 | Valid values include `message-send-mail-with-sendmail' (the default), |
7d829636 DL |
352 | `message-send-mail-with-mh', `message-send-mail-with-qmail', |
353 | `smtpmail-send-it' and `feedmail-send-it'. | |
354 | ||
355 | See also `send-mail-function'." | |
eec82323 LMI |
356 | :type '(radio (function-item message-send-mail-with-sendmail) |
357 | (function-item message-send-mail-with-mh) | |
358 | (function-item message-send-mail-with-qmail) | |
6748645f | 359 | (function-item smtpmail-send-it) |
7d829636 | 360 | (function-item feedmail-send-it) |
eec82323 LMI |
361 | (function :tag "Other")) |
362 | :group 'message-sending | |
363 | :group 'message-mail) | |
364 | ||
365 | (defcustom message-send-news-function 'message-send-news | |
366 | "Function to call to send the current buffer as news. | |
367 | The headers should be delimited by a line whose contents match the | |
368 | variable `mail-header-separator'." | |
369 | :group 'message-sending | |
370 | :group 'message-news | |
371 | :type 'function) | |
372 | ||
373 | (defcustom message-reply-to-function nil | |
7d829636 | 374 | "If non-nil, function that should return a list of headers. |
eec82323 LMI |
375 | This function should pick out addresses from the To, Cc, and From headers |
376 | and respond with new To and Cc headers." | |
377 | :group 'message-interface | |
7d829636 | 378 | :type '(choice function (const nil))) |
eec82323 LMI |
379 | |
380 | (defcustom message-wide-reply-to-function nil | |
7d829636 | 381 | "If non-nil, function that should return a list of headers. |
eec82323 LMI |
382 | This function should pick out addresses from the To, Cc, and From headers |
383 | and respond with new To and Cc headers." | |
384 | :group 'message-interface | |
7d829636 | 385 | :type '(choice function (const nil))) |
eec82323 LMI |
386 | |
387 | (defcustom message-followup-to-function nil | |
7d829636 | 388 | "If non-nil, function that should return a list of headers. |
eec82323 LMI |
389 | This function should pick out addresses from the To, Cc, and From headers |
390 | and respond with new To and Cc headers." | |
391 | :group 'message-interface | |
7d829636 | 392 | :type '(choice function (const nil))) |
eec82323 LMI |
393 | |
394 | (defcustom message-use-followup-to 'ask | |
395 | "*Specifies what to do with Followup-To header. | |
396 | If nil, always ignore the header. If it is t, use its value, but | |
397 | query before using the \"poster\" value. If it is the symbol `ask', | |
398 | always query the user whether to use the value. If it is the symbol | |
399 | `use', always use the value." | |
400 | :group 'message-interface | |
401 | :type '(choice (const :tag "ignore" nil) | |
402 | (const use) | |
403 | (const ask))) | |
404 | ||
eec82323 | 405 | (defcustom message-sendmail-f-is-evil nil |
7d829636 | 406 | "*Non-nil means don't add \"-f username\" to the sendmail command line. |
16409b0b | 407 | Doing so would be even more evil than leaving it out." |
eec82323 LMI |
408 | :group 'message-sending |
409 | :type 'boolean) | |
410 | ||
411 | ;; qmail-related stuff | |
412 | (defcustom message-qmail-inject-program "/var/qmail/bin/qmail-inject" | |
413 | "Location of the qmail-inject program." | |
414 | :group 'message-sending | |
415 | :type 'file) | |
416 | ||
417 | (defcustom message-qmail-inject-args nil | |
418 | "Arguments passed to qmail-inject programs. | |
419 | This should be a list of strings, one string for each argument. | |
420 | ||
421 | For e.g., if you wish to set the envelope sender address so that bounces | |
422 | go to the right place or to deal with listserv's usage of that address, you | |
423 | might set this variable to '(\"-f\" \"you@some.where\")." | |
424 | :group 'message-sending | |
425 | :type '(repeat string)) | |
426 | ||
16409b0b GM |
427 | (defvar message-cater-to-broken-inn t |
428 | "Non-nil means Gnus should not fold the `References' header. | |
429 | Folding `References' makes ancient versions of INN create incorrect | |
430 | NOV lines.") | |
431 | ||
534aa266 DL |
432 | (eval-when-compile |
433 | (defvar gnus-post-method) | |
434 | (defvar gnus-select-method)) | |
eec82323 LMI |
435 | (defcustom message-post-method |
436 | (cond ((and (boundp 'gnus-post-method) | |
6748645f | 437 | (listp gnus-post-method) |
eec82323 LMI |
438 | gnus-post-method) |
439 | gnus-post-method) | |
440 | ((boundp 'gnus-select-method) | |
441 | gnus-select-method) | |
442 | (t '(nnspool ""))) | |
6748645f LMI |
443 | "*Method used to post news. |
444 | Note that when posting from inside Gnus, for instance, this | |
445 | variable isn't used." | |
eec82323 LMI |
446 | :group 'message-news |
447 | :group 'message-sending | |
448 | ;; This should be the `gnus-select-method' widget, but that might | |
449 | ;; create a dependence to `gnus.el'. | |
450 | :type 'sexp) | |
451 | ||
452 | (defcustom message-generate-headers-first nil | |
453 | "*If non-nil, generate all possible headers before composing." | |
454 | :group 'message-headers | |
455 | :type 'boolean) | |
456 | ||
457 | (defcustom message-setup-hook nil | |
458 | "Normal hook, run each time a new outgoing message is initialized. | |
459 | The function `message-setup' runs this hook." | |
460 | :group 'message-various | |
461 | :type 'hook) | |
462 | ||
16409b0b GM |
463 | (defcustom message-cancel-hook nil |
464 | "Hook run when cancelling articles." | |
465 | :group 'message-various | |
466 | :type 'hook) | |
467 | ||
eec82323 LMI |
468 | (defcustom message-signature-setup-hook nil |
469 | "Normal hook, run each time a new outgoing message is initialized. | |
470 | It is run after the headers have been inserted and before | |
471 | the signature is inserted." | |
472 | :group 'message-various | |
473 | :type 'hook) | |
474 | ||
475 | (defcustom message-mode-hook nil | |
476 | "Hook run in message mode buffers." | |
477 | :group 'message-various | |
478 | :type 'hook) | |
479 | ||
480 | (defcustom message-header-hook nil | |
481 | "Hook run in a message mode buffer narrowed to the headers." | |
482 | :group 'message-various | |
483 | :type 'hook) | |
484 | ||
485 | (defcustom message-header-setup-hook nil | |
6748645f | 486 | "Hook called narrowed to the headers when setting up a message buffer." |
eec82323 LMI |
487 | :group 'message-various |
488 | :type 'hook) | |
489 | ||
490 | ;;;###autoload | |
491 | (defcustom message-citation-line-function 'message-insert-citation-line | |
492 | "*Function called to insert the \"Whomever writes:\" line." | |
493 | :type 'function | |
494 | :group 'message-insertion) | |
495 | ||
496 | ;;;###autoload | |
497 | (defcustom message-yank-prefix "> " | |
16409b0b | 498 | "*Prefix inserted on the lines of yanked messages." |
eec82323 LMI |
499 | :type 'string |
500 | :group 'message-insertion) | |
501 | ||
502 | (defcustom message-indentation-spaces 3 | |
503 | "*Number of spaces to insert at the beginning of each cited line. | |
504 | Used by `message-yank-original' via `message-yank-cite'." | |
505 | :group 'message-insertion | |
506 | :type 'integer) | |
507 | ||
508 | ;;;###autoload | |
6748645f | 509 | (defcustom message-cite-function 'message-cite-original |
4a55f847 RS |
510 | "*Function for citing an original message. |
511 | Predefined functions include `message-cite-original' and | |
512 | `message-cite-original-without-signature'. | |
6748645f | 513 | Note that `message-cite-original' uses `mail-citation-hook' if that is non-nil." |
eec82323 | 514 | :type '(radio (function-item message-cite-original) |
16409b0b | 515 | (function-item message-cite-original-without-signature) |
eec82323 LMI |
516 | (function-item sc-cite-original) |
517 | (function :tag "Other")) | |
518 | :group 'message-insertion) | |
519 | ||
520 | ;;;###autoload | |
521 | (defcustom message-indent-citation-function 'message-indent-citation | |
522 | "*Function for modifying a citation just inserted in the mail buffer. | |
523 | This can also be a list of functions. Each function can find the | |
524 | citation between (point) and (mark t). And each function should leave | |
525 | point and mark around the citation text as modified." | |
526 | :type 'function | |
527 | :group 'message-insertion) | |
528 | ||
529 | (defvar message-abbrevs-loaded nil) | |
530 | ||
531 | ;;;###autoload | |
532 | (defcustom message-signature t | |
533 | "*String to be inserted at the end of the message buffer. | |
534 | If t, the `message-signature-file' file will be inserted instead. | |
535 | If a function, the result from the function will be used instead. | |
536 | If a form, the result from the form will be used instead." | |
537 | :type 'sexp | |
538 | :group 'message-insertion) | |
539 | ||
540 | ;;;###autoload | |
541 | (defcustom message-signature-file "~/.signature" | |
5449c317 DL |
542 | "*Name of file containing the text inserted at end of message buffer. |
543 | Ignored if the named file doesn't exist. | |
544 | If nil, don't insert a signature." | |
545 | :type '(choice file (const :tags "None" nil)) | |
eec82323 LMI |
546 | :group 'message-insertion) |
547 | ||
548 | (defcustom message-distribution-function nil | |
549 | "*Function called to return a Distribution header." | |
550 | :group 'message-news | |
551 | :group 'message-headers | |
7d829636 | 552 | :type '(choice function (const nil))) |
eec82323 LMI |
553 | |
554 | (defcustom message-expires 14 | |
555 | "Number of days before your article expires." | |
556 | :group 'message-news | |
557 | :group 'message-headers | |
558 | :link '(custom-manual "(message)News Headers") | |
559 | :type 'integer) | |
560 | ||
561 | (defcustom message-user-path nil | |
562 | "If nil, use the NNTP server name in the Path header. | |
563 | If stringp, use this; if non-nil, use no host name (user name only)." | |
564 | :group 'message-news | |
565 | :group 'message-headers | |
566 | :link '(custom-manual "(message)News Headers") | |
567 | :type '(choice (const :tag "nntp" nil) | |
568 | (string :tag "name") | |
569 | (sexp :tag "none" :format "%t" t))) | |
570 | ||
571 | (defvar message-reply-buffer nil) | |
572 | (defvar message-reply-headers nil) | |
573 | (defvar message-newsreader nil) | |
574 | (defvar message-mailer nil) | |
575 | (defvar message-sent-message-via nil) | |
576 | (defvar message-checksum nil) | |
577 | (defvar message-send-actions nil | |
578 | "A list of actions to be performed upon successful sending of a message.") | |
579 | (defvar message-exit-actions nil | |
580 | "A list of actions to be performed upon exiting after sending a message.") | |
581 | (defvar message-kill-actions nil | |
582 | "A list of actions to be performed before killing a message buffer.") | |
583 | (defvar message-postpone-actions nil | |
584 | "A list of actions to be performed after postponing a message.") | |
585 | ||
6748645f LMI |
586 | (define-widget 'message-header-lines 'text |
587 | "All header lines must be LFD terminated." | |
3536d0c1 | 588 | :format "%{%t%}:%n%v" |
6748645f LMI |
589 | :valid-regexp "^\\'" |
590 | :error "All header lines must be newline terminated") | |
591 | ||
eec82323 LMI |
592 | (defcustom message-default-headers "" |
593 | "*A string containing header lines to be inserted in outgoing messages. | |
594 | It is inserted before you edit the message, so you can edit or delete | |
595 | these lines." | |
596 | :group 'message-headers | |
6748645f | 597 | :type 'message-header-lines) |
eec82323 LMI |
598 | |
599 | (defcustom message-default-mail-headers "" | |
600 | "*A string of header lines to be inserted in outgoing mails." | |
601 | :group 'message-headers | |
602 | :group 'message-mail | |
6748645f | 603 | :type 'message-header-lines) |
eec82323 LMI |
604 | |
605 | (defcustom message-default-news-headers "" | |
16409b0b | 606 | "*A string of header lines to be inserted in outgoing news articles." |
eec82323 LMI |
607 | :group 'message-headers |
608 | :group 'message-news | |
6748645f | 609 | :type 'message-header-lines) |
eec82323 LMI |
610 | |
611 | ;; Note: could use /usr/ucb/mail instead of sendmail; | |
612 | ;; options -t, and -v if not interactive. | |
613 | (defcustom message-mailer-swallows-blank-line | |
614 | (if (and (string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)" | |
615 | system-configuration) | |
616 | (file-readable-p "/etc/sendmail.cf") | |
617 | (let ((buffer (get-buffer-create " *temp*"))) | |
618 | (unwind-protect | |
619 | (save-excursion | |
620 | (set-buffer buffer) | |
621 | (insert-file-contents "/etc/sendmail.cf") | |
622 | (goto-char (point-min)) | |
623 | (let ((case-fold-search nil)) | |
624 | (re-search-forward "^OR\\>" nil t))) | |
625 | (kill-buffer buffer)))) | |
626 | ;; According to RFC822, "The field-name must be composed of printable | |
627 | ;; ASCII characters (i. e., characters that have decimal values between | |
628 | ;; 33 and 126, except colon)", i. e., any chars except ctl chars, | |
629 | ;; space, or colon. | |
630 | '(looking-at "[ \t]\\|[][!\"#$%&'()*+,-./0-9;<=>?@A-Z\\\\^_`a-z{|}~]+:")) | |
6748645f | 631 | "*Set this non-nil if the system's mailer runs the header and body together. |
eec82323 LMI |
632 | \(This problem exists on Sunos 4 when sendmail is run in remote mode.) |
633 | The value should be an expression to test whether the problem will | |
634 | actually occur." | |
635 | :group 'message-sending | |
636 | :type 'sexp) | |
637 | ||
961a48db | 638 | ;;;###autoload |
16409b0b GM |
639 | (define-mail-user-agent 'message-user-agent |
640 | 'message-mail 'message-send-and-exit | |
641 | 'message-kill-buffer 'message-send-hook) | |
eec82323 LMI |
642 | |
643 | (defvar message-mh-deletable-headers '(Message-ID Date Lines Sender) | |
644 | "If non-nil, delete the deletable headers before feeding to mh.") | |
645 | ||
a8151ef7 LMI |
646 | (defvar message-send-method-alist |
647 | '((news message-news-p message-send-via-news) | |
648 | (mail message-mail-p message-send-via-mail)) | |
649 | "Alist of ways to send outgoing messages. | |
650 | Each element has the form | |
651 | ||
652 | \(TYPE PREDICATE FUNCTION) | |
653 | ||
654 | where TYPE is a symbol that names the method; PREDICATE is a function | |
655 | called without any parameters to determine whether the message is | |
656 | a message of type TYPE; and FUNCTION is a function to be called if | |
657 | PREDICATE returns non-nil. FUNCTION is called with one parameter -- | |
658 | the prefix.") | |
659 | ||
c541eb9a | 660 | (defcustom message-mail-alias-type 'abbrev |
a8151ef7 LMI |
661 | "*What alias expansion type to use in Message buffers. |
662 | The default is `abbrev', which uses mailabbrev. nil switches | |
c541eb9a DL |
663 | mail aliases off." |
664 | :group 'message | |
665 | :link '(custom-manual "(message)Mail Aliases") | |
666 | :type '(choice (const :tag "Use Mailabbrev" abbrev) | |
667 | (const :tag "No expansion" nil))) | |
a8151ef7 | 668 | |
6748645f | 669 | (defcustom message-auto-save-directory |
8c6f6f4b | 670 | (file-name-as-directory (nnheader-concat message-directory "drafts")) |
6748645f LMI |
671 | "*Directory where Message auto-saves buffers if Gnus isn't running. |
672 | If nil, Message won't auto-save." | |
673 | :group 'message-buffers | |
7d829636 | 674 | :type '(choice directory (const :tag "Don't auto-save" nil))) |
6748645f | 675 | |
16409b0b GM |
676 | (defcustom message-buffer-naming-style 'unique |
677 | "*The way new message buffers are named. | |
678 | Valid valued are `unique' and `unsent'." | |
2d447df6 | 679 | :version "21.1" |
16409b0b GM |
680 | :group 'message-buffers |
681 | :type '(choice (const :tag "unique" unique) | |
682 | (const :tag "unsent" unsent))) | |
683 | ||
7d829636 | 684 | (defcustom message-default-charset |
83595c0c DL |
685 | (and (not (mm-multibyte-p)) 'iso-8859-1) |
686 | "Default charset used in non-MULE Emacsen. | |
687 | If nil, you might be asked to input the charset." | |
2d447df6 | 688 | :version "21.1" |
16409b0b GM |
689 | :group 'message |
690 | :type 'symbol) | |
691 | ||
7d829636 | 692 | (defcustom message-dont-reply-to-names |
16409b0b GM |
693 | (and (boundp 'rmail-dont-reply-to-names) rmail-dont-reply-to-names) |
694 | "*A regexp specifying names to prune when doing wide replies. | |
695 | A value of nil means exclude your own name only." | |
2d447df6 | 696 | :version "21.1" |
16409b0b GM |
697 | :group 'message |
698 | :type '(choice (const :tag "Yourself" nil) | |
699 | regexp)) | |
700 | ||
eec82323 LMI |
701 | ;;; Internal variables. |
702 | ;;; Well, not really internal. | |
703 | ||
704 | (defvar message-mode-syntax-table | |
705 | (let ((table (copy-syntax-table text-mode-syntax-table))) | |
706 | (modify-syntax-entry ?% ". " table) | |
16409b0b GM |
707 | (modify-syntax-entry ?> ". " table) |
708 | (modify-syntax-entry ?< ". " table) | |
eec82323 LMI |
709 | table) |
710 | "Syntax table used while in Message mode.") | |
711 | ||
712 | (defvar message-mode-abbrev-table text-mode-abbrev-table | |
713 | "Abbrev table used in Message mode buffers. | |
714 | Defaults to `text-mode-abbrev-table'.") | |
eec82323 LMI |
715 | |
716 | (defface message-header-to-face | |
717 | '((((class color) | |
718 | (background dark)) | |
43273f39 | 719 | (:foreground "green2" :weight bold)) |
eec82323 LMI |
720 | (((class color) |
721 | (background light)) | |
43273f39 | 722 | (:foreground "MidnightBlue" :weight bold)) |
eec82323 | 723 | (t |
43273f39 | 724 | (:weight bold :slant italic))) |
eec82323 LMI |
725 | "Face used for displaying From headers." |
726 | :group 'message-faces) | |
727 | ||
728 | (defface message-header-cc-face | |
729 | '((((class color) | |
730 | (background dark)) | |
43273f39 | 731 | (:foreground "green4" :weight bold)) |
eec82323 LMI |
732 | (((class color) |
733 | (background light)) | |
734 | (:foreground "MidnightBlue")) | |
735 | (t | |
43273f39 | 736 | (:weight bold))) |
eec82323 LMI |
737 | "Face used for displaying Cc headers." |
738 | :group 'message-faces) | |
739 | ||
740 | (defface message-header-subject-face | |
741 | '((((class color) | |
742 | (background dark)) | |
743 | (:foreground "green3")) | |
744 | (((class color) | |
745 | (background light)) | |
43273f39 | 746 | (:foreground "navy blue" :weight bold)) |
eec82323 | 747 | (t |
43273f39 | 748 | (:weight bold))) |
eec82323 LMI |
749 | "Face used for displaying subject headers." |
750 | :group 'message-faces) | |
751 | ||
752 | (defface message-header-newsgroups-face | |
753 | '((((class color) | |
754 | (background dark)) | |
43273f39 | 755 | (:foreground "yellow" :weight bold :slant italic)) |
eec82323 LMI |
756 | (((class color) |
757 | (background light)) | |
43273f39 | 758 | (:foreground "blue4" :weight bold :slant italic)) |
eec82323 | 759 | (t |
43273f39 | 760 | (:weight bold :slant italic))) |
eec82323 LMI |
761 | "Face used for displaying newsgroups headers." |
762 | :group 'message-faces) | |
763 | ||
764 | (defface message-header-other-face | |
765 | '((((class color) | |
766 | (background dark)) | |
6748645f | 767 | (:foreground "#b00000")) |
eec82323 LMI |
768 | (((class color) |
769 | (background light)) | |
770 | (:foreground "steel blue")) | |
771 | (t | |
43273f39 | 772 | (:weight bold :slant italic))) |
eec82323 LMI |
773 | "Face used for displaying newsgroups headers." |
774 | :group 'message-faces) | |
775 | ||
776 | (defface message-header-name-face | |
777 | '((((class color) | |
778 | (background dark)) | |
779 | (:foreground "DarkGreen")) | |
780 | (((class color) | |
781 | (background light)) | |
782 | (:foreground "cornflower blue")) | |
783 | (t | |
43273f39 | 784 | (:weight bold))) |
eec82323 LMI |
785 | "Face used for displaying header names." |
786 | :group 'message-faces) | |
787 | ||
788 | (defface message-header-xheader-face | |
789 | '((((class color) | |
790 | (background dark)) | |
791 | (:foreground "blue")) | |
792 | (((class color) | |
793 | (background light)) | |
794 | (:foreground "blue")) | |
795 | (t | |
43273f39 | 796 | (:weight bold))) |
eec82323 LMI |
797 | "Face used for displaying X-Header headers." |
798 | :group 'message-faces) | |
799 | ||
800 | (defface message-separator-face | |
801 | '((((class color) | |
802 | (background dark)) | |
6748645f | 803 | (:foreground "blue3")) |
eec82323 LMI |
804 | (((class color) |
805 | (background light)) | |
806 | (:foreground "brown")) | |
807 | (t | |
43273f39 | 808 | (:weight bold))) |
eec82323 LMI |
809 | "Face used for displaying the separator." |
810 | :group 'message-faces) | |
811 | ||
812 | (defface message-cited-text-face | |
813 | '((((class color) | |
814 | (background dark)) | |
815 | (:foreground "red")) | |
816 | (((class color) | |
817 | (background light)) | |
818 | (:foreground "red")) | |
819 | (t | |
43273f39 | 820 | (:weight bold))) |
eec82323 LMI |
821 | "Face used for displaying cited text names." |
822 | :group 'message-faces) | |
823 | ||
16409b0b GM |
824 | (defface message-mml-face |
825 | '((((class color) | |
826 | (background dark)) | |
827 | (:foreground "ForestGreen")) | |
828 | (((class color) | |
829 | (background light)) | |
830 | (:foreground "ForestGreen")) | |
831 | (t | |
43273f39 | 832 | (:weight bold))) |
16409b0b GM |
833 | "Face used for displaying MML." |
834 | :group 'message-faces) | |
835 | ||
eec82323 | 836 | (defvar message-font-lock-keywords |
8befbee7 | 837 | (let* ((cite-prefix "[:alpha:]") |
eec82323 | 838 | (cite-suffix (concat cite-prefix "0-9_.@-")) |
000281e3 | 839 | (content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)\n?")) |
a8151ef7 | 840 | `((,(concat "^\\([Tt]o:\\)" content) |
eec82323 LMI |
841 | (1 'message-header-name-face) |
842 | (2 'message-header-to-face nil t)) | |
a8151ef7 | 843 | (,(concat "^\\(^[GBF]?[Cc][Cc]:\\|^[Rr]eply-[Tt]o:\\)" content) |
eec82323 LMI |
844 | (1 'message-header-name-face) |
845 | (2 'message-header-cc-face nil t)) | |
a8151ef7 | 846 | (,(concat "^\\([Ss]ubject:\\)" content) |
eec82323 LMI |
847 | (1 'message-header-name-face) |
848 | (2 'message-header-subject-face nil t)) | |
a8151ef7 | 849 | (,(concat "^\\([Nn]ewsgroups:\\|Followup-[Tt]o:\\)" content) |
eec82323 LMI |
850 | (1 'message-header-name-face) |
851 | (2 'message-header-newsgroups-face nil t)) | |
a8151ef7 | 852 | (,(concat "^\\([A-Z][^: \n\t]+:\\)" content) |
eec82323 LMI |
853 | (1 'message-header-name-face) |
854 | (2 'message-header-other-face nil t)) | |
855 | (,(concat "^\\(X-[A-Za-z0-9-]+\\|In-Reply-To\\):" content) | |
856 | (1 'message-header-name-face) | |
857 | (2 'message-header-name-face)) | |
6748645f LMI |
858 | ,@(if (and mail-header-separator |
859 | (not (equal mail-header-separator ""))) | |
860 | `((,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$") | |
861 | 1 'message-separator-face)) | |
862 | nil) | |
eec82323 LMI |
863 | (,(concat "^[ \t]*" |
864 | "\\([" cite-prefix "]+[" cite-suffix "]*\\)?" | |
6748645f | 865 | "[:>|}].*") |
16409b0b GM |
866 | (0 'message-cited-text-face)) |
867 | ("<#/?\\(multipart\\|part\\|external\\|mml\\).*>" | |
868 | (0 'message-mml-face)))) | |
eec82323 LMI |
869 | "Additional expressions to highlight in Message mode.") |
870 | ||
6748645f LMI |
871 | ;; XEmacs does it like this. For Emacs, we have to set the |
872 | ;; `font-lock-defaults' buffer-local variable. | |
873 | (put 'message-mode 'font-lock-defaults '(message-font-lock-keywords t)) | |
874 | ||
eec82323 LMI |
875 | (defvar message-face-alist |
876 | '((bold . bold-region) | |
877 | (underline . underline-region) | |
878 | (default . (lambda (b e) | |
879 | (unbold-region b e) | |
880 | (ununderline-region b e)))) | |
881 | "Alist of mail and news faces for facemenu. | |
8f688cb0 | 882 | The cdr of each entry is a function for applying the face to a region.") |
eec82323 LMI |
883 | |
884 | (defcustom message-send-hook nil | |
885 | "Hook run before sending messages." | |
886 | :group 'message-various | |
887 | :options '(ispell-message) | |
888 | :type 'hook) | |
889 | ||
890 | (defcustom message-send-mail-hook nil | |
891 | "Hook run before sending mail messages." | |
892 | :group 'message-various | |
893 | :type 'hook) | |
894 | ||
895 | (defcustom message-send-news-hook nil | |
896 | "Hook run before sending news messages." | |
897 | :group 'message-various | |
898 | :type 'hook) | |
899 | ||
900 | (defcustom message-sent-hook nil | |
901 | "Hook run after sending messages." | |
902 | :group 'message-various | |
903 | :type 'hook) | |
904 | ||
6748645f LMI |
905 | (defvar message-send-coding-system 'binary |
906 | "Coding system to encode outgoing mail.") | |
907 | ||
16409b0b GM |
908 | (defvar message-draft-coding-system |
909 | mm-auto-save-coding-system | |
910 | "Coding system to compose mail.") | |
911 | ||
912 | (defcustom message-send-mail-partially-limit 1000000 | |
913 | "The limitation of messages sent as message/partial. | |
7d829636 DL |
914 | The lower bound of message size in characters, beyond which the message |
915 | should be sent in several parts. If it is nil, the size is unlimited." | |
2d447df6 | 916 | :version "21.1" |
16409b0b GM |
917 | :group 'message-buffers |
918 | :type '(choice (const :tag "unlimited" nil) | |
919 | (integer 1000000))) | |
920 | ||
83595c0c DL |
921 | (defcustom message-alternative-emails nil |
922 | "A regexp to match the alternative email addresses. | |
923 | The first matched address (not primary one) is used in the From field." | |
924 | :group 'message-headers | |
925 | :type '(choice (const :tag "Always use primary" nil) | |
926 | regexp)) | |
927 | ||
88818fbe SZ |
928 | (defcustom message-mail-user-agent nil |
929 | "Like `mail-user-agent'. | |
7d829636 | 930 | Except if it is nil, use Gnus native MUA; if it is t, use |
88818fbe SZ |
931 | `mail-user-agent'." |
932 | :type '(radio (const :tag "Gnus native" | |
933 | :format "%t\n" | |
934 | nil) | |
935 | (const :tag "`mail-user-agent'" | |
936 | :format "%t\n" | |
937 | t) | |
938 | (function-item :tag "Default Emacs mail" | |
939 | :format "%t\n" | |
940 | sendmail-user-agent) | |
941 | (function-item :tag "Emacs interface to MH" | |
942 | :format "%t\n" | |
943 | mh-e-user-agent) | |
944 | (function :tag "Other")) | |
945 | :version "21.1" | |
946 | :group 'message) | |
947 | ||
eec82323 LMI |
948 | ;;; Internal variables. |
949 | ||
83595c0c | 950 | (defvar message-sending-message "Sending...") |
eec82323 LMI |
951 | (defvar message-buffer-list nil) |
952 | (defvar message-this-is-news nil) | |
953 | (defvar message-this-is-mail nil) | |
6748645f | 954 | (defvar message-draft-article nil) |
16409b0b GM |
955 | (defvar message-mime-part nil) |
956 | (defvar message-posting-charset nil) | |
eec82323 LMI |
957 | |
958 | ;; Byte-compiler warning | |
534aa266 DL |
959 | (eval-when-compile |
960 | (defvar gnus-active-hashtb) | |
961 | (defvar gnus-read-active-file)) | |
eec82323 LMI |
962 | |
963 | ;;; Regexp matching the delimiter of messages in UNIX mail format | |
05d70628 RS |
964 | ;;; (UNIX From lines), minus the initial ^. It should be a copy |
965 | ;;; of rmail.el's rmail-unix-mail-delimiter. | |
eec82323 LMI |
966 | (defvar message-unix-mail-delimiter |
967 | (let ((time-zone-regexp | |
968 | (concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?" | |
969 | "\\|[-+]?[0-9][0-9][0-9][0-9]" | |
970 | "\\|" | |
971 | "\\) *"))) | |
972 | (concat | |
973 | "From " | |
974 | ||
05d70628 RS |
975 | ;; Many things can happen to an RFC 822 mailbox before it is put into |
976 | ;; a `From' line. The leading phrase can be stripped, e.g. | |
977 | ;; `Joe <@w.x:joe@y.z>' -> `<@w.x:joe@y.z>'. The <> can be stripped, e.g. | |
978 | ;; `<@x.y:joe@y.z>' -> `@x.y:joe@y.z'. Everything starting with a CRLF | |
979 | ;; can be removed, e.g. | |
980 | ;; From: joe@y.z (Joe K | |
981 | ;; User) | |
982 | ;; can yield `From joe@y.z (Joe K Fri Mar 22 08:11:15 1996', and | |
983 | ;; From: Joe User | |
984 | ;; <joe@y.z> | |
985 | ;; can yield `From Joe User Fri Mar 22 08:11:15 1996'. | |
986 | ;; The mailbox can be removed or be replaced by white space, e.g. | |
987 | ;; From: "Joe User"{space}{tab} | |
988 | ;; <joe@y.z> | |
989 | ;; can yield `From {space}{tab} Fri Mar 22 08:11:15 1996', | |
990 | ;; where {space} and {tab} represent the Ascii space and tab characters. | |
991 | ;; We want to match the results of any of these manglings. | |
992 | ;; The following regexp rejects names whose first characters are | |
993 | ;; obviously bogus, but after that anything goes. | |
994 | "\\([^\0-\b\n-\r\^?].*\\)? " | |
eec82323 LMI |
995 | |
996 | ;; The time the message was sent. | |
16409b0b GM |
997 | "\\([^\0-\r \^?]+\\) +" ; day of the week |
998 | "\\([^\0-\r \^?]+\\) +" ; month | |
999 | "\\([0-3]?[0-9]\\) +" ; day of month | |
1000 | "\\([0-2][0-9]:[0-5][0-9]\\(:[0-6][0-9]\\)?\\) *" ; time of day | |
eec82323 LMI |
1001 | |
1002 | ;; Perhaps a time zone, specified by an abbreviation, or by a | |
1003 | ;; numeric offset. | |
1004 | time-zone-regexp | |
1005 | ||
1006 | ;; The year. | |
05d70628 | 1007 | " \\([0-9][0-9]+\\) *" |
eec82323 LMI |
1008 | |
1009 | ;; On some systems the time zone can appear after the year, too. | |
1010 | time-zone-regexp | |
1011 | ||
1012 | ;; Old uucp cruft. | |
1013 | "\\(remote from .*\\)?" | |
1014 | ||
05d70628 | 1015 | "\n")) |
6748645f | 1016 | "Regexp matching the delimiter of messages in UNIX mail format.") |
eec82323 LMI |
1017 | |
1018 | (defvar message-unsent-separator | |
1019 | (concat "^ *---+ +Unsent message follows +---+ *$\\|" | |
1020 | "^ *---+ +Returned message +---+ *$\\|" | |
1021 | "^Start of returned message$\\|" | |
1022 | "^ *---+ +Original message +---+ *$\\|" | |
1023 | "^ *--+ +begin message +--+ *$\\|" | |
1024 | "^ *---+ +Original message follows +---+ *$\\|" | |
16409b0b | 1025 | "^ *---+ +Undelivered message follows +---+ *$\\|" |
eec82323 LMI |
1026 | "^|? *---+ +Message text follows: +---+ *|?$") |
1027 | "A regexp that matches the separator before the text of a failed message.") | |
1028 | ||
1029 | (defvar message-header-format-alist | |
1030 | `((Newsgroups) | |
1031 | (To . message-fill-address) | |
1032 | (Cc . message-fill-address) | |
1033 | (Subject) | |
1034 | (In-Reply-To) | |
1035 | (Fcc) | |
1036 | (Bcc) | |
1037 | (Date) | |
1038 | (Organization) | |
1039 | (Distribution) | |
1040 | (Lines) | |
1041 | (Expires) | |
1042 | (Message-ID) | |
6748645f | 1043 | (References . message-shorten-references) |
16409b0b | 1044 | (User-Agent)) |
eec82323 LMI |
1045 | "Alist used for formatting headers.") |
1046 | ||
1047 | (eval-and-compile | |
1048 | (autoload 'message-setup-toolbar "messagexmas") | |
6748645f | 1049 | (autoload 'mh-new-draft-name "mh-comp") |
eec82323 LMI |
1050 | (autoload 'mh-send-letter "mh-comp") |
1051 | (autoload 'gnus-point-at-eol "gnus-util") | |
1052 | (autoload 'gnus-point-at-bol "gnus-util") | |
eec82323 | 1053 | (autoload 'gnus-output-to-rmail "gnus-util") |
16409b0b | 1054 | (autoload 'gnus-output-to-mail "gnus-util") |
6748645f LMI |
1055 | (autoload 'mail-abbrev-in-expansion-header-p "mailabbrev") |
1056 | (autoload 'nndraft-request-associate-buffer "nndraft") | |
1057 | (autoload 'nndraft-request-expire-articles "nndraft") | |
1058 | (autoload 'gnus-open-server "gnus-int") | |
1059 | (autoload 'gnus-request-post "gnus-int") | |
1060 | (autoload 'gnus-alive-p "gnus-util") | |
16409b0b | 1061 | (autoload 'gnus-group-name-charset "gnus-group") |
42b7180c | 1062 | (autoload 'rmail-output "rmailout")) |
eec82323 LMI |
1063 | |
1064 | \f | |
1065 | ||
1066 | ;;; | |
1067 | ;;; Utility functions. | |
1068 | ;;; | |
1069 | ||
1070 | (defmacro message-y-or-n-p (question show &rest text) | |
7d829636 | 1071 | "Ask QUESTION, displaying remaining args in a temporary buffer if SHOW." |
eec82323 LMI |
1072 | `(message-talkative-question 'y-or-n-p ,question ,show ,@text)) |
1073 | ||
eec82323 | 1074 | (defmacro message-delete-line (&optional n) |
7d829636 | 1075 | "Delete the current line (and the next N lines)." |
eec82323 LMI |
1076 | `(delete-region (progn (beginning-of-line) (point)) |
1077 | (progn (forward-line ,(or n 1)) (point)))) | |
1078 | ||
16409b0b | 1079 | (defun message-unquote-tokens (elems) |
7d829636 | 1080 | "Remove double quotes (\") from strings in list ELEMS." |
16409b0b GM |
1081 | (mapcar (lambda (item) |
1082 | (while (string-match "^\\(.*\\)\"\\(.*\\)$" item) | |
7d829636 | 1083 | (setq item (concat (match-string 1 item) |
16409b0b GM |
1084 | (match-string 2 item)))) |
1085 | item) | |
1086 | elems)) | |
1087 | ||
eec82323 LMI |
1088 | (defun message-tokenize-header (header &optional separator) |
1089 | "Split HEADER into a list of header elements. | |
16409b0b GM |
1090 | SEPARATOR is a string of characters to be used as separators. \",\" |
1091 | is used by default." | |
eec82323 LMI |
1092 | (if (not header) |
1093 | nil | |
1094 | (let ((regexp (format "[%s]+" (or separator ","))) | |
1095 | (beg 1) | |
1096 | (first t) | |
1097 | quoted elems paren) | |
1098 | (save-excursion | |
1099 | (message-set-work-buffer) | |
1100 | (insert header) | |
1101 | (goto-char (point-min)) | |
1102 | (while (not (eobp)) | |
1103 | (if first | |
1104 | (setq first nil) | |
1105 | (forward-char 1)) | |
1106 | (cond ((and (> (point) beg) | |
1107 | (or (eobp) | |
1108 | (and (looking-at regexp) | |
1109 | (not quoted) | |
1110 | (not paren)))) | |
1111 | (push (buffer-substring beg (point)) elems) | |
1112 | (setq beg (match-end 0))) | |
16409b0b | 1113 | ((eq (char-after) ?\") |
eec82323 | 1114 | (setq quoted (not quoted))) |
16409b0b | 1115 | ((and (eq (char-after) ?\() |
eec82323 LMI |
1116 | (not quoted)) |
1117 | (setq paren t)) | |
16409b0b | 1118 | ((and (eq (char-after) ?\)) |
eec82323 LMI |
1119 | (not quoted)) |
1120 | (setq paren nil)))) | |
16409b0b | 1121 | (nreverse elems))))) |
eec82323 LMI |
1122 | |
1123 | (defun message-mail-file-mbox-p (file) | |
1124 | "Say whether FILE looks like a Unix mbox file." | |
1125 | (when (and (file-exists-p file) | |
1126 | (file-readable-p file) | |
1127 | (file-regular-p file)) | |
16409b0b | 1128 | (with-temp-buffer |
eec82323 LMI |
1129 | (nnheader-insert-file-contents file) |
1130 | (goto-char (point-min)) | |
1131 | (looking-at message-unix-mail-delimiter)))) | |
1132 | ||
1133 | (defun message-fetch-field (header &optional not-all) | |
1134 | "The same as `mail-fetch-field', only remove all newlines." | |
6748645f | 1135 | (let* ((inhibit-point-motion-hooks t) |
16409b0b | 1136 | (case-fold-search t) |
6748645f | 1137 | (value (mail-fetch-field header nil (not not-all)))) |
eec82323 | 1138 | (when value |
16409b0b GM |
1139 | (while (string-match "\n[\t ]+" value) |
1140 | (setq value (replace-match " " t t value))) | |
1141 | (set-text-properties 0 (length value) nil value) | |
1142 | value))) | |
1143 | ||
1144 | (defun message-narrow-to-field () | |
1145 | "Narrow the buffer to the header on the current line." | |
1146 | (beginning-of-line) | |
1147 | (narrow-to-region | |
1148 | (point) | |
1149 | (progn | |
1150 | (forward-line 1) | |
1151 | (if (re-search-forward "^[^ \n\t]" nil t) | |
1152 | (progn | |
1153 | (beginning-of-line) | |
1154 | (point)) | |
1155 | (point-max)))) | |
1156 | (goto-char (point-min))) | |
eec82323 LMI |
1157 | |
1158 | (defun message-add-header (&rest headers) | |
1159 | "Add the HEADERS to the message header, skipping those already present." | |
1160 | (while headers | |
1161 | (let (hclean) | |
1162 | (unless (string-match "^\\([^:]+\\):[ \t]*[^ \t]" (car headers)) | |
1163 | (error "Invalid header `%s'" (car headers))) | |
1164 | (setq hclean (match-string 1 (car headers))) | |
16409b0b GM |
1165 | (save-restriction |
1166 | (message-narrow-to-headers) | |
1167 | (unless (re-search-forward (concat "^" (regexp-quote hclean) ":") nil t) | |
1168 | (insert (car headers) ?\n)))) | |
eec82323 LMI |
1169 | (setq headers (cdr headers)))) |
1170 | ||
16409b0b | 1171 | |
eec82323 | 1172 | (defun message-fetch-reply-field (header) |
7d829636 | 1173 | "Fetch field HEADER from the message we're replying to." |
eec82323 LMI |
1174 | (when (and message-reply-buffer |
1175 | (buffer-name message-reply-buffer)) | |
1176 | (save-excursion | |
1177 | (set-buffer message-reply-buffer) | |
1178 | (message-fetch-field header)))) | |
1179 | ||
1180 | (defun message-set-work-buffer () | |
1181 | (if (get-buffer " *message work*") | |
1182 | (progn | |
1183 | (set-buffer " *message work*") | |
1184 | (erase-buffer)) | |
1185 | (set-buffer (get-buffer-create " *message work*")) | |
1186 | (kill-all-local-variables) | |
16409b0b | 1187 | (mm-enable-multibyte))) |
eec82323 LMI |
1188 | |
1189 | (defun message-functionp (form) | |
1190 | "Return non-nil if FORM is funcallable." | |
1191 | (or (and (symbolp form) (fboundp form)) | |
1192 | (and (listp form) (eq (car form) 'lambda)) | |
6748645f | 1193 | (byte-code-function-p form))) |
eec82323 | 1194 | |
16409b0b | 1195 | (defun message-strip-list-identifiers (subject) |
7d829636 | 1196 | "Remove list identifiers in `gnus-list-identifiers' from string SUBJECT." |
16409b0b GM |
1197 | (require 'gnus-sum) ; for gnus-list-identifiers |
1198 | (let ((regexp (if (stringp gnus-list-identifiers) | |
1199 | gnus-list-identifiers | |
1200 | (mapconcat 'identity gnus-list-identifiers " *\\|")))) | |
7d829636 | 1201 | (if (string-match (concat "\\(\\(\\(Re: +\\)?\\(" regexp |
16409b0b GM |
1202 | " *\\)\\)+\\(Re: +\\)?\\)") subject) |
1203 | (concat (substring subject 0 (match-beginning 1)) | |
1204 | (or (match-string 3 subject) | |
1205 | (match-string 5 subject)) | |
1206 | (substring subject | |
1207 | (match-end 1))) | |
1208 | subject))) | |
1209 | ||
eec82323 | 1210 | (defun message-strip-subject-re (subject) |
7d829636 | 1211 | "Remove \"Re:\" from subject lines in string SUBJECT." |
6748645f | 1212 | (if (string-match message-subject-re-regexp subject) |
eec82323 LMI |
1213 | (substring subject (match-end 0)) |
1214 | subject)) | |
1215 | ||
1216 | (defun message-remove-header (header &optional is-regexp first reverse) | |
1217 | "Remove HEADER in the narrowed buffer. | |
7d829636 | 1218 | If IS-REGEXP, HEADER is a regular expression. |
eec82323 LMI |
1219 | If FIRST, only remove the first instance of the header. |
1220 | Return the number of headers removed." | |
1221 | (goto-char (point-min)) | |
6748645f | 1222 | (let ((regexp (if is-regexp header (concat "^" (regexp-quote header) ":"))) |
eec82323 LMI |
1223 | (number 0) |
1224 | (case-fold-search t) | |
1225 | last) | |
1226 | (while (and (not (eobp)) | |
1227 | (not last)) | |
1228 | (if (if reverse | |
1229 | (not (looking-at regexp)) | |
1230 | (looking-at regexp)) | |
1231 | (progn | |
1232 | (incf number) | |
1233 | (when first | |
1234 | (setq last t)) | |
1235 | (delete-region | |
1236 | (point) | |
1237 | ;; There might be a continuation header, so we have to search | |
1238 | ;; until we find a new non-continuation line. | |
1239 | (progn | |
1240 | (forward-line 1) | |
1241 | (if (re-search-forward "^[^ \t]" nil t) | |
1242 | (goto-char (match-beginning 0)) | |
1243 | (point-max))))) | |
1244 | (forward-line 1) | |
1245 | (if (re-search-forward "^[^ \t]" nil t) | |
1246 | (goto-char (match-beginning 0)) | |
16409b0b | 1247 | (goto-char (point-max))))) |
eec82323 LMI |
1248 | number)) |
1249 | ||
16409b0b GM |
1250 | (defun message-remove-first-header (header) |
1251 | "Remove the first instance of HEADER if there is more than one." | |
1252 | (let ((count 0) | |
1253 | (regexp (concat "^" (regexp-quote header) ":"))) | |
1254 | (save-excursion | |
1255 | (goto-char (point-min)) | |
1256 | (while (re-search-forward regexp nil t) | |
1257 | (incf count))) | |
1258 | (while (> count 1) | |
1259 | (message-remove-header header nil t) | |
1260 | (decf count)))) | |
1261 | ||
eec82323 LMI |
1262 | (defun message-narrow-to-headers () |
1263 | "Narrow the buffer to the head of the message." | |
1264 | (widen) | |
1265 | (narrow-to-region | |
1266 | (goto-char (point-min)) | |
1267 | (if (re-search-forward | |
1268 | (concat "^" (regexp-quote mail-header-separator) "\n") nil t) | |
1269 | (match-beginning 0) | |
1270 | (point-max))) | |
1271 | (goto-char (point-min))) | |
1272 | ||
158d6e07 | 1273 | (defun message-narrow-to-head-1 () |
7d829636 | 1274 | "Like `message-narrow-to-head'. Don't widen." |
eec82323 LMI |
1275 | (narrow-to-region |
1276 | (goto-char (point-min)) | |
1277 | (if (search-forward "\n\n" nil 1) | |
1278 | (1- (point)) | |
1279 | (point-max))) | |
1280 | (goto-char (point-min))) | |
1281 | ||
158d6e07 SZ |
1282 | (defun message-narrow-to-head () |
1283 | "Narrow the buffer to the head of the message. | |
1284 | Point is left at the beginning of the narrowed-to region." | |
1285 | (widen) | |
1286 | (message-narrow-to-head-1)) | |
1287 | ||
16409b0b GM |
1288 | (defun message-narrow-to-headers-or-head () |
1289 | "Narrow the buffer to the head of the message." | |
1290 | (widen) | |
1291 | (narrow-to-region | |
1292 | (goto-char (point-min)) | |
1293 | (cond | |
1294 | ((re-search-forward | |
1295 | (concat "^" (regexp-quote mail-header-separator) "\n") nil t) | |
1296 | (match-beginning 0)) | |
1297 | ((search-forward "\n\n" nil t) | |
1298 | (1- (point))) | |
1299 | (t | |
1300 | (point-max)))) | |
1301 | (goto-char (point-min))) | |
1302 | ||
eec82323 LMI |
1303 | (defun message-news-p () |
1304 | "Say whether the current buffer contains a news message." | |
6748645f LMI |
1305 | (and (not message-this-is-mail) |
1306 | (or message-this-is-news | |
1307 | (save-excursion | |
1308 | (save-restriction | |
1309 | (message-narrow-to-headers) | |
1310 | (and (message-fetch-field "newsgroups") | |
1311 | (not (message-fetch-field "posted-to")))))))) | |
eec82323 LMI |
1312 | |
1313 | (defun message-mail-p () | |
1314 | "Say whether the current buffer contains a mail message." | |
6748645f LMI |
1315 | (and (not message-this-is-news) |
1316 | (or message-this-is-mail | |
1317 | (save-excursion | |
1318 | (save-restriction | |
1319 | (message-narrow-to-headers) | |
1320 | (or (message-fetch-field "to") | |
1321 | (message-fetch-field "cc") | |
1322 | (message-fetch-field "bcc"))))))) | |
eec82323 LMI |
1323 | |
1324 | (defun message-next-header () | |
1325 | "Go to the beginning of the next header." | |
1326 | (beginning-of-line) | |
1327 | (or (eobp) (forward-char 1)) | |
1328 | (not (if (re-search-forward "^[^ \t]" nil t) | |
1329 | (beginning-of-line) | |
1330 | (goto-char (point-max))))) | |
1331 | ||
1332 | (defun message-sort-headers-1 () | |
1333 | "Sort the buffer as headers using `message-rank' text props." | |
1334 | (goto-char (point-min)) | |
16409b0b | 1335 | (require 'sort) |
eec82323 LMI |
1336 | (sort-subr |
1337 | nil 'message-next-header | |
1338 | (lambda () | |
1339 | (message-next-header) | |
1340 | (unless (bobp) | |
1341 | (forward-char -1))) | |
1342 | (lambda () | |
1343 | (or (get-text-property (point) 'message-rank) | |
1344 | 10000)))) | |
1345 | ||
1346 | (defun message-sort-headers () | |
1347 | "Sort the headers of the current message according to `message-header-format-alist'." | |
1348 | (interactive) | |
1349 | (save-excursion | |
1350 | (save-restriction | |
1351 | (let ((max (1+ (length message-header-format-alist))) | |
1352 | rank) | |
1353 | (message-narrow-to-headers) | |
1354 | (while (re-search-forward "^[^ \n]+:" nil t) | |
1355 | (put-text-property | |
1356 | (match-beginning 0) (1+ (match-beginning 0)) | |
1357 | 'message-rank | |
1358 | (if (setq rank (length (memq (assq (intern (buffer-substring | |
1359 | (match-beginning 0) | |
1360 | (1- (match-end 0)))) | |
1361 | message-header-format-alist) | |
1362 | message-header-format-alist))) | |
1363 | (- max rank) | |
1364 | (1+ max))))) | |
1365 | (message-sort-headers-1)))) | |
1366 | ||
1367 | \f | |
1368 | ||
1369 | ;;; | |
1370 | ;;; Message mode | |
1371 | ;;; | |
1372 | ||
1373 | ;;; Set up keymap. | |
1374 | ||
1375 | (defvar message-mode-map nil) | |
1376 | ||
1377 | (unless message-mode-map | |
16409b0b GM |
1378 | (setq message-mode-map (make-keymap)) |
1379 | (set-keymap-parent message-mode-map text-mode-map) | |
eec82323 LMI |
1380 | (define-key message-mode-map "\C-c?" 'describe-mode) |
1381 | ||
1382 | (define-key message-mode-map "\C-c\C-f\C-t" 'message-goto-to) | |
1383 | (define-key message-mode-map "\C-c\C-f\C-b" 'message-goto-bcc) | |
1384 | (define-key message-mode-map "\C-c\C-f\C-w" 'message-goto-fcc) | |
1385 | (define-key message-mode-map "\C-c\C-f\C-c" 'message-goto-cc) | |
1386 | (define-key message-mode-map "\C-c\C-f\C-s" 'message-goto-subject) | |
1387 | (define-key message-mode-map "\C-c\C-f\C-r" 'message-goto-reply-to) | |
1388 | (define-key message-mode-map "\C-c\C-f\C-n" 'message-goto-newsgroups) | |
1389 | (define-key message-mode-map "\C-c\C-f\C-d" 'message-goto-distribution) | |
1390 | (define-key message-mode-map "\C-c\C-f\C-f" 'message-goto-followup-to) | |
1391 | (define-key message-mode-map "\C-c\C-f\C-k" 'message-goto-keywords) | |
1392 | (define-key message-mode-map "\C-c\C-f\C-u" 'message-goto-summary) | |
1393 | (define-key message-mode-map "\C-c\C-b" 'message-goto-body) | |
1394 | (define-key message-mode-map "\C-c\C-i" 'message-goto-signature) | |
1395 | ||
1396 | (define-key message-mode-map "\C-c\C-t" 'message-insert-to) | |
1397 | (define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups) | |
1398 | ||
1399 | (define-key message-mode-map "\C-c\C-y" 'message-yank-original) | |
16409b0b | 1400 | (define-key message-mode-map "\C-c\M-\C-y" 'message-yank-buffer) |
eec82323 LMI |
1401 | (define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message) |
1402 | (define-key message-mode-map "\C-c\C-w" 'message-insert-signature) | |
16409b0b | 1403 | (define-key message-mode-map "\C-c\M-h" 'message-insert-headers) |
eec82323 LMI |
1404 | (define-key message-mode-map "\C-c\C-r" 'message-caesar-buffer-body) |
1405 | (define-key message-mode-map "\C-c\C-o" 'message-sort-headers) | |
1406 | (define-key message-mode-map "\C-c\M-r" 'message-rename-buffer) | |
1407 | ||
1408 | (define-key message-mode-map "\C-c\C-c" 'message-send-and-exit) | |
1409 | (define-key message-mode-map "\C-c\C-s" 'message-send) | |
1410 | (define-key message-mode-map "\C-c\C-k" 'message-kill-buffer) | |
1411 | (define-key message-mode-map "\C-c\C-d" 'message-dont-send) | |
1412 | ||
1413 | (define-key message-mode-map "\C-c\C-e" 'message-elide-region) | |
6748645f LMI |
1414 | (define-key message-mode-map "\C-c\C-v" 'message-delete-not-region) |
1415 | (define-key message-mode-map "\C-c\C-z" 'message-kill-to-signature) | |
1416 | (define-key message-mode-map "\M-\r" 'message-newline-and-reformat) | |
10893bb6 | 1417 | (define-key message-mode-map [remap split-line] 'message-split-line) |
eec82323 | 1418 | |
16409b0b GM |
1419 | (define-key message-mode-map "\C-c\C-a" 'mml-attach-file) |
1420 | ||
eec82323 LMI |
1421 | (define-key message-mode-map "\t" 'message-tab)) |
1422 | ||
1423 | (easy-menu-define | |
1424 | message-mode-menu message-mode-map "Message Menu." | |
1425 | '("Message" | |
1426 | ["Sort Headers" message-sort-headers t] | |
1427 | ["Yank Original" message-yank-original t] | |
1428 | ["Fill Yanked Message" message-fill-yanked-message t] | |
1429 | ["Insert Signature" message-insert-signature t] | |
1430 | ["Caesar (rot13) Message" message-caesar-buffer-body t] | |
1431 | ["Caesar (rot13) Region" message-caesar-region (mark t)] | |
1432 | ["Elide Region" message-elide-region (mark t)] | |
6748645f LMI |
1433 | ["Delete Outside Region" message-delete-not-region (mark t)] |
1434 | ["Kill To Signature" message-kill-to-signature t] | |
1435 | ["Newline and Reformat" message-newline-and-reformat t] | |
eec82323 | 1436 | ["Rename buffer" message-rename-buffer t] |
c47a0dc8 DL |
1437 | ["Spellcheck" ispell-message |
1438 | :help "Spellcheck this message"] | |
1439 | ["Attach file as MIME" mml-attach-file | |
1440 | :help "Attach a file at point"] | |
eec82323 | 1441 | "----" |
c47a0dc8 DL |
1442 | ["Send Message" message-send-and-exit |
1443 | :help "Send this message"] | |
1444 | ["Abort Message" message-dont-send | |
1445 | :help "File this draft message and exit"] | |
1446 | ["Kill Message" message-kill-buffer | |
1447 | :help "Delete this message without sending"])) | |
eec82323 LMI |
1448 | |
1449 | (easy-menu-define | |
1450 | message-mode-field-menu message-mode-map "" | |
1451 | '("Field" | |
1452 | ["Fetch To" message-insert-to t] | |
1453 | ["Fetch Newsgroups" message-insert-newsgroups t] | |
1454 | "----" | |
1455 | ["To" message-goto-to t] | |
1456 | ["Subject" message-goto-subject t] | |
1457 | ["Cc" message-goto-cc t] | |
1458 | ["Reply-To" message-goto-reply-to t] | |
1459 | ["Summary" message-goto-summary t] | |
1460 | ["Keywords" message-goto-keywords t] | |
1461 | ["Newsgroups" message-goto-newsgroups t] | |
1462 | ["Followup-To" message-goto-followup-to t] | |
1463 | ["Distribution" message-goto-distribution t] | |
1464 | ["Body" message-goto-body t] | |
1465 | ["Signature" message-goto-signature t])) | |
1466 | ||
534aa266 DL |
1467 | (eval-when-compile |
1468 | (defvar facemenu-add-face-function) | |
1469 | (defvar facemenu-remove-face-function)) | |
eec82323 LMI |
1470 | |
1471 | ;;;###autoload | |
1472 | (defun message-mode () | |
1473 | "Major mode for editing mail and news to be sent. | |
7d829636 DL |
1474 | Like Text Mode but with these additional commands:\\<message-mode-map> |
1475 | C-c C-s `message-send' (send the message) C-c C-c `message-send-and-exit' | |
1476 | C-c C-d Postpone sending the message C-c C-k Kill the message | |
eec82323 LMI |
1477 | C-c C-f move to a header field (and create it if there isn't): |
1478 | C-c C-f C-t move to To C-c C-f C-s move to Subject | |
1479 | C-c C-f C-c move to Cc C-c C-f C-b move to Bcc | |
1480 | C-c C-f C-w move to Fcc C-c C-f C-r move to Reply-To | |
1481 | C-c C-f C-u move to Summary C-c C-f C-n move to Newsgroups | |
1482 | C-c C-f C-k move to Keywords C-c C-f C-d move to Distribution | |
1483 | C-c C-f C-f move to Followup-To | |
7d829636 DL |
1484 | C-c C-t `message-insert-to' (add a To header to a news followup) |
1485 | C-c C-n `message-insert-newsgroups' (add a Newsgroup header to a news reply) | |
1486 | C-c C-b `message-goto-body' (move to beginning of message text). | |
1487 | C-c C-i `message-goto-signature' (move to the beginning of the signature). | |
1488 | C-c C-w `message-insert-signature' (insert `message-signature-file' file). | |
1489 | C-c C-y `message-yank-original' (insert current message, if any). | |
1490 | C-c C-q `message-fill-yanked-message' (fill what was yanked). | |
1491 | C-c C-e `message-elide-region' (elide the text between point and mark). | |
1492 | C-c C-v `message-delete-not-region' (remove the text outside the region). | |
1493 | C-c C-z `message-kill-to-signature' (kill the text up to the signature). | |
1494 | C-c C-r `message-caesar-buffer-body' (rot13 the message body). | |
1495 | C-c C-a `mml-attach-file' (attach a file as MIME). | |
1496 | M-RET `message-newline-and-reformat' (break the line and reformat)." | |
eec82323 | 1497 | (interactive) |
16409b0b GM |
1498 | (if (local-variable-p 'mml-buffer-list (current-buffer)) |
1499 | (mml-destroy-buffers)) | |
eec82323 | 1500 | (kill-all-local-variables) |
16409b0b | 1501 | (set (make-local-variable 'message-reply-buffer) nil) |
6748645f LMI |
1502 | (make-local-variable 'message-send-actions) |
1503 | (make-local-variable 'message-exit-actions) | |
eec82323 LMI |
1504 | (make-local-variable 'message-kill-actions) |
1505 | (make-local-variable 'message-postpone-actions) | |
6748645f LMI |
1506 | (make-local-variable 'message-draft-article) |
1507 | (make-local-hook 'kill-buffer-hook) | |
eec82323 LMI |
1508 | (set-syntax-table message-mode-syntax-table) |
1509 | (use-local-map message-mode-map) | |
1510 | (setq local-abbrev-table message-mode-abbrev-table) | |
1511 | (setq major-mode 'message-mode) | |
1512 | (setq mode-name "Message") | |
1513 | (setq buffer-offer-save t) | |
eec82323 LMI |
1514 | (make-local-variable 'facemenu-add-face-function) |
1515 | (make-local-variable 'facemenu-remove-face-function) | |
1516 | (setq facemenu-add-face-function | |
1517 | (lambda (face end) | |
1518 | (let ((face-fun (cdr (assq face message-face-alist)))) | |
1519 | (if face-fun | |
1520 | (funcall face-fun (point) end) | |
1521 | (error "Face %s not configured for %s mode" face mode-name))) | |
1522 | "") | |
1523 | facemenu-remove-face-function t) | |
eec82323 LMI |
1524 | (make-local-variable 'message-reply-headers) |
1525 | (setq message-reply-headers nil) | |
1526 | (make-local-variable 'message-newsreader) | |
1527 | (make-local-variable 'message-mailer) | |
1528 | (make-local-variable 'message-post-method) | |
16409b0b GM |
1529 | (set (make-local-variable 'message-sent-message-via) nil) |
1530 | (set (make-local-variable 'message-checksum) nil) | |
1531 | (set (make-local-variable 'message-mime-part) 0) | |
f8c0f31e | 1532 | (message-setup-fill-variables) |
980984d8 | 1533 | ;; Allow using comment commands to add/remove quoting. |
f71680f9 | 1534 | (set (make-local-variable 'comment-start) message-yank-prefix) |
eec82323 LMI |
1535 | ;;(when (fboundp 'mail-hist-define-keys) |
1536 | ;; (mail-hist-define-keys)) | |
16409b0b GM |
1537 | (if (featurep 'xemacs) |
1538 | (message-setup-toolbar) | |
1539 | (set (make-local-variable 'font-lock-defaults) | |
c47a0dc8 DL |
1540 | '(message-font-lock-keywords t)) |
1541 | (if (boundp 'message-tool-bar-map) | |
1542 | (set (make-local-variable 'tool-bar-map) message-tool-bar-map))) | |
eec82323 LMI |
1543 | (easy-menu-add message-mode-menu message-mode-map) |
1544 | (easy-menu-add message-mode-field-menu message-mode-map) | |
1545 | ;; Allow mail alias things. | |
a8151ef7 LMI |
1546 | (when (eq message-mail-alias-type 'abbrev) |
1547 | (if (fboundp 'mail-abbrevs-setup) | |
1548 | (mail-abbrevs-setup) | |
6748645f | 1549 | (mail-aliases-setup))) |
3efe5554 SZ |
1550 | (unless buffer-file-name |
1551 | (message-set-auto-save-file-name)) | |
16409b0b GM |
1552 | (mm-enable-multibyte) |
1553 | (make-local-variable 'indent-tabs-mode) ;Turn off tabs for indentation. | |
1554 | (setq indent-tabs-mode nil) | |
1555 | (mml-mode) | |
eec82323 LMI |
1556 | (run-hooks 'text-mode-hook 'message-mode-hook)) |
1557 | ||
f8c0f31e DL |
1558 | (defun message-setup-fill-variables () |
1559 | "Setup message fill variables." | |
1560 | (make-local-variable 'paragraph-separate) | |
1561 | (make-local-variable 'paragraph-start) | |
1562 | (make-local-variable 'adaptive-fill-regexp) | |
1563 | (unless (boundp 'adaptive-fill-first-line-regexp) | |
1564 | (setq adaptive-fill-first-line-regexp nil)) | |
1565 | (make-local-variable 'adaptive-fill-first-line-regexp) | |
1566 | (make-local-variable 'auto-fill-inhibit-regexp) | |
1567 | (let ((quote-prefix-regexp | |
1568 | (concat | |
1569 | "[ \t]*" ; possible initial space | |
1570 | "\\(\\(" (regexp-quote message-yank-prefix) "\\|" ; user's prefix | |
1571 | "\\w+>\\|" ; supercite-style prefix | |
1572 | "[|:>]" ; standard prefix | |
1573 | "\\)[ \t]*\\)+"))) ; possible space after each prefix | |
1574 | (setq paragraph-start | |
1575 | (concat | |
1576 | (regexp-quote mail-header-separator) "$\\|" | |
1577 | "[ \t]*$\\|" ; blank lines | |
1578 | "-- $\\|" ; signature delimiter | |
1579 | "---+$\\|" ; delimiters for forwarded messages | |
1580 | page-delimiter "$\\|" ; spoiler warnings | |
1581 | ".*wrote:$\\|" ; attribution lines | |
1582 | quote-prefix-regexp "$")) ; empty lines in quoted text | |
1583 | (setq paragraph-separate paragraph-start) | |
1584 | (setq adaptive-fill-regexp | |
1585 | (concat quote-prefix-regexp "\\|" adaptive-fill-regexp)) | |
1586 | (setq adaptive-fill-first-line-regexp | |
1587 | (concat quote-prefix-regexp "\\|" | |
1588 | adaptive-fill-first-line-regexp)) | |
1589 | (setq auto-fill-inhibit-regexp "^[A-Z][^: \n\t]+:"))) | |
1590 | ||
eec82323 LMI |
1591 | \f |
1592 | ||
1593 | ;;; | |
1594 | ;;; Message mode commands | |
1595 | ;;; | |
1596 | ||
1597 | ;;; Movement commands | |
1598 | ||
1599 | (defun message-goto-to () | |
1600 | "Move point to the To header." | |
1601 | (interactive) | |
1602 | (message-position-on-field "To")) | |
1603 | ||
1604 | (defun message-goto-subject () | |
1605 | "Move point to the Subject header." | |
1606 | (interactive) | |
1607 | (message-position-on-field "Subject")) | |
1608 | ||
1609 | (defun message-goto-cc () | |
1610 | "Move point to the Cc header." | |
1611 | (interactive) | |
1612 | (message-position-on-field "Cc" "To")) | |
1613 | ||
1614 | (defun message-goto-bcc () | |
1615 | "Move point to the Bcc header." | |
1616 | (interactive) | |
1617 | (message-position-on-field "Bcc" "Cc" "To")) | |
1618 | ||
1619 | (defun message-goto-fcc () | |
1620 | "Move point to the Fcc header." | |
1621 | (interactive) | |
1622 | (message-position-on-field "Fcc" "To" "Newsgroups")) | |
1623 | ||
1624 | (defun message-goto-reply-to () | |
1625 | "Move point to the Reply-To header." | |
1626 | (interactive) | |
1627 | (message-position-on-field "Reply-To" "Subject")) | |
1628 | ||
1629 | (defun message-goto-newsgroups () | |
1630 | "Move point to the Newsgroups header." | |
1631 | (interactive) | |
1632 | (message-position-on-field "Newsgroups")) | |
1633 | ||
1634 | (defun message-goto-distribution () | |
1635 | "Move point to the Distribution header." | |
1636 | (interactive) | |
1637 | (message-position-on-field "Distribution")) | |
1638 | ||
1639 | (defun message-goto-followup-to () | |
1640 | "Move point to the Followup-To header." | |
1641 | (interactive) | |
1642 | (message-position-on-field "Followup-To" "Newsgroups")) | |
1643 | ||
1644 | (defun message-goto-keywords () | |
1645 | "Move point to the Keywords header." | |
1646 | (interactive) | |
1647 | (message-position-on-field "Keywords" "Subject")) | |
1648 | ||
1649 | (defun message-goto-summary () | |
1650 | "Move point to the Summary header." | |
1651 | (interactive) | |
1652 | (message-position-on-field "Summary" "Subject")) | |
1653 | ||
1654 | (defun message-goto-body () | |
1655 | "Move point to the beginning of the message body." | |
1656 | (interactive) | |
1657 | (if (looking-at "[ \t]*\n") (expand-abbrev)) | |
1658 | (goto-char (point-min)) | |
16409b0b GM |
1659 | (or (search-forward (concat "\n" mail-header-separator "\n") nil t) |
1660 | (search-forward "\n\n" nil t))) | |
eec82323 | 1661 | |
6748645f LMI |
1662 | (defun message-goto-eoh () |
1663 | "Move point to the end of the headers." | |
1664 | (interactive) | |
1665 | (message-goto-body) | |
16409b0b | 1666 | (forward-line -1)) |
6748645f | 1667 | |
eec82323 | 1668 | (defun message-goto-signature () |
6748645f LMI |
1669 | "Move point to the beginning of the message signature. |
1670 | If there is no signature in the article, go to the end and | |
1671 | return nil." | |
eec82323 LMI |
1672 | (interactive) |
1673 | (goto-char (point-min)) | |
1674 | (if (re-search-forward message-signature-separator nil t) | |
1675 | (forward-line 1) | |
6748645f LMI |
1676 | (goto-char (point-max)) |
1677 | nil)) | |
eec82323 LMI |
1678 | |
1679 | \f | |
1680 | ||
a8151ef7 LMI |
1681 | (defun message-insert-to (&optional force) |
1682 | "Insert a To header that points to the author of the article being replied to. | |
1683 | If the original author requested not to be sent mail, the function signals | |
1684 | an error. | |
1685 | With the prefix argument FORCE, insert the header anyway." | |
1686 | (interactive "P") | |
eec82323 | 1687 | (let ((co (message-fetch-reply-field "mail-copies-to"))) |
a8151ef7 LMI |
1688 | (when (and (null force) |
1689 | co | |
16409b0b GM |
1690 | (or (equal (downcase co) "never") |
1691 | (equal (downcase co) "nobody"))) | |
eec82323 LMI |
1692 | (error "The user has requested not to have copies sent via mail"))) |
1693 | (when (and (message-position-on-field "To") | |
1694 | (mail-fetch-field "to") | |
1695 | (not (string-match "\\` *\\'" (mail-fetch-field "to")))) | |
1696 | (insert ", ")) | |
1697 | (insert (or (message-fetch-reply-field "reply-to") | |
1698 | (message-fetch-reply-field "from") ""))) | |
1699 | ||
16409b0b GM |
1700 | (defun message-widen-reply () |
1701 | "Widen the reply to include maximum recipients." | |
1702 | (interactive) | |
1703 | (let ((follow-to | |
1704 | (and message-reply-buffer | |
1705 | (buffer-name message-reply-buffer) | |
1706 | (save-excursion | |
1707 | (set-buffer message-reply-buffer) | |
1708 | (message-get-reply-headers t))))) | |
1709 | (save-excursion | |
1710 | (save-restriction | |
1711 | (message-narrow-to-headers) | |
1712 | (dolist (elem follow-to) | |
1713 | (message-remove-header (symbol-name (car elem))) | |
1714 | (goto-char (point-min)) | |
1715 | (insert (symbol-name (car elem)) ": " | |
1716 | (cdr elem) "\n")))))) | |
1717 | ||
eec82323 LMI |
1718 | (defun message-insert-newsgroups () |
1719 | "Insert the Newsgroups header from the article being replied to." | |
1720 | (interactive) | |
1721 | (when (and (message-position-on-field "Newsgroups") | |
1722 | (mail-fetch-field "newsgroups") | |
1723 | (not (string-match "\\` *\\'" (mail-fetch-field "newsgroups")))) | |
1724 | (insert ",")) | |
1725 | (insert (or (message-fetch-reply-field "newsgroups") ""))) | |
1726 | ||
1727 | \f | |
1728 | ||
1729 | ;;; Various commands | |
1730 | ||
6748645f | 1731 | (defun message-delete-not-region (beg end) |
7d829636 | 1732 | "Delete everything in the body of the current message outside of the region." |
6748645f LMI |
1733 | (interactive "r") |
1734 | (save-excursion | |
1735 | (goto-char end) | |
1736 | (delete-region (point) (if (not (message-goto-signature)) | |
1737 | (point) | |
1738 | (forward-line -2) | |
1739 | (point))) | |
1740 | (insert "\n") | |
1741 | (goto-char beg) | |
1742 | (delete-region beg (progn (message-goto-body) | |
1743 | (forward-line 2) | |
1744 | (point)))) | |
1745 | (when (message-goto-signature) | |
1746 | (forward-line -2))) | |
1747 | ||
1748 | (defun message-kill-to-signature () | |
1749 | "Deletes all text up to the signature." | |
1750 | (interactive) | |
1751 | (let ((point (point))) | |
1752 | (message-goto-signature) | |
1753 | (unless (eobp) | |
1754 | (forward-line -2)) | |
1755 | (kill-region point (point)) | |
1756 | (unless (bolp) | |
1757 | (insert "\n")))) | |
1758 | ||
1759 | (defun message-newline-and-reformat () | |
1760 | "Insert four newlines, and then reformat if inside quoted text." | |
1761 | (interactive) | |
9e30862d | 1762 | ;; The Latin-1 angle quote looks pretty dubious. -- fx |
16409b0b | 1763 |