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