Replace version 24.2 with 24.3 where appropriate (hopefully)
[bpt/emacs.git] / lisp / obsolete / mailpost.el
CommitLineData
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.
29To use it, include \"(setq send-mail-function 'post-mail-send-it)\" in
30site-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