Commit | Line | Data |
---|---|---|
84176303 ER |
1 | ;;; mailpost.el --- RMAIL coupler to /usr/uci/post mailer |
2 | ||
eea8d4ef | 3 | ;; This is in the public domain |
659f64e9 | 4 | ;; since Delp distributed it in 1986 without a copyright notice. |
eea8d4ef | 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 |
2a1e2476 | 12 | ;; Obsolete-since: 24.3 |
84176303 | 13 | |
84176303 | 14 | ;;; Commentary: |
6594deb0 | 15 | |
bd1411a8 RS |
16 | ;; Yet another mail interface. this for the rmail system to provide |
17 | ;; the missing sendmail interface on systems without /usr/lib/sendmail, | |
18 | ;; but with /usr/uci/post. | |
84176303 ER |
19 | |
20 | ;;; Code: | |
bd1411a8 | 21 | |
e8a57935 JB |
22 | (require 'mailalias) |
23 | (require 'sendmail) | |
24 | ||
bd1411a8 RS |
25 | ;; (setq send-mail-function 'post-mail-send-it) |
26 | ||
27 | (defun post-mail-send-it () | |
d1682c89 JB |
28 | "The MH -post interface for `rmail-mail' to call. |
29 | To use it, include \"(setq send-mail-function 'post-mail-send-it)\" in | |
30 | site-init." | |
bd1411a8 RS |
31 | (let ((errbuf (if mail-interactive |
32 | (generate-new-buffer " post-mail errors") | |
33 | 0)) | |
9858013f | 34 | temfile |
bd1411a8 RS |
35 | (tembuf (generate-new-buffer " post-mail temp")) |
36 | (case-fold-search nil) | |
37 | delimline | |
38 | (mailbuf (current-buffer))) | |
39 | (unwind-protect | |
937e6a56 | 40 | (with-current-buffer tembuf |
bd1411a8 RS |
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 | |
937e6a56 | 76 | (with-current-buffer errbuf |
bd1411a8 | 77 | (erase-buffer)))) |
9858013f GM |
78 | (let ((m (default-file-modes))) |
79 | (unwind-protect | |
80 | (progn | |
81 | (set-default-file-modes 384) | |
82 | (setq temfile (make-temp-file ",rpost"))) | |
83 | (set-default-file-modes m))) | |
bd1411a8 RS |
84 | (apply 'call-process |
85 | (append (list (if (boundp 'post-mail-program) | |
86 | post-mail-program | |
87 | "/usr/uci/lib/mh/post") | |
88 | nil errbuf nil | |
89 | "-nofilter" "-msgid") | |
90 | (if mail-interactive '("-watch") '("-nowatch")) | |
91 | (list temfile))) | |
92 | (if mail-interactive | |
937e6a56 | 93 | (with-current-buffer errbuf |
bd1411a8 RS |
94 | (goto-char (point-min)) |
95 | (while (re-search-forward "\n\n* *" nil t) | |
96 | (replace-match "; ")) | |
97 | (if (not (zerop (buffer-size))) | |
98 | (error "Sending...failed to %s" | |
99 | (buffer-substring (point-min) (point-max))))))) | |
100 | (kill-buffer tembuf) | |
101 | (if (bufferp errbuf) | |
102 | (switch-to-buffer errbuf))))) | |
6594deb0 | 103 | |
896546cd RS |
104 | (provide 'mailpost) |
105 | ||
6594deb0 | 106 | ;;; mailpost.el ends here |