# HG changeset patch # User Richard M. Stallman # Date 983848754 0 # Node ID c96255f288753dfb5c473a3ee5ce6327e95719f2 # Parent 37301d674d0a5f94b515cd463859026bfaf7af1d (rmail-retry-failure): Don't call rmail-beginning-of-message. Don't discard From: field. Do discard Received: field. Use unwind-protect to re-prune. (rmail-retry-ignored-headers): Discard X-Authentication-Warning field. diff -r 37301d674d0a -r c96255f28875 lisp/mail/rmail.el --- a/lisp/mail/rmail.el Tue Mar 06 03:18:50 2001 +0000 +++ b/lisp/mail/rmail.el Tue Mar 06 03:19:14 2001 +0000 @@ -173,7 +173,7 @@ :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 @@ (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)))))) (defun rmail-summary-exists () "Non-nil iff in an RMAIL buffer and an associated summary buffer exists.