Mercurial > emacs
comparison lisp/mail/mailpost.el @ 4:504879714b38
Initial revision
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Thu, 18 Sep 1986 22:28:40 +0000 |
parents | |
children | d1d8765cc35e |
comparison
equal
deleted
inserted
replaced
3:9c1c71cc250c | 4:504879714b38 |
---|---|
1 ;; | |
2 ;; P O S T . E L | |
3 ;; | |
4 ;; Yet another mail interface. this for the rmail system to provide | |
5 ;; the missing sendmail interface on systems without /usr/lib/sendmail, | |
6 ;; but with /usr/uci/post. | |
7 ;; | |
8 ;; created by: Gary Delp <delp at huey.Udel.Edu> | |
9 ;; Mon Jan 13 14:45:12 1986 | |
10 ;; | |
11 ;; | |
12 | |
13 ;; (setq send-mail-function 'post-mail-send-it) | |
14 | |
15 (defun post-mail-send-it () | |
16 "\ | |
17 the MH -post interface for rmail-mail to call. | |
18 to use it, include (setq send-mail-function 'post-mail-send-it) in site-init." | |
19 (let ((errbuf (if mail-interactive | |
20 (generate-new-buffer " post-mail errors") | |
21 0)) | |
22 (temfile "/tmp/,rpost") | |
23 (tembuf (generate-new-buffer " post-mail temp")) | |
24 (case-fold-search nil) | |
25 delimline | |
26 (mailbuf (current-buffer))) | |
27 (unwind-protect | |
28 (save-excursion | |
29 (set-buffer tembuf) | |
30 (erase-buffer) | |
31 (insert-buffer-substring mailbuf) | |
32 (goto-char (point-max)) | |
33 ;; require one newline at the end. | |
34 (or (= (preceding-char) ?\n) | |
35 (insert ?\n)) | |
36 ;; Change header-delimiter to be what post-mail expects. | |
37 (goto-char (point-min)) | |
38 (search-forward (concat "\n" mail-header-separator "\n")) | |
39 (replace-match "\n\n") | |
40 (backward-char 1) | |
41 (setq delimline (point-marker)) | |
42 (if mail-aliases | |
43 (expand-mail-aliases (point-min) delimline)) | |
44 (goto-char (point-min)) | |
45 ;; ignore any blank lines in the header | |
46 (while (and (re-search-forward "\n\n\n*" delimline t) | |
47 (< (point) delimline)) | |
48 (replace-match "\n")) | |
49 ;; Find and handle any FCC fields. | |
50 (let ((case-fold-search t)) | |
51 (goto-char (point-min)) | |
52 (if (re-search-forward "^FCC:" delimline t) | |
53 (mail-do-fcc delimline)) | |
54 ;; If there is a From and no Sender, put it a Sender. | |
55 (goto-char (point-min)) | |
56 (and (re-search-forward "^From:" delimline t) | |
57 (not (save-excursion | |
58 (goto-char (point-min)) | |
59 (re-search-forward "^Sender:" delimline t))) | |
60 (progn | |
61 (forward-line 1) | |
62 (insert "Sender: " (user-login-name) "\n"))) | |
63 ;; don't send out a blank subject line | |
64 (goto-char (point-min)) | |
65 (if (re-search-forward "^Subject:[ \t]*\n" delimline t) | |
66 (replace-match "")) | |
67 (if mail-interactive | |
68 (save-excursion | |
69 (set-buffer errbuf) | |
70 (erase-buffer)))) | |
71 (write-file (setq temfile (make-temp-name temfile))) | |
72 (set-file-modes temfile 384) | |
73 (apply 'call-process | |
74 (append (list (if (boundp 'post-mail-program) | |
75 post-mail-program | |
76 "/usr/uci/lib/mh/post") | |
77 nil errbuf nil | |
78 "-nofilter" "-msgid") | |
79 (if mail-interactive '("-watch") '("-nowatch")) | |
80 (list temfile))) | |
81 (if mail-interactive | |
82 (save-excursion | |
83 (set-buffer errbuf) | |
84 (goto-char (point-min)) | |
85 (while (re-search-forward "\n\n* *" nil t) | |
86 (replace-match "; ")) | |
87 (if (not (zerop (buffer-size))) | |
88 (error "Sending...failed to %s" | |
89 (buffer-substring (point-min) (point-max))))))) | |
90 (kill-buffer tembuf) | |
91 (if (bufferp errbuf) | |
92 (switch-to-buffer errbuf))))) |