*** empty log message ***
[gnus] / lisp / gnus-msg.el
index 3565aaf..4e77b21 100644 (file)
@@ -27,6 +27,8 @@
 
 (require 'gnus)
 (require 'sendmail)
+(require 'gnus-ems)
+(require 'rmail)
 
 (defvar gnus-organization-file "/usr/lib/news/organization"
   "*Local news organization file.")
@@ -148,7 +150,7 @@ RFC977 and RFC1036 require From, Date, Newsgroups, Subject,
 Message-ID.  Organization, Lines and X-Newsreader are optional.  If
 you want Gnus not to insert some header, remove it from this list.")
 
-(defvar gnus-deletable-headers '(Message-ID)
+(defvar gnus-deletable-headers '(Message-ID Date)
   "*Headers to be deleted if they already exists.")
 
 (defvar gnus-check-before-posting 
@@ -159,6 +161,11 @@ you want Gnus not to insert some header, remove it from this list.")
 If this variable is t, Gnus will check everything it can.  If it is a
 list, then those elements in that list will be checked.")
 
+(defvar gnus-delete-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:"
+  "*Header lines matching this regexp will be deleted before posting.
+It's best to delete old Path and Date headers before psoting to avoid
+any confusion.")
+
 (defvar gnus-auto-mail-to-author nil
   "*If non-nil, mail the authors of articles a copy of your follow-ups.
 If this variable is `ask', the user will be prompted for whether to
@@ -214,6 +221,7 @@ headers.")
 ;;; Internal variables.
 
 (defvar gnus-post-news-buffer "*post-news*")
+(defvar gnus-mail-buffer "*mail*")
 (defvar gnus-summary-send-map nil)
 (defvar gnus-article-copy nil)
 (defvar gnus-reply-subject nil)
@@ -255,9 +263,7 @@ headers.")
 (defun gnus-group-mail ()
   "Start composing a mail."
   (interactive)
-  (funcall gnus-mail-other-window-method)
-  (gnus-configure-windows 'group-mail)
-  (run-hooks 'gnus-mail-hook))
+  (funcall gnus-mail-other-window-method))
 
 (defun gnus-group-post-news ()
   "Post an article."
@@ -278,8 +284,8 @@ If prefix argument YANK is non-nil, original article is yanked automatically."
   (gnus-set-global-variables)
   (if yank-articles (gnus-summary-goto-subject (car yank-articles)))
   (save-window-excursion
-    (gnus-summary-select-article t))
-  (let ((headers gnus-current-headers)
+    (gnus-summary-select-article))
+  (let ((headers (gnus-get-header-by-number (gnus-summary-article-number)))
        (gnus-newsgroup-name gnus-newsgroup-name))
     ;; Check Followup-To: poster.
     (set-buffer gnus-article-buffer)
@@ -288,12 +294,11 @@ If prefix argument YANK is non-nil, original article is yanked automatically."
             (or (not (eq gnus-use-followup-to t))
                 (not (gnus-y-or-n-p 
                       "Do you want to ignore `Followup-To: poster'? "))))
-       ;; Mail to the poster.  Gnus is now RFC1036 compliant.
+       ;; Mail to the poster. 
        (gnus-summary-reply yank)
       (gnus-post-news nil gnus-newsgroup-name
                      headers gnus-article-buffer 
-                     (or yank-articles (not (not yank))))))
-  (gnus-article-hide-headers-if-wanted))
+                     (or yank-articles (not (not yank)))))))
 
 (defun gnus-summary-followup-with-original (n)
   "Compose a followup to an article and include the original article."
@@ -320,9 +325,9 @@ If prefix argument YANK is non-nil, original article is yanked automatically."
   (let ((articles (gnus-summary-work-articles n)))
     (while articles
       (gnus-summary-select-article t nil nil (car articles))
-      (gnus-eval-in-buffer-window gnus-article-buffer (gnus-cancel-news))
+      (and (gnus-eval-in-buffer-window gnus-article-buffer (gnus-cancel-news))
+          (gnus-summary-mark-as-read (car articles) gnus-canceled-mark))
       (gnus-summary-remove-process-mark (car articles))
-      (gnus-summary-mark-as-read (car articles) gnus-canceled-mark)
       (gnus-article-hide-headers-if-wanted)
       (setq articles (cdr articles)))))
 
@@ -332,13 +337,13 @@ This is done simply by taking the old article and adding a Supersedes
 header line with the old Message-ID."
   (interactive)
   (gnus-set-global-variables)
+  (gnus-summary-select-article t)
   (if (not
        (string-equal
        (downcase (mail-strip-quoted-names 
                   (header-from gnus-current-headers)))
        (downcase (mail-strip-quoted-names (gnus-inews-user-name)))))
       (error "This article is not yours."))
-  (gnus-summary-select-article t)
   (save-excursion
     (set-buffer gnus-article-buffer)
     (let ((buffer-read-only nil))
@@ -357,7 +362,14 @@ header line with the old Message-ID."
          (replace-match "Supersedes: " t t))
        (search-forward "\n\n")
        (forward-line -1)
-       (insert mail-header-separator))))
+       (insert mail-header-separator)
+
+       (forward-line -1)
+       (narrow-to-region (point-min) (point))
+       (goto-char (point-min))
+       (and gnus-delete-supersedes-headers
+            (delete-matching-lines gnus-delete-supersedes-headers))
+       (widen))))
 
 \f
 ;;;###autoload
@@ -407,7 +419,7 @@ Type \\[describe-mode] in the buffer to get a list of commands."
                          (cons (current-buffer) gnus-current-article))))
            (from (and header (header-from header)))
            (winconf (current-window-configuration))
-           follow-to real-group)
+           real-group)
        (and gnus-interactive-post
             (not gnus-expert-user)
             post (not group)
@@ -431,16 +443,15 @@ Type \\[describe-mode] in the buffer to get a list of commands."
                     (if (and (boundp 'gnus-followup-to-function)
                              gnus-followup-to-function
                              gnus-article-copy)
-                        (setq follow-to
-                              (save-excursion
-                                (set-buffer gnus-article-copy)
-                                (funcall gnus-followup-to-function group)))))
+                        (save-excursion
+                          (set-buffer gnus-article-copy)
+                          (funcall gnus-followup-to-function group))))
                 gnus-use-followup-to))
          (if post
-             (gnus-configure-windows 'post)
+             (gnus-configure-windows 'post 'force)
            (if yank
-               (gnus-configure-windows 'followup-yank)
-             (gnus-configure-windows 'followup)))
+               (gnus-configure-windows 'followup-yank 'force)
+             (gnus-configure-windows 'followup 'force)))
          (gnus-overload-functions)
          (make-local-variable 'gnus-article-reply)
          (make-local-variable 'gnus-article-check-size)
@@ -518,7 +529,8 @@ will attempt to use the foreign server to post the article."
   (interactive "P")
   (let* ((case-fold-search nil)
         (server-running (gnus-server-opened gnus-select-method))
-        (reply gnus-article-reply))
+        (reply gnus-article-reply)
+        error post-result)
     (save-excursion
       ;; Connect to default NNTP server if necessary.
       ;; Suggested by yuki@flab.fujitsu.junet.
@@ -670,26 +682,34 @@ will attempt to use the foreign server to post the article."
 
       ;; Send to server. 
       (gnus-message 5 "Posting to USENET...")
-      (if (funcall gnus-inews-article-function use-group-method)
-         (progn
-           (gnus-message 5 "Posting to USENET...done")
-           (if (gnus-buffer-exists-p (car-safe reply))
-               (progn
-                 (save-excursion
-                   (set-buffer gnus-summary-buffer)
-                   (gnus-summary-mark-article-as-replied 
-                    (cdr reply))))))
-       ;; We cannot signal an error.
-       (ding) (gnus-message 1 "Article rejected: %s" 
-                            (gnus-status-message gnus-select-method)))
-      (set-buffer-modified-p nil))
+      (setq post-result (funcall gnus-inews-article-function use-group-method))
+      (cond ((eq post-result 'illegal)
+            (setq error t)
+            (ding))
+           (post-result
+            (gnus-message 5 "Posting to USENET...done")
+            (if (gnus-buffer-exists-p (car-safe reply))
+                (progn
+                  (save-excursion
+                    (set-buffer gnus-summary-buffer)
+                    (gnus-summary-mark-article-as-replied 
+                     (cdr reply)))))
+            (set-buffer-modified-p nil))
+           (t
+            ;; We cannot signal an error.
+            (setq error t)
+            (ding)
+            (gnus-message 1 "Article rejected: %s" 
+                          (gnus-status-message gnus-select-method)))))
     ;; If NNTP server is opened by gnus-inews-news, close it by myself.
     (or server-running
        (gnus-close-server (gnus-find-method-for-group gnus-newsgroup-name)))
     (let ((conf gnus-prev-winconf))
-      (bury-buffer)
-      ;; Restore last window configuration.
-      (and conf (set-window-configuration conf)))))
+      (if (not error)
+         (progn
+           (bury-buffer)
+           ;; Restore last window configuration.
+           (and conf (set-window-configuration conf)))))))
 
 (defun gnus-inews-check-post ()
   "Check whether the post looks ok."
@@ -702,22 +722,26 @@ will attempt to use the foreign server to post the article."
        (goto-char (point-min))
        (narrow-to-region 
         (point) 
-        (re-search-forward 
-         (concat "^" (regexp-quote mail-header-separator) "$")))
+        (progn
+          (re-search-forward 
+           (concat "^" (regexp-quote mail-header-separator) "$"))
+          (match-beginning 0)))
        (goto-char (point-min))
        (and 
         ;; Check for commands in Subject.
-        (or (gnus-check-before-posting 'subject-cmsg)
-            (save-excursion
-              (if (string-match "^cmsg " (mail-fetch-field "subject"))
-                  (gnus-y-or-n-p
-                   "The control code \"cmsg \" is in the subject. Really post? ")
-                t)))
+        (or 
+         (gnus-check-before-posting 'subject-cmsg)
+         (save-excursion
+           (if (string-match "^cmsg " (mail-fetch-field "subject"))
+               (gnus-y-or-n-p
+                "The control code \"cmsg \" is in the subject. Really post? ")
+             t)))
         ;; Check for multiple identical headers.
         (or (gnus-check-before-posting 'multiple-headers)
             (save-excursion
               (let (found)
-                (while (and (not found) (re-search-forward "^[^ \t:]+: " nil t))
+                (while (and (not found) (re-search-forward "^[^ \t:]+: "
+                                                           nil t))
                   (save-excursion
                     (or (re-search-forward 
                          (concat "^" (setq found
@@ -756,12 +780,20 @@ will attempt to use the foreign server to post the article."
             (save-excursion
               (let* ((case-fold-search t)
                      (from (mail-fetch-field "from")))
-                (or (not from)
-                    (and (string-match "@" from)
-                         (string-match "@[^\\.]*\\." from))
-                    (gnus-yes-or-no-p
-                     (format "The From looks strange: \"%s\". Really post? "
-                             from)))))))))
+                (cond
+                 ((not from)
+                  (gnus-yes-or-no-p "There is no From line. Really post? "))
+                 ((not (string-match "@[^\\.]*\\." from))
+                  (gnus-yes-or-no-p
+                   (format 
+                    "The address looks strange: \"%s\". Really post? " from)))
+                 ((string-match "(.*).*(.*)" from)
+                  (gnus-yes-or-no-p
+                   (format
+                    "The From header looks strange: \"%s\". Really post? " 
+                    from)))
+                 (t t)))))
+        )))
     ;; Check for long lines.
     (or (gnus-check-before-posting 'long-lines)
        (save-excursion
@@ -794,12 +826,13 @@ will attempt to use the foreign server to post the article."
          t))
     ;; Use the (size . checksum) variable to see whether the
     ;; article is empty or has only quoted text.
-    (or (gnus-check-before-posting 'new-text)
-       (if (and (= (buffer-size) (car gnus-article-check-size))
-                (= (gnus-article-checksum) (cdr gnus-article-check-size)))
-           (gnus-yes-or-no-p
-            "It looks like there's no new text in your article. Really post? ")
-         t))
+    (or
+     (gnus-check-before-posting 'new-text)
+     (if (and (= (buffer-size) (car gnus-article-check-size))
+             (= (gnus-article-checksum) (cdr gnus-article-check-size)))
+        (gnus-yes-or-no-p
+         "It looks like there's no new text in your article. Really post? ")
+       t))
     ;; Check the length of the signature.
     (or (gnus-check-before-posting 'signature)
        (progn
@@ -822,10 +855,11 @@ will attempt to use the foreign server to post the article."
 
 ;; Returns non-nil if this type is not to be checked.
 (defun gnus-check-before-posting (type)
-  (or (not gnus-check-before-posting)
-      (if (listp gnus-check-before-posting)
-         (memq type gnus-check-before-posting)
-       t)))
+  (not 
+   (or (not gnus-check-before-posting)
+       (if (listp gnus-check-before-posting)
+          (memq type gnus-check-before-posting)
+        t))))
 
 (defun gnus-cancel-news ()
   "Cancel an article you posted."
@@ -837,7 +871,7 @@ will attempt to use the foreign server to post the article."
            (message-id nil)
            (distribution nil))
        (or (gnus-member-of-valid 'post gnus-newsgroup-name)
-           (error "This backend does not support cancelling"))
+           (error "This backend does not support canceling"))
        (save-excursion
          ;; Get header info. from original article.
          (save-restriction
@@ -856,7 +890,8 @@ will attempt to use the foreign server to post the article."
                (downcase (mail-strip-quoted-names from))
                (downcase (mail-strip-quoted-names (gnus-inews-user-name)))))
              (progn
-               (ding) (gnus-message 3 "This article is not yours."))
+               (ding) (gnus-message 3 "This article is not yours.")
+               nil)
            ;; Make control article.
            (set-buffer (get-buffer-create " *Gnus-canceling*"))
            (buffer-disable-undo (current-buffer))
@@ -864,17 +899,24 @@ will attempt to use the foreign server to post the article."
            (insert "Newsgroups: " newsgroups "\n"
                    "Subject: cancel " message-id "\n"
                    "Control: cancel " message-id "\n"
+                   (if distribution
+                       (concat "Distribution: " distribution "\n")
+                     "")
                    mail-header-separator "\n"
                    "This is a cancel message from " from ".\n")
            ;; Send the control article to NNTP server.
            (gnus-message 5 "Canceling your article...")
-           (if (funcall gnus-inews-article-function)
-               (gnus-message 5 "Canceling your article...done")
-             (ding) 
-             (gnus-message 1 "Cancel failed; %s" 
-                           (gnus-status-message gnus-newsgroup-name)))
-           ;; Kill the article buffer.
-           (kill-buffer (current-buffer)))))))
+           (prog1
+               (if (funcall gnus-inews-article-function)
+                   (gnus-message 5 "Canceling your article...done")
+                 (progn
+                   (ding) 
+                   (gnus-message 1 "Cancel failed; %s" 
+                                 (gnus-status-message gnus-newsgroup-name))
+                   nil)
+                 t)
+             ;; Kill the article buffer.
+             (kill-buffer (current-buffer))))))))
 
 \f
 ;;; Lowlevel inews interface
@@ -906,7 +948,7 @@ will attempt to use the foreign server to post the article."
     (if (and gnus-article-check-size
             (not (gnus-inews-check-post)))
        ;; Aber nein!
-       ()
+       'illegal
       ;; Looks ok, so we do the nasty.
       (save-excursion
        (set-buffer tmpbuf)
@@ -969,18 +1011,9 @@ Headers in `gnus-required-headers' will be generated."
        (goto-char (point-min))
        (and (re-search-forward 
              (concat "^" (symbol-name (car headers)) ": *") nil t)
-            (get-text-property (match-end 0) 'gnus-delete)
+            (get-text-property (1+ (match-beginning 0)) 'gnus-deletable)
             (gnus-delete-line))
        (setq headers (cdr headers))))
-    ;; Insert new Sender if the From is strange. 
-    (let ((from (mail-fetch-field "from")))
-      (if (and from (not (string= (downcase from) (downcase From))))
-         (progn
-           (goto-char (point-min))    
-           (and (re-search-forward "^Sender:" nil t)
-                (delete-region (progn (beginning-of-line) (point))
-                               (progn (forward-line 1) (point))))
-           (insert "Sender: " From "\n"))))
     ;; If there are References, and no "Re: ", then the thread has
     ;; changed name. See Son-of-1036.
     (if (and (mail-fetch-field "references")
@@ -1027,17 +1060,34 @@ Headers in `gnus-required-headers' will be generated."
                      ;; so we just ask the user.
                      (read-from-minibuffer
                       (format "Empty header for %s; enter value: " header))))
-           ;; Add the deletable property to the headers that require it. 
-           (and (memq header gnus-deletable-headers)
-                (add-text-properties 
-                 0 (length value) '(gnus-deletable t) value))
            ;; Finally insert the header.
-           (if (bolp)
-               (save-excursion
-                 (goto-char (point-max))
-                 (insert (symbol-name header) ": " value "\n"))
-             (replace-match value t t))))
-      (setq headers (cdr headers)))))
+           (save-excursion
+             (if (bolp)
+                 (progn
+                   (goto-char (point-max))
+                   (insert (symbol-name header) ": " value "\n")
+                   (forward-line -1))
+               (replace-match value t t))
+             ;; Add the deletable property to the headers that require it.
+             (and (memq header gnus-deletable-headers)
+                  (progn (beginning-of-line) (looking-at "[^:]+: "))
+                  (add-text-properties 
+                   (point) (match-end 0)
+                   '(gnus-deletable t face italic) (current-buffer))))))
+      (setq headers (cdr headers)))
+    ;; Insert new Sender if the From is strange. 
+    (let ((from (mail-fetch-field "from")))
+      (if (and from (not (string=
+                         (downcase (car (gnus-extract-address-components 
+                                         from)))
+                         (downcase (gnus-inews-real-user-address)))))
+         (progn
+           (goto-char (point-min))    
+           (and (re-search-forward "^Sender:" nil t)
+                (delete-region (progn (beginning-of-line) (point))
+                               (progn (forward-line 1) (point))))
+           (insert "Sender: " (gnus-inews-real-user-address) "\n"))))))
+
 
 (defun gnus-inews-insert-signature ()
   "Insert a signature file.
@@ -1051,10 +1101,8 @@ nil."
   (save-excursion
     (let ((signature 
           (or (and gnus-signature-function
-                   (fboundp gnus-signature-function)
                    (funcall gnus-signature-function gnus-newsgroup-name))
-              gnus-signature-file))
-         b)
+              gnus-signature-file)))
       (if (and signature
               (or (file-exists-p signature)
                   (string-match " " signature)
@@ -1066,14 +1114,32 @@ nil."
                ()
              ;; Delete any previous signatures.
              (if (search-backward "\n-- \n" nil t)
-                 (delete-region (1+ (point)) (point-max)))
-             (insert "\n-- \n")
+                 (delete-region (point) (point-max)))
+             (or (eolp) (insert "\n"))
+             (insert "-- \n")
              (if (file-exists-p signature)
                  (insert-file-contents signature)
                (insert signature))
              (goto-char (point-max))
              (or (bolp) (insert "\n"))))))))
 
+;; Written by "Mr. Per Persson" <pp@solace.mh.se>.
+(defun gnus-inews-insert-mime-headers ()
+  (let ((mail-header-separator ""))
+    (or (mail-position-on-field "Mime-Version")
+       (insert "1.0")
+       (cond ((save-excursion
+                (beginning-of-buffer)
+                (re-search-forward "[\200-\377]" nil t))
+              (or (mail-position-on-field "Content-Type")
+                  (insert "text/plain; charset=ISO-8859-1"))
+              (or (mail-position-on-field "Content-Transfer-Encoding")
+                  (insert "8bit")))
+             (t (or (mail-position-on-field "Content-Type")
+                    (insert "text/plain; charset=US-ASCII"))
+                (or (mail-position-on-field "Content-Transfer-Encoding")
+                    (insert "7bit")))))))
+
 (defun gnus-inews-do-fcc ()
   "Process FCC: fields in current article buffer.
 Unless the first character of the field is `|', the article is saved
@@ -1151,6 +1217,12 @@ a program specified by the rest of the value."
                      (t
                       (concat " (" full-name ")")))))))
 
+(defun gnus-inews-real-user-address ()
+  "Return the \"real\" user address.
+This function tries to ignore all user modifications, and 
+give as trustworthy answer as possible."
+  (concat (user-login-name) "@" (gnus-inews-full-address)))
+
 (defun gnus-inews-login-name ()
   "Return login name."
   (or gnus-user-login-name (getenv "LOGNAME") (user-login-name)))
@@ -1261,6 +1333,9 @@ organization."
              "~/.organization")))
     (and (stringp organization)
         (> (length organization) 0)
+        (or (file-exists-p organization)
+            (string-match " " organization)
+            (not (string-match "^/usr/lib/" organization)))
         (save-excursion
           (gnus-set-work-buffer)
           (if (file-exists-p organization)
@@ -1298,11 +1373,10 @@ Customize the variable gnus-mail-reply-method to use another mailer."
   ;; Stripping headers should be specified with mail-yank-ignored-headers.
   (gnus-set-global-variables)
   (if yank-articles (gnus-summary-goto-subject (car yank-articles)))
-  (gnus-summary-select-article t)
+  (gnus-summary-select-article)
   (let ((gnus-newsgroup-name gnus-newsgroup-name))
     (bury-buffer gnus-article-buffer)
-    (funcall gnus-mail-reply-method (or yank-articles (not (not yank)))))
-  (gnus-article-hide-headers-if-wanted))
+    (funcall gnus-mail-reply-method (or yank-articles (not (not yank))))))
 
 (defun gnus-summary-reply-with-original (n)
   "Reply mail to news author with original article.
@@ -1315,13 +1389,12 @@ Customize the variable gnus-mail-reply-method to use another mailer."
 Customize the variable gnus-mail-forward-method to use another mailer."
   (interactive "P")
   (gnus-set-global-variables)
-  (gnus-summary-select-article t)
+  (gnus-summary-select-article)
   (gnus-copy-article-buffer)
   (let ((gnus-newsgroup-name gnus-newsgroup-name))
     (if post
        (gnus-forward-using-post gnus-article-copy)
-      (funcall gnus-mail-forward-method gnus-article-copy)))
-  (gnus-article-hide-headers-if-wanted))
+      (funcall gnus-mail-forward-method gnus-article-copy))))
 
 (defun gnus-summary-post-forward ()
   "Forward the current article to a newsgroup."
@@ -1341,7 +1414,7 @@ The current group name will be inserted at \"%s\".")
           "Really send a nastygram to the author of the current article? "))
       (let ((group gnus-newsgroup-name))
        (gnus-summary-reply-with-original n)
-       (set-buffer "*mail*")
+       (set-buffer gnus-mail-buffer)
        (insert (format gnus-nastygram-message group))
        (gnus-mail-send-and-exit))))
 
@@ -1357,20 +1430,17 @@ mailer."
 (defun gnus-mail-reply-using-mail (&optional yank to-address)
   (save-excursion
     (set-buffer gnus-summary-buffer)
-    (let ((info (nth 2 (gnus-gethash gnus-newsgroup-name gnus-newsrc-hashtb)))
-         (group (gnus-group-real-name gnus-newsgroup-name))
+    (let ((group (gnus-group-real-name gnus-newsgroup-name))
          (cur (cons (current-buffer) (cdr gnus-article-current)))
          (winconf (current-window-configuration))
-         from subject date to reply-to message-of
-         references message-id sender follow-to cc sendto elt)
-      (set-buffer (get-buffer-create "*mail*"))
+         from subject date reply-to message-of
+         references message-id sender follow-to sendto elt)
+      (set-buffer (get-buffer-create gnus-mail-buffer))
       (mail-mode)
       (make-local-variable 'gnus-article-reply)
       (setq gnus-article-reply cur)
       (make-local-variable 'gnus-prev-winconf)
       (setq gnus-prev-winconf winconf)
-      (use-local-map (copy-keymap mail-mode-map))
-      (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit)
       (if (and (buffer-modified-p)
               (> (buffer-size) 0)
               (not (gnus-y-or-n-p 
@@ -1399,7 +1469,6 @@ mailer."
                              "Re: none"))
            (or (string-match "^[Rr][Ee]:" subject)
                (setq subject (concat "Re: " subject)))
-           (setq cc (mail-fetch-field "cc"))
            (setq reply-to (mail-fetch-field "reply-to"))
            (setq references (mail-fetch-field "references"))
            (setq message-id (mail-fetch-field "message-id"))
@@ -1420,6 +1489,9 @@ mailer."
                          (or follow-to reply-to from sender "")))
                    subject message-of nil gnus-article-copy nil)
 
+       (use-local-map (copy-keymap mail-mode-map))
+       (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit)
+
        (if (and follow-to (listp follow-to))
            (progn
              (goto-char (point-min))
@@ -1445,7 +1517,7 @@ mailer."
         (concat "^" (regexp-quote mail-header-separator) "$"))
        (forward-line 1)
        (if (not yank)
-           (gnus-configure-windows 'reply)
+           (gnus-configure-windows 'reply 'force)
          (let ((last (point))
                end)
            (if (not (listp yank))
@@ -1468,7 +1540,7 @@ mailer."
                (goto-char end)
                (setq yank (cdr yank))))
            (goto-char last))
-         (gnus-configure-windows 'reply-yank))
+         (gnus-configure-windows 'reply-yank 'force))
        (run-hooks 'gnus-mail-hook)))))
 
 (defun gnus-mail-yank-original ()
@@ -1533,7 +1605,7 @@ mailer."
     (gnus-forward-insert-buffer forward-buffer)
     (goto-char (point-min))
     (re-search-forward "^To: " nil t)
-    (gnus-configure-windows 'mail-forward)
+    (gnus-configure-windows 'mail-forward 'force)
     ;; You have a chance to arrange the message.
     (run-hooks 'gnus-mail-forward-hook)
     (run-hooks 'gnus-mail-hook)))
@@ -1555,7 +1627,8 @@ mailer."
     (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit)
     (make-local-variable 'gnus-prev-winconf)
     (setq gnus-prev-winconf winconf)
-    (run-hooks 'gnus-mail-hook)))
+    (run-hooks 'gnus-mail-hook)
+    (gnus-configure-windows 'summary-mail 'force)))
 
 (defun gnus-article-mail (yank)
   "Send a reply to the address near point.
@@ -1575,6 +1648,90 @@ If YANK is non-nil, include the original article."
   (interactive)
   (gnus-article-mail 'yank))
 
+(defun gnus-bug ()
+  "Send a bug report to the Gnus maintainers."
+  (interactive)
+  (let ((winconf (current-window-configuration)))
+    (delete-other-windows)
+    (switch-to-buffer "*Gnus Help Bug*")
+    (erase-buffer)
+    (insert gnus-bug-message)
+    (goto-char (point-min))
+    (pop-to-buffer "*Gnus Bug*")
+    (erase-buffer)
+    (mail-mode)
+    (mail-setup gnus-maintainer nil nil nil nil nil)
+    (make-local-variable 'gnus-prev-winconf)
+    (setq gnus-prev-winconf winconf)
+    (use-local-map (copy-keymap mail-mode-map))
+    (local-set-key "\C-c\C-c" 'gnus-bug-mail-send-and-exit)
+    (goto-char (point-min))
+    (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
+    (forward-line 1)
+    (insert (format "%s\n%s\n\n\n\n\n" (gnus-version) (emacs-version)))
+    (let ((b (point)))
+      (gnus-debug)
+      (goto-char (- b 3)))
+    (message "")))
+
+(defun gnus-bug-mail-send-and-exit ()
+  "Send the bug message and exit."
+  (interactive)
+  (and (get-buffer "*Gnus Help Bug*")
+       (kill-buffer "*Gnus Help Bug*"))
+  (gnus-mail-send-and-exit))
+
+(defun gnus-debug ()
+  "Attemps to go through the Gnus source file and report what variables have been changed.
+The source file has to be in the Emacs load path."
+  (interactive)
+  (let ((files '("gnus.el" "gnus-msg.el" "gnus-score.el"))
+       file dirs expr olist)
+    (message "Please wait while we snoop your variables...")
+    (sit-for 0)
+    (save-excursion
+      (set-buffer (get-buffer-create " *gnus bug info*"))
+      (buffer-disable-undo (current-buffer))
+      (while files
+       (erase-buffer)
+       (setq dirs load-path)
+       (while dirs
+         (if (or (not (car dirs))
+                 (not (stringp (car dirs)))
+                 (not (file-exists-p 
+                       (setq file (concat (file-name-as-directory 
+                                           (car dirs)) (car files))))))
+             (setq dirs (cdr dirs))
+           (setq dirs nil)
+           (insert-file-contents file)
+           (goto-char (point-min))
+           (or (re-search-forward "^;;* *Internal variables" nil t)
+               (error "Malformed sources in file %s" file))
+           (narrow-to-region (point-min) (point))
+           (goto-char (point-min))
+           (while (setq expr (condition-case () 
+                                 (read (current-buffer)) (error nil)))
+             (condition-case ()
+                 (and (eq (car expr) 'defvar)
+                      (stringp (nth 3 expr))
+                      (or (not (boundp (nth 1 expr)))
+                          (not (equal (eval (nth 2 expr))
+                                      (symbol-value (nth 1 expr)))))
+                      (setq olist (cons (nth 1 expr) olist)))
+               (error nil)))))
+       (setq files (cdr files)))
+      (kill-buffer (current-buffer)))
+    (insert "------------------- Environment follows -------------------\n\n")
+    (while olist
+      (if (boundp (car olist))
+         (insert "(setq " (symbol-name (car olist)) " '" 
+                 (prin1-to-string (symbol-value (car olist))) ")\n")
+       (insert ";; (makeunbound '" (symbol-name (car olist)) ")\n"))
+      (setq olist (cdr olist)))
+    (insert "\n\n")))
+
+(gnus-ems-redefine)
+
 (provide 'gnus-msg)
 
 ;;; gnus-msg.el ends here