(message-send-mail-with-smtp): Modify for smtp.el of Shoe-gnus.
[elisp/gnus.git-] / lisp / message.el
index 445e788..0b9e25a 100644 (file)
@@ -226,7 +226,7 @@ included.  Organization, Lines and User-Agent are optional."
   :group 'message-headers
   :type 'regexp)
 
-(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^X-Trace:\\|^X-Complaints-To:"
+(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:"
   "*Header lines matching this regexp will be deleted before posting.
 It's best to delete old Path and Date headers before posting to avoid
 any confusion."
@@ -308,7 +308,7 @@ If t, use `message-user-organization-file'."
   :type 'boolean)
 
 (defcustom message-included-forward-headers
-  "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-\\|^Message-ID:\\|^References:\\|^Content-Transfer-Encoding:\\|^Content-Type:\\|^MIME-Version:"
+  "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-\\|^Message-ID:\\|^References:\\|^Content-\\|^MIME-Version:"
   "*Regexp matching headers to be included in forwarded messages."
   :group 'message-forwarding
   :type 'regexp)
@@ -334,7 +334,7 @@ The provided functions are:
   :group 'message-forwarding
   :type 'boolean)
 
-(defcustom message-ignored-resent-headers "^Return-receipt"
+(defcustom message-ignored-resent-headers "^Return-Receipt"
   "*All headers that match this regexp will be deleted when resending a message."
   :group 'message-interface
   :type 'regexp)
@@ -661,10 +661,10 @@ the prefix.")
 The default is `abbrev', which uses mailabbrev.  nil switches
 mail aliases off.")
 
-(defcustom message-autosave-directory
+(defcustom message-auto-save-directory
   (nnheader-concat message-directory "drafts/")
-  "*Directory where Message autosaves buffers if Gnus isn't running.
-If nil, Message won't autosave."
+  "*Directory where Message auto-saves buffers if Gnus isn't running.
+If nil, Message won't auto-save."
   :group 'message-buffers
   :type 'directory)
 
@@ -2011,7 +2011,7 @@ the user from the mailer."
        ;; (mail-hist-put-headers-into-history))
        (run-hooks 'message-sent-hook)
        (message "Sending...done")
-       ;; Mark the buffer as unmodified and delete autosave.
+       ;; Mark the buffer as unmodified and delete auto-save.
        (set-buffer-modified-p nil)
        (delete-auto-save-file-if-necessary t)
        (message-disassociate-draft)
@@ -2230,143 +2230,32 @@ to find out how to use this."
     (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))
-       (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"))))
 
 (defun message-send-news (&optional arg)
   (let ((tembuf (message-generate-new-buffer-clone-locals " *message temp*"))
@@ -3482,12 +3371,12 @@ Headers already prepared in the buffer are not modified."
 
 (defun message-set-auto-save-file-name ()
   "Associate the message buffer with a file in the drafts directory."
-  (when message-autosave-directory
+  (when message-auto-save-directory
     (if (gnus-alive-p)
        (setq message-draft-article
              (nndraft-request-associate-buffer "drafts"))
       (setq buffer-file-name (expand-file-name "*message*"
-                                              message-autosave-directory))
+                                              message-auto-save-directory))
       (setq buffer-auto-save-file-name (make-auto-save-file-name)))
     (clear-visited-file-modtime)))