|
0
|
1 ;;; feedmail.el --- outbound mail handling
|
|
|
2
|
|
|
3 ;; Keywords: mail
|
|
|
4
|
|
|
5 ;;; Synched up with: Not in FSF.
|
|
|
6
|
|
|
7 ;;; From: William.J.Carpenter@hos1cad.att.com (Bill C)
|
|
|
8 ;;; Subject: feedmail.el, patchlevel 2 [repost]
|
|
|
9 ;;; Date: 8 Jun 91 22:23:00 GMT
|
|
|
10 ;;; Organization: AT&T Bell Laboratories
|
|
|
11 ;;;
|
|
|
12 ;;; 5-may-92 jwz Conditionalized calling expand-mail-aliases, since that
|
|
|
13 ;;; function doesn't exist in Lucid GNU Emacs or when using
|
|
|
14 ;;; mail-abbrevs.el.
|
|
|
15 ;;;
|
|
|
16 ;;; Here's the latest version of feedmail.el, a replacement for parts of
|
|
|
17 ;;; GNUemacs' sendmail.el (specifically, it's what handles your outgoing
|
|
|
18 ;;; mail after you type C-c C-c in mail mode). (Sorry if you're seeing
|
|
|
19 ;;; this a second time. Looks like my earlier attempt to post it didn't
|
|
|
20 ;;; get off the local machine.)
|
|
|
21 ;;;
|
|
|
22 ;;; This version contains the following new things:
|
|
|
23 ;;;
|
|
|
24 ;;; * fix for handling default-case-fold-search
|
|
|
25 ;;; * involve user-full-name in default from line
|
|
|
26 ;;; * fix for my improper use of mail-strip-quoted-names when
|
|
|
27 ;;; addresses contain a mix of "<>" and "()" styles
|
|
|
28 ;;; * new feature allowing optional generation of Message-ID
|
|
|
29
|
|
|
30 ;;; feedmail.el
|
|
|
31 ;;; LCD record:
|
|
|
32 ;;; feedmail|Bill Carpenter|william.j.carpenter@att.com|Outbound mail handling|91-05-24|2|feedmail.el
|
|
|
33 ;;;
|
|
|
34 ;;; Written by Bill Carpenter <william.j.carpenter@att.com>
|
|
|
35 ;;; original, 31 March 1991
|
|
|
36 ;;; patchlevel 1, 5 April 1991
|
|
|
37 ;;; patchlevel 2, 24 May 1991
|
|
|
38 ;;;
|
|
|
39 ;;; As far as I'm concerned, anyone can do anything they want with
|
|
|
40 ;;; this specific piece of code. No warranty or promise of support is
|
|
|
41 ;;; offered.
|
|
|
42 ;;;
|
|
|
43 ;;; This stuff does in elisp the stuff that used to be done
|
|
|
44 ;;; by the separate program "fakemail" for processing outbound email.
|
|
|
45 ;;; In other words, it takes over after you hit "C-c C-c" in mail mode.
|
|
|
46 ;;; By appropriate setting of options, you can still use "fakemail",
|
|
|
47 ;;; or you can even revert to sendmail (which is not too popular
|
|
|
48 ;;; locally). See the variables at the top of the elisp for how to
|
|
|
49 ;;; achieve these effects:
|
|
|
50 ;;;
|
|
|
51 ;;; --- you can get one last look at the prepped outbound message and
|
|
|
52 ;;; be prompted for confirmation
|
|
|
53 ;;;
|
|
|
54 ;;; --- removes BCC: headers after getting address info
|
|
|
55 ;;;
|
|
|
56 ;;; --- does smart filling of TO: and CC: headers
|
|
|
57 ;;;
|
|
|
58 ;;; --- processes FCC: lines and removes them
|
|
|
59 ;;;
|
|
|
60 ;;; --- empty headers are removed
|
|
|
61 ;;;
|
|
|
62 ;;; --- can force FROM: or SENDER: line
|
|
|
63 ;;;
|
|
|
64 ;;; --- can generate a Message-ID line
|
|
|
65 ;;;
|
|
|
66 ;;; --- strips comments from address info (both "()" and "<>" are
|
|
|
67 ;;; handled via a call to mail-strip-quoted-names); the
|
|
|
68 ;;; comments are stripped in the simplified address list given
|
|
|
69 ;;; to a subprocess, not in the headers in the mail itself
|
|
|
70 ;;; (they are left unchanged, modulo smart filling)
|
|
|
71 ;;;
|
|
|
72 ;;; --- error info is pumped into a normal buffer instead of the
|
|
|
73 ;;; minibuffer
|
|
|
74 ;;;
|
|
|
75 ;;; --- just before the optional prompt for confirmation, lets you
|
|
|
76 ;;; run a hook on the prepped message and simplified address
|
|
|
77 ;;; list
|
|
|
78 ;;;
|
|
|
79 ;;; --- you can specify something other than /bin/mail for the
|
|
|
80 ;;; subprocess
|
|
|
81 ;;;
|
|
|
82 ;;; After a few options below, you will find the function
|
|
|
83 ;;; feedmail-send-it. Everything after that function is just local
|
|
|
84 ;;; stuff for this file. There are two ways you can use the stuff in
|
|
|
85 ;;; this file:
|
|
|
86 ;;;
|
|
|
87 ;;; (1) Put the contents of this file into sendmail.el and change the
|
|
|
88 ;;; name of feedmail-send-it to sendmail-send-it, replacing that
|
|
|
89 ;;; function in sendmail.el.
|
|
|
90 ;;;
|
|
|
91 ;;; or
|
|
|
92 ;;;
|
|
|
93 ;;; (2) Save this file as feedmail.el somewhere on your elisp
|
|
|
94 ;;; loadpath; byte-compile it. Put the following lines somewhere in
|
|
|
95 ;;; your ~/.emacs stuff:
|
|
|
96 ;;;
|
|
|
97 ;;; (setq send-mail-function 'feedmail-send-it)
|
|
|
98 ;;; (autoload 'feedmail-send-it "feedmail")
|
|
|
99 ;;;
|
|
|
100
|
|
134
|
101 (defgroup feedmail nil
|
|
|
102 "Outbound mail handling."
|
|
|
103 :group 'mail)
|
|
0
|
104
|
|
|
105
|
|
134
|
106 (defcustom feedmail-confirm-outgoing nil
|
|
|
107 "*If non-nil, gives a y-or-n confirmation prompt after prepping,
|
|
|
108 before sending mail."
|
|
|
109 :type 'boolean
|
|
|
110 :group 'feedmail)
|
|
|
111
|
|
|
112
|
|
|
113 (defcustom feedmail-nuke-bcc t
|
|
0
|
114 "*Non-nil means get rid of the BCC: lines from the message header
|
|
|
115 text before sending the mail. In any case, the BCC: lines do
|
|
|
116 participate in the composed address list. You probably want to keep
|
|
134
|
117 them if you're using sendmail (see feedmail-buffer-eating-function)."
|
|
|
118 :type 'boolean
|
|
|
119 :group 'feedmail)
|
|
0
|
120
|
|
|
121
|
|
134
|
122 (defcustom feedmail-fill-to-cc t
|
|
0
|
123 "*Non-nil means do smart filling (line-wrapping) of TO: and CC: header
|
|
|
124 lines. If nil, the lines are left as-is. The filling is done after
|
|
134
|
125 mail address alias expansion."
|
|
|
126 :type 'boolean
|
|
|
127 :group 'feedmail)
|
|
0
|
128
|
|
|
129
|
|
134
|
130 (defcustom feedmail-fill-to-cc-fill-column default-fill-column
|
|
|
131 "*Fill column used when wrapping mail TO: and CC: lines."
|
|
|
132 :type 'integer
|
|
|
133 :group 'feedmail)
|
|
0
|
134
|
|
|
135
|
|
134
|
136 (defcustom feedmail-nuke-empty-headers t
|
|
0
|
137 "*If non-nil, headers with no contents are removed from the outgoing
|
|
|
138 email. A completely empty SUBJECT: header is always removed,
|
|
|
139 regardless of the setting of this variable. The only time you would
|
|
|
140 want them left in would be if you used some headers whose presence
|
|
134
|
141 indicated something rather than their contents."
|
|
|
142 :type 'boolean
|
|
|
143 :group 'feedmail)
|
|
0
|
144
|
|
|
145 ;;; wjc sez: I think the use of the SENDER: line is pretty pointless,
|
|
|
146 ;;; but I left it in to be compatible with sendmail.el and because
|
|
|
147 ;;; maybe some distant mail system needs it. Really, though, if you
|
|
|
148 ;;; want a sender line in your mail, just put one in there and don't
|
|
|
149 ;;; wait for feedmail to do it for you.
|
|
|
150
|
|
134
|
151 (defcustom feedmail-sender-line nil
|
|
0
|
152 "*If nil, no SENDER: header is forced. If non-nil and the email
|
|
|
153 already has a FROM: header, a SENDER: header is forced with this as
|
|
|
154 its contents. You can probably leave this nil, but if you feel like
|
|
|
155 using it, a good value would be a fully-qualified domain name form of
|
|
|
156 your address. For example, william.j.carpenter@att.com. Don't
|
|
|
157 include a trailing newline or the keyword SENDER:. They're
|
|
134
|
158 automatically provided."
|
|
|
159 :type 'boolean
|
|
|
160 :group 'feedmail)
|
|
0
|
161
|
|
|
162
|
|
|
163 ;; user-full-name suggested by kpc@ptolemy.arc.nasa.gov (=Kimball Collins)
|
|
134
|
164 (defcustom feedmail-from-line
|
|
0
|
165 (concat (user-login-name) "@" (system-name) " (" (user-full-name) ")")
|
|
|
166 "*If non-nil and the email has no FROM: header, one will be forced
|
|
|
167 with this as its contents. A good value would be a fully-qualified
|
|
|
168 domain name form of your address. For example, william.j.carpenter@att.com.
|
|
|
169 (The default value of this variable is probably not very good, since
|
|
|
170 it doesn't have a domain part.) Don't include a trailing newline or
|
|
134
|
171 the keyword FROM:. They're automatically provided."
|
|
|
172 :type '(choice (const nil) string)
|
|
|
173 :group 'feedmail)
|
|
0
|
174
|
|
|
175
|
|
|
176 ;;; Here's how I use the GNUS Message-ID generator for mail but not
|
|
|
177 ;;; for news postings:
|
|
|
178 ;;;
|
|
|
179 ;;; (setq feedmail-message-id-generator 'wjc:gnusish-message-id)
|
|
|
180 ;;; (setq gnus-your-domain "hos1cad.ATT.COM")
|
|
|
181 ;;;
|
|
|
182 ;;; (defun wjc:gnusish-message-id ()
|
|
|
183 ;;; (require 'gnuspost)
|
|
|
184 ;;; (if (fboundp 'wjc:gnus-inews-message-id)
|
|
|
185 ;;; (wjc:gnus-inews-message-id)
|
|
|
186 ;;; (gnus-inews-message-id)))
|
|
|
187 ;;;
|
|
|
188 ;;; (setq news-inews-hook
|
|
|
189 ;;; '(lambda ()
|
|
|
190 ;;; (defun gnus-inews-date () nil)
|
|
|
191 ;;; (fset 'wjc:gnus-inews-message-id (symbol-function 'gnus-inews-message-id))
|
|
|
192 ;;; (defun gnus-inews-message-id () nil)
|
|
|
193 ;;; ))
|
|
|
194 ;;;
|
|
134
|
195 (defcustom feedmail-message-id-generator nil
|
|
0
|
196 "*If non-nil, should be a function (called with no arguments) which
|
|
|
197 will generate a unique message ID which will be inserted on a
|
|
|
198 Message-ID: header. The message ID should be the return value of the
|
|
|
199 function. Don't include trailing newline, leading space, or the
|
|
|
200 keyword MESSAGE-ID. They're automatically provided. Do include
|
|
|
201 surrounding <> brackets. For an example of a message ID generating
|
|
|
202 function, you could look at the GNUS function gnus-inews-message-id.
|
|
|
203 When called, the current buffer is the prepped outgoing mail buffer
|
|
|
204 (the function may inspect it, but shouldn't modify it). If the returned
|
|
|
205 value doesn't contain any non-whitespace characters, no message ID
|
|
|
206 header is generated, so you could generate them conditionally,
|
|
134
|
207 based on the contents of the mail."
|
|
|
208 :type 'boolean
|
|
|
209 :group 'feedmail)
|
|
0
|
210
|
|
|
211
|
|
|
212 (defun feedmail-confirm-addresses-hook-example ()
|
|
|
213 "An example of a last chance hook that shows the simple addresses
|
|
|
214 and gets a confirmation. Use as (setq feedmail-last-chance-hook
|
|
|
215 'feedmail-confirm-addresses-hook-example)."
|
|
|
216 (save-window-excursion
|
|
|
217 (display-buffer feedmail-address-buffer)
|
|
|
218 (if (not (y-or-n-p "How do you like them apples? "))
|
|
|
219 (error "Sending...gave up in last chance hook"))))
|
|
|
220
|
|
|
221
|
|
134
|
222 (defcustom feedmail-last-chance-hook nil
|
|
0
|
223 "*User's last opportunity to modify the message on its way out. It
|
|
|
224 has already had all the header prepping from the standard package.
|
|
|
225 The next step after running the hook will be to push the buffer into a
|
|
|
226 subprocess that mails the mail. The hook might be interested in these
|
|
|
227 buffers: (1) feedmail-prepped-text-buffer contains the header and body
|
|
|
228 of the message, ready to go; (2) feedmail-address-buffer contains the
|
|
|
229 space-separated, simplified list of addresses which is to be given to
|
|
|
230 the subprocess (the hook may change them). feedmail-error-buffer is
|
|
|
231 an empty buffer intended to soak up errors for display to the user.
|
|
|
232 If the hook allows interactive activity, the user should not send more
|
|
134
|
233 mail while in the hook since some of the internal buffers will be reused."
|
|
|
234 :type 'hook
|
|
|
235 :group 'feedmail)
|
|
0
|
236
|
|
|
237 ;; XEmacs change: make the default more sensible.
|
|
134
|
238 (defcustom feedmail-buffer-eating-function
|
|
0
|
239 (if (and (boundp 'sendmail-program)
|
|
|
240 (string-match "sendmail" sendmail-program))
|
|
|
241 'feedmail-buffer-to-sendmail
|
|
|
242 'feedmail-buffer-to-binmail)
|
|
|
243 "*Function used to send the prepped buffer to a subprocess. The
|
|
|
244 function's three (mandatory) arguments are: (1) the buffer containing
|
|
|
245 the prepped message; (2) a buffer where errors should be directed; and
|
|
|
246 (3) a string containing the space-separated list of simplified
|
|
|
247 addresses. Two popular choices for this are 'feedmail-buffer-to-binmail
|
|
|
248 and 'feedmail-buffer-to-sendmail. If you use the sendmail form, you
|
|
|
249 probably want to set feedmail-nuke-bcc to nil. If you use the binmail
|
|
134
|
250 form, check the value of feedmail-binmail-template."
|
|
|
251 :type 'function
|
|
|
252 :group 'feedmail)
|
|
0
|
253
|
|
|
254
|
|
134
|
255 (defcustom feedmail-binmail-template (if mail-interactive "/bin/mail %s" "/bin/rmail %s")
|
|
0
|
256 "*Command template for the subprocess which will get rid of the
|
|
|
257 mail. It can result in any command understandable by /bin/sh. The
|
|
|
258 single '%s', if present, gets replaced by the space-separated,
|
|
|
259 simplified list of addressees. Used in feedmail-buffer-to-binmail to
|
|
|
260 form the shell command which will receive the contents of the prepped
|
|
|
261 buffer as stdin. If you'd like your errors to come back as mail
|
|
|
262 instead of immediately in a buffer, try /bin/rmail instead of
|
|
|
263 /bin/mail (this can be accomplished by keeping the default nil setting
|
|
|
264 of mail-interactive). You might also like to consult local mail
|
|
134
|
265 experts for any other interesting command line possibilities."
|
|
|
266 :type 'string
|
|
|
267 :group 'feedmail)
|
|
0
|
268
|
|
|
269
|
|
|
270 ;; feedmail-buffer-to-binmail and feedmail-buffer-to-sendmail are the
|
|
|
271 ;; only things provided for values for the variable
|
|
|
272 ;; feedmail-buffer-eating-function. It's pretty easy to write your
|
|
|
273 ;; own, though.
|
|
|
274
|
|
|
275 (defun feedmail-buffer-to-binmail (prepped-mail-buffer mail-error-buffer simple-address-list)
|
|
|
276 "Function which actually calls /bin/mail as a subprocess and feeds the buffer to it."
|
|
|
277 (save-excursion
|
|
|
278 (set-buffer prepped-mail-buffer)
|
|
|
279 (apply 'call-process-region
|
|
|
280 (append (list (point-min) (point-max)
|
|
|
281 "/bin/sh" nil mail-error-buffer nil "-c"
|
|
|
282 (format feedmail-binmail-template simple-address-list ))))
|
|
|
283 ) ;; save-excursion
|
|
|
284 )
|
|
|
285
|
|
|
286
|
|
|
287 (defun feedmail-buffer-to-sendmail (prepped-mail-buffer feedmail-error-buffer simple-address-list)
|
|
|
288 "Function which actually calls sendmail as a subprocess and feeds the buffer to it."
|
|
|
289 (save-excursion
|
|
|
290 (set-buffer prepped-mail-buffer)
|
|
|
291 (apply 'call-process-region
|
|
|
292 (append (list (point-min) (point-max)
|
|
|
293 (if (boundp 'sendmail-program)
|
|
|
294 sendmail-program
|
|
|
295 "/usr/lib/sendmail")
|
|
|
296 nil feedmail-error-buffer nil
|
|
|
297 "-oi" "-t")
|
|
|
298 ;; Don't say "from root" if running under su.
|
|
|
299 (and (equal (user-real-login-name) "root")
|
|
|
300 (list "-f" (user-login-name)))
|
|
|
301 ;; These mean "report errors by mail"
|
|
|
302 ;; and "deliver in background".
|
|
|
303 (if (null mail-interactive) '("-oem" "-odb"))))
|
|
|
304 ))
|
|
|
305
|
|
|
306
|
|
|
307 ;; feedmail-send-it is the only "public" function is this file.
|
|
|
308 ;; All of the others are just little helpers.
|
|
|
309 ;;;###autoload
|
|
|
310 (defun feedmail-send-it ()
|
|
|
311 (let* ((default-case-fold-search t)
|
|
|
312 (feedmail-error-buffer (get-buffer-create " *Outgoing Email Errors*"))
|
|
|
313 (feedmail-prepped-text-buffer (get-buffer-create " *Outgoing Email Text*"))
|
|
|
314 (feedmail-address-buffer (get-buffer-create " *Outgoing Email Address List*"))
|
|
|
315 (feedmail-raw-text-buffer (current-buffer))
|
|
|
316 (case-fold-search nil)
|
|
|
317 end-of-headers-marker)
|
|
|
318
|
|
|
319 (unwind-protect (save-excursion
|
|
|
320 (set-buffer feedmail-prepped-text-buffer) (erase-buffer)
|
|
|
321
|
|
|
322 ;; jam contents of user-supplied mail buffer into our scratch buffer
|
|
|
323 (insert-buffer-substring feedmail-raw-text-buffer)
|
|
|
324
|
|
|
325 ;; require one newline at the end.
|
|
|
326 (goto-char (point-max))
|
|
|
327 (or (= (preceding-char) ?\n) (insert ?\n))
|
|
|
328
|
|
|
329 ;; Change header-delimiter to be what mailers expect (empty line).
|
|
|
330 (goto-char (point-min))
|
|
|
331 (re-search-forward (concat "^" (regexp-quote mail-header-separator) "\n"))
|
|
|
332 (replace-match "\n")
|
|
|
333 ;; why was this backward-char here?
|
|
|
334 ;;(backward-char 1)
|
|
|
335 (setq end-of-headers-marker (point-marker))
|
|
|
336
|
|
|
337 (if (and (fboundp 'expand-mail-aliases) ; nil = mail-abbrevs.el
|
|
|
338 mail-aliases)
|
|
|
339 (expand-mail-aliases (point-min) end-of-headers-marker))
|
|
|
340
|
|
|
341 ;; make it pretty
|
|
|
342 (if feedmail-fill-to-cc (feedmail-fill-to-cc-function end-of-headers-marker))
|
|
|
343 ;; ignore any blank lines in the header
|
|
|
344 (goto-char (point-min))
|
|
|
345 (while (and (re-search-forward "\n\n\n*" end-of-headers-marker t) (< (point) end-of-headers-marker))
|
|
|
346 (replace-match "\n"))
|
|
|
347
|
|
|
348 (let ((case-fold-search t))
|
|
|
349 (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) end-of-headers-marker)
|
|
|
350 (save-excursion (set-buffer feedmail-address-buffer)
|
|
|
351 (goto-char (point-min))
|
|
|
352 (if (not (re-search-forward "\\S-" (point-max) t))
|
|
|
353 (error "Sending...abandoned, no addressees!")))
|
|
|
354
|
|
|
355 ;; Find and handle any BCC fields.
|
|
|
356 (if feedmail-nuke-bcc (feedmail-do-bcc end-of-headers-marker))
|
|
|
357
|
|
|
358 ;; Find and handle any FCC fields.
|
|
|
359 (goto-char (point-min))
|
|
|
360 (if (re-search-forward "^FCC:" end-of-headers-marker t)
|
|
|
361 (mail-do-fcc end-of-headers-marker))
|
|
|
362
|
|
|
363 (goto-char (point-min))
|
|
|
364 (if (re-search-forward "^FROM:" end-of-headers-marker t)
|
|
|
365
|
|
|
366 ;; If there is a FROM: and no SENDER:, put in a SENDER:
|
|
|
367 ;; if requested by user
|
|
|
368 (if (and feedmail-sender-line
|
|
|
369 (not (save-excursion (goto-char (point-min))
|
|
|
370 (re-search-forward "^SENDER:" end-of-headers-marker t))))
|
|
|
371 (progn (forward-line 1) (insert "Sender: " feedmail-sender-line "\n")))
|
|
|
372
|
|
|
373 ;; no FROM: ... force one?
|
|
|
374 (if feedmail-from-line
|
|
|
375 (progn (goto-char (point-min)) (insert "From: " feedmail-from-line "\n")))
|
|
|
376 )
|
|
|
377
|
|
|
378 ;; don't send out a blank subject line
|
|
|
379 (goto-char (point-min))
|
|
|
380 (if (re-search-forward "^Subject:[ \t]*\n" end-of-headers-marker t)
|
|
|
381 (replace-match ""))
|
|
|
382
|
|
|
383 ;; don't send out a blank headers of various sorts
|
|
|
384 (goto-char (point-min))
|
|
|
385 (and feedmail-nuke-empty-headers ;; hey, who's an empty-header?
|
|
|
386 (while (re-search-forward "^[A-Za-z0-9-]+:[ \t]*\n" end-of-headers-marker t)
|
|
|
387 (replace-match ""))))
|
|
|
388
|
|
|
389 ;; message ID generation
|
|
|
390 (if feedmail-message-id-generator
|
|
|
391 (progn
|
|
|
392 (goto-char (point-min))
|
|
|
393 (if (re-search-forward "^MESSAGE-ID:[ \t]*\n" end-of-headers-marker t)
|
|
|
394 (replace-match ""))
|
|
|
395 (setq feedmail-msgid-part (funcall feedmail-message-id-generator))
|
|
|
396 (goto-char (point-min))
|
|
|
397 (and feedmail-msgid-part (string-match "[^ \t]" feedmail-msgid-part)
|
|
|
398 (insert "Message-ID: " feedmail-msgid-part "\n"))))
|
|
|
399
|
|
|
400
|
|
|
401 (save-excursion (set-buffer feedmail-error-buffer) (erase-buffer))
|
|
|
402
|
|
|
403 (run-hooks 'feedmail-last-chance-hook)
|
|
|
404
|
|
|
405 (if (or (not feedmail-confirm-outgoing) (feedmail-one-last-look feedmail-prepped-text-buffer))
|
|
|
406 (funcall feedmail-buffer-eating-function feedmail-prepped-text-buffer feedmail-error-buffer
|
|
|
407 (save-excursion (set-buffer feedmail-address-buffer) (buffer-string)))
|
|
|
408 (error "Sending...abandoned")
|
|
|
409 )
|
|
|
410 ) ;; unwind-protect body (save-excursion)
|
|
|
411
|
|
|
412 ;; unwind-protect cleanup forms
|
|
|
413 (kill-buffer feedmail-prepped-text-buffer)
|
|
|
414 (kill-buffer feedmail-address-buffer)
|
|
|
415 (set-buffer feedmail-error-buffer)
|
|
|
416 (if (zerop (buffer-size))
|
|
|
417 (kill-buffer feedmail-error-buffer)
|
|
|
418 (progn (display-buffer feedmail-error-buffer)
|
|
|
419 (error "Sending...failed")))
|
|
|
420 (set-buffer feedmail-raw-text-buffer))
|
|
|
421 ) ;; let
|
|
|
422 )
|
|
|
423
|
|
|
424
|
|
|
425 (defun feedmail-do-bcc (header-end)
|
|
|
426 "Delete BCC: and their continuation lines from the header area.
|
|
|
427 There may be multiple BCC: lines, and each may have arbitrarily
|
|
|
428 many continuation lines."
|
|
|
429 (let ((case-fold-search t))
|
|
|
430 (save-excursion (goto-char (point-min))
|
|
|
431 ;; iterate over all BCC: lines
|
|
|
432 (while (re-search-forward "^BCC:" header-end t)
|
|
|
433 (delete-region (match-beginning 0) (progn (forward-line 1) (point)))
|
|
|
434 ;; get rid of any continuation lines
|
|
|
435 (while (and (looking-at "^[ \t].*\n") (< (point) header-end))
|
|
|
436 (replace-match ""))
|
|
|
437 )
|
|
|
438 ) ;; save-excursion
|
|
|
439 ) ;; let
|
|
|
440 )
|
|
|
441
|
|
|
442 (defun feedmail-fill-to-cc-function (header-end)
|
|
|
443 "Smart filling of TO: and CC: headers. The filling tries to avoid
|
|
|
444 splitting lines except at commas. This avoids, in particular,
|
|
|
445 splitting within parenthesized comments in addresses."
|
|
|
446 (let ((case-fold-search t)
|
|
|
447 (fill-prefix "\t")
|
|
|
448 (fill-column feedmail-fill-to-cc-fill-column)
|
|
|
449 this-line
|
|
|
450 this-line-end)
|
|
|
451 (save-excursion (goto-char (point-min))
|
|
|
452 ;; iterate over all TO:/CC: lines
|
|
|
453 (while (re-search-forward "^\\(TO:\\|CC:\\)" header-end t)
|
|
|
454 (setq this-line (match-beginning 0))
|
|
|
455 (forward-line 1)
|
|
|
456 ;; get any continuation lines
|
|
|
457 (while (and (looking-at "^[ \t]+") (< (point) header-end))
|
|
|
458 (replace-match " ")
|
|
|
459 (forward-line 1))
|
|
|
460 (setq this-line-end (point-marker))
|
|
|
461
|
|
|
462 ;; The general idea is to break only on commas. Change
|
|
|
463 ;; all the blanks to something unprintable; change the
|
|
|
464 ;; commas to blanks; fill the region; change it back.
|
|
|
465 (subst-char-in-region this-line this-line-end ? 2 t) ;; blank --> C-b
|
|
|
466 (subst-char-in-region this-line this-line-end ?, ? t) ;; comma --> blank
|
|
|
467 (fill-region-as-paragraph this-line this-line-end)
|
|
|
468
|
|
|
469 (subst-char-in-region this-line this-line-end ? ?, t) ;; comma <-- blank
|
|
|
470 (subst-char-in-region this-line this-line-end 2 ? t) ;; blank <-- C-b
|
|
|
471
|
|
|
472 ;; look out for missing commas before continuation lines
|
|
|
473 (save-excursion
|
|
|
474 (goto-char this-line)
|
|
|
475 (while (re-search-forward "\\([^,]\\)\n\t[ ]*" this-line-end t)
|
|
|
476 (replace-match "\\1,\n\t")))
|
|
|
477 )
|
|
|
478 ) ;; while
|
|
|
479 ) ;; save-excursion
|
|
|
480 )
|
|
|
481
|
|
|
482
|
|
|
483 (defun feedmail-deduce-address-list (feedmail-text-buffer header-start header-end)
|
|
|
484 "Get address list suitable for command line use on simple /bin/mail."
|
|
|
485 (require 'mail-utils) ;; pick up mail-strip-quoted-names
|
|
|
486 (let
|
|
|
487 ((case-fold-search t)
|
|
|
488 (simple-address-list "")
|
|
|
489 this-line
|
|
|
490 this-line-end)
|
|
|
491 (unwind-protect
|
|
|
492 (save-excursion
|
|
|
493 (set-buffer feedmail-address-buffer) (erase-buffer)
|
|
|
494 (insert-buffer-substring feedmail-text-buffer header-start header-end)
|
|
|
495 (goto-char (point-min))
|
|
|
496 (while (re-search-forward "^\\(TO:\\|CC:\\|BCC:\\)" header-end t)
|
|
|
497 (replace-match "")
|
|
|
498 (setq this-line (match-beginning 0))
|
|
|
499 (forward-line 1)
|
|
|
500 ;; get any continuation lines
|
|
|
501 (while (and (looking-at "^[ \t]+") (< (point) header-end))
|
|
|
502 (forward-line 1))
|
|
|
503 (setq this-line-end (point-marker))
|
|
|
504 (setq simple-address-list
|
|
|
505 (concat simple-address-list " "
|
|
|
506 (mail-strip-quoted-names (buffer-substring this-line this-line-end))))
|
|
|
507 )
|
|
|
508 (erase-buffer)
|
|
|
509 (insert-string simple-address-list)
|
|
|
510 (subst-char-in-region (point-min) (point-max) 10 ? t) ;; newline --> blank
|
|
|
511 (subst-char-in-region (point-min) (point-max) ?, ? t) ;; comma --> blank
|
|
|
512 (subst-char-in-region (point-min) (point-max) 9 ? t) ;; tab --> blank
|
|
|
513
|
|
|
514 (goto-char (point-min))
|
|
|
515 ;; tidyness in case hook is not robust when it looks at this
|
|
|
516 (while (re-search-forward "[ \t]+" header-end t) (replace-match " "))
|
|
|
517
|
|
|
518 )
|
|
|
519 )
|
|
|
520 )
|
|
|
521 )
|
|
|
522
|
|
|
523
|
|
|
524 (defun feedmail-one-last-look (feedmail-prepped-text-buffer)
|
|
|
525 "Offer the user one last chance to give it up."
|
|
|
526 (save-excursion (save-window-excursion
|
|
|
527 (switch-to-buffer feedmail-prepped-text-buffer)
|
|
|
528 (y-or-n-p "Send this email? "))))
|
|
|
529
|
|
|
530
|
|
|
531 (provide 'feedmail)
|
