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