446 |
;; has been called and has done so. |
;; has been called and has done so. |
447 |
(let ((fill-prefix "\t") |
(let ((fill-prefix "\t") |
448 |
(address-start (point))) |
(address-start (point))) |
449 |
(insert to hard-newline) |
(insert to "\n") |
450 |
(fill-region-as-paragraph address-start (point-max)) |
(fill-region-as-paragraph address-start (point-max)) |
451 |
(goto-char (point-max)) |
(goto-char (point-max)) |
452 |
(unless (bolp) |
(unless (bolp) |
455 |
(if cc |
(if cc |
456 |
(let ((fill-prefix "\t") |
(let ((fill-prefix "\t") |
457 |
(address-start (progn (insert "CC: ") (point)))) |
(address-start (progn (insert "CC: ") (point)))) |
458 |
(insert cc hard-newline) |
(insert cc "\n") |
459 |
(fill-region-as-paragraph address-start (point-max)) |
(fill-region-as-paragraph address-start (point-max)) |
460 |
(goto-char (point-max)) |
(goto-char (point-max)) |
461 |
(unless (bolp) |
(unless (bolp) |
464 |
(let ((fill-prefix "\t") |
(let ((fill-prefix "\t") |
465 |
(fill-column 78) |
(fill-column 78) |
466 |
(address-start (point))) |
(address-start (point))) |
467 |
(insert "In-reply-to: " in-reply-to hard-newline) |
(insert "In-reply-to: " in-reply-to "\n") |
468 |
(fill-region-as-paragraph address-start (point-max)) |
(fill-region-as-paragraph address-start (point-max)) |
469 |
(goto-char (point-max)) |
(goto-char (point-max)) |
470 |
(unless (bolp) |
(unless (bolp) |
471 |
(newline)))) |
(newline)))) |
472 |
(insert "Subject: " (or subject "") hard-newline) |
(insert "Subject: " (or subject "") "\n") |
473 |
(if mail-default-headers |
(if mail-default-headers |
474 |
(insert mail-default-headers)) |
(insert mail-default-headers)) |
475 |
(if mail-default-reply-to |
(if mail-default-reply-to |
476 |
(insert "Reply-to: " mail-default-reply-to hard-newline)) |
(insert "Reply-to: " mail-default-reply-to "\n")) |
477 |
(if mail-self-blind |
(if mail-self-blind |
478 |
(insert "BCC: " user-mail-address hard-newline)) |
(insert "BCC: " user-mail-address "\n")) |
479 |
(if mail-archive-file-name |
(if mail-archive-file-name |
480 |
(insert "FCC: " mail-archive-file-name hard-newline)) |
(insert "FCC: " mail-archive-file-name "\n")) |
481 |
(put-text-property (point) |
(put-text-property (point) |
482 |
(progn |
(progn |
483 |
(insert mail-header-separator hard-newline) |
(insert mail-header-separator "\n") |
484 |
(1- (point))) |
(1- (point))) |
485 |
'category 'mail-header-separator) |
'category 'mail-header-separator) |
486 |
;; Insert the signature. But remember the beginning of the message. |
;; Insert the signature. But remember the beginning of the message. |
488 |
(cond ((eq mail-signature t) |
(cond ((eq mail-signature t) |
489 |
(if (file-exists-p mail-signature-file) |
(if (file-exists-p mail-signature-file) |
490 |
(progn |
(progn |
491 |
(insert hard-newline hard-newline "-- " hard-newline) |
(insert "\n\n-- \n") |
492 |
(insert-file-contents mail-signature-file)))) |
(insert-file-contents mail-signature-file)))) |
493 |
((stringp mail-signature) |
((stringp mail-signature) |
494 |
(insert mail-signature)) |
(insert mail-signature)) |
835 |
(split-string new-header-values |
(split-string new-header-values |
836 |
",[[:space:]]+" t)) |
",[[:space:]]+" t)) |
837 |
(mapconcat 'identity l ", ")) |
(mapconcat 'identity l ", ")) |
838 |
hard-newline)) |
"\n")) |
839 |
;; Add Mail-Reply-To if none yet |
;; Add Mail-Reply-To if none yet |
840 |
(unless (mail-fetch-field "mail-reply-to") |
(unless (mail-fetch-field "mail-reply-to") |
841 |
(goto-char (mail-header-end)) |
(goto-char (mail-header-end)) |
842 |
(insert "Mail-Reply-To: " |
(insert "Mail-Reply-To: " |
843 |
(or (mail-fetch-field "reply-to") |
(or (mail-fetch-field "reply-to") |
844 |
user-mail-address) |
user-mail-address) |
845 |
hard-newline)))))) |
"\n")))))) |
846 |
(unless (memq mail-send-nonascii '(t mime)) |
(unless (memq mail-send-nonascii '(t mime)) |
847 |
(goto-char (point-min)) |
(goto-char (point-min)) |
848 |
(skip-chars-forward "\0-\177") |
(skip-chars-forward "\0-\177") |
931 |
fullname-end 1) |
fullname-end 1) |
932 |
(replace-match "\\\\\\&" t)) |
(replace-match "\\\\\\&" t)) |
933 |
(insert "\"")))) |
(insert "\"")))) |
934 |
(insert " <" login ">" hard-newline)) |
(insert " <" login ">\n")) |
935 |
((eq mail-from-style 'parens) |
((eq mail-from-style 'parens) |
936 |
(insert "From: " login " (") |
(insert "From: " login " (") |
937 |
(let ((fullname-start (point))) |
(let ((fullname-start (point))) |
955 |
fullname-end 1) |
fullname-end 1) |
956 |
(replace-match "\\1(\\3)" t) |
(replace-match "\\1(\\3)" t) |
957 |
(goto-char fullname-start)))) |
(goto-char fullname-start)))) |
958 |
(insert ")" hard-newline)) |
(insert ")\n")) |
959 |
((null mail-from-style) |
((null mail-from-style) |
960 |
(insert "From: " login hard-newline)) |
(insert "From: " login "\n")) |
961 |
((eq mail-from-style 'system-default) |
((eq mail-from-style 'system-default) |
962 |
nil) |
nil) |
963 |
(t (error "Invalid value for `mail-from-style'"))))) |
(t (error "Invalid value for `mail-from-style'"))))) |
996 |
(goto-char (point-max)) |
(goto-char (point-max)) |
997 |
;; require one newline at the end. |
;; require one newline at the end. |
998 |
(or (= (preceding-char) ?\n) |
(or (= (preceding-char) ?\n) |
999 |
(insert hard-newline)) |
(insert ?\n)) |
1000 |
;; Change header-delimiter to be what sendmail expects. |
;; Change header-delimiter to be what sendmail expects. |
1001 |
(goto-char (mail-header-end)) |
(goto-char (mail-header-end)) |
1002 |
(delete-region (point) (progn (end-of-line) (point))) |
(delete-region (point) (progn (end-of-line) (point))) |
1008 |
;; Ignore any blank lines in the header |
;; Ignore any blank lines in the header |
1009 |
(while (and (re-search-forward "\n\n\n*" delimline t) |
(while (and (re-search-forward "\n\n\n*" delimline t) |
1010 |
(< (point) delimline)) |
(< (point) delimline)) |
1011 |
(replace-match hard-newline)) |
(replace-match "\n")) |
1012 |
(goto-char (point-min)) |
(goto-char (point-min)) |
1013 |
;; Look for Resent- headers. They require sending |
;; Look for Resent- headers. They require sending |
1014 |
;; the message specially. |
;; the message specially. |
1070 |
(setq charset |
(setq charset |
1071 |
(coding-system-get selected-coding 'mime-charset)) |
(coding-system-get selected-coding 'mime-charset)) |
1072 |
(goto-char delimline) |
(goto-char delimline) |
1073 |
(insert "MIME-version: 1.0" hard-newline |
(insert "MIME-version: 1.0\n" |
1074 |
"Content-type: text/plain; charset=" |
"Content-type: text/plain; charset=" |
1075 |
(symbol-name charset) hard-newline |
(symbol-name charset) |
1076 |
"Content-Transfer-Encoding: 8bit" hard-newline))) |
"\nContent-Transfer-Encoding: 8bit\n"))) |
1077 |
;; Insert an extra newline if we need it to work around |
;; Insert an extra newline if we need it to work around |
1078 |
;; Sun's bug that swallows newlines. |
;; Sun's bug that swallows newlines. |
1079 |
(goto-char (1+ delimline)) |
(goto-char (1+ delimline)) |
1167 |
(set-buffer tembuf) |
(set-buffer tembuf) |
1168 |
(erase-buffer) |
(erase-buffer) |
1169 |
;; This initial newline is written out if the fcc file already exists. |
;; This initial newline is written out if the fcc file already exists. |
1170 |
(insert hard-newline "From " (user-login-name) " " |
(insert "\nFrom " (user-login-name) " " |
1171 |
(current-time-string time) hard-newline) |
(current-time-string time) "\n") |
1172 |
;; Insert the time zone before the year. |
;; Insert the time zone before the year. |
1173 |
(forward-char -1) |
(forward-char -1) |
1174 |
(forward-word -1) |
(forward-word -1) |
1178 |
(insert-buffer-substring rmailbuf) |
(insert-buffer-substring rmailbuf) |
1179 |
;; Make sure messages are separated. |
;; Make sure messages are separated. |
1180 |
(goto-char (point-max)) |
(goto-char (point-max)) |
1181 |
(insert hard-newline) |
(insert ?\n) |
1182 |
(goto-char 2) |
(goto-char 2) |
1183 |
;; ``Quote'' "^From " as ">From " |
;; ``Quote'' "^From " as ">From " |
1184 |
;; (note that this isn't really quoting, as there is no requirement |
;; (note that this isn't really quoting, as there is no requirement |
1220 |
(rmail-maybe-set-message-counters) |
(rmail-maybe-set-message-counters) |
1221 |
(widen) |
(widen) |
1222 |
(narrow-to-region (point-max) (point-max)) |
(narrow-to-region (point-max) (point-max)) |
1223 |
(insert "\C-l" hard-newline "0, unseen,," |
(insert "\C-l\n0, unseen,,\n*** EOOH ***\n" |
1224 |
hard-newline "*** EOOH ***" hard-newline |
"Date: " (mail-rfc822-date) "\n") |
|
"Date: " (mail-rfc822-date) hard-newline) |
|
1225 |
(insert-buffer-substring curbuf beg2 end) |
(insert-buffer-substring curbuf beg2 end) |
1226 |
(insert hard-newline "\C-_") |
(insert "\n\C-_") |
1227 |
(goto-char (point-min)) |
(goto-char (point-min)) |
1228 |
(widen) |
(widen) |
1229 |
(search-backward "\n\^_") |
(search-backward "\n\^_") |
1261 |
(set-buffer (get-buffer-create " mail-temp")) |
(set-buffer (get-buffer-create " mail-temp")) |
1262 |
(setq buffer-read-only nil) |
(setq buffer-read-only nil) |
1263 |
(erase-buffer) |
(erase-buffer) |
1264 |
(insert "\C-l" hard-newline "0, unseen,," hard-newline |
(insert "\C-l\n0, unseen,,\n*** EOOH ***\nDate: " |
1265 |
"*** EOOH ***" hard-newline "Date: " |
(mail-rfc822-date) "\n") |
|
(mail-rfc822-date) hard-newline) |
|
1266 |
(insert-buffer-substring curbuf beg2 end) |
(insert-buffer-substring curbuf beg2 end) |
1267 |
(insert hard-newline "\C-_") |
(insert "\n\C-_") |
1268 |
(write-region (point-min) (point-max) (car fcc-list) t) |
(write-region (point-min) (point-max) (car fcc-list) t) |
1269 |
(erase-buffer))) |
(erase-buffer))) |
1270 |
(write-region |
(write-region |
1316 |
(expand-abbrev) |
(expand-abbrev) |
1317 |
(or (mail-position-on-field "cc" t) |
(or (mail-position-on-field "cc" t) |
1318 |
(progn (mail-position-on-field "to") |
(progn (mail-position-on-field "to") |
1319 |
(insert hard-newline "CC: ")))) |
(insert "\nCC: ")))) |
1320 |
|
|
1321 |
(defun mail-bcc () |
(defun mail-bcc () |
1322 |
"Move point to end of BCC-field. Create a BCC field if none." |
"Move point to end of BCC-field. Create a BCC field if none." |
1324 |
(expand-abbrev) |
(expand-abbrev) |
1325 |
(or (mail-position-on-field "bcc" t) |
(or (mail-position-on-field "bcc" t) |
1326 |
(progn (mail-position-on-field "to") |
(progn (mail-position-on-field "to") |
1327 |
(insert hard-newline "BCC: ")))) |
(insert "\nBCC: ")))) |
1328 |
|
|
1329 |
(defun mail-fcc (folder) |
(defun mail-fcc (folder) |
1330 |
"Add a new FCC field, with file name completion." |
"Add a new FCC field, with file name completion." |
1332 |
(expand-abbrev) |
(expand-abbrev) |
1333 |
(or (mail-position-on-field "fcc" t) ;Put new field after exiting FCC. |
(or (mail-position-on-field "fcc" t) ;Put new field after exiting FCC. |
1334 |
(mail-position-on-field "to")) |
(mail-position-on-field "to")) |
1335 |
(insert hard-newline "FCC: " folder)) |
(insert "\nFCC: " folder)) |
1336 |
|
|
1337 |
(defun mail-reply-to () |
(defun mail-reply-to () |
1338 |
"Move point to end of Reply-To-field. Create a Reply-To field if none." |
"Move point to end of Reply-To-field. Create a Reply-To field if none." |
1347 |
(expand-abbrev) |
(expand-abbrev) |
1348 |
(or (mail-position-on-field "mail-reply-to" t) |
(or (mail-position-on-field "mail-reply-to" t) |
1349 |
(progn (mail-position-on-field "to") |
(progn (mail-position-on-field "to") |
1350 |
(insert hard-newline "Mail-Reply-To: ")))) |
(insert "\nMail-Reply-To: ")))) |
1351 |
|
|
1352 |
(defun mail-mail-followup-to () |
(defun mail-mail-followup-to () |
1353 |
"Move point to end of Mail-Followup-To field. |
"Move point to end of Mail-Followup-To field. |
1356 |
(expand-abbrev) |
(expand-abbrev) |
1357 |
(or (mail-position-on-field "mail-followup-to" t) |
(or (mail-position-on-field "mail-followup-to" t) |
1358 |
(progn (mail-position-on-field "to") |
(progn (mail-position-on-field "to") |
1359 |
(insert hard-newline "Mail-Followup-To: ")))) |
(insert "\nMail-Followup-To: ")))) |
1360 |
|
|
1361 |
(defun mail-position-on-field (field &optional soft) |
(defun mail-position-on-field (field &optional soft) |
1362 |
(let (end |
(let (end |
1371 |
t) |
t) |
1372 |
(or soft |
(or soft |
1373 |
(progn (goto-char end) |
(progn (goto-char end) |
1374 |
(insert field ": " hard-newline) |
(insert field ": \n") |
1375 |
(skip-chars-backward "\n"))) |
(skip-chars-backward "\n"))) |
1376 |
nil))) |
nil))) |
1377 |
|
|
1394 |
(delete-region (point) (point-max))) |
(delete-region (point) (point-max))) |
1395 |
(if (stringp mail-signature) |
(if (stringp mail-signature) |
1396 |
(insert mail-signature) |
(insert mail-signature) |
1397 |
(insert hard-newline hard-newline "-- " hard-newline) |
(insert "\n\n-- \n") |
1398 |
(insert-file-contents (expand-file-name mail-signature-file))))) |
(insert-file-contents (expand-file-name mail-signature-file))))) |
1399 |
|
|
1400 |
(defun mail-fill-yanked-message (&optional justifyp) |
(defun mail-fill-yanked-message (&optional justifyp) |
1480 |
;; loop would deactivate the mark because we inserted text. |
;; loop would deactivate the mark because we inserted text. |
1481 |
(goto-char (prog1 (mark t) |
(goto-char (prog1 (mark t) |
1482 |
(set-marker (mark-marker) (point) (current-buffer)))) |
(set-marker (mark-marker) (point) (current-buffer)))) |
1483 |
(if (not (eolp)) (insert hard-newline))))) |
(if (not (eolp)) (insert ?\n))))) |
1484 |
|
|
1485 |
(defun mail-yank-clear-headers (start end) |
(defun mail-yank-clear-headers (start end) |
1486 |
(if (< end start) |
(if (< end start) |
1564 |
(insert-char ?= (max 0 (- 60 (current-column)))) |
(insert-char ?= (max 0 (- 60 (current-column)))) |
1565 |
(newline) |
(newline) |
1566 |
(setq middle (point)) |
(setq middle (point)) |
1567 |
(insert "============================================================" |
(insert "============================================================\n") |
|
hard-newline) |
|
1568 |
(push-mark) |
(push-mark) |
1569 |
(goto-char middle) |
(goto-char middle) |
1570 |
(insert-file-contents file) |
(insert-file-contents file) |