diff options
| author | Richard M. Stallman | 1996-06-18 22:38:23 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1996-06-18 22:38:23 +0000 |
| commit | 0e2701ca22814e2024715bc8f09805992ef5ce5e (patch) | |
| tree | b0d9dd489f1d58ece6e367043d275ed5b588e2de | |
| parent | e2f7c2217eaecff5ecaf44b77b75b1ae5a2069a0 (diff) | |
| download | emacs-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.el | 62 |
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) |