1 |
;;; message.el --- composing mail and news messages -*- coding: iso-latin-1 -*- |
;;; message.el --- composing mail and news messages |
2 |
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2004 |
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 |
3 |
;; Free Software Foundation, Inc. |
;; Free Software Foundation, Inc. |
4 |
|
|
5 |
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
32 |
|
|
33 |
(eval-when-compile |
(eval-when-compile |
34 |
(require 'cl) |
(require 'cl) |
35 |
(defvar gnus-list-identifiers)) ; gnus-sum is required where necessary |
(defvar gnus-message-group-art) |
36 |
|
(defvar gnus-list-identifiers)) ; gnus-sum is required where necessary |
37 |
|
(require 'canlock) |
38 |
(require 'mailheader) |
(require 'mailheader) |
39 |
(require 'nnheader) |
(require 'nnheader) |
40 |
;; This is apparently necessary even though things are autoloaded: |
;; This is apparently necessary even though things are autoloaded. |
41 |
|
;; Because we dynamically bind mail-abbrev-mode-regexp, we'd better |
42 |
|
;; require mailabbrev here. |
43 |
(if (featurep 'xemacs) |
(if (featurep 'xemacs) |
44 |
(require 'mail-abbrevs)) |
(require 'mail-abbrevs) |
45 |
|
(require 'mailabbrev)) |
46 |
(require 'mail-parse) |
(require 'mail-parse) |
47 |
(require 'mml) |
(require 'mml) |
48 |
|
(require 'rfc822) |
49 |
|
(eval-and-compile |
50 |
|
(autoload 'gnus-find-method-for-group "gnus") |
51 |
|
(autoload 'nnvirtual-find-group-art "nnvirtual") |
52 |
|
(autoload 'gnus-group-decoded-name "gnus-group")) |
53 |
|
|
54 |
(defgroup message '((user-mail-address custom-variable) |
(defgroup message '((user-mail-address custom-variable) |
55 |
(user-full-name custom-variable)) |
(user-full-name custom-variable)) |
133 |
(function :tag "Other")) |
(function :tag "Other")) |
134 |
:group 'message-sending) |
:group 'message-sending) |
135 |
|
|
136 |
|
(defcustom message-fcc-externalize-attachments nil |
137 |
|
"If non-nil, attachments are included as external parts in Fcc copies." |
138 |
|
:type 'boolean |
139 |
|
:group 'message-sending) |
140 |
|
|
141 |
(defcustom message-courtesy-message |
(defcustom message-courtesy-message |
142 |
"The following message is a courtesy copy of an article\nthat has been posted to %s as well.\n\n" |
"The following message is a courtesy copy of an article\nthat has been posted to %s as well.\n\n" |
143 |
"*This is inserted at the start of a mailed copy of a posted message. |
"*This is inserted at the start of a mailed copy of a posted message. |
145 |
the article has been posted to will be inserted there. |
the article has been posted to will be inserted there. |
146 |
If this variable is nil, no such courtesy message will be added." |
If this variable is nil, no such courtesy message will be added." |
147 |
:group 'message-sending |
:group 'message-sending |
148 |
:type 'string) |
:type '(radio (string :format "%t: %v\n" :size 0) (const nil))) |
149 |
|
|
150 |
(defcustom message-ignored-bounced-headers "^\\(Received\\|Return-Path\\):" |
(defcustom message-ignored-bounced-headers |
151 |
|
"^\\(Received\\|Return-Path\\|Delivered-To\\):" |
152 |
"*Regexp that matches headers to be removed in resent bounced mail." |
"*Regexp that matches headers to be removed in resent bounced mail." |
153 |
:group 'message-interface |
:group 'message-interface |
154 |
:type 'regexp) |
:type 'regexp) |
172 |
(const default)) |
(const default)) |
173 |
:group 'message-headers) |
:group 'message-headers) |
174 |
|
|
175 |
(defcustom message-syntax-checks nil |
(defcustom message-insert-canlock t |
176 |
|
"Whether to insert a Cancel-Lock header in news postings." |
177 |
|
:version "21.3" |
178 |
|
:group 'message-headers |
179 |
|
:type 'boolean) |
180 |
|
|
181 |
|
(defcustom message-syntax-checks |
182 |
|
(if message-insert-canlock '((sender . disabled)) nil) |
183 |
;; Guess this one shouldn't be easy to customize... |
;; Guess this one shouldn't be easy to customize... |
184 |
"*Controls what syntax checks should not be performed on outgoing posts. |
"*Controls what syntax checks should not be performed on outgoing posts. |
185 |
To disable checking of long signatures, for instance, add |
To disable checking of long signatures, for instance, add |
192 |
`new-text', `quoting-style', `redirected-followup', `signature', |
`new-text', `quoting-style', `redirected-followup', `signature', |
193 |
`approved', `sender', `empty', `empty-headers', `message-id', `from', |
`approved', `sender', `empty', `empty-headers', `message-id', `from', |
194 |
`subject', `shorten-followup-to', `existing-newsgroups', |
`subject', `shorten-followup-to', `existing-newsgroups', |
195 |
`buffer-file-name', `unchanged', `newsgroups'." |
`buffer-file-name', `unchanged', `newsgroups', `reply-to', |
196 |
|
`continuation-headers', `long-header-lines', `invisible-text' and |
197 |
|
`illegible-text'." |
198 |
:group 'message-news |
:group 'message-news |
199 |
:type '(repeat sexp)) ; Fixme: improve this |
:type '(repeat sexp)) ; Fixme: improve this |
200 |
|
|
201 |
|
(defcustom message-required-headers '((optional . References) |
202 |
|
From) |
203 |
|
"*Headers to be generated or prompted for when sending a message. |
204 |
|
Also see `message-required-news-headers' and |
205 |
|
`message-required-mail-headers'." |
206 |
|
:group 'message-news |
207 |
|
:group 'message-headers |
208 |
|
:link '(custom-manual "(message)Message Headers") |
209 |
|
:type '(repeat sexp)) |
210 |
|
|
211 |
|
(defcustom message-draft-headers '(References From) |
212 |
|
"*Headers to be generated when saving a draft message." |
213 |
|
:group 'message-news |
214 |
|
:group 'message-headers |
215 |
|
:link '(custom-manual "(message)Message Headers") |
216 |
|
:type '(repeat sexp)) |
217 |
|
|
218 |
(defcustom message-required-news-headers |
(defcustom message-required-news-headers |
219 |
'(From Newsgroups Subject Date Message-ID |
'(From Newsgroups Subject Date Message-ID |
220 |
(optional . Organization) Lines |
(optional . Organization) |
221 |
(optional . User-Agent)) |
(optional . User-Agent)) |
222 |
"*Headers to be generated or prompted for when posting an article. |
"*Headers to be generated or prompted for when posting an article. |
223 |
RFC977 and RFC1036 require From, Date, Newsgroups, Subject, |
RFC977 and RFC1036 require From, Date, Newsgroups, Subject, |
226 |
header, remove it from this list." |
header, remove it from this list." |
227 |
:group 'message-news |
:group 'message-news |
228 |
:group 'message-headers |
:group 'message-headers |
229 |
|
:link '(custom-manual "(message)Message Headers") |
230 |
:type '(repeat sexp)) |
:type '(repeat sexp)) |
231 |
|
|
232 |
(defcustom message-required-mail-headers |
(defcustom message-required-mail-headers |
233 |
'(From Subject Date (optional . In-Reply-To) Message-ID Lines |
'(From Subject Date (optional . In-Reply-To) Message-ID |
234 |
(optional . User-Agent)) |
(optional . User-Agent)) |
235 |
"*Headers to be generated or prompted for when mailing a message. |
"*Headers to be generated or prompted for when mailing a message. |
236 |
RFC822 required that From, Date, To, Subject and Message-ID be |
It is recommended that From, Date, To, Subject and Message-ID be |
237 |
included. Organization, Lines and User-Agent are optional." |
included. Organization and User-Agent are optional." |
238 |
:group 'message-mail |
:group 'message-mail |
239 |
:group 'message-headers |
:group 'message-headers |
240 |
|
:link '(custom-manual "(message)Message Headers") |
241 |
:type '(repeat sexp)) |
:type '(repeat sexp)) |
242 |
|
|
243 |
(defcustom message-deletable-headers '(Message-ID Date Lines) |
(defcustom message-deletable-headers '(Message-ID Date Lines) |
244 |
"Headers to be deleted if they already exist and were generated by message previously." |
"Headers to be deleted if they already exist and were generated by message previously." |
245 |
:group 'message-headers |
:group 'message-headers |
246 |
|
:link '(custom-manual "(message)Message Headers") |
247 |
:type 'sexp) |
:type 'sexp) |
248 |
|
|
249 |
(defcustom message-ignored-news-headers |
(defcustom message-ignored-news-headers |
250 |
"^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:" |
"^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:" |
251 |
"*Regexp of headers to be removed unconditionally before posting." |
"*Regexp of headers to be removed unconditionally before posting." |
252 |
:group 'message-news |
:group 'message-news |
253 |
:group 'message-headers |
:group 'message-headers |
254 |
|
:link '(custom-manual "(message)Message Headers") |
255 |
:type 'regexp) |
:type 'regexp) |
256 |
|
|
257 |
(defcustom message-ignored-mail-headers "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:" |
(defcustom message-ignored-mail-headers |
258 |
|
"^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:" |
259 |
"*Regexp of headers to be removed unconditionally before mailing." |
"*Regexp of headers to be removed unconditionally before mailing." |
260 |
:group 'message-mail |
:group 'message-mail |
261 |
:group 'message-headers |
:group 'message-headers |
262 |
|
:link '(custom-manual "(message)Mail Headers") |
263 |
:type 'regexp) |
:type 'regexp) |
264 |
|
|
265 |
(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:" |
(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:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:\\|^X-Payment:" |
266 |
"*Header lines matching this regexp will be deleted before posting. |
"*Header lines matching this regexp will be deleted before posting. |
267 |
It's best to delete old Path and Date headers before posting to avoid |
It's best to delete old Path and Date headers before posting to avoid |
268 |
any confusion." |
any confusion." |
269 |
:group 'message-interface |
:group 'message-interface |
270 |
|
:link '(custom-manual "(message)Superseding") |
271 |
:type 'regexp) |
:type 'regexp) |
272 |
|
|
273 |
(defcustom message-subject-re-regexp "^[ \t]*\\([Rr][Ee]:[ \t]*\\)*[ \t]*" |
(defcustom message-subject-re-regexp |
274 |
|
"^[ \t]*\\([Rr][Ee]\\(\\[[0-9]*\\]\\)*:[ \t]*\\)*[ \t]*" |
275 |
"*Regexp matching \"Re: \" in the subject line." |
"*Regexp matching \"Re: \" in the subject line." |
276 |
:group 'message-various |
:group 'message-various |
277 |
|
:link '(custom-manual "(message)Message Headers") |
278 |
|
:type 'regexp) |
279 |
|
|
280 |
|
;;; Start of variables adopted from `message-utils.el'. |
281 |
|
|
282 |
|
(defcustom message-subject-trailing-was-query 'ask |
283 |
|
"*What to do with trailing \"(was: <old subject>)\" in subject lines. |
284 |
|
If nil, leave the subject unchanged. If it is the symbol `ask', query |
285 |
|
the user what do do. In this case, the subject is matched against |
286 |
|
`message-subject-trailing-was-ask-regexp'. If |
287 |
|
`message-subject-trailing-was-query' is t, always strip the trailing |
288 |
|
old subject. In this case, `message-subject-trailing-was-regexp' is |
289 |
|
used." |
290 |
|
:type '(choice (const :tag "never" nil) |
291 |
|
(const :tag "always strip" t) |
292 |
|
(const ask)) |
293 |
|
:link '(custom-manual "(message)Message Headers") |
294 |
|
:group 'message-various) |
295 |
|
|
296 |
|
(defcustom message-subject-trailing-was-ask-regexp |
297 |
|
"[ \t]*\\([[(]+[Ww][Aa][Ss][ \t]*.*[\])]+\\)" |
298 |
|
"*Regexp matching \"(was: <old subject>)\" in the subject line. |
299 |
|
|
300 |
|
The function `message-strip-subject-trailing-was' uses this regexp if |
301 |
|
`message-subject-trailing-was-query' is set to the symbol `ask'. If |
302 |
|
the variable is t instead of `ask', use |
303 |
|
`message-subject-trailing-was-regexp' instead. |
304 |
|
|
305 |
|
It is okay to create some false positives here, as the user is asked." |
306 |
|
:group 'message-various |
307 |
|
:link '(custom-manual "(message)Message Headers") |
308 |
:type 'regexp) |
:type 'regexp) |
309 |
|
|
310 |
|
(defcustom message-subject-trailing-was-regexp |
311 |
|
"[ \t]*\\((*[Ww][Aa][Ss]:[ \t]*.*)\\)" |
312 |
|
"*Regexp matching \"(was: <old subject>)\" in the subject line. |
313 |
|
|
314 |
|
If `message-subject-trailing-was-query' is set to t, the subject is |
315 |
|
matched against `message-subject-trailing-was-regexp' in |
316 |
|
`message-strip-subject-trailing-was'. You should use a regexp creating very |
317 |
|
few false positives here." |
318 |
|
:group 'message-various |
319 |
|
:link '(custom-manual "(message)Message Headers") |
320 |
|
:type 'regexp) |
321 |
|
|
322 |
|
;; Fixme: Why are all these things autoloaded? |
323 |
|
|
324 |
|
;;; marking inserted text |
325 |
|
|
326 |
|
;;;###autoload |
327 |
|
(defcustom message-mark-insert-begin |
328 |
|
"--8<---------------cut here---------------start------------->8---\n" |
329 |
|
"How to mark the beginning of some inserted text." |
330 |
|
:type 'string |
331 |
|
:link '(custom-manual "(message)Insertion Variables") |
332 |
|
:group 'message-various) |
333 |
|
|
334 |
|
;;;###autoload |
335 |
|
(defcustom message-mark-insert-end |
336 |
|
"--8<---------------cut here---------------end--------------->8---\n" |
337 |
|
"How to mark the end of some inserted text." |
338 |
|
:type 'string |
339 |
|
:link '(custom-manual "(message)Insertion Variables") |
340 |
|
:group 'message-various) |
341 |
|
|
342 |
|
;;;###autoload |
343 |
|
(defcustom message-archive-header |
344 |
|
"X-No-Archive: Yes\n" |
345 |
|
"Header to insert when you don't want your article to be archived. |
346 |
|
Archives \(such as groups.google.com\) respect this header." |
347 |
|
:type 'string |
348 |
|
:link '(custom-manual "(message)Header Commands") |
349 |
|
:group 'message-various) |
350 |
|
|
351 |
|
;;;###autoload |
352 |
|
(defcustom message-archive-note |
353 |
|
"X-No-Archive: Yes - save http://groups.google.com/" |
354 |
|
"Note to insert why you wouldn't want this posting archived. |
355 |
|
If nil, don't insert any text in the body." |
356 |
|
:type '(radio (string :format "%t: %v\n" :size 0) |
357 |
|
(const nil)) |
358 |
|
:link '(custom-manual "(message)Header Commands") |
359 |
|
:group 'message-various) |
360 |
|
|
361 |
|
;;; Crossposts and Followups |
362 |
|
;; inspired by JoH-followup-to by Jochem Huhman <joh at gmx.de> |
363 |
|
;; new suggestions by R. Weikusat <rw at another.de> |
364 |
|
|
365 |
|
(defvar message-cross-post-old-target nil |
366 |
|
"Old target for cross-posts or follow-ups.") |
367 |
|
(make-variable-buffer-local 'message-cross-post-old-target) |
368 |
|
|
369 |
|
;;;###autoload |
370 |
|
(defcustom message-cross-post-default t |
371 |
|
"When non-nil `message-cross-post-followup-to' will perform a crosspost. |
372 |
|
If nil, `message-cross-post-followup-to' will only do a followup. Note that |
373 |
|
you can explicitly override this setting by calling |
374 |
|
`message-cross-post-followup-to' with a prefix." |
375 |
|
:type 'boolean |
376 |
|
:group 'message-various) |
377 |
|
|
378 |
|
;;;###autoload |
379 |
|
(defcustom message-cross-post-note |
380 |
|
"Crosspost & Followup-To: " |
381 |
|
"Note to insert before signature to notify of cross-post and follow-up." |
382 |
|
:type 'string |
383 |
|
:group 'message-various) |
384 |
|
|
385 |
|
;;;###autoload |
386 |
|
(defcustom message-followup-to-note |
387 |
|
"Followup-To: " |
388 |
|
"Note to insert before signature to notify of follow-up only." |
389 |
|
:type 'string |
390 |
|
:group 'message-various) |
391 |
|
|
392 |
|
;;;###autoload |
393 |
|
(defcustom message-cross-post-note-function |
394 |
|
'message-cross-post-insert-note |
395 |
|
"Function to use to insert note about Crosspost or Followup-To. |
396 |
|
The function will be called with four arguments. The function should not only |
397 |
|
insert a note, but also ensure old notes are deleted. See the documentation |
398 |
|
for `message-cross-post-insert-note'." |
399 |
|
:type 'function |
400 |
|
:group 'message-various) |
401 |
|
|
402 |
|
;;; End of variables adopted from `message-utils.el'. |
403 |
|
|
404 |
;;;###autoload |
;;;###autoload |
405 |
(defcustom message-signature-separator "^-- *$" |
(defcustom message-signature-separator "^-- *$" |
406 |
"Regexp matching the signature separator." |
"Regexp matching the signature separator." |
407 |
:type 'regexp |
:type 'regexp |
408 |
|
:link '(custom-manual "(message)Various Message Variables") |
409 |
:group 'message-various) |
:group 'message-various) |
410 |
|
|
411 |
(defcustom message-elide-ellipsis "\n[...]\n\n" |
(defcustom message-elide-ellipsis "\n[...]\n\n" |
412 |
"*The string which is inserted for elided text." |
"*The string which is inserted for elided text." |
413 |
:type 'string |
:type 'string |
414 |
|
:link '(custom-manual "(message)Various Commands") |
415 |
:group 'message-various) |
:group 'message-various) |
416 |
|
|
417 |
(defcustom message-interactive nil |
(defcustom message-interactive t |
418 |
"Non-nil means when sending a message wait for and display errors. |
"Non-nil means when sending a message wait for and display errors. |
419 |
nil means let mailer mail back a message to report errors." |
nil means let mailer mail back a message to report errors." |
420 |
:group 'message-sending |
:group 'message-sending |
421 |
:group 'message-mail |
:group 'message-mail |
422 |
|
:link '(custom-manual "(message)Sending Variables") |
423 |
:type 'boolean) |
:type 'boolean) |
424 |
|
|
425 |
(defcustom message-generate-new-buffers 'unique |
(defcustom message-generate-new-buffers 'unique |
428 |
the to address and the group name. (Any of these may be nil.) The function |
the to address and the group name. (Any of these may be nil.) The function |
429 |
should return the new buffer name." |
should return the new buffer name." |
430 |
:group 'message-buffers |
:group 'message-buffers |
431 |
|
:link '(custom-manual "(message)Message Buffers") |
432 |
:type '(choice (const :tag "off" nil) |
:type '(choice (const :tag "off" nil) |
433 |
(const :tag "unique" unique) |
(const :tag "unique" unique) |
434 |
(const :tag "unsent" unsent) |
(const :tag "unsent" unsent) |
437 |
(defcustom message-kill-buffer-on-exit nil |
(defcustom message-kill-buffer-on-exit nil |
438 |
"*Non-nil means that the message buffer will be killed after sending a message." |
"*Non-nil means that the message buffer will be killed after sending a message." |
439 |
:group 'message-buffers |
:group 'message-buffers |
440 |
|
:link '(custom-manual "(message)Message Buffers") |
441 |
:type 'boolean) |
:type 'boolean) |
442 |
|
|
443 |
(eval-when-compile |
(eval-when-compile |
458 |
(defcustom message-user-organization-file "/usr/lib/news/organization" |
(defcustom message-user-organization-file "/usr/lib/news/organization" |
459 |
"*Local news organization file." |
"*Local news organization file." |
460 |
:type 'file |
:type 'file |
461 |
|
:link '(custom-manual "(message)News Headers") |
462 |
:group 'message-headers) |
:group 'message-headers) |
463 |
|
|
464 |
(defcustom message-make-forward-subject-function |
(defcustom message-make-forward-subject-function |
465 |
'message-forward-subject-author-subject |
#'message-forward-subject-name-subject |
466 |
"*List of functions called to generate subject headers for forwarded messages. |
"*List of functions called to generate subject headers for forwarded messages. |
467 |
The subject generated by the previous function is passed into each |
The subject generated by the previous function is passed into each |
468 |
successive function. |
successive function. |
469 |
|
|
470 |
The provided functions are: |
The provided functions are: |
471 |
|
|
472 |
* `message-forward-subject-author-subject' (Source of article (author or |
* `message-forward-subject-author-subject' Source of article (author or |
473 |
newsgroup)), in brackets followed by the subject |
newsgroup), in brackets followed by the subject |
474 |
* `message-forward-subject-fwd' (Subject of article with 'Fwd:' prepended |
* `message-forward-subject-name-subject' Source of article (name of author |
475 |
|
or newsgroup), in brackets followed by the subject |
476 |
|
* `message-forward-subject-fwd' Subject of article with 'Fwd:' prepended |
477 |
to it." |
to it." |
478 |
:group 'message-forwarding |
:group 'message-forwarding |
479 |
|
:link '(custom-manual "(message)Forwarding") |
480 |
:type '(radio (function-item message-forward-subject-author-subject) |
:type '(radio (function-item message-forward-subject-author-subject) |
481 |
(function-item message-forward-subject-fwd) |
(function-item message-forward-subject-fwd) |
482 |
|
(function-item message-forward-subject-name-subject) |
483 |
(repeat :tag "List of functions" function))) |
(repeat :tag "List of functions" function))) |
484 |
|
|
485 |
(defcustom message-forward-as-mime t |
(defcustom message-forward-as-mime t |
486 |
"*If non-nil, forward messages as an inline/rfc822 MIME section. Otherwise, directly inline the old message in the forwarded message." |
"*Non-nil means forward messages as an inline/rfc822 MIME section. |
487 |
|
Otherwise, directly inline the old message in the forwarded message." |
488 |
:version "21.1" |
:version "21.1" |
489 |
:group 'message-forwarding |
:group 'message-forwarding |
490 |
|
:link '(custom-manual "(message)Forwarding") |
491 |
:type 'boolean) |
:type 'boolean) |
492 |
|
|
493 |
(defcustom message-forward-show-mml t |
(defcustom message-forward-show-mml 'best |
494 |
"*If non-nil, forward messages are shown as mml. Otherwise, forward messages are unchanged." |
"*Non-nil means show forwarded messages as MML (decoded from MIME). |
495 |
|
Otherwise, forwarded messages are unchanged. |
496 |
|
Can also be the symbol `best' to indicate that MML should be |
497 |
|
used, except when it is a bad idea to use MML. One example where |
498 |
|
it is a bad idea is when forwarding a signed or encrypted |
499 |
|
message, because converting MIME to MML would invalidate the |
500 |
|
digital signature." |
501 |
:version "21.1" |
:version "21.1" |
502 |
:group 'message-forwarding |
:group 'message-forwarding |
503 |
:type 'boolean) |
:type '(choice (const :tag "use MML" t) |
504 |
|
(const :tag "don't use MML " nil) |
505 |
|
(const :tag "use MML when appropriate" best))) |
506 |
|
|
507 |
(defcustom message-forward-before-signature t |
(defcustom message-forward-before-signature t |
508 |
"*If non-nil, put forwarded message before signature, else after." |
"*Non-nil means put forwarded message before signature, else after." |
509 |
:group 'message-forwarding |
:group 'message-forwarding |
510 |
:type 'boolean) |
:type 'boolean) |
511 |
|
|
512 |
(defcustom message-wash-forwarded-subjects nil |
(defcustom message-wash-forwarded-subjects nil |
513 |
"*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." |
"*Non-nil means try to remove as much cruft as possible from the subject. |
514 |
|
Done before generating the new subject of a forward." |
515 |
:group 'message-forwarding |
:group 'message-forwarding |
516 |
|
:link '(custom-manual "(message)Forwarding") |
517 |
:type 'boolean) |
:type 'boolean) |
518 |
|
|
519 |
(defcustom message-ignored-resent-headers "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:" |
(defcustom message-ignored-resent-headers "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:\\|^>?From " |
520 |
"*All headers that match this regexp will be deleted when resending a message." |
"*All headers that match this regexp will be deleted when resending a message." |
521 |
:group 'message-interface |
:group 'message-interface |
522 |
|
:link '(custom-manual "(message)Resending") |
523 |
:type 'regexp) |
:type 'regexp) |
524 |
|
|
525 |
(defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus" |
(defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus" |
532 |
(defcustom message-ignored-cited-headers "." |
(defcustom message-ignored-cited-headers "." |
533 |
"*Delete these headers from the messages you yank." |
"*Delete these headers from the messages you yank." |
534 |
:group 'message-insertion |
:group 'message-insertion |
535 |
|
:link '(custom-manual "(message)Insertion Variables") |
536 |
|
:type 'regexp) |
537 |
|
|
538 |
|
(defcustom message-cite-prefix-regexp |
539 |
|
(if (string-match "[[:digit:]]" "1") ;; support POSIX? |
540 |
|
"\\([ \t]*[-_.[:word:]]+>+\\|[ \t]*[]>|}+]\\)+" |
541 |
|
;; ?-, ?_ or ?. MUST NOT be in syntax entry w. |
542 |
|
(let ((old-table (syntax-table)) |
543 |
|
non-word-constituents) |
544 |
|
(set-syntax-table text-mode-syntax-table) |
545 |
|
(setq non-word-constituents |
546 |
|
(concat |
547 |
|
(if (string-match "\\w" "-") "" "-") |
548 |
|
(if (string-match "\\w" "_") "" "_") |
549 |
|
(if (string-match "\\w" ".") "" "."))) |
550 |
|
(set-syntax-table old-table) |
551 |
|
(if (equal non-word-constituents "") |
552 |
|
"\\([ \t]*\\(\\w\\)+>+\\|[ \t]*[]>|}+]\\)+" |
553 |
|
(concat "\\([ \t]*\\(\\w\\|[" |
554 |
|
non-word-constituents |
555 |
|
"]\\)+>+\\|[ \t]*[]>|}+]\\)+")))) |
556 |
|
"*Regexp matching the longest possible citation prefix on a line." |
557 |
|
:group 'message-insertion |
558 |
|
:link '(custom-manual "(message)Insertion Variables") |
559 |
:type 'regexp) |
:type 'regexp) |
560 |
|
|
561 |
(defcustom message-cancel-message "I am canceling my own article.\n" |
(defcustom message-cancel-message "I am canceling my own article.\n" |
562 |
"Message to be inserted in the cancel message." |
"Message to be inserted in the cancel message." |
563 |
:group 'message-interface |
:group 'message-interface |
564 |
|
:link '(custom-manual "(message)Canceling News") |
565 |
:type 'string) |
:type 'string) |
566 |
|
|
567 |
;; Useful to set in site-init.el |
;; Useful to set in site-init.el |
573 |
|
|
574 |
Valid values include `message-send-mail-with-sendmail' (the default), |
Valid values include `message-send-mail-with-sendmail' (the default), |
575 |
`message-send-mail-with-mh', `message-send-mail-with-qmail', |
`message-send-mail-with-mh', `message-send-mail-with-qmail', |
576 |
`smtpmail-send-it' and `feedmail-send-it'. |
`message-smtpmail-send-it', `smtpmail-send-it' and `feedmail-send-it'. |
577 |
|
|
578 |
See also `send-mail-function'." |
See also `send-mail-function'." |
579 |
:type '(radio (function-item message-send-mail-with-sendmail) |
:type '(radio (function-item message-send-mail-with-sendmail) |
580 |
(function-item message-send-mail-with-mh) |
(function-item message-send-mail-with-mh) |
581 |
(function-item message-send-mail-with-qmail) |
(function-item message-send-mail-with-qmail) |
582 |
|
(function-item message-smtpmail-send-it) |
583 |
(function-item smtpmail-send-it) |
(function-item smtpmail-send-it) |
584 |
(function-item feedmail-send-it) |
(function-item feedmail-send-it) |
585 |
(function :tag "Other")) |
(function :tag "Other")) |
586 |
:group 'message-sending |
:group 'message-sending |
587 |
|
:link '(custom-manual "(message)Mail Variables") |
588 |
:group 'message-mail) |
:group 'message-mail) |
589 |
|
|
590 |
(defcustom message-send-news-function 'message-send-news |
(defcustom message-send-news-function 'message-send-news |
593 |
variable `mail-header-separator'." |
variable `mail-header-separator'." |
594 |
:group 'message-sending |
:group 'message-sending |
595 |
:group 'message-news |
:group 'message-news |
596 |
|
:link '(custom-manual "(message)News Variables") |
597 |
:type 'function) |
:type 'function) |
598 |
|
|
599 |
(defcustom message-reply-to-function nil |
(defcustom message-reply-to-function nil |
601 |
This function should pick out addresses from the To, Cc, and From headers |
This function should pick out addresses from the To, Cc, and From headers |
602 |
and respond with new To and Cc headers." |
and respond with new To and Cc headers." |
603 |
:group 'message-interface |
:group 'message-interface |
604 |
|
:link '(custom-manual "(message)Reply") |
605 |
:type '(choice function (const nil))) |
:type '(choice function (const nil))) |
606 |
|
|
607 |
(defcustom message-wide-reply-to-function nil |
(defcustom message-wide-reply-to-function nil |
609 |
This function should pick out addresses from the To, Cc, and From headers |
This function should pick out addresses from the To, Cc, and From headers |
610 |
and respond with new To and Cc headers." |
and respond with new To and Cc headers." |
611 |
:group 'message-interface |
:group 'message-interface |
612 |
|
:link '(custom-manual "(message)Wide Reply") |
613 |
:type '(choice function (const nil))) |
:type '(choice function (const nil))) |
614 |
|
|
615 |
(defcustom message-followup-to-function nil |
(defcustom message-followup-to-function nil |
617 |
This function should pick out addresses from the To, Cc, and From headers |
This function should pick out addresses from the To, Cc, and From headers |
618 |
and respond with new To and Cc headers." |
and respond with new To and Cc headers." |
619 |
:group 'message-interface |
:group 'message-interface |
620 |
|
:link '(custom-manual "(message)Followup") |
621 |
:type '(choice function (const nil))) |
:type '(choice function (const nil))) |
622 |
|
|
623 |
(defcustom message-use-followup-to 'ask |
(defcustom message-use-followup-to 'ask |
627 |
always query the user whether to use the value. If it is the symbol |
always query the user whether to use the value. If it is the symbol |
628 |
`use', always use the value." |
`use', always use the value." |
629 |
:group 'message-interface |
:group 'message-interface |
630 |
|
:link '(custom-manual "(message)Followup") |
631 |
:type '(choice (const :tag "ignore" nil) |
:type '(choice (const :tag "ignore" nil) |
632 |
|
(const :tag "use & query" t) |
633 |
(const use) |
(const use) |
634 |
(const ask))) |
(const ask))) |
635 |
|
|
636 |
|
(defcustom message-use-mail-followup-to 'use |
637 |
|
"*Specifies what to do with Mail-Followup-To header. |
638 |
|
If nil, always ignore the header. If it is the symbol `ask', always |
639 |
|
query the user whether to use the value. If it is the symbol `use', |
640 |
|
always use the value." |
641 |
|
:group 'message-interface |
642 |
|
:link '(custom-manual "(message)Mailing Lists") |
643 |
|
:type '(choice (const :tag "ignore" nil) |
644 |
|
(const use) |
645 |
|
(const ask))) |
646 |
|
|
647 |
|
(defcustom message-subscribed-address-functions nil |
648 |
|
"*Specifies functions for determining list subscription. |
649 |
|
If nil, do not attempt to determine list subscription with functions. |
650 |
|
If non-nil, this variable contains a list of functions which return |
651 |
|
regular expressions to match lists. These functions can be used in |
652 |
|
conjunction with `message-subscribed-regexps' and |
653 |
|
`message-subscribed-addresses'." |
654 |
|
:group 'message-interface |
655 |
|
:link '(custom-manual "(message)Mailing Lists") |
656 |
|
:type '(repeat sexp)) |
657 |
|
|
658 |
|
(defcustom message-subscribed-address-file nil |
659 |
|
"*A file containing addresses the user is subscribed to. |
660 |
|
If nil, do not look at any files to determine list subscriptions. If |
661 |
|
non-nil, each line of this file should be a mailing list address." |
662 |
|
:group 'message-interface |
663 |
|
:link '(custom-manual "(message)Mailing Lists") |
664 |
|
:type '(radio (file :format "%t: %v\n" :size 0) |
665 |
|
(const nil))) |
666 |
|
|
667 |
|
(defcustom message-subscribed-addresses nil |
668 |
|
"*Specifies a list of addresses the user is subscribed to. |
669 |
|
If nil, do not use any predefined list subscriptions. This list of |
670 |
|
addresses can be used in conjunction with |
671 |
|
`message-subscribed-address-functions' and `message-subscribed-regexps'." |
672 |
|
:group 'message-interface |
673 |
|
:link '(custom-manual "(message)Mailing Lists") |
674 |
|
:type '(repeat string)) |
675 |
|
|
676 |
|
(defcustom message-subscribed-regexps nil |
677 |
|
"*Specifies a list of addresses the user is subscribed to. |
678 |
|
If nil, do not use any predefined list subscriptions. This list of |
679 |
|
regular expressions can be used in conjunction with |
680 |
|
`message-subscribed-address-functions' and `message-subscribed-addresses'." |
681 |
|
:group 'message-interface |
682 |
|
:link '(custom-manual "(message)Mailing Lists") |
683 |
|
:type '(repeat regexp)) |
684 |
|
|
685 |
|
(defcustom message-allow-no-recipients 'ask |
686 |
|
"Specifies what to do when there are no recipients other than Gcc/Fcc. |
687 |
|
If it is the symbol `always', the posting is allowed. If it is the |
688 |
|
symbol `never', the posting is not allowed. If it is the symbol |
689 |
|
`ask', you are prompted." |
690 |
|
:group 'message-interface |
691 |
|
:link '(custom-manual "(message)Message Headers") |
692 |
|
:type '(choice (const always) |
693 |
|
(const never) |
694 |
|
(const ask))) |
695 |
|
|
696 |
(defcustom message-sendmail-f-is-evil nil |
(defcustom message-sendmail-f-is-evil nil |
697 |
"*Non-nil means don't add \"-f username\" to the sendmail command line. |
"*Non-nil means don't add \"-f username\" to the sendmail command line. |
698 |
Doing so would be even more evil than leaving it out." |
Doing so would be even more evil than leaving it out." |
699 |
:group 'message-sending |
:group 'message-sending |
700 |
|
:link '(custom-manual "(message)Mail Variables") |
701 |
:type 'boolean) |
:type 'boolean) |
702 |
|
|
703 |
|
(defcustom message-sendmail-envelope-from nil |
704 |
|
"*Envelope-from when sending mail with sendmail. |
705 |
|
If this is nil, use `user-mail-address'. If it is the symbol |
706 |
|
`header', use the From: header of the message." |
707 |
|
:type '(choice (string :tag "From name") |
708 |
|
(const :tag "Use From: header from message" header) |
709 |
|
(const :tag "Use `user-mail-address'" nil)) |
710 |
|
:link '(custom-manual "(message)Mail Variables") |
711 |
|
:group 'message-sending) |
712 |
|
|
713 |
;; qmail-related stuff |
;; qmail-related stuff |
714 |
(defcustom message-qmail-inject-program "/var/qmail/bin/qmail-inject" |
(defcustom message-qmail-inject-program "/var/qmail/bin/qmail-inject" |
715 |
"Location of the qmail-inject program." |
"Location of the qmail-inject program." |
716 |
:group 'message-sending |
:group 'message-sending |
717 |
|
:link '(custom-manual "(message)Mail Variables") |
718 |
:type 'file) |
:type 'file) |
719 |
|
|
720 |
(defcustom message-qmail-inject-args nil |
(defcustom message-qmail-inject-args nil |
721 |
"Arguments passed to qmail-inject programs. |
"Arguments passed to qmail-inject programs. |
722 |
This should be a list of strings, one string for each argument. |
This should be a list of strings, one string for each argument. It |
723 |
|
may also be a function. |
724 |
|
|
725 |
For e.g., if you wish to set the envelope sender address so that bounces |
For e.g., if you wish to set the envelope sender address so that bounces |
726 |
go to the right place or to deal with listserv's usage of that address, you |
go to the right place or to deal with listserv's usage of that address, you |
727 |
might set this variable to '(\"-f\" \"you@some.where\")." |
might set this variable to '(\"-f\" \"you@some.where\")." |
728 |
:group 'message-sending |
:group 'message-sending |
729 |
:type '(repeat string)) |
:link '(custom-manual "(message)Mail Variables") |
730 |
|
:type '(choice (function) |
731 |
|
(repeat string))) |
732 |
|
|
733 |
(defvar message-cater-to-broken-inn t |
(defvar message-cater-to-broken-inn t |
734 |
"Non-nil means Gnus should not fold the `References' header. |
"Non-nil means Gnus should not fold the `References' header. |
755 |
;; create a dependence to `gnus.el'. |
;; create a dependence to `gnus.el'. |
756 |
:type 'sexp) |
:type 'sexp) |
757 |
|
|
758 |
(defcustom message-generate-headers-first nil |
;; FIXME: This should be a temporary workaround until someone implements a |
759 |
"*If non-nil, generate all possible headers before composing." |
;; proper solution. If a crash happens while replying, the auto-save file |
760 |
|
;; will *not* have a `References:' header if `message-generate-headers-first' |
761 |
|
;; is nil. See: http://article.gmane.org/gmane.emacs.gnus.general/51138 |
762 |
|
(defcustom message-generate-headers-first '(references) |
763 |
|
"Which headers should be generated before starting to compose a message. |
764 |
|
If `t', generate all required headers. This can also be a list of headers to |
765 |
|
generate. The variables `message-required-news-headers' and |
766 |
|
`message-required-mail-headers' specify which headers to generate. |
767 |
|
|
768 |
|
Note that the variable `message-deletable-headers' specifies headers which |
769 |
|
are to be deleted and then re-generated before sending, so this variable |
770 |
|
will not have a visible effect for those headers." |
771 |
:group 'message-headers |
:group 'message-headers |
772 |
:type 'boolean) |
:link '(custom-manual "(message)Message Headers") |
773 |
|
:type '(choice (const :tag "None" nil) |
774 |
|
(const :tag "References" '(references)) |
775 |
|
(const :tag "All" t) |
776 |
|
(repeat (sexp :tag "Header")))) |
777 |
|
|
778 |
(defcustom message-setup-hook nil |
(defcustom message-setup-hook nil |
779 |
"Normal hook, run each time a new outgoing message is initialized. |
"Normal hook, run each time a new outgoing message is initialized. |
780 |
The function `message-setup' runs this hook." |
The function `message-setup' runs this hook." |
781 |
:group 'message-various |
:group 'message-various |
782 |
|
:link '(custom-manual "(message)Various Message Variables") |
783 |
:type 'hook) |
:type 'hook) |
784 |
|
|
785 |
(defcustom message-cancel-hook nil |
(defcustom message-cancel-hook nil |
786 |
"Hook run when cancelling articles." |
"Hook run when cancelling articles." |
787 |
:group 'message-various |
:group 'message-various |
788 |
|
:link '(custom-manual "(message)Various Message Variables") |
789 |
:type 'hook) |
:type 'hook) |
790 |
|
|
791 |
(defcustom message-signature-setup-hook nil |
(defcustom message-signature-setup-hook nil |
793 |
It is run after the headers have been inserted and before |
It is run after the headers have been inserted and before |
794 |
the signature is inserted." |
the signature is inserted." |
795 |
:group 'message-various |
:group 'message-various |
796 |
|
:link '(custom-manual "(message)Various Message Variables") |
797 |
:type 'hook) |
:type 'hook) |
798 |
|
|
799 |
(defcustom message-mode-hook nil |
(defcustom message-mode-hook nil |
809 |
(defcustom message-header-setup-hook nil |
(defcustom message-header-setup-hook nil |
810 |
"Hook called narrowed to the headers when setting up a message buffer." |
"Hook called narrowed to the headers when setting up a message buffer." |
811 |
:group 'message-various |
:group 'message-various |
812 |
|
:link '(custom-manual "(message)Various Message Variables") |
813 |
:type 'hook) |
:type 'hook) |
814 |
|
|
815 |
|
(defcustom message-minibuffer-local-map |
816 |
|
(let ((map (make-sparse-keymap 'message-minibuffer-local-map))) |
817 |
|
(set-keymap-parent map minibuffer-local-map) |
818 |
|
map) |
819 |
|
"Keymap for `message-read-from-minibuffer'.") |
820 |
|
|
821 |
;;;###autoload |
;;;###autoload |
822 |
(defcustom message-citation-line-function 'message-insert-citation-line |
(defcustom message-citation-line-function 'message-insert-citation-line |
823 |
"*Function called to insert the \"Whomever writes:\" line." |
"*Function called to insert the \"Whomever writes:\" line. |
824 |
|
|
825 |
|
Note that Gnus provides a feature where the reader can click on |
826 |
|
`writes:' to hide the cited text. If you change this line too much, |
827 |
|
people who read your message will have to change their Gnus |
828 |
|
configuration. See the variable `gnus-cite-attribution-suffix'." |
829 |
:type 'function |
:type 'function |
830 |
|
:link '(custom-manual "(message)Insertion Variables") |
831 |
:group 'message-insertion) |
:group 'message-insertion) |
832 |
|
|
833 |
;;;###autoload |
;;;###autoload |
834 |
(defcustom message-yank-prefix "> " |
(defcustom message-yank-prefix "> " |
835 |
"*Prefix inserted on the lines of yanked messages." |
"*Prefix inserted on the lines of yanked messages. |
836 |
|
Fix `message-cite-prefix-regexp' if it is set to an abnormal value. |
837 |
|
See also `message-yank-cited-prefix'." |
838 |
|
:type 'string |
839 |
|
:link '(custom-manual "(message)Insertion Variables") |
840 |
|
:group 'message-insertion) |
841 |
|
|
842 |
|
(defcustom message-yank-cited-prefix ">" |
843 |
|
"*Prefix inserted on cited or empty lines of yanked messages. |
844 |
|
Fix `message-cite-prefix-regexp' if it is set to an abnormal value. |
845 |
|
See also `message-yank-prefix'." |
846 |
:type 'string |
:type 'string |
847 |
|
:link '(custom-manual "(message)Insertion Variables") |
848 |
:group 'message-insertion) |
:group 'message-insertion) |
849 |
|
|
850 |
(defcustom message-indentation-spaces 3 |
(defcustom message-indentation-spaces 3 |
851 |
"*Number of spaces to insert at the beginning of each cited line. |
"*Number of spaces to insert at the beginning of each cited line. |
852 |
Used by `message-yank-original' via `message-yank-cite'." |
Used by `message-yank-original' via `message-yank-cite'." |
853 |
:group 'message-insertion |
:group 'message-insertion |
854 |
|
:link '(custom-manual "(message)Insertion Variables") |
855 |
:type 'integer) |
:type 'integer) |
856 |
|
|
857 |
;;;###autoload |
;;;###autoload |
864 |
(function-item message-cite-original-without-signature) |
(function-item message-cite-original-without-signature) |
865 |
(function-item sc-cite-original) |
(function-item sc-cite-original) |
866 |
(function :tag "Other")) |
(function :tag "Other")) |
867 |
|
:link '(custom-manual "(message)Insertion Variables") |
868 |
:group 'message-insertion) |
:group 'message-insertion) |
869 |
|
|
870 |
;;;###autoload |
;;;###autoload |
874 |
citation between (point) and (mark t). And each function should leave |
citation between (point) and (mark t). And each function should leave |
875 |
point and mark around the citation text as modified." |
point and mark around the citation text as modified." |
876 |
:type 'function |
:type 'function |
877 |
|
:link '(custom-manual "(message)Insertion Variables") |
878 |
:group 'message-insertion) |
:group 'message-insertion) |
879 |
|
|
|
(defvar message-abbrevs-loaded nil) |
|
|
|
|
880 |
;;;###autoload |
;;;###autoload |
881 |
(defcustom message-signature t |
(defcustom message-signature t |
882 |
"*String to be inserted at the end of the message buffer. |
"*String to be inserted at the end of the message buffer. |
884 |
If a function, the result from the function will be used instead. |
If a function, the result from the function will be used instead. |
885 |
If a form, the result from the form will be used instead." |
If a form, the result from the form will be used instead." |
886 |
:type 'sexp |
:type 'sexp |
887 |
|
:link '(custom-manual "(message)Insertion Variables") |
888 |
:group 'message-insertion) |
:group 'message-insertion) |
889 |
|
|
890 |
;;;###autoload |
;;;###autoload |
893 |
Ignored if the named file doesn't exist. |
Ignored if the named file doesn't exist. |
894 |
If nil, don't insert a signature." |
If nil, don't insert a signature." |
895 |
:type '(choice file (const :tags "None" nil)) |
:type '(choice file (const :tags "None" nil)) |
896 |
|
:link '(custom-manual "(message)Insertion Variables") |
897 |
|
:group 'message-insertion) |
898 |
|
|
899 |
|
;;;###autoload |
900 |
|
(defcustom message-signature-insert-empty-line t |
901 |
|
"*If non-nil, insert an empty line before the signature separator." |
902 |
|
:type 'boolean |
903 |
|
:link '(custom-manual "(message)Insertion Variables") |
904 |
:group 'message-insertion) |
:group 'message-insertion) |
905 |
|
|
906 |
(defcustom message-distribution-function nil |
(defcustom message-distribution-function nil |
907 |
"*Function called to return a Distribution header." |
"*Function called to return a Distribution header." |
908 |
:group 'message-news |
:group 'message-news |
909 |
:group 'message-headers |
:group 'message-headers |
910 |
|
:link '(custom-manual "(message)News Headers") |
911 |
:type '(choice function (const nil))) |
:type '(choice function (const nil))) |
912 |
|
|
913 |
(defcustom message-expires 14 |
(defcustom message-expires 14 |
928 |
(sexp :tag "none" :format "%t" t))) |
(sexp :tag "none" :format "%t" t))) |
929 |
|
|
930 |
(defvar message-reply-buffer nil) |
(defvar message-reply-buffer nil) |
931 |
(defvar message-reply-headers nil) |
(defvar message-reply-headers nil |
932 |
|
"The headers of the current replied article. |
933 |
|
It is a vector of the following headers: |
934 |
|
\[number subject from date id references chars lines xref extra].") |
935 |
(defvar message-newsreader nil) |
(defvar message-newsreader nil) |
936 |
(defvar message-mailer nil) |
(defvar message-mailer nil) |
937 |
(defvar message-sent-message-via nil) |
(defvar message-sent-message-via nil) |
956 |
It is inserted before you edit the message, so you can edit or delete |
It is inserted before you edit the message, so you can edit or delete |
957 |
these lines." |
these lines." |
958 |
:group 'message-headers |
:group 'message-headers |
959 |
|
:link '(custom-manual "(message)Message Headers") |
960 |
:type 'message-header-lines) |
:type 'message-header-lines) |
961 |
|
|
962 |
(defcustom message-default-mail-headers "" |
(defcustom message-default-mail-headers "" |
963 |
"*A string of header lines to be inserted in outgoing mails." |
"*A string of header lines to be inserted in outgoing mails." |
964 |
:group 'message-headers |
:group 'message-headers |
965 |
:group 'message-mail |
:group 'message-mail |
966 |
|
:link '(custom-manual "(message)Mail Headers") |
967 |
:type 'message-header-lines) |
:type 'message-header-lines) |
968 |
|
|
969 |
(defcustom message-default-news-headers "" |
(defcustom message-default-news-headers "" |
970 |
"*A string of header lines to be inserted in outgoing news articles." |
"*A string of header lines to be inserted in outgoing news articles." |
971 |
:group 'message-headers |
:group 'message-headers |
972 |
:group 'message-news |
:group 'message-news |
973 |
|
:link '(custom-manual "(message)News Headers") |
974 |
:type 'message-header-lines) |
:type 'message-header-lines) |
975 |
|
|
976 |
;; Note: could use /usr/ucb/mail instead of sendmail; |
;; Note: could use /usr/ucb/mail instead of sendmail; |
998 |
The value should be an expression to test whether the problem will |
The value should be an expression to test whether the problem will |
999 |
actually occur." |
actually occur." |
1000 |
:group 'message-sending |
:group 'message-sending |
1001 |
|
:link '(custom-manual "(message)Mail Variables") |
1002 |
:type 'sexp) |
:type 'sexp) |
1003 |
|
|
1004 |
;;;###autoload |
;;;###autoload |
1037 |
"*Directory where Message auto-saves buffers if Gnus isn't running. |
"*Directory where Message auto-saves buffers if Gnus isn't running. |
1038 |
If nil, Message won't auto-save." |
If nil, Message won't auto-save." |
1039 |
:group 'message-buffers |
:group 'message-buffers |
1040 |
|
:link '(custom-manual "(message)Various Message Variables") |
1041 |
:type '(choice directory (const :tag "Don't auto-save" nil))) |
:type '(choice directory (const :tag "Don't auto-save" nil))) |
1042 |
|
|
|
(defcustom message-buffer-naming-style 'unique |
|
|
"*The way new message buffers are named. |
|
|
Valid values are `unique' and `unsent'." |
|
|
:version "21.1" |
|
|
:group 'message-buffers |
|
|
:type '(choice (const :tag "unique" unique) |
|
|
(const :tag "unsent" unsent))) |
|
|
|
|
1043 |
(defcustom message-default-charset |
(defcustom message-default-charset |
1044 |
(and (not (mm-multibyte-p)) 'iso-8859-1) |
(and (not (mm-multibyte-p)) 'iso-8859-1) |
1045 |
"Default charset used in non-MULE Emacsen. |
"Default charset used in non-MULE Emacsen. |
1046 |
If nil, you might be asked to input the charset." |
If nil, you might be asked to input the charset." |
1047 |
:version "21.1" |
:version "21.1" |
1048 |
:group 'message |
:group 'message |
1049 |
|
:link '(custom-manual "(message)Various Message Variables") |
1050 |
:type 'symbol) |
:type 'symbol) |
1051 |
|
|
1052 |
(defcustom message-dont-reply-to-names |
(defcustom message-dont-reply-to-names |
1053 |
(and (boundp 'rmail-dont-reply-to-names) rmail-dont-reply-to-names) |
(and (boundp 'rmail-dont-reply-to-names) rmail-dont-reply-to-names) |
1054 |
"*A regexp specifying names to prune when doing wide replies. |
"*A regexp specifying addresses to prune when doing wide replies. |
1055 |
A value of nil means exclude your own name only." |
A value of nil means exclude your own user name only." |
1056 |
:version "21.1" |
:version "21.1" |
1057 |
:group 'message |
:group 'message |
1058 |
|
:link '(custom-manual "(message)Wide Reply") |
1059 |
:type '(choice (const :tag "Yourself" nil) |
:type '(choice (const :tag "Yourself" nil) |
1060 |
regexp)) |
regexp)) |
1061 |
|
|
1062 |
|
(defvar message-shoot-gnksa-feet nil |
1063 |
|
"*A list of GNKSA feet you are allowed to shoot. |
1064 |
|
Gnus gives you all the opportunity you could possibly want for |
1065 |
|
shooting yourself in the foot. Also, Gnus allows you to shoot the |
1066 |
|
feet of Good Net-Keeping Seal of Approval. The following are foot |
1067 |
|
candidates: |
1068 |
|
`empty-article' Allow you to post an empty article; |
1069 |
|
`quoted-text-only' Allow you to post quoted text only; |
1070 |
|
`multiple-copies' Allow you to post multiple copies; |
1071 |
|
`cancel-messages' Allow you to cancel or supersede messages from |
1072 |
|
your other email addresses.") |
1073 |
|
|
1074 |
|
(defsubst message-gnksa-enable-p (feature) |
1075 |
|
(or (not (listp message-shoot-gnksa-feet)) |
1076 |
|
(memq feature message-shoot-gnksa-feet))) |
1077 |
|
|
1078 |
|
(defcustom message-hidden-headers nil |
1079 |
|
"Regexp of headers to be hidden when composing new messages. |
1080 |
|
This can also be a list of regexps to match headers. Or a list |
1081 |
|
starting with `not' and followed by regexps." |
1082 |
|
:group 'message |
1083 |
|
:link '(custom-manual "(message)Message Headers") |
1084 |
|
:type '(repeat regexp)) |
1085 |
|
|
1086 |
;;; Internal variables. |
;;; Internal variables. |
1087 |
;;; Well, not really internal. |
;;; Well, not really internal. |
1088 |
|
|
1094 |
table) |
table) |
1095 |
"Syntax table used while in Message mode.") |
"Syntax table used while in Message mode.") |
1096 |
|
|
|
(defvar message-mode-abbrev-table text-mode-abbrev-table |
|
|
"Abbrev table used in Message mode buffers. |
|
|
Defaults to `text-mode-abbrev-table'.") |
|
|
|
|
1097 |
(defface message-header-to-face |
(defface message-header-to-face |
1098 |
'((((class color) |
'((((class color) |
1099 |
(background dark)) |
(background dark)) |
1100 |
(:foreground "green2" :weight bold)) |
(:foreground "green2" :bold t)) |
1101 |
(((class color) |
(((class color) |
1102 |
(background light)) |
(background light)) |
1103 |
(:foreground "MidnightBlue" :weight bold)) |
(:foreground "MidnightBlue" :bold t)) |
1104 |
(t |
(t |
1105 |
(:weight bold :slant italic))) |
(:bold t :italic t))) |
1106 |
"Face used for displaying From headers." |
"Face used for displaying From headers." |
1107 |
:group 'message-faces) |
:group 'message-faces) |
1108 |
|
|
1109 |
(defface message-header-cc-face |
(defface message-header-cc-face |
1110 |
'((((class color) |
'((((class color) |
1111 |
(background dark)) |
(background dark)) |
1112 |
(:foreground "green4" :weight bold)) |
(:foreground "green4" :bold t)) |
1113 |
(((class color) |
(((class color) |
1114 |
(background light)) |
(background light)) |
1115 |
(:foreground "MidnightBlue")) |
(:foreground "MidnightBlue")) |
1116 |
(t |
(t |
1117 |
(:weight bold))) |
(:bold t))) |
1118 |
"Face used for displaying Cc headers." |
"Face used for displaying Cc headers." |
1119 |
:group 'message-faces) |
:group 'message-faces) |
1120 |
|
|
1124 |
(:foreground "green3")) |
(:foreground "green3")) |
1125 |
(((class color) |
(((class color) |
1126 |
(background light)) |
(background light)) |
1127 |
(:foreground "navy blue" :weight bold)) |
(:foreground "navy blue" :bold t)) |
1128 |
(t |
(t |
1129 |
(:weight bold))) |
(:bold t))) |
1130 |
"Face used for displaying subject headers." |
"Face used for displaying subject headers." |
1131 |
:group 'message-faces) |
:group 'message-faces) |
1132 |
|
|
1133 |
(defface message-header-newsgroups-face |
(defface message-header-newsgroups-face |
1134 |
'((((class color) |
'((((class color) |
1135 |
(background dark)) |
(background dark)) |
1136 |
(:foreground "yellow" :weight bold :slant italic)) |
(:foreground "yellow" :bold t :italic t)) |
1137 |
(((class color) |
(((class color) |
1138 |
(background light)) |
(background light)) |
1139 |
(:foreground "blue4" :weight bold :slant italic)) |
(:foreground "blue4" :bold t :italic t)) |
1140 |
(t |
(t |
1141 |
(:weight bold :slant italic))) |
(:bold t :italic t))) |
1142 |
"Face used for displaying newsgroups headers." |
"Face used for displaying newsgroups headers." |
1143 |
:group 'message-faces) |
:group 'message-faces) |
1144 |
|
|
1150 |
(background light)) |
(background light)) |
1151 |
(:foreground "steel blue")) |
(:foreground "steel blue")) |
1152 |
(t |
(t |
1153 |
(:weight bold :slant italic))) |
(:bold t :italic t))) |
1154 |
"Face used for displaying newsgroups headers." |
"Face used for displaying newsgroups headers." |
1155 |
:group 'message-faces) |
:group 'message-faces) |
1156 |
|
|
1162 |
(background light)) |
(background light)) |
1163 |
(:foreground "cornflower blue")) |
(:foreground "cornflower blue")) |
1164 |
(t |
(t |
1165 |
(:weight bold))) |
(:bold t))) |
1166 |
"Face used for displaying header names." |
"Face used for displaying header names." |
1167 |
:group 'message-faces) |
:group 'message-faces) |
1168 |
|
|
1174 |
(background light)) |
(background light)) |
1175 |
(:foreground "blue")) |
(:foreground "blue")) |
1176 |
(t |
(t |
1177 |
(:weight bold))) |
(:bold t))) |
1178 |
"Face used for displaying X-Header headers." |
"Face used for displaying X-Header headers." |
1179 |
:group 'message-faces) |
:group 'message-faces) |
1180 |
|
|
1186 |
(background light)) |
(background light)) |
1187 |
(:foreground "brown")) |
(:foreground "brown")) |
1188 |
(t |
(t |
1189 |
(:weight bold))) |
(:bold t))) |
1190 |
"Face used for displaying the separator." |
"Face used for displaying the separator." |
1191 |
:group 'message-faces) |
:group 'message-faces) |
1192 |
|
|
1198 |
(background light)) |
(background light)) |
1199 |
(:foreground "red")) |
(:foreground "red")) |
1200 |
(t |
(t |
1201 |
(:weight bold))) |
(:bold t))) |
1202 |
"Face used for displaying cited text names." |
"Face used for displaying cited text names." |
1203 |
:group 'message-faces) |
:group 'message-faces) |
1204 |
|
|
1210 |
(background light)) |
(background light)) |
1211 |
(:foreground "ForestGreen")) |
(:foreground "ForestGreen")) |
1212 |
(t |
(t |
1213 |
(:weight bold))) |
(:bold t))) |
1214 |
"Face used for displaying MML." |
"Face used for displaying MML." |
1215 |
:group 'message-faces) |
:group 'message-faces) |
1216 |
|
|
1217 |
|
(defun message-font-lock-make-header-matcher (regexp) |
1218 |
|
(let ((form |
1219 |
|
`(lambda (limit) |
1220 |
|
(let ((start (point))) |
1221 |
|
(save-restriction |
1222 |
|
(widen) |
1223 |
|
(goto-char (point-min)) |
1224 |
|
(if (re-search-forward |
1225 |
|
(concat "^" (regexp-quote mail-header-separator) "$") |
1226 |
|
nil t) |
1227 |
|
(setq limit (min limit (match-beginning 0)))) |
1228 |
|
(goto-char start)) |
1229 |
|
(and (< start limit) |
1230 |
|
(re-search-forward ,regexp limit t)))))) |
1231 |
|
(if (featurep 'bytecomp) |
1232 |
|
(byte-compile form) |
1233 |
|
form))) |
1234 |
|
|
1235 |
(defvar message-font-lock-keywords |
(defvar message-font-lock-keywords |
1236 |
(let* ((cite-prefix "[:alpha:]") |
(let ((content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)\n?")) |
1237 |
(cite-suffix (concat cite-prefix "0-9_.@-")) |
`((,(message-font-lock-make-header-matcher |
1238 |
(content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)\n?")) |
(concat "^\\([Tt]o:\\)" content)) |
|
`((,(concat "^\\([Tt]o:\\)" content) |
|
1239 |
(1 'message-header-name-face) |
(1 'message-header-name-face) |
1240 |
(2 'message-header-to-face nil t)) |
(2 'message-header-to-face nil t)) |
1241 |
(,(concat "^\\(^[GBF]?[Cc][Cc]:\\|^[Rr]eply-[Tt]o:\\)" content) |
(,(message-font-lock-make-header-matcher |
1242 |
|
(concat "^\\(^[GBF]?[Cc][Cc]:\\|^[Rr]eply-[Tt]o:\\)" content)) |
1243 |
(1 'message-header-name-face) |
(1 'message-header-name-face) |
1244 |
(2 'message-header-cc-face nil t)) |
(2 'message-header-cc-face nil t)) |
1245 |
(,(concat "^\\([Ss]ubject:\\)" content) |
(,(message-font-lock-make-header-matcher |
1246 |
|
(concat "^\\([Ss]ubject:\\)" content)) |
1247 |
(1 'message-header-name-face) |
(1 'message-header-name-face) |
1248 |
(2 'message-header-subject-face nil t)) |
(2 'message-header-subject-face nil t)) |
1249 |
(,(concat "^\\([Nn]ewsgroups:\\|Followup-[Tt]o:\\)" content) |
(,(message-font-lock-make-header-matcher |
1250 |
|
(concat "^\\([Nn]ewsgroups:\\|Followup-[Tt]o:\\)" content)) |
1251 |
(1 'message-header-name-face) |
(1 'message-header-name-face) |
1252 |
(2 'message-header-newsgroups-face nil t)) |
(2 'message-header-newsgroups-face nil t)) |
1253 |
(,(concat "^\\([A-Z][^: \n\t]+:\\)" content) |
(,(message-font-lock-make-header-matcher |
1254 |
|
(concat "^\\([A-Z][^: \n\t]+:\\)" content)) |
1255 |
(1 'message-header-name-face) |
(1 'message-header-name-face) |
1256 |
(2 'message-header-other-face nil t)) |
(2 'message-header-other-face nil t)) |
1257 |
(,(concat "^\\(X-[A-Za-z0-9-]+\\|In-Reply-To\\):" content) |
(,(message-font-lock-make-header-matcher |
1258 |
|
(concat "^\\(X-[A-Za-z0-9-]+:\\|In-Reply-To:\\)" content)) |
1259 |
(1 'message-header-name-face) |
(1 'message-header-name-face) |
1260 |
(2 'message-header-name-face)) |
(2 'message-header-name-face)) |
1261 |
,@(if (and mail-header-separator |
,@(if (and mail-header-separator |
1263 |
`((,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$") |
`((,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$") |
1264 |
1 'message-separator-face)) |
1 'message-separator-face)) |
1265 |
nil) |
nil) |
1266 |
(,(concat "^[ \t]*" |
((lambda (limit) |
1267 |
"\\([" cite-prefix "]+[" cite-suffix "]*\\)?" |
(re-search-forward (concat "^\\(" |
1268 |
"[:>|}].*") |
message-cite-prefix-regexp |
1269 |
|
"\\).*") |
1270 |
|
limit t)) |
1271 |
(0 'message-cited-text-face)) |
(0 'message-cited-text-face)) |
1272 |
("<#/?\\(multipart\\|part\\|external\\|mml\\).*>" |
("<#/?\\(multipart\\|part\\|external\\|mml\\|secure\\)[^>]*>" |
1273 |
(0 'message-mml-face)))) |
(0 'message-mml-face)))) |
1274 |
"Additional expressions to highlight in Message mode.") |
"Additional expressions to highlight in Message mode.") |
1275 |
|
|
1276 |
|
|
1277 |
;; XEmacs does it like this. For Emacs, we have to set the |
;; XEmacs does it like this. For Emacs, we have to set the |
1278 |
;; `font-lock-defaults' buffer-local variable. |
;; `font-lock-defaults' buffer-local variable. |
1279 |
(put 'message-mode 'font-lock-defaults '(message-font-lock-keywords t)) |
(put 'message-mode 'font-lock-defaults '(message-font-lock-keywords t)) |
1288 |
The cdr of each entry is a function for applying the face to a region.") |
The cdr of each entry is a function for applying the face to a region.") |
1289 |
|
|
1290 |
(defcustom message-send-hook nil |
(defcustom message-send-hook nil |
1291 |
"Hook run before sending messages." |
"Hook run before sending messages. |
1292 |
|
This hook is run quite early when sending." |
1293 |
:group 'message-various |
:group 'message-various |
1294 |
:options '(ispell-message) |
:options '(ispell-message) |
1295 |
|
:link '(custom-manual "(message)Various Message Variables") |
1296 |
:type 'hook) |
:type 'hook) |
1297 |
|
|
1298 |
(defcustom message-send-mail-hook nil |
(defcustom message-send-mail-hook nil |
1299 |
"Hook run before sending mail messages." |
"Hook run before sending mail messages. |
1300 |
|
This hook is run very late -- just before the message is sent as |
1301 |
|
mail." |
1302 |
:group 'message-various |
:group 'message-various |
1303 |
|
:link '(custom-manual "(message)Various Message Variables") |
1304 |
:type 'hook) |
:type 'hook) |
1305 |
|
|
1306 |
(defcustom message-send-news-hook nil |
(defcustom message-send-news-hook nil |
1307 |
"Hook run before sending news messages." |
"Hook run before sending news messages. |
1308 |
|
This hook is run very late -- just before the message is sent as |
1309 |
|
news." |
1310 |
:group 'message-various |
:group 'message-various |
1311 |
|
:link '(custom-manual "(message)Various Message Variables") |
1312 |
:type 'hook) |
:type 'hook) |
1313 |
|
|
1314 |
(defcustom message-sent-hook nil |
(defcustom message-sent-hook nil |
1321 |
|
|
1322 |
(defvar message-draft-coding-system |
(defvar message-draft-coding-system |
1323 |
mm-auto-save-coding-system |
mm-auto-save-coding-system |
1324 |
"Coding system to compose mail.") |
"*Coding system to compose mail. |
1325 |
|
If you'd like to make it possible to share draft files between XEmacs |
1326 |
|
and Emacs, you may use `iso-2022-7bit' for this value at your own risk. |
1327 |
|
Note that the coding-system `iso-2022-7bit' isn't suitable to all data.") |
1328 |
|
|
1329 |
(defcustom message-send-mail-partially-limit 1000000 |
(defcustom message-send-mail-partially-limit 1000000 |
1330 |
"The limitation of messages sent as message/partial. |
"The limitation of messages sent as message/partial. |
1332 |
should be sent in several parts. If it is nil, the size is unlimited." |
should be sent in several parts. If it is nil, the size is unlimited." |
1333 |
:version "21.1" |
:version "21.1" |
1334 |
:group 'message-buffers |
:group 'message-buffers |
1335 |
|
:link '(custom-manual "(message)Mail Variables") |
1336 |
:type '(choice (const :tag "unlimited" nil) |
:type '(choice (const :tag "unlimited" nil) |
1337 |
(integer 1000000))) |
(integer 1000000))) |
1338 |
|
|
1340 |
"A regexp to match the alternative email addresses. |
"A regexp to match the alternative email addresses. |
1341 |
The first matched address (not primary one) is used in the From field." |
The first matched address (not primary one) is used in the From field." |
1342 |
:group 'message-headers |
:group 'message-headers |
1343 |
|
:link '(custom-manual "(message)Message Headers") |
1344 |
:type '(choice (const :tag "Always use primary" nil) |
:type '(choice (const :tag "Always use primary" nil) |
1345 |
regexp)) |
regexp)) |
1346 |
|
|
1347 |
|
(defcustom message-hierarchical-addresses nil |
1348 |
|
"A list of hierarchical mail address definitions. |
1349 |
|
|
1350 |
|
Inside each entry, the first address is the \"top\" address, and |
1351 |
|
subsequent addresses are subaddresses; this is used to indicate that |
1352 |
|
mail sent to the first address will automatically be delivered to the |
1353 |
|
subaddresses. So if the first address appears in the recipient list |
1354 |
|
for a message, the subaddresses will be removed (if present) before |
1355 |
|
the mail is sent. All addresses in this structure should be |
1356 |
|
downcased." |
1357 |
|
:group 'message-headers |
1358 |
|
:type '(repeat (repeat string))) |
1359 |
|
|
1360 |
(defcustom message-mail-user-agent nil |
(defcustom message-mail-user-agent nil |
1361 |
"Like `mail-user-agent'. |
"Like `mail-user-agent'. |
1362 |
Except if it is nil, use Gnus native MUA; if it is t, use |
Except if it is nil, use Gnus native MUA; if it is t, use |
1377 |
:version "21.1" |
:version "21.1" |
1378 |
:group 'message) |
:group 'message) |
1379 |
|
|
1380 |
|
(defcustom message-wide-reply-confirm-recipients nil |
1381 |
|
"Whether to confirm a wide reply to multiple email recipients. |
1382 |
|
If this variable is nil, don't ask whether to reply to all recipients. |
1383 |
|
If this variable is non-nil, pose the question \"Reply to all |
1384 |
|
recipients?\" before a wide reply to multiple recipients. If the user |
1385 |
|
answers yes, reply to all recipients as usual. If the user answers |
1386 |
|
no, only reply back to the author." |
1387 |
|
:version "21.3" |
1388 |
|
:group 'message-headers |
1389 |
|
:link '(custom-manual "(message)Wide Reply") |
1390 |
|
:type 'boolean) |
1391 |
|
|
1392 |
|
(defcustom message-user-fqdn nil |
1393 |
|
"*Domain part of Messsage-Ids." |
1394 |
|
:group 'message-headers |
1395 |
|
:link '(custom-manual "(message)News Headers") |
1396 |
|
:type '(radio (const :format "%v " nil) |
1397 |
|
(string :format "FQDN: %v\n" :size 0))) |
1398 |
|
|
1399 |
|
(defcustom message-use-idna (and (condition-case nil (require 'idna) |
1400 |
|
(file-error)) |
1401 |
|
(mm-coding-system-p 'utf-8) |
1402 |
|
(executable-find idna-program) |
1403 |
|
'ask) |
1404 |
|
"Whether to encode non-ASCII in domain names into ASCII according to IDNA." |
1405 |
|
:group 'message-headers |
1406 |
|
:link '(custom-manual "(message)IDNA") |
1407 |
|
:type '(choice (const :tag "Ask" ask) |
1408 |
|
(const :tag "Never" nil) |
1409 |
|
(const :tag "Always" t))) |
1410 |
|
|
1411 |
;;; Internal variables. |
;;; Internal variables. |
1412 |
|
|
1413 |
(defvar message-sending-message "Sending...") |
(defvar message-sending-message "Sending...") |
1417 |
(defvar message-draft-article nil) |
(defvar message-draft-article nil) |
1418 |
(defvar message-mime-part nil) |
(defvar message-mime-part nil) |
1419 |
(defvar message-posting-charset nil) |
(defvar message-posting-charset nil) |
1420 |
|
(defvar message-inserted-headers nil) |
1421 |
|
|
1422 |
;; Byte-compiler warning |
;; Byte-compiler warning |
1423 |
(eval-when-compile |
(eval-when-compile |
1443 |
;; can be removed, e.g. |
;; can be removed, e.g. |
1444 |
;; From: joe@y.z (Joe K |
;; From: joe@y.z (Joe K |
1445 |
;; User) |
;; User) |
1446 |
;; can yield `From joe@y.z (Joe K Fri Mar 22 08:11:15 1996', and |
;; can yield `From joe@y.z (Joe K Fri Mar 22 08:11:15 1996', and |
1447 |
;; From: Joe User |
;; From: Joe User |
1448 |
;; <joe@y.z> |
;; <joe@y.z> |
1449 |
;; can yield `From Joe User Fri Mar 22 08:11:15 1996'. |
;; can yield `From Joe User Fri Mar 22 08:11:15 1996'. |
1455 |
;; We want to match the results of any of these manglings. |
;; We want to match the results of any of these manglings. |
1456 |
;; The following regexp rejects names whose first characters are |
;; The following regexp rejects names whose first characters are |
1457 |
;; obviously bogus, but after that anything goes. |
;; obviously bogus, but after that anything goes. |
1458 |
"\\([^\0-\b\n-\r\^?].*\\)? " |
"\\([^\0-\b\n-\r\^?].*\\)?" |
1459 |
|
|
1460 |
;; The time the message was sent. |
;; The time the message was sent. |
1461 |
"\\([^\0-\r \^?]+\\) +" ; day of the week |
"\\([^\0-\r \^?]+\\) +" ; day of the week |
1508 |
(User-Agent)) |
(User-Agent)) |
1509 |
"Alist used for formatting headers.") |
"Alist used for formatting headers.") |
1510 |
|
|
1511 |
|
(defvar message-options nil |
1512 |
|
"Some saved answers when sending message.") |
1513 |
|
|
1514 |
|
(defvar message-send-mail-real-function nil |
1515 |
|
"Internal send mail function.") |
1516 |
|
|
1517 |
|
(defvar message-bogus-system-names "^localhost\\." |
1518 |
|
"The regexp of bogus system names.") |
1519 |
|
|
1520 |
|
(defcustom message-valid-fqdn-regexp |
1521 |
|
(concat "[a-z0-9][-.a-z0-9]+\\." ;; [hostname.subdomain.]domain. |
1522 |
|
;; valid TLDs: |
1523 |
|
"\\([a-z][a-z]" ;; two letter country TDLs |
1524 |
|
"\\|biz\\|com\\|edu\\|gov\\|int\\|mil\\|net\\|org" |
1525 |
|
"\\|aero\\|coop\\|info\\|name\\|museum" |
1526 |
|
"\\|arpa\\|pro\\|uucp\\|bitnet\\|bofh" ;; old style? |
1527 |
|
"\\)") |
1528 |
|
"Regular expression that matches a valid FQDN." |
1529 |
|
;; see also: gnus-button-valid-fqdn-regexp |
1530 |
|
:group 'message-headers |
1531 |
|
:type 'regexp) |
1532 |
|
|
1533 |
(eval-and-compile |
(eval-and-compile |
1534 |
|
(autoload 'idna-to-ascii "idna") |
1535 |
(autoload 'message-setup-toolbar "messagexmas") |
(autoload 'message-setup-toolbar "messagexmas") |
1536 |
(autoload 'mh-new-draft-name "mh-comp") |
(autoload 'mh-new-draft-name "mh-comp") |
1537 |
(autoload 'mh-send-letter "mh-comp") |
(autoload 'mh-send-letter "mh-comp") |
1539 |
(autoload 'gnus-point-at-bol "gnus-util") |
(autoload 'gnus-point-at-bol "gnus-util") |
1540 |
(autoload 'gnus-output-to-rmail "gnus-util") |
(autoload 'gnus-output-to-rmail "gnus-util") |
1541 |
(autoload 'gnus-output-to-mail "gnus-util") |
(autoload 'gnus-output-to-mail "gnus-util") |
|
(autoload 'mail-abbrev-in-expansion-header-p "mailabbrev") |
|
1542 |
(autoload 'nndraft-request-associate-buffer "nndraft") |
(autoload 'nndraft-request-associate-buffer "nndraft") |
1543 |
(autoload 'nndraft-request-expire-articles "nndraft") |
(autoload 'nndraft-request-expire-articles "nndraft") |
1544 |
(autoload 'gnus-open-server "gnus-int") |
(autoload 'gnus-open-server "gnus-int") |
1545 |
(autoload 'gnus-request-post "gnus-int") |
(autoload 'gnus-request-post "gnus-int") |
1546 |
(autoload 'gnus-alive-p "gnus-util") |
(autoload 'gnus-alive-p "gnus-util") |
1547 |
|
(autoload 'gnus-server-string "gnus") |
1548 |
(autoload 'gnus-group-name-charset "gnus-group") |
(autoload 'gnus-group-name-charset "gnus-group") |
1549 |
(autoload 'rmail-output "rmailout")) |
(autoload 'gnus-group-name-decode "gnus-group") |
1550 |
|
(autoload 'gnus-groups-from-server "gnus") |
1551 |
|
(autoload 'rmail-output "rmailout") |
1552 |
|
(autoload 'gnus-delay-article "gnus-delay") |
1553 |
|
(autoload 'gnus-make-local-hook "gnus-util") |
1554 |
|
(autoload 'gnus-extract-address-components "gnus-util")) |
1555 |
|
|
1556 |
|
|
1557 |
|
|
1568 |
`(delete-region (progn (beginning-of-line) (point)) |
`(delete-region (progn (beginning-of-line) (point)) |
1569 |
(progn (forward-line ,(or n 1)) (point)))) |
(progn (forward-line ,(or n 1)) (point)))) |
1570 |
|
|
1571 |
|
(defun message-mark-active-p () |
1572 |
|
"Non-nil means the mark and region are currently active in this buffer." |
1573 |
|
mark-active) |
1574 |
|
|
1575 |
(defun message-unquote-tokens (elems) |
(defun message-unquote-tokens (elems) |
1576 |
"Remove double quotes (\") from strings in list ELEMS." |
"Remove double quotes (\") from strings in list ELEMS." |
1577 |
(mapcar (lambda (item) |
(mapcar (lambda (item) |
1578 |
(while (string-match "^\\(.*\\)\"\\(.*\\)$" item) |
(while (string-match "^\\(.*\\)\"\\(.*\\)$" item) |
1579 |
(setq item (concat (match-string 1 item) |
(setq item (concat (match-string 1 item) |
1580 |
(match-string 2 item)))) |
(match-string 2 item)))) |
1581 |
item) |
item) |
1582 |
elems)) |
elems)) |
1583 |
|
|
1584 |
(defun message-tokenize-header (header &optional separator) |
(defun message-tokenize-header (header &optional separator) |
1585 |
"Split HEADER into a list of header elements. |
"Split HEADER into a list of header elements. |
1588 |
(if (not header) |
(if (not header) |
1589 |
nil |
nil |
1590 |
(let ((regexp (format "[%s]+" (or separator ","))) |
(let ((regexp (format "[%s]+" (or separator ","))) |
1591 |
(beg 1) |
(beg (point-min)) |
1592 |
(first t) |
(first t) |
1593 |
quoted elems paren) |
quoted elems paren) |
1594 |
(save-excursion |
(with-temp-buffer |
1595 |
(message-set-work-buffer) |
(mm-enable-multibyte) |
1596 |
(insert header) |
(insert header) |
1597 |
(goto-char (point-min)) |
(goto-char (point-min)) |
1598 |
(while (not (eobp)) |
(while (not (eobp)) |
1614 |
((and (eq (char-after) ?\)) |
((and (eq (char-after) ?\)) |
1615 |
(not quoted)) |
(not quoted)) |
1616 |
(setq paren nil)))) |
(setq paren nil)))) |
1617 |
(nreverse elems))))) |
(nreverse elems))))) |
1618 |
|
|
1619 |
(defun message-mail-file-mbox-p (file) |
(defun message-mail-file-mbox-p (file) |
1620 |
"Say whether FILE looks like a Unix mbox file." |
"Say whether FILE looks like a Unix mbox file." |
1627 |
(looking-at message-unix-mail-delimiter)))) |
(looking-at message-unix-mail-delimiter)))) |
1628 |
|
|
1629 |
(defun message-fetch-field (header &optional not-all) |
(defun message-fetch-field (header &optional not-all) |
1630 |
"The same as `mail-fetch-field', only remove all newlines." |
"The same as `mail-fetch-field', only remove all newlines. |
1631 |
|
The buffer is expected to be narrowed to just the header of the message; |
1632 |
|
see `message-narrow-to-headers-or-head'." |
1633 |
(let* ((inhibit-point-motion-hooks t) |
(let* ((inhibit-point-motion-hooks t) |
1634 |
(case-fold-search t) |
(case-fold-search t) |
1635 |
(value (mail-fetch-field header nil (not not-all)))) |
(value (mail-fetch-field header nil (not not-all)))) |
1639 |
(set-text-properties 0 (length value) nil value) |
(set-text-properties 0 (length value) nil value) |
1640 |
value))) |
value))) |
1641 |
|
|
1642 |
|
(defun message-field-value (header &optional not-all) |
1643 |
|
"The same as `message-fetch-field', only narrow to the headers first." |
1644 |
|
(save-excursion |
1645 |
|
(save-restriction |
1646 |
|
(message-narrow-to-headers-or-head) |
1647 |
|
(message-fetch-field header not-all)))) |
1648 |
|
|
1649 |
(defun message-narrow-to-field () |
(defun message-narrow-to-field () |
1650 |
"Narrow the buffer to the header on the current line." |
"Narrow the buffer to the header on the current line." |
1651 |
(beginning-of-line) |
(beginning-of-line) |
1670 |
(save-restriction |
(save-restriction |
1671 |
(message-narrow-to-headers) |
(message-narrow-to-headers) |
1672 |
(unless (re-search-forward (concat "^" (regexp-quote hclean) ":") nil t) |
(unless (re-search-forward (concat "^" (regexp-quote hclean) ":") nil t) |
1673 |
(insert (car headers) ?\n)))) |
(goto-char (point-max)) |
1674 |
|
(if (string-match "\n$" (car headers)) |
1675 |
|
(insert (car headers)) |
1676 |
|
(insert (car headers) ?\n))))) |
1677 |
(setq headers (cdr headers)))) |
(setq headers (cdr headers)))) |
1678 |
|
|
1679 |
|
(defmacro message-with-reply-buffer (&rest forms) |
1680 |
|
"Evaluate FORMS in the reply buffer, if it exists." |
1681 |
|
`(when (and message-reply-buffer |
1682 |
|
(buffer-name message-reply-buffer)) |
1683 |
|
(save-excursion |
1684 |
|
(set-buffer message-reply-buffer) |
1685 |
|
,@forms))) |
1686 |
|
|
1687 |
|
(put 'message-with-reply-buffer 'lisp-indent-function 0) |
1688 |
|
(put 'message-with-reply-buffer 'edebug-form-spec '(body)) |
1689 |
|
|
1690 |
(defun message-fetch-reply-field (header) |
(defun message-fetch-reply-field (header) |
1691 |
"Fetch field HEADER from the message we're replying to." |
"Fetch field HEADER from the message we're replying to." |
1692 |
(when (and message-reply-buffer |
(message-with-reply-buffer |
1693 |
(buffer-name message-reply-buffer)) |
(save-restriction |
1694 |
(save-excursion |
(mail-narrow-to-head) |
|
(set-buffer message-reply-buffer) |
|
1695 |
(message-fetch-field header)))) |
(message-fetch-field header)))) |
1696 |
|
|
|
(defun message-set-work-buffer () |
|
|
(if (get-buffer " *message work*") |
|
|
(progn |
|
|
(set-buffer " *message work*") |
|
|
(erase-buffer)) |
|
|
(set-buffer (get-buffer-create " *message work*")) |
|
|
(kill-all-local-variables) |
|
|
(mm-enable-multibyte))) |
|
|
|
|
|
(defun message-functionp (form) |
|
|
"Return non-nil if FORM is funcallable." |
|
|
(or (and (symbolp form) (fboundp form)) |
|
|
(and (listp form) (eq (car form) 'lambda)) |
|
|
(byte-code-function-p form))) |
|
|
|
|
1697 |
(defun message-strip-list-identifiers (subject) |
(defun message-strip-list-identifiers (subject) |
1698 |
"Remove list identifiers in `gnus-list-identifiers' from string SUBJECT." |
"Remove list identifiers in `gnus-list-identifiers' from string SUBJECT." |
1699 |
(require 'gnus-sum) ; for gnus-list-identifiers |
(require 'gnus-sum) ; for gnus-list-identifiers |
1701 |
gnus-list-identifiers |
gnus-list-identifiers |
1702 |
(mapconcat 'identity gnus-list-identifiers " *\\|")))) |
(mapconcat 'identity gnus-list-identifiers " *\\|")))) |
1703 |
(if (string-match (concat "\\(\\(\\(Re: +\\)?\\(" regexp |
(if (string-match (concat "\\(\\(\\(Re: +\\)?\\(" regexp |
1704 |
" *\\)\\)+\\(Re: +\\)?\\)") subject) |
" *\\)\\)+\\(Re: +\\)?\\)") subject) |
1705 |
(concat (substring subject 0 (match-beginning 1)) |
(concat (substring subject 0 (match-beginning 1)) |
1706 |
(or (match-string 3 subject) |
(or (match-string 3 subject) |
1707 |
(match-string 5 subject)) |
(match-string 5 subject)) |
1715 |
(substring subject (match-end 0)) |
(substring subject (match-end 0)) |
1716 |
subject)) |
subject)) |
1717 |
|
|
1718 |
|
;;; Start of functions adopted from `message-utils.el'. |
1719 |
|
|
1720 |
|
(defun message-strip-subject-trailing-was (subject) |
1721 |
|
"Remove trailing \"(Was: <old subject>)\" from SUBJECT lines. |
1722 |
|
Leading \"Re: \" is not stripped by this function. Use the function |
1723 |
|
`message-strip-subject-re' for this." |
1724 |
|
(let* ((query message-subject-trailing-was-query) |
1725 |
|
(new) (found)) |
1726 |
|
(setq found |
1727 |
|
(string-match |
1728 |
|
(if (eq query 'ask) |
1729 |
|
message-subject-trailing-was-ask-regexp |
1730 |
|
message-subject-trailing-was-regexp) |
1731 |
|
subject)) |
1732 |
|
(if found |
1733 |
|
(setq new (substring subject 0 (match-beginning 0)))) |
1734 |
|
(if (or (not found) (eq query nil)) |
1735 |
|
subject |
1736 |
|
(if (eq query 'ask) |
1737 |
|
(if (message-y-or-n-p |
1738 |
|
"Strip `(was: <old subject>)' in subject? " t |
1739 |
|
(concat |
1740 |
|
"Strip `(was: <old subject>)' in subject " |
1741 |
|
"and use the new one instead?\n\n" |
1742 |
|
"Current subject is: \"" |
1743 |
|
subject "\"\n\n" |
1744 |
|
"New subject would be: \"" |
1745 |
|
new "\"\n\n" |
1746 |
|
"See the variable `message-subject-trailing-was-query' " |
1747 |
|
"to get rid of this query." |
1748 |
|
)) |
1749 |
|
new subject) |
1750 |
|
new)))) |
1751 |
|
|
1752 |
|
;;; Suggested by Jonas Steverud @ www.dtek.chalmers.se/~d4jonas/ |
1753 |
|
|
1754 |
|
;;;###autoload |
1755 |
|
(defun message-change-subject (new-subject) |
1756 |
|
"Ask for NEW-SUBJECT header, append (was: <Old Subject>)." |
1757 |
|
;; <URL:http://www.landfield.com/usefor/drafts/draft-ietf-usefor-useage--1.02.unpaged> |
1758 |
|
(interactive |
1759 |
|
(list |
1760 |
|
(read-from-minibuffer "New subject: "))) |
1761 |
|
(cond ((and (not (or (null new-subject) ; new subject not empty |
1762 |
|
(zerop (string-width new-subject)) |
1763 |
|
(string-match "^[ \t]*$" new-subject)))) |
1764 |
|
(save-excursion |
1765 |
|
(let ((old-subject |
1766 |
|
(save-restriction |
1767 |
|
(message-narrow-to-headers) |
1768 |
|
(message-fetch-field "Subject")))) |
1769 |
|
(cond ((not old-subject) |
1770 |
|
(error "No current subject")) |
1771 |
|
((not (string-match |
1772 |
|
(concat "^[ \t]*" |
1773 |
|
(regexp-quote new-subject) |
1774 |
|
" \t]*$") |
1775 |
|
old-subject)) ; yes, it really is a new subject |
1776 |
|
;; delete eventual Re: prefix |
1777 |
|
(setq old-subject |
1778 |
|
(message-strip-subject-re old-subject)) |
1779 |
|
(message-goto-subject) |
1780 |
|
(message-delete-line) |
1781 |
|
(insert (concat "Subject: " |
1782 |
|
new-subject |
1783 |
|
" (was: " |
1784 |
|
old-subject ")\n"))))))))) |
1785 |
|
|
1786 |
|
;;;###autoload |
1787 |
|
(defun message-mark-inserted-region (beg end) |
1788 |
|
"Mark some region in the current article with enclosing tags. |
1789 |
|
See `message-mark-insert-begin' and `message-mark-insert-end'." |
1790 |
|
(interactive "r") |
1791 |
|
(save-excursion |
1792 |
|
;; add to the end of the region first, otherwise end would be invalid |
1793 |
|
(goto-char end) |
1794 |
|
(insert message-mark-insert-end) |
1795 |
|
(goto-char beg) |
1796 |
|
(insert message-mark-insert-begin))) |
1797 |
|
|
1798 |
|
;;;###autoload |
1799 |
|
(defun message-mark-insert-file (file) |
1800 |
|
"Insert FILE at point, marking it with enclosing tags. |
1801 |
|
See `message-mark-insert-begin' and `message-mark-insert-end'." |
1802 |
|
(interactive "fFile to insert: ") |
1803 |
|
;; reverse insertion to get correct result. |
1804 |
|
(let ((p (point))) |
1805 |
|
(insert message-mark-insert-end) |
1806 |
|
(goto-char p) |
1807 |
|
(insert-file-contents file) |
1808 |
|
(goto-char p) |
1809 |
|
(insert message-mark-insert-begin))) |
1810 |
|
|
1811 |
|
;;;###autoload |
1812 |
|
(defun message-add-archive-header () |
1813 |
|
"Insert \"X-No-Archive: Yes\" in the header and a note in the body. |
1814 |
|
The note can be customized using `message-archive-note'. When called with a |
1815 |
|
prefix argument, ask for a text to insert. If you don't want the note in the |
1816 |
|
body, set `message-archive-note' to nil." |
1817 |
|
(interactive) |
1818 |
|
(if current-prefix-arg |
1819 |
|
(setq message-archive-note |
1820 |
|
(read-from-minibuffer "Reason for No-Archive: " |
1821 |
|
(cons message-archive-note 0)))) |
1822 |
|
(save-excursion |
1823 |
|
(if (message-goto-signature) |
1824 |
|
(re-search-backward message-signature-separator)) |
1825 |
|
(when message-archive-note |
1826 |
|
(insert message-archive-note) |
1827 |
|
(newline)) |
1828 |
|
(message-add-header message-archive-header) |
1829 |
|
(message-sort-headers))) |
1830 |
|
|
1831 |
|
;;;###autoload |
1832 |
|
(defun message-cross-post-followup-to-header (target-group) |
1833 |
|
"Mangles FollowUp-To and Newsgroups header to point to TARGET-GROUP. |
1834 |
|
With prefix-argument just set Follow-Up, don't cross-post." |
1835 |
|
(interactive |
1836 |
|
(list ; Completion based on Gnus |
1837 |
|
(completing-read "Followup To: " |
1838 |
|
(if (boundp 'gnus-newsrc-alist) |
1839 |
|
gnus-newsrc-alist) |
1840 |
|
nil nil '("poster" . 0) |
1841 |
|
(if (boundp 'gnus-group-history) |
1842 |
|
'gnus-group-history)))) |
1843 |
|
(message-remove-header "Follow[Uu]p-[Tt]o" t) |
1844 |
|
(message-goto-newsgroups) |
1845 |
|
(beginning-of-line) |
1846 |
|
;; if we already did a crosspost before, kill old target |
1847 |
|
(if (and message-cross-post-old-target |
1848 |
|
(re-search-forward |
1849 |
|
(regexp-quote (concat "," message-cross-post-old-target)) |
1850 |
|
nil t)) |
1851 |
|
(replace-match "")) |
1852 |
|
;; unless (followup is to poster or user explicitly asked not |
1853 |
|
;; to cross-post, or target-group is already in Newsgroups) |
1854 |
|
;; add target-group to Newsgroups line. |
1855 |
|
(cond ((and (or |
1856 |
|
;; def: cross-post, req:no |
1857 |
|
(and message-cross-post-default (not current-prefix-arg)) |
1858 |
|
;; def: no-cross-post, req:yes |
1859 |
|
(and (not message-cross-post-default) current-prefix-arg)) |
1860 |
|
(not (string-match "poster" target-group)) |
1861 |
|
(not (string-match (regexp-quote target-group) |
1862 |
|
(message-fetch-field "Newsgroups")))) |
1863 |
|
(end-of-line) |
1864 |
|
(insert (concat "," target-group)))) |
1865 |
|
(end-of-line) ; ensure Followup: comes after Newsgroups: |
1866 |
|
;; unless new followup would be identical to Newsgroups line |
1867 |
|
;; make a new Followup-To line |
1868 |
|
(if (not (string-match (concat "^[ \t]*" |
1869 |
|
target-group |
1870 |
|
"[ \t]*$") |
1871 |
|
(message-fetch-field "Newsgroups"))) |
1872 |
|
(insert (concat "\nFollowup-To: " target-group))) |
1873 |
|
(setq message-cross-post-old-target target-group)) |
1874 |
|
|
1875 |
|
;;;###autoload |
1876 |
|
(defun message-cross-post-insert-note (target-group cross-post in-old |
1877 |
|
old-groups) |
1878 |
|
"Insert a in message body note about a set Followup or Crosspost. |
1879 |
|
If there have been previous notes, delete them. TARGET-GROUP specifies the |
1880 |
|
group to Followup-To. When CROSS-POST is t, insert note about |
1881 |
|
crossposting. IN-OLD specifies whether TARGET-GROUP is a member of |
1882 |
|
OLD-GROUPS. OLD-GROUPS lists the old-groups the posting would have |
1883 |
|
been made to before the user asked for a Crosspost." |
1884 |
|
;; start scanning body for previous uses |
1885 |
|
(message-goto-signature) |
1886 |
|
(let ((head (re-search-backward |
1887 |
|
(concat "^" mail-header-separator) |
1888 |
|
nil t))) ; just search in body |
1889 |
|
(message-goto-signature) |
1890 |
|
(while (re-search-backward |
1891 |
|
(concat "^" (regexp-quote message-cross-post-note) ".*") |
1892 |
|
head t) |
1893 |
|
(message-delete-line)) |
1894 |
|
(message-goto-signature) |
1895 |
|
(while (re-search-backward |
1896 |
|
(concat "^" (regexp-quote message-followup-to-note) ".*") |
1897 |
|
head t) |
1898 |
|
(message-delete-line)) |
1899 |
|
;; insert new note |
1900 |
|
(if (message-goto-signature) |
1901 |
|
(re-search-backward message-signature-separator)) |
1902 |
|
(if (or in-old |
1903 |
|
(not cross-post) |
1904 |
|
(string-match "^[ \t]*poster[ \t]*$" target-group)) |
1905 |
|
(insert (concat message-followup-to-note target-group "\n")) |
1906 |
|
(insert (concat message-cross-post-note target-group "\n"))))) |
1907 |
|
|
1908 |
|
;;;###autoload |
1909 |
|
(defun message-cross-post-followup-to (target-group) |
1910 |
|
"Crossposts message and set Followup-To to TARGET-GROUP. |
1911 |
|
With prefix-argument just set Follow-Up, don't cross-post." |
1912 |
|
(interactive |
1913 |
|
(list ; Completion based on Gnus |
1914 |
|
(completing-read "Followup To: " |
1915 |
|
(if (boundp 'gnus-newsrc-alist) |
1916 |
|
gnus-newsrc-alist) |
1917 |
|
nil nil '("poster" . 0) |
1918 |
|
(if (boundp 'gnus-group-history) |
1919 |
|
'gnus-group-history)))) |
1920 |
|
(cond ((not (or (null target-group) ; new subject not empty |
1921 |
|
(zerop (string-width target-group)) |
1922 |
|
(string-match "^[ \t]*$" target-group))) |
1923 |
|
(save-excursion |
1924 |
|
(let* ((old-groups (message-fetch-field "Newsgroups")) |
1925 |
|
(in-old (string-match |
1926 |
|
(regexp-quote target-group) |
1927 |
|
(or old-groups "")))) |
1928 |
|
;; check whether target exactly matches old Newsgroups |
1929 |
|
(cond ((not old-groups) |
1930 |
|
(error "No current newsgroup")) |
1931 |
|
((or (not in-old) |
1932 |
|
(not (string-match |
1933 |
|
(concat "^[ \t]*" |
1934 |
|
(regexp-quote target-group) |
1935 |
|
"[ \t]*$") |
1936 |
|
old-groups))) |
1937 |
|
;; yes, Newsgroups line must change |
1938 |
|
(message-cross-post-followup-to-header target-group) |
1939 |
|
;; insert note whether we do cross-post or followup-to |
1940 |
|
(funcall message-cross-post-note-function |
1941 |
|
target-group |
1942 |
|
(if (or (and message-cross-post-default |
1943 |
|
(not current-prefix-arg)) |
1944 |
|
(and (not message-cross-post-default) |
1945 |
|
current-prefix-arg)) t) |
1946 |
|
in-old old-groups)))))))) |
1947 |
|
|
1948 |
|
;;; Reduce To: to Cc: or Bcc: header |
1949 |
|
|
1950 |
|
;;;###autoload |
1951 |
|
(defun message-reduce-to-to-cc () |
1952 |
|
"Replace contents of To: header with contents of Cc: or Bcc: header." |
1953 |
|
(interactive) |
1954 |
|
(let ((cc-content |
1955 |
|
(save-restriction (message-narrow-to-headers) |
1956 |
|
(message-fetch-field "cc"))) |
1957 |
|
(bcc nil)) |
1958 |
|
(if (and (not cc-content) |
1959 |
|
(setq cc-content |
1960 |
|
(save-restriction |
1961 |
|
(message-narrow-to-headers) |
1962 |
|
(message-fetch-field "bcc")))) |
1963 |
|
(setq bcc t)) |
1964 |
|
(cond (cc-content |
1965 |
|
(save-excursion |
1966 |
|
(message-goto-to) |
1967 |
|
(message-delete-line) |
1968 |
|
(insert (concat "To: " cc-content "\n")) |
1969 |
|
(save-restriction |
1970 |
|
(message-narrow-to-headers) |
1971 |
|
(message-remove-header (if bcc |
1972 |
|
"bcc" |
1973 |
|
"cc")))))))) |
1974 |
|
|
1975 |
|
;;; End of functions adopted from `message-utils.el'. |
1976 |
|
|
1977 |
(defun message-remove-header (header &optional is-regexp first reverse) |
(defun message-remove-header (header &optional is-regexp first reverse) |
1978 |
"Remove HEADER in the narrowed buffer. |
"Remove HEADER in the narrowed buffer. |
1979 |
If IS-REGEXP, HEADER is a regular expression. |
If IS-REGEXP, HEADER is a regular expression. |
2082 |
(message-fetch-field "cc") |
(message-fetch-field "cc") |
2083 |
(message-fetch-field "bcc"))))))) |
(message-fetch-field "bcc"))))))) |
2084 |
|
|
2085 |
|
(defun message-subscribed-p () |
2086 |
|
"Say whether we need to insert a MFT header." |
2087 |
|
(or message-subscribed-regexps |
2088 |
|
message-subscribed-addresses |
2089 |
|
message-subscribed-address-file |
2090 |
|
message-subscribed-address-functions)) |
2091 |
|
|
2092 |
(defun message-next-header () |
(defun message-next-header () |
2093 |
"Go to the beginning of the next header." |
"Go to the beginning of the next header." |
2094 |
(beginning-of-line) |
(beginning-of-line) |
2132 |
(1+ max))))) |
(1+ max))))) |
2133 |
(message-sort-headers-1)))) |
(message-sort-headers-1)))) |
2134 |
|
|
2135 |
|
|
2136 |
|
|
2137 |
|
|
2138 |
;;; |
;;; |
2149 |
(define-key message-mode-map "\C-c?" 'describe-mode) |
(define-key message-mode-map "\C-c?" 'describe-mode) |
2150 |
|
|
2151 |
(define-key message-mode-map "\C-c\C-f\C-t" 'message-goto-to) |
(define-key message-mode-map "\C-c\C-f\C-t" 'message-goto-to) |
2152 |
|
(define-key message-mode-map "\C-c\C-f\C-o" 'message-goto-from) |
2153 |
(define-key message-mode-map "\C-c\C-f\C-b" 'message-goto-bcc) |
(define-key message-mode-map "\C-c\C-f\C-b" 'message-goto-bcc) |
2154 |
(define-key message-mode-map "\C-c\C-f\C-w" 'message-goto-fcc) |
(define-key message-mode-map "\C-c\C-f\C-w" 'message-goto-fcc) |
2155 |
(define-key message-mode-map "\C-c\C-f\C-c" 'message-goto-cc) |
(define-key message-mode-map "\C-c\C-f\C-c" 'message-goto-cc) |
2158 |
(define-key message-mode-map "\C-c\C-f\C-n" 'message-goto-newsgroups) |
(define-key message-mode-map "\C-c\C-f\C-n" 'message-goto-newsgroups) |
2159 |
(define-key message-mode-map "\C-c\C-f\C-d" 'message-goto-distribution) |
(define-key message-mode-map "\C-c\C-f\C-d" 'message-goto-distribution) |
2160 |
(define-key message-mode-map "\C-c\C-f\C-f" 'message-goto-followup-to) |
(define-key message-mode-map "\C-c\C-f\C-f" 'message-goto-followup-to) |
2161 |
|
(define-key message-mode-map "\C-c\C-f\C-m" 'message-goto-mail-followup-to) |
2162 |
(define-key message-mode-map "\C-c\C-f\C-k" 'message-goto-keywords) |
(define-key message-mode-map "\C-c\C-f\C-k" 'message-goto-keywords) |
2163 |
(define-key message-mode-map "\C-c\C-f\C-u" 'message-goto-summary) |
(define-key message-mode-map "\C-c\C-f\C-u" 'message-goto-summary) |
2164 |
|
(define-key message-mode-map "\C-c\C-f\C-i" |
2165 |
|
'message-insert-or-toggle-importance) |
2166 |
|
(define-key message-mode-map "\C-c\C-f\C-a" |
2167 |
|
'message-generate-unsubscribed-mail-followup-to) |
2168 |
|
|
2169 |
|
;; modify headers (and insert notes in body) |
2170 |
|
(define-key message-mode-map "\C-c\C-fs" 'message-change-subject) |
2171 |
|
;; |
2172 |
|
(define-key message-mode-map "\C-c\C-fx" 'message-cross-post-followup-to) |
2173 |
|
;; prefix+message-cross-post-followup-to = same w/o cross-post |
2174 |
|
(define-key message-mode-map "\C-c\C-ft" 'message-reduce-to-to-cc) |
2175 |
|
(define-key message-mode-map "\C-c\C-fa" 'message-add-archive-header) |
2176 |
|
;; mark inserted text |
2177 |
|
(define-key message-mode-map "\C-c\M-m" 'message-mark-inserted-region) |
2178 |
|
(define-key message-mode-map "\C-c\M-f" 'message-mark-insert-file) |
2179 |
|
|
2180 |
(define-key message-mode-map "\C-c\C-b" 'message-goto-body) |
(define-key message-mode-map "\C-c\C-b" 'message-goto-body) |
2181 |
(define-key message-mode-map "\C-c\C-i" 'message-goto-signature) |
(define-key message-mode-map "\C-c\C-i" 'message-goto-signature) |
2182 |
|
|
2183 |
(define-key message-mode-map "\C-c\C-t" 'message-insert-to) |
(define-key message-mode-map "\C-c\C-t" 'message-insert-to) |
2184 |
|
(define-key message-mode-map "\C-c\C-fw" 'message-insert-wide-reply) |
2185 |
(define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups) |
(define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups) |
2186 |
|
(define-key message-mode-map "\C-c\C-l" 'message-to-list-only) |
2187 |
|
|
2188 |
|
(define-key message-mode-map "\C-c\C-u" 'message-insert-or-toggle-importance) |
2189 |
|
(define-key message-mode-map "\C-c\M-n" |
2190 |
|
'message-insert-disposition-notification-to) |
2191 |
|
|
2192 |
(define-key message-mode-map "\C-c\C-y" 'message-yank-original) |
(define-key message-mode-map "\C-c\C-y" 'message-yank-original) |
2193 |
(define-key message-mode-map "\C-c\M-\C-y" 'message-yank-buffer) |
(define-key message-mode-map "\C-c\M-\C-y" 'message-yank-buffer) |
2202 |
(define-key message-mode-map "\C-c\C-s" 'message-send) |
(define-key message-mode-map "\C-c\C-s" 'message-send) |
2203 |
(define-key message-mode-map "\C-c\C-k" 'message-kill-buffer) |
(define-key message-mode-map "\C-c\C-k" 'message-kill-buffer) |
2204 |
(define-key message-mode-map "\C-c\C-d" 'message-dont-send) |
(define-key message-mode-map "\C-c\C-d" 'message-dont-send) |
2205 |
|
(define-key message-mode-map "\C-c\n" 'gnus-delay-article) |
2206 |
|
|
2207 |
(define-key message-mode-map "\C-c\C-e" 'message-elide-region) |
(define-key message-mode-map "\C-c\C-e" 'message-elide-region) |
2208 |
(define-key message-mode-map "\C-c\C-v" 'message-delete-not-region) |
(define-key message-mode-map "\C-c\C-v" 'message-delete-not-region) |
2209 |
(define-key message-mode-map "\C-c\C-z" 'message-kill-to-signature) |
(define-key message-mode-map "\C-c\C-z" 'message-kill-to-signature) |
2210 |
(define-key message-mode-map "\M-\r" 'message-newline-and-reformat) |
(define-key message-mode-map "\M-\r" 'message-newline-and-reformat) |
2211 |
|
;;(define-key message-mode-map "\M-q" 'message-fill-paragraph) |
2212 |
(define-key message-mode-map [remap split-line] 'message-split-line) |
(define-key message-mode-map [remap split-line] 'message-split-line) |
2213 |
|
|
2214 |
(define-key message-mode-map "\C-c\C-a" 'mml-attach-file) |
(define-key message-mode-map "\C-c\C-a" 'mml-attach-file) |
2215 |
|
|
2216 |
(define-key message-mode-map "\t" 'message-tab)) |
(define-key message-mode-map "\C-a" 'message-beginning-of-line) |
2217 |
|
(define-key message-mode-map "\t" 'message-tab) |
2218 |
|
(define-key message-mode-map "\M-;" 'comment-region)) |
2219 |
|
|
2220 |
(easy-menu-define |
(easy-menu-define |
2221 |
message-mode-menu message-mode-map "Message Menu." |
message-mode-menu message-mode-map "Message Menu." |
2222 |
'("Message" |
`("Message" |
2223 |
["Sort Headers" message-sort-headers t] |
["Yank Original" message-yank-original message-reply-buffer] |
2224 |
["Yank Original" message-yank-original t] |
["Fill Yanked Message" message-fill-yanked-message t] |
2225 |
["Fill Yanked Message" message-fill-yanked-message t] |
["Insert Signature" message-insert-signature t] |
2226 |
["Insert Signature" message-insert-signature t] |
["Caesar (rot13) Message" message-caesar-buffer-body t] |
2227 |
["Caesar (rot13) Message" message-caesar-buffer-body t] |
["Caesar (rot13) Region" message-caesar-region (message-mark-active-p)] |
2228 |
["Caesar (rot13) Region" message-caesar-region (mark t)] |
["Elide Region" message-elide-region |
2229 |
["Elide Region" message-elide-region (mark t)] |
:active (message-mark-active-p) |
2230 |
["Delete Outside Region" message-delete-not-region (mark t)] |
,@(if (featurep 'xemacs) nil |
2231 |
["Kill To Signature" message-kill-to-signature t] |
'(:help "Replace text in region with an ellipsis"))] |
2232 |
["Newline and Reformat" message-newline-and-reformat t] |
["Delete Outside Region" message-delete-not-region |
2233 |
["Rename buffer" message-rename-buffer t] |
:active (message-mark-active-p) |
2234 |
["Spellcheck" ispell-message |
,@(if (featurep 'xemacs) nil |
2235 |
:help "Spellcheck this message"] |
'(:help "Delete all quoted text outside region"))] |
2236 |
["Attach file as MIME" mml-attach-file |
["Kill To Signature" message-kill-to-signature t] |
2237 |
:help "Attach a file at point"] |
["Newline and Reformat" message-newline-and-reformat t] |
2238 |
"----" |
["Rename buffer" message-rename-buffer t] |
2239 |
["Send Message" message-send-and-exit |
["Spellcheck" ispell-message |
2240 |
:help "Send this message"] |
,@(if (featurep 'xemacs) '(t) |
2241 |
["Abort Message" message-dont-send |
'(:help "Spellcheck this message"))] |
2242 |
:help "File this draft message and exit"] |
"----" |
2243 |
["Kill Message" message-kill-buffer |
["Insert Region Marked" message-mark-inserted-region |
2244 |
:help "Delete this message without sending"])) |
:active (message-mark-active-p) |
2245 |
|
,@(if (featurep 'xemacs) nil |
2246 |
|
'(:help "Mark region with enclosing tags"))] |
2247 |
|
["Insert File Marked..." message-mark-insert-file |
2248 |
|
,@(if (featurep 'xemacs) '(t) |
2249 |
|
'(:help "Insert file at point marked with enclosing tags"))] |
2250 |
|
"----" |
2251 |
|
["Send Message" message-send-and-exit |
2252 |
|
,@(if (featurep 'xemacs) '(t) |
2253 |
|
'(:help "Send this message"))] |
2254 |
|
["Postpone Message" message-dont-send |
2255 |
|
,@(if (featurep 'xemacs) '(t) |
2256 |
|
'(:help "File this draft message and exit"))] |
2257 |
|
["Send at Specific Time..." gnus-delay-article |
2258 |
|
,@(if (featurep 'xemacs) '(t) |
2259 |
|
'(:help "Ask, then arrange to send message at that time"))] |
2260 |
|
["Kill Message" message-kill-buffer |
2261 |
|
,@(if (featurep 'xemacs) '(t) |
2262 |
|
'(:help "Delete this message without sending"))])) |
2263 |
|
|
2264 |
(easy-menu-define |
(easy-menu-define |
2265 |
message-mode-field-menu message-mode-map "" |
message-mode-field-menu message-mode-map "" |
2266 |
'("Field" |
`("Field" |
2267 |
["Fetch To" message-insert-to t] |
["To" message-goto-to t] |
2268 |
["Fetch Newsgroups" message-insert-newsgroups t] |
["From" message-goto-from t] |
2269 |
"----" |
["Subject" message-goto-subject t] |
2270 |
["To" message-goto-to t] |
["Change subject..." message-change-subject t] |
2271 |
["Subject" message-goto-subject t] |
["Cc" message-goto-cc t] |
2272 |
["Cc" message-goto-cc t] |
["Bcc" message-goto-bcc t] |
2273 |
["Reply-To" message-goto-reply-to t] |
["Fcc" message-goto-fcc t] |
2274 |
["Summary" message-goto-summary t] |
["Reply-To" message-goto-reply-to t] |
2275 |
["Keywords" message-goto-keywords t] |
["Flag As Important" message-insert-importance-high |
2276 |
["Newsgroups" message-goto-newsgroups t] |
,@(if (featurep 'xemacs) '(t) |
2277 |
["Followup-To" message-goto-followup-to t] |
'(:help "Mark this message as important"))] |
2278 |
["Distribution" message-goto-distribution t] |
["Flag As Unimportant" message-insert-importance-low |
2279 |
["Body" message-goto-body t] |
,@(if (featurep 'xemacs) '(t) |
2280 |
["Signature" message-goto-signature t])) |
'(:help "Mark this message as unimportant"))] |
2281 |
|
["Request Receipt" |
2282 |
|
message-insert-disposition-notification-to |
2283 |
|
,@(if (featurep 'xemacs) '(t) |
2284 |
|
'(:help "Request a receipt notification"))] |
2285 |
|
"----" |
2286 |
|
;; (typical) news stuff |
2287 |
|
["Summary" message-goto-summary t] |
2288 |
|
["Keywords" message-goto-keywords t] |
2289 |
|
["Newsgroups" message-goto-newsgroups t] |
2290 |
|
["Fetch Newsgroups" message-insert-newsgroups t] |
2291 |
|
["Followup-To" message-goto-followup-to t] |
2292 |
|
;; ["Followup-To (with note in body)" message-cross-post-followup-to t] |
2293 |
|
["Crosspost / Followup-To..." message-cross-post-followup-to t] |
2294 |
|
["Distribution" message-goto-distribution t] |
2295 |
|
["X-No-Archive:" message-add-archive-header t ] |
2296 |
|
"----" |
2297 |
|
;; (typical) mailing-lists stuff |
2298 |
|
["Fetch To" message-insert-to |
2299 |
|
,@(if (featurep 'xemacs) '(t) |
2300 |
|
'(:help "Insert a To header that points to the author."))] |
2301 |
|
["Fetch To and Cc" message-insert-wide-reply |
2302 |
|
,@(if (featurep 'xemacs) '(t) |
2303 |
|
'(:help |
2304 |
|
"Insert To and Cc headers as if you were doing a wide reply."))] |
2305 |
|
"----" |
2306 |
|
["Send to list only" message-to-list-only t] |
2307 |
|
["Mail-Followup-To" message-goto-mail-followup-to t] |
2308 |
|
["Unsubscribed list post" message-generate-unsubscribed-mail-followup-to |
2309 |
|
,@(if (featurep 'xemacs) '(t) |
2310 |
|
'(:help "Insert a reasonable `Mail-Followup-To:' header."))] |
2311 |
|
["Reduce To: to Cc:" message-reduce-to-to-cc t] |
2312 |
|
"----" |
2313 |
|
["Sort Headers" message-sort-headers t] |
2314 |
|
["Encode non-ASCII domain names" message-idna-to-ascii-rhs t] |
2315 |
|
["Goto Body" message-goto-body t] |
2316 |
|
["Goto Signature" message-goto-signature t])) |
2317 |
|
|
2318 |
|
(defvar message-tool-bar-map nil) |
2319 |
|
|
2320 |
(eval-when-compile |
(eval-when-compile |
2321 |
(defvar facemenu-add-face-function) |
(defvar facemenu-add-face-function) |
2322 |
(defvar facemenu-remove-face-function)) |
(defvar facemenu-remove-face-function)) |
2323 |
|
|
2324 |
|
;;; Forbidden properties |
2325 |
|
;; |
2326 |
|
;; We use `after-change-functions' to keep special text properties |
2327 |
|
;; that interfer with the normal function of message mode out of the |
2328 |
|
;; buffer. |
2329 |
|
|
2330 |
|
(defcustom message-strip-special-text-properties t |
2331 |
|
"Strip special properties from the message buffer. |
2332 |
|
|
2333 |
|
Emacs has a number of special text properties which can break message |
2334 |
|
composing in various ways. If this option is set, message will strip |
2335 |
|
these properties from the message composition buffer. However, some |
2336 |
|
packages requires these properties to be present in order to work. |
2337 |
|
If you use one of these packages, turn this option off, and hope the |
2338 |
|
message composition doesn't break too bad." |
2339 |
|
:group 'message-various |
2340 |
|
:link '(custom-manual "(message)Various Message Variables") |
2341 |
|
:type 'boolean) |
2342 |
|
|
2343 |
|
(defconst message-forbidden-properties |
2344 |
|
;; No reason this should be clutter up customize. We make it a |
2345 |
|
;; property list (rather than a list of property symbols), to be |
2346 |
|
;; directly useful for `remove-text-properties'. |
2347 |
|
'(field nil read-only nil invisible nil intangible nil |
2348 |
|
mouse-face nil modification-hooks nil insert-in-front-hooks nil |
2349 |
|
insert-behind-hooks nil point-entered nil point-left nil) |
2350 |
|
;; Other special properties: |
2351 |
|
;; category, face, display: probably doesn't do any harm. |
2352 |
|
;; fontified: is used by font-lock. |
2353 |
|
;; syntax-table, local-map: I dunno. |
2354 |
|
;; We need to add XEmacs names to the list. |
2355 |
|
"Property list of with properties.forbidden in message buffers. |
2356 |
|
The values of the properties are ignored, only the property names are used.") |
2357 |
|
|
2358 |
|
(defun message-tamago-not-in-use-p (pos) |
2359 |
|
"Return t when tamago version 4 is not in use at the cursor position. |
2360 |
|
Tamago version 4 is a popular input method for writing Japanese text. |
2361 |
|
It uses the properties `intangible', `invisible', `modification-hooks' |
2362 |
|
and `read-only' when translating ascii or kana text to kanji text. |
2363 |
|
These properties are essential to work, so we should never strip them." |
2364 |
|
(not (and (boundp 'egg-modefull-mode) |
2365 |
|
(symbol-value 'egg-modefull-mode) |
2366 |
|
(or (memq (get-text-property pos 'intangible) |
2367 |
|
'(its-part-1 its-part-2)) |
2368 |
|
(get-text-property pos 'egg-end) |
2369 |
|
(get-text-property pos 'egg-lang) |
2370 |
|
(get-text-property pos 'egg-start))))) |
2371 |
|
|
2372 |
|
(defun message-strip-forbidden-properties (begin end &optional old-length) |
2373 |
|
"Strip forbidden properties between BEGIN and END, ignoring the third arg. |
2374 |
|
This function is intended to be called from `after-change-functions'. |
2375 |
|
See also `message-forbidden-properties'." |
2376 |
|
(when (and message-strip-special-text-properties |
2377 |
|
(message-tamago-not-in-use-p begin)) |
2378 |
|
(while (not (= begin end)) |
2379 |
|
(when (not (get-text-property begin 'message-hidden)) |
2380 |
|
(remove-text-properties begin (1+ begin) |
2381 |
|
message-forbidden-properties)) |
2382 |
|
(incf begin)))) |
2383 |
|
|
2384 |
;;;###autoload |
;;;###autoload |
2385 |
(defun message-mode () |
(define-derived-mode message-mode text-mode "Message" |
2386 |
"Major mode for editing mail and news to be sent. |
"Major mode for editing mail and news to be sent. |
2387 |
Like Text Mode but with these additional commands:\\<message-mode-map> |
Like Text Mode but with these additional commands:\\<message-mode-map> |
2388 |
C-c C-s `message-send' (send the message) C-c C-c `message-send-and-exit' |
C-c C-s `message-send' (send the message) C-c C-c `message-send-and-exit' |
2393 |
C-c C-f C-w move to Fcc C-c C-f C-r move to Reply-To |
C-c C-f C-w move to Fcc C-c C-f C-r move to Reply-To |
2394 |
C-c C-f C-u move to Summary C-c C-f C-n move to Newsgroups |
C-c C-f C-u move to Summary C-c C-f C-n move to Newsgroups |
2395 |
C-c C-f C-k move to Keywords C-c C-f C-d move to Distribution |
C-c C-f C-k move to Keywords C-c C-f C-d move to Distribution |
2396 |
|
C-c C-f C-o move to From (\"Originator\") |
2397 |
C-c C-f C-f move to Followup-To |
C-c C-f C-f move to Followup-To |
2398 |
|
C-c C-f C-m move to Mail-Followup-To |
2399 |
|
C-c C-f C-i cycle through Importance values |
2400 |
|
C-c C-f s change subject and append \"(was: <Old Subject>)\" |
2401 |
|
C-c C-f x crossposting with FollowUp-To header and note in body |
2402 |
|
C-c C-f t replace To: header with contents of Cc: or Bcc: |
2403 |
|
C-c C-f a Insert X-No-Archive: header and a note in the body |
2404 |
C-c C-t `message-insert-to' (add a To header to a news followup) |
C-c C-t `message-insert-to' (add a To header to a news followup) |
2405 |
|
C-c C-l `message-to-list-only' (removes all but list address in to/cc) |
2406 |
C-c C-n `message-insert-newsgroups' (add a Newsgroup header to a news reply) |
C-c C-n `message-insert-newsgroups' (add a Newsgroup header to a news reply) |
2407 |
C-c C-b `message-goto-body' (move to beginning of message text). |
C-c C-b `message-goto-body' (move to beginning of message text). |
2408 |
C-c C-i `message-goto-signature' (move to the beginning of the signature). |
C-c C-i `message-goto-signature' (move to the beginning of the signature). |
2414 |
C-c C-z `message-kill-to-signature' (kill the text up to the signature). |
C-c C-z `message-kill-to-signature' (kill the text up to the signature). |
2415 |
C-c C-r `message-caesar-buffer-body' (rot13 the message body). |
C-c C-r `message-caesar-buffer-body' (rot13 the message body). |
2416 |
C-c C-a `mml-attach-file' (attach a file as MIME). |
C-c C-a `mml-attach-file' (attach a file as MIME). |
2417 |
|
C-c C-u `message-insert-or-toggle-importance' (insert or cycle importance). |
2418 |
|
C-c M-n `message-insert-disposition-notification-to' (request receipt). |
2419 |
|
C-c M-m `message-mark-inserted-region' (mark region with enclosing tags). |
2420 |
|
C-c M-f `message-mark-insert-file' (insert file marked with enclosing tags). |
2421 |
M-RET `message-newline-and-reformat' (break the line and reformat)." |
M-RET `message-newline-and-reformat' (break the line and reformat)." |
2422 |
(interactive) |
(setq local-abbrev-table text-mode-abbrev-table) |
|
(if (local-variable-p 'mml-buffer-list (current-buffer)) |
|
|
(mml-destroy-buffers)) |
|
|
(kill-all-local-variables) |
|
2423 |
(set (make-local-variable 'message-reply-buffer) nil) |
(set (make-local-variable 'message-reply-buffer) nil) |
2424 |
(make-local-variable 'message-send-actions) |
(set (make-local-variable 'message-inserted-headers) nil) |
2425 |
(make-local-variable 'message-exit-actions) |
(set (make-local-variable 'message-send-actions) nil) |
2426 |
(make-local-variable 'message-kill-actions) |
(set (make-local-variable 'message-exit-actions) nil) |
2427 |
(make-local-variable 'message-postpone-actions) |
(set (make-local-variable 'message-kill-actions) nil) |
2428 |
(make-local-variable 'message-draft-article) |
(set (make-local-variable 'message-postpone-actions) nil) |
2429 |
(make-local-hook 'kill-buffer-hook) |
(set (make-local-variable 'message-draft-article) nil) |
|
(set-syntax-table message-mode-syntax-table) |
|
|
(use-local-map message-mode-map) |
|
|
(setq local-abbrev-table message-mode-abbrev-table) |
|
|
(setq major-mode 'message-mode) |
|
|
(setq mode-name "Message") |
|
2430 |
(setq buffer-offer-save t) |
(setq buffer-offer-save t) |
2431 |
(make-local-variable 'facemenu-add-face-function) |
(set (make-local-variable 'facemenu-add-face-function) |
2432 |
(make-local-variable 'facemenu-remove-face-function) |
(lambda (face end) |
2433 |
(setq facemenu-add-face-function |
(let ((face-fun (cdr (assq face message-face-alist)))) |
2434 |
(lambda (face end) |
(if face-fun |
2435 |
(let ((face-fun (cdr (assq face message-face-alist)))) |
(funcall face-fun (point) end) |
2436 |
(if face-fun |
(error "Face %s not configured for %s mode" face mode-name))) |
2437 |
(funcall face-fun (point) end) |
"")) |
2438 |
(error "Face %s not configured for %s mode" face mode-name))) |
(set (make-local-variable 'facemenu-remove-face-function) t) |
2439 |
"") |
(set (make-local-variable 'message-reply-headers) nil) |
|
facemenu-remove-face-function t) |
|
|
(make-local-variable 'message-reply-headers) |
|
|
(setq message-reply-headers nil) |
|
2440 |
(make-local-variable 'message-newsreader) |
(make-local-variable 'message-newsreader) |
2441 |
(make-local-variable 'message-mailer) |
(make-local-variable 'message-mailer) |
2442 |
(make-local-variable 'message-post-method) |
(make-local-variable 'message-post-method) |
2445 |
(set (make-local-variable 'message-mime-part) 0) |
(set (make-local-variable 'message-mime-part) 0) |
2446 |
(message-setup-fill-variables) |
(message-setup-fill-variables) |
2447 |
;; Allow using comment commands to add/remove quoting. |
;; Allow using comment commands to add/remove quoting. |
2448 |
|
;; (set (make-local-variable 'comment-start) message-yank-prefix) |
2449 |
(when message-yank-prefix |
(when message-yank-prefix |
2450 |
(set (make-local-variable 'comment-start) message-yank-prefix) |
(set (make-local-variable 'comment-start) message-yank-prefix) |
2451 |
(set (make-local-variable 'comment-start-skip) |
(set (make-local-variable 'comment-start-skip) |
2452 |
(concat "^" (regexp-quote message-yank-prefix) "[ \t]*"))) |
(concat "^" (regexp-quote message-yank-prefix) "[ \t]*"))) |
|
;;(when (fboundp 'mail-hist-define-keys) |
|
|
;; (mail-hist-define-keys)) |
|
2453 |
(if (featurep 'xemacs) |
(if (featurep 'xemacs) |
2454 |
(message-setup-toolbar) |
(message-setup-toolbar) |
2455 |
(set (make-local-variable 'font-lock-defaults) |
(set (make-local-variable 'font-lock-defaults) |
2456 |
'(message-font-lock-keywords t)) |
'(message-font-lock-keywords t)) |
2457 |
(if (boundp 'message-tool-bar-map) |
(if (boundp 'tool-bar-map) |
2458 |
(set (make-local-variable 'tool-bar-map) message-tool-bar-map))) |
(set (make-local-variable 'tool-bar-map) (message-tool-bar-map)))) |
2459 |
(easy-menu-add message-mode-menu message-mode-map) |
(easy-menu-add message-mode-menu message-mode-map) |
2460 |
(easy-menu-add message-mode-field-menu message-mode-map) |
(easy-menu-add message-mode-field-menu message-mode-map) |
2461 |
|
(gnus-make-local-hook 'after-change-functions) |
2462 |
|
;; Mmmm... Forbidden properties... |
2463 |
|
(add-hook 'after-change-functions 'message-strip-forbidden-properties |
2464 |
|
nil 'local) |
2465 |
;; Allow mail alias things. |
;; Allow mail alias things. |
2466 |
(when (eq message-mail-alias-type 'abbrev) |
(when (eq message-mail-alias-type 'abbrev) |
2467 |
(if (fboundp 'mail-abbrevs-setup) |
(if (fboundp 'mail-abbrevs-setup) |
2468 |
(mail-abbrevs-setup) |
(mail-abbrevs-setup) |
2469 |
(mail-aliases-setup))) |
(if (fboundp 'mail-aliases-setup) ; warning avoidance |
2470 |
|
(mail-aliases-setup)))) |
2471 |
(unless buffer-file-name |
(unless buffer-file-name |
2472 |
(message-set-auto-save-file-name)) |
(message-set-auto-save-file-name)) |
2473 |
(mm-enable-multibyte) |
(unless (buffer-base-buffer) |
2474 |
(make-local-variable 'indent-tabs-mode) ;Turn off tabs for indentation. |
;; Don't enable multibyte on an indirect buffer. Maybe enabling |
2475 |
(setq indent-tabs-mode nil) |
;; multibyte is not necessary at all. -- zsh |
2476 |
(mml-mode) |
(mm-enable-multibyte)) |
2477 |
(run-hooks 'text-mode-hook 'message-mode-hook)) |
(set (make-local-variable 'indent-tabs-mode) nil) ;No tabs for indentation. |
2478 |
|
(mml-mode)) |
2479 |
|
|
2480 |
(defun message-setup-fill-variables () |
(defun message-setup-fill-variables () |
2481 |
"Setup message fill variables." |
"Setup message fill variables." |
2482 |
|
(set (make-local-variable 'fill-paragraph-function) |
2483 |
|
'message-fill-paragraph) |
2484 |
(make-local-variable 'paragraph-separate) |
(make-local-variable 'paragraph-separate) |
2485 |
(make-local-variable 'paragraph-start) |
(make-local-variable 'paragraph-start) |
2486 |
(make-local-variable 'adaptive-fill-regexp) |
(make-local-variable 'adaptive-fill-regexp) |
2487 |
(unless (boundp 'adaptive-fill-first-line-regexp) |
(unless (boundp 'adaptive-fill-first-line-regexp) |
2488 |
(setq adaptive-fill-first-line-regexp nil)) |
(setq adaptive-fill-first-line-regexp nil)) |
2489 |
(make-local-variable 'adaptive-fill-first-line-regexp) |
(make-local-variable 'adaptive-fill-first-line-regexp) |
|
(make-local-variable 'auto-fill-inhibit-regexp) |
|
2490 |
(let ((quote-prefix-regexp |
(let ((quote-prefix-regexp |
2491 |
(concat |
;; User should change message-cite-prefix-regexp if |
2492 |
"[ \t]*" ; possible initial space |
;; message-yank-prefix is set to an abnormal value. |
2493 |
"\\(\\(" (regexp-quote message-yank-prefix) "\\|" ; user's prefix |
(concat "\\(" message-cite-prefix-regexp "\\)[ \t]*"))) |
|
"\\w+>\\|" ; supercite-style prefix |
|
|
"[|:>]" ; standard prefix |
|
|
"\\)[ \t]*\\)+"))) ; possible space after each prefix |
|
2494 |
(setq paragraph-start |
(setq paragraph-start |
2495 |
(concat |
(concat |
2496 |
(regexp-quote mail-header-separator) "$\\|" |
(regexp-quote mail-header-separator) "$\\|" |
2497 |
"[ \t]*$\\|" ; blank lines |
"[ \t]*$\\|" ; blank lines |
2498 |
"-- $\\|" ; signature delimiter |
"-- $\\|" ; signature delimiter |
2499 |
"---+$\\|" ; delimiters for forwarded messages |
"---+$\\|" ; delimiters for forwarded messages |
2500 |
page-delimiter "$\\|" ; spoiler warnings |
page-delimiter "$\\|" ; spoiler warnings |
2501 |
".*wrote:$\\|" ; attribution lines |
".*wrote:$\\|" ; attribution lines |
2502 |
quote-prefix-regexp "$")) ; empty lines in quoted text |
quote-prefix-regexp "$\\|" ; empty lines in quoted text |
2503 |
|
; mml tags |
2504 |
|
"<#!*/?\\(multipart\\|part\\|external\\|mml\\|secure\\)")) |
2505 |
(setq paragraph-separate paragraph-start) |
(setq paragraph-separate paragraph-start) |
2506 |
(setq adaptive-fill-regexp |
(setq adaptive-fill-regexp |
2507 |
(concat quote-prefix-regexp "\\|" adaptive-fill-regexp)) |
(concat quote-prefix-regexp "\\|" adaptive-fill-regexp)) |
2508 |
(setq adaptive-fill-first-line-regexp |
(setq adaptive-fill-first-line-regexp |
2509 |
(concat quote-prefix-regexp "\\|" |
(concat quote-prefix-regexp "\\|" |
2510 |
adaptive-fill-first-line-regexp)) |
adaptive-fill-first-line-regexp))) |
2511 |
(setq auto-fill-inhibit-regexp "^[A-Z][^: \n\t]+:"))) |
(make-local-variable 'auto-fill-inhibit-regexp) |
2512 |
|
;;(setq auto-fill-inhibit-regexp "^[A-Z][^: \n\t]+:") |
2513 |
|
(setq auto-fill-inhibit-regexp nil) |
2514 |
|
(make-local-variable 'normal-auto-fill-function) |
2515 |
|
(setq normal-auto-fill-function 'message-do-auto-fill) |
2516 |
|
;; KLUDGE: auto fill might already be turned on in `text-mode-hook'. |
2517 |
|
;; In that case, ensure that it uses the right function. The real |
2518 |
|
;; solution would be not to use `define-derived-mode', and run |
2519 |
|
;; `text-mode-hook' ourself at the end of the mode. |
2520 |
|
;; -- Per Abrahamsen <abraham@dina.kvl.dk> Date: 2001-10-19. |
2521 |
|
(when auto-fill-function |
2522 |
|
(setq auto-fill-function normal-auto-fill-function))) |
2523 |
|
|
2524 |
|
|
2525 |
|
|
2534 |
(interactive) |
(interactive) |
2535 |
(message-position-on-field "To")) |
(message-position-on-field "To")) |
2536 |
|
|
2537 |
|
(defun message-goto-from () |
2538 |
|
"Move point to the From header." |
2539 |
|
(interactive) |
2540 |
|
(message-position-on-field "From")) |
2541 |
|
|
2542 |
(defun message-goto-subject () |
(defun message-goto-subject () |
2543 |
"Move point to the Subject header." |
"Move point to the Subject header." |
2544 |
(interactive) |
(interactive) |
2579 |
(interactive) |
(interactive) |
2580 |
(message-position-on-field "Followup-To" "Newsgroups")) |
(message-position-on-field "Followup-To" "Newsgroups")) |
2581 |
|
|
2582 |
|
(defun message-goto-mail-followup-to () |
2583 |
|
"Move point to the Mail-Followup-To header." |
2584 |
|
(interactive) |
2585 |
|
(message-position-on-field "Mail-Followup-To" "From")) |
2586 |
|
|
2587 |
(defun message-goto-keywords () |
(defun message-goto-keywords () |
2588 |
"Move point to the Keywords header." |
"Move point to the Keywords header." |
2589 |
(interactive) |
(interactive) |
2594 |
(interactive) |
(interactive) |
2595 |
(message-position-on-field "Summary" "Subject")) |
(message-position-on-field "Summary" "Subject")) |
2596 |
|
|
2597 |
(defun message-goto-body () |
(defun message-goto-body (&optional interactivep) |
2598 |
"Move point to the beginning of the message body." |
"Move point to the beginning of the message body." |
2599 |
(interactive) |
(interactive (list t)) |
2600 |
(if (looking-at "[ \t]*\n") (expand-abbrev)) |
(when (and interactivep |
2601 |
|
(looking-at "[ \t]*\n")) |
2602 |
|
(expand-abbrev)) |
2603 |
(goto-char (point-min)) |
(goto-char (point-min)) |
2604 |
(or (search-forward (concat "\n" mail-header-separator "\n") nil t) |
(or (search-forward (concat "\n" mail-header-separator "\n") nil t) |
2605 |
(search-forward "\n\n" nil t))) |
(search-forward-regexp "[^:]+:\\([^\n]\\|\n[ \t]\\)+\n\n" nil t))) |
2606 |
|
|
2607 |
(defun message-goto-eoh () |
(defun message-goto-eoh () |
2608 |
"Move point to the end of the headers." |
"Move point to the end of the headers." |
2621 |
(goto-char (point-max)) |
(goto-char (point-max)) |
2622 |
nil)) |
nil)) |
2623 |
|
|
2624 |
|
(defun message-generate-unsubscribed-mail-followup-to (&optional include-cc) |
2625 |
|
"Insert a reasonable MFT header in a post to an unsubscribed list. |
2626 |
|
When making original posts to a mailing list you are not subscribed to, |
2627 |
|
you have to type in a MFT header by hand. The contents, usually, are |
2628 |
|
the addresses of the list and your own address. This function inserts |
2629 |
|
such a header automatically. It fetches the contents of the To: header |
2630 |
|
in the current mail buffer, and appends the current `user-mail-address'. |
2631 |
|
|
2632 |
|
If the optional argument INCLUDE-CC is non-nil, the addresses in the |
2633 |
|
Cc: header are also put into the MFT." |
2634 |
|
|
2635 |
|
(interactive "P") |
2636 |
|
(let* (cc tos) |
2637 |
|
(save-restriction |
2638 |
|
(message-narrow-to-headers) |
2639 |
|
(message-remove-header "Mail-Followup-To") |
2640 |
|
(setq cc (and include-cc (message-fetch-field "Cc"))) |
2641 |
|
(setq tos (if cc |
2642 |
|
(concat (message-fetch-field "To") "," cc) |
2643 |
|
(message-fetch-field "To")))) |
2644 |
|
(message-goto-mail-followup-to) |
2645 |
|
(insert (concat tos ", " user-mail-address)))) |
2646 |
|
|
2647 |
|
|
2648 |
|
|
2649 |
(defun message-insert-to (&optional force) |
(defun message-insert-to (&optional force) |
2650 |
"Insert a To header that points to the author of the article being replied to. |
"Insert a To header that points to the author of the article being replied to. |
2651 |
If the original author requested not to be sent mail, the function signals |
If the original author requested not to be sent mail, don't insert unless the |
2652 |
an error. |
prefix FORCE is given." |
|
With the prefix argument FORCE, insert the header anyway." |
|
2653 |
(interactive "P") |
(interactive "P") |
2654 |
(let ((co (message-fetch-reply-field "mail-copies-to"))) |
(let* ((mct (message-fetch-reply-field "mail-copies-to")) |
2655 |
(when (and (null force) |
(dont (and mct (or (equal (downcase mct) "never") |
2656 |
co |
(equal (downcase mct) "nobody")))) |
2657 |
(or (equal (downcase co) "never") |
(to (or (message-fetch-reply-field "mail-reply-to") |
2658 |
(equal (downcase co) "nobody"))) |
(message-fetch-reply-field "reply-to") |
2659 |
(error "The user has requested not to have copies sent via mail"))) |
(message-fetch-reply-field "from")))) |
2660 |
(when (and (message-position-on-field "To") |
(when (and dont to) |
2661 |
(mail-fetch-field "to") |
(message |
2662 |
(not (string-match "\\` *\\'" (mail-fetch-field "to")))) |
(if force |
2663 |
(insert ", ")) |
"Ignoring the user request not to have copies sent via mail" |
2664 |
(insert (or (message-fetch-reply-field "reply-to") |
"Complying with the user request not to have copies sent via mail"))) |
2665 |
(message-fetch-reply-field "from") ""))) |
(when (and force (not to)) |
2666 |
|
(error "No mail address in the article")) |
2667 |
|
(when (and to (or force (not dont))) |
2668 |
|
(message-carefully-insert-headers (list (cons 'To to)))))) |
2669 |
|
|
2670 |
|
(defun message-insert-wide-reply () |
2671 |
|
"Insert To and Cc headers as if you were doing a wide reply." |
2672 |
|
(interactive) |
2673 |
|
(let ((headers (message-with-reply-buffer |
2674 |
|
(message-get-reply-headers t)))) |
2675 |
|
(message-carefully-insert-headers headers))) |
2676 |
|
|
2677 |
|
(defcustom message-header-synonyms |
2678 |
|
'((To Cc Bcc)) |
2679 |
|
"List of lists of header synonyms. |
2680 |
|
E.g., if this list contains a member list with elements `Cc' and `To', |
2681 |
|
then `message-carefully-insert-headers' will not insert a `To' header |
2682 |
|
when the message is already `Cc'ed to the recipient." |
2683 |
|
:group 'message-headers |
2684 |
|
:link '(custom-manual "(message)Message Headers") |
2685 |
|
:type '(repeat sexp)) |
2686 |
|
|
2687 |
|
(defun message-carefully-insert-headers (headers) |
2688 |
|
"Insert the HEADERS, an alist, into the message buffer. |
2689 |
|
Does not insert the headers when they are already present there |
2690 |
|
or in the synonym headers, defined by `message-header-synonyms'." |
2691 |
|
;; FIXME: Should compare only the address and not the full name. Comparison |
2692 |
|
;; should be done case-folded (and with `string=' rather than |
2693 |
|
;; `string-match'). |
2694 |
|
(dolist (header headers) |
2695 |
|
(let* ((header-name (symbol-name (car header))) |
2696 |
|
(new-header (cdr header)) |
2697 |
|
(synonyms (loop for synonym in message-header-synonyms |
2698 |
|
when (memq (car header) synonym) return synonym)) |
2699 |
|
(old-header |
2700 |
|
(loop for synonym in synonyms |
2701 |
|
for old-header = (mail-fetch-field (symbol-name synonym)) |
2702 |
|
when (and old-header (string-match new-header old-header)) |
2703 |
|
return synonym))) |
2704 |
|
(if old-header |
2705 |
|
(message "already have `%s' in `%s'" new-header old-header) |
2706 |
|
(when (and (message-position-on-field header-name) |
2707 |
|
(setq old-header (mail-fetch-field header-name)) |
2708 |
|
(not (string-match "\\` *\\'" old-header))) |
2709 |
|
(insert ", ")) |
2710 |
|
(insert new-header))))) |
2711 |
|
|
2712 |
(defun message-widen-reply () |
(defun message-widen-reply () |
2713 |
"Widen the reply to include maximum recipients." |
"Widen the reply to include maximum recipients." |
2743 |
(defun message-delete-not-region (beg end) |
(defun message-delete-not-region (beg end) |
2744 |
"Delete everything in the body of the current message outside of the region." |
"Delete everything in the body of the current message outside of the region." |
2745 |
(interactive "r") |
(interactive "r") |
2746 |
(save-excursion |
(let (citeprefix) |
2747 |
(goto-char end) |
(save-excursion |
2748 |
(delete-region (point) (if (not (message-goto-signature)) |
(goto-char beg) |
2749 |
(point) |
;; snarf citation prefix, if appropriate |
2750 |
(forward-line -2) |
(unless (eq (point) (progn (beginning-of-line) (point))) |
2751 |
(point))) |
(when (looking-at message-cite-prefix-regexp) |
2752 |
(insert "\n") |
(setq citeprefix (match-string 0)))) |
2753 |
(goto-char beg) |
(goto-char end) |
2754 |
(delete-region beg (progn (message-goto-body) |
(delete-region (point) (if (not (message-goto-signature)) |
2755 |
(forward-line 2) |
(point) |
2756 |
(point)))) |
(forward-line -2) |
2757 |
|
(point))) |
2758 |
|
(insert "\n") |
2759 |
|
(goto-char beg) |
2760 |
|
(delete-region beg (progn (message-goto-body) |
2761 |
|
(forward-line 2) |
2762 |
|
(point))) |
2763 |
|
(when citeprefix |
2764 |
|
(insert citeprefix)))) |
2765 |
(when (message-goto-signature) |
(when (message-goto-signature) |
2766 |
(forward-line -2))) |
(forward-line -2))) |
2767 |
|
|
2771 |
(let ((point (point))) |
(let ((point (point))) |
2772 |
(message-goto-signature) |
(message-goto-signature) |
2773 |
(unless (eobp) |
(unless (eobp) |
2774 |
(forward-line -2)) |
(end-of-line -1)) |
2775 |
(kill-region point (point)) |
(kill-region point (point)) |
2776 |
(unless (bolp) |
(unless (bolp) |
2777 |
(insert "\n")))) |
(insert "\n")))) |
2778 |
|
|
2779 |
(defun message-newline-and-reformat () |
(defun message-newline-and-reformat (&optional arg not-break) |
2780 |
"Insert four newlines, and then reformat if inside quoted text." |
"Insert four newlines, and then reformat if inside quoted text. |
2781 |
(interactive) |
Prefix arg means justify as well." |
2782 |
;; The Latin-1 angle quote looks pretty dubious. -- fx |
(interactive (list (if current-prefix-arg 'full))) |
2783 |
(let ((prefix "[]>»|:}+ \t]*") |
(let (quoted point beg end leading-space bolp) |
|
(supercite-thing "[-._[:alnum:]]*[>]+[ \t]*") |
|
|
quoted point) |
|
|
(unless (bolp) |
|
|
(save-excursion |
|
|
(beginning-of-line) |
|
|
(when (looking-at (concat prefix |
|
|
supercite-thing)) |
|
|
(setq quoted (match-string 0)))) |
|
|
(insert "\n")) |
|
2784 |
(setq point (point)) |
(setq point (point)) |
2785 |
(insert "\n\n\n") |
(beginning-of-line) |
2786 |
(delete-region (point) (re-search-forward "[ \t]*")) |
(setq beg (point)) |
2787 |
(when quoted |
(setq bolp (= beg point)) |
2788 |
(insert quoted)) |
;; Find first line of the paragraph. |
2789 |
(fill-paragraph nil) |
(if not-break |
2790 |
|
(while (and (not (eobp)) |
2791 |
|
(not (looking-at message-cite-prefix-regexp)) |
2792 |
|
(looking-at paragraph-start)) |
2793 |
|
(forward-line 1))) |
2794 |
|
;; Find the prefix |
2795 |
|
(when (looking-at message-cite-prefix-regexp) |
2796 |
|
(setq quoted (match-string 0)) |
2797 |
|
(goto-char (match-end 0)) |
2798 |
|
(looking-at "[ \t]*") |
2799 |
|
(setq leading-space (match-string 0))) |
2800 |
|
(if (and quoted |
2801 |
|
(not not-break) |
2802 |
|
(not bolp) |
2803 |
|
(< (- point beg) (length quoted))) |
2804 |
|
;; break inside the cite prefix. |
2805 |
|
(setq quoted nil |
2806 |
|
end nil)) |
2807 |
|
(if quoted |
2808 |
|
(progn |
2809 |
|
(forward-line 1) |
2810 |
|
(while (and (not (eobp)) |
2811 |
|
(not (looking-at paragraph-separate)) |
2812 |
|
(looking-at message-cite-prefix-regexp) |
2813 |
|
(equal quoted (match-string 0))) |
2814 |
|
(goto-char (match-end 0)) |
2815 |
|
(looking-at "[ \t]*") |
2816 |
|
(if (> (length leading-space) (length (match-string 0))) |
2817 |
|
(setq leading-space (match-string 0))) |
2818 |
|
(forward-line 1)) |
2819 |
|
(setq end (point)) |
2820 |
|
(goto-char beg) |
2821 |
|
(while (and (if (bobp) nil (forward-line -1) t) |
2822 |
|
(not (looking-at paragraph-start)) |
2823 |
|
(looking-at message-cite-prefix-regexp) |
2824 |
|
(equal quoted (match-string 0))) |
2825 |
|
(setq beg (point)) |
2826 |
|
(goto-char (match-end 0)) |
2827 |
|
(looking-at "[ \t]*") |
2828 |
|
(if (> (length leading-space) (length (match-string 0))) |
2829 |
|
(setq leading-space (match-string 0))))) |
2830 |
|
(while (and (not (eobp)) |
2831 |
|
(not (looking-at paragraph-separate)) |
2832 |
|
(not (looking-at message-cite-prefix-regexp))) |
2833 |
|
(forward-line 1)) |
2834 |
|
(setq end (point)) |
2835 |
|
(goto-char beg) |
2836 |
|
(while (and (if (bobp) nil (forward-line -1) t) |
2837 |
|
(not (looking-at paragraph-start)) |
2838 |
|
(not (looking-at message-cite-prefix-regexp))) |
2839 |
|
(setq beg (point)))) |
2840 |
(goto-char point) |
(goto-char point) |
2841 |
(forward-line 1))) |
(save-restriction |
2842 |
|
(narrow-to-region beg end) |
2843 |
|
(if not-break |
2844 |
|
(setq point nil) |
2845 |
|
(if bolp |
2846 |
|
(newline) |
2847 |
|
(newline) |
2848 |
|
(newline)) |
2849 |
|
(setq point (point)) |
2850 |
|
;; (newline 2) doesn't mark both newline's as hard, so call |
2851 |
|
;; newline twice. -jas |
2852 |
|
(newline) |
2853 |
|
(newline) |
2854 |
|
(delete-region (point) (re-search-forward "[ \t]*")) |
2855 |
|
(when (and quoted (not bolp)) |
2856 |
|
(insert quoted leading-space))) |
2857 |
|
(undo-boundary) |
2858 |
|
(if quoted |
2859 |
|
(let* ((adaptive-fill-regexp |
2860 |
|
(regexp-quote (concat quoted leading-space))) |
2861 |
|
(adaptive-fill-first-line-regexp |
2862 |
|
adaptive-fill-regexp )) |
2863 |
|
(fill-paragraph arg)) |
2864 |
|
(fill-paragraph arg)) |
2865 |
|
(if point (goto-char point))))) |
2866 |
|
|
2867 |
|
(defun message-fill-paragraph (&optional arg) |
2868 |
|
"Like `fill-paragraph'." |
2869 |
|
(interactive (list (if current-prefix-arg 'full))) |
2870 |
|
(if (if (boundp 'filladapt-mode) filladapt-mode) |
2871 |
|
nil |
2872 |
|
(message-newline-and-reformat arg t) |
2873 |
|
t)) |
2874 |
|
|
2875 |
(defun message-split-line () |
;; Is it better to use `mail-header-end'? |
2876 |
"Split current line, moving portion beyond point vertically down. |
(defun message-point-in-header-p () |
2877 |
If the current line has `message-yank-prefix', insert it on the new line." |
"Return t if point is in the header." |
2878 |
(interactive "*") |
(save-excursion |
2879 |
(split-line message-yank-prefix)) |
(let ((p (point))) |
2880 |
|
(goto-char (point-min)) |
2881 |
|
(not (re-search-forward |
2882 |
|
(concat "^" (regexp-quote mail-header-separator) "\n") |
2883 |
|
p t))))) |
2884 |
|
|
2885 |
|
(defun message-do-auto-fill () |
2886 |
|
"Like `do-auto-fill', but don't fill in message header." |
2887 |
|
(unless (message-point-in-header-p) |
2888 |
|
(do-auto-fill))) |
2889 |
|
|
2890 |
(defun message-insert-signature (&optional force) |
(defun message-insert-signature (&optional force) |
2891 |
"Insert a signature. See documentation for variable `message-signature'." |
"Insert a signature. See documentation for variable `message-signature'." |
2900 |
((and (null message-signature) |
((and (null message-signature) |
2901 |
force) |
force) |
2902 |
t) |
t) |
2903 |
((message-functionp message-signature) |
((functionp message-signature) |
2904 |
(funcall message-signature)) |
(funcall message-signature)) |
2905 |
((listp message-signature) |
((listp message-signature) |
2906 |
(eval message-signature)) |
(eval message-signature)) |
2917 |
;; Insert the signature. |
;; Insert the signature. |
2918 |
(unless (bolp) |
(unless (bolp) |
2919 |
(insert "\n")) |
(insert "\n")) |
2920 |
(insert "\n-- \n") |
(when message-signature-insert-empty-line |
2921 |
|
(insert "\n")) |
2922 |
|
(insert "-- \n") |
2923 |
(if (eq signature t) |
(if (eq signature t) |
2924 |
(insert-file-contents message-signature-file) |
(insert-file-contents message-signature-file) |
2925 |
(insert signature)) |
(insert signature)) |
2926 |
(goto-char (point-max)) |
(goto-char (point-max)) |
2927 |
(or (bolp) (insert "\n"))))) |
(or (bolp) (insert "\n"))))) |
2928 |
|
|
2929 |
|
(defun message-insert-importance-high () |
2930 |
|
"Insert header to mark message as important." |
2931 |
|
(interactive) |
2932 |
|
(save-excursion |
2933 |
|
(save-restriction |
2934 |
|
(message-narrow-to-headers) |
2935 |
|
(message-remove-header "Importance")) |
2936 |
|
(message-goto-eoh) |
2937 |
|
(insert "Importance: high\n"))) |
2938 |
|
|
2939 |
|
(defun message-insert-importance-low () |
2940 |
|
"Insert header to mark message as unimportant." |
2941 |
|
(interactive) |
2942 |
|
(save-excursion |
2943 |
|
(save-restriction |
2944 |
|
(message-narrow-to-headers) |
2945 |
|
(message-remove-header "Importance")) |
2946 |
|
(message-goto-eoh) |
2947 |
|
(insert "Importance: low\n"))) |
2948 |
|
|
2949 |
|
(defun message-insert-or-toggle-importance () |
2950 |
|
"Insert a \"Importance: high\" header, or cycle through the header values. |
2951 |
|
The three allowed values according to RFC 1327 are `high', `normal' |
2952 |
|
and `low'." |
2953 |
|
(interactive) |
2954 |
|
(save-excursion |
2955 |
|
(let ((valid '("high" "normal" "low")) |
2956 |
|
(new "high") |
2957 |
|
cur) |
2958 |
|
(save-restriction |
2959 |
|
(message-narrow-to-headers) |
2960 |
|
(when (setq cur (message-fetch-field "Importance")) |
2961 |
|
(message-remove-header "Importance") |
2962 |
|
(setq new (cond ((string= cur "high") |
2963 |
|
"low") |
2964 |
|
((string= cur "low") |
2965 |
|
"normal") |
2966 |
|
(t |
2967 |
|
"high"))))) |
2968 |
|
(message-goto-eoh) |
2969 |
|
(insert (format "Importance: %s\n" new))))) |
2970 |
|
|
2971 |
|
(defun message-insert-disposition-notification-to () |
2972 |
|
"Request a disposition notification (return receipt) to this message. |
2973 |
|
Note that this should not be used in newsgroups." |
2974 |
|
(interactive) |
2975 |
|
(save-excursion |
2976 |
|
(save-restriction |
2977 |
|
(message-narrow-to-headers) |
2978 |
|
(message-remove-header "Disposition-Notification-To")) |
2979 |
|
(message-goto-eoh) |
2980 |
|
(insert (format "Disposition-Notification-To: %s\n" |
2981 |
|
(or (message-field-value "Reply-to") |
2982 |
|
(message-field-value "From") |
2983 |
|
(message-make-from)))))) |
2984 |
|
|
2985 |
(defun message-elide-region (b e) |
(defun message-elide-region (b e) |
2986 |
"Elide the text in the region. |
"Elide the text in the region. |
2987 |
An ellipsis (from `message-elide-ellipsis') will be inserted where the |
An ellipsis (from `message-elide-ellipsis') will be inserted where the |
3002 |
(prefix-numeric-value current-prefix-arg)))) |
(prefix-numeric-value current-prefix-arg)))) |
3003 |
|
|
3004 |
(setq n (if (numberp n) (mod n 26) 13)) ;canonize N |
(setq n (if (numberp n) (mod n 26) 13)) ;canonize N |
3005 |
(unless (or (zerop n) ; no action needed for a rot of 0 |
(unless (or (zerop n) ; no action needed for a rot of 0 |
3006 |
(= b e)) ; no region to rotate |
(= b e)) ; no region to rotate |
3007 |
;; We build the table, if necessary. |
;; We build the table, if necessary. |
3008 |
(when (or (not message-caesar-translation-table) |
(when (or (not message-caesar-translation-table) |
3045 |
(save-excursion |
(save-excursion |
3046 |
(save-restriction |
(save-restriction |
3047 |
(when (message-goto-body) |
(when (message-goto-body) |
3048 |
(narrow-to-region (point) (point-max))) |
(narrow-to-region (point) (point-max))) |
3049 |
(shell-command-on-region |
(shell-command-on-region |
3050 |
(point-min) (point-max) program nil t)))) |
(point-min) (point-max) program nil t)))) |
3051 |
|
|
3125 |
(save-excursion |
(save-excursion |
3126 |
(goto-char start) |
(goto-char start) |
3127 |
(while (< (point) (mark t)) |
(while (< (point) (mark t)) |
3128 |
(insert message-yank-prefix) |
(if (or (looking-at ">") (looking-at "^$")) |
3129 |
|
(insert message-yank-cited-prefix) |
3130 |
|
(insert message-yank-prefix)) |
3131 |
(forward-line 1)))) |
(forward-line 1)))) |
3132 |
(goto-char start))) |
(goto-char start))) |
3133 |
|
|
3158 |
(defun message-yank-buffer (buffer) |
(defun message-yank-buffer (buffer) |
3159 |
"Insert BUFFER into the current buffer and quote it." |
"Insert BUFFER into the current buffer and quote it." |
3160 |
(interactive "bYank buffer: ") |
(interactive "bYank buffer: ") |
3161 |
(let ((message-reply-buffer buffer)) |
(let ((message-reply-buffer (get-buffer buffer))) |
3162 |
(save-window-excursion |
(save-window-excursion |
3163 |
(message-yank-original)))) |
(message-yank-original)))) |
3164 |
|
|
3175 |
|
|
3176 |
(defun message-cite-original-without-signature () |
(defun message-cite-original-without-signature () |
3177 |
"Cite function in the standard Message manner." |
"Cite function in the standard Message manner." |
3178 |
(let ((start (point)) |
(let* ((start (point)) |
3179 |
(end (mark t)) |
(end (mark t)) |
3180 |
(functions |
(functions |
3181 |
(when message-indent-citation-function |
(when message-indent-citation-function |
3182 |
(if (listp message-indent-citation-function) |
(if (listp message-indent-citation-function) |
3183 |
message-indent-citation-function |
message-indent-citation-function |
3184 |
(list message-indent-citation-function))))) |
(list message-indent-citation-function)))) |
3185 |
|
;; This function may be called by `gnus-summary-yank-message' and |
3186 |
|
;; may insert a different article from the original. So, we will |
3187 |
|
;; modify the value of `message-reply-headers' with that article. |
3188 |
|
(message-reply-headers |
3189 |
|
(save-restriction |
3190 |
|
(narrow-to-region start end) |
3191 |
|
(message-narrow-to-head-1) |
3192 |
|
(vector 0 |
3193 |
|
(or (message-fetch-field "subject") "none") |
3194 |
|
(message-fetch-field "from") |
3195 |
|
(message-fetch-field "date") |
3196 |
|
(message-fetch-field "message-id" t) |
3197 |
|
(message-fetch-field "references") |
3198 |
|
0 0 "")))) |
3199 |
(mml-quote-region start end) |
(mml-quote-region start end) |
3200 |
;; Allow undoing. |
;; Allow undoing. |
3201 |
(undo-boundary) |
(undo-boundary) |
3218 |
(insert "\n")) |
(insert "\n")) |
3219 |
(funcall message-citation-line-function)))) |
(funcall message-citation-line-function)))) |
3220 |
|
|
3221 |
(eval-when-compile (defvar mail-citation-hook)) ;Compiler directive |
(eval-when-compile (defvar mail-citation-hook)) ;Compiler directive |
3222 |
(defun message-cite-original () |
(defun message-cite-original () |
3223 |
"Cite function in the standard Message manner." |
"Cite function in the standard Message manner." |
3224 |
(if (and (boundp 'mail-citation-hook) |
(if (and (boundp 'mail-citation-hook) |
3225 |
mail-citation-hook) |
mail-citation-hook) |
3226 |
(run-hooks 'mail-citation-hook) |
(run-hooks 'mail-citation-hook) |
3227 |
(let ((start (point)) |
(let* ((start (point)) |
3228 |
(end (mark t)) |
(end (mark t)) |
3229 |
(functions |
(functions |
3230 |
(when message-indent-citation-function |
(when message-indent-citation-function |
3231 |
(if (listp message-indent-citation-function) |
(if (listp message-indent-citation-function) |
3232 |
message-indent-citation-function |
message-indent-citation-function |
3233 |
(list message-indent-citation-function))))) |
(list message-indent-citation-function)))) |
3234 |
|
;; This function may be called by `gnus-summary-yank-message' and |
3235 |
|
;; may insert a different article from the original. So, we will |
3236 |
|
;; modify the value of `message-reply-headers' with that article. |
3237 |
|
(message-reply-headers |
3238 |
|
(save-restriction |
3239 |
|
(narrow-to-region start end) |
3240 |
|
(message-narrow-to-head-1) |
3241 |
|
(vector 0 |
3242 |
|
(or (message-fetch-field "subject") "none") |
3243 |
|
(message-fetch-field "from") |
3244 |
|
(message-fetch-field "date") |
3245 |
|
(message-fetch-field "message-id" t) |
3246 |
|
(message-fetch-field "references") |
3247 |
|
0 0 "")))) |
3248 |
(mml-quote-region start end) |
(mml-quote-region start end) |
3249 |
(goto-char start) |
(goto-char start) |
3250 |
(while functions |
(while functions |
3331 |
t))) |
t))) |
3332 |
|
|
3333 |
(defun message-dont-send () |
(defun message-dont-send () |
3334 |
"Don't send the message you have been editing." |
"Don't send the message you have been editing. |
3335 |
|
Instead, just auto-save the buffer and then bury it." |
3336 |
(interactive) |
(interactive) |
3337 |
(set-buffer-modified-p t) |
(set-buffer-modified-p t) |
3338 |
(save-buffer) |
(save-buffer) |
3345 |
(interactive) |
(interactive) |
3346 |
(when (or (not (buffer-modified-p)) |
(when (or (not (buffer-modified-p)) |
3347 |
(yes-or-no-p "Message modified; kill anyway? ")) |
(yes-or-no-p "Message modified; kill anyway? ")) |
3348 |
(let ((actions message-kill-actions)) |
(let ((actions message-kill-actions) |
3349 |
|
(draft-article message-draft-article) |
3350 |
|
(auto-save-file-name buffer-auto-save-file-name) |
3351 |
|
(file-name buffer-file-name) |
3352 |
|
(modified (buffer-modified-p))) |
3353 |
(setq buffer-file-name nil) |
(setq buffer-file-name nil) |
3354 |
(kill-buffer (current-buffer)) |
(kill-buffer (current-buffer)) |
3355 |
|
(when (and (or (and auto-save-file-name |
3356 |
|
(file-exists-p auto-save-file-name)) |
3357 |
|
(and file-name |
3358 |
|
(file-exists-p file-name))) |
3359 |
|
(yes-or-no-p (format "Remove the backup file%s? " |
3360 |
|
(if modified " too" "")))) |
3361 |
|
(ignore-errors |
3362 |
|
(delete-file auto-save-file-name)) |
3363 |
|
(let ((message-draft-article draft-article)) |
3364 |
|
(message-disassociate-draft))) |
3365 |
(message-do-actions actions)))) |
(message-do-actions actions)))) |
3366 |
|
|
3367 |
(defun message-bury (buffer) |
(defun message-bury (buffer) |
3392 |
(message message-sending-message) |
(message message-sending-message) |
3393 |
(let ((alist message-send-method-alist) |
(let ((alist message-send-method-alist) |
3394 |
(success t) |
(success t) |
3395 |
elem sent) |
elem sent dont-barf-on-no-method |
3396 |
|
(message-options message-options)) |
3397 |
|
(message-options-set-recipient) |
3398 |
(while (and success |
(while (and success |
3399 |
(setq elem (pop alist))) |
(setq elem (pop alist))) |
3400 |
(when (funcall (cadr elem)) |
(when (funcall (cadr elem)) |
3401 |
(when (and (or (not (memq (car elem) |
(when (and (or (not (memq (car elem) |
3402 |
message-sent-message-via)) |
message-sent-message-via)) |
3403 |
(y-or-n-p |
(message-fetch-field "supersedes") |
3404 |
(format |
(if (or (message-gnksa-enable-p 'multiple-copies) |
3405 |
"Already sent message via %s; resend? " |
(not (eq (car elem) 'news))) |
3406 |
(car elem)))) |
(y-or-n-p |
3407 |
|
(format |
3408 |
|
"Already sent message via %s; resend? " |
3409 |
|
(car elem))) |
3410 |
|
(error "Denied posting -- multiple copies"))) |
3411 |
(setq success (funcall (caddr elem) arg))) |
(setq success (funcall (caddr elem) arg))) |
3412 |
(setq sent t)))) |
(setq sent t)))) |
3413 |
(unless (or sent (not success)) |
(unless (or sent |
3414 |
|
(not success) |
3415 |
|
(let ((fcc (message-fetch-field "Fcc")) |
3416 |
|
(gcc (message-fetch-field "Gcc"))) |
3417 |
|
(when (or fcc gcc) |
3418 |
|
(or (eq message-allow-no-recipients 'always) |
3419 |
|
(and (not (eq message-allow-no-recipients 'never)) |
3420 |
|
(setq dont-barf-on-no-method |
3421 |
|
(gnus-y-or-n-p |
3422 |
|
(format "No receiver, perform %s anyway? " |
3423 |
|
(cond ((and fcc gcc) "Fcc and Gcc") |
3424 |
|
(fcc "Fcc") |
3425 |
|
(t "Gcc")))))))))) |
3426 |
(error "No methods specified to send by")) |
(error "No methods specified to send by")) |
3427 |
(when (and success sent) |
(when (or dont-barf-on-no-method |
3428 |
|
(and success sent)) |
3429 |
(message-do-fcc) |
(message-do-fcc) |
3430 |
(save-excursion |
(save-excursion |
3431 |
(run-hooks 'message-sent-hook)) |
(run-hooks 'message-sent-hook)) |
3457 |
(put 'message-check 'lisp-indent-function 1) |
(put 'message-check 'lisp-indent-function 1) |
3458 |
(put 'message-check 'edebug-form-spec '(form body)) |
(put 'message-check 'edebug-form-spec '(form body)) |
3459 |
|
|
3460 |
|
(defun message-text-with-property (prop) |
3461 |
|
"Return a list of all points where the text has PROP." |
3462 |
|
(let ((points nil) |
3463 |
|
(point (point-min))) |
3464 |
|
(save-excursion |
3465 |
|
(while (< point (point-max)) |
3466 |
|
(when (get-text-property point prop) |
3467 |
|
(push point points)) |
3468 |
|
(incf point))) |
3469 |
|
(nreverse points))) |
3470 |
|
|
3471 |
(defun message-fix-before-sending () |
(defun message-fix-before-sending () |
3472 |
"Do various things to make the message nice before sending it." |
"Do various things to make the message nice before sending it." |
3473 |
;; Make sure there's a newline at the end of the message. |
;; Make sure there's a newline at the end of the message. |
3474 |
(goto-char (point-max)) |
(goto-char (point-max)) |
3475 |
(unless (bolp) |
(unless (bolp) |
3476 |
(insert "\n")) |
(insert "\n")) |
3477 |
;; Delete all invisible text. |
;; Make the hidden headers visible. |
3478 |
|
(let ((points (message-text-with-property 'message-hidden))) |
3479 |
|
(when points |
3480 |
|
(goto-char (car points)) |
3481 |
|
(dolist (point points) |
3482 |
|
(add-text-properties point (1+ point) |
3483 |
|
'(invisible nil intangible nil))))) |
3484 |
|
;; Make invisible text visible. |
3485 |
|
;; It doesn't seem as if this is useful, since the invisible property |
3486 |
|
;; is clobbered by an after-change hook anyhow. |
3487 |
(message-check 'invisible-text |
(message-check 'invisible-text |
3488 |
(when (text-property-any (point-min) (point-max) 'invisible t) |
(let ((points (message-text-with-property 'invisible))) |
3489 |
(put-text-property (point-min) (point-max) 'invisible nil) |
(when points |
3490 |
(unless (yes-or-no-p |
(goto-char (car points)) |
3491 |
"Invisible text found and made visible; continue posting? ") |
(dolist (point points) |
3492 |
(error "Invisible text found and made visible"))))) |
(put-text-property point (1+ point) 'invisible nil) |
3493 |
|
(message-overlay-put (message-make-overlay point (1+ point)) |
3494 |
|
'face 'highlight)) |
3495 |
|
(unless (yes-or-no-p |
3496 |
|
"Invisible text found and made visible; continue sending? ") |
3497 |
|
(error "Invisible text found and made visible"))))) |
3498 |
|
(message-check 'illegible-text |
3499 |
|
(let (found choice) |
3500 |
|
(message-goto-body) |
3501 |
|
(skip-chars-forward mm-7bit-chars) |
3502 |
|
(while (not (eobp)) |
3503 |
|
(when (let ((char (char-after))) |
3504 |
|
(or (< (mm-char-int char) 128) |
3505 |
|
(and (mm-multibyte-p) |
3506 |
|
(memq (char-charset char) |
3507 |
|
'(eight-bit-control eight-bit-graphic |
3508 |
|
control-1)) |
3509 |
|
(not (get-text-property |
3510 |
|
(point) 'untranslated-utf-8))))) |
3511 |
|
(message-overlay-put (message-make-overlay (point) (1+ (point))) |
3512 |
|
'face 'highlight) |
3513 |
|
(setq found t)) |
3514 |
|
(forward-char) |
3515 |
|
(skip-chars-forward mm-7bit-chars)) |
3516 |
|
(when found |
3517 |
|
(setq choice |
3518 |
|
(gnus-multiple-choice |
3519 |
|
"Non-printable characters found. Continue sending?" |
3520 |
|
'((?d "Remove non-printable characters and send") |
3521 |
|
(?r "Replace non-printable characters with dots and send") |
3522 |
|
(?i "Ignore non-printable characters and send") |
3523 |
|
(?e "Continue editing")))) |
3524 |
|
(if (eq choice ?e) |
3525 |
|
(error "Non-printable characters")) |
3526 |
|
(message-goto-body) |
3527 |
|
(skip-chars-forward mm-7bit-chars) |
3528 |
|
(while (not (eobp)) |
3529 |
|
(when (let ((char (char-after))) |
3530 |
|
(or (< (mm-char-int char) 128) |
3531 |
|
(and (mm-multibyte-p) |
3532 |
|
;; Fixme: Wrong for Emacs 22 and for things |
3533 |
|
;; like undecable utf-8. Should at least |
3534 |
|
;; use find-coding-systems-region. |
3535 |
|
(memq (char-charset char) |
3536 |
|
'(eight-bit-control eight-bit-graphic |
3537 |
|
control-1)) |
3538 |
|
(not (get-text-property |
3539 |
|
(point) 'untranslated-utf-8))))) |
3540 |
|
(if (eq choice ?i) |
3541 |
|
(message-kill-all-overlays) |
3542 |
|
(delete-char 1) |
3543 |
|
(when (eq choice ?r) |
3544 |
|
(insert ".")))) |
3545 |
|
(forward-char) |
3546 |
|
(skip-chars-forward mm-7bit-chars)))))) |
3547 |
|
|
3548 |
(defun message-add-action (action &rest types) |
(defun message-add-action (action &rest types) |
3549 |
"Add ACTION to be performed when doing an exit of type TYPES." |
"Add ACTION to be performed when doing an exit of type TYPES." |
3550 |
|
(while types |
3551 |
|
(add-to-list (intern (format "message-%s-actions" (pop types))) |
3552 |
|
action))) |
3553 |
|
|
3554 |
|
(defun message-delete-action (action &rest types) |
3555 |
|
"Delete ACTION from lists of actions performed when doing an exit of type TYPES." |
3556 |
(let (var) |
(let (var) |
3557 |
(while types |
(while types |
3558 |
(set (setq var (intern (format "message-%s-actions" (pop types)))) |
(set (setq var (intern (format "message-%s-actions" (pop types)))) |
3559 |
(nconc (symbol-value var) (list action)))))) |
(delq action (symbol-value var)))))) |
3560 |
|
|
3561 |
(defun message-do-actions (actions) |
(defun message-do-actions (actions) |
3562 |
"Perform all actions in ACTIONS." |
"Perform all actions in ACTIONS." |
3565 |
(ignore-errors |
(ignore-errors |
3566 |
(cond |
(cond |
3567 |
;; A simple function. |
;; A simple function. |
3568 |
((message-functionp (car actions)) |
((functionp (car actions)) |
3569 |
(funcall (car actions))) |
(funcall (car actions))) |
3570 |
;; Something to be evaled. |
;; Something to be evaled. |
3571 |
(t |
(t |
3573 |
(pop actions))) |
(pop actions))) |
3574 |
|
|
3575 |
(defun message-send-mail-partially () |
(defun message-send-mail-partially () |
3576 |
"Sendmail as message/partial." |
"Send mail as message/partial." |
3577 |
;; replace the header delimiter with a blank line |
;; replace the header delimiter with a blank line |
3578 |
(goto-char (point-min)) |
(goto-char (point-min)) |
3579 |
(re-search-forward |
(re-search-forward |
3621 |
(message-remove-header "Lines") |
(message-remove-header "Lines") |
3622 |
(goto-char (point-max)) |
(goto-char (point-max)) |
3623 |
(insert "Mime-Version: 1.0\n") |
(insert "Mime-Version: 1.0\n") |
3624 |
(setq header (buffer-substring (point-min) (point-max)))) |
(setq header (buffer-string))) |
3625 |
(goto-char (point-max)) |
(goto-char (point-max)) |
3626 |
(insert (format "Content-Type: message/partial; id=\"%s\"; number=%d; total=%d\n" |
(insert (format "Content-Type: message/partial; id=\"%s\"; number=%d; total=%d\n\n" |
3627 |
id n total)) |
id n total)) |
3628 |
|
(forward-char -1) |
3629 |
(let ((mail-header-separator "")) |
(let ((mail-header-separator "")) |
3630 |
(when (memq 'Message-ID message-required-mail-headers) |
(when (memq 'Message-ID message-required-mail-headers) |
3631 |
(insert "Message-ID: " (message-make-message-id) "\n")) |
(insert "Message-ID: " (message-make-message-id) "\n")) |
3632 |
(when (memq 'Lines message-required-mail-headers) |
(when (memq 'Lines message-required-mail-headers) |
3633 |
(let ((mail-header-separator "")) |
(insert "Lines: " (message-make-lines) "\n")) |
|
(insert "Lines: " (message-make-lines) "\n"))) |
|
3634 |
(message-goto-subject) |
(message-goto-subject) |
3635 |
(end-of-line) |
(end-of-line) |
3636 |
(insert (format " (%d/%d)" n total)) |
(insert (format " (%d/%d)" n total)) |
|
(goto-char (point-max)) |
|
|
(insert "\n") |
|
3637 |
(widen) |
(widen) |
3638 |
(mm-with-unibyte-current-buffer |
(mm-with-unibyte-current-buffer |
3639 |
(funcall message-send-mail-function))) |
(funcall (or message-send-mail-real-function |
3640 |
|
message-send-mail-function)))) |
3641 |
(setq n (+ n 1)) |
(setq n (+ n 1)) |
3642 |
(setq p (pop plist)) |
(setq p (pop plist)) |
3643 |
(erase-buffer))) |
(erase-buffer))) |
3653 |
(message-posting-charset |
(message-posting-charset |
3654 |
(if (fboundp 'gnus-setup-posting-charset) |
(if (fboundp 'gnus-setup-posting-charset) |
3655 |
(gnus-setup-posting-charset nil) |
(gnus-setup-posting-charset nil) |
3656 |
message-posting-charset))) |
message-posting-charset)) |
3657 |
|
(headers message-required-mail-headers)) |
3658 |
(save-restriction |
(save-restriction |
3659 |
(message-narrow-to-headers) |
(message-narrow-to-headers) |
3660 |
|
;; Generate the Mail-Followup-To header if the header is not there... |
3661 |
|
(if (and (message-subscribed-p) |
3662 |
|
(not (mail-fetch-field "mail-followup-to"))) |
3663 |
|
(setq headers |
3664 |
|
(cons |
3665 |
|
(cons "Mail-Followup-To" (message-make-mail-followup-to)) |
3666 |
|
message-required-mail-headers)) |
3667 |
|
;; otherwise, delete the MFT header if the field is empty |
3668 |
|
(when (equal "" (mail-fetch-field "mail-followup-to")) |
3669 |
|
(message-remove-header "^Mail-Followup-To:"))) |
3670 |
;; Insert some headers. |
;; Insert some headers. |
3671 |
(let ((message-deletable-headers |
(let ((message-deletable-headers |
3672 |
(if news nil message-deletable-headers))) |
(if news nil message-deletable-headers))) |
3673 |
(message-generate-headers message-required-mail-headers)) |
(message-generate-headers headers)) |
3674 |
;; Let the user do all of the above. |
;; Let the user do all of the above. |
3675 |
(run-hooks 'message-header-hook)) |
(run-hooks 'message-header-hook)) |
3676 |
(unwind-protect |
(unwind-protect |
3677 |
(save-excursion |
(save-excursion |
3678 |
(set-buffer tembuf) |
(set-buffer tembuf) |
3679 |
(erase-buffer) |
(erase-buffer) |
3680 |
;; Avoid copying text props. |
;; Avoid copying text props (except hard newlines). |
3681 |
(insert (with-current-buffer mailbuf |
(insert (with-current-buffer mailbuf |
3682 |
(buffer-substring-no-properties (point-min) (point-max)))) |
(mml-buffer-substring-no-properties-except-hard-newlines |
3683 |
|
(point-min) (point-max)))) |
3684 |
;; Remove some headers. |
;; Remove some headers. |
3685 |
(message-encode-message-body) |
(message-encode-message-body) |
3686 |
(save-restriction |
(save-restriction |
3696 |
;; require one newline at the end. |
;; require one newline at the end. |
3697 |
(or (= (preceding-char) ?\n) |
(or (= (preceding-char) ?\n) |
3698 |
(insert ?\n)) |
(insert ?\n)) |
3699 |
|
(message-cleanup-headers) |
3700 |
|
;; FIXME: we're inserting the courtesy copy after encoding. |
3701 |
|
;; This is wrong if the courtesy copy string contains |
3702 |
|
;; non-ASCII characters. -- jh |
3703 |
(when |
(when |
3704 |
(save-restriction |
(save-restriction |
3705 |
(message-narrow-to-headers) |
(message-narrow-to-headers) |
3706 |
(and news |
(and news |
3707 |
(or (message-fetch-field "cc") |
(or (message-fetch-field "cc") |
3708 |
|
(message-fetch-field "bcc") |
3709 |
(message-fetch-field "to")) |
(message-fetch-field "to")) |
3710 |
(let ((content-type (message-fetch-field "content-type"))) |
(let ((content-type (message-fetch-field |
3711 |
(or |
"content-type"))) |
3712 |
(not content-type) |
(and |
3713 |
(string= "text/plain" |
(or |
3714 |
(car |
(not content-type) |
3715 |
(mail-header-parse-content-type |
(string= "text/plain" |
3716 |
content-type))))))) |
(car |
3717 |
|
(mail-header-parse-content-type |
3718 |
|
content-type)))) |
3719 |
|
(not |
3720 |
|
(string= "base64" |
3721 |
|
(message-fetch-field |
3722 |
|
"content-transfer-encoding"))))))) |
3723 |
(message-insert-courtesy-copy)) |
(message-insert-courtesy-copy)) |
3724 |
(if (or (not message-send-mail-partially-limit) |
(if (or (not message-send-mail-partially-limit) |
3725 |
(< (point-max) message-send-mail-partially-limit) |
(< (buffer-size) message-send-mail-partially-limit) |
3726 |
(not (y-or-n-p "The message size is too large, should it be sent partially? "))) |
(not (message-y-or-n-p |
3727 |
|
"The message size is too large, split? " |
3728 |
|
t |
3729 |
|
"\ |
3730 |
|
The message size, " |
3731 |
|
(/ (buffer-size) 1000) "KB, is too large. |
3732 |
|
|
3733 |
|
Some mail gateways (MTA's) bounce large messages. To avoid the |
3734 |
|
problem, answer `y', and the message will be split into several |
3735 |
|
smaller pieces, the size of each is about " |
3736 |
|
(/ message-send-mail-partially-limit 1000) |
3737 |
|
"KB except the last |
3738 |
|
one. |
3739 |
|
|
3740 |
|
However, some mail readers (MUA's) can't read split messages, i.e., |
3741 |
|
mails in message/partially format. Answer `n', and the message will be |
3742 |
|
sent in one piece. |
3743 |
|
|
3744 |
|
The size limit is controlled by `message-send-mail-partially-limit'. |
3745 |
|
If you always want Gnus to send messages in one piece, set |
3746 |
|
`message-send-mail-partially-limit' to nil. |
3747 |
|
"))) |
3748 |
(mm-with-unibyte-current-buffer |
(mm-with-unibyte-current-buffer |
3749 |
(funcall message-send-mail-function)) |
(message "Sending via mail...") |
3750 |
|
(funcall (or message-send-mail-real-function |
3751 |
|
message-send-mail-function))) |
3752 |
(message-send-mail-partially))) |
(message-send-mail-partially))) |
3753 |
(kill-buffer tembuf)) |
(kill-buffer tembuf)) |
3754 |
(set-buffer mailbuf) |
(set-buffer mailbuf) |
3761 |
" sendmail errors") |
" sendmail errors") |
3762 |
0)) |
0)) |
3763 |
resend-to-addresses delimline) |
resend-to-addresses delimline) |
3764 |
(let ((case-fold-search t)) |
(unwind-protect |
3765 |
(save-restriction |
(progn |
3766 |
(message-narrow-to-headers) |
(let ((case-fold-search t)) |
3767 |
(setq resend-to-addresses (message-fetch-field "resent-to"))) |
(save-restriction |
3768 |
;; Change header-delimiter to be what sendmail expects. |
(message-narrow-to-headers) |
3769 |
(goto-char (point-min)) |
(setq resend-to-addresses (message-fetch-field "resent-to"))) |
3770 |
(re-search-forward |
;; Change header-delimiter to be what sendmail expects. |
3771 |
(concat "^" (regexp-quote mail-header-separator) "\n")) |
(goto-char (point-min)) |
3772 |
(replace-match "\n") |
(re-search-forward |
3773 |
(backward-char 1) |
(concat "^" (regexp-quote mail-header-separator) "\n")) |
3774 |
(setq delimline (point-marker)) |
(replace-match "\n") |
3775 |
(run-hooks 'message-send-mail-hook) |
(backward-char 1) |
3776 |
;; Insert an extra newline if we need it to work around |
(setq delimline (point-marker)) |
3777 |
;; Sun's bug that swallows newlines. |
(run-hooks 'message-send-mail-hook) |
3778 |
(goto-char (1+ delimline)) |
;; Insert an extra newline if we need it to work around |
3779 |
(when (eval message-mailer-swallows-blank-line) |
;; Sun's bug that swallows newlines. |
3780 |
(newline)) |
(goto-char (1+ delimline)) |
3781 |
(when message-interactive |
(when (eval message-mailer-swallows-blank-line) |
3782 |
(save-excursion |
(newline)) |
3783 |
(set-buffer errbuf) |
(when message-interactive |
3784 |
(erase-buffer)))) |
(save-excursion |
3785 |
(let ((default-directory "/") |
(set-buffer errbuf) |
3786 |
(coding-system-for-write message-send-coding-system)) |
(erase-buffer)))) |
3787 |
(apply 'call-process-region |
(let* ((default-directory "/") |
3788 |
(append (list (point-min) (point-max) |
(coding-system-for-write message-send-coding-system) |
3789 |
(if (boundp 'sendmail-program) |
(cpr (apply |
3790 |
sendmail-program |
'call-process-region |
3791 |
"/usr/lib/sendmail") |
(append |
3792 |
nil errbuf nil "-oi") |
(list (point-min) (point-max) |
3793 |
;; Always specify who from, |
(if (boundp 'sendmail-program) |
3794 |
;; since some systems have broken sendmails. |
sendmail-program |
3795 |
;; But some systems are more broken with -f, so |
"/usr/lib/sendmail") |
3796 |
;; we'll let users override this. |
nil errbuf nil "-oi") |
3797 |
(if (null message-sendmail-f-is-evil) |
;; Always specify who from, |
3798 |
(list "-f" (message-make-address))) |
;; since some systems have broken sendmails. |
3799 |
;; These mean "report errors by mail" |
;; But some systems are more broken with -f, so |
3800 |
;; and "deliver in background". |
;; we'll let users override this. |
3801 |
(if (null message-interactive) '("-oem" "-odb")) |
(if (null message-sendmail-f-is-evil) |
3802 |
;; Get the addresses from the message |
(list "-f" (message-sendmail-envelope-from))) |
3803 |
;; unless this is a resend. |
;; These mean "report errors by mail" |
3804 |
;; We must not do that for a resend |
;; and "deliver in background". |
3805 |
;; because we would find the original addresses. |
(if (null message-interactive) '("-oem" "-odb")) |
3806 |
;; For a resend, include the specific addresses. |
;; Get the addresses from the message |
3807 |
(if resend-to-addresses |
;; unless this is a resend. |
3808 |
(list resend-to-addresses) |
;; We must not do that for a resend |
3809 |
'("-t"))))) |
;; because we would find the original addresses. |
3810 |
(when message-interactive |
;; For a resend, include the specific addresses. |
3811 |
(save-excursion |
(if resend-to-addresses |
3812 |
(set-buffer errbuf) |
(list resend-to-addresses) |
3813 |
(goto-char (point-min)) |
'("-t")))))) |
3814 |
(while (re-search-forward "\n\n* *" nil t) |
(unless (or (null cpr) (and (numberp cpr) (zerop cpr))) |
3815 |
(replace-match "; ")) |
(error "Sending...failed with exit value %d" cpr))) |
3816 |
(if (not (zerop (buffer-size))) |
(when message-interactive |
3817 |
(error "Sending...failed to %s" |
(save-excursion |
3818 |
(buffer-substring (point-min) (point-max))))) |
(set-buffer errbuf) |
3819 |
|
(goto-char (point-min)) |
3820 |
|
(while (re-search-forward "\n\n* *" nil t) |
3821 |
|
(replace-match "; ")) |
3822 |
|
(if (not (zerop (buffer-size))) |
3823 |
|
(error "Sending...failed to %s" |
3824 |
|
(buffer-string)))))) |
3825 |
(when (bufferp errbuf) |
(when (bufferp errbuf) |
3826 |
(kill-buffer errbuf))))) |
(kill-buffer errbuf))))) |
3827 |
|
|
3839 |
(case |
(case |
3840 |
(let ((coding-system-for-write message-send-coding-system)) |
(let ((coding-system-for-write message-send-coding-system)) |
3841 |
(apply |
(apply |
3842 |
'call-process-region 1 (point-max) message-qmail-inject-program |
'call-process-region (point-min) (point-max) |
3843 |
nil nil nil |
message-qmail-inject-program nil nil nil |
3844 |
;; qmail-inject's default behaviour is to look for addresses on the |
;; qmail-inject's default behaviour is to look for addresses on the |
3845 |
;; command line; if there're none, it scans the headers. |
;; command line; if there're none, it scans the headers. |
3846 |
;; yes, it does The Right Thing w.r.t. Resent-To and it's kin. |
;; yes, it does The Right Thing w.r.t. Resent-To and it's kin. |
3858 |
;; free for -inject-arguments -- a big win for the user and for us |
;; free for -inject-arguments -- a big win for the user and for us |
3859 |
;; since we don't have to play that double-guessing game and the user |
;; since we don't have to play that double-guessing game and the user |
3860 |
;; gets full control (no gestapo'ish -f's, for instance). --sj |
;; gets full control (no gestapo'ish -f's, for instance). --sj |
3861 |
message-qmail-inject-args)) |
(if (functionp message-qmail-inject-args) |
3862 |
|
(funcall message-qmail-inject-args) |
3863 |
|
message-qmail-inject-args))) |
3864 |
;; qmail-inject doesn't say anything on it's stdout/stderr, |
;; qmail-inject doesn't say anything on it's stdout/stderr, |
3865 |
;; we have to look at the retval instead |
;; we have to look at the retval instead |
3866 |
(0 nil) |
(0 nil) |
3867 |
(1 (error "qmail-inject reported permanent failure")) |
(100 (error "qmail-inject reported permanent failure")) |
3868 |
(111 (error "qmail-inject reported transient failure")) |
(111 (error "qmail-inject reported transient failure")) |
3869 |
;; should never happen |
;; should never happen |
3870 |
(t (error "qmail-inject reported unknown failure")))) |
(t (error "qmail-inject reported unknown failure")))) |
3887 |
;; Pass it on to mh. |
;; Pass it on to mh. |
3888 |
(mh-send-letter))) |
(mh-send-letter))) |
3889 |
|
|
3890 |
|
(defun message-smtpmail-send-it () |
3891 |
|
"Send the prepared message buffer with `smtpmail-send-it'. |
3892 |
|
This only differs from `smtpmail-send-it' that this command evaluates |
3893 |
|
`message-send-mail-hook' just before sending a message. It is useful |
3894 |
|
if your ISP requires the POP-before-SMTP authentication. See the Gnus |
3895 |
|
manual for details." |
3896 |
|
(run-hooks 'message-send-mail-hook) |
3897 |
|
(smtpmail-send-it)) |
3898 |
|
|
3899 |
|
(defun message-canlock-generate () |
3900 |
|
"Return a string that is non-trivial to guess. |
3901 |
|
Do not use this for anything important, it is cryptographically weak." |
3902 |
|
(require 'sha1) |
3903 |
|
(let (sha1-maximum-internal-length) |
3904 |
|
(sha1 (concat (message-unique-id) |
3905 |
|
(format "%x%x%x" (random) (random t) (random)) |
3906 |
|
(prin1-to-string (recent-keys)) |
3907 |
|
(prin1-to-string (garbage-collect)))))) |
3908 |
|
|
3909 |
|
(defun message-canlock-password () |
3910 |
|
"The password used by message for cancel locks. |
3911 |
|
This is the value of `canlock-password', if that option is non-nil. |
3912 |
|
Otherwise, generate and save a value for `canlock-password' first." |
3913 |
|
(unless canlock-password |
3914 |
|
(customize-save-variable 'canlock-password (message-canlock-generate)) |
3915 |
|
(setq canlock-password-for-verify canlock-password)) |
3916 |
|
canlock-password) |
3917 |
|
|
3918 |
|
(defun message-insert-canlock () |
3919 |
|
(when message-insert-canlock |
3920 |
|
(message-canlock-password) |
3921 |
|
(canlock-insert-header))) |
3922 |
|
|
3923 |
(defun message-send-news (&optional arg) |
(defun message-send-news (&optional arg) |
3924 |
(let* ((tembuf (message-generate-new-buffer-clone-locals " *message temp*")) |
(let* ((tembuf (message-generate-new-buffer-clone-locals " *message temp*")) |
3925 |
(case-fold-search nil) |
(case-fold-search nil) |
3926 |
(method (if (message-functionp message-post-method) |
(method (if (functionp message-post-method) |
3927 |
(funcall message-post-method arg) |
(funcall message-post-method arg) |
3928 |
message-post-method)) |
message-post-method)) |
3929 |
(group-name-charset (gnus-group-name-charset method "")) |
(newsgroups-field (save-restriction |
3930 |
|
(message-narrow-to-headers-or-head) |
3931 |
|
(message-fetch-field "Newsgroups"))) |
3932 |
|
(followup-field (save-restriction |
3933 |
|
(message-narrow-to-headers-or-head) |
3934 |
|
(message-fetch-field "Followup-To"))) |
3935 |
|
;; BUG: We really need to get the charset for each name in the |
3936 |
|
;; Newsgroups and Followup-To lines to allow crossposting |
3937 |
|
;; between group namess with incompatible character sets. |
3938 |
|
;; -- Per Abrahamsen <abraham@dina.kvl.dk> 2001-10-08. |
3939 |
|
(group-field-charset |
3940 |
|
(gnus-group-name-charset method newsgroups-field)) |
3941 |
|
(followup-field-charset |
3942 |
|
(gnus-group-name-charset method (or followup-field ""))) |
3943 |
(rfc2047-header-encoding-alist |
(rfc2047-header-encoding-alist |
3944 |
(if group-name-charset |
(append (when group-field-charset |
3945 |
(cons (cons "Newsgroups" group-name-charset) |
(list (cons "Newsgroups" group-field-charset))) |
3946 |
rfc2047-header-encoding-alist) |
(when followup-field-charset |
3947 |
rfc2047-header-encoding-alist)) |
(list (cons "Followup-To" followup-field-charset))) |
3948 |
|
rfc2047-header-encoding-alist)) |
3949 |
(messbuf (current-buffer)) |
(messbuf (current-buffer)) |
3950 |
(message-syntax-checks |
(message-syntax-checks |
3951 |
(if arg |
(if (and arg |
3952 |
|
(listp message-syntax-checks)) |
3953 |
(cons '(existing-newsgroups . disabled) |
(cons '(existing-newsgroups . disabled) |
3954 |
message-syntax-checks) |
message-syntax-checks) |
3955 |
message-syntax-checks)) |
message-syntax-checks)) |
3956 |
(message-this-is-news t) |
(message-this-is-news t) |
3957 |
(message-posting-charset (gnus-setup-posting-charset |
(message-posting-charset |
3958 |
(save-restriction |
(gnus-setup-posting-charset newsgroups-field)) |
|
(message-narrow-to-headers-or-head) |
|
|
(message-fetch-field "Newsgroups")))) |
|
3959 |
result) |
result) |
3960 |
(if (not (message-check-news-body-syntax)) |
(if (not (message-check-news-body-syntax)) |
3961 |
nil |
nil |
3963 |
(message-narrow-to-headers) |
(message-narrow-to-headers) |
3964 |
;; Insert some headers. |
;; Insert some headers. |
3965 |
(message-generate-headers message-required-news-headers) |
(message-generate-headers message-required-news-headers) |
3966 |
|
(message-insert-canlock) |
3967 |
;; Let the user do all of the above. |
;; Let the user do all of the above. |
3968 |
(run-hooks 'message-header-hook)) |
(run-hooks 'message-header-hook)) |
3969 |
(if group-name-charset |
;; Note: This check will be disabled by the ".*" default value for |
3970 |
(setq message-syntax-checks |
;; gnus-group-name-charset-group-alist. -- Pa 2001-10-07. |
3971 |
|
(when (and group-field-charset |
3972 |
|
(listp message-syntax-checks)) |
3973 |
|
(setq message-syntax-checks |
3974 |
(cons '(valid-newsgroups . disabled) |
(cons '(valid-newsgroups . disabled) |
3975 |
message-syntax-checks))) |
message-syntax-checks))) |
3976 |
(message-cleanup-headers) |
(message-cleanup-headers) |
3977 |
(if (not (message-check-news-syntax)) |
(if (not (let ((message-post-method method)) |
3978 |
|
(message-check-news-syntax))) |
3979 |
nil |
nil |
3980 |
(unwind-protect |
(unwind-protect |
3981 |
(save-excursion |
(save-excursion |
3982 |
(set-buffer tembuf) |
(set-buffer tembuf) |
3983 |
(buffer-disable-undo) |
(buffer-disable-undo) |
3984 |
(erase-buffer) |
(erase-buffer) |
3985 |
;; Avoid copying text props. |
;; Avoid copying text props (except hard newlines). |
3986 |
(insert (with-current-buffer messbuf |
(insert |
3987 |
(buffer-substring-no-properties |
(with-current-buffer messbuf |
3988 |
(point-min) (point-max)))) |
(mml-buffer-substring-no-properties-except-hard-newlines |
3989 |
|
(point-min) (point-max)))) |
3990 |
(message-encode-message-body) |
(message-encode-message-body) |
3991 |
;; Remove some headers. |
;; Remove some headers. |
3992 |
(save-restriction |
(save-restriction |
4011 |
(backward-char 1)) |
(backward-char 1)) |
4012 |
(run-hooks 'message-send-news-hook) |
(run-hooks 'message-send-news-hook) |
4013 |
(gnus-open-server method) |
(gnus-open-server method) |
4014 |
|
(message "Sending news via %s..." (gnus-server-string method)) |
4015 |
(setq result (let ((mail-header-separator "")) |
(setq result (let ((mail-header-separator "")) |
4016 |
(gnus-request-post method)))) |
(gnus-request-post method)))) |
4017 |
(kill-buffer tembuf)) |
(kill-buffer tembuf)) |
4072 |
(y-or-n-p |
(y-or-n-p |
4073 |
"The control code \"cmsg\" is in the subject. Really post? ") |
"The control code \"cmsg\" is in the subject. Really post? ") |
4074 |
t)) |
t)) |
4075 |
|
;; Check long header lines. |
4076 |
|
(message-check 'long-header-lines |
4077 |
|
(let ((start (point)) |
4078 |
|
(header nil) |
4079 |
|
(length 0) |
4080 |
|
found) |
4081 |
|
(while (and (not found) |
4082 |
|
(re-search-forward "^\\([^ \t:]+\\): " nil t)) |
4083 |
|
(if (> (- (point) (match-beginning 0)) 998) |
4084 |
|
(setq found t |
4085 |
|
length (- (point) (match-beginning 0))) |
4086 |
|
(setq header (match-string-no-properties 1))) |
4087 |
|
(setq start (match-beginning 0)) |
4088 |
|
(forward-line 1)) |
4089 |
|
(if found |
4090 |
|
(y-or-n-p (format "Your %s header is too long (%d). Really post? " |
4091 |
|
header length)) |
4092 |
|
t))) |
4093 |
;; Check for multiple identical headers. |
;; Check for multiple identical headers. |
4094 |
(message-check 'multiple-headers |
(message-check 'multiple-headers |
4095 |
(let (found) |
(let (found) |
4128 |
(zerop |
(zerop |
4129 |
(length |
(length |
4130 |
(setq to (completing-read |
(setq to (completing-read |
4131 |
"Followups to: (default all groups) " |
"Followups to (default: no Followup-To header) " |
4132 |
(mapcar (lambda (g) (list g)) |
(mapcar #'list |
4133 |
(cons "poster" |
(cons "poster" |
4134 |
(message-tokenize-header |
(message-tokenize-header |
4135 |
newsgroups))))))))) |
newsgroups))))))))) |
4139 |
;; Check "Shoot me". |
;; Check "Shoot me". |
4140 |
(message-check 'shoot |
(message-check 'shoot |
4141 |
(if (re-search-forward |
(if (re-search-forward |
4142 |
"Message-ID.*.i-did-not-set--mail-host-address--so-shoot-me" nil t) |
"Message-ID.*.i-did-not-set--mail-host-address--so-tickle-me" nil t) |
4143 |
(y-or-n-p "You appear to have a misconfigured system. Really post? ") |
(y-or-n-p "You appear to have a misconfigured system. Really post? ") |
4144 |
t)) |
t)) |
4145 |
;; Check for Approved. |
;; Check for Approved. |
4170 |
(if followup-to |
(if followup-to |
4171 |
(concat newsgroups "," followup-to) |
(concat newsgroups "," followup-to) |
4172 |
newsgroups))) |
newsgroups))) |
4173 |
(hashtb (and (boundp 'gnus-active-hashtb) |
(post-method (if (functionp message-post-method) |
4174 |
gnus-active-hashtb)) |
(funcall message-post-method) |
4175 |
|
message-post-method)) |
4176 |
|
;; KLUDGE to handle nnvirtual groups. Doing this right |
4177 |
|
;; would probably involve a new nnoo function. |
4178 |
|
;; -- Per Abrahamsen <abraham@dina.kvl.dk>, 2001-10-17. |
4179 |
|
(method (if (and (consp post-method) |
4180 |
|
(eq (car post-method) 'nnvirtual) |
4181 |
|
gnus-message-group-art) |
4182 |
|
(let ((group (car (nnvirtual-find-group-art |
4183 |
|
(car gnus-message-group-art) |
4184 |
|
(cdr gnus-message-group-art))))) |
4185 |
|
(gnus-find-method-for-group group)) |
4186 |
|
post-method)) |
4187 |
|
(known-groups |
4188 |
|
(mapcar (lambda (n) |
4189 |
|
(gnus-group-name-decode |
4190 |
|
(gnus-group-real-name n) |
4191 |
|
(gnus-group-name-charset method n))) |
4192 |
|
(gnus-groups-from-server method))) |
4193 |
errors) |
errors) |
4194 |
(if (or (not hashtb) |
(while groups |
4195 |
(not (boundp 'gnus-read-active-file)) |
(when (and (not (equal (car groups) "poster")) |
4196 |
(not gnus-read-active-file) |
(not (member (car groups) known-groups)) |
4197 |
(eq gnus-read-active-file 'some)) |
(not (member (car groups) errors))) |
4198 |
t |
(push (car groups) errors)) |
4199 |
(while groups |
(pop groups)) |
4200 |
(when (and (not (boundp (intern (car groups) hashtb))) |
(cond |
4201 |
(not (equal (car groups) "poster"))) |
;; Gnus is not running. |
4202 |
(push (car groups) errors)) |
((or (not (and (boundp 'gnus-active-hashtb) |
4203 |
(pop groups)) |
gnus-active-hashtb)) |
4204 |
(if (not errors) |
(not (boundp 'gnus-read-active-file))) |
4205 |
t |
t) |
4206 |
(y-or-n-p |
;; We don't have all the group names. |
4207 |
(format |
((and (or (not gnus-read-active-file) |
4208 |
"Really post to %s unknown group%s: %s? " |
(eq gnus-read-active-file 'some)) |
4209 |
(if (= (length errors) 1) "this" "these") |
errors) |
4210 |
(if (= (length errors) 1) "" "s") |
(y-or-n-p |
4211 |
(mapconcat 'identity errors ", "))))))) |
(format |
4212 |
|
"Really use %s possibly unknown group%s: %s? " |
4213 |
|
(if (= (length errors) 1) "this" "these") |
4214 |
|
(if (= (length errors) 1) "" "s") |
4215 |
|
(mapconcat 'identity errors ", ")))) |
4216 |
|
;; There were no errors. |
4217 |
|
((not errors) |
4218 |
|
t) |
4219 |
|
;; There are unknown groups. |
4220 |
|
(t |
4221 |
|
(y-or-n-p |
4222 |
|
(format |
4223 |
|
"Really post to %s unknown group%s: %s? " |
4224 |
|
(if (= (length errors) 1) "this" "these") |
4225 |
|
(if (= (length errors) 1) "" "s") |
4226 |
|
(mapconcat 'identity errors ", "))))))) |
4227 |
|
;; Check continuation headers. |
4228 |
|
(message-check 'continuation-headers |
4229 |
|
(goto-char (point-min)) |
4230 |
|
(let ((do-posting t)) |
4231 |
|
(while (re-search-forward "^[^ \t\n][^:\n]*$" nil t) |
4232 |
|
(if (y-or-n-p "Fix continuation lines? ") |
4233 |
|
(progn |
4234 |
|
(goto-char (match-beginning 0)) |
4235 |
|
(insert " ")) |
4236 |
|
(unless (y-or-n-p "Send anyway? ") |
4237 |
|
(setq do-posting nil)))) |
4238 |
|
do-posting)) |
4239 |
;; Check the Newsgroups & Followup-To headers for syntax errors. |
;; Check the Newsgroups & Followup-To headers for syntax errors. |
4240 |
(message-check 'valid-newsgroups |
(message-check 'valid-newsgroups |
4241 |
(let ((case-fold-search t) |
(let ((case-fold-search t) |
4290 |
"@[^\\.]*\\." |
"@[^\\.]*\\." |
4291 |
(setq ad (nth 1 (mail-extract-address-components |
(setq ad (nth 1 (mail-extract-address-components |
4292 |
from))))) ;larsi@ifi |
from))))) ;larsi@ifi |
4293 |
(string-match "\\.\\." ad) ;larsi@ifi..uio |
(string-match "\\.\\." ad) ;larsi@ifi..uio |
4294 |
(string-match "@\\." ad) ;larsi@.ifi.uio |
(string-match "@\\." ad) ;larsi@.ifi.uio |
4295 |
(string-match "\\.$" ad) ;larsi@ifi.uio. |
(string-match "\\.$" ad) ;larsi@ifi.uio. |
4296 |
(not (string-match "^[^@]+@[^@]+$" ad)) ;larsi.ifi.uio |
(not (string-match "^[^@]+@[^@]+$" ad)) ;larsi.ifi.uio |
4298 |
(message |
(message |
4299 |
"Denied posting -- the From looks strange: \"%s\"." from) |
"Denied posting -- the From looks strange: \"%s\"." from) |
4300 |
nil) |
nil) |
4301 |
|
((let ((addresses (rfc822-addresses from))) |
4302 |
|
(while (and addresses |
4303 |
|
(not (eq (string-to-char (car addresses)) ?\())) |
4304 |
|
(setq addresses (cdr addresses))) |
4305 |
|
addresses) |
4306 |
|
(message |
4307 |
|
"Denied posting -- bad From address: \"%s\"." from) |
4308 |
|
nil) |
4309 |
|
(t t)))) |
4310 |
|
;; Check the Reply-To header. |
4311 |
|
(message-check 'reply-to |
4312 |
|
(let* ((case-fold-search t) |
4313 |
|
(reply-to (message-fetch-field "reply-to")) |
4314 |
|
ad) |
4315 |
|
(cond |
4316 |
|
((not reply-to) |
4317 |
|
t) |
4318 |
|
((string-match "," reply-to) |
4319 |
|
(y-or-n-p |
4320 |
|
(format "Multiple Reply-To addresses: \"%s\". Really post? " |
4321 |
|
reply-to))) |
4322 |
|
((or (not (string-match |
4323 |
|
"@[^\\.]*\\." |
4324 |
|
(setq ad (nth 1 (mail-extract-address-components |
4325 |
|
reply-to))))) ;larsi@ifi |
4326 |
|
(string-match "\\.\\." ad) ;larsi@ifi..uio |
4327 |
|
(string-match "@\\." ad) ;larsi@.ifi.uio |
4328 |
|
(string-match "\\.$" ad) ;larsi@ifi.uio. |
4329 |
|
(not (string-match "^[^@]+@[^@]+$" ad)) ;larsi.ifi.uio |
4330 |
|
(string-match "(.*).*(.*)" reply-to)) ;(lars) (lars) |
4331 |
|
(y-or-n-p |
4332 |
|
(format |
4333 |
|
"The Reply-To looks strange: \"%s\". Really post? " |
4334 |
|
reply-to))) |
4335 |
(t t)))))) |
(t t)))))) |
4336 |
|
|
4337 |
(defun message-check-news-body-syntax () |
(defun message-check-news-body-syntax () |
4341 |
(goto-char (point-min)) |
(goto-char (point-min)) |
4342 |
(re-search-forward |
(re-search-forward |
4343 |
(concat "^" (regexp-quote mail-header-separator) "$")) |
(concat "^" (regexp-quote mail-header-separator) "$")) |
4344 |
|
(forward-line 1) |
4345 |
(while (and |
(while (and |
4346 |
(progn |
(or (looking-at |
4347 |
(end-of-line) |
"<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)") |
4348 |
(< (current-column) 80)) |
(let ((p (point))) |
4349 |
|
(end-of-line) |
4350 |
|
(< (- (point) p) 80))) |
4351 |
(zerop (forward-line 1)))) |
(zerop (forward-line 1)))) |
4352 |
(or (bolp) |
(or (bolp) |
4353 |
(eobp) |
(eobp) |
4364 |
(re-search-backward message-signature-separator nil t) |
(re-search-backward message-signature-separator nil t) |
4365 |
(beginning-of-line) |
(beginning-of-line) |
4366 |
(or (re-search-backward "[^ \n\t]" b t) |
(or (re-search-backward "[^ \n\t]" b t) |
4367 |
(y-or-n-p "Empty article. Really post? ")))) |
(if (message-gnksa-enable-p 'empty-article) |
4368 |
|
(y-or-n-p "Empty article. Really post? ") |
4369 |
|
(message "Denied posting -- Empty article.") |
4370 |
|
nil)))) |
4371 |
;; Check for control characters. |
;; Check for control characters. |
4372 |
(message-check 'control-chars |
(message-check 'control-chars |
4373 |
(if (re-search-forward "[\000-\007\013\015-\032\034-\037\200-\237]" nil t) |
(if (re-search-forward "[\000-\007\013\015-\032\034-\037\200-\237]" nil t) |
4386 |
(or |
(or |
4387 |
(not message-checksum) |
(not message-checksum) |
4388 |
(not (eq (message-checksum) message-checksum)) |
(not (eq (message-checksum) message-checksum)) |
4389 |
(y-or-n-p |
(if (message-gnksa-enable-p 'quoted-text-only) |
4390 |
"It looks like no new text has been added. Really post? "))) |
(y-or-n-p |
4391 |
|
"It looks like no new text has been added. Really post? ") |
4392 |
|
(message "Denied posting -- no new text has been added.") |
4393 |
|
nil))) |
4394 |
;; Check the length of the signature. |
;; Check the length of the signature. |
4395 |
(message-check 'signature |
(message-check 'signature |
4396 |
(goto-char (point-max)) |
(goto-char (point-max)) |
4404 |
(message-check 'quoting-style |
(message-check 'quoting-style |
4405 |
(goto-char (point-max)) |
(goto-char (point-max)) |
4406 |
(let ((no-problem t)) |
(let ((no-problem t)) |
4407 |
(when (search-backward-regexp "^>[^\n]*\n>" nil t) |
(when (search-backward-regexp "^>[^\n]*\n" nil t) |
4408 |
(setq no-problem nil) |
(setq no-problem (search-forward-regexp "^[ \t]*[^>\n]" nil t))) |
|
(while (not (eobp)) |
|
|
(when (and (not (eolp)) (looking-at "[^> \t]")) |
|
|
(setq no-problem t)) |
|
|
(forward-line))) |
|
4409 |
(if no-problem |
(if no-problem |
4410 |
t |
t |
4411 |
(y-or-n-p "Your text should follow quoted text. Really post? ")))))) |
(if (message-gnksa-enable-p 'quoted-text-only) |
4412 |
|
(y-or-n-p "Your text should follow quoted text. Really post? ") |
4413 |
|
;; Ensure that |
4414 |
|
(goto-char (point-min)) |
4415 |
|
(re-search-forward |
4416 |
|
(concat "^" (regexp-quote mail-header-separator) "$")) |
4417 |
|
(if (search-forward-regexp "^[ \t]*[^>\n]" nil t) |
4418 |
|
(y-or-n-p "Your text should follow quoted text. Really post? ") |
4419 |
|
(message "Denied posting -- only quoted text.") |
4420 |
|
nil))))))) |
4421 |
|
|
4422 |
(defun message-checksum () |
(defun message-checksum () |
4423 |
"Return a \"checksum\" for the current buffer." |
"Return a \"checksum\" for the current buffer." |
4428 |
(concat "^" (regexp-quote mail-header-separator) "$")) |
(concat "^" (regexp-quote mail-header-separator) "$")) |
4429 |
(while (not (eobp)) |
(while (not (eobp)) |
4430 |
(when (not (looking-at "[ \t\n]")) |
(when (not (looking-at "[ \t\n]")) |
4431 |
(setq sum (logxor (ash sum 1) (if (natnump sum) 0 1) |
(setq sum (logxor (ash sum 1) (if (natnump sum) 0 1) |
4432 |
(char-after)))) |
(char-after)))) |
4433 |
(forward-char 1))) |
(forward-char 1))) |
4434 |
sum)) |
sum)) |
4435 |
|
|
4437 |
"Process Fcc headers in the current buffer." |
"Process Fcc headers in the current buffer." |
4438 |
(let ((case-fold-search t) |
(let ((case-fold-search t) |
4439 |
(buf (current-buffer)) |
(buf (current-buffer)) |
4440 |
list file) |
list file |
4441 |
|
(mml-externalize-attachments message-fcc-externalize-attachments)) |
4442 |
(save-excursion |
(save-excursion |
|
(set-buffer (get-buffer-create " *message temp*")) |
|
|
(erase-buffer) |
|
|
(insert-buffer-substring buf) |
|
|
(save-restriction |
|
|
(message-narrow-to-headers) |
|
|
(while (setq file (message-fetch-field "fcc")) |
|
|
(push file list) |
|
|
(message-remove-header "fcc" nil t))) |
|
|
(message-encode-message-body) |
|
4443 |
(save-restriction |
(save-restriction |
4444 |
(message-narrow-to-headers) |
(message-narrow-to-headers) |
4445 |
(let ((mail-parse-charset message-default-charset) |
(setq file (message-fetch-field "fcc" t))) |
4446 |
(rfc2047-header-encoding-alist |
(when file |
4447 |
(cons '("Newsgroups" . default) |
(set-buffer (get-buffer-create " *message temp*")) |
4448 |
rfc2047-header-encoding-alist))) |
(erase-buffer) |
4449 |
(mail-encode-encoded-word-buffer))) |
(insert-buffer-substring buf) |
4450 |
(goto-char (point-min)) |
(message-encode-message-body) |
4451 |
(when (re-search-forward |
(save-restriction |
4452 |
(concat "^" (regexp-quote mail-header-separator) "$") |
(message-narrow-to-headers) |
4453 |
nil t) |
(while (setq file (message-fetch-field "fcc" t)) |
4454 |
(replace-match "" t t )) |
(push file list) |
4455 |
;; Process FCC operations. |
(message-remove-header "fcc" nil t)) |
4456 |
(while list |
(let ((mail-parse-charset message-default-charset) |
4457 |
(setq file (pop list)) |
(rfc2047-header-encoding-alist |
4458 |
(if (string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" file) |
(cons '("Newsgroups" . default) |
4459 |
;; Pipe the article to the program in question. |
rfc2047-header-encoding-alist))) |
4460 |
(call-process-region (point-min) (point-max) shell-file-name |
(mail-encode-encoded-word-buffer))) |
4461 |
nil nil nil shell-command-switch |
(goto-char (point-min)) |
4462 |
(match-string 1 file)) |
(when (re-search-forward |
4463 |
;; Save the article. |
(concat "^" (regexp-quote mail-header-separator) "$") |
4464 |
(setq file (expand-file-name file)) |
nil t) |
4465 |
(unless (file-exists-p (file-name-directory file)) |
(replace-match "" t t )) |
4466 |
(make-directory (file-name-directory file) t)) |
;; Process FCC operations. |
4467 |
(if (and message-fcc-handler-function |
(while list |
4468 |
(not (eq message-fcc-handler-function 'rmail-output))) |
(setq file (pop list)) |
4469 |
(funcall message-fcc-handler-function file) |
(if (string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" file) |
4470 |
(if (and (file-readable-p file) (mail-file-babyl-p file)) |
;; Pipe the article to the program in question. |
4471 |
(rmail-output file 1 nil t) |
(call-process-region (point-min) (point-max) shell-file-name |
4472 |
(let ((mail-use-rfc822 t)) |
nil nil nil shell-command-switch |
4473 |
(rmail-output file 1 t t)))))) |
(match-string 1 file)) |
4474 |
(kill-buffer (current-buffer))))) |
;; Save the article. |
4475 |
|
(setq file (expand-file-name file)) |
4476 |
|
(unless (file-exists-p (file-name-directory file)) |
4477 |
|
(make-directory (file-name-directory file) t)) |
4478 |
|
(if (and message-fcc-handler-function |
4479 |
|
(not (eq message-fcc-handler-function 'rmail-output))) |
4480 |
|
(funcall message-fcc-handler-function file) |
4481 |
|
(if (and (file-readable-p file) (mail-file-babyl-p file)) |
4482 |
|
(rmail-output file 1 nil t) |
4483 |
|
(let ((mail-use-rfc822 t)) |
4484 |
|
(rmail-output file 1 t t)))))) |
4485 |
|
(kill-buffer (current-buffer)))))) |
4486 |
|
|
4487 |
(defun message-output (filename) |
(defun message-output (filename) |
4488 |
"Append this article to Unix/babyl mail file FILENAME." |
"Append this article to Unix/babyl mail file FILENAME." |
4514 |
(point))) |
(point))) |
4515 |
(goto-char (point-min)) |
(goto-char (point-min)) |
4516 |
(while (re-search-forward "\n[ \t]+" nil t) |
(while (re-search-forward "\n[ \t]+" nil t) |
4517 |
(replace-match " " t t)) ;No line breaks (too confusing) |
(replace-match " " t t)) ;No line breaks (too confusing) |
4518 |
(goto-char (point-min)) |
(goto-char (point-min)) |
4519 |
(while (re-search-forward "[ \t\n]*,[ \t\n]*\\|[ \t]+" nil t) |
(while (re-search-forward "[ \t\n]*,[ \t\n]*\\|[ \t]+" nil t) |
4520 |
(replace-match "," t t)) |
(replace-match "," t t)) |
4533 |
(setq sign "-") |
(setq sign "-") |
4534 |
(setq zone (- zone))) |
(setq zone (- zone))) |
4535 |
(concat |
(concat |
4536 |
|
;; The day name of the %a spec is locale-specific. Pfff. |
4537 |
|
(format "%s, " (capitalize (car (rassoc (nth 6 (decode-time now)) |
4538 |
|
parse-time-weekdays)))) |
4539 |
(format-time-string "%d" now) |
(format-time-string "%d" now) |
4540 |
;; The month name of the %b spec is locale-specific. Pfff. |
;; The month name of the %b spec is locale-specific. Pfff. |
4541 |
(format " %s " |
(format " %s " |
4587 |
(aset user (match-beginning 0) ?_)) |
(aset user (match-beginning 0) ?_)) |
4588 |
user) |
user) |
4589 |
(message-number-base36 (user-uid) -1)) |
(message-number-base36 (user-uid) -1)) |
4590 |
(message-number-base36 (+ (car tm) |
(message-number-base36 (+ (car tm) |
4591 |
(lsh (% message-unique-id-char 25) 16)) 4) |
(lsh (% message-unique-id-char 25) 16)) 4) |
4592 |
(message-number-base36 (+ (nth 1 tm) |
(message-number-base36 (+ (nth 1 tm) |
4593 |
(lsh (/ message-unique-id-char 25) 16)) 4) |
(lsh (/ message-unique-id-char 25) 16)) 4) |
4594 |
;; Append the newsreader name, because while the generated |
;; Append a given name, because while the generated ID is unique |
4595 |
;; ID is unique to this newsreader, other newsreaders might |
;; to this newsreader, other newsreaders might otherwise generate |
4596 |
;; otherwise generate the same ID via another algorithm. |
;; the same ID via another algorithm. |
4597 |
".fsf"))) |
".fsf"))) |
4598 |
|
|
4599 |
(defun message-number-base36 (num len) |
(defun message-number-base36 (num len) |
4609 |
"Make an Organization header." |
"Make an Organization header." |
4610 |
(let* ((organization |
(let* ((organization |
4611 |
(when message-user-organization |
(when message-user-organization |
4612 |
(if (message-functionp message-user-organization) |
(if (functionp message-user-organization) |
4613 |
(funcall message-user-organization) |
(funcall message-user-organization) |
4614 |
message-user-organization)))) |
message-user-organization)))) |
4615 |
(save-excursion |
(with-temp-buffer |
4616 |
(message-set-work-buffer) |
(mm-enable-multibyte) |
4617 |
(cond ((stringp organization) |
(cond ((stringp organization) |
4618 |
(insert organization)) |
(insert organization)) |
4619 |
((and (eq t organization) |
((and (eq t organization) |
4631 |
(save-excursion |
(save-excursion |
4632 |
(save-restriction |
(save-restriction |
4633 |
(widen) |
(widen) |
4634 |
(goto-char (point-min)) |
(message-goto-body) |
|
(re-search-forward |
|
|
(concat "^" (regexp-quote mail-header-separator) "$")) |
|
|
(forward-line 1) |
|
4635 |
(int-to-string (count-lines (point) (point-max)))))) |
(int-to-string (count-lines (point) (point-max)))))) |
4636 |
|
|
4637 |
|
(defun message-make-references () |
4638 |
|
"Return the References header for this message." |
4639 |
|
(when message-reply-headers |
4640 |
|
(let ((message-id (mail-header-message-id message-reply-headers)) |
4641 |
|
(references (mail-header-references message-reply-headers)) |
4642 |
|
new-references) |
4643 |
|
(if (or references message-id) |
4644 |
|
(concat (or references "") (and references " ") |
4645 |
|
(or message-id "")) |
4646 |
|
nil)))) |
4647 |
|
|
4648 |
(defun message-make-in-reply-to () |
(defun message-make-in-reply-to () |
4649 |
"Return the In-Reply-To header for this message." |
"Return the In-Reply-To header for this message." |
4650 |
(when message-reply-headers |
(when message-reply-headers |
4651 |
(mail-header-message-id message-reply-headers))) |
(let ((from (mail-header-from message-reply-headers)) |
4652 |
|
(date (mail-header-date message-reply-headers)) |
4653 |
|
(msg-id (mail-header-message-id message-reply-headers))) |
4654 |
|
(when from |
4655 |
|
(let ((name (mail-extract-address-components from))) |
4656 |
|
(concat msg-id (if msg-id " (") |
4657 |
|
(or (car name) |
4658 |
|
(nth 1 name)) |
4659 |
|
"'s message of \"" |
4660 |
|
(if (or (not date) (string= date "")) |
4661 |
|
"(unknown date)" date) |
4662 |
|
"\"" (if msg-id ")"))))))) |
4663 |
|
|
4664 |
(defun message-make-distribution () |
(defun message-make-distribution () |
4665 |
"Make a Distribution header." |
"Make a Distribution header." |
4666 |
(let ((orig-distribution (message-fetch-reply-field "distribution"))) |
(let ((orig-distribution (message-fetch-reply-field "distribution"))) |
4667 |
(cond ((message-functionp message-distribution-function) |
(cond ((functionp message-distribution-function) |
4668 |
(funcall message-distribution-function)) |
(funcall message-distribution-function)) |
4669 |
(t orig-distribution)))) |
(t orig-distribution)))) |
4670 |
|
|
4697 |
(user-full-name)))) |
(user-full-name)))) |
4698 |
(when (string= fullname "&") |
(when (string= fullname "&") |
4699 |
(setq fullname (user-login-name))) |
(setq fullname (user-login-name))) |
4700 |
(save-excursion |
(with-temp-buffer |
4701 |
(message-set-work-buffer) |
(mm-enable-multibyte) |
4702 |
(cond |
(cond |
4703 |
((or (null style) |
((or (null style) |
4704 |
(equal fullname "")) |
(equal fullname "")) |
4715 |
(string-match "[\\()]" tmp))))) |
(string-match "[\\()]" tmp))))) |
4716 |
(insert fullname) |
(insert fullname) |
4717 |
(goto-char (point-min)) |
(goto-char (point-min)) |
4718 |
;; Look for a character that cannot appear unquoted |
;; Look for a character that cannot appear unquoted |
4719 |
;; according to RFC 822. |
;; according to RFC 822. |
4720 |
(when (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" nil 1) |
(when (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" nil 1) |
4721 |
;; Quote fullname, escaping specials. |
;; Quote fullname, escaping specials. |
4722 |
(goto-char (point-min)) |
(goto-char (point-min)) |
4723 |
(insert "\"") |
(insert "\"") |
4724 |
(while (re-search-forward "[\"\\]" nil 1) |
(while (re-search-forward "[\"\\]" nil 1) |
4725 |
(replace-match "\\\\\\&" t)) |
(replace-match "\\\\\\&" t)) |
4726 |
(insert "\"")) |
(insert "\"")) |
4727 |
(insert " <" login ">")) |
(insert " <" login ">")) |
4728 |
(t ; 'parens or default |
(t ; 'parens or default |
4729 |
(insert login " (") |
(insert login " (") |
4759 |
|
|
4760 |
(defun message-user-mail-address () |
(defun message-user-mail-address () |
4761 |
"Return the pertinent part of `user-mail-address'." |
"Return the pertinent part of `user-mail-address'." |
4762 |
(when user-mail-address |
(when (and user-mail-address |
4763 |
|
(string-match "@.*\\." user-mail-address)) |
4764 |
(if (string-match " " user-mail-address) |
(if (string-match " " user-mail-address) |
4765 |
(nth 1 (mail-extract-address-components user-mail-address)) |
(nth 1 (mail-extract-address-components user-mail-address)) |
4766 |
user-mail-address))) |
user-mail-address))) |
4767 |
|
|
4768 |
|
(defun message-sendmail-envelope-from () |
4769 |
|
"Return the envelope from." |
4770 |
|
(cond ((eq message-sendmail-envelope-from 'header) |
4771 |
|
(nth 1 (mail-extract-address-components |
4772 |
|
(message-fetch-field "from")))) |
4773 |
|
((stringp message-sendmail-envelope-from) |
4774 |
|
message-sendmail-envelope-from) |
4775 |
|
(t |
4776 |
|
(message-make-address)))) |
4777 |
|
|
4778 |
(defun message-make-fqdn () |
(defun message-make-fqdn () |
4779 |
"Return user's fully qualified domain name." |
"Return user's fully qualified domain name." |
4780 |
(let ((system-name (system-name)) |
(let* ((system-name (system-name)) |
4781 |
(user-mail (message-user-mail-address))) |
(user-mail (message-user-mail-address)) |
4782 |
|
(user-domain |
4783 |
|
(if (and user-mail |
4784 |
|
(string-match "@\\(.*\\)\\'" user-mail)) |
4785 |
|
(match-string 1 user-mail))) |
4786 |
|
(case-fold-search t)) |
4787 |
(cond |
(cond |
4788 |
((string-match "[^.]\\.[^.]" system-name) |
((and message-user-fqdn |
4789 |
|
(stringp message-user-fqdn) |
4790 |
|
(string-match message-valid-fqdn-regexp message-user-fqdn) |
4791 |
|
(not (string-match message-bogus-system-names message-user-fqdn))) |
4792 |
|
message-user-fqdn) |
4793 |
|
;; `message-user-fqdn' seems to be valid |
4794 |
|
((and (string-match message-valid-fqdn-regexp system-name) |
4795 |
|
(not (string-match message-bogus-system-names system-name))) |
4796 |
;; `system-name' returned the right result. |
;; `system-name' returned the right result. |
4797 |
system-name) |
system-name) |
4798 |
;; Try `mail-host-address'. |
;; Try `mail-host-address'. |
4799 |
((and (boundp 'mail-host-address) |
((and (boundp 'mail-host-address) |
4800 |
(stringp mail-host-address) |
(stringp mail-host-address) |
4801 |
(string-match "\\." mail-host-address)) |
(string-match message-valid-fqdn-regexp mail-host-address) |
4802 |
|
(not (string-match message-bogus-system-names mail-host-address))) |
4803 |
mail-host-address) |
mail-host-address) |
4804 |
;; We try `user-mail-address' as a backup. |
;; We try `user-mail-address' as a backup. |
4805 |
((and user-mail |
((and user-domain |
4806 |
(string-match "\\." user-mail) |
(stringp user-domain) |
4807 |
(string-match "@\\(.*\\)\\'" user-mail)) |
(string-match message-valid-fqdn-regexp user-domain) |
4808 |
(match-string 1 user-mail)) |
(not (string-match message-bogus-system-names user-domain))) |
4809 |
|
user-domain) |
4810 |
;; Default to this bogus thing. |
;; Default to this bogus thing. |
4811 |
(t |
(t |
4812 |
(concat system-name ".i-did-not-set--mail-host-address--so-shoot-me"))))) |
(concat system-name |
4813 |
|
".i-did-not-set--mail-host-address--so-tickle-me"))))) |
4814 |
|
|
4815 |
(defun message-make-host-name () |
(defun message-make-host-name () |
4816 |
"Return the name of the host." |
"Return the name of the host." |
4823 |
(or mail-host-address |
(or mail-host-address |
4824 |
(message-make-fqdn))) |
(message-make-fqdn))) |
4825 |
|
|
4826 |
|
(defun message-to-list-only () |
4827 |
|
"Send a message to the list only. |
4828 |
|
Remove all addresses but the list address from To and Cc headers." |
4829 |
|
(interactive) |
4830 |
|
(let ((listaddr (message-make-mail-followup-to t))) |
4831 |
|
(when listaddr |
4832 |
|
(save-excursion |
4833 |
|
(message-remove-header "to") |
4834 |
|
(message-remove-header "cc") |
4835 |
|
(message-position-on-field "To" "X-Draft-From") |
4836 |
|
(insert listaddr))))) |
4837 |
|
|
4838 |
|
(defun message-make-mail-followup-to (&optional only-show-subscribed) |
4839 |
|
"Return the Mail-Followup-To header. |
4840 |
|
If passed the optional argument ONLY-SHOW-SUBSCRIBED only return the |
4841 |
|
subscribed address (and not the additional To and Cc header contents)." |
4842 |
|
(let* ((case-fold-search t) |
4843 |
|
(to (message-fetch-field "To")) |
4844 |
|
(cc (message-fetch-field "cc")) |
4845 |
|
(msg-recipients (concat to (and to cc ", ") cc)) |
4846 |
|
(recipients |
4847 |
|
(mapcar 'mail-strip-quoted-names |
4848 |
|
(message-tokenize-header msg-recipients))) |
4849 |
|
(file-regexps |
4850 |
|
(if message-subscribed-address-file |
4851 |
|
(let (begin end item re) |
4852 |
|
(save-excursion |
4853 |
|
(with-temp-buffer |
4854 |
|
(insert-file-contents message-subscribed-address-file) |
4855 |
|
(while (not (eobp)) |
4856 |
|
(setq begin (point)) |
4857 |
|
(forward-line 1) |
4858 |
|
(setq end (point)) |
4859 |
|
(if (bolp) (setq end (1- end))) |
4860 |
|
(setq item (regexp-quote (buffer-substring begin end))) |
4861 |
|
(if re (setq re (concat re "\\|" item)) |
4862 |
|
(setq re (concat "\\`\\(" item)))) |
4863 |
|
(and re (list (concat re "\\)\\'")))))))) |
4864 |
|
(mft-regexps (apply 'append message-subscribed-regexps |
4865 |
|
(mapcar 'regexp-quote |
4866 |
|
message-subscribed-addresses) |
4867 |
|
file-regexps |
4868 |
|
(mapcar 'funcall |
4869 |
|
message-subscribed-address-functions)))) |
4870 |
|
(save-match-data |
4871 |
|
(let ((subscribed-lists nil) |
4872 |
|
(list |
4873 |
|
(loop for recipient in recipients |
4874 |
|
when (loop for regexp in mft-regexps |
4875 |
|
when (string-match regexp recipient) return t) |
4876 |
|
return recipient))) |
4877 |
|
(when list |
4878 |
|
(if only-show-subscribed |
4879 |
|
list |
4880 |
|
msg-recipients)))))) |
4881 |
|
|
4882 |
|
(defun message-idna-to-ascii-rhs-1 (header) |
4883 |
|
"Interactively potentially IDNA encode domain names in HEADER." |
4884 |
|
(let ((field (message-fetch-field header)) |
4885 |
|
rhs ace address) |
4886 |
|
(when field |
4887 |
|
(dolist (address (mail-header-parse-addresses field)) |
4888 |
|
(setq address (car address) |
4889 |
|
rhs (downcase (or (cadr (split-string address "@")) "")) |
4890 |
|
ace (downcase (idna-to-ascii rhs))) |
4891 |
|
(when (and (not (equal rhs ace)) |
4892 |
|
(or (not (eq message-use-idna 'ask)) |
4893 |
|
(y-or-n-p (format "Replace %s with %s? " rhs ace)))) |
4894 |
|
(goto-char (point-min)) |
4895 |
|
(while (re-search-forward (concat "^" header ":") nil t) |
4896 |
|
(message-narrow-to-field) |
4897 |
|
(while (search-forward (concat "@" rhs) nil t) |
4898 |
|
(replace-match (concat "@" ace) t t)) |
4899 |
|
(goto-char (point-max)) |
4900 |
|
(widen))))))) |
4901 |
|
|
4902 |
|
(defun message-idna-to-ascii-rhs () |
4903 |
|
"Possibly IDNA encode non-ASCII domain names in From:, To: and Cc: headers. |
4904 |
|
See `message-idna-encode'." |
4905 |
|
(interactive) |
4906 |
|
(when message-use-idna |
4907 |
|
(save-excursion |
4908 |
|
(save-restriction |
4909 |
|
(message-narrow-to-head) |
4910 |
|
(message-idna-to-ascii-rhs-1 "From") |
4911 |
|
(message-idna-to-ascii-rhs-1 "To") |
4912 |
|
(message-idna-to-ascii-rhs-1 "Cc"))))) |
4913 |
|
|
4914 |
(defun message-generate-headers (headers) |
(defun message-generate-headers (headers) |
4915 |
"Prepare article HEADERS. |
"Prepare article HEADERS. |
4916 |
Headers already prepared in the buffer are not modified." |
Headers already prepared in the buffer are not modified." |
4917 |
|
(setq headers (append headers message-required-headers)) |
4918 |
(save-restriction |
(save-restriction |
4919 |
(message-narrow-to-headers) |
(message-narrow-to-headers) |
4920 |
(let* ((Date (message-make-date)) |
(let* ((Date (message-make-date)) |
4925 |
(Subject nil) |
(Subject nil) |
4926 |
(Newsgroups nil) |
(Newsgroups nil) |
4927 |
(In-Reply-To (message-make-in-reply-to)) |
(In-Reply-To (message-make-in-reply-to)) |
4928 |
|
(References (message-make-references)) |
4929 |
(To nil) |
(To nil) |
4930 |
(Distribution (message-make-distribution)) |
(Distribution (message-make-distribution)) |
4931 |
(Lines (message-make-lines)) |
(Lines (message-make-lines)) |
4932 |
(User-Agent message-newsreader) |
(User-Agent message-newsreader) |
4933 |
(Expires (message-make-expires)) |
(Expires (message-make-expires)) |
4934 |
(case-fold-search t) |
(case-fold-search t) |
4935 |
header value elem) |
(optionalp nil) |
4936 |
|
header value elem header-string) |
4937 |
;; First we remove any old generated headers. |
;; First we remove any old generated headers. |
4938 |
(let ((headers message-deletable-headers)) |
(let ((headers message-deletable-headers)) |
4939 |
(unless (buffer-modified-p) |
(unless (buffer-modified-p) |
4954 |
(setq elem (pop headers)) |
(setq elem (pop headers)) |
4955 |
(if (consp elem) |
(if (consp elem) |
4956 |
(if (eq (car elem) 'optional) |
(if (eq (car elem) 'optional) |
4957 |
(setq header (cdr elem)) |
(setq header (cdr elem) |
4958 |
|
optionalp t) |
4959 |
(setq header (car elem))) |
(setq header (car elem))) |
4960 |
(setq header elem)) |
(setq header elem)) |
4961 |
|
(setq header-string (if (stringp header) |
4962 |
|
header |
4963 |
|
(symbol-name header))) |
4964 |
(when (or (not (re-search-forward |
(when (or (not (re-search-forward |
4965 |
(concat "^" |
(concat "^" |
4966 |
(regexp-quote |
(regexp-quote (downcase header-string)) |
|
(downcase |
|
|
(if (stringp header) |
|
|
header |
|
|
(symbol-name header)))) |
|
4967 |
":") |
":") |
4968 |
nil t)) |
nil t)) |
4969 |
(progn |
(progn |
4970 |
;; The header was found. We insert a space after the |
;; The header was found. We insert a space after the |
4971 |
;; colon, if there is none. |
;; colon, if there is none. |
4972 |
(if (/= (char-after) ? ) (insert " ") (forward-char 1)) |
(if (/= (char-after) ? ) (insert " ") (forward-char 1)) |
4973 |
;; Find out whether the header is empty... |
;; Find out whether the header is empty. |
4974 |
(looking-at "[ \t]*\n[^ \t]"))) |
(looking-at "[ \t]*\n[^ \t]"))) |
4975 |
;; So we find out what value we should insert. |
;; So we find out what value we should insert. |
4976 |
(setq value |
(setq value |
4977 |
(cond |
(cond |
4978 |
((and (consp elem) (eq (car elem) 'optional)) |
((and (consp elem) |
4979 |
|
(eq (car elem) 'optional) |
4980 |
|
(not (member header-string message-inserted-headers))) |
4981 |
;; This is an optional header. If the cdr of this |
;; This is an optional header. If the cdr of this |
4982 |
;; is something that is nil, then we do not insert |
;; is something that is nil, then we do not insert |
4983 |
;; this header. |
;; this header. |
4984 |
(setq header (cdr elem)) |
(setq header (cdr elem)) |
4985 |
(or (and (fboundp (cdr elem)) (funcall (cdr elem))) |
(or (and (functionp (cdr elem)) |
4986 |
(and (boundp (cdr elem)) (symbol-value (cdr elem))))) |
(funcall (cdr elem))) |
4987 |
|
(and (boundp (cdr elem)) |
4988 |
|
(symbol-value (cdr elem))))) |
4989 |
((consp elem) |
((consp elem) |
4990 |
;; The element is a cons. Either the cdr is a |
;; The element is a cons. Either the cdr is a |
4991 |
;; string to be inserted verbatim, or it is a |
;; string to be inserted verbatim, or it is a |
4992 |
;; function, and we insert the value returned from |
;; function, and we insert the value returned from |
4993 |
;; this function. |
;; this function. |
4994 |
(or (and (stringp (cdr elem)) (cdr elem)) |
(or (and (stringp (cdr elem)) |
4995 |
(and (fboundp (cdr elem)) (funcall (cdr elem))))) |
(cdr elem)) |
4996 |
((and (boundp header) (symbol-value header)) |
(and (functionp (cdr elem)) |
4997 |
|
(funcall (cdr elem))))) |
4998 |
|
((and (boundp header) |
4999 |
|
(symbol-value header)) |
5000 |
;; The element is a symbol. We insert the value |
;; The element is a symbol. We insert the value |
5001 |
;; of this symbol, if any. |
;; of this symbol, if any. |
5002 |
(symbol-value header)) |
(symbol-value header)) |
5013 |
(progn |
(progn |
5014 |
;; This header didn't exist, so we insert it. |
;; This header didn't exist, so we insert it. |
5015 |
(goto-char (point-max)) |
(goto-char (point-max)) |
5016 |
(insert (if (stringp header) header (symbol-name header)) |
(let ((formatter |
5017 |
": " value "\n") |
(cdr (assq header message-header-format-alist)))) |
5018 |
(forward-line -1)) |
(if formatter |
5019 |
|
(funcall formatter header value) |
5020 |
|
(insert header-string ": " value)) |
5021 |
|
;; We check whether the value was ended by a |
5022 |
|
;; newline. If now, we insert one. |
5023 |
|
(unless (bolp) |
5024 |
|
(insert "\n")) |
5025 |
|
(forward-line -1))) |
5026 |
;; The value of this header was empty, so we clear |
;; The value of this header was empty, so we clear |
5027 |
;; totally and insert the new value. |
;; totally and insert the new value. |
5028 |
(delete-region (point) (gnus-point-at-eol)) |
(delete-region (point) (gnus-point-at-eol)) |
5029 |
(insert value)) |
;; If the header is optional, and the header was |
5030 |
|
;; empty, we con't insert it anyway. |
5031 |
|
(unless optionalp |
5032 |
|
(push header-string message-inserted-headers) |
5033 |
|
(insert value))) |
5034 |
;; Add the deletable property to the headers that require it. |
;; Add the deletable property to the headers that require it. |
5035 |
(and (memq header message-deletable-headers) |
(and (memq header message-deletable-headers) |
5036 |
(progn (beginning-of-line) (looking-at "[^:]+: ")) |
(progn (beginning-of-line) (looking-at "[^:]+: ")) |
5061 |
(beginning-of-line)) |
(beginning-of-line)) |
5062 |
(when (or (message-news-p) |
(when (or (message-news-p) |
5063 |
(string-match "@.+\\.." secure-sender)) |
(string-match "@.+\\.." secure-sender)) |
5064 |
(insert "Sender: " secure-sender "\n"))))))) |
(insert "Sender: " secure-sender "\n")))) |
5065 |
|
;; Check for IDNA |
5066 |
|
(message-idna-to-ascii-rhs)))) |
5067 |
|
|
5068 |
(defun message-insert-courtesy-copy () |
(defun message-insert-courtesy-copy () |
5069 |
"Insert a courtesy message in mail copies of combined messages." |
"Insert a courtesy message in mail copies of combined messages." |
5116 |
(widen) |
(widen) |
5117 |
(forward-line 1))) |
(forward-line 1))) |
5118 |
|
|
5119 |
|
(defun message-split-line () |
5120 |
|
"Split current line, moving portion beyond point vertically down. |
5121 |
|
If the current line has `message-yank-prefix', insert it on the new line." |
5122 |
|
(interactive "*") |
5123 |
|
(condition-case nil |
5124 |
|
(split-line message-yank-prefix) ;; Emacs 21.3.50+ supports arg. |
5125 |
|
(error |
5126 |
|
(split-line)))) |
5127 |
|
|
5128 |
(defun message-fill-header (header value) |
(defun message-fill-header (header value) |
5129 |
(let ((begin (point)) |
(let ((begin (point)) |
5130 |
(fill-column 78) |
(fill-column 78) |
5152 |
(nthcdr (+ (- cut 2) surplus 1) list))) |
(nthcdr (+ (- cut 2) surplus 1) list))) |
5153 |
|
|
5154 |
(defun message-shorten-references (header references) |
(defun message-shorten-references (header references) |
5155 |
"Trim REFERENCES to be less than 31 Message-ID long, and fold them. |
"Trim REFERENCES to be 21 Message-ID long or less, and fold them. |
5156 |
If folding is disallowed, also check that the REFERENCES are less |
If folding is disallowed, also check that the REFERENCES are less |
5157 |
than 988 characters long, and if they are not, trim them until they are." |
than 988 characters long, and if they are not, trim them until they are." |
5158 |
(let ((maxcount 31) |
(let ((maxcount 21) |
5159 |
(count 0) |
(count 0) |
5160 |
(cut 6) |
(cut 2) |
5161 |
refs) |
refs) |
5162 |
(with-temp-buffer |
(with-temp-buffer |
5163 |
(insert references) |
(insert references) |
5223 |
(forward-line 2))) |
(forward-line 2))) |
5224 |
(sit-for 0))) |
(sit-for 0))) |
5225 |
|
|
5226 |
|
(defcustom message-beginning-of-line t |
5227 |
|
"Whether \\<message-mode-map>\\[message-beginning-of-line]\ |
5228 |
|
goes to beginning of header values." |
5229 |
|
:group 'message-buffers |
5230 |
|
:link '(custom-manual "(message)Movement") |
5231 |
|
:type 'boolean) |
5232 |
|
|
5233 |
|
(defun message-beginning-of-line (&optional n) |
5234 |
|
"Move point to beginning of header value or to beginning of line. |
5235 |
|
The prefix argument N is passed directly to `beginning-of-line'. |
5236 |
|
|
5237 |
|
This command is identical to `beginning-of-line' if point is |
5238 |
|
outside the message header or if the option `message-beginning-of-line' |
5239 |
|
is nil. |
5240 |
|
|
5241 |
|
If point is in the message header and on a (non-continued) header |
5242 |
|
line, move point to the beginning of the header value. If point |
5243 |
|
is already there, move point to beginning of line. Therefore, |
5244 |
|
repeated calls will toggle point between beginning of field and |
5245 |
|
beginning of line." |
5246 |
|
(interactive "p") |
5247 |
|
(let ((zrs 'zmacs-region-stays)) |
5248 |
|
(when (and (interactive-p) (boundp zrs)) |
5249 |
|
(set zrs t))) |
5250 |
|
(if (and message-beginning-of-line |
5251 |
|
(message-point-in-header-p)) |
5252 |
|
(let* ((here (point)) |
5253 |
|
(bol (progn (beginning-of-line n) (point))) |
5254 |
|
(eol (gnus-point-at-eol)) |
5255 |
|
(eoh (re-search-forward ": *" eol t))) |
5256 |
|
(if (or (not eoh) (equal here eoh)) |
5257 |
|
(goto-char bol) |
5258 |
|
(goto-char eoh))) |
5259 |
|
(beginning-of-line n))) |
5260 |
|
|
5261 |
(defun message-buffer-name (type &optional to group) |
(defun message-buffer-name (type &optional to group) |
5262 |
"Return a new (unique) buffer name based on TYPE and TO." |
"Return a new (unique) buffer name based on TYPE and TO." |
5263 |
(cond |
(cond |
5274 |
"*"))) |
"*"))) |
5275 |
;; Check whether `message-generate-new-buffers' is a function, |
;; Check whether `message-generate-new-buffers' is a function, |
5276 |
;; and if so, call it. |
;; and if so, call it. |
5277 |
((message-functionp message-generate-new-buffers) |
((functionp message-generate-new-buffers) |
5278 |
(funcall message-generate-new-buffers type to group)) |
(funcall message-generate-new-buffers type to group)) |
5279 |
((eq message-generate-new-buffers 'unsent) |
((eq message-generate-new-buffers 'unsent) |
5280 |
(generate-new-buffer-name |
(generate-new-buffer-name |
5311 |
;; list of buffers. |
;; list of buffers. |
5312 |
(setq message-buffer-list (delq (current-buffer) message-buffer-list)) |
(setq message-buffer-list (delq (current-buffer) message-buffer-list)) |
5313 |
(while (and message-max-buffers |
(while (and message-max-buffers |
5314 |
message-buffer-list |
message-buffer-list |
5315 |
(>= (length message-buffer-list) message-max-buffers)) |
(>= (length message-buffer-list) message-max-buffers)) |
5316 |
;; Kill the oldest buffer -- unless it has been changed. |
;; Kill the oldest buffer -- unless it has been changed. |
5317 |
(let ((buffer (pop message-buffer-list))) |
(let ((buffer (pop message-buffer-list))) |
5321 |
;; Rename the buffer. |
;; Rename the buffer. |
5322 |
(if message-send-rename-function |
(if message-send-rename-function |
5323 |
(funcall message-send-rename-function) |
(funcall message-send-rename-function) |
5324 |
(when (string-match "\\`\\*\\(unsent \\)?" (buffer-name)) |
;; Note: mail-abbrevs of XEmacs renames buffer name behind Gnus. |
5325 |
(rename-buffer |
(when (string-match |
5326 |
(concat "*sent " (substring (buffer-name) (match-end 0))) t))) |
"\\`\\*\\(sent \\|unsent \\)?\\(.+\\)\\*[^\\*]*\\|\\`mail to " |
5327 |
|
(buffer-name)) |
5328 |
|
(let ((name (match-string 2 (buffer-name))) |
5329 |
|
to group) |
5330 |
|
(if (not (or (null name) |
5331 |
|
(string-equal name "mail") |
5332 |
|
(string-equal name "posting"))) |
5333 |
|
(setq name (concat "*sent " name "*")) |
5334 |
|
(message-narrow-to-headers) |
5335 |
|
(setq to (message-fetch-field "to")) |
5336 |
|
(setq group (message-fetch-field "newsgroups")) |
5337 |
|
(widen) |
5338 |
|
(setq name |
5339 |
|
(cond |
5340 |
|
(to (concat "*sent mail to " |
5341 |
|
(or (car (mail-extract-address-components to)) |
5342 |
|
to) "*")) |
5343 |
|
((and group (not (string= group ""))) |
5344 |
|
(concat "*sent posting on " group "*")) |
5345 |
|
(t "*sent mail*")))) |
5346 |
|
(unless (string-equal name (buffer-name)) |
5347 |
|
(rename-buffer name t))))) |
5348 |
;; Push the current buffer onto the list. |
;; Push the current buffer onto the list. |
5349 |
(when message-max-buffers |
(when message-max-buffers |
5350 |
(setq message-buffer-list |
(setq message-buffer-list |
5384 |
headers) |
headers) |
5385 |
nil switch-function yank-action actions))))) |
nil switch-function yank-action actions))))) |
5386 |
|
|
5387 |
(eval-when-compile (defvar mc-modes-alist)) |
(defun message-headers-to-generate (headers included-headers excluded-headers) |
5388 |
|
"Return a list that includes all headers from HEADERS. |
5389 |
|
If INCLUDED-HEADERS is a list, just include those headers. If if is |
5390 |
|
t, include all headers. In any case, headers from EXCLUDED-HEADERS |
5391 |
|
are not included." |
5392 |
|
(let ((result nil) |
5393 |
|
header-name) |
5394 |
|
(dolist (header headers) |
5395 |
|
(setq header-name (cond |
5396 |
|
((and (consp header) |
5397 |
|
(eq (car header) 'optional)) |
5398 |
|
;; On the form (optional . Header) |
5399 |
|
(cdr header)) |
5400 |
|
((consp header) |
5401 |
|
;; On the form (Header . function) |
5402 |
|
(car header)) |
5403 |
|
(t |
5404 |
|
;; Just a Header. |
5405 |
|
header))) |
5406 |
|
(when (and (not (memq header-name excluded-headers)) |
5407 |
|
(or (eq included-headers t) |
5408 |
|
(memq header-name included-headers))) |
5409 |
|
(push header result))) |
5410 |
|
(nreverse result))) |
5411 |
|
|
5412 |
(defun message-setup-1 (headers &optional replybuffer actions) |
(defun message-setup-1 (headers &optional replybuffer actions) |
|
(when (and (boundp 'mc-modes-alist) |
|
|
(not (assq 'message-mode mc-modes-alist))) |
|
|
(push '(message-mode (encrypt . mc-encrypt-message) |
|
|
(sign . mc-sign-message)) |
|
|
mc-modes-alist)) |
|
5413 |
(dolist (action actions) |
(dolist (action actions) |
5414 |
(condition-case nil |
(condition-case nil |
5415 |
(add-to-list 'message-send-actions |
(add-to-list 'message-send-actions |
5443 |
(or (bolp) (insert ?\n))) |
(or (bolp) (insert ?\n))) |
5444 |
(when message-generate-headers-first |
(when message-generate-headers-first |
5445 |
(message-generate-headers |
(message-generate-headers |
5446 |
(delq 'Lines |
(message-headers-to-generate |
5447 |
(delq 'Subject |
(append message-required-news-headers |
5448 |
(copy-sequence message-required-news-headers)))))) |
message-required-headers) |
5449 |
|
message-generate-headers-first |
5450 |
|
'(Lines Subject))))) |
5451 |
(when (message-mail-p) |
(when (message-mail-p) |
5452 |
(when message-default-mail-headers |
(when message-default-mail-headers |
5453 |
(insert message-default-mail-headers) |
(insert message-default-mail-headers) |
5454 |
(or (bolp) (insert ?\n))) |
(or (bolp) (insert ?\n))) |
5455 |
|
(save-restriction |
5456 |
|
(message-narrow-to-headers) |
5457 |
|
(if message-alternative-emails |
5458 |
|
(message-use-alternative-email-as-from))) |
5459 |
(when message-generate-headers-first |
(when message-generate-headers-first |
5460 |
(message-generate-headers |
(message-generate-headers |
5461 |
(delq 'Lines |
(message-headers-to-generate |
5462 |
(delq 'Subject |
(append message-required-mail-headers |
5463 |
(copy-sequence message-required-mail-headers)))))) |
message-required-headers) |
5464 |
|
message-generate-headers-first |
5465 |
|
'(Lines Subject))))) |
5466 |
(run-hooks 'message-signature-setup-hook) |
(run-hooks 'message-signature-setup-hook) |
5467 |
(message-insert-signature) |
(message-insert-signature) |
5468 |
(save-restriction |
(save-restriction |
5469 |
(message-narrow-to-headers) |
(message-narrow-to-headers) |
|
(if message-alternative-emails |
|
|
(message-use-alternative-email-as-from)) |
|
5470 |
(run-hooks 'message-header-setup-hook)) |
(run-hooks 'message-header-setup-hook)) |
5471 |
(set-buffer-modified-p nil) |
(set-buffer-modified-p nil) |
5472 |
(setq buffer-undo-list nil) |
(setq buffer-undo-list nil) |
5483 |
(if (gnus-alive-p) |
(if (gnus-alive-p) |
5484 |
(setq message-draft-article |
(setq message-draft-article |
5485 |
(nndraft-request-associate-buffer "drafts")) |
(nndraft-request-associate-buffer "drafts")) |
5486 |
(setq buffer-file-name (expand-file-name "*message*" |
(setq buffer-file-name (expand-file-name |
5487 |
message-auto-save-directory)) |
(if (memq system-type |
5488 |
|
'(ms-dos ms-windows windows-nt |
5489 |
|
cygwin cygwin32 win32 w32 |
5490 |
|
mswindows)) |
5491 |
|
"message" |
5492 |
|
"*message*") |
5493 |
|
message-auto-save-directory)) |
5494 |
(setq buffer-auto-save-file-name (make-auto-save-file-name))) |
(setq buffer-auto-save-file-name (make-auto-save-file-name))) |
5495 |
(clear-visited-file-modtime) |
(clear-visited-file-modtime) |
5496 |
(setq buffer-file-coding-system message-draft-coding-system))) |
(setq buffer-file-coding-system message-draft-coding-system))) |
5551 |
"Start editing a news article to be sent." |
"Start editing a news article to be sent." |
5552 |
(interactive) |
(interactive) |
5553 |
(let ((message-this-is-news t)) |
(let ((message-this-is-news t)) |
5554 |
(message-pop-to-buffer (message-buffer-name "news" nil newsgroups)) |
(message-pop-to-buffer (message-buffer-name "posting" nil newsgroups)) |
5555 |
(message-setup `((Newsgroups . ,(or newsgroups "")) |
(message-setup `((Newsgroups . ,(or newsgroups "")) |
5556 |
(Subject . ,(or subject "")))))) |
(Subject . ,(or subject "")))))) |
5557 |
|
|
5558 |
(defun message-get-reply-headers (wide &optional to-address) |
(defun message-get-reply-headers (wide &optional to-address address-headers) |
5559 |
(let (follow-to mct never-mct from to cc reply-to ccalist) |
(let (follow-to mct never-mct to cc author mft recipients) |
5560 |
;; Find all relevant headers we need. |
;; Find all relevant headers we need. |
5561 |
(setq from (message-fetch-field "from") |
(save-restriction |
5562 |
to (message-fetch-field "to") |
(message-narrow-to-headers-or-head) |
5563 |
cc (message-fetch-field "cc") |
;; Gmane renames "To". Look at "Original-To", too, if it is present in |
5564 |
mct (message-fetch-field "mail-copies-to") |
;; message-header-synonyms. |
5565 |
reply-to (message-fetch-field "reply-to")) |
(setq to (or (message-fetch-field "to") |
5566 |
|
(and (loop for synonym in message-header-synonyms |
5567 |
|
when (memq 'Original-To synonym) |
5568 |
|
return t) |
5569 |
|
(message-fetch-field "original-to"))) |
5570 |
|
cc (message-fetch-field "cc") |
5571 |
|
mct (message-fetch-field "mail-copies-to") |
5572 |
|
author (or (message-fetch-field "mail-reply-to") |
5573 |
|
(message-fetch-field "reply-to") |
5574 |
|
(message-fetch-field "from") |
5575 |
|
"") |
5576 |
|
mft (and message-use-mail-followup-to |
5577 |
|
(message-fetch-field "mail-followup-to")))) |
5578 |
|
|
5579 |
;; Handle special values of Mail-Copies-To. |
;; Handle special values of Mail-Copies-To. |
5580 |
(when mct |
(when mct |
5584 |
(setq mct nil)) |
(setq mct nil)) |
5585 |
((or (equal (downcase mct) "always") |
((or (equal (downcase mct) "always") |
5586 |
(equal (downcase mct) "poster")) |
(equal (downcase mct) "poster")) |
5587 |
(setq mct (or reply-to from))))) |
(setq mct author)))) |
5588 |
|
|
5589 |
(if (or (not wide) |
(save-match-data |
5590 |
to-address) |
;; Build (textual) list of new recipient addresses. |
5591 |
(progn |
(cond |
5592 |
(setq follow-to (list (cons 'To (or to-address reply-to from)))) |
((not wide) |
5593 |
(when (and wide mct) |
(setq recipients (concat ", " author))) |
5594 |
(push (cons 'Cc mct) follow-to))) |
(address-headers |
5595 |
(let (ccalist) |
(dolist (header address-headers) |
5596 |
(save-excursion |
(let ((value (message-fetch-field header))) |
5597 |
(message-set-work-buffer) |
(when value |
5598 |
(unless never-mct |
(setq recipients (concat recipients ", " value)))))) |
5599 |
(insert (or reply-to from ""))) |
((and mft |
5600 |
(insert (if to (concat (if (bolp) "" ", ") to "") "")) |
(string-match "[^ \t,]" mft) |
5601 |
(insert (if mct (concat (if (bolp) "" ", ") mct) "")) |
(or (not (eq message-use-mail-followup-to 'ask)) |
5602 |
(insert (if cc (concat (if (bolp) "" ", ") cc) "")) |
(message-y-or-n-p "Obey Mail-Followup-To? " t "\ |
5603 |
(goto-char (point-min)) |
You should normally obey the Mail-Followup-To: header. In this |
5604 |
(while (re-search-forward "[ \t]+" nil t) |
article, it has the value of |
5605 |
(replace-match " " t t)) |
|
5606 |
;; Remove addresses that match `rmail-dont-reply-to-names'. |
" mft " |
5607 |
(let ((rmail-dont-reply-to-names message-dont-reply-to-names)) |
|
5608 |
(insert (prog1 (rmail-dont-reply-to (buffer-string)) |
which directs your response to " (if (string-match "," mft) |
5609 |
(erase-buffer)))) |
"the specified addresses" |
5610 |
(goto-char (point-min)) |
"that address only") ". |
5611 |
;; Perhaps "Mail-Copies-To: never" removed the only address? |
|
5612 |
(when (eobp) |
Most commonly, Mail-Followup-To is used by a mailing list poster to |
5613 |
(insert (or reply-to from ""))) |
express that responses should be sent to just the list, and not the |
5614 |
(setq ccalist |
poster as well. |
5615 |
(mapcar |
|
5616 |
(lambda (addr) |
If a message is posted to several mailing lists, Mail-Followup-To may |
5617 |
(cons (mail-strip-quoted-names addr) addr)) |
also be used to direct the following discussion to one list only, |
5618 |
(message-tokenize-header (buffer-string)))) |
because discussions that are spread over several lists tend to be |
5619 |
(let ((s ccalist)) |
fragmented and very difficult to follow. |
5620 |
(while s |
|
5621 |
(setq ccalist (delq (assoc (car (pop s)) s) ccalist))))) |
Also, some source/announcement lists are not intended for discussion; |
5622 |
(setq follow-to (list (cons 'To (cdr (pop ccalist))))) |
responses here are directed to other addresses."))) |
5623 |
(when ccalist |
(setq recipients (concat ", " mft))) |
5624 |
(let ((ccs (cons 'Cc (mapconcat |
(to-address |
5625 |
(lambda (addr) (cdr addr)) ccalist ", ")))) |
(setq recipients (concat ", " to-address)) |
5626 |
(when (string-match "^ +" (cdr ccs)) |
;; If the author explicitly asked for a copy, we don't deny it to them. |
5627 |
(setcdr ccs (substring (cdr ccs) (match-end 0)))) |
(if mct (setq recipients (concat recipients ", " mct)))) |
5628 |
(push ccs follow-to))))) |
(t |
5629 |
|
(setq recipients (if never-mct "" (concat ", " author))) |
5630 |
|
(if to (setq recipients (concat recipients ", " to))) |
5631 |
|
(if cc (setq recipients (concat recipients ", " cc))) |
5632 |
|
(if mct (setq recipients (concat recipients ", " mct))))) |
5633 |
|
(if (>= (length recipients) 2) |
5634 |
|
;; Strip the leading ", ". |
5635 |
|
(setq recipients (substring recipients 2))) |
5636 |
|
;; Squeeze whitespace. |
5637 |
|
(while (string-match "[ \t][ \t]+" recipients) |
5638 |
|
(setq recipients (replace-match " " t t recipients))) |
5639 |
|
;; Remove addresses that match `rmail-dont-reply-to-names'. |
5640 |
|
(let ((rmail-dont-reply-to-names message-dont-reply-to-names)) |
5641 |
|
(setq recipients (rmail-dont-reply-to recipients))) |
5642 |
|
;; Perhaps "Mail-Copies-To: never" removed the only address? |
5643 |
|
(if (string-equal recipients "") |
5644 |
|
(setq recipients author)) |
5645 |
|
;; Convert string to a list of (("foo@bar" . "Name <Foo@BAR>") ...). |
5646 |
|
(setq recipients |
5647 |
|
(mapcar |
5648 |
|
(lambda (addr) |
5649 |
|
(cons (downcase (mail-strip-quoted-names addr)) addr)) |
5650 |
|
(message-tokenize-header recipients))) |
5651 |
|
;; Remove first duplicates. (Why not all duplicates? Is this a bug?) |
5652 |
|
(let ((s recipients)) |
5653 |
|
(while s |
5654 |
|
(setq recipients (delq (assoc (car (pop s)) s) recipients)))) |
5655 |
|
|
5656 |
|
;; Remove hierarchical lists that are contained within each other, |
5657 |
|
;; if message-hierarchical-addresses is defined. |
5658 |
|
(when message-hierarchical-addresses |
5659 |
|
(let ((plain-addrs (mapcar 'car recipients)) |
5660 |
|
subaddrs recip) |
5661 |
|
(while plain-addrs |
5662 |
|
(setq subaddrs (assoc (car plain-addrs) |
5663 |
|
message-hierarchical-addresses) |
5664 |
|
plain-addrs (cdr plain-addrs)) |
5665 |
|
(when subaddrs |
5666 |
|
(setq subaddrs (cdr subaddrs)) |
5667 |
|
(while subaddrs |
5668 |
|
(setq recip (assoc (car subaddrs) recipients) |
5669 |
|
subaddrs (cdr subaddrs)) |
5670 |
|
(if recip |
5671 |
|
(setq recipients (delq recip recipients)))))))) |
5672 |
|
|
5673 |
|
;; Build the header alist. Allow the user to be asked whether |
5674 |
|
;; or not to reply to all recipients in a wide reply. |
5675 |
|
(setq follow-to (list (cons 'To (cdr (pop recipients))))) |
5676 |
|
(when (and recipients |
5677 |
|
(or (not message-wide-reply-confirm-recipients) |
5678 |
|
(y-or-n-p "Reply to all recipients? "))) |
5679 |
|
(setq recipients (mapconcat |
5680 |
|
(lambda (addr) (cdr addr)) recipients ", ")) |
5681 |
|
(if (string-match "^ +" recipients) |
5682 |
|
(setq recipients (substring recipients (match-end 0)))) |
5683 |
|
(push (cons 'Cc recipients) follow-to))) |
5684 |
follow-to)) |
follow-to)) |
5685 |
|
|
|
|
|
5686 |
;;;###autoload |
;;;###autoload |
5687 |
(defun message-reply (&optional to-address wide) |
(defun message-reply (&optional to-address wide) |
5688 |
"Start editing a reply to the article in the current buffer." |
"Start editing a reply to the article in the current buffer." |
5699 |
;; Allow customizations to have their say. |
;; Allow customizations to have their say. |
5700 |
(if (not wide) |
(if (not wide) |
5701 |
;; This is a regular reply. |
;; This is a regular reply. |
5702 |
(if (message-functionp message-reply-to-function) |
(when (functionp message-reply-to-function) |
|
(setq follow-to (funcall message-reply-to-function))) |
|
|
;; This is a followup. |
|
|
(if (message-functionp message-wide-reply-to-function) |
|
5703 |
(save-excursion |
(save-excursion |
5704 |
(setq follow-to |
(setq follow-to (funcall message-reply-to-function)))) |
5705 |
(funcall message-wide-reply-to-function))))) |
;; This is a followup. |
5706 |
|
(when (functionp message-wide-reply-to-function) |
5707 |
|
(save-excursion |
5708 |
|
(setq follow-to |
5709 |
|
(funcall message-wide-reply-to-function))))) |
5710 |
(setq message-id (message-fetch-field "message-id" t) |
(setq message-id (message-fetch-field "message-id" t) |
5711 |
references (message-fetch-field "references") |
references (message-fetch-field "references") |
5712 |
date (message-fetch-field "date") |
date (message-fetch-field "date") |
5713 |
from (message-fetch-field "from") |
from (message-fetch-field "from") |
5714 |
subject (or (message-fetch-field "subject") "none")) |
subject (or (message-fetch-field "subject") "none")) |
5715 |
(if gnus-list-identifiers |
(when gnus-list-identifiers |
5716 |
(setq subject (message-strip-list-identifiers subject))) |
(setq subject (message-strip-list-identifiers subject))) |
5717 |
(setq subject (concat "Re: " (message-strip-subject-re subject))) |
(setq subject (concat "Re: " (message-strip-subject-re subject))) |
5718 |
|
(when message-subject-trailing-was-query |
5719 |
|
(setq subject (message-strip-subject-trailing-was subject))) |
5720 |
|
|
5721 |
(when (and (setq gnus-warning (message-fetch-field "gnus-warning")) |
(when (and (setq gnus-warning (message-fetch-field "gnus-warning")) |
5722 |
(string-match "<[^>]+>" gnus-warning)) |
(string-match "<[^>]+>" gnus-warning)) |
5723 |
(setq message-id (match-string 0 gnus-warning))) |
(setq message-id (match-string 0 gnus-warning))) |
5724 |
|
|
5725 |
(unless follow-to |
(unless follow-to |
5726 |
(setq follow-to (message-get-reply-headers wide to-address)))) |
(setq follow-to (message-get-reply-headers wide to-address)))) |
5727 |
|
|
5728 |
(unless (message-mail-user-agent) |
(unless (message-mail-user-agent) |
5729 |
(message-pop-to-buffer |
(message-pop-to-buffer |
5736 |
|
|
5737 |
(message-setup |
(message-setup |
5738 |
`((Subject . ,subject) |
`((Subject . ,subject) |
5739 |
,@follow-to |
,@follow-to) |
|
,@(if (or references message-id) |
|
|
`((References . ,(concat (or references "") (and references " ") |
|
|
(or message-id "")))) |
|
|
nil)) |
|
5740 |
cur))) |
cur))) |
5741 |
|
|
5742 |
;;;###autoload |
;;;###autoload |
5752 |
(interactive) |
(interactive) |
5753 |
(require 'gnus-sum) ; for gnus-list-identifiers |
(require 'gnus-sum) ; for gnus-list-identifiers |
5754 |
(let ((cur (current-buffer)) |
(let ((cur (current-buffer)) |
5755 |
from subject date reply-to mct |
from subject date reply-to mrt mct |
5756 |
references message-id follow-to |
references message-id follow-to |
5757 |
(inhibit-point-motion-hooks t) |
(inhibit-point-motion-hooks t) |
5758 |
(message-this-is-news t) |
(message-this-is-news t) |
5763 |
(if (search-forward "\n\n" nil t) |
(if (search-forward "\n\n" nil t) |
5764 |
(1- (point)) |
(1- (point)) |
5765 |
(point-max))) |
(point-max))) |
5766 |
(when (message-functionp message-followup-to-function) |
(when (functionp message-followup-to-function) |
5767 |
(setq follow-to |
(setq follow-to |
5768 |
(funcall message-followup-to-function))) |
(funcall message-followup-to-function))) |
5769 |
(setq from (message-fetch-field "from") |
(setq from (message-fetch-field "from") |
5775 |
newsgroups (message-fetch-field "newsgroups") |
newsgroups (message-fetch-field "newsgroups") |
5776 |
posted-to (message-fetch-field "posted-to") |
posted-to (message-fetch-field "posted-to") |
5777 |
reply-to (message-fetch-field "reply-to") |
reply-to (message-fetch-field "reply-to") |
5778 |
|
mrt (message-fetch-field "mail-reply-to") |
5779 |
distribution (message-fetch-field "distribution") |
distribution (message-fetch-field "distribution") |
5780 |
mct (message-fetch-field "mail-copies-to")) |
mct (message-fetch-field "mail-copies-to")) |
5781 |
(when (and (setq gnus-warning (message-fetch-field "gnus-warning")) |
(when (and (setq gnus-warning (message-fetch-field "gnus-warning")) |
5789 |
(if gnus-list-identifiers |
(if gnus-list-identifiers |
5790 |
(setq subject (message-strip-list-identifiers subject))) |
(setq subject (message-strip-list-identifiers subject))) |
5791 |
(setq subject (concat "Re: " (message-strip-subject-re subject))) |
(setq subject (concat "Re: " (message-strip-subject-re subject))) |
5792 |
|
(when message-subject-trailing-was-query |
5793 |
|
(setq subject (message-strip-subject-trailing-was subject))) |
5794 |
(widen)) |
(widen)) |
5795 |
|
|
5796 |
(message-pop-to-buffer (message-buffer-name "followup" from newsgroups)) |
(message-pop-to-buffer (message-buffer-name "followup" from newsgroups)) |
5797 |
|
|
5798 |
|
(setq message-reply-headers |
5799 |
|
(vector 0 subject from date message-id references 0 0 "")) |
5800 |
|
|
5801 |
(message-setup |
(message-setup |
5802 |
`((Subject . ,subject) |
`((Subject . ,subject) |
5803 |
,@(cond |
,@(cond |
5818 |
does not read the newsgroup, so he wouldn't see any replies sent to it.")) |
does not read the newsgroup, so he wouldn't see any replies sent to it.")) |
5819 |
(progn |
(progn |
5820 |
(setq message-this-is-news nil) |
(setq message-this-is-news nil) |
5821 |
(cons 'To (or reply-to from ""))) |
(cons 'To (or mrt reply-to from ""))) |
5822 |
(cons 'Newsgroups newsgroups))) |
(cons 'Newsgroups newsgroups))) |
5823 |
(t |
(t |
5824 |
(if (or (equal followup-to newsgroups) |
(if (or (equal followup-to newsgroups) |
5837 |
because discussions that are spread over several newsgroup tend to |
because discussions that are spread over several newsgroup tend to |
5838 |
be fragmented and very difficult to follow. |
be fragmented and very difficult to follow. |
5839 |
|
|
5840 |
Also, some source/announcement newsgroups are not indented for discussion; |
Also, some source/announcement newsgroups are not intended for discussion; |
5841 |
responses here are directed to other newsgroups.")) |
responses here are directed to other newsgroups.")) |
5842 |
(cons 'Newsgroups followup-to) |
(cons 'Newsgroups followup-to) |
5843 |
(cons 'Newsgroups newsgroups)))))) |
(cons 'Newsgroups newsgroups)))))) |
5846 |
(t |
(t |
5847 |
`((Newsgroups . ,newsgroups)))) |
`((Newsgroups . ,newsgroups)))) |
5848 |
,@(and distribution (list (cons 'Distribution distribution))) |
,@(and distribution (list (cons 'Distribution distribution))) |
|
,@(if (or references message-id) |
|
|
`((References . ,(concat (or references "") (and references " ") |
|
|
(or message-id ""))))) |
|
5849 |
,@(when (and mct |
,@(when (and mct |
5850 |
(not (or (equal (downcase mct) "never") |
(not (or (equal (downcase mct) "never") |
5851 |
(equal (downcase mct) "nobody")))) |
(equal (downcase mct) "nobody")))) |
5852 |
(list (cons 'Cc (if (or (equal (downcase mct) "always") |
(list (cons 'Cc (if (or (equal (downcase mct) "always") |
5853 |
(equal (downcase mct) "poster")) |
(equal (downcase mct) "poster")) |
5854 |
(or reply-to from "") |
(or mrt reply-to from "") |
5855 |
mct))))) |
mct))))) |
5856 |
|
|
5857 |
cur) |
cur))) |
|
|
|
|
(setq message-reply-headers |
|
|
(vector 0 subject from date message-id references 0 0 "")))) |
|
5858 |
|
|
5859 |
|
(defun message-is-yours-p () |
5860 |
|
"Non-nil means current article is yours. |
5861 |
|
If you have added 'cancel-messages to 'message-shoot-gnksa-feet', all articles |
5862 |
|
are yours except those that have Cancel-Lock header not belonging to you. |
5863 |
|
Instead of shooting GNKSA feet, you should modify 'message-alternative-emails' |
5864 |
|
regexp to match all of yours addresses." |
5865 |
|
;; Canlock-logic as suggested by Per Abrahamsen |
5866 |
|
;; <abraham@dina.kvl.dk> |
5867 |
|
;; |
5868 |
|
;; IF article has cancel-lock THEN |
5869 |
|
;; IF we can verify it THEN |
5870 |
|
;; issue cancel |
5871 |
|
;; ELSE |
5872 |
|
;; error: cancellock: article is not yours |
5873 |
|
;; ELSE |
5874 |
|
;; Use old rules, comparing sender... |
5875 |
|
(save-excursion |
5876 |
|
(save-restriction |
5877 |
|
(message-narrow-to-head-1) |
5878 |
|
(if (message-fetch-field "Cancel-Lock") |
5879 |
|
(if (null (canlock-verify)) |
5880 |
|
t |
5881 |
|
(error "Failed to verify Cancel-lock: This article is not yours")) |
5882 |
|
(let (sender from) |
5883 |
|
(or |
5884 |
|
(message-gnksa-enable-p 'cancel-messages) |
5885 |
|
(and (setq sender (message-fetch-field "sender")) |
5886 |
|
(string-equal (downcase sender) |
5887 |
|
(downcase (message-make-sender)))) |
5888 |
|
;; Email address in From field equals to our address |
5889 |
|
(and (setq from (message-fetch-field "from")) |
5890 |
|
(string-equal |
5891 |
|
(downcase (cadr (mail-extract-address-components from))) |
5892 |
|
(downcase (cadr (mail-extract-address-components |
5893 |
|
(message-make-from)))))) |
5894 |
|
;; Email address in From field matches |
5895 |
|
;; 'message-alternative-emails' regexp |
5896 |
|
(and from |
5897 |
|
message-alternative-emails |
5898 |
|
(string-match |
5899 |
|
message-alternative-emails |
5900 |
|
(cadr (mail-extract-address-components from)))))))))) |
5901 |
|
|
5902 |
;;;###autoload |
;;;###autoload |
5903 |
(defun message-cancel-news (&optional arg) |
(defun message-cancel-news (&optional arg) |
5906 |
(interactive "P") |
(interactive "P") |
5907 |
(unless (message-news-p) |
(unless (message-news-p) |
5908 |
(error "This is not a news article; canceling is impossible")) |
(error "This is not a news article; canceling is impossible")) |
5909 |
(when (yes-or-no-p "Do you really want to cancel this article? ") |
(let (from newsgroups message-id distribution buf) |
5910 |
(let (from newsgroups message-id distribution buf sender) |
(save-excursion |
5911 |
(save-excursion |
;; Get header info from original article. |
5912 |
;; Get header info from original article. |
(save-restriction |
5913 |
(save-restriction |
(message-narrow-to-head-1) |
5914 |
(message-narrow-to-head-1) |
(setq from (message-fetch-field "from") |
5915 |
(setq from (message-fetch-field "from") |
newsgroups (message-fetch-field "newsgroups") |
5916 |
sender (message-fetch-field "sender") |
message-id (message-fetch-field "message-id" t) |
5917 |
newsgroups (message-fetch-field "newsgroups") |
distribution (message-fetch-field "distribution"))) |
5918 |
message-id (message-fetch-field "message-id" t) |
;; Make sure that this article was written by the user. |
5919 |
distribution (message-fetch-field "distribution"))) |
(unless (message-is-yours-p) |
5920 |
;; Make sure that this article was written by the user. |
(error "This article is not yours")) |
5921 |
(unless (or (and sender |
(when (yes-or-no-p "Do you really want to cancel this article? ") |
|
(string-equal |
|
|
(downcase sender) |
|
|
(downcase (message-make-sender)))) |
|
|
(string-equal |
|
|
(downcase (cadr (mail-extract-address-components from))) |
|
|
(downcase (cadr (mail-extract-address-components |
|
|
(message-make-from)))))) |
|
|
(error "This article is not yours")) |
|
5922 |
;; Make control message. |
;; Make control message. |
5923 |
(if arg |
(if arg |
5924 |
(message-news) |
(message-news) |
5925 |
(setq buf (set-buffer (get-buffer-create " *message cancel*")))) |
(setq buf (set-buffer (get-buffer-create " *message cancel*")))) |
5926 |
(erase-buffer) |
(erase-buffer) |
5927 |
(insert "Newsgroups: " newsgroups "\n" |
(insert "Newsgroups: " newsgroups "\n" |
5928 |
"From: " from "\n" |
"From: " from "\n" |
5929 |
"Subject: cmsg cancel " message-id "\n" |
"Subject: cmsg cancel " message-id "\n" |
5930 |
"Control: cancel " message-id "\n" |
"Control: cancel " message-id "\n" |
5931 |
(if distribution |
(if distribution |
5948 |
This is done simply by taking the old article and adding a Supersedes |
This is done simply by taking the old article and adding a Supersedes |
5949 |
header line with the old Message-ID." |
header line with the old Message-ID." |
5950 |
(interactive) |
(interactive) |
5951 |
(let ((cur (current-buffer)) |
(let ((cur (current-buffer))) |
|
(sender (message-fetch-field "sender")) |
|
|
(from (message-fetch-field "from"))) |
|
5952 |
;; Check whether the user owns the article that is to be superseded. |
;; Check whether the user owns the article that is to be superseded. |
5953 |
(unless (or (and sender |
(unless (message-is-yours-p) |
|
(string-equal |
|
|
(downcase sender) |
|
|
(downcase (message-make-sender)))) |
|
|
(string-equal |
|
|
(downcase (cadr (mail-extract-address-components from))) |
|
|
(downcase (cadr (mail-extract-address-components |
|
|
(message-make-from)))))) |
|
5954 |
(error "This article is not yours")) |
(error "This article is not yours")) |
5955 |
;; Get a normal message buffer. |
;; Get a normal message buffer. |
5956 |
(message-pop-to-buffer (message-buffer-name "supersede")) |
(message-pop-to-buffer (message-buffer-name "supersede")) |
6027 |
(defvar message-forward-decoded-p nil |
(defvar message-forward-decoded-p nil |
6028 |
"Non-nil means the original message is decoded.") |
"Non-nil means the original message is decoded.") |
6029 |
|
|
6030 |
|
(defun message-forward-subject-name-subject (subject) |
6031 |
|
"Generate a SUBJECT for a forwarded message. |
6032 |
|
The form is: [Source] Subject, where if the original message was mail, |
6033 |
|
Source is the name of the sender, and if the original message was |
6034 |
|
news, Source is the list of newsgroups is was posted to." |
6035 |
|
(let* ((group (message-fetch-field "newsgroups")) |
6036 |
|
(from (message-fetch-field "from")) |
6037 |
|
(prefix |
6038 |
|
(if group |
6039 |
|
(gnus-group-decoded-name group) |
6040 |
|
(or (and from (car (gnus-extract-address-components from))) |
6041 |
|
"(nowhere)")))) |
6042 |
|
(concat "[" |
6043 |
|
(if message-forward-decoded-p |
6044 |
|
prefix |
6045 |
|
(mail-decode-encoded-word-string prefix)) |
6046 |
|
"] " subject))) |
6047 |
|
|
6048 |
(defun message-forward-subject-author-subject (subject) |
(defun message-forward-subject-author-subject (subject) |
6049 |
"Generate a SUBJECT for a forwarded message. |
"Generate a SUBJECT for a forwarded message. |
6050 |
The form is: [Source] Subject, where if the original message was mail, |
The form is: [Source] Subject, where if the original message was mail, |
6051 |
Source is the sender, and if the original message was news, Source is |
Source is the sender, and if the original message was news, Source is |
6052 |
the list of newsgroups is was posted to." |
the list of newsgroups is was posted to." |
6053 |
(concat "[" |
(let* ((group (message-fetch-field "newsgroups")) |
6054 |
(let ((prefix |
(prefix |
6055 |
(or (message-fetch-field "newsgroups") |
(if group |
6056 |
(message-fetch-field "from") |
(gnus-group-decoded-name group) |
6057 |
"(nowhere)"))) |
(or (message-fetch-field "from") |
6058 |
(if message-forward-decoded-p |
"(nowhere)")))) |
6059 |
prefix |
(concat "[" |
6060 |
(mail-decode-encoded-word-string prefix))) |
(if message-forward-decoded-p |
6061 |
"] " subject)) |
prefix |
6062 |
|
(mail-decode-encoded-word-string prefix)) |
6063 |
|
"] " subject))) |
6064 |
|
|
6065 |
(defun message-forward-subject-fwd (subject) |
(defun message-forward-subject-fwd (subject) |
6066 |
"Generate a SUBJECT for a forwarded message. |
"Generate a SUBJECT for a forwarded message. |
6067 |
The form is: Fwd: Subject, where Subject is the original subject of |
The form is: Fwd: Subject, where Subject is the original subject of |
6068 |
the message." |
the message." |
6069 |
(concat "Fwd: " subject)) |
(if (string-match "^Fwd: " subject) |
6070 |
|
subject |
6071 |
|
(concat "Fwd: " subject))) |
6072 |
|
|
6073 |
(defun message-make-forward-subject () |
(defun message-make-forward-subject () |
6074 |
"Return a Subject header suitable for the message in the current buffer." |
"Return a Subject header suitable for the message in the current buffer." |
6092 |
;; Apply funcs in order, passing subject generated by previous |
;; Apply funcs in order, passing subject generated by previous |
6093 |
;; func to the next one. |
;; func to the next one. |
6094 |
(while funcs |
(while funcs |
6095 |
(when (message-functionp (car funcs)) |
(when (functionp (car funcs)) |
6096 |
(setq subject (funcall (car funcs) subject))) |
(setq subject (funcall (car funcs) subject))) |
6097 |
(setq funcs (cdr funcs))) |
(setq funcs (cdr funcs))) |
6098 |
subject)))) |
subject)))) |
6118 |
(message-mail nil subject)) |
(message-mail nil subject)) |
6119 |
(message-forward-make-body cur digest))) |
(message-forward-make-body cur digest))) |
6120 |
|
|
6121 |
|
(defun message-forward-make-body-plain (forward-buffer) |
6122 |
|
(insert |
6123 |
|
"\n-------------------- Start of forwarded message --------------------\n") |
6124 |
|
(let ((b (point)) e) |
6125 |
|
(insert |
6126 |
|
(with-temp-buffer |
6127 |
|
(mm-disable-multibyte) |
6128 |
|
(insert |
6129 |
|
(with-current-buffer forward-buffer |
6130 |
|
(mm-with-unibyte-current-buffer (buffer-string)))) |
6131 |
|
(mm-enable-multibyte) |
6132 |
|
(mime-to-mml) |
6133 |
|
(goto-char (point-min)) |
6134 |
|
(when (looking-at "From ") |
6135 |
|
(replace-match "X-From-Line: ")) |
6136 |
|
(buffer-string))) |
6137 |
|
(setq e (point)) |
6138 |
|
(insert |
6139 |
|
"\n-------------------- End of forwarded message --------------------\n") |
6140 |
|
(when (and (not current-prefix-arg) |
6141 |
|
message-forward-ignored-headers) |
6142 |
|
(save-restriction |
6143 |
|
(narrow-to-region b e) |
6144 |
|
(goto-char b) |
6145 |
|
(narrow-to-region (point) |
6146 |
|
(or (search-forward "\n\n" nil t) (point))) |
6147 |
|
(message-remove-header message-forward-ignored-headers t))))) |
6148 |
|
|
6149 |
|
(defun message-forward-make-body-mime (forward-buffer) |
6150 |
|
(insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n") |
6151 |
|
(let ((b (point)) e) |
6152 |
|
(save-restriction |
6153 |
|
(narrow-to-region (point) (point)) |
6154 |
|
(mml-insert-buffer forward-buffer) |
6155 |
|
(goto-char (point-min)) |
6156 |
|
(when (looking-at "From ") |
6157 |
|
(replace-match "X-From-Line: ")) |
6158 |
|
(goto-char (point-max))) |
6159 |
|
(setq e (point)) |
6160 |
|
(insert "<#/part>\n"))) |
6161 |
|
|
6162 |
|
(defun message-forward-make-body-mml (forward-buffer) |
6163 |
|
(insert "\n\n<#mml type=message/rfc822 disposition=inline>\n") |
6164 |
|
(let ((b (point)) e) |
6165 |
|
(if (not message-forward-decoded-p) |
6166 |
|
(insert |
6167 |
|
(with-temp-buffer |
6168 |
|
(mm-disable-multibyte) |
6169 |
|
(insert |
6170 |
|
(with-current-buffer forward-buffer |
6171 |
|
(mm-with-unibyte-current-buffer (buffer-string)))) |
6172 |
|
(mm-enable-multibyte) |
6173 |
|
(mime-to-mml) |
6174 |
|
(goto-char (point-min)) |
6175 |
|
(when (looking-at "From ") |
6176 |
|
(replace-match "X-From-Line: ")) |
6177 |
|
(buffer-string))) |
6178 |
|
(save-restriction |
6179 |
|
(narrow-to-region (point) (point)) |
6180 |
|
(mml-insert-buffer forward-buffer) |
6181 |
|
(goto-char (point-min)) |
6182 |
|
(when (looking-at "From ") |
6183 |
|
(replace-match "X-From-Line: ")) |
6184 |
|
(goto-char (point-max)))) |
6185 |
|
(setq e (point)) |
6186 |
|
(insert "<#/mml>\n") |
6187 |
|
(when (and (not current-prefix-arg) |
6188 |
|
message-forward-ignored-headers) |
6189 |
|
(save-restriction |
6190 |
|
(narrow-to-region b e) |
6191 |
|
(goto-char b) |
6192 |
|
(narrow-to-region (point) |
6193 |
|
(or (search-forward "\n\n" nil t) (point))) |
6194 |
|
(message-remove-header message-forward-ignored-headers t))))) |
6195 |
|
|
6196 |
|
(defun message-forward-make-body-digest-plain (forward-buffer) |
6197 |
|
(insert |
6198 |
|
"\n-------------------- Start of forwarded message --------------------\n") |
6199 |
|
(let ((b (point)) e) |
6200 |
|
(mml-insert-buffer forward-buffer) |
6201 |
|
(setq e (point)) |
6202 |
|
(insert |
6203 |
|
"\n-------------------- End of forwarded message --------------------\n"))) |
6204 |
|
|
6205 |
|
(defun message-forward-make-body-digest-mime (forward-buffer) |
6206 |
|
(insert "\n<#multipart type=digest>\n") |
6207 |
|
(let ((b (point)) e) |
6208 |
|
(insert-buffer-substring forward-buffer) |
6209 |
|
(setq e (point)) |
6210 |
|
(insert "<#/multipart>\n") |
6211 |
|
(save-restriction |
6212 |
|
(narrow-to-region b e) |
6213 |
|
(goto-char b) |
6214 |
|
(narrow-to-region (point) |
6215 |
|
(or (search-forward "\n\n" nil t) (point))) |
6216 |
|
(delete-region (point-min) (point-max))))) |
6217 |
|
|
6218 |
|
(defun message-forward-make-body-digest (forward-buffer) |
6219 |
|
(if message-forward-as-mime |
6220 |
|
(message-forward-make-body-digest-mime forward-buffer) |
6221 |
|
(message-forward-make-body-digest-plain forward-buffer))) |
6222 |
|
|
6223 |
;;;###autoload |
;;;###autoload |
6224 |
(defun message-forward-make-body (forward-buffer &optional digest) |
(defun message-forward-make-body (forward-buffer &optional digest) |
6225 |
;; Put point where we want it before inserting the forwarded |
;; Put point where we want it before inserting the forwarded |
6227 |
(if message-forward-before-signature |
(if message-forward-before-signature |
6228 |
(message-goto-body) |
(message-goto-body) |
6229 |
(goto-char (point-max))) |
(goto-char (point-max))) |
6230 |
(if message-forward-as-mime |
(if digest |
6231 |
(if digest |
(message-forward-make-body-digest forward-buffer) |
|
(insert "\n<#multipart type=digest>\n") |
|
|
(if message-forward-show-mml |
|
|
(insert "\n\n<#mml type=message/rfc822 disposition=inline>\n") |
|
|
(insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n"))) |
|
|
(insert "\n-------------------- Start of forwarded message --------------------\n")) |
|
|
(let ((b (point)) e) |
|
|
(if digest |
|
|
(if message-forward-as-mime |
|
|
(insert-buffer-substring forward-buffer) |
|
|
(mml-insert-buffer forward-buffer)) |
|
|
(if (and message-forward-show-mml |
|
|
(not message-forward-decoded-p)) |
|
|
(insert |
|
|
(with-temp-buffer |
|
|
(mm-disable-multibyte) ;; Must copy buffer in unibyte mode |
|
|
(insert |
|
|
(with-current-buffer forward-buffer |
|
|
(mm-string-as-unibyte (buffer-string)))) |
|
|
(mm-enable-multibyte) |
|
|
(mime-to-mml) |
|
|
(goto-char (point-min)) |
|
|
(when (looking-at "From ") |
|
|
(replace-match "X-From-Line: ")) |
|
|
(buffer-string))) |
|
|
(save-restriction |
|
|
(narrow-to-region (point) (point)) |
|
|
(mml-insert-buffer forward-buffer) |
|
|
(goto-char (point-min)) |
|
|
(when (looking-at "From ") |
|
|
(replace-match "X-From-Line: ")) |
|
|
(goto-char (point-max))))) |
|
|
(setq e (point)) |
|
6232 |
(if message-forward-as-mime |
(if message-forward-as-mime |
6233 |
(if digest |
(if (and message-forward-show-mml |
6234 |
(insert "<#/multipart>\n") |
(not (and (eq message-forward-show-mml 'best) |
6235 |
(if message-forward-show-mml |
(with-current-buffer forward-buffer |
6236 |
(insert "<#/mml>\n") |
(goto-char (point-min)) |
6237 |
(insert "<#/part>\n"))) |
(re-search-forward |
6238 |
(insert "\n-------------------- End of forwarded message --------------------\n")) |
"Content-Type: *multipart/\\(signed\\|encrypted\\)" |
6239 |
(if (and digest message-forward-as-mime) |
nil t))))) |
6240 |
(save-restriction |
(message-forward-make-body-mml forward-buffer) |
6241 |
(narrow-to-region b e) |
(message-forward-make-body-mime forward-buffer)) |
6242 |
(goto-char b) |
(message-forward-make-body-plain forward-buffer))) |
|
(narrow-to-region (point) |
|
|
(or (search-forward "\n\n" nil t) (point))) |
|
|
(delete-region (point-min) (point-max))) |
|
|
(when (and (not current-prefix-arg) |
|
|
message-forward-ignored-headers) |
|
|
(save-restriction |
|
|
(narrow-to-region b e) |
|
|
(goto-char b) |
|
|
(narrow-to-region (point) |
|
|
(or (search-forward "\n\n" nil t) (point))) |
|
|
(message-remove-header message-forward-ignored-headers t))))) |
|
6243 |
(message-position-point)) |
(message-position-point)) |
6244 |
|
|
6245 |
;;;###autoload |
;;;###autoload |
6246 |
(defun message-forward-rmail-make-body (forward-buffer) |
(defun message-forward-rmail-make-body (forward-buffer) |
6247 |
(save-window-excursion |
(save-window-excursion |
6248 |
(set-buffer forward-buffer) |
(set-buffer forward-buffer) |
6249 |
|
;; Rmail doesn't have rmail-msg-restore-non-pruned-header in Emacs |
6250 |
|
;; 20. FIXIT, or we drop support for rmail in Emacs 20. |
6251 |
(if (rmail-msg-is-pruned) |
(if (rmail-msg-is-pruned) |
6252 |
(rmail-msg-restore-non-pruned-header))) |
(rmail-msg-restore-non-pruned-header))) |
6253 |
(message-forward-make-body forward-buffer)) |
(message-forward-make-body forward-buffer)) |
6254 |
|
|
6255 |
|
(eval-when-compile (defvar rmail-enable-mime-composing)) |
6256 |
|
|
6257 |
|
;; Fixme: Should have defcustom. |
6258 |
;;;###autoload |
;;;###autoload |
6259 |
(defun message-insinuate-rmail () |
(defun message-insinuate-rmail () |
6260 |
"Let RMAIL uses message to forward." |
"Let RMAIL use message to forward." |
6261 |
(interactive) |
(interactive) |
6262 |
(setq rmail-enable-mime-composing t) |
(setq rmail-enable-mime-composing t) |
6263 |
(setq rmail-insert-mime-forwarded-message-function |
(setq rmail-insert-mime-forwarded-message-function |
6276 |
(unless (message-mail-user-agent) |
(unless (message-mail-user-agent) |
6277 |
(set-buffer (get-buffer-create " *message resend*")) |
(set-buffer (get-buffer-create " *message resend*")) |
6278 |
(erase-buffer)) |
(erase-buffer)) |
6279 |
(let ((message-this-is-mail t)) |
(let ((message-this-is-mail t) |
6280 |
|
message-setup-hook) |
6281 |
(message-setup `((To . ,address)))) |
(message-setup `((To . ,address)))) |
6282 |
;; Insert our usual headers. |
;; Insert our usual headers. |
6283 |
(message-generate-headers '(From Date To)) |
(message-generate-headers '(From Date To Message-ID)) |
6284 |
(message-narrow-to-headers) |
(message-narrow-to-headers) |
6285 |
|
;; Remove X-Draft-From header etc. |
6286 |
|
(message-remove-header message-ignored-mail-headers t) |
6287 |
;; Rename them all to "Resent-*". |
;; Rename them all to "Resent-*". |
6288 |
|
(goto-char (point-min)) |
6289 |
(while (re-search-forward "^[A-Za-z]" nil t) |
(while (re-search-forward "^[A-Za-z]" nil t) |
6290 |
(forward-char -1) |
(forward-char -1) |
6291 |
(insert "Resent-")) |
(insert "Resent-")) |
6336 |
(mm-insert-part handles) |
(mm-insert-part handles) |
6337 |
(undo-boundary) |
(undo-boundary) |
6338 |
(goto-char (point-min)) |
(goto-char (point-min)) |
6339 |
(search-forward "\n\n" nil t) |
(re-search-forward "\n\n+" nil t) |
6340 |
(or (and (re-search-forward message-unsent-separator nil t) |
(setq boundary (point)) |
|
(forward-line 1)) |
|
|
(re-search-forward "^Return-Path:.*\n" nil t)) |
|
6341 |
;; We remove everything before the bounced mail. |
;; We remove everything before the bounced mail. |
6342 |
(delete-region |
(if (or (re-search-forward message-unsent-separator nil t) |
6343 |
(point-min) |
(progn |
6344 |
(if (re-search-forward "^[^ \n\t]+:" nil t) |
(search-forward "\n\n" nil 'move) |
6345 |
(match-beginning 0) |
(re-search-backward "^Return-Path:.*\n" boundary t))) |
6346 |
(point)))) |
(progn |
6347 |
|
(forward-line 1) |
6348 |
|
(delete-region (point-min) |
6349 |
|
(if (re-search-forward "^[^ \n\t]+:" nil t) |
6350 |
|
(match-beginning 0) |
6351 |
|
(point)))) |
6352 |
|
(goto-char boundary) |
6353 |
|
(when (re-search-backward "^.?From .*\n" nil t) |
6354 |
|
(delete-region (match-beginning 0) (match-end 0))))) |
6355 |
(mm-enable-multibyte) |
(mm-enable-multibyte) |
|
(mime-to-mml) |
|
6356 |
(save-restriction |
(save-restriction |
6357 |
(message-narrow-to-head-1) |
(message-narrow-to-head-1) |
6358 |
(message-remove-header message-ignored-bounced-headers t) |
(message-remove-header message-ignored-bounced-headers t) |
6403 |
(special-display-regexps nil) |
(special-display-regexps nil) |
6404 |
(same-window-buffer-names nil) |
(same-window-buffer-names nil) |
6405 |
(same-window-regexps nil)) |
(same-window-regexps nil)) |
6406 |
(message-pop-to-buffer (message-buffer-name "news" nil newsgroups))) |
(message-pop-to-buffer (message-buffer-name "posting" nil newsgroups))) |
6407 |
(let ((message-this-is-news t)) |
(let ((message-this-is-news t)) |
6408 |
(message-setup `((Newsgroups . ,(or newsgroups "")) |
(message-setup `((Newsgroups . ,(or newsgroups "")) |
6409 |
(Subject . ,(or subject "")))))) |
(Subject . ,(or subject "")))))) |
6417 |
(special-display-regexps nil) |
(special-display-regexps nil) |
6418 |
(same-window-buffer-names nil) |
(same-window-buffer-names nil) |
6419 |
(same-window-regexps nil)) |
(same-window-regexps nil)) |
6420 |
(message-pop-to-buffer (message-buffer-name "news" nil newsgroups))) |
(message-pop-to-buffer (message-buffer-name "posting" nil newsgroups))) |
6421 |
(let ((message-this-is-news t)) |
(let ((message-this-is-news t)) |
6422 |
(message-setup `((Newsgroups . ,(or newsgroups "")) |
(message-setup `((Newsgroups . ,(or newsgroups "")) |
6423 |
(Subject . ,(or subject "")))))) |
(Subject . ,(or subject "")))))) |
6456 |
(if (eq (char-after) (char-after (- (point) 2))) |
(if (eq (char-after) (char-after (- (point) 2))) |
6457 |
(delete-char -2)))))) |
(delete-char -2)))))) |
6458 |
|
|
6459 |
(defalias 'message-exchange-point-and-mark 'exchange-point-and-mark) |
(defun message-exchange-point-and-mark () |
6460 |
|
"Exchange point and mark, but don't activate region if it was inactive." |
6461 |
|
(unless (prog1 |
6462 |
|
(message-mark-active-p) |
6463 |
|
(exchange-point-and-mark)) |
6464 |
|
(setq mark-active nil))) |
6465 |
|
|
6466 |
|
(defalias 'message-make-overlay 'make-overlay) |
6467 |
|
(defalias 'message-delete-overlay 'delete-overlay) |
6468 |
|
(defalias 'message-overlay-put 'overlay-put) |
6469 |
|
(defun message-kill-all-overlays () |
6470 |
|
(if (featurep 'xemacs) |
6471 |
|
(map-extents (lambda (extent ignore) (delete-extent extent))) |
6472 |
|
(mapcar #'delete-overlay (overlays-in (point-min) (point-max))))) |
6473 |
|
|
6474 |
;; Support for toolbar |
;; Support for toolbar |
6475 |
(eval-when-compile (defvar tool-bar-map)) |
(eval-when-compile |
6476 |
(if (featurep 'xemacs) |
(defvar tool-bar-map) |
6477 |
(require 'messagexmas) |
(defvar tool-bar-mode)) |
6478 |
(when (and |
|
6479 |
(condition-case nil (require 'tool-bar) (error nil)) |
(defun message-tool-bar-local-item-from-menu (command icon in-map &optional from-map &rest props) |
6480 |
(fboundp 'tool-bar-add-item-from-menu) |
;; We need to make tool bar entries in local keymaps with |
6481 |
tool-bar-mode) |
;; `tool-bar-local-item-from-menu' in Emacs > 21.3 |
6482 |
(defvar message-tool-bar-map |
(if (fboundp 'tool-bar-local-item-from-menu) |
6483 |
(let ((tool-bar-map (copy-keymap tool-bar-map))) |
;; This is for Emacs 21.3 |
6484 |
;; Zap some items which aren't so relevant and take up space. |
(tool-bar-local-item-from-menu command icon in-map from-map props) |
6485 |
(dolist (key '(print-buffer kill-buffer save-buffer write-file |
(tool-bar-add-item-from-menu command icon from-map props))) |
6486 |
dired open-file)) |
|
6487 |
(define-key tool-bar-map (vector key) nil)) |
(defun message-tool-bar-map () |
6488 |
|
(or message-tool-bar-map |
6489 |
(tool-bar-add-item-from-menu |
(setq message-tool-bar-map |
6490 |
'message-send-and-exit "mail_send" message-mode-map) |
(and |
6491 |
(tool-bar-add-item-from-menu |
(condition-case nil (require 'tool-bar) (error nil)) |
6492 |
'message-kill-buffer "close" message-mode-map) |
(fboundp 'tool-bar-add-item-from-menu) |
6493 |
(tool-bar-add-item-from-menu |
tool-bar-mode |
6494 |
'message-dont-send "cancel" message-mode-map) |
(let ((tool-bar-map (copy-keymap tool-bar-map)) |
6495 |
(tool-bar-add-item-from-menu |
(load-path (mm-image-load-path))) |
6496 |
'mml-attach-file "attach" message-mode-map) |
;; Zap some items which aren't so relevant and take |
6497 |
(tool-bar-add-item-from-menu |
;; up space. |
6498 |
'ispell-message "spell" message-mode-map) |
(dolist (key '(print-buffer kill-buffer save-buffer |
6499 |
tool-bar-map)))) |
write-file dired open-file)) |
6500 |
|
(define-key tool-bar-map (vector key) nil)) |
6501 |
|
(message-tool-bar-local-item-from-menu |
6502 |
|
'message-send-and-exit "mail_send" tool-bar-map message-mode-map) |
6503 |
|
(message-tool-bar-local-item-from-menu |
6504 |
|
'message-kill-buffer "close" tool-bar-map message-mode-map) |
6505 |
|
(message-tool-bar-local-item-from-menu |
6506 |
|
'message-dont-send "cancel" tool-bar-map message-mode-map) |
6507 |
|
(message-tool-bar-local-item-from-menu |
6508 |
|
'mml-attach-file "attach" tool-bar-map mml-mode-map) |
6509 |
|
(message-tool-bar-local-item-from-menu |
6510 |
|
'ispell-message "spell" tool-bar-map message-mode-map) |
6511 |
|
(message-tool-bar-local-item-from-menu |
6512 |
|
'mml-preview "preview" |
6513 |
|
tool-bar-map mml-mode-map) |
6514 |
|
(message-tool-bar-local-item-from-menu |
6515 |
|
'message-insert-importance-high "important" |
6516 |
|
tool-bar-map message-mode-map) |
6517 |
|
(message-tool-bar-local-item-from-menu |
6518 |
|
'message-insert-importance-low "unimportant" |
6519 |
|
tool-bar-map message-mode-map) |
6520 |
|
(message-tool-bar-local-item-from-menu |
6521 |
|
'message-insert-disposition-notification-to "receipt" |
6522 |
|
tool-bar-map message-mode-map) |
6523 |
|
tool-bar-map))))) |
6524 |
|
|
6525 |
;;; Group name completion. |
;;; Group name completion. |
6526 |
|
|
6527 |
(defvar message-newgroups-header-regexp |
(defcustom message-newgroups-header-regexp |
6528 |
"^\\(Newsgroups\\|Followup-To\\|Posted-To\\|Gcc\\):" |
"^\\(Newsgroups\\|Followup-To\\|Posted-To\\|Gcc\\):" |
6529 |
"Regexp that match headers that lists groups.") |
"Regexp that match headers that lists groups." |
6530 |
|
:group 'message |
6531 |
|
:type 'regexp) |
6532 |
|
|
6533 |
|
(defcustom message-completion-alist |
6534 |
|
(list (cons message-newgroups-header-regexp 'message-expand-group) |
6535 |
|
'("^\\(Resent-\\)?\\(To\\|B?Cc\\):" . message-expand-name) |
6536 |
|
'("^\\(Reply-To\\|From\\|Mail-Followup-To\\|Mail-Copies-To\\):" |
6537 |
|
. message-expand-name) |
6538 |
|
'("^\\(Disposition-Notification-To\\|Return-Receipt-To\\):" |
6539 |
|
. message-expand-name)) |
6540 |
|
"Alist of (RE . FUN). Use FUN for completion on header lines matching RE." |
6541 |
|
:group 'message |
6542 |
|
:type '(alist :key-type regexp :value-type function)) |
6543 |
|
|
6544 |
|
(defcustom message-tab-body-function nil |
6545 |
|
"*Function to execute when `message-tab' (TAB) is executed in the body. |
6546 |
|
If nil, the function bound in `text-mode-map' or `global-map' is executed." |
6547 |
|
:group 'message |
6548 |
|
:link '(custom-manual "(message)Various Commands") |
6549 |
|
:type 'function) |
6550 |
|
|
6551 |
(defun message-tab () |
(defun message-tab () |
6552 |
"Expand group names in Newsgroups and Followup-To headers. |
"Complete names according to `message-completion-alist'. |
6553 |
Do a `tab-to-tab-stop' if not in those headers." |
Execute function specified by `message-tab-body-function' when not in |
6554 |
|
those headers." |
6555 |
(interactive) |
(interactive) |
6556 |
(if (let ((mail-abbrev-mode-regexp message-newgroups-header-regexp)) |
(let ((alist message-completion-alist)) |
6557 |
(mail-abbrev-in-expansion-header-p)) |
(while (and alist |
6558 |
(message-expand-group) |
(let ((mail-abbrev-mode-regexp (caar alist))) |
6559 |
(tab-to-tab-stop))) |
(not (mail-abbrev-in-expansion-header-p)))) |
6560 |
|
(setq alist (cdr alist))) |
6561 |
|
(funcall (or (cdar alist) message-tab-body-function |
6562 |
|
(lookup-key text-mode-map "\t") |
6563 |
|
(lookup-key global-map "\t") |
6564 |
|
'indent-relative)))) |
6565 |
|
|
6566 |
(defun message-expand-group () |
(defun message-expand-group () |
6567 |
"Expand the group name under point." |
"Expand the group name under point." |
6605 |
(goto-char (point-min)) |
(goto-char (point-min)) |
6606 |
(delete-region (point) (progn (forward-line 3) (point)))))))))) |
(delete-region (point) (progn (forward-line 3) (point)))))))))) |
6607 |
|
|
6608 |
|
(defun message-expand-name () |
6609 |
|
(if (fboundp 'bbdb-complete-name) |
6610 |
|
(bbdb-complete-name) |
6611 |
|
(expand-abbrev))) |
6612 |
|
|
6613 |
;;; Help stuff. |
;;; Help stuff. |
6614 |
|
|
6615 |
(defun message-talkative-question (ask question show &rest text) |
(defun message-talkative-question (ask question show &rest text) |
6639 |
(list list)))) |
(list list)))) |
6640 |
|
|
6641 |
(defun message-generate-new-buffer-clone-locals (name &optional varstr) |
(defun message-generate-new-buffer-clone-locals (name &optional varstr) |
6642 |
"Create and return a buffer with name based on NAME using `generate-new-buffer.' |
"Create and return a buffer with name based on NAME using `generate-new-buffer'. |
6643 |
Then clone the local variables and values from the old buffer to the |
Then clone the local variables and values from the old buffer to the |
6644 |
new one, cloning only the locals having a substring matching the |
new one, cloning only the locals having a substring matching the |
6645 |
regexp varstr." |
regexp VARSTR." |
6646 |
(let ((oldbuf (current-buffer))) |
(let ((oldbuf (current-buffer))) |
6647 |
(save-excursion |
(save-excursion |
6648 |
(set-buffer (generate-new-buffer name)) |
(set-buffer (generate-new-buffer name)) |
6700 |
(when lines |
(when lines |
6701 |
(insert lines)) |
(insert lines)) |
6702 |
(setq content-type-p |
(setq content-type-p |
6703 |
(re-search-backward "^Content-Type:" nil t))) |
(or mml-boundary |
6704 |
|
(re-search-backward "^Content-Type:" nil t)))) |
6705 |
(save-restriction |
(save-restriction |
6706 |
(message-narrow-to-headers-or-head) |
(message-narrow-to-headers-or-head) |
6707 |
(message-remove-first-header "Content-Type") |
(message-remove-first-header "Content-Type") |
6708 |
(message-remove-first-header "Content-Transfer-Encoding")) |
(message-remove-first-header "Content-Transfer-Encoding")) |
6709 |
;; We always make sure that the message has a Content-Type header. |
;; We always make sure that the message has a Content-Type |
6710 |
;; This is because some broken MTAs and MUAs get awfully confused |
;; header. This is because some broken MTAs and MUAs get |
6711 |
;; when confronted with a message with a MIME-Version header and |
;; awfully confused when confronted with a message with a |
6712 |
;; without a Content-Type header. For instance, Solaris' |
;; MIME-Version header and without a Content-Type header. For |
6713 |
;; /usr/bin/mail. |
;; instance, Solaris' /usr/bin/mail. |
6714 |
(unless content-type-p |
(unless content-type-p |
6715 |
(goto-char (point-min)) |
(goto-char (point-min)) |
6716 |
;; For unknown reason, MIME-Version doesn't exist. |
;; For unknown reason, MIME-Version doesn't exist. |
6718 |
(forward-line 1) |
(forward-line 1) |
6719 |
(insert "Content-Type: text/plain; charset=us-ascii\n")))))) |
(insert "Content-Type: text/plain; charset=us-ascii\n")))))) |
6720 |
|
|
6721 |
(defun message-read-from-minibuffer (prompt) |
(defun message-read-from-minibuffer (prompt &optional initial-contents) |
6722 |
"Read from the minibuffer while providing abbrev expansion." |
"Read from the minibuffer while providing abbrev expansion." |
6723 |
(if (fboundp 'mail-abbrevs-setup) |
(if (fboundp 'mail-abbrevs-setup) |
6724 |
(let ((mail-abbrev-mode-regexp "") |
(let ((mail-abbrev-mode-regexp "") |
6725 |
(minibuffer-setup-hook 'mail-abbrevs-setup)) |
(minibuffer-setup-hook 'mail-abbrevs-setup) |
6726 |
(read-from-minibuffer prompt)) |
(minibuffer-local-map message-minibuffer-local-map)) |
6727 |
(let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook)) |
(read-from-minibuffer prompt initial-contents)) |
6728 |
(read-string prompt)))) |
(let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook) |
6729 |
|
(minibuffer-local-map message-minibuffer-local-map)) |
6730 |
|
(read-string prompt initial-contents)))) |
6731 |
|
|
6732 |
(defun message-use-alternative-email-as-from () |
(defun message-use-alternative-email-as-from () |
6733 |
(require 'mail-utils) |
(require 'mail-utils) |
6747 |
(goto-char (point-max)) |
(goto-char (point-max)) |
6748 |
(insert "From: " email "\n")))) |
(insert "From: " email "\n")))) |
6749 |
|
|
6750 |
|
(defun message-options-get (symbol) |
6751 |
|
(cdr (assq symbol message-options))) |
6752 |
|
|
6753 |
|
(defun message-options-set (symbol value) |
6754 |
|
(let ((the-cons (assq symbol message-options))) |
6755 |
|
(if the-cons |
6756 |
|
(if value |
6757 |
|
(setcdr the-cons value) |
6758 |
|
(setq message-options (delq the-cons message-options))) |
6759 |
|
(and value |
6760 |
|
(push (cons symbol value) message-options)))) |
6761 |
|
value) |
6762 |
|
|
6763 |
|
(defun message-options-set-recipient () |
6764 |
|
(save-restriction |
6765 |
|
(message-narrow-to-headers-or-head) |
6766 |
|
(message-options-set 'message-sender |
6767 |
|
(mail-strip-quoted-names |
6768 |
|
(message-fetch-field "from"))) |
6769 |
|
(message-options-set 'message-recipients |
6770 |
|
(mail-strip-quoted-names |
6771 |
|
(let ((to (message-fetch-field "to")) |
6772 |
|
(cc (message-fetch-field "cc")) |
6773 |
|
(bcc (message-fetch-field "bcc"))) |
6774 |
|
(concat |
6775 |
|
(or to "") |
6776 |
|
(if (and to cc) ", ") |
6777 |
|
(or cc "") |
6778 |
|
(if (and (or to cc) bcc) ", ") |
6779 |
|
(or bcc ""))))))) |
6780 |
|
|
6781 |
|
(defun message-hide-headers () |
6782 |
|
"Hide headers based on the `message-hidden-headers' variable." |
6783 |
|
(let ((regexps (if (stringp message-hidden-headers) |
6784 |
|
(list message-hidden-headers) |
6785 |
|
message-hidden-headers)) |
6786 |
|
(inhibit-point-motion-hooks t) |
6787 |
|
(after-change-functions nil)) |
6788 |
|
(when regexps |
6789 |
|
(save-excursion |
6790 |
|
(save-restriction |
6791 |
|
(message-narrow-to-headers) |
6792 |
|
(goto-char (point-min)) |
6793 |
|
(while (not (eobp)) |
6794 |
|
(if (not (message-hide-header-p regexps)) |
6795 |
|
(message-next-header) |
6796 |
|
(let ((begin (point))) |
6797 |
|
(message-next-header) |
6798 |
|
(add-text-properties |
6799 |
|
begin (point) |
6800 |
|
'(invisible t message-hidden t)))))))))) |
6801 |
|
|
6802 |
|
(defun message-hide-header-p (regexps) |
6803 |
|
(let ((result nil) |
6804 |
|
(reverse nil)) |
6805 |
|
(when (eq (car regexps) 'not) |
6806 |
|
(setq reverse t) |
6807 |
|
(pop regexps)) |
6808 |
|
(dolist (regexp regexps) |
6809 |
|
(setq result (or result (looking-at regexp)))) |
6810 |
|
(if reverse |
6811 |
|
(not result) |
6812 |
|
result))) |
6813 |
|
|
6814 |
|
(when (featurep 'xemacs) |
6815 |
|
(require 'messagexmas) |
6816 |
|
(message-xmas-redefine)) |
6817 |
|
|
6818 |
(provide 'message) |
(provide 'message) |
6819 |
|
|
6820 |
(run-hooks 'message-load-hook) |
(run-hooks 'message-load-hook) |