Mercurial > emacs
annotate lisp/mail/mailpost.el @ 2607:fcf578723758
(Fexpand_file_name): Undo last change--too risky for now.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Thu, 29 Apr 1993 13:17:56 +0000 |
parents | 9f3cc03dae67 |
children | 11218164bc54 |
rev | line source |
---|---|
791
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
1 ;;; mailpost.el --- RMAIL coupler to /usr/uci/post mailer |
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
2 |
840
113281b361ec
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
811
diff
changeset
|
3 ;; This is in the public domain |
113281b361ec
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
811
diff
changeset
|
4 ;; since Delp distributed it without a copyright notice in 1986. |
113281b361ec
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
811
diff
changeset
|
5 |
791
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
6 ;; Author: Gary Delp <delp@huey.Udel.Edu> |
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
7 ;; Maintainer: FSF |
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
8 ;; Created: 13 Jan 1986 |
811
e694e0879463
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
791
diff
changeset
|
9 ;; Keywords: mail |
791
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
10 |
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
11 ;;; Commentary: |
659
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
222
diff
changeset
|
12 |
4 | 13 ;; Yet another mail interface. this for the rmail system to provide |
14 ;; the missing sendmail interface on systems without /usr/lib/sendmail, | |
15 ;; but with /usr/uci/post. | |
791
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
16 |
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
17 ;;; Code: |
4 | 18 |
923 | 19 (require 'mailalias) |
20 (require 'sendmail) | |
21 | |
4 | 22 ;; (setq send-mail-function 'post-mail-send-it) |
23 | |
24 (defun post-mail-send-it () | |
222 | 25 "The MH -post interface for `rmail-mail' to call. |
26 To use it, include \"(setq send-mail-function 'post-mail-send-it)\" in | |
27 site-init." | |
4 | 28 (let ((errbuf (if mail-interactive |
29 (generate-new-buffer " post-mail errors") | |
30 0)) | |
31 (temfile "/tmp/,rpost") | |
32 (tembuf (generate-new-buffer " post-mail temp")) | |
33 (case-fold-search nil) | |
34 delimline | |
35 (mailbuf (current-buffer))) | |
36 (unwind-protect | |
37 (save-excursion | |
38 (set-buffer tembuf) | |
39 (erase-buffer) | |
40 (insert-buffer-substring mailbuf) | |
41 (goto-char (point-max)) | |
42 ;; require one newline at the end. | |
43 (or (= (preceding-char) ?\n) | |
44 (insert ?\n)) | |
45 ;; Change header-delimiter to be what post-mail expects. | |
46 (goto-char (point-min)) | |
47 (search-forward (concat "\n" mail-header-separator "\n")) | |
48 (replace-match "\n\n") | |
49 (backward-char 1) | |
50 (setq delimline (point-marker)) | |
51 (if mail-aliases | |
52 (expand-mail-aliases (point-min) delimline)) | |
53 (goto-char (point-min)) | |
54 ;; ignore any blank lines in the header | |
55 (while (and (re-search-forward "\n\n\n*" delimline t) | |
56 (< (point) delimline)) | |
57 (replace-match "\n")) | |
58 ;; Find and handle any FCC fields. | |
59 (let ((case-fold-search t)) | |
60 (goto-char (point-min)) | |
61 (if (re-search-forward "^FCC:" delimline t) | |
62 (mail-do-fcc delimline)) | |
63 ;; If there is a From and no Sender, put it a Sender. | |
64 (goto-char (point-min)) | |
65 (and (re-search-forward "^From:" delimline t) | |
66 (not (save-excursion | |
67 (goto-char (point-min)) | |
68 (re-search-forward "^Sender:" delimline t))) | |
69 (progn | |
70 (forward-line 1) | |
71 (insert "Sender: " (user-login-name) "\n"))) | |
72 ;; don't send out a blank subject line | |
73 (goto-char (point-min)) | |
74 (if (re-search-forward "^Subject:[ \t]*\n" delimline t) | |
75 (replace-match "")) | |
76 (if mail-interactive | |
77 (save-excursion | |
78 (set-buffer errbuf) | |
79 (erase-buffer)))) | |
80 (write-file (setq temfile (make-temp-name temfile))) | |
81 (set-file-modes temfile 384) | |
82 (apply 'call-process | |
83 (append (list (if (boundp 'post-mail-program) | |
84 post-mail-program | |
85 "/usr/uci/lib/mh/post") | |
86 nil errbuf nil | |
87 "-nofilter" "-msgid") | |
88 (if mail-interactive '("-watch") '("-nowatch")) | |
89 (list temfile))) | |
90 (if mail-interactive | |
91 (save-excursion | |
92 (set-buffer errbuf) | |
93 (goto-char (point-min)) | |
94 (while (re-search-forward "\n\n* *" nil t) | |
95 (replace-match "; ")) | |
96 (if (not (zerop (buffer-size))) | |
97 (error "Sending...failed to %s" | |
98 (buffer-substring (point-min) (point-max))))))) | |
99 (kill-buffer tembuf) | |
100 (if (bufferp errbuf) | |
101 (switch-to-buffer errbuf))))) | |
659
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
222
diff
changeset
|
102 |
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
222
diff
changeset
|
103 ;;; mailpost.el ends here |