1;;; mailpost.el --- RMAIL coupler to /usr/uci/post mailer 2 3;; This is in the public domain 4;; since Delp distributed it without a copyright notice in 1986. 5 6;; This file is part of GNU Emacs. 7 8;; Author: Gary Delp <delp@huey.Udel.Edu> 9;; Maintainer: FSF 10;; Created: 13 Jan 1986 11;; Keywords: mail 12 13;;; Commentary: 14 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. 18 19;;; Code: 20 21(require 'mailalias) 22(require 'sendmail) 23 24;; (setq send-mail-function 'post-mail-send-it) 25 26(defun post-mail-send-it () 27 "The MH -post interface for `rmail-mail' to call. 28To use it, include \"(setq send-mail-function 'post-mail-send-it)\" in 29site-init." 30 (let ((errbuf (if mail-interactive 31 (generate-new-buffer " post-mail errors") 32 0)) 33 temfile 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. 48 (mail-sendmail-undelimit-header) 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)))) 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))) 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))))) 105 106(provide 'mailpost) 107 108;;; arch-tag: 1f8ca085-60a6-4eac-8efb-69ffec2fa124 109;;; mailpost.el ends here 110