Commit | Line | Data |
---|---|---|
84176303 ER |
1 | ;;; mailpost.el --- RMAIL coupler to /usr/uci/post mailer |
2 | ||
eea8d4ef ER |
3 | ;; This is in the public domain |
4 | ;; since Delp distributed it without a copyright notice in 1986. | |
5 | ||
55535639 PJ |
6 | ;; This file is part of GNU Emacs. |
7 | ||
84176303 ER |
8 | ;; Author: Gary Delp <delp@huey.Udel.Edu> |
9 | ;; Maintainer: FSF | |
10 | ;; Created: 13 Jan 1986 | |
fd7fa35a | 11 | ;; Keywords: mail |
84176303 | 12 | |
84176303 | 13 | ;;; Commentary: |
6594deb0 | 14 | |
bd1411a8 RS |
15 | ;; Yet another mail interface. this for the rmail system to provide |
16 | ;; the missing sendmail interface on systems without /usr/lib/sendmail, | |
17 | ;; but with /usr/uci/post. | |
84176303 ER |
18 | |
19 | ;;; Code: | |
bd1411a8 | 20 | |
e8a57935 JB |
21 | (require 'mailalias) |
22 | (require 'sendmail) | |
23 | ||
bd1411a8 RS |
24 | ;; (setq send-mail-function 'post-mail-send-it) |
25 | ||
26 | (defun post-mail-send-it () | |
d1682c89 JB |
27 | "The MH -post interface for `rmail-mail' to call. |
28 | To use it, include \"(setq send-mail-function 'post-mail-send-it)\" in | |
29 | site-init." | |
bd1411a8 RS |
30 | (let ((errbuf (if mail-interactive |
31 | (generate-new-buffer " post-mail errors") | |
32 | 0)) | |
9858013f | 33 | temfile |
bd1411a8 RS |
34 | (tembuf (generate-new-buffer " post-mail temp")) |
35 | (case-fold-search nil) | |
36 | delimline | |
37 | (mailbuf (current-buffer))) | |
38 | (unwind-protect | |
39 | (save-excursion | |
40 | (set-buffer tembuf) | |
41 | (erase-buffer) | |
42 | (insert-buffer-substring mailbuf) | |
43 | (goto-char (point-max)) | |
44 | ;; require one newline at the end. | |
45 | (or (= (preceding-char) ?\n) | |
46 | (insert ?\n)) | |
47 | ;; Change header-delimiter to be what post-mail expects. | |
82860d5c | 48 | (mail-sendmail-undelimit-header) |
bd1411a8 RS |
49 | (setq delimline (point-marker)) |
50 | (if mail-aliases | |
51 | (expand-mail-aliases (point-min) delimline)) | |
52 | (goto-char (point-min)) | |
53 | ;; ignore any blank lines in the header | |
54 | (while (and (re-search-forward "\n\n\n*" delimline t) | |
55 | (< (point) delimline)) | |
56 | (replace-match "\n")) | |
57 | ;; Find and handle any FCC fields. | |
58 | (let ((case-fold-search t)) | |
59 | (goto-char (point-min)) | |
60 | (if (re-search-forward "^FCC:" delimline t) | |
61 | (mail-do-fcc delimline)) | |
62 | ;; If there is a From and no Sender, put it a Sender. | |
63 | (goto-char (point-min)) | |
64 | (and (re-search-forward "^From:" delimline t) | |
65 | (not (save-excursion | |
66 | (goto-char (point-min)) | |
67 | (re-search-forward "^Sender:" delimline t))) | |
68 | (progn | |
69 | (forward-line 1) | |
70 | (insert "Sender: " (user-login-name) "\n"))) | |
71 | ;; don't send out a blank subject line | |
72 | (goto-char (point-min)) | |
73 | (if (re-search-forward "^Subject:[ \t]*\n" delimline t) | |
74 | (replace-match "")) | |
75 | (if mail-interactive | |
76 | (save-excursion | |
77 | (set-buffer errbuf) | |
78 | (erase-buffer)))) | |
9858013f GM |
79 | (let ((m (default-file-modes))) |
80 | (unwind-protect | |
81 | (progn | |
82 | (set-default-file-modes 384) | |
83 | (setq temfile (make-temp-file ",rpost"))) | |
84 | (set-default-file-modes m))) | |
bd1411a8 RS |
85 | (apply 'call-process |
86 | (append (list (if (boundp 'post-mail-program) | |
87 | post-mail-program | |
88 | "/usr/uci/lib/mh/post") | |
89 | nil errbuf nil | |
90 | "-nofilter" "-msgid") | |
91 | (if mail-interactive '("-watch") '("-nowatch")) | |
92 | (list temfile))) | |
93 | (if mail-interactive | |
94 | (save-excursion | |
95 | (set-buffer errbuf) | |
96 | (goto-char (point-min)) | |
97 | (while (re-search-forward "\n\n* *" nil t) | |
98 | (replace-match "; ")) | |
99 | (if (not (zerop (buffer-size))) | |
100 | (error "Sending...failed to %s" | |
101 | (buffer-substring (point-min) (point-max))))))) | |
102 | (kill-buffer tembuf) | |
103 | (if (bufferp errbuf) | |
104 | (switch-to-buffer errbuf))))) | |
6594deb0 | 105 | |
896546cd RS |
106 | (provide 'mailpost) |
107 | ||
cbee283d | 108 | ;; arch-tag: 1f8ca085-60a6-4eac-8efb-69ffec2fa124 |
6594deb0 | 109 | ;;; mailpost.el ends here |