Synch with Oort Gnus.
[elisp/gnus.git-] / lisp / gnus-msg.el
index c4c3a55..3955179 100644 (file)
@@ -55,7 +55,7 @@ methods.  If that is the case, the user will be queried for what select
 method to use when posting."
   :group 'gnus-group-foreign
   :type `(choice (const nil)
-                 (const current)
+                (const current)
                 (const native)
                 (sexp :tag "Methods" ,gnus-select-method)))
 
@@ -152,6 +152,8 @@ use this option with care."
 (defvar gnus-last-posting-server nil)
 (defvar gnus-message-group-art nil)
 
+(defvar gnus-msg-force-broken-reply-to nil)
+
 (defconst gnus-bug-message
   (format "Sending a bug report to the Gnus Towers.
 ========================================
@@ -213,6 +215,8 @@ Thank you for your help in stamping out bugs.
   "m" gnus-summary-mail-other-window
   "u" gnus-uu-post-news
   "\M-c" gnus-summary-mail-crosspost-complaint
+  "Br" gnus-summary-reply-broken-reply-to
+  "BR" gnus-summary-reply-broken-reply-to-with-original
   "om" gnus-summary-mail-forward
   "op" gnus-summary-post-forward
   "Om" gnus-summary-digest-mail-forward
@@ -578,7 +582,7 @@ header line with the old Message-ID."
            (while (looking-at message-unix-mail-delimiter)
              (forward-line 1))
            (setq beg (point))
-           (setq end (or (message-goto-body) (point)))
+           (setq end (or (message-goto-body) beg))
            ;; Delete the headers from the displayed articles.
            (set-buffer gnus-article-copy)
            (delete-region (goto-char (point-min))
@@ -651,10 +655,11 @@ header line with the old Message-ID."
        (when yank
          (gnus-inews-yank-articles yank))))))
 
-(defun gnus-msg-treat-broken-reply-to ()
+(defun gnus-msg-treat-broken-reply-to (&optional force)
   "Remove the Reply-to header iff broken-reply-to."
-  (when (gnus-group-find-parameter
-        gnus-newsgroup-name 'broken-reply-to)
+  (when (or force
+           (gnus-group-find-parameter
+            gnus-newsgroup-name 'broken-reply-to))
     (save-restriction
       (message-narrow-to-head)
       (message-remove-header "reply-to"))))
@@ -808,7 +813,7 @@ If VERY-WIDE, make a very wide reply."
              (message-narrow-to-head)
              (setq headers (concat headers (buffer-string)))))))
       (set-buffer (gnus-copy-article-buffer))
-      (gnus-msg-treat-broken-reply-to)
+      (gnus-msg-treat-broken-reply-to gnus-msg-force-broken-reply-to)
       (save-restriction
        (message-narrow-to-head)
        (when very-wide
@@ -825,6 +830,24 @@ The original article will be yanked."
   (interactive "P")
   (gnus-summary-reply (gnus-summary-work-articles n) wide))
 
+(defun gnus-summary-reply-broken-reply-to (&optional yank wide very-wide)
+  "Like `gnus-summary-reply' except removing reply-to field.
+If prefix argument YANK is non-nil, the original article is yanked
+automatically.
+If WIDE, make a wide reply.
+If VERY-WIDE, make a very wide reply."
+  (interactive
+   (list (and current-prefix-arg
+             (gnus-summary-work-articles 1))))
+  (let ((gnus-msg-force-broken-reply-to t))
+    (gnus-summary-reply yank wide very-wide)))
+
+(defun gnus-summary-reply-broken-reply-to-with-original (n &optional wide)
+  "Like `gnus-summary-reply-with-original' except removing reply-to field.
+The original article will be yanked."
+  (interactive "P")
+  (gnus-summary-reply-broken-reply-to (gnus-summary-work-articles n) wide))
+
 (defun gnus-summary-wide-reply (&optional yank)
   "Start composing a wide reply mail to the current message.
 If prefix argument YANK is non-nil, the original article is yanked
@@ -1277,42 +1300,41 @@ this is a reply."
 ;; Do Gcc handling, which copied the message over to some group.
 (defun gnus-inews-do-gcc (&optional gcc)
   (interactive)
-  (when (gnus-alive-p)
-    (save-excursion
-      (save-restriction
-       (message-narrow-to-headers)
-       (let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
-             (coding-system-for-write 'raw-text)
-             (output-coding-system 'raw-text)
-             groups group method group-art)
-         (when gcc
-           (message-remove-header "gcc")
-           (widen)
-           (setq groups (message-unquote-tokens
-                          (message-tokenize-header gcc " ,")))
-           ;; Copy the article over to some group(s).
-           (while (setq group (pop groups))
-             (gnus-check-server
-              (setq method (gnus-inews-group-method group)))
-             (unless (gnus-request-group group nil method)
-               (gnus-request-create-group group method))
-             (save-excursion
-               (nnheader-set-temp-buffer " *acc*")
-               (insert-buffer-substring message-encoding-buffer)
-               (gnus-run-hooks 'gnus-before-do-gcc-hook)
-               (goto-char (point-min))
-               (when (re-search-forward
-                      (concat "^" (regexp-quote mail-header-separator) "$")
-                      nil t)
-                 (replace-match "" t t ))
-               (unless (setq group-art
-                             (gnus-request-accept-article group method t t))
-                 (gnus-message 1 "Couldn't store article in group %s: %s"
-                               group (gnus-status-message method))
-                 (sit-for 2))
-               (when (and group-art gnus-inews-mark-gcc-as-read)
-                 (gnus-group-mark-article-read group (cdr group-art)))
-               (kill-buffer (current-buffer))))))))))
+  (save-excursion
+    (save-restriction
+      (message-narrow-to-headers)
+      (let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
+           (coding-system-for-write 'raw-text)
+           (output-coding-system 'raw-text)
+           groups group method group-art)
+       (when gcc
+         (message-remove-header "gcc")
+         (widen)
+         (setq groups (message-unquote-tokens
+                       (message-tokenize-header gcc " ,")))
+         ;; Copy the article over to some group(s).
+         (while (setq group (pop groups))
+           (gnus-check-server
+            (setq method (gnus-inews-group-method group)))
+           (unless (gnus-request-group group nil method)
+             (gnus-request-create-group group method))
+           (save-excursion
+             (nnheader-set-temp-buffer " *acc*")
+             (insert-buffer-substring message-encoding-buffer)
+             (gnus-run-hooks 'gnus-before-do-gcc-hook)
+             (goto-char (point-min))
+             (when (re-search-forward
+                    (concat "^" (regexp-quote mail-header-separator) "$")
+                    nil t)
+               (replace-match "" t t ))
+             (unless (setq group-art
+                           (gnus-request-accept-article group method t t))
+               (gnus-message 1 "Couldn't store article in group %s: %s"
+                             group (gnus-status-message method))
+               (sit-for 2))
+             (when (and group-art gnus-inews-mark-gcc-as-read)
+               (gnus-group-mark-article-read group (cdr group-art)))
+             (kill-buffer (current-buffer)))))))))
 
 (defun gnus-inews-insert-gcc ()
   "Insert Gcc headers based on `gnus-outgoing-message-group'."
@@ -1526,8 +1548,8 @@ this is a reply."
       (when (or name address)
        (add-hook 'message-setup-hook
                  `(lambda ()
-                    (set (make-local-variable 'user-mail-address)
-                         ,(or (cdr address) user-mail-address))
+                    (set (make-local-variable 'user-mail-address)
+                         ,(or (cdr address) user-mail-address))
                     (let ((user-full-name ,(or (cdr name) (user-full-name)))
                           (user-mail-address
                            ,(or (cdr address) user-mail-address)))
@@ -1543,7 +1565,7 @@ this is a reply."
 (defun gnus-maybe-setup-default-charset ()
   (let ((charset
         (and (boundp 'gnus-summary-buffer)
-              (buffer-live-p gnus-summary-buffer)
+             (buffer-live-p gnus-summary-buffer)
              (save-excursion
                (set-buffer gnus-summary-buffer)
                default-mime-charset))))