Function: rmail-retry-failure

rmail-retry-failure is an interactive and byte-compiled function defined in rmail.el.gz.

Signature

(rmail-retry-failure)

Documentation

Edit a mail message which is based on the contents of the current message.

For a message rejected by the mail system, extract the interesting headers and the body of the original message. If the failed message is a MIME multipart message, it is searched for a body part with a header which matches the variable mail-mime-unsent-header. Otherwise, the variable mail-unsent-separator should match the string that 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.

View in manual

Key Bindings

Source Code

;; Defined in /usr/src/emacs/lisp/mail/rmail.el.gz
(defun rmail-retry-failure ()
  "Edit a mail message which is based on the contents of the current message.
For a message rejected by the mail system, extract the interesting headers and
the body of the original message.
If the failed message is a MIME multipart message, it is searched for a
body part with a header which matches the variable `mail-mime-unsent-header'.
Otherwise, the variable `mail-unsent-separator' should match the string that
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 (bounce-buffer  ;; Buffer we found it in
        bounce-start   ;; Position of start of failed message in that buffer
        bounce-end     ;; Position of end of failed message in that buffer
        bounce-indent  ;; Number of columns we need to de-indent it.
	(msgnum rmail-current-message)
	resending
	(content-type (rmail-get-header "Content-Type")))
    (save-excursion
      (goto-char (point-min))
      (let ((case-fold-search t))
	(if (and content-type
		 (string-match
		  ";[\n\t ]*boundary=\"?\\([-0-9a-z'()+_,./:=? ]+\\)\"?"
		  content-type))
	    ;; Handle a MIME multipart bounce message
            ;; by scanning the raw buffer.
	    (let ((codestring
		   (concat "\n--"
			   (substring content-type (match-beginning 1)
				      (match-end 1))))
                  (beg (rmail-msgbeg msgnum))
                  (end (rmail-msgend msgnum)))
              (with-current-buffer rmail-view-buffer
                (save-restriction
                  (narrow-to-region beg end)
                  (goto-char (point-min))
                  (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))
                  (setq bounce-buffer (current-buffer))
                  (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-buffer (current-buffer))
		(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-buffer (current-buffer))
		  (setq bounce-end (point)))
	      (setq bounce-start (point)
                    bounce-buffer (current-buffer)
		    bounce-end (point-max)))
	    (unless (search-forward "\n\n" nil t)
	      (error "Cannot find end of header in failed message"))))))
    ;; We have found the message that bounced, within the current message.
    ;; Now 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-buffer
			    (list (list 'rmail-mark-message
					rmail-buffer
					(aref rmail-msgref-vector msgnum)
					rmail-retried-attr-index)))
	  ;; 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)
		eoh)
	    (erase-buffer)
	    (insert-buffer-substring bounce-buffer
				     bounce-start bounce-end)
	    (goto-char (point-min))
	    (if bounce-indent
		(indent-rigidly (point-min) (point-max) bounce-indent))
	    (rfc822-goto-eoh)
	    (setq eoh (point))
	    (insert mail-header-separator)
	    (save-restriction
	      (narrow-to-region (point-min) eoh)
	      (rmail-delete-headers rmail-retry-ignored-headers)
	      (rmail-delete-headers "^\\(sender\\|return-path\\|received\\):")
	      (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))))))