Mercurial > emacs

changeset 36568:c96255f28875

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(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.
author Richard M. Stallman <rms@gnu.org>
date Tue, 06 Mar 2001 03:19:14 +0000
parents 37301d674d0a
children df30cce5ee20
files lisp/mail/rmail.el
diffstat 1 files changed, 105 insertions(+), 102 deletions(-) [+]
line wrap: on
line diff
--- 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.