summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRichard M. Stallman <rms@gnu.org>2001-03-06 03:19:14 +0000
committerRichard M. Stallman <rms@gnu.org>2001-03-06 03:19:14 +0000
commitdcffef53ac0a75ad3236d12a9f0049fbcffceddb (patch)
tree4708138ec825b328f3cf1d425b278ef77145db9f
parentc306d2db483f6f20cbd803e0188c384fa5868e45 (diff)
downloademacs-dcffef53ac0a75ad3236d12a9f0049fbcffceddb.tar.gz
(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.
-rw-r--r--lisp/mail/rmail.el207
1 files changed, 105 insertions, 102 deletions
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index 05d509e0284..4909a4cb956 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -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))))))
(defun rmail-summary-exists ()
"Non-nil iff in an RMAIL buffer and an associated summary buffer exists.