*** empty log message ***
[gnus] / lisp / gnus-msg.el
1 ;;; gnus-msg.el --- mail and post interface for Gnus
2 ;; Copyright (C) 1995 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 (require 'rmail)
32
33 (defvar gnus-organization-file "/usr/lib/news/organization"
34   "*Local news organization file.")
35
36 (defvar gnus-prepare-article-hook (list 'gnus-inews-insert-signature)
37   "*A hook called after preparing body, but before preparing header headers.
38 The default hook (`gnus-inews-insert-signature') inserts a signature
39 file specified by the variable `gnus-signature-file'.")
40
41 (defvar gnus-post-prepare-function nil
42   "*Function that is run after a post buffer has been prepared.
43 It is called with the name of the newsgroup that is posted to. It
44 might be used, for instance, for inserting signatures based on the
45 newsgroup name. (In that case, `gnus-signature-file' and
46 `mail-signature' should both be set to nil).")
47
48 (defvar gnus-post-prepare-hook nil
49   "*Hook that is run after a post buffer has been prepared.
50 If you want to insert the signature, you might put
51 `gnus-inews-insert-signature' in this hook.")
52
53 (defvar gnus-use-followup-to t
54   "*Specifies what to do with Followup-To header.
55 If nil, ignore the header. If it is t, use its value, but ignore 
56 `poster'.  If it is the symbol `ask', query the user before posting.
57 If it is the symbol `use', always use the value.") 
58
59 (defvar gnus-followup-to-function nil
60   "*A variable that contains a function that returns a followup address.
61 The function will be called in the buffer of the article that is being
62 followed up. The buffer will be narrowed to the headers of the
63 article. To pick header headers, one might use `mail-fetch-field'.  The
64 function will be called with the name of the current newsgroup as the
65 argument.
66
67 Here's an example `gnus-followup-to-function':
68
69 (setq gnus-followup-to-function
70       (lambda (group)
71         (cond ((string= group \"mail.list\")
72                (or (mail-fetch-field \"sender\") 
73                    (mail-fetch-field \"from\")))
74               (t
75                (or (mail-fetch-field \"reply-to\") 
76                    (mail-fetch-field \"from\"))))))")
77
78 (defvar gnus-reply-to-function nil
79   "*A variable that contains a function that returns a reply address.
80 See the `gnus-followup-to-function' variable for an explanation of how
81 this variable is used.
82
83 This function should return a string that will be used to fill in the
84 header.  This function may also return a list.  In that case, every
85 list element should be a cons where the first car should be a string
86 with the header name, and the cdr should be a string with the header
87 value.")
88
89 (defvar gnus-author-copy (getenv "AUTHORCOPY")
90   "*Save outgoing articles in this file.
91 Initialized from the AUTHORCOPY environment variable.
92
93 If this variable begins with the character \"|\", outgoing articles
94 will be piped to the named program. It is possible to save an article
95 in an MH folder as follows:
96
97 \(setq gnus-author-copy \"|/usr/local/lib/mh/rcvstore +Article\")
98
99 If the first character is not a pipe, articles are saved using the
100 function specified by the `gnus-author-copy-saver' variable.")
101
102 (defvar gnus-mail-self-blind nil
103   "*Non-nil means insert a BCC header in all outgoing articles.
104 This will result in having a copy of the article mailed to yourself.
105 The BCC header is inserted when the post buffer is initialized, so you
106 can remove or alter the BCC header to override the default.")
107
108 (defvar gnus-author-copy-saver (function rmail-output)
109   "*A function called to save outgoing articles.
110 This function will be called with the same of the file to store the
111 article in. The default function is `rmail-output' which saves in Unix
112 mailbox format.")
113
114 (defvar gnus-outgoing-message-group nil
115   "*All outgoing messages will be put in this group.
116 If you want to store all your outgoing mail and articles in the group
117 \"nnml:archive\", you set this variable to that value. This variable
118 can also be a list of group names. 
119
120 If you want to have greater control over what group to put each
121 message in, you can set this variable to a function that checks the
122 current newsgroup name and then returns a suitable group name (or list
123 of names).")
124
125 (defvar gnus-draft-group-directory 
126   (expand-file-name
127    (concat (file-name-as-directory gnus-article-save-directory)
128            "drafts"))
129   "*The directory where draft messages will be stored.")
130
131 (defvar gnus-user-login-name nil
132   "*The login name of the user.
133 Got from the function `user-login-name' if undefined.")
134
135 (defvar gnus-user-full-name nil
136   "*The full name of the user.
137 Got from the NAME environment variable if undefined.")
138
139 (defvar gnus-user-from-line nil
140   "*Your full, complete e-mail address.  
141 Overrides the other Gnus variables if it is non-nil.
142
143 Here are two example values of this variable:
144
145  \"Lars Magne Ingebrigtsen <larsi@ifi.uio.no>\"
146
147 and
148
149  \"larsi@ifi.uio.no (Lars Magne Ingebrigtsen)\"
150
151 The first version is recommended, but the name has to be quoted if it
152 contains non-alphanumerical characters.")
153
154 (defvar gnus-signature-file "~/.signature"
155   "*Your signature file.
156 If the variable is a string that doesn't correspond to a file, the
157 string itself is inserted.")
158
159 (defvar gnus-signature-function nil
160   "*A function that should return a signature file name.
161 The function will be called with the name of the newsgroup being
162 posted to.
163 If the function returns a string that doesn't correspond to a file, the
164 string itself is inserted.
165 If the function returns nil, the `gnus-signature-file' variable will
166 be used instead.")
167
168 (defvar gnus-required-headers
169   '(From Date Newsgroups Subject Message-ID Organization Lines X-Newsreader)
170   "*Headers to be generated or prompted for when posting an article.
171 RFC977 and RFC1036 require From, Date, Newsgroups, Subject,
172 Message-ID.  Organization, Lines and X-Newsreader are optional.  If
173 you want Gnus not to insert some header, remove it from this list.")
174
175 (defvar gnus-required-mail-headers 
176   '(From Date To Subject Message-ID Organization Lines)
177   "*Headers to be generated or prompted for when mailing a message.
178 RFC822 required that From, Date, To, Subject and Message-ID be
179 included.  Organization, Lines and X-Mailer are optional.")
180
181 (defvar gnus-deletable-headers '(Message-ID Date)
182   "*Headers to be deleted if they already exists and were generated by Gnus previously.")
183
184 (defvar gnus-removable-headers '(NNTP-Posting-Host Bcc Xref)
185   "*Headers to be removed unconditionally before posting.")
186
187 (defvar gnus-check-before-posting 
188   '(subject-cmsg multiple-headers sendsys message-id from
189                  long-lines control-chars size new-text
190                  signature approved)
191   "In non-nil, Gnus will attempt to run some checks on outgoing posts.
192 If this variable is t, Gnus will check everything it can.  If it is a
193 list, then those elements in that list will be checked.")
194
195 (defvar gnus-delete-supersedes-headers
196   "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Supersedes:"
197   "*Header lines matching this regexp will be deleted before posting.
198 It's best to delete old Path and Date headers before psoting to avoid
199 any confusion.")
200
201 (defvar gnus-auto-mail-to-author nil
202   "*If non-nil, mail the authors of articles a copy of your follow-ups.
203 If this variable is `ask', the user will be prompted for whether to
204 mail a copy.  The string given by `gnus-mail-courtesy-message' will be
205 inserted at the beginning of the mail copy.
206
207 Mail is sent using the function specified by the
208 `gnus-mail-send-method' variable.")
209
210 ;; Added by Ethan Bradford <ethanb@ptolemy.astro.washington.edu>.
211 (defvar gnus-mail-courtesy-message
212   "The following message is a courtesy copy of an article\nthat has been posted as well.\n\n"
213   "*This is inserted at the start of a mailed copy of a posted message.
214 If this variable is nil, no such courtesy message will be added.")
215
216 (defvar gnus-mail-reply-method (function gnus-mail-reply-using-mail)
217   "*Function to compose a reply.
218 Three pre-made functions are `gnus-mail-reply-using-mail' (sendmail);
219 `gnus-mail-reply-using-mhe' (MH-E); and `gnus-mail-reply-using-vm'.")
220
221 (defvar gnus-mail-forward-method (function gnus-mail-forward-using-mail)
222   "*Function to forward the current message to another user.
223 Three pre-made functions are `gnus-mail-forward-using-mail' (sendmail);
224 `gnus-mail-forward-using-mhe' (MH-E); and `gnus-mail-forward-using-vm'.") 
225
226 (defvar gnus-mail-other-window-method 'gnus-mail-other-window-using-mail
227   "*Function to compose mail in the other window.
228 Three pre-made functions are `gnus-mail-other-window-using-mail'
229 (sendmail); `gnus-mail-other-window-using-mhe' (MH-E); and
230 `gnus-mail-other-window-using-vm'.")
231
232 (defvar gnus-mail-send-method send-mail-function
233   "*Function to mail a message which is also being posted as an article.
234 The message must have To or Cc header.  The default is copied from
235 the variable `send-mail-function'.")
236
237 (defvar gnus-inews-article-function 'gnus-inews-article
238   "*Function to post an article.")
239
240 (defvar gnus-bounced-headers-junk "^\\(Received\\):"
241   "*Regexp that matches headers to be removed in resent bounced mail.")
242
243 (defvar gnus-inews-article-hook (list 'gnus-inews-do-fcc)
244   "*A hook called before finally posting an article.
245 The default hook (`gnus-inews-do-fcc') does FCC processing (ie. saves
246 the article to a file).")
247
248 (defvar gnus-inews-article-header-hook nil
249   "*A hook called after inserting the headers in an article to be posted.
250 The hook is called from the *post-news* buffer, narrowed to the
251 headers.")
252
253 (defvar gnus-mail-hook nil
254   "*A hook called as the last thing after setting up a mail buffer.")
255
256 (defvar gnus-message-sent-hook nil
257   "*A hook run after an article has been sent (or attempted sent).")
258
259 ;;; Internal variables.
260
261 (defvar gnus-post-news-buffer "*post-news*")
262 (defvar gnus-mail-buffer "*mail*")
263 (defvar gnus-summary-send-map nil)
264 (defvar gnus-article-copy nil)
265 (defvar gnus-reply-subject nil)
266
267 (eval-and-compile
268   (autoload 'gnus-uu-post-news "gnus-uu" nil t)
269   (autoload 'news-setup "rnewspost")
270   (autoload 'news-mode "rnewspost"))
271
272 \f
273 ;;;
274 ;;; Gnus Posting Functions
275 ;;;
276
277 (define-prefix-command 'gnus-summary-send-map)
278 (define-key gnus-summary-mode-map "S" 'gnus-summary-send-map)
279 (define-key gnus-summary-send-map "p" 'gnus-summary-post-news)
280 (define-key gnus-summary-send-map "f" 'gnus-summary-followup)
281 (define-key gnus-summary-send-map "F" 'gnus-summary-followup-with-original)
282 (define-key gnus-summary-send-map "b" 'gnus-summary-followup-and-reply)
283 (define-key gnus-summary-send-map "B" 'gnus-summary-followup-and-reply-with-original)
284 (define-key gnus-summary-send-map "c" 'gnus-summary-cancel-article)
285 (define-key gnus-summary-send-map "s" 'gnus-summary-supersede-article)
286 (define-key gnus-summary-send-map "r" 'gnus-summary-reply)
287 (define-key gnus-summary-send-map "R" 'gnus-summary-reply-with-original)
288 (define-key gnus-summary-send-map "m" 'gnus-summary-mail-other-window)
289 (define-key gnus-summary-send-map "Db" 'gnus-summary-resend-bounced-mail)
290 (define-key gnus-summary-send-map "Dc" 'gnus-summary-send-draft)
291 (define-key gnus-summary-send-map "u" 'gnus-uu-post-news)
292 (define-key gnus-summary-send-map "om" 'gnus-summary-mail-forward)
293 (define-key gnus-summary-send-map "op" 'gnus-summary-post-forward)
294 (define-key gnus-summary-send-map "Om" 'gnus-uu-digest-mail-forward)
295 (define-key gnus-summary-send-map "Op" 'gnus-uu-digest-post-forward)
296
297 ;;; Internal functions.
298
299 (defun gnus-number-base36 (num len)
300   (if (if (< len 0) (<= num 0) (= len 0))
301       ""
302     (concat (gnus-number-base36 (/ num 36) (1- len))
303             (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210"
304                                   (% num 36))))))
305
306 ;;; Post news commands of Gnus group mode and summary mode
307
308 (defun gnus-group-mail ()
309   "Start composing a mail."
310   (interactive)
311   (gnus-new-mail))
312
313 (defun gnus-group-post-news ()
314   "Post an article."
315   (interactive)
316   (let ((gnus-newsgroup-name nil))
317     (gnus-post-news 'post nil nil gnus-article-buffer)))
318
319 (defun gnus-summary-post-news ()
320   "Post an article."
321   (interactive)
322   (gnus-set-global-variables)
323   (gnus-post-news 'post gnus-newsgroup-name))
324
325 (defun gnus-summary-followup (yank &optional yank-articles)
326   "Compose a followup to an article.
327 If prefix argument YANK is non-nil, original article is yanked automatically."
328   (interactive "P")
329   (gnus-set-global-variables)
330   (if yank-articles (gnus-summary-goto-subject (car yank-articles)))
331   (save-window-excursion
332     (gnus-summary-select-article))
333   (let ((headers (gnus-summary-article-header (gnus-summary-article-number)))
334         (gnus-newsgroup-name gnus-newsgroup-name))
335     ;; Check Followup-To: poster.
336     (set-buffer gnus-article-buffer)
337     (if (and gnus-use-followup-to
338              (string-equal "poster" (gnus-fetch-field "followup-to"))
339              (or (not (memq gnus-use-followup-to '(t ask)))
340                  (not (gnus-y-or-n-p 
341                        "Do you want to ignore `Followup-To: poster'? "))))
342         ;; Mail to the poster. 
343         (gnus-summary-reply yank)
344       (gnus-post-news nil gnus-newsgroup-name
345                       headers gnus-article-buffer 
346                       (or yank-articles (not (not yank)))))))
347
348 (defun gnus-summary-followup-with-original (n)
349   "Compose a followup to an article and include the original article."
350   (interactive "P")
351   (gnus-summary-followup t (gnus-summary-work-articles n)))
352
353 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
354 (defun gnus-summary-followup-and-reply (yank &optional yank-articles)
355   "Compose a followup and do an auto mail to author."
356   (interactive "P")
357   (gnus-set-global-variables)
358   (let ((gnus-auto-mail-to-author t))
359     (gnus-summary-followup yank yank-articles)))
360
361 (defun gnus-summary-followup-and-reply-with-original (n)
362   "Compose a followup, include the original, and do an auto mail to author."
363   (interactive "P")
364   (gnus-summary-followup-and-reply t (gnus-summary-work-articles n)))
365
366 (defun gnus-summary-cancel-article (n)
367   "Cancel an article you posted."
368   (interactive "P")
369   (gnus-set-global-variables)
370   (let ((articles (gnus-summary-work-articles n)))
371     (while articles
372       (gnus-summary-select-article t nil nil (car articles))
373       (and (gnus-eval-in-buffer-window gnus-article-buffer (gnus-cancel-news))
374            (gnus-summary-mark-as-read (car articles) gnus-canceled-mark))
375       (gnus-summary-remove-process-mark (car articles))
376       (gnus-article-hide-headers-if-wanted)
377       (setq articles (cdr articles)))))
378
379 (defun gnus-summary-supersede-article ()
380   "Compose an article that will supersede a previous article.
381 This is done simply by taking the old article and adding a Supersedes
382 header line with the old Message-ID."
383   (interactive)
384   (gnus-set-global-variables)
385   (gnus-summary-select-article t)
386   (if (not
387        (string-equal
388         (downcase (mail-strip-quoted-names 
389                    (mail-header-from gnus-current-headers)))
390         (downcase (mail-strip-quoted-names (gnus-inews-user-name)))))
391       (error "This article is not yours."))
392   (save-excursion
393     (set-buffer gnus-article-buffer)
394     (let ((buffer-read-only nil))
395       (goto-char (point-min))
396       (search-forward "\n\n" nil t)
397       (if (not (re-search-backward "^Message-ID: " nil t))
398           (error "No Message-ID in this article"))))
399   (if (gnus-post-news 'post gnus-newsgroup-name)
400       (progn
401         (erase-buffer)
402         (insert-buffer gnus-article-buffer)
403         (if (search-forward "\n\n" nil t)
404             (forward-char -1)
405           (goto-char (point-max)))
406         (narrow-to-region (point-min) (point))
407         (goto-char (point-min))
408         (and gnus-delete-supersedes-headers
409              (delete-matching-lines gnus-delete-supersedes-headers))
410         (goto-char (point-min))
411         (if (not (re-search-forward "^Message-ID: " nil t))
412             (error "No Message-ID in this article")
413           (replace-match "Supersedes: " t t))
414         (goto-char (point-max))
415         (insert mail-header-separator)
416         (widen)
417         (forward-line 1))))
418
419 \f
420 ;;;###autoload
421 (defalias 'sendnews 'gnus-post-news)
422
423 ;;;###autoload
424 (defalias 'postnews 'gnus-post-news)
425
426 (defun gnus-copy-article-buffer (&optional article-buffer)
427   ;; make a copy of the article buffer with all text properties removed
428   ;; this copy is in the buffer gnus-article-copy.
429   ;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used
430   ;; this buffer should be passed to all mail/news reply/post routines.
431   (setq gnus-article-copy (get-buffer-create " *gnus article copy*"))
432   (buffer-disable-undo gnus-article-copy)
433   (or (memq gnus-article-copy gnus-buffer-list)
434       (setq gnus-buffer-list (cons gnus-article-copy gnus-buffer-list)))
435   (let ((article-buffer (or article-buffer gnus-article-buffer)))
436     (if (and (get-buffer article-buffer)
437              (buffer-name (get-buffer article-buffer)))
438         (save-excursion
439           (set-buffer article-buffer)
440           (widen)
441           (copy-to-buffer gnus-article-copy (point-min) (point-max))
442           (set-text-properties (point-min) (point-max) 
443                                nil gnus-article-copy)))))
444
445 (defun gnus-post-news (post &optional group header article-buffer yank subject)
446   "Begin editing a new USENET news article to be posted.
447 Type \\[describe-mode] in the buffer to get a list of commands."
448   (interactive (list t))
449   (let* ((group (or group gnus-newsgroup-name))
450          (to-address 
451           (assq 'to-address 
452                 (nth 5 (nth 2 (gnus-gethash group gnus-newsrc-hashtb))))))
453     (if (and (gnus-member-of-valid 'post (or group gnus-newsgroup-name))
454              (not to-address))
455         (if post
456             (gnus-new-news group)
457           (gnus-news-followup yank group))
458       (if post
459           (gnus-new-mail)
460         (gnus-mail-reply yank (and to-address (cdr to-address)) 'followup)))))
461
462 (defun gnus-inews-news (&optional use-group-method)
463   "Send a news message.
464 If given a prefix, and the group is a foreign group, this function
465 will attempt to use the foreign server to post the article."
466   (interactive "P")
467   (let* ((case-fold-search nil)
468          (server-running (gnus-server-opened gnus-current-select-method))
469          (reply gnus-article-reply)
470          error post-result)
471     (save-excursion
472       (gnus-start-news-server)          ;Use default server.
473       (widen)
474       (goto-char (point-min))
475       (run-hooks 'news-inews-hook)
476
477       ;; Send to server. 
478       (gnus-message 5 "Posting to USENET...")
479       (setq post-result (funcall gnus-inews-article-function use-group-method))
480       (cond ((eq post-result 'illegal)
481              (setq error t)
482              (ding))
483             (post-result
484              (gnus-message 5 "Posting to USENET...done")
485              (if (gnus-buffer-exists-p (car-safe reply))
486                  (progn
487                    (save-excursion
488                      (set-buffer gnus-summary-buffer)
489                      (gnus-summary-mark-article-as-replied 
490                       (cdr reply)))))
491              (set-buffer-modified-p nil))
492             (t
493              ;; We cannot signal an error.
494              (setq error t)
495              (ding)
496              (gnus-message 1 "Article rejected: %s" 
497                            (gnus-status-message gnus-select-method)))))
498
499     (let ((conf gnus-prev-winconf))
500       (if (not error)
501           (progn
502             (bury-buffer)
503             ;; Restore last window configuration.
504             (and conf (set-window-configuration conf)))))))
505
506 (defun gnus-inews-narrow-to-headers ()
507   (widen)
508   (narrow-to-region
509    (goto-char (point-min))
510    (or (and (re-search-forward 
511              (concat "^" (regexp-quote mail-header-separator) "$") nil t)
512             (match-beginning 0))
513        (point-max))))
514
515 (defun gnus-inews-send-mail-copy ()
516   ;; Mail the message if To, Bcc or Cc exists.
517   (let* ((types '("to" "bcc" "cc"))
518          (ty types)
519          (buffer (current-buffer))
520          fcc)
521     (save-restriction
522       (widen)
523       (gnus-inews-narrow-to-headers)
524
525       (while ty
526         (or (mail-fetch-field (car ty) nil t)
527             (setq types (delete (car ty) types)))
528         (setq ty (cdr ty)))
529
530       (if (not types)
531           ;; We do not want to send mail.
532           ()
533         (gnus-message 5 "Sending via mail...")
534         (widen)
535         (save-excursion
536           ;; We copy the article over to a temp buffer since we are
537           ;; going to modify it a little.  
538           (nnheader-set-temp-buffer " *Gnus-mailing*")
539           (insert-buffer buffer)
540           ;; We remove Fcc, because we don't want the mailer to see
541           ;; that header.  
542           (gnus-inews-narrow-to-headers)
543           (nnheader-remove-header "fcc")
544
545           (widen)
546             
547           (if (and gnus-mail-courtesy-message
548                    (or (member "to" types)
549                        (member "cc" types)))
550               ;; We only want to insert the courtesy mail message if
551               ;; we use To or Cc; Bcc should not have one. Well, if
552               ;; both Bcc and To are present, it will get one
553               ;; anyway.
554               (progn
555                 ;; Insert "courtesy" mail message.
556                 (goto-char (point-min))
557                 (re-search-forward
558                  (concat "^" (regexp-quote mail-header-separator) "$"))
559                 (forward-line 1)
560                 (insert gnus-mail-courtesy-message)))
561
562           (gnus-mail-send)
563           (kill-buffer (current-buffer))
564           (gnus-message 5 "Sending via mail...done"))))))
565
566 (defun gnus-inews-remove-headers-after-mail ()
567   (save-excursion
568     (save-restriction
569       (gnus-inews-narrow-to-headers)
570       (nnheader-remove-header "bcc"))))
571
572 (defun gnus-inews-check-post ()
573   "Check whether the post looks ok."
574   (or
575    (not gnus-check-before-posting)
576    (and 
577     ;; We narrow to the headers and check them first.
578     (save-excursion
579       (save-restriction
580         (goto-char (point-min))
581         (narrow-to-region 
582          (point) 
583          (progn
584            (re-search-forward 
585             (concat "^" (regexp-quote mail-header-separator) "$"))
586            (match-beginning 0)))
587         (goto-char (point-min))
588         (and 
589          ;; Check for commands in Subject.
590          (or 
591           (gnus-check-before-posting 'subject-cmsg)
592           (save-excursion
593             (if (string-match "^cmsg " (mail-fetch-field "subject"))
594                 (gnus-y-or-n-p
595                  "The control code \"cmsg \" is in the subject. Really post? ")
596               t)))
597          ;; Check for multiple identical headers.
598          (or (gnus-check-before-posting 'multiple-headers)
599              (save-excursion
600                (let (found)
601                  (while (and (not found) (re-search-forward "^[^ \t:]+: "
602                                                             nil t))
603                    (save-excursion
604                      (or (re-search-forward 
605                           (concat "^" (setq found
606                                             (buffer-substring 
607                                              (match-beginning 0) 
608                                              (- (match-end 0) 2))))
609                           nil t)
610                          (setq found nil))))
611                  (if found
612                      (gnus-y-or-n-p 
613                       (format "Multiple %s headers. Really post? " found))
614                    t))))
615          ;; Check for Version and Sendsys.
616          (or (gnus-check-before-posting 'sendsys)
617              (save-excursion
618                (if (re-search-forward "^Sendsys:\\|^Version:" nil t)
619                    (gnus-y-or-n-p
620                     (format "The article contains a %s command. Really post? "
621                             (buffer-substring (match-beginning 0) 
622                                               (1- (match-end 0)))))
623                  t)))
624          ;; Check for Approved.
625          (or (gnus-check-before-posting 'approved)
626              (save-excursion
627                (if (re-search-forward "^Approved:" nil t)
628                    (gnus-y-or-n-p
629                     "The article contains an Approved header. Really post? ")
630                  t)))
631          ;; Check the Message-ID header.
632          (or (gnus-check-before-posting 'message-id)
633              (save-excursion
634                (let* ((case-fold-search t)
635                       (message-id (mail-fetch-field "message-id")))
636                  (or (not message-id)
637                      (and (string-match "@" message-id)
638                           (string-match "@[^\\.]*\\." message-id))
639                      (gnus-y-or-n-p
640                       (format 
641                        "The Message-ID looks strange: \"%s\". Really post? "
642                        message-id))))))
643          ;; Check the From header.
644          (or (gnus-check-before-posting 'from)
645              (save-excursion
646                (let* ((case-fold-search t)
647                       (from (mail-fetch-field "from")))
648                  (cond
649                   ((not from)
650                    (gnus-y-or-n-p "There is no From line. Really post? "))
651                   ((not (string-match "@[^\\.]*\\." from))
652                    (gnus-y-or-n-p
653                     (format 
654                      "The address looks strange: \"%s\". Really post? " from)))
655                   ((string-match "(.*).*(.*)" from)
656                    (gnus-y-or-n-p
657                     (format
658                      "The From header looks strange: \"%s\". Really post? " 
659                      from)))
660                   (t t)))))
661          )))
662     ;; Check for long lines.
663     (or (gnus-check-before-posting 'long-lines)
664         (save-excursion
665           (goto-char (point-min))
666           (re-search-forward
667            (concat "^" (regexp-quote mail-header-separator) "$"))
668           (while (and
669                   (progn
670                     (end-of-line)
671                     (< (current-column) 80))
672                   (zerop (forward-line 1))))
673           (or (bolp)
674               (eobp)
675               (gnus-y-or-n-p
676                (format
677                 "You have lines longer than 79 characters.  Really post? ")))))
678     ;; Check for control characters.
679     (or (gnus-check-before-posting 'control-chars)
680         (save-excursion
681           (if (re-search-forward "[\000-\007\013\015-\037\200-\237]" nil t)
682               (gnus-y-or-n-p 
683                "The article contains control characters. Really post? ")
684             t)))
685     ;; Check excessive size.
686     (or (gnus-check-before-posting 'size)
687         (if (> (buffer-size) 60000)
688             (gnus-y-or-n-p
689              (format "The article is %d octets long. Really post? "
690                      (buffer-size)))
691           t))
692     ;; Use the (size . checksum) variable to see whether the
693     ;; article is empty or has only quoted text.
694     (or
695      (gnus-check-before-posting 'new-text)
696      (if (and (= (buffer-size) (car gnus-article-check-size))
697               (= (gnus-article-checksum) (cdr gnus-article-check-size)))
698          (gnus-y-or-n-p
699           "It looks like there's no new text in your article. Really post? ")
700        t))
701     ;; Check the length of the signature.
702     (or (gnus-check-before-posting 'signature)
703         (progn
704           (goto-char (point-max))
705           (if (not (re-search-backward gnus-signature-separator nil t))
706               t
707             (if (> (count-lines (point) (point-max)) 4)
708                 (gnus-y-or-n-p
709                  (format
710                   "Your .sig is %d lines; it should be max 4.  Really post? "
711                   (count-lines (point) (point-max))))
712               t)))))))
713
714 (defun gnus-article-checksum ()
715   (let ((sum 0))
716     (save-excursion
717       (while (not (eobp))
718         (setq sum (logxor sum (following-char)))
719         (forward-char 1)))
720     sum))
721
722 ;; Returns non-nil if this type is not to be checked.
723 (defun gnus-check-before-posting (type)
724   (not 
725    (or (not gnus-check-before-posting)
726        (if (listp gnus-check-before-posting)
727            (memq type gnus-check-before-posting)
728          t))))
729
730 (defun gnus-cancel-news ()
731   "Cancel an article you posted."
732   (interactive)
733   (if (or gnus-expert-user
734           (gnus-yes-or-no-p "Do you really want to cancel this article? "))
735       (let ((from nil)
736             (newsgroups nil)
737             (message-id nil)
738             (distribution nil))
739         (or (gnus-member-of-valid 'post gnus-newsgroup-name)
740             (error "This backend does not support canceling"))
741         (save-excursion
742           ;; Get header info. from original article.
743           (save-restriction
744             (gnus-article-show-all-headers)
745             (goto-char (point-min))
746             (search-forward "\n\n" nil 'move)
747             (narrow-to-region (point-min) (point))
748             (setq from (mail-fetch-field "from"))
749             (setq newsgroups (mail-fetch-field "newsgroups"))
750             (setq message-id (mail-fetch-field "message-id"))
751             (setq distribution (mail-fetch-field "distribution")))
752           ;; Verify if the article is absolutely user's by comparing
753           ;; user id with value of its From: field.
754           (if (not
755                (string-equal
756                 (downcase (mail-strip-quoted-names from))
757                 (downcase (mail-strip-quoted-names (gnus-inews-user-name)))))
758               (progn
759                 (ding) (gnus-message 3 "This article is not yours.")
760                 nil)
761             ;; Make control article.
762             (set-buffer (get-buffer-create " *Gnus-canceling*"))
763             (buffer-disable-undo (current-buffer))
764             (erase-buffer)
765             (insert "Newsgroups: " newsgroups "\n"
766                     "From: " (gnus-inews-real-user-address) "\n"
767                     "Subject: cancel " message-id "\n"
768                     "Control: cancel " message-id "\n"
769                     (if distribution
770                         (concat "Distribution: " distribution "\n")
771                       "")
772                     mail-header-separator "\n"
773                     "This is a cancel message from " from ".\n")
774             ;; Send the control article to NNTP server.
775             (gnus-message 5 "Canceling your article...")
776             (prog1
777                 (if (funcall gnus-inews-article-function)
778                     (gnus-message 5 "Canceling your article...done")
779                   (progn
780                     (ding) 
781                     (gnus-message 1 "Cancel failed; %s" 
782                                   (gnus-status-message gnus-newsgroup-name))
783                     nil)
784                   t)
785               ;; Kill the article buffer.
786               (kill-buffer (current-buffer))))))))
787
788 \f
789 ;;; Lowlevel inews interface.
790
791 ;; Dummy to avoid byte-compile warning.
792 (defvar nnspool-rejected-article-hook)
793
794 (defun gnus-inews-article (&optional use-group-method)
795   "Post an article in current buffer using NNTP protocol."
796   (let ((artbuf (current-buffer))
797         gcc result)
798     (widen)
799     (goto-char (point-max))
800     ;; Require a newline at the end of the buffer since inews may
801     ;; append a .signature.
802     (or (= (preceding-char) ?\n)
803         (insert ?\n))
804     ;; Prepare article headers.  All message body such as signature
805     ;; must be inserted before Lines: field is prepared.
806     (save-restriction
807       (gnus-inews-narrow-to-headers)
808       ;; Fix some headers.
809       (gnus-inews-cleanup-headers)
810       ;; Remove some headers.
811       (gnus-inews-remove-headers)
812       ;; Insert some headers.
813       (gnus-inews-insert-headers)
814       ;; Let the user do all of the above.
815       (run-hooks 'gnus-inews-article-header-hook)
816       ;; Copy the Gcc header, if any.
817       (setq gcc (mail-fetch-field "gcc"))
818       (widen))
819     ;; Check whether the article is a good Net Citizen.
820     (if (and gnus-article-check-size
821              (not (gnus-inews-check-post)))
822         ;; Aber nein!
823         'illegal
824       ;; We fudge a hook for nnspool.
825       (setq nnspool-rejected-article-hook
826             (`
827              (list
828               (lambda ()
829                 (condition-case ()
830                     (save-excursion
831                       (set-buffer (, (buffer-name)))
832                       (gnus-put-in-draft-group nil 'silent))
833                   (error 
834                    (ding)
835                    (gnus-message 
836                     1 "Couldn't enter rejected article into draft group")))))))
837                                    
838       ;; Looks ok, so we do the nasty.
839       (save-excursion
840         ;; This hook may insert a signature.
841         (save-excursion
842           (goto-char (point-min))
843           (let ((gnus-newsgroup-name (or (mail-fetch-field "newsgroups")
844                                          gnus-newsgroup-name)))
845             (run-hooks 'gnus-prepare-article-hook)))
846         ;; Send off copies using mail, if that is wanted.
847         (gnus-inews-send-mail-copy)
848         ;; Remove more headers.
849         (gnus-inews-remove-headers-after-mail)
850         ;; Copy the article over to a temp buffer.
851         (nnheader-set-temp-buffer " *Gnus-posting*")
852         (insert-buffer-substring artbuf)
853         ;; Remove the header separator.
854         (goto-char (point-min))
855         (re-search-forward
856          (concat "^" (regexp-quote mail-header-separator) "$"))
857         (replace-match "" t t)
858         ;; Run final inews hooks.  This hook may do FCC.
859         ;; The article must be saved before being posted because
860         ;; `gnus-request-post' modifies the buffer.
861         (run-hooks 'gnus-inews-article-hook)
862         ;; Copy the article over to some group, possibly.
863         (and gcc (gnus-inews-do-gcc gcc))
864         ;; Post the article.
865         (setq result
866               (gnus-request-post 
867                (if use-group-method
868                    (gnus-find-method-for-group gnus-newsgroup-name)
869                  gnus-select-method) use-group-method))
870         (kill-buffer (current-buffer)))
871       (run-hooks 'gnus-message-sent-hook)
872       ;; We remove To and Cc headers to avoid re-mailing if the user
873       ;; accidentally (or purposefully) leans on the `C-c C-c' keys
874       ;; and the news server rejects the posting.
875       (gnus-inews-narrow-to-headers)
876       (nnheader-remove-header "^\\(to\\|[bcf]cc\\|cc\\):" t)
877       (widen)
878       ;; If the posting was unsuccessful (that it, it was rejected) we
879       ;; put it into the draft group.
880       (or result (gnus-put-in-draft-group))
881       result)))
882
883 (defun gnus-inews-cleanup-headers ()
884   ;; Correct newsgroups field: change sequence of spaces to comma and 
885   ;; eliminate spaces around commas.  Eliminate imbedded line breaks.
886   (goto-char (point-min))
887   (if (re-search-forward "^Newsgroups: +" nil t)
888       (save-restriction
889         (narrow-to-region
890          (point)
891          (if (re-search-forward "^[^ \t]" nil t)
892              (match-beginning 0)
893            (forward-line 1)
894            (point)))
895         (goto-char (point-min))
896         (while (re-search-forward "\n[ \t]+" nil t)
897           (replace-match " " t t))      ;No line breaks (too confusing)
898         (goto-char (point-min))
899         (while (re-search-forward "[ \t\n]*,[ \t\n]*\\|[ \t]+" nil t)
900           (replace-match "," t t))
901         (goto-char (point-min))
902         ;; Remove a trailing comma.
903         (if (re-search-forward ",$" nil t)
904             (replace-match "" t t))))
905
906   ;; Added by Per Abrahamsen <abraham@iesd.auc.dk>.
907   ;; Help save the the world!
908   (or 
909    gnus-expert-user
910    (let ((newsgroups (mail-fetch-field "newsgroups"))
911          (followup-to (mail-fetch-field "followup-to"))
912          groups to)
913      (if (and newsgroups
914               (string-match "," newsgroups) (not followup-to))
915          (progn
916            (while (string-match "," newsgroups)
917              (setq groups
918                    (cons (list (substring newsgroups 0 (match-beginning 0)))
919                          groups))
920              (setq newsgroups (substring newsgroups (match-end 0))))
921            (setq groups (nreverse (cons (list newsgroups) groups)))
922
923            (setq to (completing-read 
924                      "Followups to: (default all groups) " groups))
925            (if (> (length to) 0)
926                (progn
927                  (goto-char (point-min))
928                  (insert "Followup-To: " to "\n")))))))
929
930   ;; Cleanup Followup-To.
931   (goto-char (point-min))
932   (if (search-forward-regexp "^Followup-To: +" nil t)
933       (save-restriction
934         (narrow-to-region
935          (point)
936          (if (re-search-forward "^[^ \t]" nil 'end)
937              (match-beginning 0)
938            (point-max)))
939         (goto-char (point-min))
940         (replace-regexp "\n[ \t]+" " ") ;No line breaks (too confusing)
941         (goto-char (point-min))
942         (replace-regexp "[ \t\n]*,[ \t\n]*\\|[ \t]+" ","))))
943
944
945 (defun gnus-inews-remove-headers ()
946   (let ((case-fold-search t)
947         (headers gnus-removable-headers))
948     ;; Remove toxic headers.
949     (while headers
950       (goto-char (point-min))
951       (and (re-search-forward 
952             (concat "^" (downcase (format "%s" (car headers))))
953             nil t)
954            (delete-region (progn (beginning-of-line) (point))
955                           (progn (forward-line 1) (point))))
956       (setq headers (cdr headers)))))
957   
958 (defun gnus-inews-insert-headers (&optional headers)
959   "Prepare article headers.
960 Headers already prepared in the buffer are not modified.
961 Headers in `gnus-required-headers' will be generated."
962   (let ((Date (gnus-inews-date))
963         (Message-ID (gnus-inews-message-id))
964         (Organization (gnus-inews-organization))
965         (From (gnus-inews-user-name))
966         (Path (gnus-inews-path))
967         (Subject nil)
968         (Newsgroups nil)
969         (To nil)
970         (Distribution nil)
971         (Lines (gnus-inews-lines))
972         (X-Newsreader gnus-version)
973         (X-Mailer gnus-version)
974         (headers (or headers gnus-required-headers))
975         (case-fold-search t)
976         header value elem)
977     ;; First we remove any old generated headers.
978     (let ((headers gnus-deletable-headers))
979       (while headers
980         (goto-char (point-min))
981         (and (re-search-forward 
982               (concat "^" (symbol-name (car headers)) ": *") nil t)
983              (get-text-property (1+ (match-beginning 0)) 'gnus-deletable)
984              (gnus-delete-line))
985         (setq headers (cdr headers))))
986     ;; If there are References, and no "Re: ", then the thread has
987     ;; changed name. See Son-of-1036.
988     (if (and (mail-fetch-field "references")
989              (get-buffer gnus-article-buffer))
990         (let ((psubject (gnus-simplify-subject-re
991                          (mail-fetch-field "subject"))))
992           (or (and psubject gnus-reply-subject 
993                    (string= (gnus-simplify-subject-re gnus-reply-subject)
994                             psubject))
995               (progn
996                 (string-match "@" Message-ID)
997                 (setq Message-ID
998                       (concat (substring Message-ID 0 (match-beginning 0))
999                               "_-_" 
1000                               (substring Message-ID (match-beginning 0))))))))
1001     ;; Go through all the required headers and see if they are in the
1002     ;; articles already. If they are not, or are empty, they are
1003     ;; inserted automatically - except for Subject, Newsgroups and
1004     ;; Distribution. 
1005     (while headers
1006       (goto-char (point-min))
1007       (setq elem (car headers))
1008       (if (consp elem)
1009           (setq header (car elem))
1010         (setq header elem))
1011       (if (or (not (re-search-forward 
1012                     (concat "^" (downcase (symbol-name header)) ":") nil t))
1013               (progn
1014                 ;; The header was found. We insert a space after the
1015                 ;; colon, if there is none.
1016                 (if (/= (following-char) ? ) (insert " "))
1017                 ;; Find out whether the header is empty...
1018                 (looking-at "[ \t]*$")))
1019           ;; So we find out what value we should insert.
1020           (progn
1021             (setq value 
1022                   (or (if (consp elem)
1023                           ;; The element is a cons.  Either the cdr is
1024                           ;; a string to be inserted verbatim, or it
1025                           ;; is a function, and we insert the value
1026                           ;; returned from this function.
1027                           (or (and (stringp (cdr elem)) (cdr elem))
1028                               (and (fboundp (cdr elem)) (funcall (cdr elem))))
1029                         ;; The element is a symbol.  We insert the
1030                         ;; value of this symbol, if any.
1031                         (and (boundp header) (symbol-value header)))
1032                       ;; We couldn't generate a value for this header,
1033                       ;; so we just ask the user.
1034                       (read-from-minibuffer
1035                        (format "Empty header for %s; enter value: " header))))
1036             ;; Finally insert the header.
1037             (save-excursion
1038               (if (bolp)
1039                   (progn
1040                     (goto-char (point-max))
1041                     (insert (symbol-name header) ": " value "\n")
1042                     (forward-line -1))
1043                 (replace-match value t t))
1044               ;; Add the deletable property to the headers that require it.
1045               (and (memq header gnus-deletable-headers)
1046                    (progn (beginning-of-line) (looking-at "[^:]+: "))
1047                    (add-text-properties 
1048                     (point) (match-end 0)
1049                     '(gnus-deletable t face italic) (current-buffer))))))
1050       (setq headers (cdr headers)))
1051     ;; Insert new Sender if the From is strange. 
1052     (let ((from (mail-fetch-field "from"))
1053           (sender (mail-fetch-field "sender")))
1054       (if (and from 
1055                (not (string=
1056                      (downcase (car (gnus-extract-address-components from)))
1057                      (downcase (gnus-inews-real-user-address))))
1058                (or (null sender)
1059                    (not 
1060                     (string=
1061                      (downcase (car (gnus-extract-address-components sender)))
1062                      (downcase (gnus-inews-real-user-address))))))
1063           (progn
1064             (goto-char (point-min))    
1065             (and (re-search-forward "^Sender:" nil t)
1066                  (progn
1067                    (beginning-of-line)
1068                    (insert "Original-")
1069                    (beginning-of-line)))
1070             (insert "Sender: " (gnus-inews-real-user-address) "\n"))))))
1071
1072
1073 (defun gnus-inews-insert-signature ()
1074   "Insert a signature file.
1075 If `gnus-signature-function' is bound and returns a string, this
1076 string is used instead of the variable `gnus-signature-file'.
1077 In either case, if the string is a file name, this file is
1078 inserted. If the string is not a file name, the string itself is
1079 inserted. 
1080
1081 If you never want any signature inserted, set both of these variables to
1082 nil."
1083   (save-excursion
1084     (let ((signature 
1085            (or (and gnus-signature-function
1086                     (funcall gnus-signature-function gnus-newsgroup-name))
1087                gnus-signature-file)))
1088       (if (and signature
1089                (or (file-exists-p signature)
1090                    (string-match " " signature)
1091                    (not (string-match 
1092                          "^/[^/]+/" (expand-file-name signature)))))
1093           (progn
1094             (goto-char (point-max))
1095             (if (and mail-signature (search-backward "\n-- \n" nil t))
1096                 ()
1097               ;; Delete any previous signatures.
1098               (if (search-backward "\n-- \n" nil t)
1099                   (delete-region (point) (point-max)))
1100               (or (eolp) (insert "\n"))
1101               (insert "-- \n")
1102               (if (file-exists-p signature)
1103                   (insert-file-contents signature)
1104                 (insert signature))
1105               (goto-char (point-max))
1106               (or (bolp) (insert "\n"))))))))
1107
1108 ;; Written by "Mr. Per Persson" <pp@solace.mh.se>.
1109 (defun gnus-inews-insert-mime-headers ()
1110   (let ((mail-header-separator ""))
1111     (or (mail-position-on-field "Mime-Version")
1112         (insert "1.0")
1113         (cond ((save-excursion
1114                  (beginning-of-buffer)
1115                  (re-search-forward "[\200-\377]" nil t))
1116                (or (mail-position-on-field "Content-Type")
1117                    (insert "text/plain; charset=ISO-8859-1"))
1118                (or (mail-position-on-field "Content-Transfer-Encoding")
1119                    (insert "8bit")))
1120               (t (or (mail-position-on-field "Content-Type")
1121                      (insert "text/plain; charset=US-ASCII"))
1122                  (or (mail-position-on-field "Content-Transfer-Encoding")
1123                      (insert "7bit")))))))
1124
1125 (defun gnus-inews-do-fcc ()
1126   "Process FCC: fields in current article buffer.
1127 Unless the first character of the field is `|', the article is saved
1128 to the specified file using the function specified by the variable
1129 gnus-author-copy-saver.  The default function rmail-output saves in
1130 Unix mailbox format.
1131 If the first character is `|', the contents of the article is send to
1132 a program specified by the rest of the value."
1133   (let ((fcc-list nil)
1134         (fcc-file nil)
1135         (case-fold-search t))           ;Should ignore case.
1136     (save-excursion
1137       (save-restriction
1138         (goto-char (point-min))
1139         (search-forward "\n\n")
1140         (narrow-to-region (point-min) (point))
1141         (goto-char (point-min))
1142         (while (re-search-forward "^FCC:[ \t]*" nil t)
1143           (setq fcc-list
1144                 (cons (buffer-substring
1145                        (point)
1146                        (progn
1147                          (end-of-line)
1148                          (skip-chars-backward " \t")
1149                          (point)))
1150                       fcc-list))
1151           (delete-region (match-beginning 0)
1152                          (progn (forward-line 1) (point))))
1153         ;; Process FCC operations.
1154         (widen)
1155         (while fcc-list
1156           (setq fcc-file (car fcc-list))
1157           (setq fcc-list (cdr fcc-list))
1158           (cond ((string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" fcc-file)
1159                  (let ((program (substring fcc-file
1160                                            (match-beginning 1) (match-end 1))))
1161                    ;; Suggested by yuki@flab.fujitsu.junet.
1162                    ;; Send article to named program.
1163                    (call-process-region (point-min) (point-max) shell-file-name
1164                                         nil nil nil "-c" program)))
1165                 (t
1166                  ;; Suggested by hyoko@flab.fujitsu.junet.
1167                  ;; Save article in Unix mail format by default.
1168                  (gnus-make-directory (file-name-directory fcc-file))
1169                  (if (and gnus-author-copy-saver
1170                           (not (eq gnus-author-copy-saver 'rmail-output)))
1171                      (funcall gnus-author-copy-saver fcc-file)
1172                    (if (and (file-readable-p fcc-file) (rmail-file-p fcc-file))
1173                        (gnus-output-to-rmail fcc-file)
1174                      (rmail-output fcc-file 1 t t))))))))))
1175
1176 (defun gnus-inews-path ()
1177   "Return uucp path."
1178   (let ((login-name (gnus-inews-login-name)))
1179     (cond ((null gnus-use-generic-path)
1180            (concat (nth 1 gnus-select-method) "!" login-name))
1181           ((stringp gnus-use-generic-path)
1182            ;; Support GENERICPATH.  Suggested by vixie@decwrl.dec.com.
1183            (concat gnus-use-generic-path "!" login-name))
1184           (t login-name))))
1185
1186 (defun gnus-inews-user-name ()
1187   "Return user's network address as \"NAME@DOMAIN (FULL-NAME)\"."
1188   (let ((full-name (gnus-inews-full-name))
1189         (address (if (or gnus-user-login-name gnus-use-generic-from
1190                          gnus-local-domain (getenv "DOMAINNAME"))
1191                      (concat (gnus-inews-login-name) "@"
1192                              (gnus-inews-domain-name gnus-use-generic-from))
1193                    user-mail-address))) 
1194     (or gnus-user-from-line
1195         (concat address
1196                 ;; User's full name.
1197                 (cond ((string-equal full-name "&") ;Unix hack.
1198                        (concat " (" (user-login-name) ")"))
1199                       ((string-match "[^ ]+@[^ ]+ +(.*)" address)
1200                        "")
1201                       (t
1202                        (concat " (" full-name ")")))))))
1203
1204 (defun gnus-inews-real-user-address ()
1205   "Return the \"real\" user address.
1206 This function tries to ignore all user modifications, and 
1207 give as trustworthy answer as possible."
1208   (concat (user-login-name) "@" (gnus-inews-full-address)))
1209
1210 (defun gnus-inews-login-name ()
1211   "Return login name."
1212   (or gnus-user-login-name (getenv "LOGNAME") (user-login-name)))
1213
1214 (defun gnus-inews-full-name ()
1215   "Return full user name."
1216   (or gnus-user-full-name (getenv "NAME") (user-full-name)))
1217
1218 (defun gnus-inews-domain-name (&optional genericfrom)
1219   "Return user's domain name.
1220 If optional argument GENERICFROM is a string, use it as the domain
1221 name; if it is non-nil, strip off local host name from the domain name.
1222 If the function `system-name' returns full internet name and the
1223 domain is undefined, the domain name is got from it."
1224   (if (or genericfrom gnus-local-domain (getenv "DOMAINNAME"))
1225       (let* ((system-name (system-name))
1226              (domain 
1227               (or (if (stringp genericfrom) genericfrom)
1228                   (getenv "DOMAINNAME")
1229                   gnus-local-domain
1230                   ;; Function `system-name' may return full internet name.
1231                   ;; Suggested by Mike DeCorte <mrd@sun.soe.clarkson.edu>.
1232                   (if (string-match "\\." system-name)
1233                       (substring system-name (match-end 0)))
1234                   (read-string "Domain name (no host): ")))
1235              (host (or (if (string-match "\\." system-name)
1236                            (substring system-name 0 (match-beginning 0)))
1237                        system-name)))
1238         (if (string-equal "." (substring domain 0 1))
1239             (setq domain (substring domain 1)))
1240         ;; Support GENERICFROM as same as standard Bnews system.
1241         ;; Suggested by ohm@kaba.junet and vixie@decwrl.dec.com.
1242         (cond ((null genericfrom)
1243                (concat host "." domain))
1244               ;;((stringp genericfrom) genericfrom)
1245               (t domain)))
1246     (if (string-match "\\." (system-name))
1247         (system-name)
1248       (substring user-mail-address 
1249                  (1+ (string-match "@" user-mail-address))))))
1250
1251 (defun gnus-inews-full-address ()
1252   (let ((domain (gnus-inews-domain-name))
1253         (system (system-name))
1254         (case-fold-search t))
1255     (if (string-match "\\." system) system
1256       (if (string-match (concat "^" (regexp-quote system)) domain) domain
1257         (concat system "." domain)))))
1258
1259 (defun gnus-inews-message-id ()
1260   "Generate unique Message-ID for user."
1261   ;; Message-ID should not contain a slash and should be terminated by
1262   ;; a number.  I don't know the reason why it is so.
1263   (concat "<" (gnus-inews-unique-id) "@" (gnus-inews-full-address) ">"))
1264
1265 (defvar gnus-unique-id-char nil)
1266
1267 ;; If you ever change this function, make sure the new version
1268 ;; cannot generate IDs that the old version could.
1269 ;; You might for example insert a "." somewhere (not next to another dot
1270 ;; or string boundary), or modify the newsreader name to "Ding".
1271 (defun gnus-inews-unique-id ()
1272   ;; Dont use microseconds from (current-time), they may be unsupported.
1273   ;; Instead we use this randomly inited counter.
1274   (setq gnus-unique-id-char
1275         (% (1+ (or gnus-unique-id-char (logand (random t) (1- (lsh 1 20)))))
1276            ;; (current-time) returns 16-bit ints,
1277            ;; and 2^16*25 just fits into 4 digits i base 36.
1278            (* 25 25)))
1279   (let ((tm (if (fboundp 'current-time)
1280                 (current-time) '(12191 46742 287898))))
1281     (concat
1282      (if (memq system-type '(ms-dos emx vax-vms))
1283          (let ((user (downcase (gnus-inews-login-name))))
1284            (while (string-match "[^a-z0-9_]" user)
1285              (aset user (match-beginning 0) ?_))
1286            user)
1287        (gnus-number-base36 (user-uid) -1))
1288      (gnus-number-base36 (+ (car   tm) (lsh (% gnus-unique-id-char 25) 16)) 4)
1289      (gnus-number-base36 (+ (nth 1 tm) (lsh (/ gnus-unique-id-char 25) 16)) 4)
1290      ;; Append the newsreader name, because while the generated
1291      ;; ID is unique to this newsreader, other newsreaders might
1292      ;; otherwise generate the same ID via another algorithm.
1293      ".fsf")))
1294
1295
1296 (defun gnus-inews-date ()
1297   "Current time string."
1298   (timezone-make-date-arpa-standard 
1299    (current-time-string) (current-time-zone)))
1300
1301 (defun gnus-inews-organization ()
1302   "Return user's organization.
1303 The ORGANIZATION environment variable is used if defined.
1304 If not, the variable `gnus-local-organization' is used instead.
1305 If it is a function, the function will be called with the current
1306 newsgroup name as the argument.
1307 If this is a file name, the contents of this file will be used as the
1308 organization."
1309   (let* ((organization 
1310           (or (getenv "ORGANIZATION")
1311               (if gnus-local-organization
1312                   (if (and (symbolp gnus-local-organization)
1313                            (fboundp gnus-local-organization))
1314                       (funcall gnus-local-organization gnus-newsgroup-name)
1315                     gnus-local-organization))
1316               gnus-organization-file
1317               "~/.organization")))
1318     (and (stringp organization)
1319          (> (length organization) 0)
1320          (or (file-exists-p organization)
1321              (string-match " " organization)
1322              (not (string-match "^/usr/lib/" organization)))
1323          (save-excursion
1324            (gnus-set-work-buffer)
1325            (if (file-exists-p organization)
1326                (insert-file-contents organization)
1327              (insert organization))
1328            (goto-char (point-min))
1329            (while (re-search-forward " *\n *" nil t)
1330              (replace-match " " t t))
1331            (buffer-substring (point-min) (point-max))))))
1332
1333 (defun gnus-inews-lines ()
1334   "Count the number of lines and return numeric string."
1335   (save-excursion
1336     (save-restriction
1337       (widen)
1338       (goto-char (point-min))
1339       (re-search-forward 
1340        (concat "^" (regexp-quote mail-header-separator) "$"))
1341       (forward-line 1)
1342       (int-to-string (count-lines (point) (point-max))))))
1343
1344 \f
1345 ;;;
1346 ;;; Gnus Mail Functions 
1347 ;;;
1348
1349 ;;; Mail reply commands of Gnus summary mode
1350
1351 (defun gnus-summary-reply (yank &optional yank-articles)
1352   "Reply mail to news author.
1353 If prefix argument YANK is non-nil, original article is yanked automatically.
1354 Customize the variable gnus-mail-reply-method to use another mailer."
1355   (interactive "P")
1356   ;; Bug fix by jbw@bigbird.bu.edu (Joe Wells)
1357   ;; Stripping headers should be specified with mail-yank-ignored-headers.
1358   (gnus-set-global-variables)
1359   (if yank-articles (gnus-summary-goto-subject (car yank-articles)))
1360   (gnus-summary-select-article)
1361   (bury-buffer gnus-article-buffer)
1362   (gnus-mail-reply (or yank-articles (not (not yank)))))
1363
1364 (defun gnus-summary-reply-with-original (n)
1365   "Reply mail to news author with original article.
1366 Customize the variable gnus-mail-reply-method to use another mailer."
1367   (interactive "P")
1368   (gnus-summary-reply t (gnus-summary-work-articles n)))
1369
1370 (defun gnus-summary-mail-forward (post)
1371   "Forward the current message to another user.
1372 Customize the variable gnus-mail-forward-method to use another mailer."
1373   (interactive "P")
1374   (gnus-set-global-variables)
1375   (gnus-summary-select-article)
1376   (gnus-copy-article-buffer)
1377   (if post
1378       (gnus-forward-using-post gnus-article-copy)
1379     (gnus-mail-forward gnus-article-copy)))
1380
1381 (defun gnus-summary-post-forward ()
1382   "Forward the current article to a newsgroup."
1383   (interactive)
1384   (gnus-summary-mail-forward t))
1385
1386 (defvar gnus-nastygram-message 
1387   "The following article was inappropriately posted to %s.\n"
1388   "Format string to insert in nastygrams.
1389 The current group name will be inserted at \"%s\".")
1390
1391 (defun gnus-summary-mail-nastygram (n)
1392   "Send a nastygram to the author of the current article."
1393   (interactive "P")
1394   (if (or gnus-expert-user
1395           (gnus-y-or-n-p 
1396            "Really send a nastygram to the author of the current article? "))
1397       (let ((group gnus-newsgroup-name))
1398         (gnus-summary-reply-with-original n)
1399         (set-buffer gnus-mail-buffer)
1400         (insert (format gnus-nastygram-message group))
1401         (gnus-mail-send-and-exit))))
1402
1403 (defun gnus-summary-mail-other-window ()
1404   "Compose mail in other window.
1405 Customize the variable `gnus-mail-other-window-method' to use another
1406 mailer."
1407   (interactive)
1408   (gnus-set-global-variables)
1409   (gnus-new-mail))
1410
1411 (defun gnus-new-mail ()
1412   (pop-to-buffer gnus-mail-buffer)
1413   (erase-buffer)
1414   (gnus-mail-setup nil nil nil nil nil nil))
1415
1416 (defun gnus-mail-reply (&optional yank to-address followup)
1417   (save-excursion
1418     (set-buffer gnus-summary-buffer)
1419     (let ((group (gnus-group-real-name gnus-newsgroup-name))
1420           (cur (cons (current-buffer) (cdr gnus-article-current)))
1421           (winconf (current-window-configuration))
1422           from subject date reply-to message-of to cc
1423           references message-id sender follow-to sendto elt new-cc)
1424       (set-buffer (get-buffer-create gnus-mail-buffer))
1425       (mail-mode)
1426       (if (and (buffer-modified-p)
1427                (> (buffer-size) 0)
1428                (not (gnus-y-or-n-p 
1429                      "Unsent message being composed; erase it? ")))
1430           ()
1431         (erase-buffer)
1432         (save-excursion
1433           (gnus-copy-article-buffer)
1434           (save-restriction
1435             (set-buffer gnus-article-copy)
1436             (gnus-narrow-to-headers)
1437             (if (not followup)
1438                 ;; This is a regular reply.
1439                 (if (and (symbolp gnus-reply-to-function)
1440                          (fboundp gnus-reply-to-function))
1441                     (setq follow-to (funcall gnus-reply-to-function group)))
1442               ;; This is a followup.
1443               (if (and (symbolp gnus-followup-to-function)
1444                        (fboundp gnus-followup-to-function))
1445                   (save-excursion
1446                     (setq follow-to
1447                           (funcall gnus-followup-to-function group)))))
1448             (setq from (mail-fetch-field "from"))
1449             (setq date (or (mail-fetch-field "date") 
1450                            (mail-header-date gnus-current-headers)))
1451             (and from
1452                  (let ((stop-pos 
1453                         (string-match "  *at \\|  *@ \\| *(\\| *<" from)))
1454                    (setq message-of
1455                          (concat (if stop-pos (substring from 0 stop-pos) from)
1456                                  "'s message of " date))))
1457             (setq sender (mail-fetch-field "sender"))
1458             (setq subject (or (mail-fetch-field "subject") "none"))
1459             ;; Remove any (buggy) Re:'s that are present and make a
1460             ;; proper one.
1461             (and (string-match "^[ \t]*[Re][Ee]:[ \t]*" subject)
1462                  (setq subject (substring subject (match-end 0))))
1463             (setq subject (concat "Re: " subject))
1464             (setq to (mail-fetch-field "to"))
1465             (setq to (mail-fetch-field "cc"))
1466             (setq reply-to (mail-fetch-field "reply-to"))
1467             (setq references (mail-fetch-field "references"))
1468             (setq message-id (mail-fetch-field "message-id"))
1469
1470             (if (not followup)
1471                 ()
1472               ;; When we followup, we want all the headers, I would think.
1473               (setq new-cc (rmail-dont-reply-to 
1474                             (concat (or to "")
1475                                     (if cc (concat (if to ", " "") cc) ""))))
1476               (let ((rmail-dont-reply-to-names 
1477                      (regexp-quote (mail-strip-quoted-names
1478                                     (or to-address reply-to from "")))))
1479                 (setq new-cc (rmail-dont-reply-to new-cc))))
1480
1481             (widen)))
1482
1483         (setq news-reply-yank-from (or from "(nobody)"))
1484         (setq news-reply-yank-message-id
1485               (or message-id "(unknown Message-ID)"))
1486
1487         ;; Gather the "to" addresses out of the follow-to list and remove
1488         ;; them as we go.
1489         (if (and follow-to (listp follow-to))
1490             (while (setq elt (assoc "To" follow-to))
1491               (setq sendto (concat sendto (and sendto ", ") (cdr elt)))
1492               (setq follow-to (delq elt follow-to))))
1493
1494         (gnus-mail-setup 
1495          (or to-address 
1496              (if (and follow-to (not (stringp follow-to))) sendto
1497                (or follow-to reply-to from sender "")))
1498          subject message-of 
1499          (if (zerop (length new-cc)) nil new-cc)
1500          gnus-article-copy nil)
1501
1502         (make-local-variable 'gnus-article-reply)
1503         (setq gnus-article-reply cur)
1504         (make-local-variable 'gnus-prev-winconf)
1505         (setq gnus-prev-winconf winconf)
1506
1507         (auto-save-mode auto-save-default)
1508         (gnus-inews-modify-mail-mode-map)
1509
1510         (if (and follow-to (listp follow-to))
1511             (progn
1512               (goto-char (point-min))
1513               (re-search-forward "^To:" nil t)
1514               (beginning-of-line)
1515               (forward-line 1)
1516               (while follow-to
1517                 (insert (car (car follow-to)) ": " (cdr (car follow-to)) "\n")
1518                 (setq follow-to (cdr follow-to)))))
1519         (nnheader-insert-references references message-id)
1520
1521         ;; Now the headers should be ok, so we do the yanking.
1522         (goto-char (point-min))
1523         (re-search-forward
1524          (concat "^" (regexp-quote mail-header-separator) "$"))
1525         (forward-line 1)
1526         (if (not yank)
1527             (gnus-configure-windows 'reply 'force)
1528           (let ((last (point))
1529                 end)
1530             (if (not (listp yank))
1531                 (progn
1532                   (save-excursion
1533                     (mail-yank-original nil))
1534                   (or mail-yank-hooks mail-citation-hook
1535                       (run-hooks 'news-reply-header-hook)))
1536               (while yank
1537                 (save-window-excursion
1538                   (set-buffer gnus-summary-buffer)
1539                   (gnus-summary-select-article nil nil nil (car yank))
1540                   (gnus-summary-remove-process-mark (car yank)))
1541                 (save-excursion
1542                   (gnus-copy-article-buffer)
1543                   (mail-yank-original nil)
1544                   (setq end (point)))
1545                 (or mail-yank-hooks mail-citation-hook
1546                     (run-hooks 'news-reply-header-hook))
1547                 (goto-char end)
1548                 (setq yank (cdr yank))))
1549             (goto-char last))
1550           (gnus-configure-windows 'reply-yank 'force))
1551         (run-hooks 'gnus-mail-hook)))))
1552
1553 (defun gnus-new-news (&optional group)
1554   (let (subject)
1555     (and gnus-interactive-post
1556          (not gnus-expert-user)
1557          (not group)
1558          (progn
1559            (setq gnus-newsgroup-name
1560                  (setq group 
1561                        (completing-read "Group: " gnus-active-hashtb)))
1562            (setq subject (read-string "Subject: "))))
1563     (pop-to-buffer "*post-news*")  
1564     (erase-buffer)
1565     (news-reply-mode)
1566     (news-setup nil subject nil group nil)
1567     (local-set-key "\C-c\C-c" 'gnus-inews-news)))
1568
1569 (defun gnus-news-followup (&optional yank group)
1570   (save-excursion
1571     (set-buffer gnus-summary-buffer)
1572     (if (not (or (not gnus-novice-user)
1573                  gnus-expert-user
1574                  (gnus-y-or-n-p
1575                   "Are you sure you want to post to all of USENET? ")))
1576         ()
1577       (let ((group (or group (gnus-group-real-name gnus-newsgroup-name)))
1578             (cur (cons (current-buffer) (cdr gnus-article-current)))
1579             (winconf (current-window-configuration))
1580             from subject date reply-to message-of
1581             references message-id sender follow-to sendto elt 
1582             followup-to distribution)
1583         (set-buffer (get-buffer-create gnus-mail-buffer))
1584         (news-mode)
1585         (if (and (buffer-modified-p)
1586                  (> (buffer-size) 0)
1587                  (not (gnus-y-or-n-p 
1588                        "Unsent message being composed; erase it? ")))
1589             ()
1590           (erase-buffer)
1591           (save-excursion
1592             (gnus-copy-article-buffer)
1593             (save-restriction
1594               (set-buffer gnus-article-copy)
1595               (gnus-narrow-to-headers)
1596               (if (and (symbolp gnus-followup-to-function)
1597                        (fboundp gnus-followup-to-function))
1598                   (save-excursion
1599                     (setq follow-to
1600                           (funcall gnus-followup-to-function group))))
1601               (setq from (mail-fetch-field "from"))
1602               (setq date (or (mail-fetch-field "date") 
1603                              (mail-header-date gnus-current-headers)))
1604               (and from
1605                    (let ((stop-pos 
1606                           (string-match "  *at \\|  *@ \\| *(\\| *<" from)))
1607                      (setq message-of
1608                            (concat 
1609                             (if stop-pos (substring from 0 stop-pos) from)
1610                             "'s message of " date))))
1611               (setq subject (or (mail-fetch-field "subject") "none"))
1612               ;; Remove any (buggy) Re:'s that are present and make a
1613               ;; proper one.
1614               (and (string-match "^[ \t]*[Re][Ee]:[ \t]*" subject)
1615                    (setq subject (substring subject (match-end 0))))
1616               (setq subject (concat "Re: " subject))
1617               (setq references (mail-fetch-field "references"))
1618               (setq message-id (mail-fetch-field "message-id"))
1619               (setq followup-to (mail-fetch-field "followup-to"))
1620               (setq distribution (mail-fetch-field "distribution"))
1621               ;; Remove bogus distribution.
1622               (and (stringp distribution)
1623                    (string-match "world" distribution)
1624                    (setq distribution nil))
1625               (widen)))
1626
1627           (setq news-reply-yank-from (or from "(nobody)"))
1628           (setq news-reply-yank-message-id
1629                 (or message-id "(unknown Message-ID)"))
1630
1631           ;; Gather the "to" addresses out of the follow-to list and remove
1632           ;; them as we go.
1633           (if (and follow-to (listp follow-to))
1634               (while (setq elt (assoc "Newsgroups" follow-to))
1635                 (setq sendto (concat sendto (and sendto ", ") (cdr elt)))
1636                 (setq follow-to (delq elt follow-to))))
1637
1638           (news-setup nil subject message-of 
1639                       (or group sendto 
1640                           (and follow-to
1641                                gnus-use-followup-to
1642                                (or (not (eq gnus-use-followup-to 'ask))
1643                                    (gnus-y-or-n-p 
1644                                     (format
1645                                      "Use Followup-To %s? " follow-to))))
1646                           group "")
1647                       gnus-article-copy)
1648
1649           (make-local-variable 'gnus-article-reply)
1650           (setq gnus-article-reply cur)
1651           (make-local-variable 'gnus-prev-winconf)
1652           (setq gnus-prev-winconf winconf)
1653           (make-local-variable 'gnus-reply-subject)
1654           (setq gnus-reply-subject (mail-header-subject gnus-current-headers))
1655
1656           (auto-save-mode auto-save-default)
1657           (gnus-inews-modify-mail-mode-map)
1658           (local-set-key "\C-c\C-c" 'gnus-inews-news)
1659
1660           (if (and follow-to (listp follow-to))
1661               (progn
1662                 (goto-char (point-min))
1663                 (and (re-search-forward "^Newsgroups:" nil t)
1664                      (forward-line 1))
1665                 (while follow-to
1666                   (insert (car (car follow-to)) ": " 
1667                           (cdr (car follow-to)) "\n")
1668                   (setq follow-to (cdr follow-to)))))
1669           
1670           ;; If a distribution existed, we use it.
1671           (if distribution
1672               (progn
1673                 (mail-position-on-field "Distribution")
1674                 (insert distribution)))
1675           
1676           (nnheader-insert-references references message-id)
1677
1678           ;; Handle `gnus-auto-mail-to-author'.
1679           ;; Suggested by Daniel Quinlan <quinlan@best.com>.
1680           ;; Revised to respect Reply-To by Ulrik Dickow <dickow@nbi.dk>.
1681           (let ((to (if (if (eq gnus-auto-mail-to-author 'ask)
1682                             (y-or-n-p "Also send mail to author? ")
1683                           gnus-auto-mail-to-author)
1684                         (or (save-excursion
1685                               (set-buffer gnus-article-copy)
1686                               (gnus-fetch-field "reply-to"))
1687                             from))))
1688             (if to
1689                 (if (mail-fetch-field "To")
1690                     (progn
1691                       (beginning-of-line)
1692                       (insert "Cc: " to "\n"))
1693                   (mail-position-on-field "To")
1694                   (insert to))))
1695
1696           ;; Handle author copy using BCC field.
1697           (if (and gnus-mail-self-blind
1698                    (not (mail-fetch-field "bcc")))
1699               (progn
1700                 (mail-position-on-field "Bcc")
1701                 (insert (if (stringp gnus-mail-self-blind)
1702                             gnus-mail-self-blind
1703                           (user-login-name)))))
1704           ;; Handle author copy using FCC field.
1705           (if gnus-author-copy
1706               (progn
1707                 (mail-position-on-field "Fcc")
1708                 (insert gnus-author-copy)))
1709         
1710           ;; Now the headers should be ok, so we do the yanking.
1711           (goto-char (point-min))
1712           (re-search-forward
1713            (concat "^" (regexp-quote mail-header-separator) "$"))
1714           (forward-line 1)
1715           (if (not yank)
1716               (gnus-configure-windows 'reply 'force)
1717             (let ((last (point))
1718                   end)
1719               (if (not (listp yank))
1720                   (progn
1721                     (save-excursion
1722                       (mail-yank-original nil))
1723                     (or mail-yank-hooks mail-citation-hook
1724                         (run-hooks 'news-reply-header-hook)))
1725                 (while yank
1726                   (save-window-excursion
1727                     (set-buffer gnus-summary-buffer)
1728                     (gnus-summary-select-article nil nil nil (car yank))
1729                     (gnus-summary-remove-process-mark (car yank)))
1730                   (save-excursion
1731                     (gnus-copy-article-buffer)
1732                     (mail-yank-original nil)
1733                     (setq end (point)))
1734                   (or mail-yank-hooks mail-citation-hook
1735                       (run-hooks 'news-reply-header-hook))
1736                   (goto-char end)
1737                   (setq yank (cdr yank))))
1738               (goto-char last))
1739             (gnus-configure-windows 'reply-yank 'force))
1740         
1741           (make-local-variable 'gnus-article-check-size)
1742           (setq gnus-article-check-size
1743                 (cons (buffer-size) (gnus-article-checksum))))))))
1744
1745 (defun gnus-mail-yank-original ()
1746   (interactive)
1747   (save-excursion
1748     (mail-yank-original nil))
1749   (or mail-yank-hooks mail-citation-hook
1750       (run-hooks 'news-reply-header-hook)))
1751
1752 (defun gnus-mail-send-and-exit (&optional dont-send)
1753   "Send the current mail and return to Gnus."
1754   (interactive)
1755   (let ((reply gnus-article-reply)
1756         (winconf gnus-prev-winconf))
1757     (or dont-send (gnus-mail-send))
1758     (bury-buffer)
1759     (if (get-buffer gnus-group-buffer)
1760         (progn
1761           (if (gnus-buffer-exists-p (car-safe reply))
1762               (progn
1763                 (set-buffer (car reply))
1764                 (and (cdr reply)
1765                      (gnus-summary-mark-article-as-replied 
1766                       (cdr reply)))))
1767           (and winconf (set-window-configuration winconf))))))
1768
1769 (defun gnus-put-message ()
1770   "Put the current message in some group and return to Gnus."
1771   (interactive)
1772   (let ((reply gnus-article-reply)
1773         (winconf gnus-prev-winconf)
1774         (group gnus-newsgroup-name)
1775         buf)
1776     
1777     (or (and group (not (gnus-group-read-only-p group)))
1778         (setq group (read-string "Put in group: " nil
1779                                  (gnus-writable-groups))))
1780     (and (gnus-gethash group gnus-newsrc-hashtb)
1781          (error "No such group: %s" group))
1782
1783     (save-excursion
1784       (save-restriction
1785         (widen)
1786         (gnus-inews-narrow-to-headers)
1787         (let (gnus-deletable-headers)
1788           (if (eq major-mode 'mail-mode)
1789               (gnus-inews-insert-headers gnus-required-mail-headers)
1790             (gnus-inews-insert-headers)))
1791         (goto-char (point-max))
1792         (insert "Gcc: " group "\n")
1793         (widen)))
1794
1795     (gnus-inews-do-gcc)
1796
1797     (if (get-buffer gnus-group-buffer)
1798         (progn
1799           (if (gnus-buffer-exists-p (car-safe reply))
1800               (progn
1801                 (set-buffer (car reply))
1802                 (and (cdr reply)
1803                      (gnus-summary-mark-article-as-replied 
1804                       (cdr reply)))))
1805           (and winconf (set-window-configuration winconf))))))
1806
1807
1808 (defun gnus-forward-make-subject (buffer)
1809   (save-excursion
1810     (set-buffer buffer)
1811     (concat "[" (if (memq 'mail (assoc (symbol-name 
1812                                         (car (gnus-find-method-for-group 
1813                                               gnus-newsgroup-name)))
1814                                        gnus-valid-select-methods))
1815                     (gnus-fetch-field "From")
1816                   gnus-newsgroup-name)
1817             "] " (or (gnus-fetch-field "Subject") ""))))
1818
1819 (defun gnus-forward-insert-buffer (buffer)
1820   (let ((beg (goto-char (point-max))))
1821     (insert "------- Start of forwarded message -------\n")
1822     (insert-buffer buffer)
1823     (goto-char (point-max))
1824     (insert "------- End of forwarded message -------\n")
1825     ;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>. 
1826     (goto-char beg)
1827     (while (setq beg (next-single-property-change (point) 'invisible))
1828       (goto-char beg)
1829       (delete-region beg (or (next-single-property-change 
1830                               (point) 'invisible)
1831                              (point-max))))))
1832
1833 (defun gnus-mail-forward (&optional buffer)
1834   "Forward the current message to another user using mail."
1835   ;; This is almost a carbon copy of rmail-forward in rmail.el.
1836   (let* ((forward-buffer (or buffer (current-buffer)))
1837          (winconf (current-window-configuration))
1838          (subject (gnus-forward-make-subject forward-buffer)))
1839     (set-buffer forward-buffer)
1840     (gnus-mail-setup nil subject nil nil nil nil 'forward)
1841     (mail nil nil subject)
1842     (gnus-inews-modify-mail-mode-map)
1843     (make-local-variable 'gnus-prev-winconf)
1844     (setq gnus-prev-winconf winconf)
1845     (gnus-forward-insert-buffer forward-buffer)
1846     (goto-char (point-min))
1847     (re-search-forward "^To: " nil t)
1848     (gnus-configure-windows 'mail-forward 'force)
1849     ;; You have a chance to arrange the message.
1850     (run-hooks 'gnus-mail-forward-hook)
1851     (run-hooks 'gnus-mail-hook)))
1852
1853 (defun gnus-forward-using-post (&optional buffer)
1854   (save-excursion
1855     (let* ((forward-buffer (or buffer (current-buffer))) 
1856            (subject (gnus-forward-make-subject forward-buffer))
1857            (gnus-newsgroup-name nil))
1858       (gnus-post-news 'post nil nil nil nil subject)
1859       (save-excursion
1860         (gnus-forward-insert-buffer forward-buffer)
1861         ;; You have a chance to arrange the message.
1862         (run-hooks 'gnus-mail-forward-hook)))))
1863
1864 (defun gnus-mail-other-window-using-mail ()
1865   "Compose mail other window using mail."
1866   (let ((winconf (current-window-configuration)))
1867     (mail-other-window nil nil nil nil nil (get-buffer gnus-article-buffer))
1868     (gnus-inews-modify-mail-mode-map)
1869     (make-local-variable 'gnus-prev-winconf)
1870     (setq gnus-prev-winconf winconf)
1871     (run-hooks 'gnus-mail-hook)
1872     (gnus-configure-windows 'summary-mail 'force)))
1873
1874 (defun gnus-article-mail (yank)
1875   "Send a reply to the address near point.
1876 If YANK is non-nil, include the original article."
1877   (interactive "P")
1878   (let ((address 
1879          (buffer-substring
1880           (save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point)))
1881           (save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point))))))
1882     (and address
1883          (progn
1884            (switch-to-buffer gnus-summary-buffer)
1885            (gnus-mail-reply yank address)))))
1886
1887 (defun gnus-bug ()
1888   "Send a bug report to the Gnus maintainers."
1889   (interactive)
1890   (let ((winconf (current-window-configuration)))
1891     (delete-other-windows)
1892     (switch-to-buffer "*Gnus Help Bug*")
1893     (erase-buffer)
1894     (insert gnus-bug-message)
1895     (goto-char (point-min))
1896     (pop-to-buffer "*Gnus Bug*")
1897     (erase-buffer)
1898     (mail-mode)
1899     (mail-setup gnus-maintainer nil nil nil nil nil)
1900     (auto-save-mode auto-save-default)
1901     (make-local-variable 'gnus-prev-winconf)
1902     (setq gnus-prev-winconf winconf)
1903     (gnus-inews-modify-mail-mode-map)
1904     (local-set-key "\C-c\C-c" 'gnus-bug-mail-send-and-exit)
1905     (goto-char (point-min))
1906     (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
1907     (forward-line 1)
1908     (insert (format "%s\n%s\n\n\n\n\n" (gnus-version) (emacs-version)))
1909     (gnus-debug)
1910     (goto-char (point-min))
1911     (search-forward "Subject: " nil t)
1912     (message "")))
1913
1914 (defun gnus-bug-mail-send-and-exit ()
1915   "Send the bug message and exit."
1916   (interactive)
1917   (and (get-buffer "*Gnus Help Bug*")
1918        (kill-buffer "*Gnus Help Bug*"))
1919   (gnus-mail-send-and-exit))
1920
1921 (defun gnus-debug ()
1922   "Attemps to go through the Gnus source file and report what variables have been changed.
1923 The source file has to be in the Emacs load path."
1924   (interactive)
1925   (let ((files '("gnus.el" "gnus-msg.el" "gnus-score.el"))
1926         file dirs expr olist sym)
1927     (message "Please wait while we snoop your variables...")
1928     (sit-for 0)
1929     (save-excursion
1930       (set-buffer (get-buffer-create " *gnus bug info*"))
1931       (buffer-disable-undo (current-buffer))
1932       (while files
1933         (erase-buffer)
1934         (setq dirs load-path)
1935         (while dirs
1936           (if (or (not (car dirs))
1937                   (not (stringp (car dirs)))
1938                   (not (file-exists-p 
1939                         (setq file (concat (file-name-as-directory 
1940                                             (car dirs)) (car files))))))
1941               (setq dirs (cdr dirs))
1942             (setq dirs nil)
1943             (insert-file-contents file)
1944             (goto-char (point-min))
1945             (or (re-search-forward "^;;* *Internal variables" nil t)
1946                 (error "Malformed sources in file %s" file))
1947             (narrow-to-region (point-min) (point))
1948             (goto-char (point-min))
1949             (while (setq expr (condition-case () 
1950                                   (read (current-buffer)) (error nil)))
1951               (condition-case ()
1952                   (and (eq (car expr) 'defvar)
1953                        (stringp (nth 3 expr))
1954                        (or (not (boundp (nth 1 expr)))
1955                            (not (equal (eval (nth 2 expr))
1956                                        (symbol-value (nth 1 expr)))))
1957                        (setq olist (cons (nth 1 expr) olist)))
1958                 (error nil)))))
1959         (setq files (cdr files)))
1960       (kill-buffer (current-buffer)))
1961     (insert "------------------- Environment follows -------------------\n\n")
1962     (while olist
1963       (if (boundp (car olist))
1964           (insert "(setq " (symbol-name (car olist)) 
1965                   (if (or (consp (setq sym (symbol-value (car olist))))
1966                           (and (symbolp sym)
1967                                (not (or (eq sym nil)
1968                                         (eq sym t)))))
1969                       " '" " ")
1970                   (prin1-to-string (symbol-value (car olist))) ")\n")
1971         (insert ";; (makeunbound '" (symbol-name (car olist)) ")\n"))
1972       (setq olist (cdr olist)))
1973     (insert "\n\n")
1974     ;; Remove any null chars - they seem to cause trouble for some
1975     ;; mailers. (Byte-compiled output from the stuff above.) 
1976     (goto-char (point-min))
1977     (while (re-search-forward "[\000\200]" nil t)
1978       (replace-match "" t t))))
1979
1980
1981 ;;; Treatment of rejected articles.
1982
1983
1984 ;;; Bounced mail.
1985
1986 (defun gnus-summary-resend-bounced-mail (fetch)
1987   "Re-mail the current message.
1988 This only makes sense if the current message is a bounce message than
1989 contains some mail you have written which has been bounced back to
1990 you.
1991 If FETCH, try to fetch the article that this is a reply to, if indeed
1992 this is a reply."
1993   (interactive)
1994   (gnus-summary-select-article t)
1995   ;; Create a mail buffer.
1996   (gnus-new-mail)
1997   (erase-buffer)
1998   (insert-buffer gnus-article-buffer)
1999   (goto-char (point-min))
2000   (search-forward "\n\n")
2001   ;; We remove everything before the bounced mail.
2002   (delete-region 
2003    (point-min)
2004    (if (re-search-forward "[^ \t]*:" nil t)
2005        (match-beginning 0)
2006      (point)))
2007   (let (references)
2008     (save-excursion
2009       (save-restriction
2010         (gnus-narrow-to-headers)
2011         (nnheader-remove-header gnus-bounced-headers-junk t)
2012         (setq references (mail-fetch-field "references"))
2013         (goto-char (point-max))
2014         (insert mail-header-separator)))
2015     ;; If there are references, we fetch the article we answered to.  
2016     (and fetch 
2017          references
2018          (string-match "\\(<[^]+>\\)[ \t]*$" references)
2019          (gnus-summary-refer-article 
2020           (substring references (match-beginning 1) (match-end 1)))
2021          (progn
2022            (gnus-summary-show-all-headers)
2023            (gnus-configure-windows 'compose-bounce))))
2024   (goto-char (point-min)))
2025
2026 ;;; Sending mail.
2027
2028 (defun gnus-mail-send ()
2029   "Send the current buffer as mail.
2030 Headers will be generated before sending."
2031   (interactive)
2032   (save-excursion
2033     (save-restriction
2034       (widen)
2035       (gnus-inews-narrow-to-headers)
2036       (gnus-inews-remove-headers)
2037       (gnus-inews-insert-headers gnus-required-mail-headers)))
2038   (widen)
2039   ;; Remove the header separator.
2040   (goto-char (point-min))
2041   (and (re-search-forward
2042         (concat "^" (regexp-quote mail-header-separator) "$") nil t)
2043        (replace-match "" t t))
2044   ;; Run final inews hooks.  This hook may do FCC.
2045   (run-hooks 'gnus-inews-article-hook)
2046   (gnus-inews-do-gcc)
2047   (gnus-narrow-to-headers)
2048   (nnheader-remove-header "^[gf]cc:" t)
2049   (widen)
2050   (goto-char (point-min))
2051   (search-forward "\n\n")
2052   (forward-char -1)
2053   (insert mail-header-separator)
2054   (mail-send)
2055   (run-hooks 'gnus-message-sent-hook))
2056
2057 (defun gnus-inews-modify-mail-mode-map ()
2058   (use-local-map (copy-keymap (current-local-map)))
2059   (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit)
2060   (local-set-key "\C-c\C-p" 'gnus-put-message)
2061   (local-set-key "\C-c\C-d" 'gnus-enter-into-draft-group))
2062
2063 (defun gnus-mail-setup (to subject in-reply-to cc replybuffer actions
2064                            &optional type)
2065   (funcall
2066    (cond
2067     ((or 
2068       (and (eq type 'reply) 
2069            (eq gnus-mail-reply-method 'gnus-mail-reply-using-mhe))
2070       (and (eq type 'forward)
2071            (eq gnus-mail-forward-method 'gnus-mail-forward-using-mhe))
2072       (and (eq type 'new) 
2073            (eq gnus-mail-other-window-method 
2074                'gnus-mail-other-window-using-mhe)))
2075      'gnus-mh-mail-setup)
2076     ((or 
2077       (and (eq type 'reply) 
2078            (eq gnus-mail-reply-method 'gnus-mail-reply-using-vm))
2079       (and (eq type 'forward)
2080            (eq gnus-mail-forward-method 'gnus-mail-forward-using-vm))
2081       (and (eq type 'new) 
2082            (eq gnus-mail-other-window-method 
2083                'gnus-mail-other-window-using-vm)))
2084      'gnus-vm-mail-setup)
2085     (t 'gnus-sendmail-mail-setup))
2086    to subject in-reply-to cc replybuffer actions))
2087
2088 (defun gnus-sendmail-mail-setup (to subject in-reply-to cc replybuffer actions)
2089   (mail-setup to subject in-reply-to cc replybuffer actions))
2090   
2091 ;;; Gcc handling.
2092
2093 ;; Do Gcc handling, which copied the message over to some group. 
2094 (defun gnus-inews-do-gcc (&optional gcc)
2095   (save-excursion
2096     (save-restriction
2097       (gnus-narrow-to-headers)
2098       (let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
2099             end)
2100         (if (not gcc)
2101             () ; Nothing to be done.
2102           (nnheader-remove-header "gcc")
2103           ;; Copy the article over to some group(s).
2104           (while (string-match
2105                   "^[ \t]*\\([^ \t]+\\)\\([ \t]+\\|$\\)" gcc)
2106             (setq end (match-end 0))
2107             (condition-case ()
2108                 (gnus-request-accept-article 
2109                  (substring gcc (match-beginning 1) (match-end 1)) t)
2110               (error nil))
2111             (setq gcc (substring gcc end))))))))
2112
2113 (defun gnus-inews-insert-gcc ()
2114   (let* ((group gnus-outgoing-message-group)
2115          (gcc (cond 
2116                ((and (symbolp group) (fboundp group))
2117                 (funcall group))
2118                ((or (stringp group) (list group))
2119                 group))))
2120     (if (not gcc)
2121         () ; Insert no Gcc.
2122       (insert "Gcc: "
2123               (if (stringp group) group
2124                 (mapconcat 'identity group " "))
2125               "\n"))))
2126
2127 ;;; Handling rejected (and postponed) news.
2128
2129 (defun gnus-draft-group ()
2130   "Return the name of the draft group."
2131   (gnus-group-prefixed-name 
2132    (file-name-nondirectory gnus-draft-group-directory)
2133    (list 'nndir gnus-draft-group-directory)))
2134
2135 (defun gnus-make-draft-group ()
2136   "Make the draft group or die trying."
2137   (let* ((method (` (nndir "private" 
2138                            (nndir-directory (, gnus-draft-group-directory)))))
2139          (group (gnus-group-prefixed-name 
2140                  (file-name-nondirectory gnus-draft-group-directory)
2141                  method)))
2142     (or (gnus-gethash group gnus-newsrc-hashtb)
2143         (gnus-group-make-group (gnus-group-real-name group) method)
2144         (error "Can't create the draft group"))
2145     group))
2146
2147 (defun gnus-enter-into-draft-group ()
2148   "Enter the current buffer into the draft group."
2149   (interactive)
2150   (gnus-put-in-draft-group t))
2151
2152 (defun gnus-put-in-draft-group (&optional generate silent)
2153   "Does the actual putting."
2154   (let ((group (gnus-make-draft-group))
2155         (type (list major-mode (buffer-name) gnus-newsgroup-name
2156                     (point)))
2157         (mode major-mode)
2158         (buf (current-buffer)))
2159     (widen)
2160     (save-excursion
2161       (nnheader-set-temp-buffer " *enter-draft*")
2162       (insert-buffer buf)
2163       (save-restriction
2164         (widen)
2165         (gnus-inews-narrow-to-headers)
2166         (let (gnus-deletable-headers)
2167           (if (eq mode 'mail-mode)
2168               (gnus-inews-insert-headers gnus-required-mail-headers)
2169             (gnus-inews-insert-headers)))
2170         (widen))
2171
2172       (goto-char (point-min))
2173       ;; We have to store whether we are in a mail group or news group. 
2174       (insert (format "X-Gnus-Draft-Type: %S\n" type))
2175       (and (re-search-forward
2176             (concat "^" (regexp-quote mail-header-separator) "$") nil t)
2177            (replace-match "" t t))
2178       (if (prog1
2179               (gnus-request-accept-article group t)
2180             (kill-buffer (current-buffer)))
2181           (or silent
2182               (gnus-mail-send-and-exit 'dont-send))))
2183     (set-buffer-modified-p nil)))
2184
2185 (defun gnus-summary-send-draft ()
2186   "Enter a mail/post buffer to edit and send the draft."
2187   (interactive)
2188   (gnus-set-global-variables)
2189   (gnus-summary-select-article t)
2190   ;; First we find the draft type.
2191   (let (type)
2192     (save-excursion 
2193       (set-buffer gnus-article-buffer)
2194       (widen)
2195       (gnus-narrow-to-headers)
2196       (setq type (condition-case ()
2197                      (read (mail-fetch-field "x-gnus-draft-type"))
2198                    (error nil)))
2199       (widen))
2200     (or type
2201         (error "Unknown draft type"))
2202     ;; Get to the proper buffer.
2203     (set-buffer (get-buffer-create (nth 1 type)))
2204     ;; It might be modified.
2205     (and (buffer-modified-p)
2206          (or (gnus-yes-or-no-p "Unsent message being composed; discard it? ")
2207              (error "Break")))
2208     (setq buffer-read-only nil)
2209     (buffer-enable-undo (current-buffer))
2210     (erase-buffer)
2211     ;; Set proper mode.
2212     (funcall (car type))
2213     (and (eq major-mode 'mail-mode)
2214          (gnus-inews-modify-mail-mode-map))
2215     ;; Arrange for deletion of the draft after successful sending.
2216     (make-local-variable 'gnus-message-sent-hook)
2217     (setq gnus-message-sent-hook
2218           (list
2219            (`
2220             (lambda ()
2221               (gnus-request-expire-articles 
2222                (, (list (cdr gnus-article-current)))
2223                (, gnus-newsgroup-name) t)))))
2224     ;; Insert the draft.
2225     (insert-buffer gnus-article-buffer)
2226     ;; Insert the separator.
2227     (goto-char (point-min))
2228     (search-forward "\n\n")
2229     (forward-char -1)
2230     (insert mail-header-separator)
2231     ;; Remove the draft header.
2232     (gnus-inews-narrow-to-headers)
2233     (nnheader-remove-header "x-gnus-draft-type")
2234     (widen)
2235     ;; Configure windows.
2236     (let ((gnus-draft-buffer (current-buffer)))
2237       (gnus-configure-windows 'draft))
2238     ;; Put point where you left it.
2239     (goto-char (nth 3 type))))
2240   
2241
2242 ;;; Allow redefinition of functions.
2243
2244 (gnus-ems-redefine)
2245
2246 (provide 'gnus-msg)
2247
2248 ;;; gnus-msg.el ends here