🚀 go-pugleaf

Try this, at least for starters.

(defun mail-resend-message
  (address &optional from bcc comment listed-to alias-file)
  "Resend current message to ADDRESS, which should be a single address, a
a string consisting of several addresses separated by commas, or a list of
addresses.  Optional FROM is the address to resend the message from, and
defaults to the username of the person redistributing the message.
Optional COMMENT is a string that will be inserted as a comment in the
resent message.  Optional LISTED-TO is the name that should be put in the
resent-to: field.  This option is only useful if used with a null to:
address and a resent-bcc:.  Optional ALIAS-FILE is alternate aliases
file to be used by sendmail, typically for purposes of moderating a list."
  (interactive "sResend to:  ")
  (if (not (eq major-mode 'rmail-mode))
      (error "mail-resend-message must be used inside rmail")
    (when (not from) (setq from (user-login-name)))
    (when (not listed-to)
      (setq listed-to (if (stringp address)
			  address
			(mapconcat 'identity address ", "))))
    (let ((errbuf (if mail-interactive
		      (generate-new-buffer " sendmail errors")
		    0))
	  (tembuf (generate-new-buffer " sendmail temp"))
	  (commentbuf (generate-new-buffer " sendmail temp"))
	  (case-fold-search nil)
	  delimline
	  (mailbuf (current-buffer))
	  (text (save-restriction
		  (widen)
		  (buffer-substring (rmail-msgbeg rmail-current-message)
				    (rmail-msgend rmail-current-message)))))
      (unwind-protect
	  (save-excursion
	    ;;>> Copy message into temp buffer
	    (set-buffer tembuf)
	    (erase-buffer)
	    (insert text)
	    ;;>> Set up comment, if any.
	    (when (and (sequencep comment) (not (zerop (length comment))))
	      (set-buffer commentbuf)
	      (insert comment)
	      (goto-char (point-min))
	      (replace-regexp "^" "Resent-Comment: ")
	      (goto-char (point-max))
	      (insert ?\n)
	      (set-buffer tembuf))
	    ;;>> Select appropriate headers for message,
	    ;;>> clean up extraneous headers and go to end of headers.
	    (goto-char (point-min))
	    (forward-line 2)
	    (delete-region (point-min) (point))
	    (if (looking-at (regexp-quote "*** EOOH ***"))
		(progn (forward-line 1)
		       (delete-region (point-min) (point))
		       (search-forward "\n\n"))
	      (search-forward "*** EOOH ***")
	      (forward-line 0)
	      (let ((temp (point)))
		(search-forward "\n\n")
		(delete-region temp (point))))
	    (forward-line -1)
	    ;;>> Insert resent-from: if needed (this might come out
	    ;;>> some day)
	    (insert "Resent-From: " from "\n")
	    ;;>> Insert resent-date.  This may be unnecessary.
	    (when comment (insert-buffer-substring commentbuf))
	    (set-buffer commentbuf)
	    (erase-buffer)
	    (call-process "/bin/date" nil t)
	    ;;>> Lots of magic numbers, but Unix dates are fixed form.
	    ;;>> So who really cares, then?
	    (let* ((raw-date (buffer-substring 1 29))
		   (clean-date (concat "Resent-Date: "
				       (substring raw-date 0 3) ","
				       (substring raw-date 7 10)
				       (substring raw-date 3 8)
				       (substring raw-date 26 28)
				       (substring raw-date 10 23) "\n")))
	      (set-buffer tembuf)
	      (insert clean-date))
	    ;;>> Insert resent-to: and bcc if need be.
	    (when address
	      (set-buffer commentbuf)
	      (erase-buffer)
	      (insert "To: " (if (stringp address)
				address
			      (mapconcat 'identity address ",\n\t"))
		      "\n")
	      (expand-mail-aliases (point-min) (point-max))
	      (set-buffer tembuf)
	      (insert "Resent-")
	      (insert-buffer-substring commentbuf))
	    ;;>> Not at all clear that this will work.
	    (when (and listed-to (not address))
	      (insert "Resent-To: " listed-to "\n"))
	    (when bcc
	      (set-buffer commentbuf)
	      (erase-buffer)
	      (insert "Bcc: " (if (stringp bcc)
				 bcc
			       (mapconcat 'identity bcc ",\n\t"))
		      "\n")
	      (expand-mail-aliases (point-min) (point-max))
	      (goto-char (point-min))
	      (insert "Resent-")
	      (replace-string ",\n" "\nResent-Bcc:")
	      (set-buffer tembuf)
	      (insert-buffer-substring commentbuf))
	    (goto-char (point-max))
	    ;; require one newline at the end.
	    (or (= (preceding-char) ?\n)
		(insert ?\n))
	    (if mail-interactive
		(save-excursion
		  (set-buffer errbuf)
		  (erase-buffer)))
	    (apply 'call-process-region
		 (append (list (point-min) (point-max)
			       (if (boundp 'sendmail-program)
				   sendmail-program
				 "/usr/lib/sendmail")
			       nil errbuf nil
			       "-oi" "-t")
			 ;; Don't say "from root" if running under su.
			 (and (equal (user-real-login-name) "root")
			      (list "-f" (user-login-name)))
			 (and alias-file
			      (list (concat "-oA" alias-file)))
			 ;; These mean "report errors by mail"
			 ;; and "deliver in background".
			 (if (null mail-interactive) '("-oem" "-odb"))))
	    (if mail-interactive
		(save-excursion
		  (set-buffer errbuf)
		  (goto-char (point-min))
		  (while (re-search-forward "\n\n* *" nil t)
		    (replace-match "; "))
		  (if (not (zerop (buffer-size)))
		      (error "Sending...failed to %s"
			     (buffer-substring (point-min) (point-max)))))))
	(kill-buffer tembuf)
	(kill-buffer commentbuf)
	(if (bufferp errbuf)
	    (kill-buffer errbuf))))))
-- 
ames >>>>>>>>>  |	Robert Krawitz <rlk@think.com>	245 First St.
bloom-beacon >  |think!rlk	(postmaster)		Cambridge, MA  02142
harvard >>>>>>  .	Thinking Machines Corp.		(617)234-2116