aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman1996-06-18 22:38:23 +0000
committerRichard M. Stallman1996-06-18 22:38:23 +0000
commit0e2701ca22814e2024715bc8f09805992ef5ce5e (patch)
treeb0d9dd489f1d58ece6e367043d275ed5b588e2de
parente2f7c2217eaecff5ecaf44b77b75b1ae5a2069a0 (diff)
downloademacs-0e2701ca22814e2024715bc8f09805992ef5ce5e.tar.gz
emacs-0e2701ca22814e2024715bc8f09805992ef5ce5e.zip
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Delete code that converted "S:" to "Subject:". Insert FROM field unless it already exists (code from sendmail.el).
-rw-r--r--lisp/mail/smtpmail.el62
1 files changed, 52 insertions, 10 deletions
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index dcea31faa09..88042b9555f 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -3,6 +3,7 @@
3;; Copyright (C) 1995, 1996 Free Software Foundation, Inc. 3;; Copyright (C) 1995, 1996 Free Software Foundation, Inc.
4 4
5;; Author: Tomoji Kagatani <kagatani@rbc.ncl.omron.co.jp> 5;; Author: Tomoji Kagatani <kagatani@rbc.ncl.omron.co.jp>
6;; Maintainer: Brian D. Carlstrom <bdc@ai.mit.edu>
6;; Keywords: mail 7;; Keywords: mail
7 8
8;; This file is part of GNU Emacs. 9;; This file is part of GNU Emacs.
@@ -25,7 +26,6 @@
25;;; Commentary: 26;;; Commentary:
26 27
27;; Send Mail to smtp host from smtpmail temp buffer. 28;; Send Mail to smtp host from smtpmail temp buffer.
28;; alfa release
29 29
30;; Please add these lines in your .emacs(_emacs). 30;; Please add these lines in your .emacs(_emacs).
31;; 31;;
@@ -36,6 +36,7 @@
36;;(setq smtpmail-debug-info t) 36;;(setq smtpmail-debug-info t)
37;;(load-library "smtpmail") 37;;(load-library "smtpmail")
38;;(setq smtpmail-code-conv-from nil) 38;;(setq smtpmail-code-conv-from nil)
39;;(setq user-full-name "YOUR NAME HERE")
39 40
40;;; Code: 41;;; Code:
41 42
@@ -103,12 +104,7 @@ don't define this value.")
103 (replace-match "\n")) 104 (replace-match "\n"))
104 (let ((case-fold-search t)) 105 (let ((case-fold-search t))
105 (goto-char (point-min)) 106 (goto-char (point-min))
106 ;; Find and handle any FCC fields.
107 (goto-char (point-min)) 107 (goto-char (point-min))
108 (if (re-search-forward "^FCC:" delimline t)
109 (mail-do-fcc delimline))
110 (goto-char (point-min))
111 (require 'mail-utils)
112 (while (re-search-forward "^Resent-to:" delimline t) 108 (while (re-search-forward "^Resent-to:" delimline t)
113 (setq resend-to-addresses 109 (setq resend-to-addresses
114 (save-restriction 110 (save-restriction
@@ -133,19 +129,65 @@ don't define this value.")
133;;; (progn 129;;; (progn
134;;; (forward-line 1) 130;;; (forward-line 1)
135;;; (insert "Sender: " (user-login-name) "\n"))) 131;;; (insert "Sender: " (user-login-name) "\n")))
136 ;; "S:" is an abbreviation for "Subject:".
137 (goto-char (point-min))
138 (if (re-search-forward "^S:" delimline t)
139 (replace-match "Subject:"))
140 ;; Don't send out a blank subject line 132 ;; Don't send out a blank subject line
141 (goto-char (point-min)) 133 (goto-char (point-min))
142 (if (re-search-forward "^Subject:[ \t]*\n" delimline t) 134 (if (re-search-forward "^Subject:[ \t]*\n" delimline t)
143 (replace-match "")) 135 (replace-match ""))
136 ;; Put the "From:" field in unless for some odd reason
137 ;; they put one in themselves.
138 (goto-char (point-min))
139 (if (not (re-search-forward "^From:" delimline t))
140 (let* ((login user-mail-address)
141 (fullname (user-full-name)))
142 (cond ((eq mail-from-style 'angles)
143 (insert "From: " fullname)
144 (let ((fullname-start (+ (point-min) 6))
145 (fullname-end (point-marker)))
146 (goto-char fullname-start)
147 ;; Look for a character that cannot appear unquoted
148 ;; according to RFC 822.
149 (if (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]"
150 fullname-end 1)
151 (progn
152 ;; Quote fullname, escaping specials.
153 (goto-char fullname-start)
154 (insert "\"")
155 (while (re-search-forward "[\"\\]"
156 fullname-end 1)
157 (replace-match "\\\\\\&" t))
158 (insert "\""))))
159 (insert " <" login ">\n"))
160 ((eq mail-from-style 'parens)
161 (insert "From: " login " (")
162 (let ((fullname-start (point)))
163 (insert fullname)
164 (let ((fullname-end (point-marker)))
165 (goto-char fullname-start)
166 ;; RFC 822 says \ and nonmatching parentheses
167 ;; must be escaped in comments.
168 ;; Escape every instance of ()\ ...
169 (while (re-search-forward "[()\\]" fullname-end 1)
170 (replace-match "\\\\\\&" t))
171 ;; ... then undo escaping of matching parentheses,
172 ;; including matching nested parentheses.
173 (goto-char fullname-start)
174 (while (re-search-forward
175 "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"
176 fullname-end 1)
177 (replace-match "\\1(\\3)" t)
178 (goto-char fullname-start))))
179 (insert ")\n"))
180 ((null mail-from-style)
181 (insert "From: " login "\n")))))
144 ;; Insert an extra newline if we need it to work around 182 ;; Insert an extra newline if we need it to work around
145 ;; Sun's bug that swallows newlines. 183 ;; Sun's bug that swallows newlines.
146 (goto-char (1+ delimline)) 184 (goto-char (1+ delimline))
147 (if (eval mail-mailer-swallows-blank-line) 185 (if (eval mail-mailer-swallows-blank-line)
148 (newline)) 186 (newline))
187 ;; Find and handle any FCC fields.
188 (goto-char (point-min))
189 (if (re-search-forward "^FCC:" delimline t)
190 (mail-do-fcc delimline))
149 (if mail-interactive 191 (if mail-interactive
150 (save-excursion 192 (save-excursion
151 (set-buffer errbuf) 193 (set-buffer errbuf)