- (let ((fill-prefix "\t")
- (address-start (point)))
- (insert to "\n")
- (fill-region-as-paragraph address-start (point)))
- (newline))
- (insert "Subject: " uce-subject-line "\n")
- (if uce-default-headers
- (insert uce-default-headers))
- (if mail-default-headers
- (insert mail-default-headers))
- (if mail-default-reply-to
- (insert "Reply-to: " mail-default-reply-to "\n"))
- (insert mail-header-separator "\n")
- ;; Insert all our text. Then go back to the place where we started.
- (if to (setq to (point)))
- ;; Text of ranting.
- (if uce-message-text
- (insert uce-message-text))
- ;; Signature.
- (cond ((eq uce-signature t)
- (if (file-exists-p "~/.signature")
- (progn
- (insert "\n\n-- \n")
- (insert-file "~/.signature")
- ;; Function insert-file leaves point where it was,
- ;; while we want to place signature in the ``middle''
- ;; of the message.
- (exchange-point-and-mark))))
- (uce-signature
- (insert "\n\n-- \n" uce-signature)))
- ;; And text of the original message.
- (if uce-uce-separator
- (insert "\n\n" uce-uce-separator "\n"))
- ;; If message doesn't end with a newline, insert it.
- (goto-char (point-max))
- (or (bolp) (newline)))
- ;; And go back to the beginning of text.
- (if to (goto-char to))
- (or to (set-buffer-modified-p nil))
- ;; Run hooks before we leave buffer for editing. Reasonable usage
- ;; might be to set up special key bindings, replace standart
- ;; functions in mail-mode, etc.
- (run-hooks 'mail-setup-hook 'uce-setup-hook)))
-
+ (setq to (format "%s" (mail-strip-quoted-names to)))
+ (setq to ""))
+ (if reply-to
+ (setq to (format "%s, %s" to (mail-strip-quoted-names reply-to))))
+ (let (first-at-sign end-of-hostname sender-host)
+ (setq first-at-sign (string-match "@" to)
+ end-of-hostname (string-match "[ ,>]" to first-at-sign)
+ sender-host (substring to first-at-sign end-of-hostname))
+ (if (string-match "\\." sender-host)
+ (setq to (format "%s, postmaster%s, abuse%s"
+ to sender-host sender-host))))
+ (setq mail-send-actions nil)
+ (setq mail-reply-buffer nil)
+ (cond ((eq uce-mail-reader 'gnus)
+ (copy-region-as-kill (point-min) (point-max)))
+ ((eq uce-mail-reader 'rmail)
+ (save-excursion
+ (save-restriction
+ (rmail-toggle-header 1)
+ (widen)
+ (rmail-maybe-set-message-counters)
+ (copy-region-as-kill (rmail-msgbeg rmail-current-message)
+ (rmail-msgend rmail-current-message))))))
+ ;; Restore the pruned header state we found.
+ (if full-header-p
+ (rmail-toggle-header 0))
+ (switch-to-buffer "*mail*")
+ (erase-buffer)
+ (setq temp (point))
+ (yank)
+ (goto-char temp)
+ (if (eq uce-mail-reader 'rmail)
+ (progn
+ (forward-line 2)
+ (let ((case-fold-search t))
+ (while (looking-at "Summary-Line:\\|Mail-From:")
+ (forward-line 1)))
+ (delete-region temp (point))))
+ ;; Now find the mail hub that first accepted this message.
+ ;; This should try to find the last Received: header.
+ ;; Sometimes there may be other headers inbetween Received: headers.
+ (cond ((eq uce-mail-reader 'gnus)
+ ;; Does Gnus always have Lines: in the end?
+ (re-search-forward "^Lines:")
+ (beginning-of-line))
+ ((eq uce-mail-reader 'rmail)
+ (beginning-of-buffer)
+ (search-forward "*** EOOH ***\n")
+ (beginning-of-line)
+ (forward-line -1)))
+ (re-search-backward "^Received:")
+ (beginning-of-line)
+ ;; Is this always good? It's the only thing I saw when I checked
+ ;; a few messages.
+ (let ((eol (save-excursion (end-of-line) (point))))
+ ;;(if (not (re-search-forward ": \\(from\\|by\\) " eol t))
+ (if (not (re-search-forward "\\(from\\|by\\) " eol t))
+ (progn
+ (goto-char eol)
+ (if (looking-at "[ \t\n]+\\(from\\|by\\) ")
+ (goto-char (match-end 0))
+ (error "Failed to extract hub address")))))
+ (setq temp (point))
+ (search-forward " ")
+ (forward-char -1)
+ ;; And add its postmaster to the list of addresses.
+ (if (string-match "\\." (buffer-substring temp (point)))
+ (setq to (format "%s, postmaster@%s"
+ to (buffer-substring temp (point)))))
+ ;; Also look at the message-id, it helps *very* often.
+ (if (and (search-forward "\nMessage-Id: " nil t)
+ ;; Not all Message-Id:'s have an `@' sign.
+ (let ((bol (point))
+ eol)
+ (end-of-line)
+ (setq eol (point))
+ (goto-char bol)
+ (search-forward "@" eol t)))
+ (progn
+ (setq temp (point))
+ (search-forward ">")
+ (forward-char -1)
+ (if (string-match "\\." (buffer-substring temp (point)))
+ (setq to (format "%s, postmaster@%s"
+ to (buffer-substring temp (point)))))))
+ (cond ((eq uce-mail-reader 'gnus)
+ ;; Does Gnus always have Lines: in the end?
+ (re-search-forward "^Lines:")
+ (beginning-of-line))
+ ((eq uce-mail-reader 'rmail)
+ (search-forward "\n*** EOOH ***\n")
+ (forward-line -1)))
+ (setq temp (point))
+ (search-forward "\n\n" nil t)
+ (if (eq uce-mail-reader 'gnus)
+ (forward-line -1))
+ (delete-region temp (point))
+ ;; End of Rmail dependent section.
+ (auto-save-mode auto-save-default)
+ (mail-mode)
+ (goto-char (point-min))
+ (insert "To: ")
+ (save-excursion
+ (if to
+ (let ((fill-prefix "\t")
+ (address-start (point)))
+ (insert to "\n")
+ (fill-region-as-paragraph address-start (point)))
+ (newline))
+ (insert "Subject: " uce-subject-line "\n")
+ (if uce-default-headers
+ (insert uce-default-headers))
+ (if mail-default-headers
+ (insert mail-default-headers))
+ (if mail-default-reply-to
+ (insert "Reply-to: " mail-default-reply-to "\n"))
+ (insert mail-header-separator "\n")
+ ;; Insert all our text. Then go back to the place where we started.
+ (if to (setq to (point)))
+ ;; Text of ranting.
+ (if uce-message-text
+ (insert uce-message-text))
+ ;; Signature.
+ (cond ((eq uce-signature t)
+ (if (file-exists-p "~/.signature")
+ (progn
+ (insert "\n\n-- \n")
+ (insert-file "~/.signature")
+ ;; Function insert-file leaves point where it was,
+ ;; while we want to place signature in the ``middle''
+ ;; of the message.
+ (exchange-point-and-mark))))
+ (uce-signature
+ (insert "\n\n-- \n" uce-signature)))
+ ;; And text of the original message.
+ (if uce-uce-separator
+ (insert "\n\n" uce-uce-separator "\n"))
+ ;; If message doesn't end with a newline, insert it.
+ (goto-char (point-max))
+ (or (bolp) (newline)))
+ ;; And go back to the beginning of text.
+ (if to (goto-char to))
+ (or to (set-buffer-modified-p nil))
+ ;; Run hooks before we leave buffer for editing. Reasonable usage
+ ;; might be to set up special key bindings, replace standart
+ ;; functions in mail-mode, etc.
+ (run-hooks 'mail-setup-hook 'uce-setup-hook))))
+