]> git.eshelyaron.com Git - emacs.git/commitdiff
(rmail-retry-failure): Don't call rmail-beginning-of-message.
authorRichard M. Stallman <rms@gnu.org>
Tue, 6 Mar 2001 03:19:14 +0000 (03:19 +0000)
committerRichard M. Stallman <rms@gnu.org>
Tue, 6 Mar 2001 03:19:14 +0000 (03:19 +0000)
Don't discard From: field.  Do discard Received: field.
Use unwind-protect to re-prune.

(rmail-retry-ignored-headers): Discard X-Authentication-Warning field.

lisp/mail/rmail.el

index 05d509e02840f2781df34c09ff800d0e9317c752..4909a4cb956d7152965662f148a08eecb4cb4fc0 100644 (file)
@@ -173,7 +173,7 @@ If nil, display all header fields except those matched by
   :group 'rmail-headers)
 
 ;;;###autoload
-(defcustom rmail-retry-ignored-headers nil "\
+(defcustom rmail-retry-ignored-headers "^x-authentication-warning:" "\
 *Headers that should be stripped when retrying a failed message."
   :type '(choice regexp (const nil :tag "None"))
   :group 'rmail-headers)
@@ -3197,107 +3197,110 @@ specifying headers which should not be copied into the new message."
        (msgnum rmail-current-message)
        (pruned (rmail-msg-is-pruned))
        bounce-start bounce-end bounce-indent resending)
-    (save-excursion
-      ;; Narrow down to just the quoted original message
-      (rmail-beginning-of-message)
-      (if pruned
-         (rmail-toggle-header 0))
-      (let* ((case-fold-search t)
-            (top (point))
-            (content-type
-             (save-restriction
-               ;; Fetch any content-type header in current message
-               (search-forward "\n\n") (narrow-to-region top (point))
-               (mail-fetch-field "Content-Type") )) )
-       ;; Handle MIME multipart bounce messages
-       (if (and content-type 
-                (string-match 
-                 ";[\n\t ]*boundary=\"?\\([-0-9a-z'()+_,./:=? ]+\\)\"?" 
-                 content-type))
-           (let ((codestring
-                  (concat "\n--"
-                          (substring content-type (match-beginning 1) 
-                                                  (match-end 1)))))
-             (or (re-search-forward mail-mime-unsent-header nil t)
-                 (error "Cannot find beginning of header in failed message"))
-             (or (search-forward "\n\n" nil t)
-                 (error "Cannot find start of Mime data in failed message"))
-             (setq bounce-start (point))
-             (if (search-forward codestring nil t)
-                 (setq bounce-end (match-beginning 0))
-               (setq bounce-end (point-max)))
-             )
-         ;; non-MIME bounce
-         (or (re-search-forward mail-unsent-separator nil t)
-             (error "Cannot parse this as a failure message"))
-         (skip-chars-forward "\n")
-         ;; Support a style of failure message in which the original
-         ;; message is indented, and included within lines saying
-         ;; `Start of returned message' and `End of returned message'.
-         (if (looking-at " +Received:")
-             (progn
-               (setq bounce-start (point))
-               (skip-chars-forward " ")
-               (setq bounce-indent (- (current-column)))
-               (goto-char (point-max))
-               (re-search-backward "^End of returned message$" nil t)
-               (setq bounce-end (point)))
-           ;; One message contained a few random lines before the old
-           ;; message header.  The first line of the message started with
-           ;; two hyphens.  A blank line followed these random lines.
-           ;; The same line beginning with two hyphens was possibly
-           ;; marking the end of the message.
-           (if (looking-at "^--")
-               (let ((boundary (buffer-substring-no-properties
-                                (point)
-                                (progn (end-of-line) (point)))))
-                 (search-forward "\n\n")
-                 (skip-chars-forward "\n")
-                 (setq bounce-start (point))
-                 (goto-char (point-max))
-                 (search-backward (concat "\n\n" boundary) bounce-start t)
-                 (setq bounce-end (point)))
-             (setq 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)
-      (if (rmail-start-mail nil nil nil nil nil rmail-this-buffer
-                           (list (list 'rmail-mark-message
-                                       rmail-this-buffer
-                                       (aref rmail-msgref-vector msgnum)
-                                       "retried")))
-         ;; Insert original text as initial text of new draft message.
-         ;; Bind inhibit-read-only since the header delimiter
-         ;; of the previous message was probably read-only.
-         (let ((inhibit-read-only t)
-               rmail-displayed-headers
-               rmail-ignored-headers)
-           (erase-buffer)
-           (insert-buffer-substring rmail-this-buffer bounce-start bounce-end)
-           (goto-char (point-min))
-           (if bounce-indent
-               (indent-rigidly (point-min) (point-max) bounce-indent))
-           (rmail-clear-headers rmail-retry-ignored-headers)
-           (rmail-clear-headers "^sender:\\|^from:\\|^return-path:")
-           (mail-sendmail-delimit-header)
-           (save-restriction
-             (narrow-to-region (point-min) (mail-header-end))
-             (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"))))
-           (goto-char (point-min))
-           (mail-position-on-field (if resending "Resent-To" "To") t)
-           (set-buffer rmail-this-buffer)
-           (rmail-beginning-of-message))))
-    (if pruned
-       (rmail-toggle-header))))
+    (unwind-protect
+       (progn
+         (save-excursion
+           ;; Un-prune the header; we need to search the whole thing.
+           (if pruned
+               (rmail-toggle-header 0))
+           (goto-char (rmail-msgbeg msgnum))
+           (let* ((case-fold-search t)
+                  (top (point))
+                  (content-type
+                   (save-restriction
+                     ;; Fetch any content-type header in current message
+                     (search-forward "\n\n") (narrow-to-region top (point))
+                     (mail-fetch-field "Content-Type") )) )
+             ;; Handle MIME multipart bounce messages
+             (if (and content-type 
+                      (string-match 
+                       ";[\n\t ]*boundary=\"?\\([-0-9a-z'()+_,./:=? ]+\\)\"?" 
+                       content-type))
+                 (let ((codestring
+                        (concat "\n--"
+                                (substring content-type (match-beginning 1) 
+                                           (match-end 1)))))
+                   (unless (re-search-forward mail-mime-unsent-header nil t)
+                     (error "Cannot find beginning of header in failed message"))
+                   (unless (search-forward "\n\n" nil t)
+                     (error "Cannot find start of Mime data in failed message"))
+                   (setq bounce-start (point))
+                   (if (search-forward codestring nil t)
+                       (setq bounce-end (match-beginning 0))
+                     (setq bounce-end (point-max)))
+                   )
+               ;; non-MIME bounce
+               (or (re-search-forward mail-unsent-separator nil t)
+                   (error "Cannot parse this as a failure message"))
+               (skip-chars-forward "\n")
+               ;; Support a style of failure message in which the original
+               ;; message is indented, and included within lines saying
+               ;; `Start of returned message' and `End of returned message'.
+               (if (looking-at " +Received:")
+                   (progn
+                     (setq bounce-start (point))
+                     (skip-chars-forward " ")
+                     (setq bounce-indent (- (current-column)))
+                     (goto-char (point-max))
+                     (re-search-backward "^End of returned message$" nil t)
+                     (setq bounce-end (point)))
+                 ;; One message contained a few random lines before
+                 ;; the old message header.  The first line of the
+                 ;; message started with two hyphens.  A blank line
+                 ;; followed these random lines.  The same line
+                 ;; beginning with two hyphens was possibly marking
+                 ;; the end of the message.
+                 (if (looking-at "^--")
+                     (let ((boundary (buffer-substring-no-properties
+                                      (point)
+                                      (progn (end-of-line) (point)))))
+                       (search-forward "\n\n")
+                       (skip-chars-forward "\n")
+                       (setq bounce-start (point))
+                       (goto-char (point-max))
+                       (search-backward (concat "\n\n" boundary) bounce-start t)
+                       (setq bounce-end (point)))
+                   (setq bounce-start (point)
+                         bounce-end (point-max)))
+                 (unless (search-forward "\n\n" nil t)
+                   (error "Cannot find end of header in failed message"))
+                 ))))
+         ;; Start sending new message; default header fields from 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)
+           (if (rmail-start-mail nil nil nil nil nil rmail-this-buffer
+                                 (list (list 'rmail-mark-message
+                                             rmail-this-buffer
+                                             (aref rmail-msgref-vector msgnum)
+                                             "retried")))
+               ;; Insert original text as initial text of new draft message.
+               ;; Bind inhibit-read-only since the header delimiter
+               ;; of the previous message was probably read-only.
+               (let ((inhibit-read-only t)
+                     rmail-displayed-headers
+                     rmail-ignored-headers)
+                 (erase-buffer)
+                 (insert-buffer-substring rmail-this-buffer
+                                          bounce-start bounce-end)
+                 (goto-char (point-min))
+                 (if bounce-indent
+                     (indent-rigidly (point-min) (point-max) bounce-indent))
+                 (rmail-clear-headers rmail-retry-ignored-headers)
+                 (rmail-clear-headers "^sender:\\|^return-path:\\|^received:")
+                 (mail-sendmail-delimit-header)
+                 (save-restriction
+                   (narrow-to-region (point-min) (mail-header-end))
+                   (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"))))
+                 (goto-char (point-min))
+                 (mail-position-on-field (if resending "Resent-To" "To") t)))))
+      (with-current-buffer rmail-this-buffer
+       (if pruned
+           (rmail-toggle-header 1))))))
 \f
 (defun rmail-summary-exists ()
   "Non-nil iff in an RMAIL buffer and an associated summary buffer exists.