(rmail-retry-failure): Copy the whole block of headers from the message

and then discard those in rmail-retry-ignored-headers.  Delete
usage of rmail-retry-setup-hook.  Bind mail-signature and
mail-setup-hook to nil when composing retry buffer.
Handle mail-self-blind.

(rmail-retry-ignored-headers): New variable,
specifying the headers that should be removed by rmail-retry-failure.
(rmail-retry-setup-hook): Obsolete variable (see below), deleted.
(rmail-clear-headers): New optional arg is list of headers to clear.

diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index 2d446716b2eff9daa12029dfc162151fc3325852..a039dea4cdbecbc9b6f57a77ea6f186fcc5ce2e3 100644 (file)
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -67,11 +67,15 @@ value is the user's name.)
 It is useful to set this variable in the site customization file.")
 
 ;;;###autoload
-(defvar rmail-ignored-headers "^via:\\|^mail-from:\\|^origin:\\|^status:\\|\
+(defvar rmail-ignored-headers "^via:\\|^mail-from:\\|^origin:\\|^status:\\|^received:\\|^x400-originator:\\|^x400-recipients:\\|^x400-received:\\|^x400-mts-identifier:\\|^x400-content-type:\\|^\\(resent-\\|\\)message-id:\\|^summary-line:" "\
 ^received:\\|^x400-originator:\\|^x400-recipients:\\|^x400-received:\\|\
 ^x400-mts-identifier:\\|^x400-content-type:\\|^message-id:\\|^summary-line:"
   "*Regexp to match Header fields that Rmail should normally hide.")
 
+;;;###autoload
+(defvar rmail-retry-ignored-headers nil "\
+*Headers that should be stripped when retrying a failed message.")
+
 ;;;###autoload
 (defvar rmail-highlighted-headers "^From:\\|^Subject:" "\
 *Regexp to match Header fields that Rmail should normally highlight.
@@ -97,10 +101,6 @@ and the value of the environment variable MAIL overrides it).")
 (defvar rmail-mail-new-frame nil
   "*Non-nil means Rmail makes a new frame for composing outgoing mail.")
 
-;;;###autoload
-(defvar rmail-retry-setup-hook nil
-  "Hook that `rmail-retry-failure' uses in place of `mail-setup-hook'.")
-
 ;;;###autoload
 (defvar rmail-secondary-file-directory "~/"
   "*Directory for additional secondary Rmail files.")
@@ -1165,14 +1165,15 @@ This function runs `rmail-get-new-mail-hook' before saving the updated file."
     (if rmail-ignored-headers (rmail-clear-headers))
     (if rmail-message-filter (funcall rmail-message-filter))))
 
-(defun rmail-clear-headers ()
+(defun rmail-clear-headers (&optional ignored-headers)
+  (or ignored-headers (setq ignored-headers rmail-ignored-headers))
   (if (search-forward "\n\n" nil t)
       (save-restriction
-        (narrow-to-region (point-min) (point))
+       (narrow-to-region (point-min) (point))
        (let ((buffer-read-only nil))
          (while (let ((case-fold-search t))
                   (goto-char (point-min))
-                  (re-search-forward rmail-ignored-headers nil t))
+                  (re-search-forward ignored-headers nil t))
            (beginning-of-line)
            (delete-region (point)
                           (progn (re-search-forward "\n[^ \t]")
@@ -2150,10 +2151,12 @@ typically for purposes of moderating a list."
 For a message rejected by the mail system, extract the interesting headers and
 the body of the original message.
 The variable `mail-unsent-separator' should match the string that
-delimits the returned original message."
+delimits the returned original message.
+The variable `rmail-retry-ignored-headers' is a regular expression
+specifying headers which should not be copied into the new message."
   (interactive)
   (require 'mail-utils)
-  (let (to subj irp2 cc orig-message)
+  (let (mail-buffer bounce-start bounce-end resending)
     (save-excursion
       ;; Narrow down to just the quoted original message
       (rmail-beginning-of-message)
@@ -2170,33 +2173,39 @@ delimits the returned original message."
              (progn
                (search-forward "\n\n")
                (skip-chars-forward "\n")))
+         (beginning-of-line)
          (narrow-to-region (point) (point-max))
-         (goto-char (point-min))
-         (search-forward "\n\n")
-         (narrow-to-region (point-min) (point))
-         ;; Now mail-fetch-field will get from headers of the original message,
-         ;; not from the headers of the rejection.
-         (setq to   (mail-fetch-field "To")
-               subj (mail-fetch-field "Subject")
-               irp2 (mail-fetch-field "In-reply-to")
-               cc   (mail-fetch-field "Cc"))
-         ;; Get the entire text (not headers) of the original message.
-         (goto-char (point-max))
-         (widen)
-         (setq orig-message
-               (buffer-substring (point) old-end)))))
+         (setq mail-buffer (current-buffer)
+               bounce-start (point)
+               bounce-end (point-max))
+         (or (search-forward "\n\n" nil t)
+             (error "Cannot find end of header in failed message")))))
     ;; Start sending a new message; default header fields from the original.
     ;; Turn off the usual actions for initializing the message body
     ;; because we want to get only the text from the failure message.
-    (let (mail-signature
-         (mail-setup-hook rmail-retry-setup-hook))
-      (if (rmail-start-mail nil to subj irp2 cc (current-buffer))
+    (let (mail-signature mail-setup-hook)
+      (if (rmail-start-mail nil nil nil nil nil mail-buffer)
          ;; Insert original text as initial text of new draft message.
          (progn
-           (goto-char (point-max))
-           (insert orig-message)
+           (erase-buffer)
+           (insert-buffer-substring mail-buffer bounce-start bounce-end)
+           (goto-char (point-min))
+           (rmail-clear-headers rmail-retry-ignored-headers)
+           (rmail-clear-headers "^sender:")
            (goto-char (point-min))
-           (end-of-line))))))
+           (save-restriction
+             (search-forward "\n\n")
+             (forward-line -1)
+             (narrow-to-region (point-min) (point))
+             (setq resending (mail-fetch-field "resent-to"))
+             (if mail-self-blind
+                 (if resending
+                     (insert "Resent-Bcc: " (user-login-name) "\n")
+                   (insert "BCC: " (user-login-name) "\n"))))
+           (insert mail-header-separator)
+           (mail-position-on-field (if resending "Resent-To" "To") t)
+           (set-buffer mail-buffer)
+           (rmail-beginning-of-message))))))
 
 (defun rmail-bury ()
   "Bury current Rmail buffer and its summary buffer."