Mercurial > emacs
annotate lisp/mail/mailpost.el @ 78445:d92fa7306fd1
** davby@ida.liu.se, 6 July: Bug in pos-visible-in-window-p
Fixed.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Tue, 07 Aug 2007 15:56:21 +0000 |
parents | 695cf19ef79e |
children | 375f2633d815 1e3a407766b9 |
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 |
38412
253f761ad37b
Some fixes to follow coding conventions in files maintained by FSF.
Pavel Janík <Pavel@Janik.cz>
parents:
29886
diff
changeset
|
6 ;; This file is part of GNU Emacs. |
253f761ad37b
Some fixes to follow coding conventions in files maintained by FSF.
Pavel Janík <Pavel@Janik.cz>
parents:
29886
diff
changeset
|
7 |
791
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
8 ;; Author: Gary Delp <delp@huey.Udel.Edu> |
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
9 ;; Maintainer: FSF |
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
10 ;; Created: 13 Jan 1986 |
811
e694e0879463
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
791
diff
changeset
|
11 ;; Keywords: mail |
791
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
12 |
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
13 ;;; Commentary: |
659
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
222
diff
changeset
|
14 |
4 | 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. | |
791
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
18 |
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
19 ;;; Code: |
4 | 20 |
923 | 21 (require 'mailalias) |
22 (require 'sendmail) | |
23 | |
4 | 24 ;; (setq send-mail-function 'post-mail-send-it) |
25 | |
26 (defun post-mail-send-it () | |
222 | 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." | |
4 | 30 (let ((errbuf (if mail-interactive |
31 (generate-new-buffer " post-mail errors") | |
32 0)) | |
29886
3baeb77c0e39
(post-mail-send-it): Make sure file has
Gerd Moellmann <gerd@gnu.org>
parents:
26039
diff
changeset
|
33 temfile |
4 | 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. | |
21921
ea04bf51647c
(post-mail-send-it): Use mail-sendmail-undelimit-header.
Richard M. Stallman <rms@gnu.org>
parents:
18383
diff
changeset
|
48 (mail-sendmail-undelimit-header) |
4 | 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)))) | |
29886
3baeb77c0e39
(post-mail-send-it): Make sure file has
Gerd Moellmann <gerd@gnu.org>
parents:
26039
diff
changeset
|
79 (let ((m (default-file-modes))) |
3baeb77c0e39
(post-mail-send-it): Make sure file has
Gerd Moellmann <gerd@gnu.org>
parents:
26039
diff
changeset
|
80 (unwind-protect |
3baeb77c0e39
(post-mail-send-it): Make sure file has
Gerd Moellmann <gerd@gnu.org>
parents:
26039
diff
changeset
|
81 (progn |
3baeb77c0e39
(post-mail-send-it): Make sure file has
Gerd Moellmann <gerd@gnu.org>
parents:
26039
diff
changeset
|
82 (set-default-file-modes 384) |
3baeb77c0e39
(post-mail-send-it): Make sure file has
Gerd Moellmann <gerd@gnu.org>
parents:
26039
diff
changeset
|
83 (setq temfile (make-temp-file ",rpost"))) |
3baeb77c0e39
(post-mail-send-it): Make sure file has
Gerd Moellmann <gerd@gnu.org>
parents:
26039
diff
changeset
|
84 (set-default-file-modes m))) |
4 | 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))))) | |
659
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
222
diff
changeset
|
105 |
18383 | 106 (provide 'mailpost) |
107 | |
52401 | 108 ;;; arch-tag: 1f8ca085-60a6-4eac-8efb-69ffec2fa124 |
659
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
222
diff
changeset
|
109 ;;; mailpost.el ends here |