HCoop / bpt / emacs.git / blame
| Commit | Line | Data |
|---|---|---|
| bd1411a8 RS |
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))))) |