;; Copyright (C) 1995, 1996 Free Software Foundation, Inc.
;; Author: Tomoji Kagatani <kagatani@rbc.ncl.omron.co.jp>
+;; Maintainer: Brian D. Carlstrom <bdc@ai.mit.edu>
;; Keywords: mail
;; This file is part of GNU Emacs.
;;; Commentary:
;; Send Mail to smtp host from smtpmail temp buffer.
-;; alfa release
;; Please add these lines in your .emacs(_emacs).
;;
;;(setq smtpmail-debug-info t)
;;(load-library "smtpmail")
;;(setq smtpmail-code-conv-from nil)
+;;(setq user-full-name "YOUR NAME HERE")
;;; Code:
(replace-match "\n"))
(let ((case-fold-search t))
(goto-char (point-min))
- ;; Find and handle any FCC fields.
- (goto-char (point-min))
- (if (re-search-forward "^FCC:" delimline t)
- (mail-do-fcc delimline))
(goto-char (point-min))
- (require 'mail-utils)
(while (re-search-forward "^Resent-to:" delimline t)
(setq resend-to-addresses
(save-restriction
;;; (progn
;;; (forward-line 1)
;;; (insert "Sender: " (user-login-name) "\n")))
- ;; "S:" is an abbreviation for "Subject:".
- (goto-char (point-min))
- (if (re-search-forward "^S:" delimline t)
- (replace-match "Subject:"))
;; 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)
;;
(setq smtpmail-address-buffer (generate-new-buffer "*smtp-mail*"))
(setq smtpmail-recipient-address-list
- (smtpmail-deduce-address-list tembuf (point-min) delimline))
+ (or resend-to-addresses
+ (smtpmail-deduce-address-list tembuf (point-min) delimline)))
(kill-buffer smtpmail-address-buffer)
(smtpmail-do-bcc delimline)
;; MAIL FROM: <sender>
; (smtpmail-send-command process (format "MAIL FROM:%s@%s" (user-login-name) (smtpmail-fqdn)))
- (smtpmail-send-command process (format "MAIL FROM:%s" user-mail-address))
+ (smtpmail-send-command process (format "MAIL FROM: <%s>" user-mail-address))
(if (or (null (car (setq response-code (smtpmail-read-response process))))
(not (integerp (car response-code)))
;; RCPT TO: <recipient>
(let ((n 0))
(while (not (null (nth n recipient)))
- (smtpmail-send-command process (format "RCPT TO: %s" (nth n recipient)))
+ (smtpmail-send-command process (format "RCPT TO: <%s>" (nth n recipient)))
(setq n (1+ n))
(if (or (null (car (setq response-code (smtpmail-read-response process))))
; (setq response-continue t)
; (setq return-value '(nil ""))
- (goto-char smtpmail-read-point)
(while response-continue
+ (goto-char smtpmail-read-point)
(while (not (search-forward "\r\n" nil t))
(accept-process-output process)
(goto-char smtpmail-read-point))
(insert data "\r\n"))
(setq smtpmail-read-point (point))
- (process-send-string process data)
- ;; . -> ..
- (if (string-equal data ".")
+ ;; Escape "." at start of a line
+ (if (eq (string-to-char data) ?.)
(process-send-string process "."))
+ (process-send-string process data)
(process-send-string process "\r\n")
)
((case-fold-search t)
(simple-address-list "")
this-line
- this-line-end)
+ this-line-end
+ addr-regexp)
(unwind-protect
(save-excursion
(set-buffer smtpmail-address-buffer) (erase-buffer)
(insert-buffer-substring smtpmail-text-buffer header-start header-end)
(goto-char (point-min))
- (while (re-search-forward "^\\(TO:\\|CC:\\|BCC:\\)" header-end t)
+ ;; RESENT-* fields should stop processing of regular fields.
+ (save-excursion
+ (if (re-search-forward "^RESENT-TO:" header-end t)
+ (setq addr-regexp "^\\(RESENT-TO:\\|RESENT-CC:\\|RESENT-BCC:\\)")
+ (setq addr-regexp "^\\(TO:\\|CC:\\|BCC:\\)")))
+
+ (while (re-search-forward addr-regexp header-end t)
(replace-match "")
(setq this-line (match-beginning 0))
(forward-line 1)