67aa9d4bd8a3eaac89f26918f483cd169e18e676
[gnus] / lisp / gnus-msg.el
1 ;;; gnus-msg.el --- mail and post interface for Gnus
2 ;; Copyright (C) 1995,96 Free Software Foundation, Inc.
3
4 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
5 ;;      Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
6 ;; Keywords: news
7
8 ;; This file is part of GNU Emacs.
9
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; any later version.
14
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 ;; GNU General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING.  If not, write to
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
23
24 ;;; Commentary:
25
26 ;;; Code:
27
28 (require 'gnus)
29 (require 'sendmail)
30 (require 'gnus-ems)
31 (eval-when-compile (require 'cl))
32
33 ;; Added by Sudish Joseph <joseph@cis.ohio-state.edu>.
34 (defvar gnus-post-method nil
35   "*Preferred method for posting USENET news.
36 If this variable is nil, Gnus will use the current method to decide
37 which method to use when posting.  If it is non-nil, it will override
38 the current method.  This method will not be used in mail groups and
39 the like, only in \"real\" newsgroups.
40
41 The value must be a valid method as discussed in the documentation of
42 `gnus-select-method'.  It can also be a list of methods.  If that is
43 the case, the user will be queried for what select method to use when
44 posting.")
45
46 (defvar gnus-organization-file "/usr/lib/news/organization"
47   "*Local news organization file.")
48
49 (defvar gnus-prepare-article-hook nil
50   "*A hook called after preparing body, but before preparing header headers.")
51
52 (defvar gnus-post-prepare-function nil
53   "*Function that is run after a post buffer has been prepared.
54 It is called with the name of the newsgroup that is posted to. It
55 might be used, for instance, for inserting signatures based on the
56 newsgroup name. (In that case, `gnus-signature-file' and
57 `mail-signature' should both be set to nil).")
58
59 (defvar gnus-post-prepare-hook nil
60   "*Hook that is run after a post buffer has been prepared.
61 If you want to insert the signature, you might put
62 `gnus-inews-insert-signature' in this hook.")
63
64 (defvar gnus-use-followup-to 'ask
65   "*Specifies what to do with Followup-To header.
66 If nil, ignore the header. If it is t, use its value, but ignore
67 \"poster\".  If it is the symbol `ask', query the user whether to
68 ignore the \"poster\" value.  If it is the symbol `use', always use
69 the value.")
70
71 (defvar gnus-followup-to-function nil
72   "*A variable that contains a function that returns a followup address.
73 The function will be called in the buffer of the article that is being
74 followed up. The buffer will be narrowed to the headers of the
75 article. To pick header headers, one might use `mail-fetch-field'.  The
76 function will be called with the name of the current newsgroup as the
77 argument.
78
79 Here's an example `gnus-followup-to-function':
80
81 (setq gnus-followup-to-function
82       (lambda (group)
83         (cond ((string= group \"mail.list\")
84                (or (mail-fetch-field \"sender\") 
85                    (mail-fetch-field \"from\")))
86               (t
87                (or (mail-fetch-field \"reply-to\") 
88                    (mail-fetch-field \"from\"))))))")
89
90 (defvar gnus-reply-to-function nil
91   "*A variable that contains a function that returns a reply address.
92 See the `gnus-followup-to-function' variable for an explanation of how
93 this variable is used.
94
95 This function should return a string that will be used to fill in the
96 header.  This function may also return a list.  In that case, every
97 list element should be a cons where the first car should be a string
98 with the header name, and the cdr should be a string with the header
99 value.")
100
101 (defvar gnus-author-copy (getenv "AUTHORCOPY")
102   "*Save outgoing articles in this file.
103 Initialized from the AUTHORCOPY environment variable.
104
105 If this variable begins with the character \"|\", outgoing articles
106 will be piped to the named program. It is possible to save an article
107 in an MH folder as follows:
108
109 \(setq gnus-author-copy \"|/usr/local/lib/mh/rcvstore +Article\")
110
111 If the first character is not a pipe, articles are saved using the
112 function specified by the `gnus-author-copy-saver' variable.")
113
114 (defvar gnus-mail-self-blind nil
115   "*Non-nil means insert a BCC header in all outgoing articles.
116 This will result in having a copy of the article mailed to yourself.
117 The BCC header is inserted when the post buffer is initialized, so you
118 can remove or alter the BCC header to override the default.")
119
120 (defvar gnus-author-copy-saver (function rmail-output)
121   "*A function called to save outgoing articles.
122 This function will be called with the same of the file to store the
123 article in. The default function is `rmail-output' which saves in Unix
124 mailbox format.")
125
126 (defvar gnus-outgoing-message-group nil
127   "*All outgoing messages will be put in this group.
128 If you want to store all your outgoing mail and articles in the group
129 \"nnml:archive\", you set this variable to that value. This variable
130 can also be a list of group names. 
131
132 If you want to have greater control over what group to put each
133 message in, you can set this variable to a function that checks the
134 current newsgroup name and then returns a suitable group name (or list
135 of names).")
136
137 (defvar gnus-message-archive-group
138   '((if (eq major-mode 'news-reply-mode) "misc-news" "misc-mail"))
139   "*Name of the group in which to save the messages you've written.
140 This can either be a string, a list of strings; or an alist
141 of regexps/functions/forms to be evaluated to return a string (or a list
142 of strings).  The functions are called with the name of the current
143 group (or nil) as a parameter.")
144
145 (defvar gnus-mailing-list-groups nil
146   "*Regexp matching groups that are really mailing lists.
147 This is useful when you're reading a mailing list that has been
148 gatewayed to a newsgroup, and you want to followup to an article in
149 the group.")
150
151 (defvar gnus-draft-group-directory 
152   (expand-file-name
153    (concat (file-name-as-directory gnus-article-save-directory)
154            "drafts"))
155   "*The directory where draft messages will be stored.")
156
157 (defvar gnus-use-draft t
158   "*Whether Gnus should use the draft group.")
159
160 (defvar gnus-posting-styles nil
161   "*Alist of styles to use when posting.")
162
163 (defvar gnus-posting-style-alist
164   '((organization . gnus-organization-file)
165     (signature . gnus-signature-file)
166     (from . gnus-user-from-line)))
167
168 (defvar gnus-user-login-name nil
169   "*The login name of the user.
170 Got from the function `user-login-name' if undefined.")
171
172 (defvar gnus-user-full-name nil
173   "*The full name of the user.
174 Got from the NAME environment variable if undefined.")
175
176 (defvar gnus-user-from-line nil
177   "*Your full, complete e-mail address.  
178 Overrides the other Gnus variables if it is non-nil.
179
180 Here are two example values of this variable:
181
182  \"Lars Magne Ingebrigtsen <larsi@ifi.uio.no>\"
183
184 and
185
186  \"larsi@ifi.uio.no (Lars Magne Ingebrigtsen)\"
187
188 The first version is recommended, but the name has to be quoted if it
189 contains non-alphanumerical characters.")
190
191 (defvar gnus-signature-file "~/.signature"
192   "*Your signature file.
193 If the variable is a string that doesn't correspond to a file, the
194 string itself is inserted.")
195
196 (defvar gnus-signature-function nil
197   "*A function that should return a signature file name.
198 The function will be called with the name of the newsgroup being
199 posted to.
200 If the function returns a string that doesn't correspond to a file, the
201 string itself is inserted.
202 If the function returns nil, the `gnus-signature-file' variable will
203 be used instead.")
204
205 (defvar gnus-forward-start-separator 
206   "------- Start of forwarded message -------\n"
207   "*Delimiter inserted before forwarded messages.")
208
209 (defvar gnus-forward-end-separator
210   "------- End of forwarded message -------\n"
211   "*Delimiter inserted after forwarded messages.")
212
213 (defvar gnus-signature-before-forwarded-message t
214   "*If non-nil, put the signature before any included forwarded message.")
215
216 (defvar gnus-forward-included-headers gnus-visible-headers
217   "*Regexp matching headers to be included in forwarded messages.")
218
219 (defvar gnus-required-headers
220   '(From Date Newsgroups Subject Message-ID Organization Lines X-Newsreader)
221   "*Headers to be generated or prompted for when posting an article.
222 RFC977 and RFC1036 require From, Date, Newsgroups, Subject,
223 Message-ID.  Organization, Lines, In-Reply-To, Expires, and
224 X-Newsreader are optional.  If you want Gnus not to insert some
225 header, remove it from this list.")
226
227 (defvar gnus-required-mail-headers 
228   '(From Date To Subject (optional . In-Reply-To) Message-ID Organization Lines)
229   "*Headers to be generated or prompted for when mailing a message.
230 RFC822 required that From, Date, To, Subject and Message-ID be
231 included.  Organization, Lines and X-Mailer are optional.")
232
233 (defvar gnus-deletable-headers '(Message-ID Date)
234   "*Headers to be deleted if they already exists and were generated by Gnus previously.")
235
236 (defvar gnus-removable-headers '(NNTP-Posting-Host Bcc Xref)
237   "*Headers to be removed unconditionally before posting.")
238
239 (defvar gnus-article-expires 14
240   "*Number of days before your article expires.
241 This variable isn't used unless you have the `Expires' element in
242 `gnus-required-headers'.")
243
244 (defvar gnus-distribution-function nil
245   "*Function that should return the Distribution header for outgoing articles.
246 It will be called from the buffer where the outgoing article
247 is being prepared with the group name as the only parameter.
248 It should return a valid distribution.  
249
250 The function will only be called if you have the `Distribution' header in 
251 `gnus-required-headers'.")
252
253 (defvar gnus-check-before-posting 
254   '(subject-cmsg multiple-headers sendsys message-id from
255                  long-lines control-chars size new-text
256                  redirected-followup signature approved sender empty)
257   "In non-nil, Gnus will attempt to run some checks on outgoing posts.
258 If this variable is t, Gnus will check everything it can.  If it is a
259 list, then those elements in that list will be checked.")
260
261 (defvar gnus-delete-supersedes-headers
262   "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Supersedes:\\|^Xref:\\|^Lines:"
263   "*Header lines matching this regexp will be deleted before posting.
264 It's best to delete old Path and Date headers before posting to avoid
265 any confusion.")
266
267 (defvar gnus-auto-mail-to-author nil
268   "*If non-nil, mail the authors of articles a copy of your follow-ups.
269 If this variable is `ask', the user will be prompted for whether to
270 mail a copy.  The string given by `gnus-mail-courtesy-message' will be
271 inserted at the beginning of the mail copy.")
272
273 ;; Added by Ethan Bradford <ethanb@ptolemy.astro.washington.edu>.
274 (defvar gnus-mail-courtesy-message
275   "The following message is a courtesy copy of an article\nthat has been posted as well.\n\n"
276   "*This is inserted at the start of a mailed copy of a posted message.
277 If this variable is nil, no such courtesy message will be added.")
278
279 (defvar gnus-mail-method 'sendmail
280   "*Method to use for composing mail.
281 There are three legal values: `sendmail' (which is the default), `mh', 
282 and `vm'.")
283
284 (defvar gnus-mail-reply-method (function gnus-mail-reply-using-mail)
285   "*Function to compose a reply.
286 Three pre-made functions are `gnus-mail-reply-using-mail' (sendmail);
287 `gnus-mail-reply-using-mhe' (MH-E); and `gnus-mail-reply-using-vm'.")
288
289 (defvar gnus-mail-forward-method (function gnus-mail-forward-using-mail)
290   "*Function to forward the current message to another user.
291 Three pre-made functions are `gnus-mail-forward-using-mail' (sendmail);
292 `gnus-mail-forward-using-mhe' (MH-E); and `gnus-mail-forward-using-vm'.") 
293
294 (defvar gnus-mail-other-window-method 'gnus-mail-other-window-using-mail
295   "*Function to compose mail in the other window.
296 Three pre-made functions are `gnus-mail-other-window-using-mail'
297 (sendmail); `gnus-mail-other-window-using-mhe' (MH-E); and
298 `gnus-mail-other-window-using-vm'.")
299
300 (defvar gnus-inews-article-function 'gnus-inews-article
301   "*Function to post an article.")
302
303 (defvar gnus-bounced-headers-junk "^\\(Received\\):"
304   "*Regexp that matches headers to be removed in resent bounced mail.")
305
306 (defvar gnus-inews-article-hook (list 'gnus-inews-do-fcc)
307   "*A hook called before finally posting an article.
308 The default hook (`gnus-inews-do-fcc') does FCC processing (ie. saves
309 the article to a file).")
310
311 (defvar gnus-inews-article-header-hook nil
312   "*A hook called after inserting the headers in an article to be posted.
313 The hook is called from the *post-news* buffer, narrowed to the
314 headers.")
315
316 (defvar gnus-mail-hook nil
317   "*A hook called as the last thing after setting up a mail buffer.")
318
319 (defvar gnus-message-sent-hook nil
320   "*A hook run after an article has been sent (or attempted sent).")
321
322 ;;; Internal variables.
323
324 (defvar gnus-post-news-buffer "*post-news*")
325 (defvar gnus-mail-buffer "*Mail Gnus*")
326 (defvar gnus-article-copy nil)
327 (defvar gnus-reply-subject nil)
328 (defvar gnus-newsgroup-followup nil)
329 (defvar gnus-add-to-address nil)
330 (defvar gnus-in-reply-to nil)
331 (defvar gnus-last-posting-server nil)
332
333
334 (eval-and-compile
335   (autoload 'gnus-uu-post-news "gnus-uu" nil t)
336   (autoload 'news-setup "rnewspost")
337   (autoload 'news-reply-mode "rnewspost")
338   (autoload 'rmail-output "rmailout"))
339
340 \f
341 ;;;
342 ;;; Gnus Posting Functions
343 ;;;
344
345 (gnus-define-keys 
346  (gnus-summary-send-map "S" gnus-summary-mode-map)
347  "p" gnus-summary-post-news
348  "f" gnus-summary-followup
349  "F" gnus-summary-followup-with-original
350  "b" gnus-summary-followup-and-reply
351  "B" gnus-summary-followup-and-reply-with-original
352  "c" gnus-summary-cancel-article
353  "s" gnus-summary-supersede-article
354  "r" gnus-summary-reply
355  "R" gnus-summary-reply-with-original
356  "m" gnus-summary-mail-other-window
357  "u" gnus-uu-post-news
358  "om" gnus-summary-mail-forward
359  "op" gnus-summary-post-forward
360  "Om" gnus-uu-digest-mail-forward
361  "Op" gnus-uu-digest-post-forward)
362
363 (gnus-define-keys
364  (gnus-send-bounce-map "D" gnus-summary-send-map)
365  "b" gnus-summary-resend-bounced-mail
366  "c" gnus-summary-send-draft
367  "r" gnus-summary-resend-message)
368
369 ;;; Internal functions.
370
371 (defun gnus-number-base36 (num len)
372   (if (if (< len 0) (<= num 0) (= len 0))
373       ""
374     (concat (gnus-number-base36 (/ num 36) (1- len))
375             (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210"
376                                   (% num 36))))))
377
378 ;;; Post news commands of Gnus group mode and summary mode
379
380 (defun gnus-group-mail ()
381   "Start composing a mail."
382   (interactive)
383   (gnus-new-mail
384    ;; We might want to prompt here.
385    (when (and gnus-interactive-post
386               (not gnus-expert-user))
387      (read-string "To: "))))
388
389 (defun gnus-group-post-news (&optional arg)
390   "Post an article.
391 The newsgroup under the cursor is used as the group to post to.
392
393 If you wish to get an empty post buffer, use a prefix ARG.  You can
394 also do this by calling this function from the bottom of the Group
395 buffer."
396   (interactive "P")
397   (let ((gnus-newsgroup-name nil)
398         (group (unless arg (gnus-group-group-name)))
399         subject)
400     ;; We might want to prompt here.
401     (when (and gnus-interactive-post
402                (not gnus-expert-user))
403       (setq gnus-newsgroup-name
404             (setq group 
405                   (completing-read "Group: " gnus-active-hashtb nil nil
406                                    (cons (or group "") 0)))))
407     (gnus-post-news 'post group nil gnus-article-buffer)))
408
409 (defun gnus-summary-post-news ()
410   "Post an article."
411   (interactive)
412   (gnus-set-global-variables)
413   (gnus-post-news 'post gnus-newsgroup-name))
414
415 (defun gnus-summary-followup (yank &optional yank-articles)
416   "Compose a followup to an article.
417 If prefix argument YANK is non-nil, original article is yanked automatically."
418   (interactive "P")
419   (gnus-set-global-variables)
420   (if yank-articles (gnus-summary-goto-subject (car yank-articles)))
421   (save-window-excursion
422     (gnus-summary-select-article))
423   (let ((headers (gnus-summary-article-header (gnus-summary-article-number)))
424         (gnus-newsgroup-name gnus-newsgroup-name))
425     ;; Check Followup-To: poster.
426     (set-buffer gnus-article-buffer)
427     (if (and gnus-use-followup-to
428              (string-equal "poster" (gnus-fetch-field "followup-to"))
429              (or (not (memq gnus-use-followup-to '(t ask)))
430                  (not (gnus-y-or-n-p 
431                        "Do you want to ignore `Followup-To: poster'? "))))
432         ;; Mail to the poster. 
433         (gnus-summary-reply yank)
434       ;; Send a followup.
435       (gnus-post-news nil gnus-newsgroup-name
436                       headers gnus-article-buffer 
437                       (or yank-articles (not (not yank)))))))
438
439 (defun gnus-summary-followup-with-original (n)
440   "Compose a followup to an article and include the original article."
441   (interactive "P")
442   (gnus-summary-followup t (gnus-summary-work-articles n)))
443
444 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
445 (defun gnus-summary-followup-and-reply (yank &optional yank-articles)
446   "Compose a followup and do an auto mail to author."
447   (interactive "P")
448   (gnus-set-global-variables)
449   (let ((gnus-auto-mail-to-author 'force))
450     (gnus-summary-followup yank yank-articles)))
451
452 (defun gnus-summary-followup-and-reply-with-original (n)
453   "Compose a followup, include the original, and do an auto mail to author."
454   (interactive "P")
455   (gnus-summary-followup-and-reply t (gnus-summary-work-articles n)))
456
457 (defun gnus-summary-cancel-article (n)
458   "Cancel an article you posted."
459   (interactive "P")
460   (gnus-set-global-variables)
461   (let ((articles (gnus-summary-work-articles n))
462         article)
463     (while (setq article (pop articles))
464       (when (gnus-summary-select-article t nil nil article)
465         (when (gnus-eval-in-buffer-window 
466                gnus-original-article-buffer (gnus-cancel-news))
467           (gnus-summary-mark-as-read article gnus-canceled-mark))
468         (gnus-article-hide-headers-if-wanted))
469       (gnus-summary-remove-process-mark article))))
470
471 (defun gnus-summary-supersede-article ()
472   "Compose an article that will supersede a previous article.
473 This is done simply by taking the old article and adding a Supersedes
474 header line with the old Message-ID."
475   (interactive)
476   (gnus-set-global-variables)
477   (gnus-summary-select-article t)
478   ;; Check whether the user owns the article that is to be superseded. 
479   (unless (string-equal
480            (downcase (mail-strip-quoted-names 
481                       (mail-header-from gnus-current-headers)))
482            (downcase (mail-strip-quoted-names (gnus-inews-user-name))))
483     (error "This article is not yours."))
484   ;; Get a normal *post-news* buffer.
485   (gnus-new-news gnus-newsgroup-name t)
486   (erase-buffer)
487   (insert-buffer-substring gnus-original-article-buffer)
488   (nnheader-narrow-to-headers)
489   ;; Remove unwanted headers.
490   (when gnus-delete-supersedes-headers
491     (nnheader-remove-header gnus-delete-supersedes-headers t))
492   (goto-char (point-min))
493   (if (not (re-search-forward "^Message-ID: " nil t))
494       (error "No Message-ID in this article")
495     (replace-match "Supersedes: " t t))
496   (goto-char (point-max))
497   (insert mail-header-separator)
498   (widen)
499   (forward-line 1))
500
501 \f
502 ;;;###autoload
503 (defalias 'sendnews 'gnus-post-news)
504
505 ;;;###autoload
506 (defalias 'postnews 'gnus-post-news)
507
508 (defun gnus-copy-article-buffer (&optional article-buffer)
509   ;; make a copy of the article buffer with all text properties removed
510   ;; this copy is in the buffer gnus-article-copy.
511   ;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used
512   ;; this buffer should be passed to all mail/news reply/post routines.
513   (setq gnus-article-copy (get-buffer-create " *gnus article copy*"))
514   (buffer-disable-undo gnus-article-copy)
515   (or (memq gnus-article-copy gnus-buffer-list)
516       (setq gnus-buffer-list (cons gnus-article-copy gnus-buffer-list)))
517   (let ((article-buffer (or article-buffer gnus-article-buffer)))
518     (if (and (get-buffer article-buffer)
519              (buffer-name (get-buffer article-buffer)))
520         (save-excursion
521           (set-buffer article-buffer)
522           (widen)
523           (copy-to-buffer gnus-article-copy (point-min) (point-max))
524           (set-text-properties (point-min) (point-max) 
525                                nil gnus-article-copy)))))
526
527 (defun gnus-post-news (post &optional group header article-buffer yank subject)
528   "Begin editing a new USENET news article to be posted.
529 Type \\[describe-mode] in the buffer to get a list of commands."
530   (interactive (list t))
531   (let* ((group (or group gnus-newsgroup-name))
532          (pgroup group)
533          to-address to-group mailing-list to-list)
534     (when group
535       (setq to-address (gnus-group-get-parameter group 'to-address)
536             to-group (gnus-group-get-parameter group 'to-group)
537             to-list (gnus-group-get-parameter group 'to-list)
538             mailing-list (when gnus-mailing-list-groups
539                            (string-match gnus-mailing-list-groups group))
540             group (gnus-group-real-name group)))
541     (if (or to-group
542             (and (gnus-news-group-p 
543                   (or pgroup gnus-newsgroup-name)
544                   (if header (mail-header-number header) gnus-current-article))
545                  (not mailing-list)
546                  (not to-list)
547                  (not to-address)))
548         ;; This is news.
549         (if post
550             (gnus-new-news (or to-group group))
551           (gnus-news-followup yank (or to-group group)))
552       ;; The is mail.
553       (if post
554           (progn
555             (gnus-new-mail (or to-address to-list))
556             ;; Arrange for mail groups that have no `to-address' to
557             ;; get that when the user sends off the mail.
558             (unless to-address
559               (make-local-variable 'gnus-add-to-address)
560               (setq gnus-add-to-address group)))
561         (gnus-mail-reply yank to-address 'followup)))))
562
563 (defun gnus-post-method (group query-method &optional silent)
564   "Return the posting method based on GROUP and query-method.
565 If SILENT, don't prompt the user."
566   (let ((group-method (if (stringp group)
567                           (gnus-find-method-for-group group)
568                         group)))
569     (cond 
570      ;; If the group-method is nil (which shouldn't happen) we use 
571      ;; the default method.
572      ((null group-method)
573       gnus-select-method)
574      ;; We want this group's method.
575      ((and query-method (not (eq query-method 0)))
576       group-method)
577      ;; We query the user for a post method.
578      ((or query-method
579           (and gnus-post-method
580                (listp (car gnus-post-method))))
581       (let* ((methods
582               ;; Collect all methods we know about.
583               (append
584                (when gnus-post-method
585                  (if (listp (car gnus-post-method))
586                      gnus-post-method
587                    (listp gnus-post-method)))
588                gnus-secondary-select-methods
589                (list gnus-select-method)
590                (list group-method)))
591              method-alist post-methods method)
592         ;; Weed out all mail methods.
593         (while methods
594           (setq method (gnus-server-get-method "" (pop methods)))
595           (when (or (gnus-method-option-p method 'post)
596                     (gnus-method-option-p method 'post-mail))
597             (push method post-methods)))
598         ;; Create a name-method alist.
599         (setq method-alist
600               (mapcar 
601                (lambda (m)
602                  (list (concat (cadr m) " (" (symbol-name (car m)) ")") m))
603                post-methods))
604         ;; Query the user.
605         (cadr
606          (assoc
607           (setq gnus-last-posting-server
608                 (if (and silent
609                          gnus-last-posting-server)
610                     ;; Just use the last value.
611                     gnus-last-posting-server
612                   (completing-read
613                    "Posting method: " method-alist nil t
614                    (cons (or gnus-last-posting-server "") 0))))
615           method-alist))))
616      ;; Override normal method.
617      ((and gnus-post-method
618            (or (gnus-method-option-p group-method 'post)
619                (gnus-method-option-p group-method 'post-mail)))
620       gnus-post-method)
621      ;; Perhaps this is a mail group?
622      ((and (not (gnus-member-of-valid 'post group))
623            (not (gnus-method-option-p group-method 'post-mail)))
624       group-method)
625      ;; Use the normal select method.
626      (t gnus-select-method))))
627
628 (defun gnus-news-group-p (group &optional article)
629   "Return non-nil if GROUP (and ARTICLE) come from a news server."
630   (or (gnus-member-of-valid 'post group) ; Ordinary news group.
631       (and (gnus-member-of-valid 'post-mail group) ; Combined group.
632            (eq (gnus-request-type group article) 'news))))
633            
634 (defun gnus-inews-news (&optional use-group-method)
635   "Send a news message.
636
637 If given a non-zero prefix and the group is a foreign group, this
638 function will attempt to use the foreign server to post the article.
639
640 If given an zero prefix, the user will be prompted for a posting
641 method to use."
642   (interactive "P")
643   (or gnus-current-select-method
644       (setq gnus-current-select-method gnus-select-method))
645   (let* ((case-fold-search nil)
646          (reply gnus-article-reply)
647          error post-result)
648     (save-excursion
649       (gnus-start-news-server)          ;Use default server.
650       (widen)
651       (goto-char (point-min))
652       (run-hooks 'news-inews-hook)
653
654       ;; Send to server. 
655       (gnus-message 5 "Posting to USENET...")
656       (setq post-result (funcall gnus-inews-article-function use-group-method))
657       (cond 
658        ((eq post-result 'illegal)
659         (setq error t)
660         (ding))
661        (post-result
662         (gnus-message 5 "Posting to USENET...done")
663         (set-buffer-modified-p nil)
664         ;; We mark the article as replied.
665         (when (gnus-buffer-exists-p (car-safe reply))
666           (save-excursion
667             (set-buffer gnus-summary-buffer)
668             (gnus-summary-mark-article-as-replied (cdr reply)))))
669        (t
670         ;; We cannot signal an error.
671         (setq error t)
672         (ding)
673         (gnus-message 
674          1 "Article rejected: %s" 
675          (gnus-status-message
676           (gnus-post-method gnus-newsgroup-name use-group-method t))))))
677
678     (let ((conf gnus-prev-winconf))
679       (unless error
680         (bury-buffer)
681         ;; Restore last window configuration.
682         (and conf (set-window-configuration conf))))))
683
684 (defun gnus-inews-narrow-to-headers ()
685   (widen)
686   (narrow-to-region
687    (goto-char (point-min))
688    (or (and (re-search-forward 
689              (concat "^" (regexp-quote mail-header-separator) "$") nil t)
690             (match-beginning 0))
691        (point-max)))
692   (goto-char (point-min)))
693
694 (defun gnus-inews-send-mail-copy ()
695   ;; Mail the message if To, Bcc or Cc exists.
696   (let* ((types '("to" "bcc" "cc"))
697          (ty types)
698          (buffer (current-buffer))
699          fcc)
700     (save-restriction
701       (widen)
702       (gnus-inews-narrow-to-headers)
703
704       (while ty
705         (or (mail-fetch-field (car ty) nil t)
706             (setq types (delete (car ty) types)))
707         (setq ty (cdr ty)))
708
709       (if (not types)
710           ;; We do not want to send mail.
711           ()
712         (gnus-message 5 "Sending via mail...")
713         (widen)
714         (save-excursion
715           ;; We copy the article over to a temp buffer since we are
716           ;; going to modify it a little.  
717           (nnheader-set-temp-buffer " *Gnus-mailing*")
718           (insert-buffer-substring buffer)
719           ;; We remove Fcc, because we don't want the mailer to see
720           ;; that header.  
721           (gnus-inews-narrow-to-headers)
722           (nnheader-remove-header "fcc")
723
724           ;; Insert the X-Courtesy-Message header.
725           (and (or (member "to" types)
726                    (member "cc" types))
727                (progn
728                 (goto-char (point-max))
729                 (insert "Posted-To: " 
730                         (mail-fetch-field "newsgroups") "\n")))
731           
732           (widen)
733           
734           (if (and gnus-mail-courtesy-message
735                    (or (member "to" types)
736                        (member "cc" types)))
737               ;; We only want to insert the courtesy mail message if
738               ;; we use To or Cc; Bcc should not have one. Well, if
739               ;; both Bcc and To are present, it will get one
740               ;; anyway.
741               (progn
742                 ;; Insert "courtesy" mail message.
743                 (goto-char (point-min))
744                 (re-search-forward
745                  (concat "^" (regexp-quote mail-header-separator) "$"))
746                 (forward-line 1)
747                 (insert gnus-mail-courtesy-message)))
748
749           (gnus-mail-send)
750           (kill-buffer (current-buffer))
751           (gnus-message 5 "Sending via mail...done"))))))
752
753 (defun gnus-inews-remove-headers-after-mail ()
754   (save-excursion
755     (save-restriction
756       (let ((case-fold-search t))
757         (gnus-inews-narrow-to-headers)
758         ;; Remove Bcc completely.
759         (nnheader-remove-header "bcc")
760         ;; We transform To and Cc headers to avoid re-mailing if the user
761         ;; accidentally (or purposefully) leans on the `C-c C-c' keys
762         ;; and the news server rejects the posting.
763         (while (re-search-forward "^\\(to\\|[bcf]cc\\|cc\\):" nil t)
764           (beginning-of-line)
765           (insert "X-"))
766         (widen)))))
767
768 (defun gnus-inews-dex-headers ()
769   "Remove \"X-\" prefixes from To and Cc headers."
770   (save-excursion
771     (save-restriction
772       (let ((case-fold-search t))
773         (nnheader-narrow-to-headers)
774         (while (re-search-forward "^X-\\(to\\|[bcf]cc\\|cc\\):" nil t)
775           (beginning-of-line)
776           (delete-char 2))
777         (widen)))))
778
779 (defun gnus-inews-remove-empty-headers ()
780   "Remove empty headers from news and mail.
781 The buffer should be narrowed to the headers before this function is
782 called."
783   (save-excursion
784     (goto-char (point-min))
785     (while (re-search-forward "^[^ \t:]+:\\([ \t]*\n\\)+[^ \t]" nil t)
786       (delete-region (match-beginning 0) (1- (match-end 0)))
787       (beginning-of-line))))
788
789 (defun gnus-inews-check-post ()
790   "Check whether the post looks ok."
791   (or
792    (not gnus-check-before-posting)
793    (and 
794     ;; We narrow to the headers and check them first.
795     (save-excursion
796       (save-restriction
797         (goto-char (point-min))
798         (narrow-to-region 
799          (point) 
800          (progn
801            (re-search-forward 
802             (concat "^" (regexp-quote mail-header-separator) "$"))
803            (match-beginning 0)))
804         (goto-char (point-min))
805         (and 
806          ;; Check for commands in Subject.
807          (or 
808           (gnus-check-before-posting 'subject-cmsg)
809           (save-excursion
810             (if (string-match "^cmsg " (mail-fetch-field "subject"))
811                 (gnus-y-or-n-p
812                  "The control code \"cmsg \" is in the subject. Really post? ")
813               t)))
814          ;; Check for multiple identical headers.
815          (or (gnus-check-before-posting 'multiple-headers)
816              (save-excursion
817                (let (found)
818                  (while (and (not found) (re-search-forward "^[^ \t:]+: "
819                                                             nil t))
820                    (save-excursion
821                      (or (re-search-forward 
822                           (concat "^" (setq found
823                                             (buffer-substring 
824                                              (match-beginning 0) 
825                                              (- (match-end 0) 2))))
826                           nil t)
827                          (setq found nil))))
828                  (if found
829                      (gnus-y-or-n-p 
830                       (format "Multiple %s headers. Really post? " found))
831                    t))))
832          ;; Check for Version and Sendsys.
833          (or (gnus-check-before-posting 'sendsys)
834              (save-excursion
835                (if (re-search-forward "^Sendsys:\\|^Version:" nil t)
836                    (gnus-y-or-n-p
837                     (format "The article contains a %s command. Really post? "
838                             (buffer-substring (match-beginning 0) 
839                                               (1- (match-end 0)))))
840                  t)))
841          ;; Check for Approved.
842          (or (gnus-check-before-posting 'approved)
843              (save-excursion
844                (if (re-search-forward "^Approved:" nil t)
845                    (gnus-y-or-n-p
846                     "The article contains an Approved header. Really post? ")
847                  t)))
848          ;; Check whether a Followup-To has redirected the newsgroup.
849          (or
850           (gnus-check-before-posting 'redirected-followup)
851           (not gnus-newsgroup-followup)
852           (save-excursion
853             (let ((followups (gnus-tokenize-header
854                               (mail-fetch-field "Newsgroups")))
855                   (newsgroups (gnus-tokenize-header
856                                (car gnus-newsgroup-followup)))
857                   shared)
858               (while (and followups
859                           (not (member followups newsgroups)))
860                 (setq followups (cdr followups)))
861               (if followups
862                   t
863                 (gnus-y-or-n-p
864                  "Followup redirected from original newsgroups.  Really post? "
865                  )))))
866          ;; Check the Message-ID header.
867          (or (gnus-check-before-posting 'message-id)
868              (save-excursion
869                (let* ((case-fold-search t)
870                       (message-id (mail-fetch-field "message-id")))
871                  (or (not message-id)
872                      (and (string-match "@" message-id)
873                           (string-match "@[^\\.]*\\." message-id))
874                      (gnus-y-or-n-p
875                       (format 
876                        "The Message-ID looks strange: \"%s\". Really post? "
877                        message-id))))))
878          ;; Check the From header.
879          (or 
880           (gnus-check-before-posting 'from)
881           (save-excursion
882             (let* ((case-fold-search t)
883                    (from (mail-fetch-field "from")))
884               (cond
885                ((not from)
886                 (gnus-y-or-n-p "There is no From line. Really post? "))
887                ((not (string-match "@[^\\.]*\\." from))
888                 (gnus-y-or-n-p
889                  (format 
890                   "The address looks strange: \"%s\". Really post? " from)))
891                ((string-match "(.*).*(.*)" from)
892                 (gnus-y-or-n-p
893                  (format
894                   "The From header looks strange: \"%s\". Really post? " 
895                   from)))
896                ((string-match "<[^>]+> *$" from)
897                 (let ((name (substring from 0 (match-beginning 0))))
898                   (or 
899                    (string-match "^ *\"[^\"]*\" *$" name)
900                    (not (string-match "[][.!()<>@,;:\\]" name))
901                    (gnus-y-or-n-p
902                     (format
903                      "The From header name has bogus characters.  Really post? " 
904                      from)))))
905                (t t)))))
906          )))
907     ;; Check for long lines.
908     (or (gnus-check-before-posting 'long-lines)
909         (save-excursion
910           (goto-char (point-min))
911           (re-search-forward
912            (concat "^" (regexp-quote mail-header-separator) "$"))
913           (while (and
914                   (progn
915                     (end-of-line)
916                     (< (current-column) 80))
917                   (zerop (forward-line 1))))
918           (or (bolp)
919               (eobp)
920               (gnus-y-or-n-p
921                "You have lines longer than 79 characters.  Really post? "))))
922     ;; Check whether the article is empty.
923     (or (gnus-check-before-posting 'empty)
924         (save-excursion
925           (goto-char (point-min))
926           (re-search-forward
927            (concat "^" (regexp-quote mail-header-separator) "$"))
928           (forward-line 1)
929           (or (re-search-forward "[^ \n\t]" nil t)
930               (gnus-y-or-n-p "Empty article.  Really post?"))))
931     ;; Check for control characters.
932     (or (gnus-check-before-posting 'control-chars)
933         (save-excursion
934           (if (re-search-forward "[\000-\007\013\015-\037\200-\237]" nil t)
935               (gnus-y-or-n-p 
936                "The article contains control characters. Really post? ")
937             t)))
938     ;; Check excessive size.
939     (or (gnus-check-before-posting 'size)
940         (if (> (buffer-size) 60000)
941             (gnus-y-or-n-p
942              (format "The article is %d octets long. Really post? "
943                      (buffer-size)))
944           t))
945     ;; Use the (size . checksum) variable to see whether the
946     ;; article is empty or has only quoted text.
947     (or
948      (gnus-check-before-posting 'new-text)
949      (if (and (= (buffer-size) (car gnus-article-check-size))
950               (= (gnus-article-checksum) (cdr gnus-article-check-size)))
951          (gnus-y-or-n-p
952           "It looks like there's no new text in your article. Really post? ")
953        t))
954     ;; Check the length of the signature.
955     (or (gnus-check-before-posting 'signature)
956         (progn
957           (goto-char (point-max))
958           (if (not (re-search-backward gnus-signature-separator nil t))
959               t
960             (if (> (count-lines (point) (point-max)) 5)
961                 (gnus-y-or-n-p
962                  (format
963                   "Your .sig is %d lines; it should be max 4.  Really post? "
964                   (count-lines (point) (point-max))))
965               t)))))))
966
967 (defun gnus-tokenize-header (header &optional separator)
968   "Split HEADER into a list of header elements.
969 \",\" is used as the separator."
970   (let* ((beg 0)
971          (separator (or separator ","))
972          (regexp
973           (format "[ \t]*\\([^%s]+\\)?\\(%s\\|\\'\\)" separator separator))
974          elems)
975     (while (and (string-match regexp header beg)
976                 (< beg (length header)))
977       (when (match-beginning 1)
978         (push (match-string 1 header) elems))
979       (setq beg (match-end 0)))
980     (nreverse elems)))
981
982 (defun gnus-article-checksum ()
983   (let ((sum 0))
984     (save-excursion
985       (while (not (eobp))
986         (setq sum (logxor sum (following-char)))
987         (forward-char 1)))
988     sum))
989
990 ;; Returns non-nil if this type is not to be checked.
991 (defun gnus-check-before-posting (type)
992   (not 
993    (or (not gnus-check-before-posting)
994        (if (listp gnus-check-before-posting)
995            (memq type gnus-check-before-posting)
996          t))))
997
998 (defun gnus-cancel-news ()
999   "Cancel an article you posted."
1000   (interactive)
1001   (if (or gnus-expert-user
1002           (gnus-yes-or-no-p "Do you really want to cancel this article? "))
1003       (let ((from nil)
1004             (newsgroups nil)
1005             (message-id nil)
1006             (distribution nil))
1007         (or (gnus-news-group-p gnus-newsgroup-name)
1008             (error "This backend does not support canceling"))
1009         (save-excursion
1010           ;; Get header info. from original article.
1011           (save-restriction
1012             (gnus-article-show-all-headers)
1013             (goto-char (point-min))
1014             (search-forward "\n\n" nil 'move)
1015             (narrow-to-region (point-min) (point))
1016             (setq from (mail-fetch-field "from"))
1017             (setq newsgroups (mail-fetch-field "newsgroups"))
1018             (setq message-id (mail-fetch-field "message-id"))
1019             (setq distribution (mail-fetch-field "distribution")))
1020           ;; Verify if the article is absolutely user's by comparing
1021           ;; user id with value of its From: field.
1022           (if (not
1023                (string-equal
1024                 (downcase (mail-strip-quoted-names from))
1025                 (downcase (mail-strip-quoted-names (gnus-inews-user-name)))))
1026               (progn
1027                 (ding) (gnus-message 3 "This article is not yours.")
1028                 nil)
1029             ;; Make control article.
1030             (set-buffer (get-buffer-create " *Gnus-canceling*"))
1031             (buffer-disable-undo (current-buffer))
1032             (erase-buffer)
1033             (insert "Newsgroups: " newsgroups "\n"
1034                     "From: " (gnus-inews-user-name) "\n"
1035                     "Subject: cancel " message-id "\n"
1036                     "Control: cancel " message-id "\n"
1037                     (if distribution
1038                         (concat "Distribution: " distribution "\n")
1039                       "")
1040                     mail-header-separator "\n"
1041                     "This is a cancel message from " from ".\n")
1042             ;; Send the control article to NNTP server.
1043             (gnus-message 5 "Canceling your article...")
1044             (prog1
1045                 (if (funcall gnus-inews-article-function)
1046                     (gnus-message 5 "Canceling your article...done")
1047                   (progn
1048                     (ding) 
1049                     (gnus-message 1 "Cancel failed; %s" 
1050                                   (gnus-status-message gnus-newsgroup-name))
1051                     nil)
1052                   t)
1053               ;; Kill the article buffer.
1054               (kill-buffer (current-buffer))))))))
1055
1056 \f
1057 ;;; Lowlevel inews interface.
1058
1059 ;; Dummy to avoid byte-compile warning.
1060 (defvar nnspool-rejected-article-hook)
1061
1062 (defun gnus-inews-article (&optional use-group-method)
1063   "Post an article in current buffer using NNTP protocol."
1064   (let ((artbuf (current-buffer))
1065         gcc result)
1066     (widen)
1067     (goto-char (point-max))
1068     ;; Require a newline at the end of the buffer since inews may
1069     ;; append a .signature.
1070     (or (= (preceding-char) ?\n)
1071         (insert ?\n))
1072     ;; Prepare article headers.  All message body such as signature
1073     ;; must be inserted before Lines: field is prepared.
1074     (save-restriction
1075       (gnus-inews-narrow-to-headers)
1076       ;; Fix some headers.
1077       (gnus-inews-cleanup-headers)
1078       ;; Remove some headers.
1079       (gnus-inews-remove-headers)
1080       ;; Insert some headers.
1081       (gnus-inews-insert-headers)
1082       ;; Let the user do all of the above.
1083       (run-hooks 'gnus-inews-article-header-hook)
1084       ;; Copy the Gcc header, if any.
1085       (setq gcc (mail-fetch-field "gcc"))
1086       (widen))
1087     ;; Check whether the article is a good Net Citizen.
1088     (if (and gnus-article-check-size
1089              (not (gnus-inews-check-post)))
1090         ;; Aber nein!
1091         'illegal
1092       ;; We fudge a hook for nnspool.
1093       (setq nnspool-rejected-article-hook
1094             (`
1095              (list
1096               (lambda ()
1097                 (condition-case ()
1098                     (save-excursion
1099                       (set-buffer (, (buffer-name)))
1100                       (gnus-associate-buffer-with-draft nil 'silent))
1101                   (error 
1102                    (ding)
1103                    (gnus-message 
1104                     1 "Couldn't enter rejected article into draft group")))))))
1105                                    
1106       ;; Looks ok, so we do the nasty.
1107       (save-excursion
1108         ;; This hook may insert a signature.
1109         (save-excursion
1110           (goto-char (point-min))
1111           (let ((gnus-newsgroup-name (or (mail-fetch-field "newsgroups")
1112                                          gnus-newsgroup-name)))
1113             (run-hooks 'gnus-prepare-article-hook)))
1114         ;; Send off copies using mail, if that is wanted.
1115         (gnus-inews-send-mail-copy)
1116         ;; Remove more headers.
1117         (gnus-inews-remove-headers-after-mail)
1118         ;; Copy the article over to a temp buffer.
1119         (nnheader-set-temp-buffer " *Gnus-posting*")
1120         (insert-buffer-substring artbuf)
1121         ;; Remove the header separator.
1122         (goto-char (point-min))
1123         (re-search-forward
1124          (concat "^" (regexp-quote mail-header-separator) "$"))
1125         (replace-match "" t t)
1126         ;; Remove X- prefixes to headers.
1127         (gnus-inews-dex-headers)
1128         ;; Run final inews hooks.  This hook may do FCC.
1129         ;; The article must be saved before being posted because
1130         ;; `gnus-request-post' modifies the buffer.
1131         (run-hooks 'gnus-inews-article-hook)
1132         ;; Copy the article over to some group, possibly.
1133         (and gcc (gnus-inews-do-gcc gcc))
1134         ;; Post the article.
1135         (setq result (gnus-request-post
1136                       (gnus-post-method gnus-newsgroup-name use-group-method)))
1137         (kill-buffer (current-buffer)))
1138       (run-hooks 'gnus-message-sent-hook)
1139       ;; If the posting was unsuccessful (that it, it was rejected) we
1140       ;; put it into the draft group.
1141       (or result (gnus-associate-buffer-with-draft))
1142       result)))
1143
1144 (defun gnus-inews-cleanup-headers ()
1145   ;; Correct newsgroups field: change sequence of spaces to comma and 
1146   ;; eliminate spaces around commas.  Eliminate imbedded line breaks.
1147   (goto-char (point-min))
1148   (if (re-search-forward "^Newsgroups: +" nil t)
1149       (save-restriction
1150         (narrow-to-region
1151          (point)
1152          (if (re-search-forward "^[^ \t]" nil t)
1153              (match-beginning 0)
1154            (forward-line 1)
1155            (point)))
1156         (goto-char (point-min))
1157         (while (re-search-forward "\n[ \t]+" nil t)
1158           (replace-match " " t t))      ;No line breaks (too confusing)
1159         (goto-char (point-min))
1160         (while (re-search-forward "[ \t\n]*,[ \t\n]*\\|[ \t]+" nil t)
1161           (replace-match "," t t))
1162         (goto-char (point-min))
1163         ;; Remove a trailing comma.
1164         (if (re-search-forward ",$" nil t)
1165             (replace-match "" t t))))
1166
1167   ;; Added by Per Abrahamsen <abraham@iesd.auc.dk>.
1168   ;; Help save the the world!
1169   (or 
1170    gnus-expert-user
1171    (let ((newsgroups (mail-fetch-field "newsgroups"))
1172          (followup-to (mail-fetch-field "followup-to"))
1173          groups to)
1174      (if (and newsgroups
1175               (string-match "," newsgroups) (not followup-to))
1176          (progn
1177            (while (string-match "," newsgroups)
1178              (setq groups
1179                    (cons (list (substring newsgroups 0 (match-beginning 0)))
1180                          groups))
1181              (setq newsgroups (substring newsgroups (match-end 0))))
1182            (setq groups (nreverse (cons (list newsgroups) groups)))
1183
1184            (setq to (completing-read 
1185                      "Followups to: (default all groups) " groups))
1186            (if (> (length to) 0)
1187                (progn
1188                  (goto-char (point-min))
1189                  (insert "Followup-To: " to "\n")))))))
1190
1191   ;; Cleanup Followup-To.
1192   (goto-char (point-min))
1193   (if (search-forward-regexp "^Followup-To: +" nil t)
1194       (save-restriction
1195         (narrow-to-region
1196          (point)
1197          (if (re-search-forward "^[^ \t]" nil 'end)
1198              (match-beginning 0)
1199            (point-max)))
1200         (goto-char (point-min))
1201         (replace-regexp "\n[ \t]+" " ") ;No line breaks (too confusing)
1202         (goto-char (point-min))
1203         (replace-regexp "[ \t\n]*,[ \t\n]*\\|[ \t]+" ","))))
1204
1205
1206 (defun gnus-inews-remove-headers ()
1207   (let ((case-fold-search t)
1208         (headers gnus-removable-headers))
1209     ;; Remove toxic headers.
1210     (while headers
1211       (goto-char (point-min))
1212       (and (re-search-forward 
1213             (concat "^" (downcase (format "%s" (car headers))))
1214             nil t)
1215            (delete-region (progn (beginning-of-line) (point))
1216                           (progn (forward-line 1) (point))))
1217       (setq headers (cdr headers)))))
1218
1219 ;;; Since the X-Newsreader/X-Mailer are ``vanity'' headers, they might
1220 ;;; as well include the Emacs version as well.
1221 ;;; The following function works with later GNU Emacs, and XEmacs.
1222 (defun gnus-extended-version ()
1223   "Stringified Gnus version and Emacs version"
1224   (interactive)
1225   (concat
1226    gnus-version
1227    "/"
1228    (cond
1229     ((string-match "^\\([0-9]+\\.[0-9]+\\)\\.[.0-9]+$" emacs-version)
1230      (concat "Emacs " (substring emacs-version
1231                                  (match-beginning 1)
1232                                  (match-end 1))))
1233     ((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)" emacs-version)
1234      (concat (substring emacs-version
1235                         (match-beginning 1)
1236                         (match-end 1))
1237              (format " %d.%d" emacs-major-version emacs-minor-version)))
1238     (t emacs-version))))
1239
1240 (defun gnus-inews-insert-headers (&optional headers)
1241   "Prepare article headers.
1242 Headers already prepared in the buffer are not modified.
1243 Headers in `gnus-required-headers' will be generated."
1244   (let* ((Date (gnus-inews-date))
1245          (Message-ID (gnus-inews-message-id))
1246          (Organization (gnus-inews-organization))
1247          (From (gnus-inews-user-name))
1248          (Path (gnus-inews-path))
1249          (Subject nil)
1250          (Newsgroups nil)
1251          (In-Reply-To (gnus-inews-in-reply-to))
1252          (To nil)
1253          (Distribution (gnus-inews-distribution))
1254          (Lines (gnus-inews-lines))
1255          (X-Newsreader (gnus-extended-version))
1256          (X-Mailer X-Newsreader)
1257          (Expires (gnus-inews-expires))
1258          (headers (or headers gnus-required-headers))
1259          (case-fold-search t)
1260          header value elem)
1261     ;; First we remove any old generated headers.
1262     (let ((headers gnus-deletable-headers))
1263       (while headers
1264         (goto-char (point-min))
1265         (and (re-search-forward 
1266               (concat "^" (symbol-name (car headers)) ": *") nil t)
1267              (get-text-property (1+ (match-beginning 0)) 'gnus-deletable)
1268              (gnus-delete-line))
1269         (setq headers (cdr headers))))
1270     ;; If there are References, and no "Re: ", then the thread has
1271     ;; changed name. See Son-of-1036.
1272     (if (and (mail-fetch-field "references")
1273              (get-buffer gnus-article-buffer))
1274         (let ((psubject (gnus-simplify-subject-re
1275                          (mail-fetch-field "subject"))))
1276           (or (and psubject gnus-reply-subject 
1277                    (string= (gnus-simplify-subject-re gnus-reply-subject)
1278                             psubject))
1279               (progn
1280                 (string-match "@" Message-ID)
1281                 (setq Message-ID
1282                       (concat (substring Message-ID 0 (match-beginning 0))
1283                               "_-_" 
1284                               (substring Message-ID (match-beginning 0))))))))
1285     ;; Go through all the required headers and see if they are in the
1286     ;; articles already. If they are not, or are empty, they are
1287     ;; inserted automatically - except for Subject, Newsgroups and
1288     ;; Distribution. 
1289     (while headers
1290       (goto-char (point-min))
1291       (setq elem (pop headers))
1292       (if (consp elem)
1293           (setq header (car elem))
1294         (setq header elem))
1295       (when (or (not (re-search-forward 
1296                       (concat "^" (downcase (symbol-name header)) ":") nil t))
1297                 (progn
1298                   ;; The header was found. We insert a space after the
1299                   ;; colon, if there is none.
1300                   (if (/= (following-char) ? ) (insert " "))
1301                   ;; Find out whether the header is empty...
1302                   (looking-at "[ \t]*$")))
1303         ;; So we find out what value we should insert.
1304         (setq value
1305               (cond 
1306                ((and (consp elem) (eq (car elem) 'optional))
1307                 ;; This is an optional header.  If the cdr of this
1308                 ;; is something that is nil, then we do not insert
1309                 ;; this header.
1310                 (setq header (cdr elem))
1311                 (or (and (fboundp (cdr elem)) (funcall (cdr elem)))
1312                     (and (boundp (cdr elem)) (symbol-value (cdr elem)))))
1313                ((consp elem)
1314                 ;; The element is a cons.  Either the cdr is a
1315                 ;; string to be inserted verbatim, or it is a
1316                 ;; function, and we insert the value returned from
1317                 ;; this function.
1318                 (or (and (stringp (cdr elem)) (cdr elem))
1319                     (and (fboundp (cdr elem)) (funcall (cdr elem)))))
1320                ((and (boundp header) (symbol-value header))
1321                 ;; The element is a symbol.  We insert the value
1322                 ;; of this symbol, if any.
1323                 (symbol-value header))
1324                (t
1325                 ;; We couldn't generate a value for this header,
1326                 ;; so we just ask the user.
1327                 (read-from-minibuffer
1328                  (format "Empty header for %s; enter value: " header)))))
1329         ;; Finally insert the header.
1330         (when (and value 
1331                    (not (equal value "")))
1332           (save-excursion
1333             (if (bolp)
1334                 (progn
1335                   ;; This header didn't exist, so we insert it.
1336                   (goto-char (point-max))
1337                   (insert (symbol-name header) ": " value "\n")
1338                   (forward-line -1))
1339               ;; The value of this header was empty, so we clear
1340               ;; totally and insert the new value.
1341               (delete-region (point) (gnus-point-at-eol))
1342               (insert value))
1343             ;; Add the deletable property to the headers that require it.
1344             (and (memq header gnus-deletable-headers)
1345                  (progn (beginning-of-line) (looking-at "[^:]+: "))
1346                  (add-text-properties 
1347                   (point) (match-end 0)
1348                   '(gnus-deletable t face italic) (current-buffer)))))))
1349     ;; Insert new Sender if the From is strange. 
1350     (let ((from (mail-fetch-field "from"))
1351           (sender (mail-fetch-field "sender"))
1352           (secure-sender (gnus-inews-real-user-address)))
1353       (when (and from 
1354                  (not (gnus-check-before-posting 'sender))
1355                  (not (string=
1356                        (downcase (car (cdr (gnus-extract-address-components
1357                                             from))))
1358                        (downcase (gnus-inews-real-user-address))))
1359                  (or (null sender)
1360                      (not 
1361                       (string=
1362                        (downcase (car (cdr (gnus-extract-address-components
1363                                             sender))))
1364                        (downcase secure-sender)))))
1365         (goto-char (point-min))    
1366         ;; Rename any old Sender headers to Original-Sender.
1367         (when (re-search-forward "^Sender:" nil t)
1368           (beginning-of-line)
1369           (insert "Original-")
1370           (beginning-of-line))
1371         (insert "Sender: " secure-sender "\n")))))
1372
1373 (defun gnus-inews-insert-signature ()
1374   "Insert a signature file.
1375 If `gnus-signature-function' is bound and returns a string, this
1376 string is used instead of the variable `gnus-signature-file'.
1377 In either case, if the string is a file name, this file is
1378 inserted. If the string is not a file name, the string itself is
1379 inserted. 
1380
1381 If you never want any signature inserted, set both of these variables to
1382 nil."
1383   (save-excursion
1384     (let ((signature 
1385            (or (and gnus-signature-function
1386                     (funcall gnus-signature-function gnus-newsgroup-name))
1387                gnus-signature-file)))
1388       (if (and signature
1389                (or (file-exists-p signature)
1390                    (string-match " " signature)
1391                    (not (string-match 
1392                          "^/[^/]+/" (expand-file-name signature)))))
1393           (progn
1394             (goto-char (point-max))
1395             (if (and mail-signature (search-backward "\n-- \n" nil t))
1396                 ()
1397               ;; Delete any previous signatures.
1398               (if (search-backward "\n-- \n" nil t)
1399                   (delete-region (point) (point-max)))
1400               (or (eolp) (insert "\n"))
1401               (insert "-- \n")
1402               (if (file-exists-p signature)
1403                   (insert-file-contents signature)
1404                 (insert signature))
1405               (goto-char (point-max))
1406               (or (bolp) (insert "\n"))))))))
1407
1408 ;; Written by "Mr. Per Persson" <pp@solace.mh.se>.
1409 (defun gnus-inews-insert-mime-headers ()
1410   (goto-char (point-min))
1411   (let ((mail-header-separator 
1412          (progn 
1413            (goto-char (point-min))
1414            (if (and (search-forward (concat "\n" mail-header-separator "\n")
1415                                     nil t)
1416                     (not (search-backward "\n\n" nil t)))
1417                mail-header-separator
1418              ""))))
1419     (or (mail-position-on-field "Mime-Version")
1420         (insert "1.0")
1421         (cond ((progn
1422                  (goto-char (point-min))
1423                  (re-search-forward "[\200-\377]" nil t))
1424                (or (mail-position-on-field "Content-Type")
1425                    (insert "text/plain; charset=ISO-8859-1"))
1426                (or (mail-position-on-field "Content-Transfer-Encoding")
1427                    (insert "8bit")))
1428               (t (or (mail-position-on-field "Content-Type")
1429                      (insert "text/plain; charset=US-ASCII"))
1430                  (or (mail-position-on-field "Content-Transfer-Encoding")
1431                      (insert "7bit")))))))
1432
1433 (defun gnus-inews-do-fcc ()
1434   "Process Fcc headers in the current buffer.
1435 Unless the first character of the field is `|', the article is saved
1436 to the specified file using the function specified by the variable
1437 gnus-author-copy-saver.  The default function rmail-output saves in
1438 Unix mailbox format.
1439
1440 If the first character is `|', the contents of the article is sent to
1441 a program specified by the rest of the value."
1442   (let ((case-fold-search t)            ;Should ignore case.
1443         list file)
1444     (save-excursion
1445       (save-restriction
1446         (nnheader-narrow-to-headers)
1447         (while (setq file (mail-fetch-field "fcc"))
1448           (push file list)
1449           (nnheader-remove-header "fcc" nil t))
1450         ;; Process FCC operations.
1451         (widen)
1452         (while list
1453           (setq file (pop list))
1454           (if (string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" file)
1455               ;; Pipe the article to the program in question.
1456               (call-process-region (point-min) (point-max) shell-file-name
1457                                    nil nil nil "-c" (match-string 1 file))
1458             ;; Save the article.
1459             (setq file (expand-file-name file))
1460             (gnus-make-directory (file-name-directory file))
1461             (if (and gnus-author-copy-saver
1462                      (not (eq gnus-author-copy-saver 'rmail-output)))
1463                 (funcall gnus-author-copy-saver file)
1464               (if (and (file-readable-p file) (mail-file-babyl-p file))
1465                   (gnus-output-to-rmail file)
1466                 (let ((mail-use-rfc822 t))
1467                   (rmail-output file 1 t t))))))))))
1468
1469 (defun gnus-inews-path ()
1470   "Return uucp path."
1471   (let ((login-name (gnus-inews-login-name)))
1472     (cond ((null gnus-use-generic-path)
1473            (concat (nth 1 gnus-select-method) "!" login-name))
1474           ((stringp gnus-use-generic-path)
1475            ;; Support GENERICPATH.  Suggested by vixie@decwrl.dec.com.
1476            (concat gnus-use-generic-path "!" login-name))
1477           (t login-name))))
1478
1479 (defun gnus-inews-user-name ()
1480   "Return user's network address as \"NAME@DOMAIN (FULL-NAME)\"."
1481   (let ((full-name (gnus-inews-full-name))
1482         (address (if (or gnus-user-login-name gnus-use-generic-from
1483                          gnus-local-domain (getenv "DOMAINNAME"))
1484                      (concat (gnus-inews-login-name) "@"
1485                              (gnus-inews-domain-name gnus-use-generic-from))
1486                    user-mail-address))) 
1487     (or gnus-user-from-line
1488         (concat address
1489                 ;; User's full name.
1490                 (cond ((string-equal full-name "&") ;Unix hack.
1491                        (concat " (" (user-login-name) ")"))
1492                       ((string-match "[^ ]+@[^ ]+ +(.*)" address)
1493                        "")
1494                       (t
1495                        (concat " (" full-name ")")))))))
1496
1497 (defun gnus-inews-real-user-address ()
1498   "Return the \"real\" user address.
1499 This function tries to ignore all user modifications, and 
1500 give as trustworthy answer as possible."
1501   (concat (user-login-name) "@" (system-name)))
1502
1503 (defun gnus-inews-login-name ()
1504   "Return login name."
1505   (or gnus-user-login-name (getenv "LOGNAME") (user-login-name)))
1506
1507 (defun gnus-inews-full-name ()
1508   "Return full user name."
1509   (or gnus-user-full-name (getenv "NAME") (user-full-name)))
1510
1511 (defun gnus-inews-domain-name (&optional genericfrom)
1512   "Return user's domain name.
1513 If optional argument GENERICFROM is a string, use it as the domain
1514 name; if it is non-nil, strip off local host name from the domain name.
1515 If the function `system-name' returns full internet name and the
1516 domain is undefined, the domain name is got from it."
1517   (if (or genericfrom gnus-local-domain (getenv "DOMAINNAME"))
1518       (let* ((system-name (system-name))
1519              (domain 
1520               (or (if (stringp genericfrom) genericfrom)
1521                   (getenv "DOMAINNAME")
1522                   (and (boundp 'mail-host-address)
1523                        mail-host-address)
1524                   gnus-local-domain
1525                   ;; Function `system-name' may return full internet name.
1526                   ;; Suggested by Mike DeCorte <mrd@sun.soe.clarkson.edu>.
1527                   (if (string-match "\\.." system-name)
1528                       ;; Some machines return "name.", and that's not
1529                       ;; very nice. 
1530                       (substring system-name (1- (match-end 0))))
1531                   (read-string "Domain name (no host): ")))
1532              (host (or (if (string-match "\\." system-name)
1533                            (substring system-name 0 (match-beginning 0)))
1534                        system-name)))
1535         (if (string-equal "." (substring domain 0 1))
1536             (setq domain (substring domain 1)))
1537         ;; Support GENERICFROM as same as standard Bnews system.
1538         ;; Suggested by ohm@kaba.junet and vixie@decwrl.dec.com.
1539         (cond ((null genericfrom)
1540                (concat host "." domain))
1541               ;;((stringp genericfrom) genericfrom)
1542               (t domain)))
1543     (if (string-match "\\." (system-name))
1544         (system-name)
1545       (if (string-match "@\\([^ ]+\\)\\($\\| \\)" user-mail-address)
1546           (substring user-mail-address 
1547                      (match-beginning 1) (match-end 1))
1548         "bogus-domain"))))
1549
1550 (defun gnus-inews-full-address ()
1551   (let ((domain (gnus-inews-domain-name))
1552         (system (system-name))
1553         (case-fold-search t))
1554     (if (string-match "\\." system) system
1555       (if (string-match (concat "^" (regexp-quote system)) domain) domain
1556         (concat system "." domain)))))
1557
1558 (defun gnus-inews-expires ()
1559   "Return an Expires header based on `gnus-article-expires'."
1560   (let ((current (current-time))
1561         (future (* 1.0 gnus-article-expires 60 60 24)))
1562     ;; Add the future to current.
1563     (setcar current (+ (car current) (round (/ future (expt 2 16)))))
1564     (setcar (cdr current) (+ (nth 1 current) (% (round future) (expt 2 16))))
1565     ;; Return the date in the future in UT.
1566     (timezone-make-date-arpa-standard 
1567      (current-time-string current) (current-time-zone) '(0 "UT"))))
1568
1569 (defun gnus-inews-distribution ()
1570   "Return the current Distribution header, if any."
1571   (when (and gnus-distribution-function
1572              (fboundp gnus-distribution-function))
1573     (funcall gnus-distribution-function (or gnus-newsgroup-name ""))))
1574
1575 (defun gnus-inews-message-id ()
1576   "Generate unique Message-ID for user."
1577   ;; Message-ID should not contain a slash and should be terminated by
1578   ;; a number.  I don't know the reason why it is so.
1579   (concat "<" (gnus-inews-unique-id) "@" (gnus-inews-full-address) ">"))
1580
1581 (defvar gnus-unique-id-char nil)
1582
1583 ;; If you ever change this function, make sure the new version
1584 ;; cannot generate IDs that the old version could.
1585 ;; You might for example insert a "." somewhere (not next to another dot
1586 ;; or string boundary), or modify the newsreader name to "Ding".
1587 (defun gnus-inews-unique-id ()
1588   ;; Don't use microseconds from (current-time), they may be unsupported.
1589   ;; Instead we use this randomly inited counter.
1590   (setq gnus-unique-id-char
1591         (% (1+ (or gnus-unique-id-char (logand (random t) (1- (lsh 1 20)))))
1592            ;; (current-time) returns 16-bit ints,
1593            ;; and 2^16*25 just fits into 4 digits i base 36.
1594            (* 25 25)))
1595   (let ((tm (if (fboundp 'current-time)
1596                 (current-time) '(12191 46742 287898))))
1597     (concat
1598      (if (memq system-type '(ms-dos emx vax-vms))
1599          (let ((user (downcase (gnus-inews-login-name))))
1600            (while (string-match "[^a-z0-9_]" user)
1601              (aset user (match-beginning 0) ?_))
1602            user)
1603        (gnus-number-base36 (user-uid) -1))
1604      (gnus-number-base36 (+ (car   tm) (lsh (% gnus-unique-id-char 25) 16)) 4)
1605      (gnus-number-base36 (+ (nth 1 tm) (lsh (/ gnus-unique-id-char 25) 16)) 4)
1606      ;; Append the newsreader name, because while the generated
1607      ;; ID is unique to this newsreader, other newsreaders might
1608      ;; otherwise generate the same ID via another algorithm.
1609      ".fsf")))
1610
1611
1612 (defun gnus-inews-date ()
1613   "Current time string."
1614   (let ((now (current-time)))
1615     (timezone-make-date-arpa-standard 
1616      (current-time-string now) (current-time-zone now))))
1617
1618 (defun gnus-inews-organization ()
1619   "Return user's organization.
1620 The ORGANIZATION environment variable is used if defined.
1621 If not, the variable `gnus-local-organization' is used instead.
1622 If it is a function, the function will be called with the current
1623 newsgroup name as the argument.
1624 If this is a file name, the contents of this file will be used as the
1625 organization."
1626   (let* ((organization 
1627           (or (getenv "ORGANIZATION")
1628               (if gnus-local-organization
1629                   (if (gnus-functionp gnus-local-organization)
1630                       (funcall gnus-local-organization gnus-newsgroup-name)
1631                     gnus-local-organization))
1632               gnus-organization-file
1633               "~/.organization")))
1634     (and (stringp organization)
1635          (> (length organization) 0)
1636          (or (file-exists-p organization)
1637              (string-match " " organization)
1638              (not (string-match "^/usr/lib/\\|^~/" organization)))
1639          (save-excursion
1640            (gnus-set-work-buffer)
1641            (if (file-exists-p organization)
1642                (insert-file-contents organization)
1643              (insert organization))
1644            (goto-char (point-min))
1645            (while (re-search-forward " *\n *" nil t)
1646              (replace-match " " t t))
1647            (buffer-substring (point-min) (point-max))))))
1648
1649 (defun gnus-inews-lines ()
1650   "Count the number of lines and return numeric string."
1651   (save-excursion
1652     (save-restriction
1653       (widen)
1654       (goto-char (point-min))
1655       (re-search-forward 
1656        (concat "^" (regexp-quote mail-header-separator) "$"))
1657       (forward-line 1)
1658       (int-to-string (count-lines (point) (point-max))))))
1659
1660 (defun gnus-inews-in-reply-to ()
1661   "Return the In-Reply-To header for this message."
1662   gnus-in-reply-to)
1663
1664 \f
1665 ;;;
1666 ;;; Gnus Mail Functions 
1667 ;;;
1668
1669 ;;; Mail reply commands of Gnus summary mode
1670
1671 (defun gnus-summary-reply (yank &optional yank-articles)
1672   "Reply mail to news author.
1673 If prefix argument YANK is non-nil, original article is yanked automatically.
1674 Customize the variable gnus-mail-reply-method to use another mailer."
1675   (interactive "P")
1676   ;; Bug fix by jbw@bigbird.bu.edu (Joe Wells)
1677   ;; Stripping headers should be specified with mail-yank-ignored-headers.
1678   (gnus-set-global-variables)
1679   (if yank-articles (gnus-summary-goto-subject (car yank-articles)))
1680   (gnus-summary-select-article)
1681   (bury-buffer gnus-article-buffer)
1682   (gnus-mail-reply (or yank-articles (not (not yank)))))
1683
1684 (defun gnus-summary-reply-with-original (n)
1685   "Reply mail to news author with original article.
1686 Customize the variable gnus-mail-reply-method to use another mailer."
1687   (interactive "P")
1688   (gnus-summary-reply t (gnus-summary-work-articles n)))
1689
1690 (defun gnus-summary-mail-forward (post)
1691   "Forward the current message to another user.
1692 Customize the variable gnus-mail-forward-method to use another mailer."
1693   (interactive "P")
1694   (gnus-set-global-variables)
1695   (gnus-summary-select-article)
1696   (gnus-copy-article-buffer)
1697   (if post
1698       (gnus-forward-using-post gnus-original-article-buffer)
1699     (gnus-mail-forward gnus-original-article-buffer)))
1700
1701 (defun gnus-summary-resend-message (address)
1702   "Resend the current article to ADDRESS."
1703   (interactive "sResend message to: ")
1704   (gnus-summary-select-article)
1705   (save-excursion
1706     (let (resent beg)
1707       ;; We first set up a normal mail buffer.
1708       (nnheader-set-temp-buffer " *Gnus resend*")
1709       ;; This code from sendmail.el
1710       (insert "To: ")
1711       (let ((fill-prefix "\t")
1712             (address-start (point)))
1713         (insert address "\n")
1714         (fill-region-as-paragraph address-start (point-max)))
1715       (insert mail-header-separator "\n")
1716       ;; Insert our usual headers.
1717       (gnus-inews-narrow-to-headers)
1718       (gnus-inews-insert-headers '(From Date To))
1719       (goto-char (point-min))
1720       ;; Rename them all to "Resent-*".
1721       (while (re-search-forward "^[A-Za-z]" nil t)
1722         (forward-char -1)
1723         (insert "Resent-"))
1724       (widen)
1725       (forward-line)
1726       (delete-region (point) (point-max))
1727       (setq beg (point))
1728       ;; Insert the message to be resent.
1729       (insert-buffer-substring gnus-original-article-buffer)
1730       (goto-char (point-min))
1731       (search-forward "\n\n")
1732       (forward-char -1)
1733       (insert mail-header-separator)
1734       ;; Rename all old ("Also-")Resent headers.
1735       (while (re-search-backward "^\\(Also-\\)?Resent-" beg t)
1736         (beginning-of-line)
1737         (insert "Also-"))
1738       ;; Send it.
1739       (mail-send)
1740       (kill-buffer (current-buffer)))))
1741
1742 (defun gnus-summary-post-forward ()
1743   "Forward the current article to a newsgroup."
1744   (interactive)
1745   (gnus-summary-mail-forward t))
1746
1747 (defvar gnus-nastygram-message 
1748   "The following article was inappropriately posted to %s.\n"
1749   "Format string to insert in nastygrams.
1750 The current group name will be inserted at \"%s\".")
1751
1752 (defun gnus-summary-mail-nastygram (n)
1753   "Send a nastygram to the author of the current article."
1754   (interactive "P")
1755   (if (or gnus-expert-user
1756           (gnus-y-or-n-p 
1757            "Really send a nastygram to the author of the current article? "))
1758       (let ((group gnus-newsgroup-name))
1759         (gnus-summary-reply-with-original n)
1760         (set-buffer gnus-mail-buffer)
1761         (insert (format gnus-nastygram-message group))
1762         (gnus-mail-send-and-exit))))
1763
1764 (defun gnus-summary-mail-other-window ()
1765   "Compose mail in other window.
1766 Customize the variable `gnus-mail-other-window-method' to use another
1767 mailer."
1768   (interactive)
1769   (gnus-set-global-variables)
1770   (gnus-new-mail
1771    ;; We might want to prompt here.
1772    (when (and gnus-interactive-post
1773               (not gnus-expert-user))
1774      (read-string "To: ")))
1775   (gnus-configure-windows 'summary-mail 'force))
1776
1777 (defun gnus-new-mail (&optional to)
1778   (let (subject)
1779     (when (and gnus-interactive-post
1780                (not gnus-expert-user))
1781       (setq subject (read-string "Subject: ")))
1782     (pop-to-buffer gnus-mail-buffer)
1783     (erase-buffer)
1784     (gnus-mail-setup 'new to subject)
1785     (gnus-inews-insert-gcc)
1786     (gnus-inews-insert-archive-gcc)
1787     (run-hooks 'gnus-mail-hook)))
1788
1789 (defun gnus-mail-reply (&optional yank to-address followup)
1790   (save-excursion
1791     (set-buffer gnus-summary-buffer)
1792     (let ((group (gnus-group-real-name gnus-newsgroup-name))
1793           (cur (cons (current-buffer) (cdr gnus-article-current)))
1794           (winconf (current-window-configuration))
1795           from subject date reply-to message-of to cc
1796           references message-id sender follow-to sendto elt new-cc new-to
1797           mct mctdo)
1798       (set-buffer (get-buffer-create gnus-mail-buffer))
1799       (mail-mode)
1800       (if (and (buffer-modified-p)
1801                (> (buffer-size) 0)
1802                (not (gnus-y-or-n-p 
1803                      "Unsent message being composed; erase it? ")))
1804           ()
1805         (erase-buffer)
1806         (save-excursion
1807           (gnus-copy-article-buffer)
1808           (save-restriction
1809             (set-buffer gnus-article-copy)
1810             (nnheader-narrow-to-headers)
1811             (if (not followup)
1812                 ;; This is a regular reply.
1813                 (if (gnus-functionp gnus-reply-to-function)
1814                     (setq follow-to (funcall gnus-reply-to-function group)))
1815               ;; This is a followup.
1816               (if (gnus-functionp gnus-followup-to-function)
1817                   (save-excursion
1818                     (setq follow-to
1819                           (funcall gnus-followup-to-function group)))))
1820             (setq from (mail-fetch-field "from"))
1821             (setq date (or (mail-fetch-field "date") 
1822                            (mail-header-date gnus-current-headers)))
1823             (setq message-of (gnus-message-of from date))
1824             (setq sender (mail-fetch-field "sender"))
1825             (setq subject (or (mail-fetch-field "subject") "none"))
1826             ;; Remove any (buggy) Re:'s that are present and make a
1827             ;; proper one.
1828             (and (string-match "^[ \t]*[Re][Ee]:[ \t]*" subject)
1829                  (setq subject (substring subject (match-end 0))))
1830             (setq subject (concat "Re: " subject))
1831             (setq to (mail-fetch-field "to"))
1832             (setq cc (mail-fetch-field "cc"))
1833             (setq mct (mail-fetch-field "mail-copies-to"))
1834             (setq reply-to
1835                   (unless (gnus-group-get-parameter group 'broken-reply-to)
1836                     (mail-fetch-field "reply-to")))
1837             (setq references (mail-fetch-field "references"))
1838             (setq message-id (mail-fetch-field "message-id"))
1839             
1840             (setq mctdo (not (equal mct "never")))
1841
1842             (if (not (and followup (not to-address)))
1843                 (setq new-to (or reply-to from))
1844               (let (ccalist)
1845                 (save-excursion
1846                   (gnus-set-work-buffer)
1847                   (unless (equal mct "never")
1848                     (insert (or reply-to from "")))
1849                   (insert (if (bolp) "" ", ")
1850                           (or to "")
1851                           (if (or (not mct) (not mctdo)) ""
1852                             (concat (if (bolp) "" ", ") mct))
1853                           (if cc (concat (if (bolp) "" ", ") cc) ""))
1854                   (goto-char (point-min))
1855                   (setq ccalist
1856                         (mapcar
1857                          (lambda (addr)
1858                            (cons (mail-strip-quoted-names addr) addr))
1859                          (nreverse (gnus-mail-parse-comma-list))))
1860                   (let ((s ccalist))
1861                     (while s
1862                       (setq ccalist (delq (assoc (car (pop s)) s) ccalist)))))
1863                 (setq new-to (cdr (pop ccalist)))
1864                 (setq new-cc 
1865                       (mapconcat 
1866                        (lambda (addr) (cdr addr))
1867                        ccalist ", "))))
1868             (widen)))
1869
1870         (setq news-reply-yank-from (or from "(nobody)"))
1871         (setq news-reply-yank-message-id
1872               (or message-id "(unknown Message-ID)"))
1873
1874         ;; Gather the "to" addresses out of the follow-to list and remove
1875         ;; them as we go.
1876         (if (and follow-to (listp follow-to))
1877             (while (setq elt (assoc "To" follow-to))
1878               (setq sendto (concat sendto (and sendto ", ") (cdr elt)))
1879               (setq follow-to (delq elt follow-to))))
1880
1881         (gnus-mail-setup 
1882          (if followup 'followup 'reply)
1883          (or to-address 
1884              (if (and follow-to (not (stringp follow-to))) sendto
1885                (or follow-to new-to sender "")))
1886          subject message-of
1887          (if (zerop (length new-cc)) nil new-cc)
1888          gnus-article-copy)
1889
1890         (make-local-variable 'gnus-article-reply)
1891         (setq gnus-article-reply cur)
1892         (make-local-variable 'gnus-prev-winconf)
1893         (setq gnus-prev-winconf winconf)
1894         (make-local-variable 'gnus-reply-subject)
1895         (setq gnus-reply-subject subject)
1896         (make-local-variable 'gnus-in-reply-to)
1897         (setq gnus-in-reply-to message-of)
1898
1899         (auto-save-mode auto-save-default)
1900         (gnus-inews-insert-gcc)
1901         (gnus-inews-insert-archive-gcc)
1902
1903         (when (and follow-to (listp follow-to))
1904           (let (beg)
1905             (gnus-inews-narrow-to-headers)
1906             (re-search-forward "^To:" nil t)
1907             (beginning-of-line)
1908             (forward-line 1)
1909             (setq beg (point))
1910             ;; Insert the rest of the Follow-To headers.
1911             (while follow-to
1912               (goto-char (point-min))
1913               (if (not (re-search-forward 
1914                         (concat "^" (caar follow-to) ": *") nil t))
1915                   (progn
1916                     (goto-char beg)
1917                     (insert (caar follow-to) ": " (cdar follow-to) "\n"))
1918                 (unless (eolp)
1919                   (insert ", "))
1920                 (insert (cdar follow-to)))
1921               (setq follow-to (cdr follow-to)))
1922             (widen)))
1923         (nnheader-insert-references references message-id)
1924
1925         ;; Now the headers should be ok, so we do the yanking.
1926         (goto-char (point-min))
1927         (re-search-forward
1928          (concat "^" (regexp-quote mail-header-separator) "$"))
1929         (forward-line 1)
1930         (if (not yank)
1931             (gnus-configure-windows 'reply 'force)
1932           (let ((last (point))
1933                 end)
1934             (if (not (listp yank))
1935                 (progn
1936                   ;; Just a single article being yanked.
1937                   (save-excursion
1938                     (mail-yank-original nil))
1939                   (or mail-yank-hooks mail-citation-hook
1940                       (run-hooks 'news-reply-header-hook)))
1941               (while yank
1942                 (save-window-excursion
1943                   (set-buffer gnus-summary-buffer)
1944                   (gnus-summary-select-article nil nil nil (car yank))
1945                   (gnus-summary-remove-process-mark (car yank)))
1946                 (save-excursion
1947                   (setq end (point))
1948                   (gnus-copy-article-buffer)
1949                   (mail-yank-original nil)
1950                   (save-restriction
1951                     (narrow-to-region (point-min) (point))
1952                     (goto-char (mark t))
1953                     (let ((news-reply-yank-from
1954                            (save-excursion 
1955                              (set-buffer gnus-article-buffer)
1956                              (or (mail-fetch-field "from") "(nobody)")))
1957                           (news-reply-yank-message-id
1958                            (save-excursion 
1959                              (set-buffer gnus-article-buffer)
1960                              (or (mail-fetch-field "message-id")
1961                                  "(unknown Message-ID)"))))
1962                       (or mail-yank-hooks mail-citation-hook
1963                           (run-hooks 'news-reply-header-hook))
1964                       (setq end (point-max)))))
1965                 (goto-char end)
1966                 (setq yank (cdr yank))))
1967             (goto-char last))
1968           (forward-line 2)
1969           (gnus-configure-windows 'reply-yank 'force))
1970         (run-hooks 'gnus-mail-hook)
1971         ;; Mark this buffer as unchanged.
1972         (set-buffer-modified-p nil)))))
1973
1974 (defun gnus-mail-parse-comma-list ()
1975   (let (accumulated
1976         beg)
1977     (skip-chars-forward " ")
1978     (while (not (eobp))
1979       (setq beg (point))
1980       (skip-chars-forward "^,")
1981       (while (zerop
1982               (save-excursion 
1983                 (save-restriction
1984                   (let ((i 0))
1985                     (narrow-to-region beg (point))
1986                     (goto-char beg)
1987                     (logand (progn
1988                               (while (search-forward "\"" nil t)
1989                                 (incf i))
1990                               (if (zerop i) 2 i)) 2)))))
1991         (skip-chars-forward ",")
1992         (skip-chars-forward "^,"))
1993       (skip-chars-backward " ")
1994       (setq accumulated
1995             (cons (buffer-substring beg (point))
1996                   accumulated))
1997       (skip-chars-forward "^,")
1998       (skip-chars-forward ", "))
1999     accumulated))
2000
2001 (defun gnus-new-news (&optional group inhibit-prompt)
2002   "Set up a *post-news* buffer that points to GROUP.
2003 If INHIBIT-PROMPT, never prompt for a Subject."
2004   (let ((winconf (current-window-configuration))
2005         subject)
2006     (when (and gnus-interactive-post
2007                (not inhibit-prompt)
2008                (not gnus-expert-user))
2009       (setq subject (read-string "Subject: ")))
2010     (pop-to-buffer gnus-post-news-buffer)  
2011     (erase-buffer)
2012     (news-reply-mode)
2013     ;; Let posting styles be configured.
2014     (gnus-configure-posting-styles)
2015     (news-setup nil subject nil (and group (gnus-group-real-name group)) nil)
2016     ;; Associate this buffer with the draft group.
2017     (gnus-enter-buffer-into-draft)
2018     (goto-char (point-min))
2019
2020     (unless (re-search-forward 
2021              (concat "^" (regexp-quote mail-header-separator) "$") nil t)
2022       (goto-char (point-max)))
2023     (insert "\n\n")
2024
2025     (gnus-inews-insert-bfcc)
2026     (gnus-inews-insert-gcc)
2027     (gnus-inews-insert-archive-gcc)
2028     (gnus-inews-insert-signature)
2029     (and gnus-post-prepare-function
2030          (gnus-functionp gnus-post-prepare-function)
2031          (funcall gnus-post-prepare-function group))
2032     (run-hooks 'gnus-post-prepare-hook)
2033     (gnus-inews-set-point)
2034     (make-local-variable 'gnus-prev-winconf)
2035     (setq gnus-prev-winconf winconf)
2036     (gnus-inews-modify-mail-mode-map)
2037     (local-set-key "\C-c\C-c" 'gnus-inews-news)))
2038
2039 (defun gnus-news-followup (&optional yank group)
2040   (save-excursion
2041     (set-buffer gnus-summary-buffer)
2042     (if (not (or (not gnus-novice-user)
2043                  gnus-expert-user
2044                  (gnus-y-or-n-p
2045                   "Are you sure you want to post to all of USENET? ")))
2046         ()
2047       (let ((group (gnus-group-real-name (or group gnus-newsgroup-name)))
2048             (cur (cons (current-buffer) (cdr gnus-article-current)))
2049             (winconf (current-window-configuration))
2050             from subject date reply-to message-of
2051             references message-id sender follow-to sendto elt 
2052             followup-to distribution newsgroups)
2053         (set-buffer (get-buffer-create gnus-post-news-buffer))
2054         (news-reply-mode)
2055         ;; Associate this buffer with the draft group.
2056         (gnus-enter-buffer-into-draft)
2057         (if (and (buffer-modified-p)
2058                  (> (buffer-size) 0)
2059                  (not (gnus-y-or-n-p 
2060                        "Unsent message being composed; erase it? ")))
2061             ()
2062           (erase-buffer)
2063           (save-excursion
2064             (gnus-copy-article-buffer)
2065             (save-restriction
2066               (set-buffer gnus-article-copy)
2067               (nnheader-narrow-to-headers)
2068               (if (gnus-functionp gnus-followup-to-function)
2069                   (save-excursion
2070                     (setq follow-to
2071                           (funcall gnus-followup-to-function group))))
2072               (setq from (mail-fetch-field "from"))
2073               (setq date (or (mail-fetch-field "date") 
2074                              (mail-header-date gnus-current-headers)))
2075               (setq message-of (gnus-message-of from date))
2076               (setq subject (or (mail-fetch-field "subject") "none"))
2077               ;; Remove any (buggy) Re:'s that are present and make a
2078               ;; proper one.
2079               (and (string-match "^[ \t]*[Re][Ee]:[ \t]*" subject)
2080                    (setq subject (substring subject (match-end 0))))
2081               (setq subject (concat "Re: " subject))
2082               (setq references (mail-fetch-field "references"))
2083               (setq message-id (mail-fetch-field "message-id"))
2084               (setq followup-to (mail-fetch-field "followup-to"))
2085               (setq newsgroups (mail-fetch-field "newsgroups"))
2086               (setq distribution (mail-fetch-field "distribution"))
2087               ;; Remove bogus distribution.
2088               (and (stringp distribution)
2089                    (string-match "world" distribution)
2090                    (setq distribution nil))
2091               (widen)))
2092
2093           (setq news-reply-yank-from (or from "(nobody)"))
2094           (setq news-reply-yank-message-id
2095                 (or message-id "(unknown Message-ID)"))
2096
2097           ;; Gather the "to" addresses out of the follow-to list and remove
2098           ;; them as we go.
2099           (if (and follow-to (listp follow-to))
2100               (while (setq elt (assoc "Newsgroups" follow-to))
2101                 (setq sendto (concat sendto (and sendto ", ") (cdr elt)))
2102                 (setq follow-to (delq elt follow-to))))
2103
2104           ;; Let posting styles be configured.
2105           (gnus-configure-posting-styles)
2106
2107           (news-setup nil subject nil 
2108                       (or sendto 
2109                           (and followup-to
2110                                gnus-use-followup-to
2111                                (or (not (eq gnus-use-followup-to 'ask))
2112                                    (gnus-y-or-n-p 
2113                                     (format
2114                                      "Use Followup-To %s? " followup-to)))
2115                                followup-to)
2116                           newsgroups group "")
2117                       gnus-article-copy)
2118
2119           (make-local-variable 'gnus-article-reply)
2120           (setq gnus-article-reply cur)
2121           (make-local-variable 'gnus-prev-winconf)
2122           (setq gnus-prev-winconf winconf)
2123           (make-local-variable 'gnus-reply-subject)
2124           (setq gnus-reply-subject (mail-header-subject gnus-current-headers))
2125           (make-local-variable 'gnus-in-reply-to)
2126           (setq gnus-in-reply-to message-of)
2127           (when (and followup-to newsgroups)
2128             (make-local-variable 'gnus-newsgroup-followup)
2129             (setq gnus-newsgroup-followup
2130                   (cons newsgroups followup-to)))
2131
2132           (gnus-inews-insert-signature)
2133
2134           (and gnus-post-prepare-function
2135                (gnus-functionp gnus-post-prepare-function)
2136                (funcall gnus-post-prepare-function group))
2137           (run-hooks 'gnus-post-prepare-hook)
2138
2139           (auto-save-mode auto-save-default)
2140           (gnus-inews-modify-mail-mode-map)
2141           (local-set-key "\C-c\C-c" 'gnus-inews-news)
2142
2143           (if (and follow-to (listp follow-to))
2144               (progn
2145                 (goto-char (point-min))
2146                 (and (re-search-forward "^Newsgroups:" nil t)
2147                      (forward-line 1))
2148                 (while follow-to
2149                   (insert (car (car follow-to)) ": " 
2150                           (cdr (car follow-to)) "\n")
2151                   (setq follow-to (cdr follow-to)))))
2152           
2153           ;; If a distribution existed, we use it.
2154           (if distribution
2155               (progn
2156                 (mail-position-on-field "Distribution")
2157                 (insert distribution)))
2158           
2159           (nnheader-insert-references references message-id)
2160
2161           ;; Handle `gnus-auto-mail-to-author'.
2162           ;; Suggested by Daniel Quinlan <quinlan@best.com>.
2163           ;; Revised to respect Reply-To by Ulrik Dickow <dickow@nbi.dk>.
2164           (let ((to (if (if (eq gnus-auto-mail-to-author 'ask)
2165                             (y-or-n-p "Also send mail to author? ")
2166                           gnus-auto-mail-to-author)
2167                         (or (save-excursion
2168                               (set-buffer gnus-article-copy)
2169                               (unless (gnus-group-get-parameter
2170                                        group 'broken-reply-to)
2171                                 (gnus-fetch-field "reply-to")))
2172                             from)))
2173                 (x-mail (save-excursion
2174                           (set-buffer gnus-article-copy)
2175                           (gnus-fetch-field "x-mail-copy-to"))))
2176             ;; Deny sending copy if there's a negative X-Mail-Copy-To
2177             ;; header. 
2178             (if x-mail
2179                 (if (and (string= x-mail "never")
2180                          (not (eq gnus-auto-mail-to-author 'force)))
2181                     (setq to nil)
2182                   (setq to x-mail)))
2183             ;; Insert a To or Cc header.
2184             (if to
2185                 (if (mail-fetch-field "To")
2186                     (progn
2187                       (beginning-of-line)
2188                       (insert "Cc: " to "\n"))
2189                   (mail-position-on-field "To")
2190                   (insert to))))
2191
2192           (gnus-inews-insert-bfcc)
2193           (gnus-inews-insert-gcc)
2194           (gnus-inews-insert-archive-gcc)
2195
2196           ;; Now the headers should be ok, so we do the yanking.
2197           (goto-char (point-min))
2198           (re-search-forward
2199            (concat "^" (regexp-quote mail-header-separator) "$"))
2200           (forward-line 1)
2201           (if (not yank)
2202               (progn
2203                 (gnus-configure-windows 'followup 'force)
2204                 (insert "\n\n")
2205                 (forward-line -2))
2206             (let ((last (point))
2207                   end)
2208               (if (not (listp yank))
2209                   (progn
2210                     (save-excursion
2211                       (mail-yank-original nil))
2212                     (or mail-yank-hooks mail-citation-hook
2213                         (run-hooks 'news-reply-header-hook)))
2214                 (while yank
2215                   (save-window-excursion
2216                     (set-buffer gnus-summary-buffer)
2217                     (gnus-summary-select-article nil nil nil (car yank))
2218                     (gnus-summary-remove-process-mark (car yank)))
2219                   (save-excursion
2220                     (gnus-copy-article-buffer)
2221                     (mail-yank-original nil)
2222                     (setq end (point)))
2223                   (or mail-yank-hooks mail-citation-hook
2224                       (run-hooks 'news-reply-header-hook))
2225                   (goto-char end)
2226                   (setq yank (cdr yank))))
2227               (goto-char last))
2228             (gnus-configure-windows 'followup-yank 'force))
2229         
2230           (make-local-variable 'gnus-article-check-size)
2231           (setq gnus-article-check-size
2232                 (cons (buffer-size) (gnus-article-checksum)))
2233           (gnus-inews-set-point))))))
2234
2235 (defun gnus-message-of (from date)
2236   "Take a FROM and a DATE and return an IN-REPLY-TO."
2237   (when from
2238     (let ((stop-pos 
2239            (string-match "  *at \\|  *@ \\| *(\\| *<" from)))
2240       (concat (if stop-pos (substring from 0 stop-pos) from)
2241               "'s message of " 
2242               (if (or (not date) (string= date ""))
2243                   "(unknown date)" date)))))
2244
2245 (defun gnus-mail-yank-original ()
2246   (interactive)
2247   (save-excursion
2248     (mail-yank-original nil))
2249   (or mail-yank-hooks mail-citation-hook
2250       (run-hooks 'news-reply-header-hook)))
2251
2252 (defun gnus-mail-send-and-exit (&optional dont-send)
2253   "Send the current mail and return to Gnus."
2254   (interactive)
2255   (let* ((reply gnus-article-reply)
2256          (winconf gnus-prev-winconf)
2257          (address-group gnus-add-to-address)
2258          (to-address (and address-group
2259                           (mail-fetch-field "to"))))
2260     (setq gnus-add-to-address nil)
2261     (let ((buffer-file-name nil))
2262       (or dont-send (gnus-mail-send)))
2263     (bury-buffer)
2264     ;; This mail group doesn't have a `to-list', so we add one
2265     ;; here.  Magic!  
2266     (and to-address
2267          (gnus-group-add-parameter 
2268           address-group (cons 'to-list to-address)))
2269     (if (get-buffer gnus-group-buffer)
2270         (progn
2271           (if (gnus-buffer-exists-p (car-safe reply))
2272               (progn
2273                 (set-buffer (car reply))
2274                 (and (cdr reply)
2275                      (gnus-summary-mark-article-as-replied 
2276                       (cdr reply)))))
2277           (and winconf (set-window-configuration winconf))))))
2278
2279 (defun gnus-put-message ()
2280   "Put the current message in some group and return to Gnus."
2281   (interactive)
2282   (let ((reply gnus-article-reply)
2283         (winconf gnus-prev-winconf)
2284         (group gnus-newsgroup-name)
2285         buf)
2286     
2287     (or (and group (not (gnus-group-read-only-p group)))
2288         (setq group (read-string "Put in group: " nil
2289                                  (gnus-writable-groups))))
2290     (and (gnus-gethash group gnus-newsrc-hashtb)
2291          (error "No such group: %s" group))
2292
2293     (save-excursion
2294       (save-restriction
2295         (widen)
2296         (gnus-inews-narrow-to-headers)
2297         (let (gnus-deletable-headers)
2298           (if (eq major-mode 'mail-mode)
2299               (gnus-inews-insert-headers gnus-required-mail-headers)
2300             (gnus-inews-insert-headers)))
2301         (goto-char (point-max))
2302         (insert "Gcc: " group "\n")
2303         (widen)))
2304
2305     (gnus-inews-do-gcc)
2306
2307     (if (get-buffer gnus-group-buffer)
2308         (progn
2309           (if (gnus-buffer-exists-p (car-safe reply))
2310               (progn
2311                 (set-buffer (car reply))
2312                 (and (cdr reply)
2313                      (gnus-summary-mark-article-as-replied 
2314                       (cdr reply)))))
2315           (and winconf (set-window-configuration winconf))))))
2316
2317 (defun gnus-forward-make-subject (buffer)
2318   (save-excursion
2319     (set-buffer buffer)
2320     (concat "[" (if (memq 'mail (assoc (symbol-name 
2321                                         (car (gnus-find-method-for-group 
2322                                               gnus-newsgroup-name)))
2323                                        gnus-valid-select-methods))
2324                     (gnus-fetch-field "From")
2325                   gnus-newsgroup-name)
2326             "] " (or (gnus-fetch-field "Subject") ""))))
2327
2328 (defun gnus-forward-insert-buffer (buffer)
2329   (save-excursion
2330     (save-restriction
2331       ;; Put point where we want it before inserting the forwarded
2332       ;; message. 
2333       (if gnus-signature-before-forwarded-message
2334           (goto-char (point-max))
2335         (goto-char (point-min))
2336         (re-search-forward
2337          (concat "^" (regexp-quote mail-header-separator) "$"))
2338         (forward-line 1))
2339       ;; Narrow to the area we are to insert.
2340       (narrow-to-region (point) (point))
2341       ;; Insert the separators and the forwarded buffer.
2342       (insert gnus-forward-start-separator)
2343       (insert-buffer-substring buffer)
2344       (goto-char (point-max))
2345       (insert gnus-forward-end-separator)
2346       ;; Remove all unwanted headers.
2347       (goto-char (point-min))
2348       (save-restriction
2349         (narrow-to-region (point) (if (search-forward "\n\n" nil t)
2350                                       (1- (point))
2351                                     (point)))
2352         (delete-non-matching-lines gnus-forward-included-headers))
2353       ;; Delete any invisible text.
2354       (goto-char (point-min))
2355       (let (beg)
2356         (while (setq beg (next-single-property-change (point) 'invisible))
2357           (goto-char beg)
2358           (delete-region beg (or (next-single-property-change 
2359                                   (point) 'invisible)
2360                                  (point-max))))))))
2361
2362 (defun gnus-mail-forward (&optional buffer)
2363   "Forward the current message to another user using mail."
2364   (let* ((forward-buffer (or buffer (current-buffer)))
2365          (winconf (current-window-configuration))
2366          (subject (gnus-forward-make-subject forward-buffer)))
2367     (set-buffer (get-buffer-create gnus-mail-buffer))
2368     (if (and (buffer-modified-p)
2369              (> (buffer-size) 0)
2370              (not (gnus-y-or-n-p 
2371                    "Unsent message being composed; erase it? ")))
2372         ()
2373       (erase-buffer)
2374       (gnus-mail-setup 'forward nil subject)
2375       (make-local-variable 'gnus-prev-winconf)
2376       (setq gnus-prev-winconf winconf)
2377       (gnus-forward-insert-buffer forward-buffer)
2378       (goto-char (point-min))
2379       (re-search-forward "^To: ?" nil t)
2380       (gnus-configure-windows 'mail-forward 'force)
2381       ;; You have a chance to arrange the message.
2382       (run-hooks 'gnus-mail-forward-hook)
2383       (run-hooks 'gnus-mail-hook))))
2384
2385 (defun gnus-forward-using-post (&optional buffer)
2386   (save-excursion
2387     (let* ((forward-buffer (or buffer (current-buffer))) 
2388            (subject (gnus-forward-make-subject forward-buffer))
2389            (gnus-newsgroup-name nil))
2390       (gnus-post-news 'post nil nil nil nil subject)
2391       (save-excursion
2392         (gnus-forward-insert-buffer forward-buffer)
2393         ;; You have a chance to arrange the message.
2394         (run-hooks 'gnus-mail-forward-hook)))))
2395
2396 (defun gnus-mail-other-window-using-mail ()
2397   "Compose mail other window using mail."
2398   (let ((winconf (current-window-configuration)))
2399     (mail-other-window nil nil nil nil nil (get-buffer gnus-article-buffer))
2400     (gnus-inews-modify-mail-mode-map)
2401     (make-local-variable 'gnus-prev-winconf)
2402     (setq gnus-prev-winconf winconf)
2403     (run-hooks 'gnus-mail-hook)
2404     (gnus-configure-windows 'summary-mail 'force)))
2405
2406 (defun gnus-article-mail (yank)
2407   "Send a reply to the address near point.
2408 If YANK is non-nil, include the original article."
2409   (interactive "P")
2410   (let ((address 
2411          (buffer-substring
2412           (save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point)))
2413           (save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point))))))
2414     (and address
2415          (progn
2416            (switch-to-buffer gnus-summary-buffer)
2417            (gnus-mail-reply yank address)))))
2418
2419 (defun gnus-bug ()
2420   "Send a bug report to the Gnus maintainers."
2421   (interactive)
2422   (let ((winconf (current-window-configuration)))
2423     (delete-other-windows)
2424     (switch-to-buffer "*Gnus Help Bug*")
2425     (erase-buffer)
2426     (insert gnus-bug-message)
2427     (goto-char (point-min))
2428     (pop-to-buffer "*Gnus Bug*")
2429     (erase-buffer)
2430     (mail-mode)
2431     (mail-setup gnus-maintainer nil nil nil nil nil)
2432     (auto-save-mode auto-save-default)
2433     (make-local-variable 'gnus-prev-winconf)
2434     (setq gnus-prev-winconf winconf)
2435     (gnus-inews-modify-mail-mode-map)
2436     (local-set-key "\C-c\C-c" 'gnus-bug-mail-send-and-exit)
2437     (goto-char (point-min))
2438     (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
2439     (forward-line 1)
2440     (insert (gnus-version) "\n")
2441     (insert (emacs-version))
2442     (insert "\n\n\n\n\n")
2443     (gnus-debug)
2444     (goto-char (point-min))
2445     (search-forward "Subject: " nil t)
2446     (message "")))
2447
2448 (defun gnus-bug-mail-send-and-exit ()
2449   "Send the bug message and exit."
2450   (interactive)
2451   (and (get-buffer "*Gnus Help Bug*")
2452        (kill-buffer "*Gnus Help Bug*"))
2453   (gnus-mail-send-and-exit))
2454
2455 (defun gnus-debug ()
2456   "Attemps to go through the Gnus source file and report what variables have been changed.
2457 The source file has to be in the Emacs load path."
2458   (interactive)
2459   (let ((files '("gnus.el" "gnus-msg.el" "gnus-score.el" "nnmail.el"))
2460         file dirs expr olist sym)
2461     (message "Please wait while we snoop your variables...")
2462     (sit-for 0)
2463     (save-excursion
2464       (set-buffer (get-buffer-create " *gnus bug info*"))
2465       (buffer-disable-undo (current-buffer))
2466       (while files
2467         (erase-buffer)
2468         (setq dirs load-path)
2469         (while dirs
2470           (if (or (not (car dirs))
2471                   (not (stringp (car dirs)))
2472                   (not (file-exists-p 
2473                         (setq file (concat (file-name-as-directory 
2474                                             (car dirs)) (car files))))))
2475               (setq dirs (cdr dirs))
2476             (setq dirs nil)
2477             (insert-file-contents file)
2478             (goto-char (point-min))
2479             (if (not (re-search-forward "^;;* *Internal variables" nil t))
2480                 (message "Malformed sources in file %s" file)
2481               (narrow-to-region (point-min) (point))
2482               (goto-char (point-min))
2483               (while (setq expr (condition-case () 
2484                                     (read (current-buffer)) (error nil)))
2485                 (condition-case ()
2486                     (and (eq (car expr) 'defvar)
2487                          (stringp (nth 3 expr))
2488                          (or (not (boundp (nth 1 expr)))
2489                              (not (equal (eval (nth 2 expr))
2490                                          (symbol-value (nth 1 expr)))))
2491                          (setq olist (cons (nth 1 expr) olist)))
2492                   (error nil))))))
2493         (setq files (cdr files)))
2494       (kill-buffer (current-buffer)))
2495     (when (setq olist (nreverse olist))
2496       (insert "------------------ Environment follows ------------------\n\n"))
2497     (while olist
2498       (if (boundp (car olist))
2499           (insert "(setq " (symbol-name (car olist)) 
2500                   (if (or (consp (setq sym (symbol-value (car olist))))
2501                           (and (symbolp sym)
2502                                (not (or (eq sym nil)
2503                                         (eq sym t)))))
2504                       " '" " ")
2505                   (prin1-to-string (symbol-value (car olist))) ")\n")
2506         (insert ";; (makeunbound '" (symbol-name (car olist)) ")\n"))
2507       (setq olist (cdr olist)))
2508     (insert "\n\n")
2509     ;; Remove any null chars - they seem to cause trouble for some
2510     ;; mailers. (Byte-compiled output from the stuff above.) 
2511     (goto-char (point-min))
2512     (while (re-search-forward "[\000\200]" nil t)
2513       (replace-match "" t t))))
2514
2515
2516 ;;; Treatment of rejected articles.
2517
2518
2519 ;;; Bounced mail.
2520
2521 (defun gnus-summary-resend-bounced-mail (fetch)
2522   "Re-mail the current message.
2523 This only makes sense if the current message is a bounce message than
2524 contains some mail you have written which has been bounced back to
2525 you.
2526 If FETCH, try to fetch the article that this is a reply to, if indeed
2527 this is a reply."
2528   (interactive "P")
2529   (gnus-summary-select-article t)
2530   ;; Create a mail buffer.
2531   (gnus-new-mail)
2532   (erase-buffer)
2533   (insert-buffer-substring gnus-article-buffer)
2534   (goto-char (point-min))
2535   (search-forward "\n\n")
2536   ;; We remove everything before the bounced mail.
2537   (delete-region 
2538    (point-min)
2539    (if (re-search-forward "[^ \t]*:" nil t)
2540        (match-beginning 0)
2541      (point)))
2542   (let (references)
2543     (save-excursion
2544       (save-restriction
2545         (nnheader-narrow-to-headers)
2546         (nnheader-remove-header gnus-bounced-headers-junk t)
2547         (setq references (mail-fetch-field "references"))
2548         (goto-char (point-max))
2549         (insert mail-header-separator)))
2550     ;; If there are references, we fetch the article we answered to.  
2551     (and fetch 
2552          references
2553          (string-match "\\(<[^]+>\\)[ \t]*$" references)
2554          (gnus-summary-refer-article 
2555           (substring references (match-beginning 1) (match-end 1)))
2556          (progn
2557            (gnus-summary-show-all-headers)
2558            (gnus-configure-windows 'compose-bounce))))
2559   (goto-char (point-min)))
2560
2561 ;;; Sending mail.
2562
2563 (defun gnus-mail-send ()
2564   "Send the current buffer as mail.
2565 Headers will be generated before sending."
2566   (interactive)
2567   (save-excursion
2568     (save-restriction
2569       (widen)
2570       (gnus-inews-narrow-to-headers)
2571       (gnus-inews-insert-headers gnus-required-mail-headers)
2572       (gnus-inews-remove-empty-headers)))
2573   (widen)
2574   ;; Remove the header separator.
2575   (goto-char (point-min))
2576   (and (re-search-forward
2577         (concat "^" (regexp-quote mail-header-separator) "$") nil t)
2578        (replace-match "" t t))
2579   ;; Run final inews hooks.  This hook may do FCC.
2580   (run-hooks 'gnus-inews-article-hook)
2581   (gnus-inews-do-gcc)
2582   (nnheader-narrow-to-headers)
2583   (nnheader-remove-header "^[gf]cc:" t)
2584   (widen)
2585   (goto-char (point-min))
2586   (search-forward "\n\n")
2587   (forward-char -1)
2588   (insert mail-header-separator)
2589   (mail-send)
2590   (run-hooks 'gnus-message-sent-hook))
2591
2592 (defun gnus-inews-modify-mail-mode-map ()
2593   (use-local-map (copy-keymap (current-local-map)))
2594   (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit)
2595   (local-set-key "\C-c\C-p" 'gnus-put-message)
2596   (local-set-key "\C-c\M-d" 'gnus-dissociate-buffer-from-draft)
2597   (local-set-key "\C-c\C-d" 'gnus-associate-buffer-with-draft))
2598
2599 (defun gnus-mail-setup (type &optional to subject in-reply-to cc
2600                              replybuffer actions)
2601   ;; Let posting styles be configured.
2602   (gnus-configure-posting-styles)
2603   (funcall
2604    (cond
2605     ((or 
2606       (eq gnus-mail-method 'mh)
2607       (and (or (eq type 'reply) (eq type 'followup))
2608            (eq gnus-mail-reply-method 'gnus-mail-reply-using-mhe))
2609       (and (eq type 'forward)
2610            (eq gnus-mail-forward-method 'gnus-mail-forward-using-mhe))
2611       (and (eq type 'new) 
2612            (eq gnus-mail-other-window-method 
2613                'gnus-mail-other-window-using-mhe)))
2614      'gnus-mh-mail-setup)
2615     ((or 
2616       (eq gnus-mail-method 'vm)
2617       (and (or (eq type 'reply) (eq type 'followup)) 
2618            (eq gnus-mail-reply-method 'gnus-mail-reply-using-vm))
2619       (and (eq type 'forward)
2620            (eq gnus-mail-forward-method 'gnus-mail-forward-using-vm))
2621       (and (eq type 'new) 
2622            (eq gnus-mail-other-window-method 
2623                'gnus-mail-other-window-using-vm)))
2624      'gnus-vm-mail-setup)
2625     (t 'gnus-sendmail-mail-setup))
2626    to subject in-reply-to cc replybuffer actions)
2627   ;; Associate this mail buffer with the draft group.
2628   (gnus-enter-buffer-into-draft))
2629
2630 (defun gnus-sendmail-mail-setup (to subject in-reply-to cc replybuffer actions)
2631   (mail-mode)
2632   (mail-setup to subject nil cc replybuffer actions)
2633   (gnus-inews-set-point)
2634   (gnus-inews-modify-mail-mode-map))
2635   
2636 ;;; Gcc handling.
2637
2638 ;; Do Gcc handling, which copied the message over to some group. 
2639 (defun gnus-inews-do-gcc (&optional gcc)
2640   (save-excursion
2641     (save-restriction
2642       (nnheader-narrow-to-headers)
2643       (let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
2644             (cur (current-buffer))
2645             end groups group method)
2646         (when gcc
2647           (nnheader-remove-header "gcc")
2648           (widen)
2649           (setq groups (gnus-tokenize-header gcc " "))
2650           ;; Copy the article over to some group(s).
2651           (while (setq group (pop groups))
2652             (gnus-check-server 
2653              (setq method
2654                    (cond ((and (null (gnus-get-info group))
2655                                (eq (car gnus-message-archive-method)
2656                                    (car (gnus-group-method-name group))))
2657                           ;; If the group doesn't exist, we assume
2658                           ;; it's an archive group...
2659                           gnus-message-archive-method)
2660                          (t (gnus-find-method-for-group group)))))
2661             (unless (gnus-request-group group t method)
2662               (gnus-request-create-group group method))
2663             (gnus-check-server method)
2664             (save-excursion
2665               (nnheader-set-temp-buffer " *acc*")
2666               (insert-buffer-substring cur)
2667               (unless (condition-case ()
2668                           (gnus-request-accept-article group t method)
2669                         (error nil))
2670                 (gnus-message 1 "Couldn't store article in group %s: %s" 
2671                               group (gnus-status-message method))
2672                 (sit-for 2))
2673               (kill-buffer (current-buffer)))))))))
2674
2675 (defun gnus-inews-insert-bfcc ()
2676   "Insert Bcc and Fcc headers."
2677   (save-excursion
2678     ;; Handle author copy using BCC field.
2679     (when (and gnus-mail-self-blind
2680                (not (mail-fetch-field "bcc")))
2681       (mail-position-on-field "Bcc")
2682       (insert (if (stringp gnus-mail-self-blind)
2683                   gnus-mail-self-blind
2684                 (user-login-name))))
2685     ;; Handle author copy using FCC field.
2686     (when gnus-author-copy
2687       (mail-position-on-field "Fcc")
2688       (insert gnus-author-copy))))
2689
2690 (defun gnus-inews-insert-gcc ()
2691   "Insert Gcc headers based on `gnus-outgoing-message-group'."
2692   (save-excursion
2693     (save-restriction
2694       (gnus-inews-narrow-to-headers)
2695       (let* ((group gnus-outgoing-message-group)
2696              (gcc (cond 
2697                    ((gnus-functionp group)
2698                     (funcall group))
2699                    ((or (stringp group) (list group))
2700                     group))))
2701         (when gcc
2702           (insert "Gcc: "
2703                   (if (stringp gcc) gcc
2704                     (mapconcat 'identity gcc " "))
2705                   "\n"))))))
2706
2707 (defun gnus-inews-insert-archive-gcc ()
2708   "Insert the Gcc to say where the article is to be archived."
2709   (let* ((var gnus-message-archive-group)
2710          result
2711          (groups
2712           (cond 
2713            ((stringp var)
2714             ;; Just a single group.
2715             (list var))
2716            ((null var)
2717             ;; We don't want this.
2718             nil)
2719            ((and (listp var) (stringp (car var)))
2720             ;; A list of groups.
2721             var)
2722            ((gnus-functionp var)
2723             ;; A function.
2724             (funcall var gnus-newsgroup-name))
2725            (t
2726             ;; An alist of regexps/functions/forms.
2727             (while (and var
2728                         (not
2729                          (setq result
2730                                (cond 
2731                                 ((stringp (caar var))
2732                                  ;; Regexp.
2733                                  (when (string-match (caar var)
2734                                                      gnus-newsgroup-name)
2735                                    (cdar var)))
2736                                 ((gnus-functionp (car var))
2737                                  ;; Function.
2738                                  (funcall (car var) gnus-newsgroup-name))
2739                                 (t
2740                                  (eval (car var)))))))
2741               (setq var (cdr var)))
2742             result))))
2743     (when groups
2744       (when (stringp groups)
2745         (setq groups (list groups)))
2746       (save-excursion
2747         (save-restriction
2748           (gnus-inews-narrow-to-headers)
2749           (goto-char (point-max))
2750           (insert "Gcc: ")
2751           (while groups
2752             (insert (gnus-group-prefixed-name 
2753                      (pop groups) gnus-message-archive-method))
2754             (insert " "))
2755           (insert "\n"))))))
2756
2757 ;;; Handling rejected (and postponed) news.
2758
2759 (defun gnus-draft-group ()
2760   "Return the name of the draft group."
2761   (gnus-group-prefixed-name 
2762    (file-name-nondirectory gnus-draft-group-directory)
2763    (list 'nndraft gnus-draft-group-directory)))
2764
2765 (defun gnus-make-draft-group ()
2766   "Make the draft group or die trying."
2767   (let* ((method (` (nndraft "private" 
2768                              (nndraft-directory 
2769                               (, gnus-draft-group-directory)))))
2770          (group (gnus-draft-group)))
2771     (or (gnus-gethash group gnus-newsrc-hashtb)
2772         (gnus-group-make-group (gnus-group-real-name group) method)
2773         (error "Can't create the draft group"))
2774     (gnus-check-server method)
2775     group))
2776
2777 (defun gnus-associate-buffer-with-draft (&optional generate silent)
2778   "Enter the current buffer into the draft group."
2779   (interactive)
2780   (when (gnus-request-accept-article (gnus-make-draft-group) t)
2781     (unless silent
2782       ;; This function does the proper marking of articles.
2783       (gnus-mail-send-and-exit 'dont-send))
2784     (set-buffer-modified-p nil)))
2785
2786 (defun gnus-enter-buffer-into-draft ()
2787   (when gnus-use-draft
2788     (save-excursion
2789       ;; Make sure the draft group exists.
2790       (gnus-make-draft-group)
2791       ;; Associate the buffer with the draft group.
2792       (let ((article (gnus-request-associate-buffer (gnus-draft-group))))
2793         ;; Arrange for deletion of the draft after successful sending.
2794         (make-local-variable 'gnus-message-sent-hook)
2795         (setq gnus-message-sent-hook
2796               (list
2797                `(lambda ()
2798                   (let ((gnus-verbose-backends nil))
2799                     (gnus-request-expire-articles 
2800                      (quote ,(list article))
2801                      ,(gnus-draft-group) t)))))))))
2802
2803 (defun gnus-dissociate-buffer-from-draft ()
2804   "Disable auto-saving and association to the draft group of the current buffer."
2805   (interactive)
2806   (run-hooks gnus-message-sent-hook)
2807   (setq buffer-file-name nil)
2808   (setq buffer-auto-save-file-name nil))
2809
2810 (defun gnus-summary-send-draft ()
2811   "Enter a mail/post buffer to edit and send the draft."
2812   (interactive)
2813   (gnus-set-global-variables)
2814   (unless (equal gnus-newsgroup-name (gnus-draft-group))
2815     (error "This function can only be used in the draft buffer"))
2816   (let (buf point)
2817     (if (not (setq buf (gnus-request-restore-buffer 
2818                         (gnus-summary-article-number) gnus-newsgroup-name)))
2819         (error "Couldn't restore the article")
2820       (setq point (point))
2821       (switch-to-buffer buf)
2822       (gnus-inews-modify-mail-mode-map)
2823       (when (eq major-mode 'news-reply-mode)
2824         (local-set-key "\C-c\C-c" 'gnus-inews-news))
2825       (gnus-enter-buffer-into-draft) 
2826       ;; Insert the separator.
2827       (goto-char (point-min))
2828       (search-forward "\n\n")
2829       (forward-char -1)
2830       (insert mail-header-separator)
2831       ;; Configure windows.
2832       (let ((gnus-draft-buffer (current-buffer)))
2833         (gnus-configure-windows 'draft)
2834         (goto-char (point))))))
2835   
2836 (defun gnus-configure-posting-styles ()
2837   "Configure posting styles according to `gnus-posting-styles'."
2838   (let ((styles gnus-posting-styles)
2839         (gnus-newsgroup-name (or gnus-newsgroup-name ""))
2840         style match variable attribute value value-value)
2841     ;; Go through all styles and look for matches.
2842     (while styles
2843       (setq style (pop styles)
2844             match (pop style))
2845       (when (cond ((stringp match)
2846                    ;; Regexp string match on the group name.
2847                    (string-match match gnus-newsgroup-name))
2848                   ((or (symbolp match)
2849                        (gnus-functionp match))
2850                    (cond ((gnus-functionp match)
2851                           ;; Function to be called.
2852                           (funcall match))
2853                          ((boundp match)
2854                           ;; Variable to be checked.
2855                           (symbol-value match))))
2856                   ((listp match)
2857                    ;; This is a form to be evaled.
2858                    (eval match)))
2859         ;; We have a match, so we set the variables.
2860         (while style
2861           (setq attribute (pop style)
2862                 value (cdr attribute))
2863           ;; We find the variable that is to be modified.
2864           (if (and (not (stringp (car attribute)))
2865                    (not (setq variable (cdr (assq (car attribute) 
2866                                                   gnus-posting-style-alist)))))
2867               (message "Couldn't find attribute %s" (car attribute))
2868             ;; We set the variable.
2869             (setq value-value
2870                   (cond ((stringp value)
2871                          value)
2872                         ((or (symbolp value)
2873                              (gnus-functionp value))
2874                          (cond ((gnus-functionp value)
2875                                 (funcall value))
2876                                ((boundp value)
2877                                 (symbol-value value))))
2878                         ((listp value)
2879                          (eval value))))
2880             (if variable
2881                 (progn
2882                   ;; This is an ordinary variable.
2883                   (make-local-variable variable)
2884                   (set variable value-value))
2885               ;; This is a header to be added to the headers when
2886               ;; posting. 
2887               (when value-value
2888                 (make-local-variable gnus-required-headers)
2889                 (make-local-variable gnus-required-mail-headers)
2890                 (push (cons (car attribute) value-value) 
2891                       gnus-required-headers)
2892                 (push (cons (car attribute) value-value) 
2893                       gnus-required-mail-headers)))))))))
2894
2895 (defun gnus-inews-set-point ()
2896   "Move point to where the user probably wants to find it."
2897   (gnus-inews-narrow-to-headers)
2898   (cond 
2899    ((re-search-forward "^[^:]+:[ \t]*$" nil t)
2900     (search-backward ":" )
2901     (widen)
2902     (forward-char 2))
2903    (t
2904     (goto-char (point-max))
2905     (widen)
2906     (forward-line 1)
2907     (unless (looking-at "$")
2908       (forward-line 2)))))
2909   
2910 ;;; Allow redefinition of functions.
2911
2912 (gnus-ems-redefine)
2913
2914 (provide 'gnus-msg)
2915
2916 ;;; gnus-msg.el ends here