Function: unforward-rmail-message

unforward-rmail-message is an autoloaded, interactive and byte-compiled function defined in undigest.el.gz.

Signature

(unforward-rmail-message)

Documentation

Extract a forwarded message from the containing message.

This puts the forwarded message into a separate rmail message following the containing message. This command is only useful when messages are forwarded with rmail-enable-mime-composing set to nil.

View in manual

Probably introduced at or before Emacs version 19.31.

Key Bindings

Source Code

;; Defined in /usr/src/emacs/lisp/mail/undigest.el.gz
;;;###autoload
(defun unforward-rmail-message ()
  "Extract a forwarded message from the containing message.
This puts the forwarded message into a separate rmail message following
the containing message.  This command is only useful when messages are
forwarded with `rmail-enable-mime-composing' set to nil."
  (interactive)
  (set-buffer rmail-buffer)
  (let ((buff (current-buffer))
        (current rmail-current-message)
        (beg (rmail-msgbeg rmail-current-message))
        (msgend (rmail-msgend rmail-current-message))
	(error t))
    (unwind-protect
	(progn
	  (if (rmail-buffers-swapped-p) (set-buffer rmail-view-buffer))
	  (widen)
	  (goto-char beg)
	  (search-forward "\n\n" msgend)
	  (narrow-to-region beg (point))
	  (let ((old-fwd-from (mail-fetch-field "Forwarded-From" nil nil t))
		(old-fwd-date (mail-fetch-field "Forwarded-Date" nil nil t))
		(fwd-from (mail-fetch-field "From"))
		(fwd-date (mail-fetch-field "Date"))
		(buffer-read-only nil)
		prefix forward-msg end)
	    (widen)
	    (narrow-to-region beg msgend)
	    (cond ((re-search-forward rmail-forward-separator-regex nil t)
		   (forward-line 1)
		   (skip-chars-forward "\n")
		   (setq beg (point))
		   (setq end (if (re-search-forward "^----.*[^- \t\n]" nil t)
				 (match-beginning 0) (point-max)))
		   (setq forward-msg
			 (replace-regexp-in-string
			  "^- -" "-" (buffer-substring beg end))))
		  ((and (re-search-forward "^\\(> ?\\)[a-zA-Z-]+: .*\n" nil t)
			(setq beg (match-beginning 0))
			(setq prefix (match-string-no-properties 1))
			(goto-char beg)
			(looking-at (concat "\\(" prefix ".+\n\\)*"
					    prefix "Date: ."))
			(looking-at (concat "\\(" prefix ".+\n\\)*"
					    prefix "From: .+\n"
					    "\\(" prefix ".+\n\\)*"
					    "\\(> ?\\)?\n" prefix)))
		   (re-search-forward "^[^>\n]" nil 'move)
		   (backward-char)
		   (skip-chars-backward " \t\n")
		   (forward-line 1)
		   (setq end (point))
		   (setq forward-msg
			 (replace-regexp-in-string
			  (if (string= prefix ">") "^>" "> ?")
			  "" (buffer-substring beg end))))
		  (t
		   (error "No forwarded message found")))
	    (widen)
	    (goto-char msgend)
	    ;; Insert a fake From line.
	    ;; FIXME we could construct one using the From and Date headers
	    ;; of the forwarded message - is it worth it?
	    (insert "\n\nFrom rmail@localhost  " (current-time-string) "\n")
	    (setq beg (point))		; start of header
	    (while old-fwd-from
	      (insert "Forwarded-From: " (car old-fwd-from) "\n")
	      (insert "Forwarded-Date: " (car old-fwd-date) "\n")
	      (setq old-fwd-from (cdr old-fwd-from))
	      (setq old-fwd-date (cdr old-fwd-date)))
	    (insert "Forwarded-From: " fwd-from "\n")
	    (insert "Forwarded-Date: " fwd-date "\n")
	    (insert forward-msg "\n")
	    (goto-char beg)
	    (re-search-forward "\n$" nil 'move) ; end of header
	    (narrow-to-region beg (point))
	    (goto-char (point-min))
	    (while (not (eobp))
	      (unless (looking-at "^[a-zA-Z-]+: ")
		(insert "\t"))
	      (forward-line))
	    (widen)
	    (goto-char beg)
	    (forward-line -1)
	    (rmail-add-mbox-headers))		; marks as unseen
	  (setq error nil)
	  (set-buffer buff)
	  (rmail-swap-buffers-maybe)
	  (goto-char (point-max))
	  ;; FIXME use rmail-count-new-messages.
	  (rmail-set-message-counters)
	  (set-buffer-modified-p t)
	  (rmail-show-message current)
	  (if (rmail-summary-exists)
	      (rmail-select-summary (rmail-update-summary))))
      (when error
	(set-buffer buff)
	(rmail-show-message current)))))