/[emacs]/emacs/lisp/mail/sendmail.el
ViewVC logotype

Diff of /emacs/lisp/mail/sendmail.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.295 by cyd, Thu Nov 17 16:30:52 2005 UTC revision 1.296 by cyd, Tue Nov 29 23:54:47 2005 UTC
# Line 446  actually occur.") Line 446  actually occur.")
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)
# Line 455  actually occur.") Line 455  actually occur.")
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)
# Line 464  actually occur.") Line 464  actually occur.")
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.
# Line 488  actually occur.") Line 488  actually occur.")
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))
# Line 835  the user from the mailer." Line 835  the user from the mailer."
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")
# Line 931  See also the function `select-message-co Line 931  See also the function `select-message-co
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)))
# Line 955  See also the function `select-message-co Line 955  See also the function `select-message-co
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'")))))
# Line 996  external program defined by `sendmail-pr Line 996  external program defined by `sendmail-pr
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)))
# Line 1008  external program defined by `sendmail-pr Line 1008  external program defined by `sendmail-pr
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.
# Line 1070  external program defined by `sendmail-pr Line 1070  external program defined by `sendmail-pr
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))
# Line 1167  external program defined by `sendmail-pr Line 1167  external program defined by `sendmail-pr
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)
# Line 1178  external program defined by `sendmail-pr Line 1178  external program defined by `sendmail-pr
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
# Line 1220  external program defined by `sendmail-pr Line 1220  external program defined by `sendmail-pr
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\^_")
# Line 1262  external program defined by `sendmail-pr Line 1261  external program defined by `sendmail-pr
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
# Line 1318  external program defined by `sendmail-pr Line 1316  external program defined by `sendmail-pr
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."
# Line 1326  external program defined by `sendmail-pr Line 1324  external program defined by `sendmail-pr
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."
# Line 1334  external program defined by `sendmail-pr Line 1332  external program defined by `sendmail-pr
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."
# Line 1349  Create a Mail-Reply-To field if none." Line 1347  Create a Mail-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.
# Line 1358  Create a Mail-Followup-To field if none. Line 1356  Create a Mail-Followup-To field if none.
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
# Line 1373  Create a Mail-Followup-To field if none. Line 1371  Create a Mail-Followup-To field if none.
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    
# Line 1396  Prefix arg means put contents at point." Line 1394  Prefix arg means put contents at point."
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)
# Line 1482  and don't delete any header fields." Line 1480  and don't delete any header fields."
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)
# Line 1566  If the current line has `mail-yank-prefi Line 1564  If the current line has `mail-yank-prefi
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)

Legend:
Removed from v.1.295  
changed lines
  Added in v.1.296

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26