42 |
:prefix "mail-" |
:prefix "mail-" |
43 |
:group 'mail) |
:group 'mail) |
44 |
|
|
45 |
|
(defcustom mail-setup-with-from t |
46 |
|
"Non-nil means insert `From:' field when setting up the message." |
47 |
|
:type 'binary |
48 |
|
:group 'sendmail |
49 |
|
:version "22.1") |
50 |
|
|
51 |
;;;###autoload |
;;;###autoload |
52 |
(defcustom mail-from-style 'angles "\ |
(defcustom mail-from-style 'angles "\ |
53 |
*Specifies how \"From:\" fields look. |
*Specifies how \"From:\" fields look. |
422 |
(setq mail-send-actions actions) |
(setq mail-send-actions actions) |
423 |
(setq mail-reply-action replybuffer) |
(setq mail-reply-action replybuffer) |
424 |
(goto-char (point-min)) |
(goto-char (point-min)) |
425 |
|
(if mail-setup-with-from |
426 |
|
(mail-insert-from-field)) |
427 |
(insert "To: ") |
(insert "To: ") |
428 |
(save-excursion |
(save-excursion |
429 |
(if to |
(if to |
892 |
of outgoing mails regardless of the current language environment. |
of outgoing mails regardless of the current language environment. |
893 |
See also the function `select-message-coding-system'.") |
See also the function `select-message-coding-system'.") |
894 |
|
|
895 |
|
(defun mail-insert-from-field () |
896 |
|
(let* ((login user-mail-address) |
897 |
|
(fullname (user-full-name)) |
898 |
|
(quote-fullname nil)) |
899 |
|
(if (string-match "[^\0-\177]" fullname) |
900 |
|
(setq fullname (rfc2047-encode-string fullname) |
901 |
|
quote-fullname t)) |
902 |
|
(cond ((eq mail-from-style 'angles) |
903 |
|
(insert "From: " fullname) |
904 |
|
(let ((fullname-start (+ (point-min) 6)) |
905 |
|
(fullname-end (point-marker))) |
906 |
|
(goto-char fullname-start) |
907 |
|
;; Look for a character that cannot appear unquoted |
908 |
|
;; according to RFC 822. |
909 |
|
(if (or (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" |
910 |
|
fullname-end 1) |
911 |
|
quote-fullname) |
912 |
|
(progn |
913 |
|
;; Quote fullname, escaping specials. |
914 |
|
(goto-char fullname-start) |
915 |
|
(insert "\"") |
916 |
|
(while (re-search-forward "[\"\\]" |
917 |
|
fullname-end 1) |
918 |
|
(replace-match "\\\\\\&" t)) |
919 |
|
(insert "\"")))) |
920 |
|
(insert " <" login ">\n")) |
921 |
|
((eq mail-from-style 'parens) |
922 |
|
(insert "From: " login " (") |
923 |
|
(let ((fullname-start (point))) |
924 |
|
(if quote-fullname |
925 |
|
(insert "\"")) |
926 |
|
(insert fullname) |
927 |
|
(if quote-fullname |
928 |
|
(insert "\"")) |
929 |
|
(let ((fullname-end (point-marker))) |
930 |
|
(goto-char fullname-start) |
931 |
|
;; RFC 822 says \ and nonmatching parentheses |
932 |
|
;; must be escaped in comments. |
933 |
|
;; Escape every instance of ()\ ... |
934 |
|
(while (re-search-forward "[()\\]" fullname-end 1) |
935 |
|
(replace-match "\\\\\\&" t)) |
936 |
|
;; ... then undo escaping of matching parentheses, |
937 |
|
;; including matching nested parentheses. |
938 |
|
(goto-char fullname-start) |
939 |
|
(while (re-search-forward |
940 |
|
"\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)" |
941 |
|
fullname-end 1) |
942 |
|
(replace-match "\\1(\\3)" t) |
943 |
|
(goto-char fullname-start)))) |
944 |
|
(insert ")\n")) |
945 |
|
((null mail-from-style) |
946 |
|
(insert "From: " login "\n")) |
947 |
|
((eq mail-from-style 'system-default) |
948 |
|
nil) |
949 |
|
(t (error "Invalid value for `mail-from-style'"))))) |
950 |
|
|
951 |
(defun sendmail-send-it () |
(defun sendmail-send-it () |
952 |
"Send the current mail buffer using the Sendmail package. |
"Send the current mail buffer using the Sendmail package. |
953 |
This is a suitable value for `send-mail-function'. It sends using the |
This is a suitable value for `send-mail-function'. It sends using the |
1044 |
;; they put one in themselves. |
;; they put one in themselves. |
1045 |
(goto-char (point-min)) |
(goto-char (point-min)) |
1046 |
(if (not (re-search-forward "^From:" delimline t)) |
(if (not (re-search-forward "^From:" delimline t)) |
1047 |
(let* ((login user-mail-address) |
(mail-insert-from-field)) |
|
(fullname (user-full-name)) |
|
|
(quote-fullname nil)) |
|
|
(if (string-match "[^\0-\177]" fullname) |
|
|
(setq fullname (rfc2047-encode-string fullname) |
|
|
quote-fullname t)) |
|
|
(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 (or (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" |
|
|
fullname-end 1) |
|
|
quote-fullname) |
|
|
(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))) |
|
|
(if quote-fullname |
|
|
(insert "\"")) |
|
|
(insert fullname) |
|
|
(if quote-fullname |
|
|
(insert "\"")) |
|
|
(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")) |
|
|
((eq mail-from-style 'system-default) |
|
|
nil) |
|
|
(t (error "Invalid value for `mail-from-style'"))))) |
|
1048 |
;; Possibly add a MIME header for the current coding system |
;; Possibly add a MIME header for the current coding system |
1049 |
(let (charset) |
(let (charset) |
1050 |
(goto-char (point-min)) |
(goto-char (point-min)) |