Mercurial > hg > xemacs-beta

comparison lisp/utils/mailpost.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children ac2d302a0011
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
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 ;;; Synched up with: FSF 19.30.
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) ;; not in XEmacs
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.
28 To use it, include \"(setq send-mail-function 'post-mail-send-it)\" in
29 site-init."
30 (let ((errbuf (if mail-interactive
31 (generate-new-buffer " post-mail errors")
32 0))
33 (temfile "/tmp/,rpost")
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 (goto-char (point-min))
49 (search-forward (concat "\n" mail-header-separator "\n"))
50 (replace-match "\n\n")
51 (backward-char 1)
52 (setq delimline (point-marker))
53 ;; XEmacs: expand-mail-aliases doesn't exist.
54 (if (and mail-aliases (fboundp 'expand-mail-aliases))
55 (expand-mail-aliases (point-min) delimline))
56 (goto-char (point-min))
57 ;; ignore any blank lines in the header
58 (while (and (re-search-forward "\n\n\n*" delimline t)
59 (< (point) delimline))
60 (replace-match "\n"))
61 ;; Find and handle any FCC fields.
62 (let ((case-fold-search t))
63 (goto-char (point-min))
64 (if (re-search-forward "^FCC:" delimline t)
65 (mail-do-fcc delimline))
66 ;; If there is a From and no Sender, put it a Sender.
67 (goto-char (point-min))
68 (and (re-search-forward "^From:" delimline t)
69 (not (save-excursion
70 (goto-char (point-min))
71 (re-search-forward "^Sender:" delimline t)))
72 (progn
73 (forward-line 1)
74 (insert "Sender: " (user-login-name) "\n")))
75 ;; don't send out a blank subject line
76 (goto-char (point-min))
77 (if (re-search-forward "^Subject:[ \t]*\n" delimline t)
78 (replace-match ""))
79 (if mail-interactive
80 (save-excursion
81 (set-buffer errbuf)
82 (erase-buffer))))
83 (write-file (setq temfile (make-temp-name temfile)))
84 (set-file-modes temfile 384)
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 ;;; mailpost.el ends here