- "Send the prepared message buffer with SMTP."
- (require 'smtp)
- (let ((errbuf (if mail-interactive
- (generate-new-buffer " smtp errors")
- 0))
- (case-fold-search nil)
- resend-to-addresses
- delimline)
- (unwind-protect
- (save-excursion
- (goto-char (point-max))
- ;; require one newline at the end.
- (or (= (preceding-char) ?\n)
- (insert ?\n))
- ;; Change header-delimiter to be what sendmail expects.
- (goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "\n"))
- (replace-match "\n")
- (backward-char 1)
- (setq delimline (point-marker))
- (run-hooks 'message-send-mail-hook)
- ;; (sendmail-synch-aliases)
- ;; (if mail-aliases
- ;; (expand-mail-aliases (point-min) delimline))
- (goto-char (point-min))
- ;; ignore any blank lines in the header
- (while (and (re-search-forward "\n\n\n*" delimline t)
- (< (point) delimline))
- (replace-match "\n"))
- (let ((case-fold-search t))
- (goto-char (point-min))
- (goto-char (point-min))
- (while (re-search-forward "^Resent-to:" delimline t)
- (setq resend-to-addresses
- (save-restriction
- (narrow-to-region (point)
- (save-excursion
- (end-of-line)
- (point)))
- (append (mail-parse-comma-list)
- resend-to-addresses))))
-;;; Apparently this causes a duplicate Sender.
-;;; ;; If the From is different than current user, insert Sender.
-;;; (goto-char (point-min))
-;;; (and (re-search-forward "^From:" delimline t)
-;;; (progn
-;;; (require 'mail-utils)
-;;; (not (string-equal
-;;; (mail-strip-quoted-names
-;;; (save-restriction
-;;; (narrow-to-region (point-min) delimline)
-;;; (mail-fetch-field "From")))
-;;; (user-login-name))))
-;;; (progn
-;;; (forward-line 1)
-;;; (insert "Sender: " (user-login-name) "\n")))
- ;; Don't send out a blank subject line
- (goto-char (point-min))
- (if (re-search-forward "^Subject:[ \t]*\n" delimline t)
- (replace-match ""))
- ;; Put the "From:" field in unless for some odd reason
- ;; they put one in themselves.
- (goto-char (point-min))
- (if (not (re-search-forward "^From:" delimline t))
- (let* ((login user-mail-address)
- (fullname (user-full-name)))
- (cond ((eq mail-from-style 'angles)
- (insert "From: " fullname)
- (let ((fullname-start (+ (point-min) 6))
- (fullname-end (point-marker)))
- (goto-char fullname-start)
- ;; Look for a character that cannot appear unquoted
- ;; according to RFC 822.
- (if (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]"
- fullname-end 1)
- (progn
- ;; Quote fullname, escaping specials.
- (goto-char fullname-start)
- (insert "\"")
- (while (re-search-forward "[\"\\]"
- fullname-end 1)
- (replace-match "\\\\\\&" t))
- (insert "\""))))
- (insert " <" login ">\n"))
- ((eq mail-from-style 'parens)
- (insert "From: " login " (")
- (let ((fullname-start (point)))
- (insert fullname)
- (let ((fullname-end (point-marker)))
- (goto-char fullname-start)
- ;; RFC 822 says \ and nonmatching parentheses
- ;; must be escaped in comments.
- ;; Escape every instance of ()\ ...
- (while (re-search-forward "[()\\]" fullname-end 1)
- (replace-match "\\\\\\&" t))
- ;; ... then undo escaping of matching parentheses,
- ;; including matching nested parentheses.
- (goto-char fullname-start)
- (while (re-search-forward
- "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"
- fullname-end 1)
- (replace-match "\\1(\\3)" t)
- (goto-char fullname-start))))
- (insert ")\n"))
- ((null mail-from-style)
- (insert "From: " login "\n")))))
- ;; Insert an extra newline if we need it to work around
- ;; Sun's bug that swallows newlines.
- (goto-char (1+ delimline))
- (if (eval mail-mailer-swallows-blank-line)
- (newline))
- ;; Find and handle any FCC fields.
- (goto-char (point-min))
- (if (re-search-forward "^FCC:" delimline t)
- (mail-do-fcc delimline))
- (if mail-interactive
- (save-excursion
- (set-buffer errbuf)
- (erase-buffer))))
- ;;
- ;;
- ;;
- (let ((recipient-address-list
- (or resend-to-addresses
- (smtp-deduce-address-list (current-buffer)
- (point-min) delimline))))
- (smtp-do-bcc delimline)
-
- (if recipient-address-list
- (if (not (smtp-via-smtp recipient-address-list
- (current-buffer)))
- (error "Sending failed; SMTP protocol error"))
- (error "Sending failed; no recipients"))
- ))
- (if (bufferp errbuf)
- (kill-buffer errbuf)))))
+ "Send off the prepared buffer with SMTP."
+ (require 'smtp) ; XXX
+ (let ((case-fold-search t)
+ recipients)
+ (save-restriction
+ (message-narrow-to-headers)
+ (setq recipients
+ ;; XXX: Should be replaced by better one.
+ (smtp-deduce-address-list (current-buffer)
+ (point-min) (point-max)))
+ ;; Remove BCC lines.
+ (message-remove-header "bcc"))
+ ;; replace the header delimiter with a blank line.
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "\n"))
+ (replace-match "\n")
+ (backward-char 1)
+ (run-hooks 'message-send-mail-hook)
+ (if recipients
+ (let ((result (smtp-via-smtp user-mail-address
+ recipients
+ (current-buffer))))
+ (unless (eq result t)
+ (error "Sending failed; " result)))
+ (error "Sending failed; no recipients"))))
+
+(defsubst message-maybe-split-and-send-news (method)
+ "Split a message if necessary, and send it via news.
+Returns nil if sending succeeded, returns t if sending failed.
+This sub function is for exclusive use of `message-send-news'."
+ (let ((mime-edit-split-ignored-field-regexp
+ mime-edit-split-ignored-field-regexp)
+ (case-fold-search t))
+ (while (string-match "Message-ID" mime-edit-split-ignored-field-regexp)
+ (setq mime-edit-split-ignored-field-regexp
+ (concat (substring mime-edit-split-ignored-field-regexp
+ 0 (match-beginning 0))
+ "Hey_MIME-Edit,_there_is_an_inviolable_Message_ID"
+ "_so_don't_rape_it!"
+ (substring mime-edit-split-ignored-field-regexp
+ (match-end 0)))))
+ (or
+ (catch 'message-sending-news-failure
+ (mime-edit-maybe-split-and-send
+ (function
+ (lambda ()
+ (interactive)
+ (save-restriction
+ (std11-narrow-to-header mail-header-separator)
+ (goto-char (point-min))
+ (when (re-search-forward "^Message-ID:" nil t)
+ (delete-region (match-end 0) (std11-field-end))
+ (insert " " (message-make-message-id))))
+ (unless (funcall message-send-news-function method)
+ (throw 'message-sending-news-failure t)))))
+ nil)
+ (not (funcall message-send-news-function method)))))