(message-send-mail-function): Add `message-send-mail-with-smtp' as an

item.
(message-send-mail-with-smtp): New function.

diff --git a/lisp/message.el b/lisp/message.el
index b6f199f..a1a5bf3 100644 (file)
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -331,6 +331,7 @@ Legal values include `message-send-mail-with-sendmail' (the default),
   :type '(radio (function-item message-send-mail-with-sendmail)
                (function-item message-send-mail-with-mh)
                (function-item message-send-mail-with-qmail)
+               (function-item message-send-mail-with-smtp)
                (function :tag "Other"))
   :group 'message-sending
   :group 'message-mail)
@@ -2077,6 +2078,152 @@ to find out how to use this."
     ;; Pass it on to mh.
     (mh-send-letter)))
 
+(defun message-send-mail-with-smtp ()
+  "Send the prepared message buffer with SMTP."
+  (require 'smtp)
+  (let ((errbuf (if mail-interactive
+                   (generate-new-buffer " smtp errors")
+                 0))
+       (tembuf (generate-new-buffer " smtp temp"))
+       (case-fold-search nil)
+       resend-to-addresses
+       delimline
+       (mailbuf (current-buffer)))
+    (unwind-protect
+       (save-excursion
+         (set-buffer tembuf)
+         (erase-buffer)
+         (insert-buffer-substring mailbuf)
+         (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))))
+         ;;
+         ;;
+         ;;
+         (setq smtp-address-buffer (generate-new-buffer "*smtp-mail*"))
+         (setq smtp-recipient-address-list
+               (or resend-to-addresses
+                   (smtp-deduce-address-list tembuf (point-min) delimline)))
+         (kill-buffer smtp-address-buffer)
+         
+         (smtp-do-bcc delimline)
+
+         (if (not (null smtp-recipient-address-list))
+             (if (not (smtp-via-smtp smtp-recipient-address-list tembuf))
+                 (error "Sending failed; SMTP protocol error"))
+           (error "Sending failed; no recipients"))
+         )
+      (kill-buffer tembuf)
+      (if (bufferp errbuf)
+         (kill-buffer errbuf)))))
+
 (defun message-send-news (&optional arg)
   (let ((tembuf (message-generate-new-buffer-clone-locals " *message temp*"))
        (case-fold-search nil)