Regenerate ldefs-boot.el
[bpt/emacs.git] / lisp / gnus / gnus-msg.el
CommitLineData
eec82323 1;;; gnus-msg.el --- mail and post interface for Gnus
e84b4b86 2
ba318903 3;; Copyright (C) 1995-2014 Free Software Foundation, Inc.
eec82323
LMI
4
5;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
6748645f 6;; Lars Magne Ingebrigtsen <larsi@gnus.org>
eec82323
LMI
7;; Keywords: news
8
9;; This file is part of GNU Emacs.
10
5e809f55 11;; GNU Emacs is free software: you can redistribute it and/or modify
eec82323 12;; it under the terms of the GNU General Public License as published by
5e809f55
GM
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
eec82323
LMI
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
5e809f55 22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
eec82323
LMI
23
24;;; Commentary:
25
26;;; Code:
27
249ffa67
RS
28(eval-when-compile (require 'cl))
29
eec82323
LMI
30(require 'gnus)
31(require 'gnus-ems)
32(require 'message)
33(require 'gnus-art)
23f87bed 34(require 'gnus-util)
eec82323 35
16409b0b 36(defcustom gnus-post-method 'current
eec82323 37 "*Preferred method for posting USENET news.
eec82323 38
e818c17f
SZ
39If this variable is `current' (which is the default), Gnus will use
40the \"current\" select method when posting. If it is `native', Gnus
41will use the native select method when posting.
6748645f
LMI
42
43This method will not be used in mail groups and the like, only in
44\"real\" newsgroups.
45
e818c17f 46If not `native' nor `current', the value must be a valid method as discussed
16409b0b
GM
47in the documentation of `gnus-select-method'. It can also be a list of
48methods. If that is the case, the user will be queried for what select
6748645f
LMI
49method to use when posting."
50 :group 'gnus-group-foreign
e818c17f
SZ
51 :link '(custom-manual "(gnus)Posting Server")
52 :type `(choice (const native)
53 (const current)
6748645f 54 (sexp :tag "Methods" ,gnus-select-method)))
eec82323 55
23f87bed 56(defcustom gnus-outgoing-message-group nil
ed797193 57 "All outgoing messages will be put in this group.
eec82323
LMI
58If you want to store all your outgoing mail and articles in the group
59\"nnml:archive\", you set this variable to that value. This variable
60can also be a list of group names.
61
62If you want to have greater control over what group to put each
63message in, you can set this variable to a function that checks the
64current newsgroup name and then returns a suitable group name (or list
23f87bed
MB
65of names)."
66 :group 'gnus-message
4a2358e9
MB
67 :type '(choice (const nil)
68 (function)
69 (string :tag "Group")
70 (repeat :tag "List of groups" (string :tag "Group"))))
eec82323 71
ed797193
G
72(make-obsolete-variable 'gnus-outgoing-message-group 'gnus-message-archive-group "24.1")
73
23f87bed
MB
74(defcustom gnus-mailing-list-groups nil
75 "*If non-nil a regexp matching groups that are really mailing lists.
eec82323
LMI
76This is useful when you're reading a mailing list that has been
77gatewayed to a newsgroup, and you want to followup to an article in
23f87bed
MB
78the group."
79 :group 'gnus-message
80 :type '(choice (regexp)
81 (const nil)))
eec82323 82
23f87bed
MB
83(defcustom gnus-add-to-list nil
84 "*If non-nil, add a `to-list' parameter automatically."
85 :group 'gnus-message
86 :type 'boolean)
eec82323 87
23f87bed 88(defcustom gnus-crosspost-complaint
eec82323
LMI
89 "Hi,
90
91You posted the article below with the following Newsgroups header:
92
93Newsgroups: %s
94
95The %s group, at least, was an inappropriate recipient
96of this message. Please trim your Newsgroups header to exclude this
97group before posting in the future.
98
99Thank you.
100
101"
102 "Format string to be inserted when complaining about crossposts.
103The first %s will be replaced by the Newsgroups header;
23f87bed
MB
104the second with the current group name."
105 :group 'gnus-message
106 :type 'string)
107
108(defcustom gnus-message-setup-hook nil
109 "Hook run after setting up a message buffer."
110 :group 'gnus-message
437ce4be 111 :options '(message-remove-blank-cited-lines)
23f87bed
MB
112 :type 'hook)
113
114(defcustom gnus-bug-create-help-buffer t
115 "*Should we create the *Gnus Help Bug* buffer?"
116 :group 'gnus-message
117 :type 'boolean)
118
119(defcustom gnus-posting-styles nil
120 "*Alist of styles to use when posting.
121See Info node `(gnus)Posting Styles'."
122 :group 'gnus-message
123 :link '(custom-manual "(gnus)Posting Styles")
124 :type '(repeat (cons (choice (regexp)
125 (variable)
126 (list (const header)
127 (string :tag "Header")
128 (regexp :tag "Regexp"))
129 (function)
130 (sexp))
131 (repeat (list
132 (choice (const signature)
133 (const signature-file)
134 (const organization)
135 (const address)
136 (const x-face-file)
137 (const name)
138 (const body)
139 (symbol)
140 (string :tag "Header"))
141 (choice (string)
142 (function)
143 (variable)
144 (sexp)))))))
145
146(defcustom gnus-gcc-mark-as-read nil
147 "If non-nil, automatically mark Gcc articles as read."
bf247b6e 148 :version "22.1"
23f87bed
MB
149 :group 'gnus-message
150 :type 'boolean)
151
152(make-obsolete-variable 'gnus-inews-mark-gcc-as-read
265ac10b 153 'gnus-gcc-mark-as-read "Emacs 22.1")
23f87bed
MB
154
155(defcustom gnus-gcc-externalize-attachments nil
156 "Should local-file attachments be included as external parts in Gcc copies?
157If it is `all', attach files as external parts;
158if a regexp and matches the Gcc group name, attach files as external parts;
159if nil, attach files as normal parts."
bf247b6e 160 :version "22.1"
23f87bed
MB
161 :group 'gnus-message
162 :type '(choice (const nil :tag "None")
163 (const all :tag "Any")
164 (string :tag "Regexp")))
165
89b163db
G
166(defcustom gnus-gcc-self-resent-messages 'no-gcc-self
167 "Like `gcc-self' group parameter, only for unmodified resent messages.
168Applied to messages sent by `gnus-summary-resend-message'. Non-nil
169value of this variable takes precedence over any existing Gcc header.
170
171If this is `none', no Gcc copy will be made. If this is t, messages
172resent will be Gcc'd to the current group. If this is a string, it
173specifies a group to which resent messages will be Gcc'd. If this is
174nil, Gcc will be done according to existing Gcc header(s), if any.
175If this is `no-gcc-self', resent messages will be Gcc'd to groups that
176existing Gcc header specifies, except for the current group."
2a1e2476 177 :version "24.3"
89b163db
G
178 :group 'gnus-message
179 :type '(choice (const none) (const t) string (const nil)
180 (const no-gcc-self)))
181
23f87bed
MB
182(gnus-define-group-parameter
183 posting-charset-alist
184 :type list
185 :function-document
186 "Return the permitted unencoded charsets for posting of GROUP."
187 :variable gnus-group-posting-charset-alist
188 :variable-default
25fc4fd5 189 '(("^\\(no\\|fr\\)\\.[^,]*\\(,[ \t\n]*\\(no\\|fr\\)\\.[^,]*\\)*$" iso-8859-1 (iso-8859-1))
16409b0b
GM
190 ("^\\(fido7\\|relcom\\)\\.[^,]*\\(,[ \t\n]*\\(fido7\\|relcom\\)\\.[^,]*\\)*$" koi8-r (koi8-r))
191 (message-this-is-mail nil nil)
192 (message-this-is-news nil t))
23f87bed 193 :variable-document
16409b0b
GM
194 "Alist of regexps and permitted unencoded charsets for posting.
195Each element of the alist has the form (TEST HEADER BODY-LIST), where
196TEST is either a regular expression matching the newsgroup header or a
197variable to query,
198HEADER is the charset which may be left unencoded in the header (nil
199means encode all charsets),
200BODY-LIST is a list of charsets which may be encoded using 8bit
201content-transfer encoding in the body, or one of the special values
202nil (always encode using quoted-printable) or t (always use 8bit).
203
204Note that any value other than nil for HEADER infringes some RFCs, so
205use this option with care."
23f87bed
MB
206 :variable-group gnus-charset
207 :variable-type
208 '(repeat (list :tag "Permitted unencoded charsets"
209 (choice :tag "Where"
210 (regexp :tag "Group")
211 (const :tag "Mail message" :value message-this-is-mail)
212 (const :tag "News article" :value message-this-is-news))
213 (choice :tag "Header"
214 (const :tag "None" nil)
215 (symbol :tag "Charset"))
216 (choice :tag "Body"
217 (const :tag "Any" :value t)
218 (const :tag "None" :value nil)
219 (repeat :tag "Charsets"
220 (symbol :tag "Charset")))))
221 :parameter-type '(choice :tag "Permitted unencoded charsets"
222 :value nil
223 (repeat (symbol)))
224 :parameter-document "\
225List of charsets that are permitted to be unencoded.")
226
227(defcustom gnus-debug-files
228 '("gnus.el" "gnus-sum.el" "gnus-group.el"
229 "gnus-art.el" "gnus-start.el" "gnus-async.el"
230 "gnus-msg.el" "gnus-score.el" "gnus-win.el" "gnus-topic.el"
231 "gnus-agent.el" "gnus-cache.el" "gnus-srvr.el"
232 "mm-util.el" "mm-decode.el" "nnmail.el" "message.el")
233 "Files whose variables will be reported in `gnus-bug'."
bf247b6e 234 :version "22.1"
23f87bed
MB
235 :group 'gnus-message
236 :type '(repeat (string :tag "File")))
237
238(defcustom gnus-debug-exclude-variables
239 '(mm-mime-mule-charset-alist
240 nnmail-split-fancy message-minibuffer-local-map)
241 "Variables that should not be reported in `gnus-bug'."
bf247b6e 242 :version "22.1"
23f87bed
MB
243 :group 'gnus-message
244 :type '(repeat (symbol :tag "Variable")))
245
246(defcustom gnus-discouraged-post-methods
247 '(nndraft nnml nnimap nnmaildir nnmh nnfolder nndir)
248 "A list of back ends that are not used in \"real\" newsgroups.
249This variable is used only when `gnus-post-method' is `current'."
bf247b6e 250 :version "22.1"
23f87bed
MB
251 :group 'gnus-group-foreign
252 :type '(repeat (symbol :tag "Back end")))
253
254(defcustom gnus-message-replysign
255 nil
256 "Automatically sign replies to signed messages.
257See also the `mml-default-sign-method' variable."
258 :group 'gnus-message
259 :type 'boolean)
260
b173bdd9 261(defcustom gnus-message-replyencrypt t
23f87bed
MB
262 "Automatically encrypt replies to encrypted messages.
263See also the `mml-default-encrypt-method' variable."
37657cbd 264 :version "24.1"
23f87bed
MB
265 :group 'gnus-message
266 :type 'boolean)
267
268(defcustom gnus-message-replysignencrypted
269 t
270 "Setting this causes automatically encrypted messages to also be signed."
271 :group 'gnus-message
272 :type 'boolean)
273
01c52d31
MB
274(defcustom gnus-confirm-mail-reply-to-news (and gnus-novice-user
275 (not gnus-expert-user))
23f87bed
MB
276 "If non-nil, Gnus requests confirmation when replying to news.
277This is done because new users often reply by mistake when reading
278news.
279This can also be a function receiving the group name as the only
e7f767c2
GM
280parameter, which should return non-nil if a confirmation is needed; or
281a regexp, in which case a confirmation is asked for if the group name
23f87bed 282matches the regexp."
330f707b 283 :version "23.1" ;; No Gnus (default changed)
23f87bed
MB
284 :group 'gnus-message
285 :type '(choice (const :tag "No" nil)
286 (const :tag "Yes" t)
e7f767c2
GM
287 (regexp :tag "If group matches regexp")
288 (function :tag "If function evaluates to non-nil")))
23f87bed
MB
289
290(defcustom gnus-confirm-treat-mail-like-news
291 nil
292 "If non-nil, Gnus will treat mail like news with regard to confirmation
293when replying by mail. See the `gnus-confirm-mail-reply-to-news' variable
294for fine-tuning this.
295If nil, Gnus will never ask for confirmation if replying to mail."
bf247b6e 296 :version "22.1"
23f87bed
MB
297 :group 'gnus-message
298 :type 'boolean)
299
300(defcustom gnus-summary-resend-default-address t
301 "If non-nil, Gnus tries to suggest a default address to resend to.
302If nil, the address field will always be empty after invoking
303`gnus-summary-resend-message'."
bf247b6e 304 :version "22.1"
23f87bed
MB
305 :group 'gnus-message
306 :type 'boolean)
6748645f 307
01c52d31
MB
308(defcustom gnus-message-highlight-citation
309 t ;; gnus-treat-highlight-citation ;; gnus-cite dependency
310 "Enable highlighting of different citation levels in message-mode."
330f707b 311 :version "23.1" ;; No Gnus
01c52d31
MB
312 :group 'gnus-cite
313 :group 'gnus-message
314 :type 'boolean)
315
89b163db
G
316(defcustom gnus-gcc-pre-body-encode-hook nil
317 "A hook called before encoding the body of the Gcc copy of a message.
318The current buffer (when the hook is run) contains the message
319including the message header. Changes made to the message will
320only affect the Gcc copy, but not the original message."
321 :group 'gnus-message
d1a1c7e6 322 :version "24.3"
89b163db
G
323 :type 'hook)
324
325(defcustom gnus-gcc-post-body-encode-hook nil
326 "A hook called after encoding the body of the Gcc copy of a message.
327The current buffer (when the hook is run) contains the message
328including the message header. Changes made to the message will
329only affect the Gcc copy, but not the original message."
330 :group 'gnus-message
d1a1c7e6 331 :version "24.3"
89b163db
G
332 :type 'hook)
333
01c52d31
MB
334(autoload 'gnus-message-citation-mode "gnus-cite" nil t)
335
eec82323
LMI
336;;; Internal variables.
337
6748645f
LMI
338(defvar gnus-inhibit-posting-styles nil
339 "Inhibit the use of posting styles.")
340
23f87bed 341(defvar gnus-article-yanked-articles nil)
eec82323
LMI
342(defvar gnus-message-buffer "*Mail Gnus*")
343(defvar gnus-article-copy nil)
23f87bed 344(defvar gnus-check-before-posting nil)
eec82323 345(defvar gnus-last-posting-server nil)
6748645f 346(defvar gnus-message-group-art nil)
eec82323 347
23f87bed
MB
348(defvar gnus-msg-force-broken-reply-to nil)
349
eec82323
LMI
350(defconst gnus-bug-message
351 "Sending a bug report to the Gnus Towers.
352========================================
353
354The buffer below is a mail buffer. When you press `C-c C-c', it will
355be sent to the Gnus Bug Exterminators.
356
16409b0b
GM
357The thing near the bottom of the buffer is how the environment
358settings will be included in the mail. Please do not delete that.
359They will tell the Bug People what your environment is, so that it
360will be easier to locate the bugs.
eec82323
LMI
361
362If you have found a bug that makes Emacs go \"beep\", set
363debug-on-error to t (`M-x set-variable RET debug-on-error RET t RET')
364and include the backtrace in your bug report.
365
366Please describe the bug in annoying, painstaking detail.
367
368Thank you for your help in stamping out bugs.
369")
370
8abf1b22 371(autoload 'gnus-uu-post-news "gnus-uu" nil t)
eec82323
LMI
372
373\f
374;;;
375;;; Gnus Posting Functions
376;;;
377
378(gnus-define-keys (gnus-summary-send-map "S" gnus-summary-mode-map)
379 "p" gnus-summary-post-news
23f87bed 380 "i" gnus-summary-news-other-window
eec82323
LMI
381 "f" gnus-summary-followup
382 "F" gnus-summary-followup-with-original
383 "c" gnus-summary-cancel-article
384 "s" gnus-summary-supersede-article
385 "r" gnus-summary-reply
16409b0b 386 "y" gnus-summary-yank-message
eec82323 387 "R" gnus-summary-reply-with-original
60a0884e 388 "L" gnus-summary-reply-to-list-with-original
eec82323
LMI
389 "w" gnus-summary-wide-reply
390 "W" gnus-summary-wide-reply-with-original
23f87bed
MB
391 "v" gnus-summary-very-wide-reply
392 "V" gnus-summary-very-wide-reply-with-original
eec82323
LMI
393 "n" gnus-summary-followup-to-mail
394 "N" gnus-summary-followup-to-mail-with-original
395 "m" gnus-summary-mail-other-window
396 "u" gnus-uu-post-news
397 "\M-c" gnus-summary-mail-crosspost-complaint
23f87bed
MB
398 "Br" gnus-summary-reply-broken-reply-to
399 "BR" gnus-summary-reply-broken-reply-to-with-original
eec82323
LMI
400 "om" gnus-summary-mail-forward
401 "op" gnus-summary-post-forward
402 "Om" gnus-uu-digest-mail-forward
403 "Op" gnus-uu-digest-post-forward)
404
405(gnus-define-keys (gnus-send-bounce-map "D" gnus-summary-send-map)
406 "b" gnus-summary-resend-bounced-mail
407 ;; "c" gnus-summary-send-draft
23f87bed
MB
408 "r" gnus-summary-resend-message
409 "e" gnus-summary-resend-message-edit)
eec82323
LMI
410
411;;; Internal functions.
412
01c52d31 413(defun gnus-inews-make-draft (articles)
23f87bed
MB
414 `(lambda ()
415 (gnus-inews-make-draft-meta-information
01c52d31 416 ,(gnus-group-decoded-name gnus-newsgroup-name) ',articles)))
23f87bed 417
54451ffa 418(autoload 'nnir-article-number "nnir" nil nil 'macro)
96bbc309 419(autoload 'nnir-article-group "nnir" nil nil 'macro)
567d89ca 420(autoload 'gnus-nnir-group-p "nnir")
54451ffa
AC
421
422
eec82323
LMI
423(defvar gnus-article-reply nil)
424(defmacro gnus-setup-message (config &rest forms)
6748645f 425 (let ((winconf (make-symbol "gnus-setup-message-winconf"))
4a3988d5 426 (winconf-name (make-symbol "gnus-setup-message-winconf-name"))
6748645f
LMI
427 (buffer (make-symbol "gnus-setup-message-buffer"))
428 (article (make-symbol "gnus-setup-message-article"))
23f87bed 429 (yanked (make-symbol "gnus-setup-yanked-articles"))
6748645f 430 (group (make-symbol "gnus-setup-message-group")))
eec82323 431 `(let ((,winconf (current-window-configuration))
8e22bee0 432 (,winconf-name gnus-current-window-configuration)
eec82323 433 (,buffer (buffer-name (current-buffer)))
567d89ca 434 (,article (if (and (gnus-nnir-group-p gnus-newsgroup-name)
53d3b731 435 gnus-article-reply)
1b9b6fbb
KY
436 (nnir-article-number (or (car-safe gnus-article-reply)
437 gnus-article-reply))
567d89ca
AC
438 gnus-article-reply))
439 (,yanked gnus-article-yanked-articles)
440 (,group (if (and (gnus-nnir-group-p gnus-newsgroup-name)
441 gnus-article-reply)
1b9b6fbb
KY
442 (nnir-article-group (or (car-safe gnus-article-reply)
443 gnus-article-reply))
567d89ca 444 gnus-newsgroup-name))
eec82323 445 (message-header-setup-hook
6748645f 446 (copy-sequence message-header-setup-hook))
16409b0b 447 (mbl mml-buffer-list)
6748645f 448 (message-mode-hook (copy-sequence message-mode-hook)))
16409b0b 449 (setq mml-buffer-list nil)
53d3b731 450 (add-hook 'message-header-setup-hook (lambda ()
b51eddb2 451 (gnus-inews-insert-gcc ,group)))
87ba2830
MB
452 ;; message-newsreader and message-mailer were formerly set in
453 ;; gnus-inews-add-send-actions, but this is too late when
454 ;; message-generate-headers-first is used. --ansel
455 (add-hook 'message-mode-hook
456 (lambda nil
457 (setq message-newsreader
458 (setq message-mailer (gnus-extended-version)))))
23f87bed
MB
459 ;; #### FIXME: for a reason that I did not manage to identify yet,
460 ;; the variable `gnus-newsgroup-name' does not honor a dynamically
461 ;; scoped or setq'ed value from a caller like `C-u gnus-summary-mail'.
462 ;; After evaluation of @forms below, it gets the value we actually want
463 ;; to override, and the posting styles are used. For that reason, I've
464 ;; added an optional argument to `gnus-configure-posting-styles' to
465 ;; make sure that the correct value for the group name is used. -- drv
466 (add-hook 'message-mode-hook
467 (if (memq ,config '(reply-yank reply))
468 (lambda ()
469 (gnus-configure-posting-styles ,group))
470 (lambda ()
471 ;; There may be an old " *gnus article copy*" buffer.
472 (let (gnus-article-copy)
473 (gnus-configure-posting-styles ,group)))))
36d3245f 474 (gnus-alist-pull ',(intern gnus-draft-meta-information-header)
23f87bed
MB
475 message-required-headers)
476 (when (and ,group
477 (not (string= ,group "")))
478 (push (cons
479 (intern gnus-draft-meta-information-header)
01c52d31 480 (gnus-inews-make-draft (or ,yanked ,article)))
23f87bed 481 message-required-headers))
eec82323 482 (unwind-protect
6748645f
LMI
483 (progn
484 ,@forms)
23f87bed 485 (gnus-inews-add-send-actions ,winconf ,buffer ,article ,config
16e07ee0 486 ,yanked ,winconf-name)
eec82323 487 (setq gnus-message-buffer (current-buffer))
6748645f
LMI
488 (set (make-local-variable 'gnus-message-group-art)
489 (cons ,group ,article))
16409b0b 490 (set (make-local-variable 'gnus-newsgroup-name) ,group)
01c52d31
MB
491 ;; Enable highlighting of different citation levels
492 (when gnus-message-highlight-citation
493 (gnus-message-citation-mode 1))
16409b0b
GM
494 (gnus-run-hooks 'gnus-message-setup-hook)
495 (if (eq major-mode 'message-mode)
25fc4fd5
SZ
496 (let ((mbl1 mml-buffer-list))
497 (setq mml-buffer-list mbl) ;; Global value
498 (set (make-local-variable 'mml-buffer-list) mbl1);; Local value
23f87bed
MB
499 (gnus-make-local-hook 'kill-buffer-hook)
500 (gnus-make-local-hook 'change-major-mode-hook)
6553d8f2 501 (add-hook 'change-major-mode-hook 'mml-destroy-buffers nil t)
16409b0b
GM
502 (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))
503 (mml-destroy-buffers)
504 (setq mml-buffer-list mbl)))
23f87bed 505 (message-hide-headers)
6748645f 506 (gnus-add-buffer)
eec82323 507 (gnus-configure-windows ,config t)
23f87bed 508 (run-hooks 'post-command-hook)
eec82323
LMI
509 (set-buffer-modified-p nil))))
510
01c52d31
MB
511(defun gnus-inews-make-draft-meta-information (group articles)
512 (when (numberp articles)
513 (setq articles (list articles)))
514 (concat "(\"" group "\""
515 (if articles
516 (concat " "
517 (mapconcat
518 (lambda (elem)
519 (number-to-string
520 (if (consp elem)
521 (car elem)
522 elem)))
523 articles " "))
524 "")
23f87bed
MB
525 ")"))
526
25fc4fd5 527;;;###autoload
23f87bed 528(defun gnus-msg-mail (&optional to subject other-headers continue
ee30fbcd
TV
529 switch-action yank-action send-actions
530 return-action)
25fc4fd5
SZ
531 "Start editing a mail message to be sent.
532Like `message-mail', but with Gnus paraphernalia, particularly the
7582f844
LI
533Gcc: header for archiving purposes.
534If Gnus isn't running, a plain `message-mail' setup is used
535instead."
25fc4fd5 536 (interactive)
7582f844 537 (if (not (gnus-alive-p))
d52ba5af
KY
538 (progn
539 (message "Gnus not running; using plain Message mode")
540 (message-mail to subject other-headers continue
541 nil yank-action send-actions return-action))
7582f844 542 (let ((buf (current-buffer))
32074209
KY
543 ;; Don't use posting styles corresponding to any existing group.
544 (gnus-newsgroup-name "")
7582f844
LI
545 mail-buf)
546 (gnus-setup-message 'message
547 (message-mail to subject other-headers continue
548 nil yank-action send-actions return-action))
549 (when switch-action
550 (setq mail-buf (current-buffer))
551 (switch-to-buffer buf)
552 (apply switch-action mail-buf nil))
553 ;; COMPOSEFUNC should return t if succeed. Undocumented ???
554 t)))
25fc4fd5 555
23f87bed
MB
556;;;###autoload
557(defun gnus-button-mailto (address)
558 "Mail to ADDRESS."
559 (set-buffer (gnus-copy-article-buffer))
560 (gnus-setup-message 'message
bfff13ab 561 (message-reply address)))
23f87bed
MB
562
563;;;###autoload
564(defun gnus-button-reply (&optional to-address wide)
565 "Like `message-reply'."
566 (interactive)
567 (gnus-setup-message 'message
bfff13ab 568 (message-reply to-address wide)))
23f87bed 569
25fc4fd5
SZ
570;;;###autoload
571(define-mail-user-agent 'gnus-user-agent
23f87bed
MB
572 'gnus-msg-mail 'message-send-and-exit
573 'message-kill-buffer 'message-send-hook)
25fc4fd5 574
16409b0b
GM
575(defun gnus-setup-posting-charset (group)
576 (let ((alist gnus-group-posting-charset-alist)
577 (group (or group ""))
578 elem)
579 (when group
580 (catch 'found
581 (while (setq elem (pop alist))
582 (when (or (and (stringp (car elem))
583 (string-match (car elem) group))
23f87bed 584 (and (functionp (car elem))
16409b0b
GM
585 (funcall (car elem) group))
586 (and (symbolp (car elem))
587 (symbol-value (car elem))))
588 (throw 'found (cons (cadr elem) (caddr elem)))))))))
589
23f87bed 590(defun gnus-inews-add-send-actions (winconf buffer article
8e22bee0
G
591 &optional config yanked
592 winconf-name)
23f87bed 593 (gnus-make-local-hook 'message-sent-hook)
0342aa5b
DL
594 (add-hook 'message-sent-hook (if gnus-agent 'gnus-agent-possibly-do-gcc
595 'gnus-inews-do-gcc) nil t)
596 (when gnus-agent
23f87bed 597 (gnus-make-local-hook 'message-header-hook)
0342aa5b 598 (add-hook 'message-header-hook 'gnus-agent-possibly-save-gcc nil t))
eec82323 599 (setq message-post-method
01c52d31 600 `(lambda (&optional arg)
eec82323 601 (gnus-post-method arg ,gnus-newsgroup-name)))
eec82323 602 (message-add-action
8e22bee0 603 `(progn
4a3988d5 604 (setq gnus-current-window-configuration ',winconf-name)
8e22bee0
G
605 (when (gnus-buffer-exists-p ,buffer)
606 (set-window-configuration ,winconf)))
23f87bed
MB
607 'exit 'postpone 'kill)
608 (let ((to-be-marked (cond
609 (yanked
610 (mapcar
611 (lambda (x) (if (listp x) (car x) x)) yanked))
612 (article (if (listp article) article (list article)))
613 (t nil))))
614 (message-add-action
615 `(when (gnus-buffer-exists-p ,buffer)
228b6ecd 616 (with-current-buffer ,buffer
23f87bed
MB
617 ,(when to-be-marked
618 (if (eq config 'forward)
619 `(gnus-summary-mark-article-as-forwarded ',to-be-marked)
620 `(gnus-summary-mark-article-as-replied ',to-be-marked)))))
621 'send)))
eec82323
LMI
622
623(put 'gnus-setup-message 'lisp-indent-function 1)
624(put 'gnus-setup-message 'edebug-form-spec '(form body))
625
626;;; Post news commands of Gnus group mode and summary mode
627
16409b0b
GM
628(defun gnus-group-mail (&optional arg)
629 "Start composing a mail.
630If ARG, use the group under the point to find a posting style.
631If ARG is 1, prompt for a group name to find the posting style."
632 (interactive "P")
633 ;; We can't `let' gnus-newsgroup-name here, since that leads
634 ;; to local variables leaking.
635 (let ((group gnus-newsgroup-name)
23f87bed
MB
636 ;; make sure last viewed article doesn't affect posting styles:
637 (gnus-article-copy)
16409b0b
GM
638 (buffer (current-buffer)))
639 (unwind-protect
640 (progn
641 (setq gnus-newsgroup-name
642 (if arg
643 (if (= 1 (prefix-numeric-value arg))
01c52d31 644 (gnus-group-completing-read
229b59da
G
645 "Use posting style of group"
646 nil (gnus-read-active-file-p))
16409b0b
GM
647 (gnus-group-group-name))
648 ""))
23f87bed 649 ;; #### see comment in gnus-setup-message -- drv
16409b0b 650 (gnus-setup-message 'message (message-mail)))
228b6ecd 651 (with-current-buffer buffer
16409b0b 652 (setq gnus-newsgroup-name group)))))
eec82323 653
23f87bed
MB
654(defun gnus-group-news (&optional arg)
655 "Start composing a news.
656If ARG, post to group under point.
657If ARG is 1, prompt for group name to post to.
658
659This function prepares a news even when using mail groups. This is useful
660for posting messages to mail groups without actually sending them over the
661network. The corresponding back end must have a 'request-post method."
662 (interactive "P")
663 ;; We can't `let' gnus-newsgroup-name here, since that leads
664 ;; to local variables leaking.
665 (let ((group gnus-newsgroup-name)
666 ;; make sure last viewed article doesn't affect posting styles:
667 (gnus-article-copy)
668 (buffer (current-buffer)))
669 (unwind-protect
670 (progn
671 (setq gnus-newsgroup-name
672 (if arg
673 (if (= 1 (prefix-numeric-value arg))
229b59da
G
674 (gnus-group-completing-read "Use group"
675 nil
01c52d31 676 (gnus-read-active-file-p))
23f87bed
MB
677 (gnus-group-group-name))
678 ""))
679 ;; #### see comment in gnus-setup-message -- drv
680 (gnus-setup-message 'message
681 (message-news (gnus-group-real-name gnus-newsgroup-name))))
228b6ecd 682 (with-current-buffer buffer
23f87bed
MB
683 (setq gnus-newsgroup-name group)))))
684
eec82323 685(defun gnus-group-post-news (&optional arg)
23f87bed
MB
686 "Start composing a message (a news by default).
687If ARG, post to group under point. If ARG is 1, prompt for group name.
688Depending on the selected group, the message might be either a mail or
689a news."
eec82323 690 (interactive "P")
6748645f 691 ;; Bind this variable here to make message mode hooks work ok.
eec82323
LMI
692 (let ((gnus-newsgroup-name
693 (if arg
694 (if (= 1 (prefix-numeric-value arg))
229b59da 695 (gnus-group-completing-read "Newsgroup" nil
01c52d31 696 (gnus-read-active-file-p))
e838e2ac 697 (or (gnus-group-group-name) ""))
23f87bed
MB
698 ""))
699 ;; make sure last viewed article doesn't affect posting styles:
700 (gnus-article-copy))
701 (gnus-post-news 'post gnus-newsgroup-name nil nil nil nil
702 (string= gnus-newsgroup-name ""))))
703
704(defun gnus-summary-mail-other-window (&optional arg)
705 "Start composing a mail in another window.
706Use the posting of the current group by default.
707If ARG, don't do that. If ARG is 1, prompt for group name to find the
708posting style."
709 (interactive "P")
710 ;; We can't `let' gnus-newsgroup-name here, since that leads
711 ;; to local variables leaking.
712 (let ((group gnus-newsgroup-name)
713 ;; make sure last viewed article doesn't affect posting styles:
714 (gnus-article-copy)
715 (buffer (current-buffer)))
716 (unwind-protect
717 (progn
718 (setq gnus-newsgroup-name
719 (if arg
720 (if (= 1 (prefix-numeric-value arg))
229b59da
G
721 (gnus-group-completing-read "Use group"
722 nil
01c52d31 723 (gnus-read-active-file-p))
23f87bed
MB
724 "")
725 gnus-newsgroup-name))
726 ;; #### see comment in gnus-setup-message -- drv
727 (gnus-setup-message 'message (message-mail)))
228b6ecd 728 (with-current-buffer buffer
23f87bed
MB
729 (setq gnus-newsgroup-name group)))))
730
731(defun gnus-summary-news-other-window (&optional arg)
732 "Start composing a news in another window.
733Post to the current group by default.
734If ARG, don't do that. If ARG is 1, prompt for group name to post to.
735
736This function prepares a news even when using mail groups. This is useful
737for posting messages to mail groups without actually sending them over the
738network. The corresponding back end must have a 'request-post method."
739 (interactive "P")
740 ;; We can't `let' gnus-newsgroup-name here, since that leads
741 ;; to local variables leaking.
742 (let ((group gnus-newsgroup-name)
743 ;; make sure last viewed article doesn't affect posting styles:
744 (gnus-article-copy)
745 (buffer (current-buffer)))
746 (unwind-protect
747 (progn
748 (setq gnus-newsgroup-name
749 (if arg
750 (if (= 1 (prefix-numeric-value arg))
229b59da
G
751 (gnus-group-completing-read "Use group"
752 nil
01c52d31 753 (gnus-read-active-file-p))
23f87bed
MB
754 "")
755 gnus-newsgroup-name))
756 ;; #### see comment in gnus-setup-message -- drv
757 (gnus-setup-message 'message
758 (progn
759 (message-news (gnus-group-real-name gnus-newsgroup-name))
760 (set (make-local-variable 'gnus-discouraged-post-methods)
01c52d31 761 (remove
23f87bed 762 (car (gnus-find-method-for-group gnus-newsgroup-name))
01c52d31 763 gnus-discouraged-post-methods)))))
228b6ecd 764 (with-current-buffer buffer
23f87bed
MB
765 (setq gnus-newsgroup-name group)))))
766
767(defun gnus-summary-post-news (&optional arg)
768 "Start composing a message. Post to the current group by default.
769If ARG, don't do that. If ARG is 1, prompt for a group name to post to.
770Depending on the selected group, the message might be either a mail or
771a news."
772 (interactive "P")
773 ;; Bind this variable here to make message mode hooks work ok.
774 (let ((gnus-newsgroup-name
775 (if arg
776 (if (= 1 (prefix-numeric-value arg))
229b59da 777 (gnus-group-completing-read "Newsgroup" nil
01c52d31 778 (gnus-read-active-file-p))
23f87bed
MB
779 "")
780 gnus-newsgroup-name))
781 ;; make sure last viewed article doesn't affect posting styles:
782 (gnus-article-copy))
eec82323
LMI
783 (gnus-post-news 'post gnus-newsgroup-name)))
784
eec82323
LMI
785
786(defun gnus-summary-followup (yank &optional force-news)
787 "Compose a followup to an article.
23f87bed
MB
788If prefix argument YANK is non-nil, the original article is yanked
789automatically.
790YANK is a list of elements, where the car of each element is the
791article number, and the cdr is the string to be yanked."
eec82323
LMI
792 (interactive
793 (list (and current-prefix-arg
794 (gnus-summary-work-articles 1))))
eec82323 795 (when yank
23f87bed
MB
796 (gnus-summary-goto-subject
797 (if (listp (car yank))
798 (caar yank)
799 (car yank))))
eec82323
LMI
800 (save-window-excursion
801 (gnus-summary-select-article))
802 (let ((headers (gnus-summary-article-header (gnus-summary-article-number)))
803 (gnus-newsgroup-name gnus-newsgroup-name))
804 ;; Send a followup.
805 (gnus-post-news nil gnus-newsgroup-name
806 headers gnus-article-buffer
23f87bed
MB
807 yank nil force-news)
808 (gnus-summary-handle-replysign)))
eec82323
LMI
809
810(defun gnus-summary-followup-with-original (n &optional force-news)
23f87bed
MB
811 "Compose a followup to an article and include the original article.
812The text in the region will be yanked. If the region isn't
813active, the entire article will be yanked."
eec82323
LMI
814 (interactive "P")
815 (gnus-summary-followup (gnus-summary-work-articles n) force-news))
816
817(defun gnus-summary-followup-to-mail (&optional arg)
818 "Followup to the current mail message via news."
819 (interactive
820 (list (and current-prefix-arg
821 (gnus-summary-work-articles 1))))
822 (gnus-summary-followup arg t))
823
824(defun gnus-summary-followup-to-mail-with-original (&optional arg)
825 "Followup to the current mail message via news."
826 (interactive "P")
827 (gnus-summary-followup (gnus-summary-work-articles arg) t))
828
829(defun gnus-inews-yank-articles (articles)
23f87bed 830 (let (beg article yank-string)
eec82323
LMI
831 (message-goto-body)
832 (while (setq article (pop articles))
23f87bed
MB
833 (when (listp article)
834 (setq yank-string (nth 1 article)
835 article (nth 0 article)))
eec82323
LMI
836 (save-window-excursion
837 (set-buffer gnus-summary-buffer)
838 (gnus-summary-select-article nil nil nil article)
839 (gnus-summary-remove-process-mark article))
23f87bed 840 (gnus-copy-article-buffer nil yank-string)
eec82323 841 (let ((message-reply-buffer gnus-article-copy)
23f87bed
MB
842 (message-reply-headers
843 ;; The headers are decoded.
844 (with-current-buffer gnus-article-copy
845 (save-restriction
846 (nnheader-narrow-to-headers)
847 (nnheader-parse-naked-head)))))
eec82323 848 (message-yank-original)
c429815a 849 (message-exchange-point-and-mark)
eec82323
LMI
850 (setq beg (or beg (mark t))))
851 (when articles
852 (insert "\n")))
853 (push-mark)
854 (goto-char beg)))
855
6748645f
LMI
856(defun gnus-summary-cancel-article (&optional n symp)
857 "Cancel an article you posted.
858Uses the process-prefix convention. If given the symbolic
859prefix `a', cancel using the standard posting method; if not
860post using the current select method."
861 (interactive (gnus-interactive "P\ny"))
01c52d31 862 (let ((message-post-method
eec82323 863 `(lambda (arg)
d52ba5af 864 (gnus-post-method (eq ',symp 'a) ,gnus-newsgroup-name)))
cf8a1938 865 (custom-address user-mail-address))
01c52d31 866 (dolist (article (gnus-summary-work-articles n))
eec82323 867 (when (gnus-summary-select-article t nil nil article)
d52ba5af
KY
868 ;; Pretend that we're doing a followup so that we can see what
869 ;; the From header would have ended up being.
870 (save-window-excursion
871 (save-excursion
872 (gnus-summary-followup nil)
873 (let ((from (message-fetch-field "from")))
874 (when from
cf8a1938 875 (setq custom-address
d52ba5af
KY
876 (car (mail-header-parse-address from)))))
877 (kill-buffer (current-buffer))))
878 ;; Now cancel the article using the From header we got.
eec82323 879 (when (gnus-eval-in-buffer-window gnus-original-article-buffer
cf8a1938
LI
880 (let ((user-mail-address (or custom-address user-mail-address)))
881 (message-cancel-news)))
eec82323
LMI
882 (gnus-summary-mark-as-read article gnus-canceled-mark)
883 (gnus-cache-remove-article 1))
884 (gnus-article-hide-headers-if-wanted))
885 (gnus-summary-remove-process-mark article))))
886
887(defun gnus-summary-supersede-article ()
888 "Compose an article that will supersede a previous article.
889This is done simply by taking the old article and adding a Supersedes
890header line with the old Message-ID."
891 (interactive)
9153f10d
MB
892 (let ((article (gnus-summary-article-number))
893 (mail-parse-charset gnus-newsgroup-charset))
eec82323
LMI
894 (gnus-setup-message 'reply-yank
895 (gnus-summary-select-article t)
896 (set-buffer gnus-original-article-buffer)
897 (message-supersede)
898 (push
899 `((lambda ()
6748645f 900 (when (gnus-buffer-exists-p ,gnus-summary-buffer)
228b6ecd 901 (with-current-buffer ,gnus-summary-buffer
eec82323
LMI
902 (gnus-cache-possibly-remove-article ,article nil nil nil t)
903 (gnus-summary-mark-as-read ,article gnus-canceled-mark)))))
2f62a044
MB
904 message-send-actions)
905 ;; Add Gcc header.
2f62a044 906 (gnus-inews-insert-gcc))))
25fc4fd5 907
eec82323
LMI
908\f
909
23f87bed 910(defun gnus-copy-article-buffer (&optional article-buffer yank-string)
eec82323
LMI
911 ;; make a copy of the article buffer with all text properties removed
912 ;; this copy is in the buffer gnus-article-copy.
913 ;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used
914 ;; this buffer should be passed to all mail/news reply/post routines.
6748645f 915 (setq gnus-article-copy (gnus-get-buffer-create " *gnus article copy*"))
228b6ecd 916 (with-current-buffer gnus-article-copy
16409b0b 917 (mm-enable-multibyte))
eec82323 918 (let ((article-buffer (or article-buffer gnus-article-buffer))
6748645f 919 end beg)
eec82323 920 (if (not (and (get-buffer article-buffer)
6748645f 921 (gnus-buffer-exists-p article-buffer)))
eec82323 922 (error "Can't find any article buffer")
228b6ecd 923 (with-current-buffer article-buffer
23f87bed
MB
924 (let ((gnus-newsgroup-charset (or gnus-article-charset
925 gnus-newsgroup-charset))
6ed7a66a 926 (inhibit-read-only t)
23f87bed
MB
927 (gnus-newsgroup-ignored-charsets
928 (or gnus-article-ignored-charsets
929 gnus-newsgroup-ignored-charsets)))
930 (save-restriction
931 ;; Copy over the (displayed) article buffer, delete
932 ;; hidden text and remove text properties.
933 (widen)
934 (copy-to-buffer gnus-article-copy (point-min) (point-max))
935 (set-buffer gnus-article-copy)
936 (when yank-string
937 (message-goto-body)
938 (delete-region (point) (point-max))
939 (insert yank-string))
940 (gnus-article-delete-text-of-type 'annotation)
7dafe00b 941 (gnus-article-delete-text-of-type 'multipart)
23f87bed
MB
942 (gnus-remove-text-with-property 'gnus-prev)
943 (gnus-remove-text-with-property 'gnus-next)
944 (gnus-remove-text-with-property 'gnus-decoration)
945 (insert
946 (prog1
947 (buffer-substring-no-properties (point-min) (point-max))
948 (erase-buffer)))
949 ;; Find the original headers.
950 (set-buffer gnus-original-article-buffer)
951 (goto-char (point-min))
952 (while (looking-at message-unix-mail-delimiter)
953 (forward-line 1))
954 (let ((mail-header-separator ""))
955 (setq beg (point)
956 end (or (message-goto-body)
957 ;; There may be just a header.
958 (point-max))))
959 ;; Delete the headers from the displayed articles.
960 (set-buffer gnus-article-copy)
961 (let ((mail-header-separator ""))
962 (delete-region (goto-char (point-min))
963 (or (message-goto-body) (point-max))))
964 ;; Insert the original article headers.
965 (insert-buffer-substring gnus-original-article-buffer beg end)
966 ;; Decode charsets.
967 (let ((gnus-article-decode-hook
968 (delq 'article-decode-charset
270a576a
MB
969 (copy-sequence gnus-article-decode-hook)))
970 (rfc2047-quote-decoded-words-containing-tspecials t))
23f87bed 971 (run-hooks 'gnus-article-decode-hook)))))
eec82323
LMI
972 gnus-article-copy)))
973
974(defun gnus-post-news (post &optional group header article-buffer yank subject
975 force-news)
976 (when article-buffer
977 (gnus-copy-article-buffer))
23f87bed
MB
978 (let ((gnus-article-reply (and article-buffer (gnus-summary-article-number)))
979 (gnus-article-yanked-articles yank)
eec82323
LMI
980 (add-to-list gnus-add-to-list))
981 (gnus-setup-message (cond (yank 'reply-yank)
982 (article-buffer 'reply)
983 (t 'message))
984 (let* ((group (or group gnus-newsgroup-name))
16409b0b 985 (charset (gnus-group-name-charset nil group))
eec82323
LMI
986 (pgroup group)
987 to-address to-group mailing-list to-list
988 newsgroup-p)
989 (when group
23f87bed 990 (setq to-address (gnus-parameter-to-address group)
eec82323 991 to-group (gnus-group-find-parameter group 'to-group)
23f87bed 992 to-list (gnus-parameter-to-list group)
eec82323
LMI
993 newsgroup-p (gnus-group-find-parameter group 'newsgroup)
994 mailing-list (when gnus-mailing-list-groups
995 (string-match gnus-mailing-list-groups group))
16409b0b
GM
996 group (gnus-group-name-decode (gnus-group-real-name group)
997 charset)))
eec82323
LMI
998 (if (or (and to-group
999 (gnus-news-group-p to-group))
1000 newsgroup-p
1001 force-news
1002 (and (gnus-news-group-p
1003 (or pgroup gnus-newsgroup-name)
23f87bed 1004 (or header gnus-current-article))
eec82323
LMI
1005 (not mailing-list)
1006 (not to-list)
1007 (not to-address)))
1008 ;; This is news.
1009 (if post
f4dd4ae8
MB
1010 (message-news
1011 (or to-group
1012 (and (not (gnus-virtual-group-p pgroup)) group)))
eec82323 1013 (set-buffer gnus-article-copy)
6748645f 1014 (gnus-msg-treat-broken-reply-to)
23f87bed
MB
1015 (message-followup (if (or newsgroup-p force-news)
1016 (if (save-restriction
1017 (article-narrow-to-head)
1018 (message-fetch-field "newsgroups"))
1019 nil
1020 "")
1021 to-group)))
eec82323
LMI
1022 ;; The is mail.
1023 (if post
1024 (progn
1025 (message-mail (or to-address to-list))
1026 ;; Arrange for mail groups that have no `to-address' to
1027 ;; get that when the user sends off the mail.
1028 (when (and (not to-list)
1029 (not to-address)
1030 add-to-list)
1031 (push (list 'gnus-inews-add-to-address pgroup)
1032 message-send-actions)))
1033 (set-buffer gnus-article-copy)
6748645f
LMI
1034 (gnus-msg-treat-broken-reply-to)
1035 (message-wide-reply to-address)))
eec82323
LMI
1036 (when yank
1037 (gnus-inews-yank-articles yank))))))
1038
23f87bed 1039(defun gnus-msg-treat-broken-reply-to (&optional force)
8f688cb0 1040 "Remove the Reply-to header if broken-reply-to."
23f87bed
MB
1041 (when (or force
1042 (gnus-group-find-parameter
1043 gnus-newsgroup-name 'broken-reply-to))
6748645f
LMI
1044 (save-restriction
1045 (message-narrow-to-head)
1046 (message-remove-header "reply-to"))))
1047
eec82323
LMI
1048(defun gnus-post-method (arg group &optional silent)
1049 "Return the posting method based on GROUP and ARG.
1050If SILENT, don't prompt the user."
23f87bed
MB
1051 (let ((gnus-post-method (or (gnus-parameter-post-method group)
1052 gnus-post-method))
1053 (group-method (gnus-find-method-for-group group)))
eec82323
LMI
1054 (cond
1055 ;; If the group-method is nil (which shouldn't happen) we use
1056 ;; the default method.
1057 ((null group-method)
23f87bed
MB
1058 (or (and (listp gnus-post-method) ;If not current/native/nil
1059 (not (listp (car gnus-post-method))) ; and not a list of methods
1060 gnus-post-method) ;then use it.
1061 gnus-select-method
1062 message-post-method))
6748645f 1063 ;; We want the inverse of the default
eec82323 1064 ((and arg (not (eq arg 0)))
23f87bed 1065 (if (eq gnus-post-method 'current)
6748645f
LMI
1066 gnus-select-method
1067 group-method))
eec82323
LMI
1068 ;; We query the user for a post method.
1069 ((or arg
23f87bed 1070 (and (listp gnus-post-method)
eec82323
LMI
1071 (listp (car gnus-post-method))))
1072 (let* ((methods
1073 ;; Collect all methods we know about.
1074 (append
23f87bed 1075 (when (listp gnus-post-method)
eec82323
LMI
1076 (if (listp (car gnus-post-method))
1077 gnus-post-method
1078 (list gnus-post-method)))
1079 gnus-secondary-select-methods
6748645f 1080 (mapcar 'cdr gnus-server-alist)
16409b0b 1081 (mapcar 'car gnus-opened-servers)
eec82323
LMI
1082 (list gnus-select-method)
1083 (list group-method)))
1084 method-alist post-methods method)
1085 ;; Weed out all mail methods.
1086 (while methods
1087 (setq method (gnus-server-get-method "" (pop methods)))
16409b0b
GM
1088 (when (and (or (gnus-method-option-p method 'post)
1089 (gnus-method-option-p method 'post-mail))
1090 (not (member method post-methods)))
eec82323
LMI
1091 (push method post-methods)))
1092 ;; Create a name-method alist.
1093 (setq method-alist
1094 (mapcar
1095 (lambda (m)
23f87bed
MB
1096 (if (equal (cadr m) "")
1097 (list (symbol-name (car m)) m)
1098 (list (concat (cadr m) " (" (symbol-name (car m)) ")") m)))
eec82323
LMI
1099 post-methods))
1100 ;; Query the user.
1101 (cadr
1102 (assoc
1103 (setq gnus-last-posting-server
1104 (if (and silent
1105 gnus-last-posting-server)
1106 ;; Just use the last value.
1107 gnus-last-posting-server
229b59da
G
1108 (gnus-completing-read
1109 "Posting method" (mapcar 'car method-alist) t
eec82323
LMI
1110 (cons (or gnus-last-posting-server "") 0))))
1111 method-alist))))
1112 ;; Override normal method.
6748645f 1113 ((and (eq gnus-post-method 'current)
23f87bed
MB
1114 (not (memq (car group-method) gnus-discouraged-post-methods))
1115 (gnus-get-function group-method 'request-post t))
1116 (assert (not arg))
16409b0b 1117 group-method)
23f87bed
MB
1118 ;; Use gnus-post-method.
1119 ((listp gnus-post-method) ;A method...
1120 (assert (not (listp (car gnus-post-method)))) ;... not a list of methods.
eec82323 1121 gnus-post-method)
23f87bed 1122 ;; Use the normal select method (nil or native).
eec82323
LMI
1123 (t gnus-select-method))))
1124
eec82323
LMI
1125\f
1126
eec82323 1127(defun gnus-extended-version ()
23f87bed
MB
1128 "Stringified Gnus version and Emacs version.
1129See the variable `gnus-user-agent'."
eec82323 1130 (interactive)
4a2358e9
MB
1131 (if (stringp gnus-user-agent)
1132 gnus-user-agent
1133 ;; `gnus-user-agent' is a list:
1134 (let* ((float-output-format nil)
1135 (gnus-v
1136 (when (memq 'gnus gnus-user-agent)
1137 (concat "Gnus/"
a048c295
KY
1138 (gnus-replace-in-string
1139 (format "%1.8f" (gnus-continuum-version gnus-version))
1140 "0+\\'" "")
4a2358e9
MB
1141 " (" gnus-version ")")))
1142 (emacs-v (gnus-emacs-version)))
1143 (concat gnus-v (when (and gnus-v emacs-v) " ")
1144 emacs-v))))
eec82323 1145
eec82323
LMI
1146\f
1147;;;
1148;;; Gnus Mail Functions
1149;;;
1150
1151;;; Mail reply commands of Gnus summary mode
1152
23f87bed
MB
1153(defun gnus-summary-reply (&optional yank wide very-wide)
1154 "Start composing a mail reply to the current message.
eec82323 1155If prefix argument YANK is non-nil, the original article is yanked
23f87bed
MB
1156automatically.
1157If WIDE, make a wide reply.
1158If VERY-WIDE, make a very wide reply."
eec82323
LMI
1159 (interactive
1160 (list (and current-prefix-arg
1161 (gnus-summary-work-articles 1))))
23f87bed
MB
1162 ;; Allow user to require confirmation before replying by mail to the
1163 ;; author of a news article (or mail message).
5415d076 1164 (when (or (not (or (gnus-news-group-p gnus-newsgroup-name)
23f87bed
MB
1165 gnus-confirm-treat-mail-like-news))
1166 (not (cond ((stringp gnus-confirm-mail-reply-to-news)
1167 (string-match gnus-confirm-mail-reply-to-news
1168 gnus-newsgroup-name))
1169 ((functionp gnus-confirm-mail-reply-to-news)
5415d076
G
1170 (funcall gnus-confirm-mail-reply-to-news
1171 gnus-newsgroup-name))
23f87bed 1172 (t gnus-confirm-mail-reply-to-news)))
b890d447
MB
1173 (if (or wide very-wide)
1174 t ;; Ignore gnus-confirm-mail-reply-to-news for wide and very
1175 ;; wide replies.
1176 (y-or-n-p "Really reply by mail to article author? ")))
23f87bed
MB
1177 (let* ((article
1178 (if (listp (car yank))
1179 (caar yank)
1180 (car yank)))
1181 (gnus-article-reply (or article (gnus-summary-article-number)))
1182 (gnus-article-yanked-articles yank)
1183 (headers ""))
1184 ;; Stripping headers should be specified with mail-yank-ignored-headers.
eec82323 1185 (when yank
23f87bed
MB
1186 (gnus-summary-goto-subject article))
1187 (gnus-setup-message (if yank 'reply-yank 'reply)
1188 (if (not very-wide)
1189 (gnus-summary-select-article)
1190 (dolist (article very-wide)
1191 (gnus-summary-select-article nil nil nil article)
228b6ecd 1192 (with-current-buffer (gnus-copy-article-buffer)
23f87bed
MB
1193 (gnus-msg-treat-broken-reply-to)
1194 (save-restriction
1195 (message-narrow-to-head)
1196 (setq headers (concat headers (buffer-string)))))))
1197 (set-buffer (gnus-copy-article-buffer))
1198 (gnus-msg-treat-broken-reply-to gnus-msg-force-broken-reply-to)
1199 (save-restriction
1200 (message-narrow-to-head)
1201 (when very-wide
1202 (erase-buffer)
1203 (insert headers))
1204 (goto-char (point-max)))
1205 (mml-quote-region (point) (point-max))
98cc61de 1206 (message-reply nil wide)
23f87bed
MB
1207 (when yank
1208 (gnus-inews-yank-articles yank))
1209 (gnus-summary-handle-replysign)))))
1210
1211(defun gnus-summary-handle-replysign ()
1212 "Check the various replysign variables and take action accordingly."
1213 (when (or gnus-message-replysign gnus-message-replyencrypt)
1214 (let (signed encrypted)
228b6ecd 1215 (with-current-buffer gnus-article-buffer
23f87bed
MB
1216 (setq signed (memq 'signed gnus-article-wash-types))
1217 (setq encrypted (memq 'encrypted gnus-article-wash-types)))
1218 (cond ((and gnus-message-replyencrypt encrypted)
1219 (mml-secure-message mml-default-encrypt-method
1220 (if gnus-message-replysignencrypted
1221 'signencrypt
1222 'encrypt)))
1223 ((and gnus-message-replysign signed)
1224 (mml-secure-message mml-default-sign-method 'sign))))))
eec82323
LMI
1225
1226(defun gnus-summary-reply-with-original (n &optional wide)
1227 "Start composing a reply mail to the current message.
1228The original article will be yanked."
1229 (interactive "P")
1230 (gnus-summary-reply (gnus-summary-work-articles n) wide))
1231
60a0884e
G
1232(defun gnus-summary-reply-to-list-with-original (n &optional wide)
1233 "Start composing a reply mail to the current message.
1234The reply goes only to the mailing list.
1235The original article will be yanked."
1236 (interactive "P")
1237 (let ((message-reply-to-function
1238 (lambda nil
1239 `((To . ,(gnus-mailing-list-followup-to))))))
1240 (gnus-summary-reply (gnus-summary-work-articles n) wide)))
1241
23f87bed
MB
1242(defun gnus-summary-reply-broken-reply-to (&optional yank wide very-wide)
1243 "Like `gnus-summary-reply' except removing reply-to field.
1244If prefix argument YANK is non-nil, the original article is yanked
1245automatically.
1246If WIDE, make a wide reply.
1247If VERY-WIDE, make a very wide reply."
1248 (interactive
1249 (list (and current-prefix-arg
1250 (gnus-summary-work-articles 1))))
1251 (let ((gnus-msg-force-broken-reply-to t))
1252 (gnus-summary-reply yank wide very-wide)))
1253
1254(defun gnus-summary-reply-broken-reply-to-with-original (n &optional wide)
1255 "Like `gnus-summary-reply-with-original' except removing reply-to field.
1256The original article will be yanked."
1257 (interactive "P")
1258 (gnus-summary-reply-broken-reply-to (gnus-summary-work-articles n) wide))
1259
eec82323
LMI
1260(defun gnus-summary-wide-reply (&optional yank)
1261 "Start composing a wide reply mail to the current message.
1262If prefix argument YANK is non-nil, the original article is yanked
1263automatically."
1264 (interactive
1265 (list (and current-prefix-arg
1266 (gnus-summary-work-articles 1))))
1267 (gnus-summary-reply yank t))
1268
1269(defun gnus-summary-wide-reply-with-original (n)
1270 "Start composing a wide reply mail to the current message.
23f87bed
MB
1271The original article will be yanked.
1272Uses the process/prefix convention."
eec82323
LMI
1273 (interactive "P")
1274 (gnus-summary-reply-with-original n t))
1275
23f87bed
MB
1276(defun gnus-summary-very-wide-reply (&optional yank)
1277 "Start composing a very wide reply mail to the current message.
1278If prefix argument YANK is non-nil, the original article is yanked
1279automatically."
1280 (interactive
1281 (list (and current-prefix-arg
1282 (gnus-summary-work-articles 1))))
1283 (gnus-summary-reply yank t (gnus-summary-work-articles yank)))
1284
1285(defun gnus-summary-very-wide-reply-with-original (n)
1286 "Start composing a very wide reply mail to the current message.
1287The original article will be yanked."
1288 (interactive "P")
1289 (gnus-summary-reply
1290 (gnus-summary-work-articles n) t (gnus-summary-work-articles n)))
1291
16409b0b 1292(defun gnus-summary-mail-forward (&optional arg post)
23f87bed
MB
1293 "Forward the current message(s) to another user.
1294If process marks exist, forward all marked messages;
1295if ARG is nil, see `message-forward-as-mime' and `message-forward-show-mml';
16409b0b 1296if ARG is 1, decode the message and forward directly inline;
25fc4fd5 1297if ARG is 2, forward message as an rfc822 MIME section;
16409b0b 1298if ARG is 3, decode message and forward as an rfc822 MIME section;
25fc4fd5 1299if ARG is 4, forward message directly inline;
16409b0b 1300otherwise, use flipped `message-forward-as-mime'.
23f87bed 1301If POST, post instead of mail.
0afb49a1 1302For the \"inline\" alternatives, also see the variable
23f87bed 1303`message-forward-ignored-headers'."
eec82323 1304 (interactive "P")
23f87bed
MB
1305 (if (cdr (gnus-summary-work-articles nil))
1306 ;; Process marks are given.
6631d4b6 1307 (gnus-uu-digest-mail-forward nil post)
23f87bed
MB
1308 ;; No process marks.
1309 (let ((message-forward-as-mime message-forward-as-mime)
1310 (message-forward-show-mml message-forward-show-mml))
1311 (cond
1312 ((null arg))
1313 ((eq arg 1)
1314 (setq message-forward-as-mime nil
1315 message-forward-show-mml t))
1316 ((eq arg 2)
1317 (setq message-forward-as-mime t
1318 message-forward-show-mml nil))
1319 ((eq arg 3)
1320 (setq message-forward-as-mime t
1321 message-forward-show-mml t))
1322 ((eq arg 4)
1323 (setq message-forward-as-mime nil
1324 message-forward-show-mml nil))
1325 (t
1326 (setq message-forward-as-mime (not message-forward-as-mime))))
1327 (let* ((gnus-article-reply (gnus-summary-article-number))
1328 (gnus-article-yanked-articles (list gnus-article-reply)))
1329 (gnus-setup-message 'forward
1330 (gnus-summary-select-article)
1331 (let ((mail-parse-charset
1332 (or (and (gnus-buffer-live-p gnus-article-buffer)
1333 (with-current-buffer gnus-article-buffer
1334 gnus-article-charset))
1335 gnus-newsgroup-charset))
1336 (mail-parse-ignored-charsets
1337 gnus-newsgroup-ignored-charsets))
1338 (set-buffer gnus-original-article-buffer)
1339 (message-forward post)))))))
eec82323 1340
89b163db
G
1341(defun gnus-summary-resend-message-insert-gcc ()
1342 "Insert Gcc header according to `gnus-gcc-self-resent-messages'."
1343 (gnus-inews-insert-gcc)
1344 (let ((gcc (mapcar
1345 (lambda (group)
1346 (mm-encode-coding-string
1347 group
1348 (gnus-group-name-charset (gnus-inews-group-method group)
1349 group)))
1350 (message-unquote-tokens
1351 (message-tokenize-header (mail-fetch-field "gcc" nil t)
1352 " ,"))))
1353 (self (with-current-buffer gnus-summary-buffer
1354 gnus-gcc-self-resent-messages)))
1355 (message-remove-header "gcc")
1356 (when gcc
1357 (goto-char (point-max))
1358 (cond ((eq self 'none))
1359 ((eq self t)
1360 (insert "Gcc: \"" gnus-newsgroup-name "\"\n"))
1361 ((stringp self)
1362 (insert "Gcc: "
1363 (mm-encode-coding-string
1364 (if (string-match " " self)
1365 (concat "\"" self "\"")
1366 self)
1367 (gnus-group-name-charset (gnus-inews-group-method self)
1368 self))
1369 "\n"))
1370 ((null self)
1371 (insert "Gcc: " (mapconcat 'identity gcc ", ") "\n"))
1372 ((eq self 'no-gcc-self)
1373 (when (setq gcc (delete
1374 gnus-newsgroup-name
1375 (delete (concat "\"" gnus-newsgroup-name "\"")
1376 gcc)))
1377 (insert "Gcc: " (mapconcat 'identity gcc ", ") "\n")))))))
1378
eec82323
LMI
1379(defun gnus-summary-resend-message (address n)
1380 "Resend the current article to ADDRESS."
23f87bed
MB
1381 (interactive
1382 (list (message-read-from-minibuffer
1383 "Resend message(s) to: "
1384 (when (and gnus-summary-resend-default-address
1385 (gnus-buffer-live-p gnus-original-article-buffer))
1386 ;; If some other article is currently selected, the
1387 ;; initial-contents is wrong. Whatever, it is just the
1388 ;; initial-contents.
1389 (with-current-buffer gnus-original-article-buffer
1390 (nnmail-fetch-field "to"))))
1391 current-prefix-arg))
89b163db 1392 (let ((message-header-setup-hook (copy-sequence message-header-setup-hook))
891403f6
KY
1393 (message-sent-hook (copy-sequence message-sent-hook))
1394 ;; Honor posting-style for `name' and `address' in Resent-From header.
1395 (styles (gnus-group-find-parameter gnus-newsgroup-name
1396 'posting-style t))
1397 (user-full-name user-full-name)
1398 (user-mail-address user-mail-address)
1399 tem)
3b7bf1d4
KY
1400 (dolist (style styles)
1401 (when (stringp (cadr style))
1402 (setcdr style (list (mm-decode-coding-string (cadr style) 'utf-8)))))
891403f6
KY
1403 (dolist (style (if styles
1404 (append gnus-posting-styles (list (cons ".*" styles)))
1405 gnus-posting-styles))
e06151b3
LI
1406 (when (and (stringp (car style))
1407 (string-match (pop style) gnus-newsgroup-name))
891403f6
KY
1408 (when (setq tem (cadr (assq 'name style)))
1409 (setq user-full-name tem))
1410 (when (setq tem (cadr (assq 'address style)))
1411 (setq user-mail-address tem))))
89b163db
G
1412 ;; `gnus-summary-resend-message-insert-gcc' must run last.
1413 (add-hook 'message-header-setup-hook
1414 'gnus-summary-resend-message-insert-gcc t)
1415 (add-hook 'message-sent-hook
1416 `(lambda ()
1417 (let ((rfc2047-encode-encoded-words nil))
1418 ,(if gnus-agent
1419 '(gnus-agent-possibly-do-gcc)
1420 '(gnus-inews-do-gcc)))))
1421 (dolist (article (gnus-summary-work-articles n))
1422 (gnus-summary-select-article nil nil nil article)
1423 (with-current-buffer gnus-original-article-buffer
1424 (let ((gnus-gcc-externalize-attachments nil)
1425 (message-inhibit-body-encoding t))
1426 (message-resend address)))
1427 (gnus-summary-mark-article-as-forwarded article))))
23f87bed
MB
1428
1429;; From: Matthieu Moy <Matthieu.Moy@imag.fr>
1430(defun gnus-summary-resend-message-edit ()
1431 "Resend an article that has already been sent.
1432A new buffer will be created to allow the user to modify body and
1433contents of the message, and then, everything will happen as when
1434composing a new message."
1435 (interactive)
9153f10d 1436 (let ((mail-parse-charset gnus-newsgroup-charset))
23f87bed
MB
1437 (gnus-setup-message 'reply-yank
1438 (gnus-summary-select-article t)
1439 (set-buffer gnus-original-article-buffer)
1440 (let ((cur (current-buffer))
1441 (to (message-fetch-field "to")))
1442 ;; Get a normal message buffer.
1443 (message-pop-to-buffer (message-buffer-name "Resend" to))
1444 (insert-buffer-substring cur)
1445 (mime-to-mml)
1446 (message-narrow-to-head-1)
1447 ;; Gnus will generate a new one when sending.
1448 (message-remove-header "Message-ID")
23f87bed 1449 ;; Remove unwanted headers.
2f62a044 1450 (message-remove-header message-ignored-resent-headers t)
23f87bed
MB
1451 (goto-char (point-max))
1452 (insert mail-header-separator)
2f62a044 1453 ;; Add Gcc header.
2f62a044 1454 (gnus-inews-insert-gcc)
23f87bed
MB
1455 (goto-char (point-min))
1456 (when (re-search-forward "^To:\\|^Newsgroups:" nil 'move)
1457 (forward-char 1))
1458 (widen)))))
eec82323 1459
16409b0b 1460(defun gnus-summary-post-forward (&optional arg)
eec82323 1461 "Forward the current article to a newsgroup.
16409b0b 1462See `gnus-summary-mail-forward' for ARG."
eec82323 1463 (interactive "P")
16409b0b 1464 (gnus-summary-mail-forward arg t))
eec82323 1465
eec82323
LMI
1466(defun gnus-summary-mail-crosspost-complaint (n)
1467 "Send a complaint about crossposting to the current article(s)."
1468 (interactive "P")
01c52d31
MB
1469 (dolist (article (gnus-summary-work-articles n))
1470 (set-buffer gnus-summary-buffer)
1471 (gnus-summary-goto-subject article)
1472 (let ((group (gnus-group-real-name gnus-newsgroup-name))
1473 newsgroups followup-to)
1474 (gnus-summary-select-article)
1475 (set-buffer gnus-original-article-buffer)
1476 (if (and (<= (length (message-tokenize-header
1477 (setq newsgroups
1478 (mail-fetch-field "newsgroups"))
1479 ", "))
1480 1)
1481 (or (not (setq followup-to (mail-fetch-field "followup-to")))
1482 (not (member group (message-tokenize-header
1483 followup-to ", ")))))
1484 (if followup-to
1485 (gnus-message 1 "Followup-to restricted")
1486 (gnus-message 1 "Not a crossposted article"))
1487 (set-buffer gnus-summary-buffer)
1488 (gnus-summary-reply-with-original 1)
1489 (set-buffer gnus-message-buffer)
1490 (message-goto-body)
1491 (insert (format gnus-crosspost-complaint newsgroups group))
1492 (message-goto-subject)
1493 (re-search-forward " *$")
1494 (replace-match " (crosspost notification)" t t)
1495 (gnus-deactivate-mark)
1496 (when (gnus-y-or-n-p "Send this complaint? ")
1497 (message-send-and-exit))))))
eec82323 1498
eec82323
LMI
1499(defun gnus-inews-add-to-address (group)
1500 (let ((to-address (mail-fetch-field "to")))
1501 (when (and to-address
1502 (gnus-alive-p))
1503 ;; This mail group doesn't have a `to-list', so we add one
1504 ;; here. Magic!
1505 (when (gnus-y-or-n-p
23f87bed 1506 (format "Do you want to add this as `to-list': %s? " to-address))
eec82323
LMI
1507 (gnus-group-add-parameter group (cons 'to-list to-address))))))
1508
eec82323
LMI
1509(defun gnus-article-mail (yank)
1510 "Send a reply to the address near point.
1511If YANK is non-nil, include the original article."
1512 (interactive "P")
1513 (let ((address
1514 (buffer-substring
1515 (save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point)))
1516 (save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point))))))
1517 (when address
23f87bed 1518 (gnus-msg-mail address)
eec82323
LMI
1519 (when yank
1520 (gnus-inews-yank-articles (list (cdr gnus-article-current)))))))
1521
1522(defvar nntp-server-type)
1523(defun gnus-bug ()
1524 "Send a bug report to the Gnus maintainers."
1525 (interactive)
1526 (unless (gnus-alive-p)
1527 (error "Gnus has been shut down"))
88818fbe
SZ
1528 (gnus-setup-message (if (message-mail-user-agent) 'message 'bug)
1529 (unless (message-mail-user-agent)
88818fbe
SZ
1530 (when gnus-bug-create-help-buffer
1531 (switch-to-buffer "*Gnus Help Bug*")
1532 (erase-buffer)
1533 (insert gnus-bug-message)
1534 (goto-char (point-min)))
1535 (message-pop-to-buffer "*Gnus Bug*"))
1536 (let ((message-this-is-mail t))
67aa99ff
G
1537 (message-setup `((To . ,gnus-maintainer)
1538 (Subject . "")
1539 (X-Debbugs-Package
1540 . ,(format "%s" gnus-bug-package))
1541 (X-Debbugs-Version
a048c295 1542 . ,(format "%s" (gnus-continuum-version))))))
6748645f
LMI
1543 (when gnus-bug-create-help-buffer
1544 (push `(gnus-bug-kill-buffer) message-send-actions))
eec82323 1545 (goto-char (point-min))
72aba33f
LMI
1546 (message-goto-body)
1547 (insert "\n\n\n\n\n")
6748645f
LMI
1548 (insert (gnus-version) "\n"
1549 (emacs-version) "\n")
eec82323
LMI
1550 (when (and (boundp 'nntp-server-type)
1551 (stringp nntp-server-type))
1552 (insert nntp-server-type))
eec82323
LMI
1553 (goto-char (point-min))
1554 (search-forward "Subject: " nil t)
1555 (message "")))
1556
1557(defun gnus-bug-kill-buffer ()
1558 (when (get-buffer "*Gnus Help Bug*")
1559 (kill-buffer "*Gnus Help Bug*")))
1560
16409b0b
GM
1561(defun gnus-summary-yank-message (buffer n)
1562 "Yank the current article into a composed message."
1563 (interactive
229b59da 1564 (list (gnus-completing-read "Buffer" (message-buffers) t)
16409b0b
GM
1565 current-prefix-arg))
1566 (gnus-summary-iterate n
23f87bed 1567 (let ((gnus-inhibit-treatment t))
16409b0b 1568 (gnus-summary-select-article))
228b6ecd 1569 (with-current-buffer buffer
16409b0b
GM
1570 (message-yank-buffer gnus-article-buffer))))
1571
eec82323
LMI
1572;;; Treatment of rejected articles.
1573;;; Bounced mail.
1574
1575(defun gnus-summary-resend-bounced-mail (&optional fetch)
1576 "Re-mail the current message.
23f87bed 1577This only makes sense if the current message is a bounce message that
eec82323
LMI
1578contains some mail you have written which has been bounced back to
1579you.
1580If FETCH, try to fetch the article that this is a reply to, if indeed
1581this is a reply."
1582 (interactive "P")
1583 (gnus-summary-select-article t)
2f62a044
MB
1584 (let (summary-buffer parent)
1585 (if fetch
1586 (progn
1587 (setq summary-buffer (current-buffer))
1588 (set-buffer gnus-original-article-buffer)
1589 (article-goto-body)
1590 (when (re-search-forward "^References:\n?" nil t)
1591 (while (memq (char-after) '(?\t ? ))
1592 (forward-line 1))
1593 (skip-chars-backward "\t\n ")
1594 (setq parent
1595 (gnus-parent-id (buffer-substring (match-end 0) (point))))))
1596 (set-buffer gnus-original-article-buffer))
1597 (gnus-setup-message 'compose-bounce
eec82323 1598 (message-bounce)
2f62a044 1599 ;; Add Gcc header.
2f62a044 1600 (gnus-inews-insert-gcc)
eec82323 1601 ;; If there are references, we fetch the article we answered to.
2f62a044
MB
1602 (when parent
1603 (with-current-buffer summary-buffer
1604 (gnus-summary-refer-article parent)
1605 (gnus-summary-show-all-headers))))))
eec82323
LMI
1606
1607;;; Gcc handling.
1608
0342aa5b 1609(defun gnus-inews-group-method (group)
23f87bed
MB
1610 (cond
1611 ;; If the group doesn't exist, we assume
1612 ;; it's an archive group...
1613 ((and (null (gnus-get-info group))
1614 (eq (car (gnus-server-to-method gnus-message-archive-method))
1615 (car (gnus-server-to-method (gnus-group-method group)))))
1616 gnus-message-archive-method)
1617 ;; Use the method.
1618 ((gnus-info-method (gnus-get-info group))
1619 (gnus-info-method (gnus-get-info group)))
1620 ;; Find the method.
1621 (t (gnus-server-to-method (gnus-group-method group)))))
0342aa5b 1622
eec82323
LMI
1623;; Do Gcc handling, which copied the message over to some group.
1624(defun gnus-inews-do-gcc (&optional gcc)
1625 (interactive)
23f87bed
MB
1626 (save-excursion
1627 (save-restriction
1628 (message-narrow-to-headers)
1629 (let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
1630 (cur (current-buffer))
f65bd833 1631 groups group method group-art options
23f87bed
MB
1632 mml-externalize-attachments)
1633 (when gcc
1634 (message-remove-header "gcc")
1635 (widen)
1636 (setq groups (message-unquote-tokens
1637 (message-tokenize-header gcc " ,")))
1638 ;; Copy the article over to some group(s).
1639 (while (setq group (pop groups))
4d8a28ec
MB
1640 (setq method (gnus-inews-group-method group)
1641 group (mm-encode-coding-string
1642 group
1643 (gnus-group-name-charset method group)))
1644 (unless (gnus-check-server method)
23f87bed
MB
1645 (error "Can't open server %s" (if (stringp method) method
1646 (car method))))
99e65b2d 1647 (unless (gnus-request-group group t method)
23f87bed
MB
1648 (gnus-request-create-group group method))
1649 (setq mml-externalize-attachments
1650 (if (stringp gnus-gcc-externalize-attachments)
1651 (string-match gnus-gcc-externalize-attachments group)
1652 gnus-gcc-externalize-attachments))
1653 (save-excursion
1654 (nnheader-set-temp-buffer " *acc*")
f65bd833 1655 (setq message-options (with-current-buffer cur message-options))
23f87bed 1656 (insert-buffer-substring cur)
89b163db 1657 (run-hooks 'gnus-gcc-pre-body-encode-hook)
23f87bed 1658 (message-encode-message-body)
89b163db 1659 (run-hooks 'gnus-gcc-post-body-encode-hook)
23f87bed
MB
1660 (save-restriction
1661 (message-narrow-to-headers)
1662 (let* ((mail-parse-charset message-default-charset)
1663 (newsgroups-field (save-restriction
1664 (message-narrow-to-headers-or-head)
1665 (message-fetch-field "Newsgroups")))
1666 (followup-field (save-restriction
1667 (message-narrow-to-headers-or-head)
1668 (message-fetch-field "Followup-To")))
1669 ;; BUG: We really need to get the charset for
1670 ;; each name in the Newsgroups and Followup-To
1671 ;; lines to allow crossposting between group
c80e3b4a 1672 ;; names with incompatible character sets.
23f87bed
MB
1673 ;; -- Per Abrahamsen <abraham@dina.kvl.dk> 2001-10-08.
1674 (group-field-charset
1675 (gnus-group-name-charset
1676 method (or newsgroups-field "")))
1677 (followup-field-charset
1678 (gnus-group-name-charset
1679 method (or followup-field "")))
1680 (rfc2047-header-encoding-alist
1681 (append
1682 (when group-field-charset
1683 (list (cons "Newsgroups" group-field-charset)))
1684 (when followup-field-charset
1685 (list (cons "Followup-To" followup-field-charset)))
1686 rfc2047-header-encoding-alist)))
1687 (mail-encode-encoded-word-buffer)))
1688 (goto-char (point-min))
1689 (when (re-search-forward
1690 (concat "^" (regexp-quote mail-header-separator) "$")
1691 nil t)
1692 (replace-match "" t t ))
01c52d31
MB
1693 (when (or (not (gnus-check-backend-function
1694 'request-accept-article group))
1695 (not (setq group-art
1696 (gnus-request-accept-article
1697 group method t t))))
23f87bed 1698 (gnus-message 1 "Couldn't store article in group %s: %s"
01c52d31 1699 group (gnus-status-message method)))
e3e955fe
MB
1700 (when (stringp method)
1701 (setq method (gnus-server-to-method method)))
1702 (when (and (listp method)
1703 (gnus-native-method-p method))
1704 (setq group (gnus-group-short-name group)))
23f87bed
MB
1705 (when (and group-art
1706 ;; FIXME: Should gcc-mark-as-read work when
1707 ;; Gnus is not running?
89b163db
G
1708 (gnus-alive-p))
1709 (if (or gnus-gcc-mark-as-read
1710 (and (boundp 'gnus-inews-mark-gcc-as-read)
1711 (symbol-value 'gnus-inews-mark-gcc-as-read)))
1712 (gnus-group-mark-article-read group (cdr group-art))
1713 (with-current-buffer gnus-group-buffer
1714 (let ((gnus-group-marked (list group))
1715 (gnus-get-new-news-hook nil)
1716 (inhibit-read-only t))
1717 (gnus-group-get-new-news-this-group nil t)))))
f65bd833
KY
1718 (setq options message-options)
1719 (with-current-buffer cur (setq message-options options))
23f87bed 1720 (kill-buffer (current-buffer)))))))))
eec82323 1721
ed797193 1722(defun gnus-inews-insert-gcc (&optional group)
eec82323 1723 "Insert the Gcc to say where the article is to be archived."
ed797193
G
1724 (let* ((group (or group gnus-newsgroup-name))
1725 (group (when group (gnus-group-decoded-name group)))
1726 (var (or gnus-outgoing-message-group gnus-message-archive-group))
6748645f 1727 (gcc-self-val
9eb45973
AC
1728 (and group (not (gnus-virtual-group-p group))
1729 (gnus-group-find-parameter group 'gcc-self)))
16409b0b 1730 result
eec82323
LMI
1731 (groups
1732 (cond
1733 ((null gnus-message-archive-method)
1734 ;; Ignore.
1735 nil)
1736 ((stringp var)
1737 ;; Just a single group.
1738 (list var))
1739 ((null var)
1740 ;; We don't want this.
1741 nil)
1742 ((and (listp var) (stringp (car var)))
1743 ;; A list of groups.
1744 var)
23f87bed 1745 ((functionp var)
eec82323
LMI
1746 ;; A function.
1747 (funcall var group))
d11f2f38 1748 (group
eec82323
LMI
1749 ;; An alist of regexps/functions/forms.
1750 (while (and var
1751 (not
1752 (setq result
1753 (cond
dc2ab667
LMI
1754 ((and group
1755 (stringp (caar var)))
eec82323
LMI
1756 ;; Regexp.
1757 (when (string-match (caar var) group)
1758 (cdar var)))
dc2ab667
LMI
1759 ((and group
1760 (functionp (car var)))
eec82323
LMI
1761 ;; Function.
1762 (funcall (car var) group))
1763 (t
1764 (eval (car var)))))))
1765 (setq var (cdr var)))
1766 result)))
1767 name)
9d9ffa13
LMI
1768 (when (and (or groups gcc-self-val)
1769 (gnus-alive-p))
eec82323
LMI
1770 (when (stringp groups)
1771 (setq groups (list groups)))
1772 (save-excursion
1773 (save-restriction
1774 (message-narrow-to-headers)
1775 (goto-char (point-max))
1776 (insert "Gcc: ")
6748645f
LMI
1777 (if gcc-self-val
1778 ;; Use the `gcc-self' param value instead.
eec82323
LMI
1779 (progn
1780 (insert
1781 (if (stringp gcc-self-val)
23f87bed
MB
1782 (if (string-match " " gcc-self-val)
1783 (concat "\"" gcc-self-val "\"")
1784 gcc-self-val)
1785 ;; In nndoc groups, we use the parent group name
1786 ;; instead of the current group.
1787 (let ((group (or (gnus-group-find-parameter
1788 gnus-newsgroup-name 'parent-group)
1789 group)))
1790 (if (string-match " " group)
1791 (concat "\"" group "\"")
1792 group))))
eec82323
LMI
1793 (if (not (eq gcc-self-val 'none))
1794 (insert "\n")
23f87bed 1795 (gnus-delete-line)))
6748645f 1796 ;; Use the list of groups.
eec82323 1797 (while (setq name (pop groups))
23f87bed
MB
1798 (let ((str (if (string-match ":" name)
1799 name
1800 (gnus-group-prefixed-name
1801 name gnus-message-archive-method))))
1802 (insert (if (string-match " " str)
1803 (concat "\"" str "\"")
1804 str)))
eec82323
LMI
1805 (when groups
1806 (insert " ")))
1807 (insert "\n")))))))
1808
23f87bed
MB
1809(defun gnus-mailing-list-followup-to ()
1810 "Look at the headers in the current buffer and return a Mail-Followup-To address."
1811 (let ((x-been-there (gnus-fetch-original-field "x-beenthere"))
1812 (list-post (gnus-fetch-original-field "list-post")))
1813 (when (and list-post
1814 (string-match "mailto:\\([^>]+\\)" list-post))
1815 (setq list-post (match-string 1 list-post)))
1816 (or list-post
1817 x-been-there)))
1818
6748645f
LMI
1819;;; Posting styles.
1820
23f87bed 1821(defun gnus-configure-posting-styles (&optional group-name)
6748645f
LMI
1822 "Configure posting styles according to `gnus-posting-styles'."
1823 (unless gnus-inhibit-posting-styles
23f87bed 1824 (let ((group (or group-name gnus-newsgroup-name ""))
ecd283b9
LMI
1825 (styles (if (gnus-buffer-live-p gnus-summary-buffer)
1826 (with-current-buffer gnus-summary-buffer
1827 gnus-posting-styles)
1828 gnus-posting-styles))
23f87bed 1829 style match attribute value v results
16409b0b
GM
1830 filep name address element)
1831 ;; If the group has a posting-style parameter, add it at the end with a
1832 ;; regexp matching everything, to be sure it takes precedence over all
1833 ;; the others.
1834 (when gnus-newsgroup-name
1835 (let ((tmp-style (gnus-group-find-parameter group 'posting-style t)))
1836 (when tmp-style
3b7bf1d4
KY
1837 (dolist (style tmp-style)
1838 (when (stringp (cadr style))
1839 (setcdr style (list (mm-decode-coding-string (cadr style)
1840 'utf-8)))))
16409b0b 1841 (setq styles (append styles (list (cons ".*" tmp-style)))))))
6748645f 1842 ;; Go through all styles and look for matches.
16409b0b
GM
1843 (dolist (style styles)
1844 (setq match (pop style))
1845 (goto-char (point-min))
1846 (when (cond
1847 ((stringp match)
1848 ;; Regexp string match on the group name.
1849 (string-match match group))
1850 ((eq match 'header)
23f87bed
MB
1851 ;; Obsolete format of header match.
1852 (and (gnus-buffer-live-p gnus-article-copy)
1853 (with-current-buffer gnus-article-copy
9b5773bc
MB
1854 (save-restriction
1855 (nnheader-narrow-to-headers)
1856 (let ((header (message-fetch-field (pop style))))
1857 (and header
1858 (string-match (pop style) header)))))))
16409b0b 1859 ((or (symbolp match)
23f87bed 1860 (functionp match))
16409b0b 1861 (cond
23f87bed 1862 ((functionp match)
16409b0b
GM
1863 ;; Function to be called.
1864 (funcall match))
1865 ((boundp match)
1866 ;; Variable to be checked.
1867 (symbol-value match))))
1868 ((listp match)
23f87bed
MB
1869 (cond
1870 ((eq (car match) 'header)
1871 ;; New format of header match.
1872 (and (gnus-buffer-live-p gnus-article-copy)
1873 (with-current-buffer gnus-article-copy
9b5773bc
MB
1874 (save-restriction
1875 (nnheader-narrow-to-headers)
1876 (let ((header (message-fetch-field (nth 1 match))))
1877 (and header
1878 (string-match (nth 2 match) header)))))))
23f87bed 1879 (t
99d99081 1880 ;; This is a form to be evalled.
23f87bed 1881 (eval match)))))
6748645f 1882 ;; We have a match, so we set the variables.
16409b0b
GM
1883 (dolist (attribute style)
1884 (setq element (pop attribute)
16409b0b
GM
1885 filep nil)
1886 (setq value
1887 (cond
1888 ((eq (car attribute) :file)
1889 (setq filep t)
1890 (cadr attribute))
1891 ((eq (car attribute) :value)
1892 (cadr attribute))
1893 (t
1894 (car attribute))))
1895 ;; We get the value.
1896 (setq v
1897 (cond
1898 ((stringp value)
389b76fa 1899 (if (and (stringp match)
87732ef3 1900 (gnus-string-match-p "\\\\[&[:digit:]]" value)
389b76fa
G
1901 (match-beginning 1))
1902 (gnus-match-substitute-replacement value nil nil group)
1903 value))
16409b0b 1904 ((or (symbolp value)
23f87bed
MB
1905 (functionp value))
1906 (cond ((functionp value)
16409b0b
GM
1907 (funcall value))
1908 ((boundp value)
1909 (symbol-value value))))
1910 ((listp value)
1911 (eval value))))
1912 ;; Translate obsolescent value.
23f87bed
MB
1913 (cond
1914 ((eq element 'signature-file)
16409b0b
GM
1915 (setq element 'signature
1916 filep t))
23f87bed
MB
1917 ((eq element 'x-face-file)
1918 (setq element 'x-face
1919 filep t)))
01c52d31
MB
1920 ;; Post-processing for the signature posting-style:
1921 (and (eq element 'signature) filep
1922 message-signature-directory
1923 ;; don't actually use the signature directory
1924 ;; if message-signature-file contains a path.
1925 (not (file-name-directory v))
1926 (setq v (nnheader-concat message-signature-directory v)))
16409b0b
GM
1927 ;; Get the contents of file elems.
1928 (when (and filep v)
1929 (setq v (with-temp-buffer
1930 (insert-file-contents v)
5f49be3f
MB
1931 (buffer-substring
1932 (point-min)
1933 (progn
1934 (goto-char (point-max))
1935 (if (zerop (skip-chars-backward "\n"))
1936 (point)
1937 (1+ (point))))))))
16409b0b
GM
1938 (setq results (delq (assoc element results) results))
1939 (push (cons element v) results))))
1940 ;; Now we have all the styles, so we insert them.
1941 (setq name (assq 'name results)
1942 address (assq 'address results))
1943 (setq results (delq name (delq address results)))
23f87bed
MB
1944 (gnus-make-local-hook 'message-setup-hook)
1945 (setq results (sort results (lambda (x y)
1946 (string-lessp (car x) (car y)))))
16409b0b
GM
1947 (dolist (result results)
1948 (add-hook 'message-setup-hook
1949 (cond
1950 ((eq 'eval (car result))
1951 'ignore)
1952 ((eq 'body (car result))
1953 `(lambda ()
1954 (save-excursion
1955 (message-goto-body)
1956 (insert ,(cdr result)))))
1957 ((eq 'signature (car result))
1958 (set (make-local-variable 'message-signature) nil)
1959 (set (make-local-variable 'message-signature-file) nil)
1960 (if (not (cdr result))
1961 'ignore
1962 `(lambda ()
1963 (save-excursion
1964 (let ((message-signature ,(cdr result)))
1965 (when message-signature
1966 (message-insert-signature)))))))
1967 (t
1968 (let ((header
1969 (if (symbolp (car result))
1970 (capitalize (symbol-name (car result)))
1971 (car result))))
1972 `(lambda ()
1973 (save-excursion
1974 (message-remove-header ,header)
1975 (let ((value ,(cdr result)))
1976 (when value
1977 (message-goto-eoh)
23f87bed
MB
1978 (insert ,header ": " value)
1979 (unless (bolp)
1980 (insert "\n")))))))))
1981 nil 'local))
16409b0b
GM
1982 (when (or name address)
1983 (add-hook 'message-setup-hook
1984 `(lambda ()
23f87bed
MB
1985 (set (make-local-variable 'user-mail-address)
1986 ,(or (cdr address) user-mail-address))
16409b0b
GM
1987 (let ((user-full-name ,(or (cdr name) (user-full-name)))
1988 (user-mail-address
1989 ,(or (cdr address) user-mail-address)))
1990 (save-excursion
1991 (message-remove-header "From")
1992 (message-goto-eoh)
23f87bed
MB
1993 (insert "From: " (message-make-from) "\n"))))
1994 nil 'local)))))
eec82323
LMI
1995
1996;;; Allow redefinition of functions.
1997
1998(gnus-ems-redefine)
1999
2000(provide 'gnus-msg)
2001
2002;;; gnus-msg.el ends here