gnus-msg.el 65.2 KB
Newer Older
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1
;;; gnus-msg.el --- mail and post interface for Gnus
2

3
;; Copyright (C) 1995-2011  Free Software Foundation, Inc.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
4 5

;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
6
;;	Lars Magne Ingebrigtsen <larsi@gnus.org>
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
7 8 9 10
;; Keywords: news

;; This file is part of GNU Emacs.

11
;; GNU Emacs is free software: you can redistribute it and/or modify
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
12
;; it under the terms of the GNU General Public License as published by
13 14
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
15 16 17 18 19 20 21

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
22
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
23 24 25 26 27

;;; Commentary:

;;; Code:

28 29
(eval-when-compile (require 'cl))

Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
30 31 32 33
(require 'gnus)
(require 'gnus-ems)
(require 'message)
(require 'gnus-art)
34
(require 'gnus-util)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
35

36
(defcustom gnus-post-method 'current
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
37 38
  "*Preferred method for posting USENET news.

39 40 41
If this variable is `current' (which is the default), Gnus will use
the \"current\" select method when posting.  If it is `native', Gnus
will use the native select method when posting.
42 43 44 45

This method will not be used in mail groups and the like, only in
\"real\" newsgroups.

46
If not `native' nor `current', the value must be a valid method as discussed
47 48
in the documentation of `gnus-select-method'.  It can also be a list of
methods.  If that is the case, the user will be queried for what select
49 50
method to use when posting."
  :group 'gnus-group-foreign
51 52 53
  :link '(custom-manual "(gnus)Posting Server")
  :type `(choice (const native)
		 (const current)
54
		 (sexp :tag "Methods" ,gnus-select-method)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
55

56
(defcustom gnus-outgoing-message-group nil
57
  "All outgoing messages will be put in this group.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
58 59 60 61 62 63 64
If you want to store all your outgoing mail and articles in the group
\"nnml:archive\", you set this variable to that value.  This variable
can also be a list of group names.

If you want to have greater control over what group to put each
message in, you can set this variable to a function that checks the
current newsgroup name and then returns a suitable group name (or list
65 66
of names)."
  :group 'gnus-message
67 68 69 70
  :type '(choice (const nil)
		 (function)
		 (string :tag "Group")
		 (repeat :tag "List of groups" (string :tag "Group"))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
71

72 73
(make-obsolete-variable 'gnus-outgoing-message-group 'gnus-message-archive-group "24.1")

74 75
(defcustom gnus-mailing-list-groups nil
  "*If non-nil a regexp matching groups that are really mailing lists.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
76 77
This is useful when you're reading a mailing list that has been
gatewayed to a newsgroup, and you want to followup to an article in
78 79 80 81
the group."
  :group 'gnus-message
  :type '(choice (regexp)
		 (const nil)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
82

83 84 85 86
(defcustom gnus-add-to-list nil
  "*If non-nil, add a `to-list' parameter automatically."
  :group 'gnus-message
  :type 'boolean)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
87

88
(defcustom gnus-crosspost-complaint
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
89 90 91 92 93 94 95 96 97 98 99 100 101 102 103
  "Hi,

You posted the article below with the following Newsgroups header:

Newsgroups: %s

The %s group, at least, was an inappropriate recipient
of this message.  Please trim your Newsgroups header to exclude this
group before posting in the future.

Thank you.

"
  "Format string to be inserted when complaining about crossposts.
The first %s will be replaced by the Newsgroups header;
104 105 106 107 108 109 110
the second with the current group name."
  :group 'gnus-message
  :type 'string)

(defcustom gnus-message-setup-hook nil
  "Hook run after setting up a message buffer."
  :group 'gnus-message
Miles Bader's avatar
Miles Bader committed
111
  :options '(message-remove-blank-cited-lines)
112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147
  :type 'hook)

(defcustom gnus-bug-create-help-buffer t
  "*Should we create the *Gnus Help Bug* buffer?"
  :group 'gnus-message
  :type 'boolean)

(defcustom gnus-posting-styles nil
  "*Alist of styles to use when posting.
See Info node `(gnus)Posting Styles'."
  :group 'gnus-message
  :link '(custom-manual "(gnus)Posting Styles")
  :type '(repeat (cons (choice (regexp)
			       (variable)
			       (list (const header)
				     (string :tag "Header")
				     (regexp :tag "Regexp"))
			       (function)
			       (sexp))
		       (repeat (list
				(choice (const signature)
					(const signature-file)
					(const organization)
					(const address)
					(const x-face-file)
					(const name)
					(const body)
					(symbol)
					(string :tag "Header"))
				(choice (string)
					(function)
					(variable)
					(sexp)))))))

(defcustom gnus-gcc-mark-as-read nil
  "If non-nil, automatically mark Gcc articles as read."
148
  :version "22.1"
149 150 151 152
  :group 'gnus-message
  :type 'boolean)

(make-obsolete-variable 'gnus-inews-mark-gcc-as-read
153
			'gnus-gcc-mark-as-read "Emacs 22.1")
154 155 156 157 158 159

(defcustom gnus-gcc-externalize-attachments nil
  "Should local-file attachments be included as external parts in Gcc copies?
If it is `all', attach files as external parts;
if a regexp and matches the Gcc group name, attach files as external parts;
if nil, attach files as normal parts."
160
  :version "22.1"
161 162 163 164 165 166 167 168 169 170 171 172
  :group 'gnus-message
  :type '(choice (const nil :tag "None")
		 (const all :tag "Any")
		 (string :tag "Regexp")))

(gnus-define-group-parameter
 posting-charset-alist
 :type list
 :function-document
 "Return the permitted unencoded charsets for posting of GROUP."
 :variable gnus-group-posting-charset-alist
 :variable-default
173
  '(("^\\(no\\|fr\\)\\.[^,]*\\(,[ \t\n]*\\(no\\|fr\\)\\.[^,]*\\)*$" iso-8859-1 (iso-8859-1))
174 175 176
    ("^\\(fido7\\|relcom\\)\\.[^,]*\\(,[ \t\n]*\\(fido7\\|relcom\\)\\.[^,]*\\)*$" koi8-r (koi8-r))
    (message-this-is-mail nil nil)
    (message-this-is-news nil t))
177
 :variable-document
178 179 180 181 182 183 184 185 186 187 188 189
  "Alist of regexps and permitted unencoded charsets for posting.
Each element of the alist has the form (TEST HEADER BODY-LIST), where
TEST is either a regular expression matching the newsgroup header or a
variable to query,
HEADER is the charset which may be left unencoded in the header (nil
means encode all charsets),
BODY-LIST is a list of charsets which may be encoded using 8bit
content-transfer encoding in the body, or one of the special values
nil (always encode using quoted-printable) or t (always use 8bit).

Note that any value other than nil for HEADER infringes some RFCs, so
use this option with care."
190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217
 :variable-group gnus-charset
 :variable-type
 '(repeat (list :tag "Permitted unencoded charsets"
		(choice :tag "Where"
			(regexp :tag "Group")
			(const :tag "Mail message" :value message-this-is-mail)
			(const :tag "News article" :value message-this-is-news))
		(choice :tag "Header"
			(const :tag "None" nil)
			(symbol :tag "Charset"))
		(choice :tag "Body"
			(const :tag "Any" :value t)
			(const :tag "None" :value nil)
			(repeat :tag "Charsets"
				(symbol :tag "Charset")))))
 :parameter-type '(choice :tag "Permitted unencoded charsets"
			  :value nil
			  (repeat (symbol)))
 :parameter-document       "\
List of charsets that are permitted to be unencoded.")

(defcustom gnus-debug-files
  '("gnus.el" "gnus-sum.el" "gnus-group.el"
    "gnus-art.el" "gnus-start.el" "gnus-async.el"
    "gnus-msg.el" "gnus-score.el" "gnus-win.el" "gnus-topic.el"
    "gnus-agent.el" "gnus-cache.el" "gnus-srvr.el"
    "mm-util.el" "mm-decode.el" "nnmail.el" "message.el")
  "Files whose variables will be reported in `gnus-bug'."
218
  :version "22.1"
219 220 221 222 223 224 225
  :group 'gnus-message
  :type '(repeat (string :tag "File")))

(defcustom gnus-debug-exclude-variables
  '(mm-mime-mule-charset-alist
    nnmail-split-fancy message-minibuffer-local-map)
  "Variables that should not be reported in `gnus-bug'."
226
  :version "22.1"
227 228 229 230 231 232 233
  :group 'gnus-message
  :type '(repeat (symbol :tag "Variable")))

(defcustom gnus-discouraged-post-methods
  '(nndraft nnml nnimap nnmaildir nnmh nnfolder nndir)
  "A list of back ends that are not used in \"real\" newsgroups.
This variable is used only when `gnus-post-method' is `current'."
234
  :version "22.1"
235 236 237 238 239 240 241 242 243 244
  :group 'gnus-group-foreign
  :type '(repeat (symbol :tag "Back end")))

(defcustom gnus-message-replysign
  nil
  "Automatically sign replies to signed messages.
See also the `mml-default-sign-method' variable."
  :group 'gnus-message
  :type 'boolean)

245
(defcustom gnus-message-replyencrypt t
246 247
  "Automatically encrypt replies to encrypted messages.
See also the `mml-default-encrypt-method' variable."
248
  :version "24.1"
249 250 251 252 253 254 255 256 257
  :group 'gnus-message
  :type 'boolean)

(defcustom gnus-message-replysignencrypted
  t
  "Setting this causes automatically encrypted messages to also be signed."
  :group 'gnus-message
  :type 'boolean)

258 259
(defcustom gnus-confirm-mail-reply-to-news (and gnus-novice-user
						(not gnus-expert-user))
260 261 262 263
  "If non-nil, Gnus requests confirmation when replying to news.
This is done because new users often reply by mistake when reading
news.
This can also be a function receiving the group name as the only
264 265
parameter, which should return non-nil if a confirmation is needed; or
a regexp, in which case a confirmation is asked for if the group name
266
matches the regexp."
267
  :version "23.1" ;; No Gnus (default changed)
268 269 270
  :group 'gnus-message
  :type '(choice (const :tag "No" nil)
		 (const :tag "Yes" t)
271 272
		 (regexp :tag "If group matches regexp")
		 (function :tag "If function evaluates to non-nil")))
273 274 275 276 277 278 279

(defcustom gnus-confirm-treat-mail-like-news
  nil
  "If non-nil, Gnus will treat mail like news with regard to confirmation
when replying by mail.  See the `gnus-confirm-mail-reply-to-news' variable
for fine-tuning this.
If nil, Gnus will never ask for confirmation if replying to mail."
280
  :version "22.1"
281 282 283 284 285 286 287
  :group 'gnus-message
  :type 'boolean)

(defcustom gnus-summary-resend-default-address t
  "If non-nil, Gnus tries to suggest a default address to resend to.
If nil, the address field will always be empty after invoking
`gnus-summary-resend-message'."
288
  :version "22.1"
289 290
  :group 'gnus-message
  :type 'boolean)
291

292 293 294
(defcustom gnus-message-highlight-citation
  t ;; gnus-treat-highlight-citation ;; gnus-cite dependency
  "Enable highlighting of different citation levels in message-mode."
295
  :version "23.1" ;; No Gnus
296 297 298 299 300 301
  :group 'gnus-cite
  :group 'gnus-message
  :type 'boolean)

(autoload 'gnus-message-citation-mode "gnus-cite" nil t)

Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
302 303
;;; Internal variables.

304 305 306
(defvar gnus-inhibit-posting-styles nil
  "Inhibit the use of posting styles.")

307
(defvar gnus-article-yanked-articles nil)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
308 309
(defvar gnus-message-buffer "*Mail Gnus*")
(defvar gnus-article-copy nil)
310
(defvar gnus-check-before-posting nil)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
311
(defvar gnus-last-posting-server nil)
312
(defvar gnus-message-group-art nil)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
313

314 315
(defvar gnus-msg-force-broken-reply-to nil)

Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
316 317 318 319 320 321 322
(defconst gnus-bug-message
  "Sending a bug report to the Gnus Towers.
========================================

The buffer below is a mail buffer.  When you press `C-c C-c', it will
be sent to the Gnus Bug Exterminators.

323 324 325 326
The thing near the bottom of the buffer is how the environment
settings will be included in the mail.  Please do not delete that.
They will tell the Bug People what your environment is, so that it
will be easier to locate the bugs.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
327 328 329 330 331 332 333 334 335 336

If you have found a bug that makes Emacs go \"beep\", set
debug-on-error to t (`M-x set-variable RET debug-on-error RET t RET')
and include the backtrace in your bug report.

Please describe the bug in annoying, painstaking detail.

Thank you for your help in stamping out bugs.
")

337
(autoload 'gnus-uu-post-news "gnus-uu" nil t)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
338 339 340 341 342 343 344 345


;;;
;;; Gnus Posting Functions
;;;

(gnus-define-keys (gnus-summary-send-map "S" gnus-summary-mode-map)
  "p" gnus-summary-post-news
346
  "i" gnus-summary-news-other-window
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
347 348 349 350 351
  "f" gnus-summary-followup
  "F" gnus-summary-followup-with-original
  "c" gnus-summary-cancel-article
  "s" gnus-summary-supersede-article
  "r" gnus-summary-reply
352
  "y" gnus-summary-yank-message
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
353
  "R" gnus-summary-reply-with-original
354
  "L" gnus-summary-reply-to-list-with-original
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
355 356
  "w" gnus-summary-wide-reply
  "W" gnus-summary-wide-reply-with-original
357 358
  "v" gnus-summary-very-wide-reply
  "V" gnus-summary-very-wide-reply-with-original
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
359 360 361 362 363
  "n" gnus-summary-followup-to-mail
  "N" gnus-summary-followup-to-mail-with-original
  "m" gnus-summary-mail-other-window
  "u" gnus-uu-post-news
  "\M-c" gnus-summary-mail-crosspost-complaint
364 365
  "Br" gnus-summary-reply-broken-reply-to
  "BR" gnus-summary-reply-broken-reply-to-with-original
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
366 367 368 369 370 371 372 373
  "om" gnus-summary-mail-forward
  "op" gnus-summary-post-forward
  "Om" gnus-uu-digest-mail-forward
  "Op" gnus-uu-digest-post-forward)

(gnus-define-keys (gnus-send-bounce-map "D" gnus-summary-send-map)
  "b" gnus-summary-resend-bounced-mail
  ;; "c" gnus-summary-send-draft
374 375
  "r" gnus-summary-resend-message
  "e" gnus-summary-resend-message-edit)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
376 377 378

;;; Internal functions.

379
(defun gnus-inews-make-draft (articles)
380 381
  `(lambda ()
     (gnus-inews-make-draft-meta-information
382
      ,(gnus-group-decoded-name gnus-newsgroup-name) ',articles)))
383

Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
384 385
(defvar gnus-article-reply nil)
(defmacro gnus-setup-message (config &rest forms)
386
  (let ((winconf (make-symbol "gnus-setup-message-winconf"))
387
	(winconf-name (make-symbol "gnus-setup-message-winconf-name"))
388 389
	(buffer (make-symbol "gnus-setup-message-buffer"))
	(article (make-symbol "gnus-setup-message-article"))
390
	(yanked (make-symbol "gnus-setup-yanked-articles"))
391
	(group (make-symbol "gnus-setup-message-group")))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
392
    `(let ((,winconf (current-window-configuration))
393
	   (,winconf-name gnus-current-window-configuration)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
394
	   (,buffer (buffer-name (current-buffer)))
395 396
	   (,article gnus-article-reply)
	   (,yanked gnus-article-yanked-articles)
397
	   (,group gnus-newsgroup-name)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
398
	   (message-header-setup-hook
399
	    (copy-sequence message-header-setup-hook))
400
	   (mbl mml-buffer-list)
401
	   (message-mode-hook (copy-sequence message-mode-hook)))
402
       (setq mml-buffer-list nil)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
403
       (add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc)
Miles Bader's avatar
Miles Bader committed
404 405 406 407 408 409 410
       ;; message-newsreader and message-mailer were formerly set in
       ;; gnus-inews-add-send-actions, but this is too late when
       ;; message-generate-headers-first is used. --ansel
       (add-hook 'message-mode-hook
		 (lambda nil
		   (setq message-newsreader
			 (setq message-mailer (gnus-extended-version)))))
411 412 413 414 415 416 417 418 419 420 421 422 423 424 425
       ;; #### FIXME: for a reason that I did not manage to identify yet,
       ;; the variable `gnus-newsgroup-name' does not honor a dynamically
       ;; scoped or setq'ed value from a caller like `C-u gnus-summary-mail'.
       ;; After evaluation of @forms below, it gets the value we actually want
       ;; to override, and the posting styles are used. For that reason, I've
       ;; added an optional argument to `gnus-configure-posting-styles' to
       ;; make sure that the correct value for the group name is used. -- drv
       (add-hook 'message-mode-hook
		 (if (memq ,config '(reply-yank reply))
		     (lambda ()
		       (gnus-configure-posting-styles ,group))
		   (lambda ()
		     ;; There may be an old " *gnus article copy*" buffer.
		     (let (gnus-article-copy)
		       (gnus-configure-posting-styles ,group)))))
426
       (gnus-alist-pull ',(intern gnus-draft-meta-information-header)
427 428 429 430 431
		  message-required-headers)
       (when (and ,group
		  (not (string= ,group "")))
	 (push (cons
		(intern gnus-draft-meta-information-header)
432
		(gnus-inews-make-draft (or ,yanked ,article)))
433
	       message-required-headers))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
434
       (unwind-protect
435 436
	   (progn
	     ,@forms)
437
	 (gnus-inews-add-send-actions ,winconf ,buffer ,article ,config
438
				      ,yanked ,winconf-name)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
439
	 (setq gnus-message-buffer (current-buffer))
440 441
	 (set (make-local-variable 'gnus-message-group-art)
	      (cons ,group ,article))
442
	 (set (make-local-variable 'gnus-newsgroup-name) ,group)
443 444 445
	 ;; Enable highlighting of different citation levels
	 (when gnus-message-highlight-citation
	   (gnus-message-citation-mode 1))
446 447
	 (gnus-run-hooks 'gnus-message-setup-hook)
	 (if (eq major-mode 'message-mode)
448 449 450
	     (let ((mbl1 mml-buffer-list))
	       (setq mml-buffer-list mbl)  ;; Global value
	       (set (make-local-variable 'mml-buffer-list) mbl1);; Local value
451 452
	       (gnus-make-local-hook 'kill-buffer-hook)
	       (gnus-make-local-hook 'change-major-mode-hook)
453
	       (add-hook 'change-major-mode-hook 'mml-destroy-buffers nil t)
454 455 456
	       (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))
	   (mml-destroy-buffers)
	   (setq mml-buffer-list mbl)))
457
       (message-hide-headers)
458
       (gnus-add-buffer)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
459
       (gnus-configure-windows ,config t)
460
       (run-hooks 'post-command-hook)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
461 462
       (set-buffer-modified-p nil))))

463 464 465 466 467 468 469 470 471 472 473 474 475 476
(defun gnus-inews-make-draft-meta-information (group articles)
  (when (numberp articles)
    (setq articles (list articles)))
  (concat "(\"" group "\""
	  (if articles
	      (concat " "
		      (mapconcat
		       (lambda (elem)
			 (number-to-string
			  (if (consp elem)
			      (car elem)
			    elem)))
		       articles " "))
	    "")
477 478
	  ")"))

479
;;;###autoload
480
(defun gnus-msg-mail (&optional to subject other-headers continue
481
		      switch-action yank-action send-actions return-action)
482 483 484 485
  "Start editing a mail message to be sent.
Like `message-mail', but with Gnus paraphernalia, particularly the
Gcc: header for archiving purposes."
  (interactive)
486 487 488 489
  (let ((buf (current-buffer))
	mail-buf)
    (gnus-setup-message 'message
      (message-mail to subject other-headers continue
490
		    nil yank-action send-actions return-action))
491 492 493 494
    (when switch-action
      (setq mail-buf (current-buffer))
      (switch-to-buffer buf)
      (apply switch-action mail-buf nil)))
495 496 497
  ;; COMPOSEFUNC should return t if succeed.  Undocumented ???
  t)

498 499 500 501 502
;;;###autoload
(defun gnus-button-mailto (address)
  "Mail to ADDRESS."
  (set-buffer (gnus-copy-article-buffer))
  (gnus-setup-message 'message
503
    (message-reply address)))
504 505 506 507 508 509

;;;###autoload
(defun gnus-button-reply (&optional to-address wide)
  "Like `message-reply'."
  (interactive)
  (gnus-setup-message 'message
510
    (message-reply to-address wide)))
511

512 513
;;;###autoload
(define-mail-user-agent 'gnus-user-agent
514 515
  'gnus-msg-mail 'message-send-and-exit
  'message-kill-buffer 'message-send-hook)
516

517 518 519 520 521 522 523 524 525
(defun gnus-setup-posting-charset (group)
  (let ((alist gnus-group-posting-charset-alist)
	(group (or group ""))
	elem)
    (when group
      (catch 'found
	(while (setq elem (pop alist))
	  (when (or (and (stringp (car elem))
			 (string-match (car elem) group))
526
		    (and (functionp (car elem))
527 528 529 530 531
			 (funcall (car elem) group))
		    (and (symbolp (car elem))
			 (symbol-value (car elem))))
	    (throw 'found (cons (cadr elem) (caddr elem)))))))))

532
(defun gnus-inews-add-send-actions (winconf buffer article
533 534
					    &optional config yanked
					    winconf-name)
535
  (gnus-make-local-hook 'message-sent-hook)
536 537 538
  (add-hook 'message-sent-hook (if gnus-agent 'gnus-agent-possibly-do-gcc
				 'gnus-inews-do-gcc) nil t)
  (when gnus-agent
539
    (gnus-make-local-hook 'message-header-hook)
540
    (add-hook 'message-header-hook 'gnus-agent-possibly-save-gcc nil t))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
541
  (setq message-post-method
542
	`(lambda (&optional arg)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
543 544
	   (gnus-post-method arg ,gnus-newsgroup-name)))
  (message-add-action
545
   `(progn
546
      (setq gnus-current-window-configuration ',winconf-name)
547 548
      (when (gnus-buffer-exists-p ,buffer)
	(set-window-configuration ,winconf)))
549 550 551 552 553 554 555 556 557
   'exit 'postpone 'kill)
  (let ((to-be-marked (cond
		       (yanked
			(mapcar
			 (lambda (x) (if (listp x) (car x) x)) yanked))
		       (article (if (listp article) article (list article)))
		       (t nil))))
    (message-add-action
     `(when (gnus-buffer-exists-p ,buffer)
Stefan Monnier's avatar
Stefan Monnier committed
558
	(with-current-buffer ,buffer
559 560 561 562 563
	  ,(when to-be-marked
	     (if (eq config 'forward)
		 `(gnus-summary-mark-article-as-forwarded ',to-be-marked)
	       `(gnus-summary-mark-article-as-replied ',to-be-marked)))))
     'send)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
564 565 566 567 568 569

(put 'gnus-setup-message 'lisp-indent-function 1)
(put 'gnus-setup-message 'edebug-form-spec '(form body))

;;; Post news commands of Gnus group mode and summary mode

570 571 572 573 574 575 576 577
(defun gnus-group-mail (&optional arg)
  "Start composing a mail.
If ARG, use the group under the point to find a posting style.
If ARG is 1, prompt for a group name to find the posting style."
  (interactive "P")
  ;; We can't `let' gnus-newsgroup-name here, since that leads
  ;; to local variables leaking.
  (let ((group gnus-newsgroup-name)
578 579
	;; make sure last viewed article doesn't affect posting styles:
	(gnus-article-copy)
580 581 582 583 584 585
	(buffer (current-buffer)))
    (unwind-protect
	(progn
	  (setq gnus-newsgroup-name
		(if arg
		    (if (= 1 (prefix-numeric-value arg))
586
			(gnus-group-completing-read
587 588
			 "Use posting style of group"
			 nil (gnus-read-active-file-p))
589 590
		      (gnus-group-group-name))
		  ""))
591
	  ;; #### see comment in gnus-setup-message -- drv
592
	  (gnus-setup-message 'message (message-mail)))
Stefan Monnier's avatar
Stefan Monnier committed
593
      (with-current-buffer buffer
594
	(setq gnus-newsgroup-name group)))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
595

596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615
(defun gnus-group-news (&optional arg)
  "Start composing a news.
If ARG, post to group under point.
If ARG is 1, prompt for group name to post to.

This function prepares a news even when using mail groups.  This is useful
for posting messages to mail groups without actually sending them over the
network.  The corresponding back end must have a 'request-post method."
  (interactive "P")
  ;; We can't `let' gnus-newsgroup-name here, since that leads
  ;; to local variables leaking.
  (let ((group gnus-newsgroup-name)
	;; make sure last viewed article doesn't affect posting styles:
	(gnus-article-copy)
	(buffer (current-buffer)))
    (unwind-protect
	(progn
	  (setq gnus-newsgroup-name
		(if arg
		    (if (= 1 (prefix-numeric-value arg))
616 617
			(gnus-group-completing-read "Use group"
						    nil
618
						    (gnus-read-active-file-p))
619 620 621 622 623
		      (gnus-group-group-name))
		  ""))
	  ;; #### see comment in gnus-setup-message -- drv
	  (gnus-setup-message 'message
	    (message-news (gnus-group-real-name gnus-newsgroup-name))))
Stefan Monnier's avatar
Stefan Monnier committed
624
      (with-current-buffer buffer
625 626
	(setq gnus-newsgroup-name group)))))

Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
627
(defun gnus-group-post-news (&optional arg)
628 629 630 631
  "Start composing a message (a news by default).
If ARG, post to group under point.  If ARG is 1, prompt for group name.
Depending on the selected group, the message might be either a mail or
a news."
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
632
  (interactive "P")
633
  ;; Bind this variable here to make message mode hooks work ok.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
634 635 636
  (let ((gnus-newsgroup-name
	 (if arg
	     (if (= 1 (prefix-numeric-value arg))
637
		 (gnus-group-completing-read "Newsgroup" nil
638
					     (gnus-read-active-file-p))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
639
	       (gnus-group-group-name))
640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662
	   ""))
	;; make sure last viewed article doesn't affect posting styles:
	(gnus-article-copy))
    (gnus-post-news 'post gnus-newsgroup-name nil nil nil nil
		    (string= gnus-newsgroup-name ""))))

(defun gnus-summary-mail-other-window (&optional arg)
  "Start composing a mail in another window.
Use the posting of the current group by default.
If ARG, don't do that.  If ARG is 1, prompt for group name to find the
posting style."
  (interactive "P")
  ;; We can't `let' gnus-newsgroup-name here, since that leads
  ;; to local variables leaking.
  (let ((group gnus-newsgroup-name)
	;; make sure last viewed article doesn't affect posting styles:
	(gnus-article-copy)
	(buffer (current-buffer)))
    (unwind-protect
	(progn
	  (setq gnus-newsgroup-name
		(if arg
		    (if (= 1 (prefix-numeric-value arg))
663 664
			(gnus-group-completing-read "Use group"
						    nil
665
						    (gnus-read-active-file-p))
666 667 668 669
		      "")
		  gnus-newsgroup-name))
	  ;; #### see comment in gnus-setup-message -- drv
	  (gnus-setup-message 'message (message-mail)))
Stefan Monnier's avatar
Stefan Monnier committed
670
      (with-current-buffer buffer
671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692
	(setq gnus-newsgroup-name group)))))

(defun gnus-summary-news-other-window (&optional arg)
  "Start composing a news in another window.
Post to the current group by default.
If ARG, don't do that.  If ARG is 1, prompt for group name to post to.

This function prepares a news even when using mail groups.  This is useful
for posting messages to mail groups without actually sending them over the
network.  The corresponding back end must have a 'request-post method."
  (interactive "P")
  ;; We can't `let' gnus-newsgroup-name here, since that leads
  ;; to local variables leaking.
  (let ((group gnus-newsgroup-name)
	;; make sure last viewed article doesn't affect posting styles:
	(gnus-article-copy)
	(buffer (current-buffer)))
    (unwind-protect
	(progn
	  (setq gnus-newsgroup-name
		(if arg
		    (if (= 1 (prefix-numeric-value arg))
693 694
			(gnus-group-completing-read "Use group"
						    nil
695
						    (gnus-read-active-file-p))
696 697 698 699 700 701 702
		      "")
		  gnus-newsgroup-name))
	  ;; #### see comment in gnus-setup-message -- drv
	  (gnus-setup-message 'message
	    (progn
	      (message-news (gnus-group-real-name gnus-newsgroup-name))
	      (set (make-local-variable 'gnus-discouraged-post-methods)
703
		   (remove
704
		    (car (gnus-find-method-for-group gnus-newsgroup-name))
705
		    gnus-discouraged-post-methods)))))
Stefan Monnier's avatar
Stefan Monnier committed
706
      (with-current-buffer buffer
707 708 709 710 711 712 713 714 715 716 717 718
	(setq gnus-newsgroup-name group)))))

(defun gnus-summary-post-news (&optional arg)
  "Start composing a message.  Post to the current group by default.
If ARG, don't do that.  If ARG is 1, prompt for a group name to post to.
Depending on the selected group, the message might be either a mail or
a news."
  (interactive "P")
  ;; Bind this variable here to make message mode hooks work ok.
  (let ((gnus-newsgroup-name
	 (if arg
	     (if (= 1 (prefix-numeric-value arg))
719
		 (gnus-group-completing-read "Newsgroup" nil
720
					     (gnus-read-active-file-p))
721 722 723 724
	       "")
	   gnus-newsgroup-name))
	;; make sure last viewed article doesn't affect posting styles:
	(gnus-article-copy))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
725 726 727 728 729
    (gnus-post-news 'post gnus-newsgroup-name)))


(defun gnus-summary-followup (yank &optional force-news)
  "Compose a followup to an article.
730 731 732 733
If prefix argument YANK is non-nil, the original article is yanked
automatically.
YANK is a list of elements, where the car of each element is the
article number, and the cdr is the string to be yanked."
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
734 735 736 737
  (interactive
   (list (and current-prefix-arg
	      (gnus-summary-work-articles 1))))
  (when yank
738 739 740 741
    (gnus-summary-goto-subject
     (if (listp (car yank))
	 (caar yank)
       (car yank))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
742 743 744 745 746 747 748
  (save-window-excursion
    (gnus-summary-select-article))
  (let ((headers (gnus-summary-article-header (gnus-summary-article-number)))
	(gnus-newsgroup-name gnus-newsgroup-name))
    ;; Send a followup.
    (gnus-post-news nil gnus-newsgroup-name
		    headers gnus-article-buffer
749 750
		    yank nil force-news)
    (gnus-summary-handle-replysign)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
751 752

(defun gnus-summary-followup-with-original (n &optional force-news)
753 754 755
  "Compose a followup to an article and include the original article.
The text in the region will be yanked.  If the region isn't
active, the entire article will be yanked."
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771
  (interactive "P")
  (gnus-summary-followup (gnus-summary-work-articles n) force-news))

(defun gnus-summary-followup-to-mail (&optional arg)
  "Followup to the current mail message via news."
  (interactive
   (list (and current-prefix-arg
	      (gnus-summary-work-articles 1))))
  (gnus-summary-followup arg t))

(defun gnus-summary-followup-to-mail-with-original (&optional arg)
  "Followup to the current mail message via news."
  (interactive "P")
  (gnus-summary-followup (gnus-summary-work-articles arg) t))

(defun gnus-inews-yank-articles (articles)
772
  (let (beg article yank-string)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
773 774
    (message-goto-body)
    (while (setq article (pop articles))
775 776 777
      (when (listp article)
	(setq yank-string (nth 1 article)
	      article (nth 0 article)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
778 779 780 781
      (save-window-excursion
	(set-buffer gnus-summary-buffer)
	(gnus-summary-select-article nil nil nil article)
	(gnus-summary-remove-process-mark article))
782
      (gnus-copy-article-buffer nil yank-string)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
783
      (let ((message-reply-buffer gnus-article-copy)
784 785 786 787 788 789
	    (message-reply-headers
	     ;; The headers are decoded.
	     (with-current-buffer gnus-article-copy
	       (save-restriction
		 (nnheader-narrow-to-headers)
		 (nnheader-parse-naked-head)))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
790
	(message-yank-original)
Miles Bader's avatar
Miles Bader committed
791
	(message-exchange-point-and-mark)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
792 793 794 795 796 797
	(setq beg (or beg (mark t))))
      (when articles
	(insert "\n")))
    (push-mark)
    (goto-char beg)))

798 799 800 801 802 803
(defun gnus-summary-cancel-article (&optional n symp)
  "Cancel an article you posted.
Uses the process-prefix convention.  If given the symbolic
prefix `a', cancel using the standard posting method; if not
post using the current select method."
  (interactive (gnus-interactive "P\ny"))
804
  (let ((message-post-method
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
805
	 `(lambda (arg)
806 807
	    (gnus-post-method (eq ',symp 'a) ,gnus-newsgroup-name))))
    (dolist (article (gnus-summary-work-articles n))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
808 809 810 811 812 813 814 815 816 817 818 819 820
      (when (gnus-summary-select-article t nil nil article)
	(when (gnus-eval-in-buffer-window gnus-original-article-buffer
		(message-cancel-news))
	  (gnus-summary-mark-as-read article gnus-canceled-mark)
	  (gnus-cache-remove-article 1))
	(gnus-article-hide-headers-if-wanted))
      (gnus-summary-remove-process-mark article))))

(defun gnus-summary-supersede-article ()
  "Compose an article that will supersede a previous article.
This is done simply by taking the old article and adding a Supersedes
header line with the old Message-ID."
  (interactive)
Miles Bader's avatar
Miles Bader committed
821 822
  (let ((article (gnus-summary-article-number))
	(mail-parse-charset gnus-newsgroup-charset))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
823 824 825 826 827 828
    (gnus-setup-message 'reply-yank
      (gnus-summary-select-article t)
      (set-buffer gnus-original-article-buffer)
      (message-supersede)
      (push
       `((lambda ()
829
	   (when (gnus-buffer-exists-p ,gnus-summary-buffer)
Stefan Monnier's avatar
Stefan Monnier committed
830
	     (with-current-buffer ,gnus-summary-buffer
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
831 832
	       (gnus-cache-possibly-remove-article ,article nil nil nil t)
	       (gnus-summary-mark-as-read ,article gnus-canceled-mark)))))
Miles Bader's avatar
Miles Bader committed
833 834 835
       message-send-actions)
      ;; Add Gcc header.
      (gnus-inews-insert-gcc))))
836

Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
837 838


839
(defun gnus-copy-article-buffer (&optional article-buffer yank-string)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
840 841 842 843
  ;; make a copy of the article buffer with all text properties removed
  ;; this copy is in the buffer gnus-article-copy.
  ;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used
  ;; this buffer should be passed to all mail/news reply/post routines.
844
  (setq gnus-article-copy (gnus-get-buffer-create " *gnus article copy*"))
Stefan Monnier's avatar
Stefan Monnier committed
845
  (with-current-buffer gnus-article-copy
846
    (mm-enable-multibyte))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
847
  (let ((article-buffer (or article-buffer gnus-article-buffer))
848
	end beg)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
849
    (if (not (and (get-buffer article-buffer)
850
		  (gnus-buffer-exists-p article-buffer)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
851
	(error "Can't find any article buffer")
Stefan Monnier's avatar
Stefan Monnier committed
852
      (with-current-buffer article-buffer
853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868
	(let ((gnus-newsgroup-charset (or gnus-article-charset
					  gnus-newsgroup-charset))
	      (gnus-newsgroup-ignored-charsets
	       (or gnus-article-ignored-charsets
		   gnus-newsgroup-ignored-charsets)))
	  (save-restriction
	    ;; Copy over the (displayed) article buffer, delete
	    ;; hidden text and remove text properties.
	    (widen)
	    (copy-to-buffer gnus-article-copy (point-min) (point-max))
	    (set-buffer gnus-article-copy)
	    (when yank-string
	      (message-goto-body)
	      (delete-region (point) (point-max))
	      (insert yank-string))
	    (gnus-article-delete-text-of-type 'annotation)
869
	    (gnus-article-delete-text-of-type 'multipart)
870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896
	    (gnus-remove-text-with-property 'gnus-prev)
	    (gnus-remove-text-with-property 'gnus-next)
	    (gnus-remove-text-with-property 'gnus-decoration)
	    (insert
	     (prog1
		 (buffer-substring-no-properties (point-min) (point-max))
	       (erase-buffer)))
	    ;; Find the original headers.
	    (set-buffer gnus-original-article-buffer)
	    (goto-char (point-min))
	    (while (looking-at message-unix-mail-delimiter)
	      (forward-line 1))
	    (let ((mail-header-separator ""))
	      (setq beg (point)
		    end (or (message-goto-body)
			    ;; There may be just a header.
			    (point-max))))
	    ;; Delete the headers from the displayed articles.
	    (set-buffer gnus-article-copy)
	    (let ((mail-header-separator ""))
	      (delete-region (goto-char (point-min))
			     (or (message-goto-body) (point-max))))
	    ;; Insert the original article headers.
	    (insert-buffer-substring gnus-original-article-buffer beg end)
	    ;; Decode charsets.
	    (let ((gnus-article-decode-hook
		   (delq 'article-decode-charset
897 898
			 (copy-sequence gnus-article-decode-hook)))
		  (rfc2047-quote-decoded-words-containing-tspecials t))
899
	      (run-hooks 'gnus-article-decode-hook)))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
900 901 902 903 904 905
      gnus-article-copy)))

(defun gnus-post-news (post &optional group header article-buffer yank subject
			    force-news)
  (when article-buffer
    (gnus-copy-article-buffer))
906 907
  (let ((gnus-article-reply (and article-buffer (gnus-summary-article-number)))
	(gnus-article-yanked-articles yank)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
908 909 910 911 912
	(add-to-list gnus-add-to-list))
    (gnus-setup-message (cond (yank 'reply-yank)
			      (article-buffer 'reply)
			      (t 'message))
      (let* ((group (or group gnus-newsgroup-name))
913
	     (charset (gnus-group-name-charset nil group))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
914 915 916 917
	     (pgroup group)
	     to-address to-group mailing-list to-list
	     newsgroup-p)
	(when group
918
	  (setq to-address (gnus-parameter-to-address group)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
919
		to-group (gnus-group-find-parameter group 'to-group)
920
		to-list (gnus-parameter-to-list group)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
921 922 923
		newsgroup-p (gnus-group-find-parameter group 'newsgroup)
		mailing-list (when gnus-mailing-list-groups
			       (string-match gnus-mailing-list-groups group))
924 925
		group (gnus-group-name-decode (gnus-group-real-name group)
					      charset)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
926 927 928 929 930 931
	(if (or (and to-group
		     (gnus-news-group-p to-group))
		newsgroup-p
		force-news
		(and (gnus-news-group-p
		      (or pgroup gnus-newsgroup-name)
932
		      (or header gnus-current-article))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
933 934 935 936 937
		     (not mailing-list)
		     (not to-list)
		     (not to-address)))
	    ;; This is news.
	    (if post
938 939 940
		(message-news
		 (or to-group
		     (and (not (gnus-virtual-group-p pgroup)) group)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
941
	      (set-buffer gnus-article-copy)
942
	      (gnus-msg-treat-broken-reply-to)
943 944 945 946 947 948 949
	      (message-followup (if (or newsgroup-p force-news)
				    (if (save-restriction
					  (article-narrow-to-head)
					  (message-fetch-field "newsgroups"))
					nil
				      "")
				  to-group)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
950 951 952 953 954 955 956 957 958 959 960 961
	  ;; The is mail.
	  (if post
	      (progn
		(message-mail (or to-address to-list))
		;; Arrange for mail groups that have no `to-address' to
		;; get that when the user sends off the mail.
		(when (and (not to-list)
			   (not to-address)
			   add-to-list)
		  (push (list 'gnus-inews-add-to-address pgroup)
			message-send-actions)))
	    (set-buffer gnus-article-copy)
962 963
	    (gnus-msg-treat-broken-reply-to)
	    (message-wide-reply to-address)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
964 965 966
	(when yank
	  (gnus-inews-yank-articles yank))))))

967
(defun gnus-msg-treat-broken-reply-to (&optional force)
ShengHuo ZHU's avatar
Typos.  
ShengHuo ZHU committed
968
  "Remove the Reply-to header if broken-reply-to."
969 970 971
  (when (or force
	    (gnus-group-find-parameter
	     gnus-newsgroup-name 'broken-reply-to))
972 973 974 975
    (save-restriction
      (message-narrow-to-head)
      (message-remove-header "reply-to"))))

Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
976 977 978
(defun gnus-post-method (arg group &optional silent)
  "Return the posting method based on GROUP and ARG.
If SILENT, don't prompt the user."
979 980 981
  (let ((gnus-post-method (or (gnus-parameter-post-method group)
			      gnus-post-method))
	(group-method (gnus-find-method-for-group group)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
982 983 984 985
    (cond
     ;; If the group-method is nil (which shouldn't happen) we use
     ;; the default method.
     ((null group-method)
986 987 988 989 990
      (or (and (listp gnus-post-method)	;If not current/native/nil
	       (not (listp (car gnus-post-method))) ; and not a list of methods
	       gnus-post-method)	;then use it.
	  gnus-select-method
	  message-post-method))
991
     ;; We want the inverse of the default
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
992
     ((and arg (not (eq arg 0)))
993
      (if (eq gnus-post-method 'current)
994 995
	  gnus-select-method
	group-method))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
996 997
     ;; We query the user for a post method.
     ((or arg
998
	  (and (listp gnus-post-method)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
999 1000 1001 1002
	       (listp (car gnus-post-method))))
      (let* ((methods
	      ;; Collect all methods we know about.
	      (append
1003
	       (when (listp gnus-post-method)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1004 1005 1006 1007
		 (if (listp (car gnus-post-method))
		     gnus-post-method
		   (list gnus-post-method)))
	       gnus-secondary-select-methods
1008
	       (mapcar 'cdr gnus-server-alist)
1009
	       (mapcar 'car gnus-opened-servers)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1010 1011 1012 1013 1014 1015
	       (list gnus-select-method)
	       (list group-method)))
	     method-alist post-methods method)
	;; Weed out all mail methods.
	(while methods
	  (setq method (gnus-server-get-method "" (pop methods)))
1016 1017 1018
	  (when (and (or (gnus-method-option-p method 'post)
			 (gnus-method-option-p method 'post-mail))
		     (not (member method post-methods)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1019 1020 1021 1022 1023
	    (push method post-methods)))
	;; Create a name-method alist.
	(setq method-alist
	      (mapcar
	       (lambda (m)
1024 1025 1026
		 (if (equal (cadr m) "")
		     (list (symbol-name (car m)) m)
		   (list (concat (cadr m) " (" (symbol-name (car m)) ")") m)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1027 1028 1029 1030 1031 1032 1033 1034 1035
	       post-methods))
	;; Query the user.
	(cadr
	 (assoc
	  (setq gnus-last-posting-server
		(if (and silent
			 gnus-last-posting-server)
		    ;; Just use the last value.
		    gnus-last-posting-server
1036 1037
		  (gnus-completing-read
		   "Posting method" (mapcar 'car method-alist) t
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1038 1039 1040
		   (cons (or gnus-last-posting-server "") 0))))
	  method-alist))))
     ;; Override normal method.
1041
     ((and (eq gnus-post-method 'current)
1042 1043 1044
	   (not (memq (car group-method) gnus-discouraged-post-methods))
	   (gnus-get-function group-method 'request-post t))
      (assert (not arg))
1045
      group-method)
1046 1047 1048
     ;; Use gnus-post-method.
     ((listp gnus-post-method)		;A method...
      (assert (not (listp (car gnus-post-method)))) ;... not a list of methods.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1049
      gnus-post-method)
1050
     ;; Use the normal select method (nil or native).
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1051 1052 1053 1054 1055
     (t gnus-select-method))))



(defun gnus-extended-version ()
1056 1057
  "Stringified Gnus version and Emacs version.
See the variable `gnus-user-agent'."
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1058
  (interactive)
1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070
  (if (stringp gnus-user-agent)
      gnus-user-agent
    ;; `gnus-user-agent' is a list:
    (let* ((float-output-format nil)
	   (gnus-v
	    (when (memq 'gnus gnus-user-agent)
	      (concat "Gnus/"
		      (prin1-to-string (gnus-continuum-version gnus-version) t)
		      " (" gnus-version ")")))
	   (emacs-v (gnus-emacs-version)))
      (concat gnus-v (when (and gnus-v emacs-v) " ")
	      emacs-v))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1071 1072 1073 1074 1075 1076 1077 1078


;;;
;;; Gnus Mail Functions
;;;

;;; Mail reply commands of Gnus summary mode

1079 1080
(defun gnus-summary-reply (&optional yank wide very-wide)
  "Start composing a mail reply to the current message.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1081
If prefix argument YANK is non-nil, the original article is yanked
1082 1083 1084
automatically.
If WIDE, make a wide reply.
If VERY-WIDE, make a very wide reply."
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1085 1086 1087
  (interactive
   (list (and current-prefix-arg
	      (gnus-summary-work-articles 1))))
1088 1089
  ;; Allow user to require confirmation before replying by mail to the
  ;; author of a news article (or mail message).
1090
  (when (or (not (or (gnus-news-group-p gnus-newsgroup-name)
1091 1092 1093 1094 1095
		     gnus-confirm-treat-mail-like-news))
	    (not (cond ((stringp gnus-confirm-mail-reply-to-news)
			(string-match gnus-confirm-mail-reply-to-news
				      gnus-newsgroup-name))
		       ((functionp gnus-confirm-mail-reply-to-news)
1096 1097
			(funcall gnus-confirm-mail-reply-to-news
				 gnus-newsgroup-name))
1098
		       (t gnus-confirm-mail-reply-to-news)))
Miles Bader's avatar
Miles Bader committed
1099 1100 1101 1102
	    (if (or wide very-wide)
		t ;; Ignore gnus-confirm-mail-reply-to-news for wide and very
		  ;; wide replies.
	      (y-or-n-p "Really reply by mail to article author? ")))
1103 1104 1105 1106 1107 1108 1109 1110
    (let* ((article
	    (if (listp (car yank))
		(caar yank)
	      (car yank)))
	   (gnus-article-reply (or article (gnus-summary-article-number)))
	   (gnus-article-yanked-articles yank)
	   (headers ""))
      ;; Stripping headers should be specified with mail-yank-ignored-headers.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1111
      (when yank
1112 1113 1114 1115 1116 1117
	(gnus-summary-goto-subject article))
      (gnus-setup-message (if yank 'reply-yank 'reply)
	(if (not very-wide)
	    (gnus-summary-select-article)
	  (dolist (article very-wide)
	    (gnus-summary-select-article nil nil nil article)
Stefan Monnier's avatar
Stefan Monnier committed
1118
	    (with-current-buffer (gnus-copy-article-buffer)
1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131
	      (gnus-msg-treat-broken-reply-to)
	      (save-restriction
		(message-narrow-to-head)
		(setq headers (concat headers (buffer-string)))))))
	(set-buffer (gnus-copy-article-buffer))
	(gnus-msg-treat-broken-reply-to gnus-msg-force-broken-reply-to)
	(save-restriction
	  (message-narrow-to-head)
	  (when very-wide
	    (erase-buffer)
	    (insert headers))
	  (goto-char (point-max)))
	(mml-quote-region (point) (point-max))
1132
	(message-reply nil wide 'switch-to-buffer)
1133 1134 1135 1136 1137 1138 1139 1140
	(when yank
	  (gnus-inews-yank-articles yank))
	(gnus-summary-handle-replysign)))))

(defun gnus-summary-handle-replysign ()
  "Check the various replysign variables and take action accordingly."
  (when (or gnus-message-replysign gnus-message-replyencrypt)
    (let (signed encrypted)
Stefan Monnier's avatar
Stefan Monnier committed
1141
      (with-current-buffer gnus-article-buffer
1142 1143 1144 1145 1146 1147 1148 1149 1150
	(setq signed (memq 'signed gnus-article-wash-types))
	(setq encrypted (memq 'encrypted gnus-article-wash-types)))
      (cond ((and gnus-message-replyencrypt encrypted)
	     (mml-secure-message mml-default-encrypt-method
				 (if gnus-message-replysignencrypted
				     'signencrypt
				   'encrypt)))
	    ((and gnus-message-replysign signed)
	     (mml-secure-message mml-default-sign-method 'sign))))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1151 1152 1153 1154 1155 1156 1157

(defun gnus-summary-reply-with-original (n &optional wide)
  "Start composing a reply mail to the current message.
The original article will be yanked."
  (interactive "P")
  (gnus-summary-reply (gnus-summary-work-articles n) wide))

1158 1159 1160 1161 1162 1163 1164 1165 1166 1167
(defun gnus-summary-reply-to-list-with-original (n &optional wide)
  "Start composing a reply mail to the current message.
The reply goes only to the mailing list.
The original article will be yanked."
  (interactive "P")
  (let ((message-reply-to-function
	 (lambda nil
	   `((To . ,(gnus-mailing-list-followup-to))))))
    (gnus-summary-reply (gnus-summary-work-articles n) wide)))

1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185
(defun gnus-summary-reply-broken-reply-to (&optional yank wide very-wide)
  "Like `gnus-summary-reply' except removing reply-to field.
If prefix argument YANK is non-nil, the original article is yanked
automatically.
If WIDE, make a wide reply.
If VERY-WIDE, make a very wide reply."
  (interactive
   (list (and current-prefix-arg
	      (gnus-summary-work-articles 1))))
  (let ((gnus-msg-force-broken-reply-to t))
    (gnus-summary-reply yank wide very-wide)))

(defun gnus-summary-reply-broken-reply-to-with-original (n &optional wide)
  "Like `gnus-summary-reply-with-original' except removing reply-to field.
The original article will be yanked."
  (interactive "P")
  (gnus-summary-reply-broken-reply-to (gnus-summary-work-articles n) wide))

Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196
(defun gnus-summary-wide-reply (&optional yank)
  "Start composing a wide reply mail to the current message.
If prefix argument YANK is non-nil, the original article is yanked
automatically."
  (interactive
   (list (and current-prefix-arg
	      (gnus-summary-work-articles 1))))
  (gnus-summary-reply yank t))

(defun gnus-summary-wide-reply-with-original (n)
  "Start composing a wide reply mail to the current message.
1197 1198
The original article will be yanked.
Uses the process/prefix convention."
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1199 1200 1201
  (interactive "P")
  (gnus-summary-reply-with-original n t))

1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217
(defun gnus-summary-very-wide-reply (&optional yank)
  "Start composing a very wide reply mail to the current message.
If prefix argument YANK is non-nil, the original article is yanked
automatically."
  (interactive
   (list (and current-prefix-arg
	      (gnus-summary-work-articles 1))))
  (gnus-summary-reply yank t (gnus-summary-work-articles yank)))

(defun gnus-summary-very-wide-reply-with-original (n)
  "Start composing a very wide reply mail to the current message.
The original article will be yanked."
  (interactive "P")
  (gnus-summary-reply
   (gnus-summary-work-articles n) t (gnus-summary-work-articles n)))

1218
(defun gnus-summary-mail-forward (&optional arg post)
1219 1220 1221
  "Forward the current message(s) to another user.
If process marks exist, forward all marked messages;
if ARG is nil, see `message-forward-as-mime' and `message-forward-show-mml';
1222
if ARG is 1, decode the message and forward directly inline;