|
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
|
|
|
101
|
|
|
102 (defvar feedmail-confirm-outgoing nil
|
|
|
103 "*If non-nil, gives a y-or-n confirmation prompt after prepping,
|
|
|
104 before sending mail.")
|
|
|
105
|
|
|
106
|
|
|
107 (defvar feedmail-nuke-bcc t
|
|
|
108 "*Non-nil means get rid of the BCC: lines from the message header
|
|
|
109 text before sending the mail. In any case, the BCC: lines do
|
|
|
110 participate in the composed address list. You probably want to keep
|
|
|
111 them if you're using sendmail (see feedmail-buffer-eating-function).")
|
|
|
112
|
|
|
113
|
|
|
114 (defvar feedmail-fill-to-cc t
|
|
|
115 "*Non-nil means do smart filling (line-wrapping) of TO: and CC: header
|
|
|
116 lines. If nil, the lines are left as-is. The filling is done after
|
|
|
117 mail address alias expansion.")
|
|
|
118
|
|
|
119
|
|
|
120 (defvar feedmail-fill-to-cc-fill-column default-fill-column
|
|
|
121 "*Fill column used when wrapping mail TO: and CC: lines.")
|
|
|
122
|
|
|
123
|
|
|
124 (defvar feedmail-nuke-empty-headers t
|
|
|
125 "*If non-nil, headers with no contents are removed from the outgoing
|
|
|
126 email. A completely empty SUBJECT: header is always removed,
|
|
|
127 regardless of the setting of this variable. The only time you would
|
|
|
128 want them left in would be if you used some headers whose presence
|
|
|
129 indicated something rather than their contents.")
|
|
|
130
|
|
|
131 ;;; wjc sez: I think the use of the SENDER: line is pretty pointless,
|
|
|
132 ;;; but I left it in to be compatible with sendmail.el and because
|
|
|
133 ;;; maybe some distant mail system needs it. Really, though, if you
|
|
|
134 ;;; want a sender line in your mail, just put one in there and don't
|
|
|
135 ;;; wait for feedmail to do it for you.
|
|
|
136
|
|
|
137 (defvar feedmail-sender-line nil
|
|
|
138 "*If nil, no SENDER: header is forced. If non-nil and the email
|
|
|
139 already has a FROM: header, a SENDER: header is forced with this as
|
|
|
140 its contents. You can probably leave this nil, but if you feel like
|
|
|
141 using it, a good value would be a fully-qualified domain name form of
|
|
|
142 your address. For example, william.j.carpenter@att.com. Don't
|
|
|
143 include a trailing newline or the keyword SENDER:. They're
|
|
|
144 automatically provided.")
|
|
|
145
|
|
|
146
|
|
|
147 ;; user-full-name suggested by kpc@ptolemy.arc.nasa.gov (=Kimball Collins)
|
|
|
148 (defvar feedmail-from-line
|
|
|
149 (concat (user-login-name) "@" (system-name) " (" (user-full-name) ")")
|
|
|
150 "*If non-nil and the email has no FROM: header, one will be forced
|
|
|
151 with this as its contents. A good value would be a fully-qualified
|
|
|
152 domain name form of your address. For example, william.j.carpenter@att.com.
|
|
|
153 (The default value of this variable is probably not very good, since
|
|
|
154 it doesn't have a domain part.) Don't include a trailing newline or
|
|
|
155 the keyword FROM:. They're automatically provided.")
|
|
|
156
|
|
|
157
|
|
|
158 ;;; Here's how I use the GNUS Message-ID generator for mail but not
|
|
|
159 ;;; for news postings:
|
|
|
160 ;;;
|
|
|
161 ;;; (setq feedmail-message-id-generator 'wjc:gnusish-message-id)
|
|
|
162 ;;; (setq gnus-your-domain "hos1cad.ATT.COM")
|
|
|
163 ;;;
|
|
|
164 ;;; (defun wjc:gnusish-message-id ()
|
|
|
165 ;;; (require 'gnuspost)
|
|
|
166 ;;; (if (fboundp 'wjc:gnus-inews-message-id)
|
|
|
167 ;;; (wjc:gnus-inews-message-id)
|
|
|
168 ;;; (gnus-inews-message-id)))
|
|
|
169 ;;;
|
|
|
170 ;;; (setq news-inews-hook
|
|
|
171 ;;; '(lambda ()
|
|
|
172 ;;; (defun gnus-inews-date () nil)
|
|
|
173 ;;; (fset 'wjc:gnus-inews-message-id (symbol-function 'gnus-inews-message-id))
|
|
|
174 ;;; (defun gnus-inews-message-id () nil)
|
|
|
175 ;;; ))
|
|
|
176 ;;;
|
|
|
177 (defvar feedmail-message-id-generator nil
|
|
|
178 "*If non-nil, should be a function (called with no arguments) which
|
|
|
179 will generate a unique message ID which will be inserted on a
|
|
|
180 Message-ID: header. The message ID should be the return value of the
|
|
|
181 function. Don't include trailing newline, leading space, or the
|
|
|
182 keyword MESSAGE-ID. They're automatically provided. Do include
|
|
|
183 surrounding <> brackets. For an example of a message ID generating
|
|
|
184 function, you could look at the GNUS function gnus-inews-message-id.
|
|
|
185 When called, the current buffer is the prepped outgoing mail buffer
|
|
|
186 (the function may inspect it, but shouldn't modify it). If the returned
|
|
|
187 value doesn't contain any non-whitespace characters, no message ID
|
|
|
188 header is generated, so you could generate them conditionally,
|
|
|
189 based on the contents of the mail.")
|
|
|
190
|
|
|
191
|
|
|
192 (defun feedmail-confirm-addresses-hook-example ()
|
|
|
193 "An example of a last chance hook that shows the simple addresses
|
|
|
194 and gets a confirmation. Use as (setq feedmail-last-chance-hook
|
|
|
195 'feedmail-confirm-addresses-hook-example)."
|
|
|
196 (save-window-excursion
|
|
|
197 (display-buffer feedmail-address-buffer)
|
|
|
198 (if (not (y-or-n-p "How do you like them apples? "))
|
|
|
199 (error "Sending...gave up in last chance hook"))))
|
|
|
200
|
|
|
201
|
|
|
202 (defvar feedmail-last-chance-hook nil
|
|
|
203 "*User's last opportunity to modify the message on its way out. It
|
|
|
204 has already had all the header prepping from the standard package.
|
|
|
205 The next step after running the hook will be to push the buffer into a
|
|
|
206 subprocess that mails the mail. The hook might be interested in these
|
|
|
207 buffers: (1) feedmail-prepped-text-buffer contains the header and body
|
|
|
208 of the message, ready to go; (2) feedmail-address-buffer contains the
|
|
|
209 space-separated, simplified list of addresses which is to be given to
|
|
|
210 the subprocess (the hook may change them). feedmail-error-buffer is
|
|
|
211 an empty buffer intended to soak up errors for display to the user.
|
|
|
212 If the hook allows interactive activity, the user should not send more
|
|
|
213 mail while in the hook since some of the internal buffers will be reused.")
|
|
|
214
|
|
|
215 ;; XEmacs change: make the default more sensible.
|
|
|
216 (defvar feedmail-buffer-eating-function
|
|
|
217 (if (and (boundp 'sendmail-program)
|
|
|
218 (string-match "sendmail" sendmail-program))
|
|
|
219 'feedmail-buffer-to-sendmail
|
|
|
220 'feedmail-buffer-to-binmail)
|
|
|
221 "*Function used to send the prepped buffer to a subprocess. The
|
|
|
222 function's three (mandatory) arguments are: (1) the buffer containing
|
|
|
223 the prepped message; (2) a buffer where errors should be directed; and
|
|
|
224 (3) a string containing the space-separated list of simplified
|
|
|
225 addresses. Two popular choices for this are 'feedmail-buffer-to-binmail
|
|
|
226 and 'feedmail-buffer-to-sendmail. If you use the sendmail form, you
|
|
|
227 probably want to set feedmail-nuke-bcc to nil. If you use the binmail
|
|
|
228 form, check the value of feedmail-binmail-template.")
|
|
|
229
|
|
|
230
|
|
|
231 (defvar feedmail-binmail-template (if mail-interactive "/bin/mail %s" "/bin/rmail %s")
|
|
|
232 "*Command template for the subprocess which will get rid of the
|
|
|
233 mail. It can result in any command understandable by /bin/sh. The
|
|
|
234 single '%s', if present, gets replaced by the space-separated,
|
|
|
235 simplified list of addressees. Used in feedmail-buffer-to-binmail to
|
|
|
236 form the shell command which will receive the contents of the prepped
|
|
|
237 buffer as stdin. If you'd like your errors to come back as mail
|
|
|
238 instead of immediately in a buffer, try /bin/rmail instead of
|
|
|
239 /bin/mail (this can be accomplished by keeping the default nil setting
|
|
|
240 of mail-interactive). You might also like to consult local mail
|
|
|
241 experts for any other interesting command line possibilities.")
|
|
|
242
|
|
|
243
|
|
|
244 ;; feedmail-buffer-to-binmail and feedmail-buffer-to-sendmail are the
|
|
|
245 ;; only things provided for values for the variable
|
|
|
246 ;; feedmail-buffer-eating-function. It's pretty easy to write your
|
|
|
247 ;; own, though.
|
|
|
248
|
|
|
249 (defun feedmail-buffer-to-binmail (prepped-mail-buffer mail-error-buffer simple-address-list)
|
|
|
250 "Function which actually calls /bin/mail as a subprocess and feeds the buffer to it."
|
|
|
251 (save-excursion
|
|
|
252 (set-buffer prepped-mail-buffer)
|
|
|
253 (apply 'call-process-region
|
|
|
254 (append (list (point-min) (point-max)
|
|
|
255 "/bin/sh" nil mail-error-buffer nil "-c"
|
|
|
256 (format feedmail-binmail-template simple-address-list ))))
|
|
|
257 ) ;; save-excursion
|
|
|
258 )
|
|
|
259
|
|
|
260
|
|
|
261 (defun feedmail-buffer-to-sendmail (prepped-mail-buffer feedmail-error-buffer simple-address-list)
|
|
|
262 "Function which actually calls sendmail as a subprocess and feeds the buffer to it."
|
|
|
263 (save-excursion
|
|
|
264 (set-buffer prepped-mail-buffer)
|
|
|
265 (apply 'call-process-region
|
|
|
266 (append (list (point-min) (point-max)
|
|
|
267 (if (boundp 'sendmail-program)
|
|
|
268 sendmail-program
|
|
|
269 "/usr/lib/sendmail")
|
|
|
270 nil feedmail-error-buffer nil
|
|
|
271 "-oi" "-t")
|
|
|
272 ;; Don't say "from root" if running under su.
|
|
|
273 (and (equal (user-real-login-name) "root")
|
|
|
274 (list "-f" (user-login-name)))
|
|
|
275 ;; These mean "report errors by mail"
|
|
|
276 ;; and "deliver in background".
|
|
|
277 (if (null mail-interactive) '("-oem" "-odb"))))
|
|
|
278 ))
|
|
|
279
|
|
|
280
|
|
|
281 ;; feedmail-send-it is the only "public" function is this file.
|
|
|
282 ;; All of the others are just little helpers.
|
|
|
283 ;;;###autoload
|
|
|
284 (defun feedmail-send-it ()
|
|
|
285 (let* ((default-case-fold-search t)
|
|
|
286 (feedmail-error-buffer (get-buffer-create " *Outgoing Email Errors*"))
|
|
|
287 (feedmail-prepped-text-buffer (get-buffer-create " *Outgoing Email Text*"))
|
|
|
288 (feedmail-address-buffer (get-buffer-create " *Outgoing Email Address List*"))
|
|
|
289 (feedmail-raw-text-buffer (current-buffer))
|
|
|
290 (case-fold-search nil)
|
|
|
291 end-of-headers-marker)
|
|
|
292
|
|
|
293 (unwind-protect (save-excursion
|
|
|
294 (set-buffer feedmail-prepped-text-buffer) (erase-buffer)
|
|
|
295
|
|
|
296 ;; jam contents of user-supplied mail buffer into our scratch buffer
|
|
|
297 (insert-buffer-substring feedmail-raw-text-buffer)
|
|
|
298
|
|
|
299 ;; require one newline at the end.
|
|
|
300 (goto-char (point-max))
|
|
|
301 (or (= (preceding-char) ?\n) (insert ?\n))
|
|
|
302
|
|
|
303 ;; Change header-delimiter to be what mailers expect (empty line).
|
|
|
304 (goto-char (point-min))
|
|
|
305 (re-search-forward (concat "^" (regexp-quote mail-header-separator) "\n"))
|
|
|
306 (replace-match "\n")
|
|
|
307 ;; why was this backward-char here?
|
|
|
308 ;;(backward-char 1)
|
|
|
309 (setq end-of-headers-marker (point-marker))
|
|
|
310
|
|
|
311 (if (and (fboundp 'expand-mail-aliases) ; nil = mail-abbrevs.el
|
|
|
312 mail-aliases)
|
|
|
313 (expand-mail-aliases (point-min) end-of-headers-marker))
|
|
|
314
|
|
|
315 ;; make it pretty
|
|
|
316 (if feedmail-fill-to-cc (feedmail-fill-to-cc-function end-of-headers-marker))
|
|
|
317 ;; ignore any blank lines in the header
|
|
|
318 (goto-char (point-min))
|
|
|
319 (while (and (re-search-forward "\n\n\n*" end-of-headers-marker t) (< (point) end-of-headers-marker))
|
|
|
320 (replace-match "\n"))
|
|
|
321
|
|
|
322 (let ((case-fold-search t))
|
|
|
323 (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) end-of-headers-marker)
|
|
|
324 (save-excursion (set-buffer feedmail-address-buffer)
|
|
|
325 (goto-char (point-min))
|
|
|
326 (if (not (re-search-forward "\\S-" (point-max) t))
|
|
|
327 (error "Sending...abandoned, no addressees!")))
|
|
|
328
|
|
|
329 ;; Find and handle any BCC fields.
|
|
|
330 (if feedmail-nuke-bcc (feedmail-do-bcc end-of-headers-marker))
|
|
|
331
|
|
|
332 ;; Find and handle any FCC fields.
|
|
|
333 (goto-char (point-min))
|
|
|
334 (if (re-search-forward "^FCC:" end-of-headers-marker t)
|
|
|
335 (mail-do-fcc end-of-headers-marker))
|
|
|
336
|
|
|
337 (goto-char (point-min))
|
|
|
338 (if (re-search-forward "^FROM:" end-of-headers-marker t)
|
|
|
339
|
|
|
340 ;; If there is a FROM: and no SENDER:, put in a SENDER:
|
|
|
341 ;; if requested by user
|
|
|
342 (if (and feedmail-sender-line
|
|
|
343 (not (save-excursion (goto-char (point-min))
|
|
|
344 (re-search-forward "^SENDER:" end-of-headers-marker t))))
|
|
|
345 (progn (forward-line 1) (insert "Sender: " feedmail-sender-line "\n")))
|
|
|
346
|
|
|
347 ;; no FROM: ... force one?
|
|
|
348 (if feedmail-from-line
|
|
|
349 (progn (goto-char (point-min)) (insert "From: " feedmail-from-line "\n")))
|
|
|
350 )
|
|
|
351
|
|
|
352 ;; don't send out a blank subject line
|
|
|
353 (goto-char (point-min))
|
|
|
354 (if (re-search-forward "^Subject:[ \t]*\n" end-of-headers-marker t)
|
|
|
355 (replace-match ""))
|
|
|
356
|
|
|
357 ;; don't send out a blank headers of various sorts
|
|
|
358 (goto-char (point-min))
|
|
|
359 (and feedmail-nuke-empty-headers ;; hey, who's an empty-header?
|
|
|
360 (while (re-search-forward "^[A-Za-z0-9-]+:[ \t]*\n" end-of-headers-marker t)
|
|
|
361 (replace-match ""))))
|
|
|
362
|
|
|
363 ;; message ID generation
|
|
|
364 (if feedmail-message-id-generator
|
|
|
365 (progn
|
|
|
366 (goto-char (point-min))
|
|
|
367 (if (re-search-forward "^MESSAGE-ID:[ \t]*\n" end-of-headers-marker t)
|
|
|
368 (replace-match ""))
|
|
|
369 (setq feedmail-msgid-part (funcall feedmail-message-id-generator))
|
|
|
370 (goto-char (point-min))
|
|
|
371 (and feedmail-msgid-part (string-match "[^ \t]" feedmail-msgid-part)
|
|
|
372 (insert "Message-ID: " feedmail-msgid-part "\n"))))
|
|
|
373
|
|
|
374
|
|
|
375 (save-excursion (set-buffer feedmail-error-buffer) (erase-buffer))
|
|
|
376
|
|
|
377 (run-hooks 'feedmail-last-chance-hook)
|
|
|
378
|
|
|
379 (if (or (not feedmail-confirm-outgoing) (feedmail-one-last-look feedmail-prepped-text-buffer))
|
|
|
380 (funcall feedmail-buffer-eating-function feedmail-prepped-text-buffer feedmail-error-buffer
|
|
|
381 (save-excursion (set-buffer feedmail-address-buffer) (buffer-string)))
|
|
|
382 (error "Sending...abandoned")
|
|
|
383 )
|
|
|
384 ) ;; unwind-protect body (save-excursion)
|
|
|
385
|
|
|
386 ;; unwind-protect cleanup forms
|
|
|
387 (kill-buffer feedmail-prepped-text-buffer)
|
|
|
388 (kill-buffer feedmail-address-buffer)
|
|
|
389 (set-buffer feedmail-error-buffer)
|
|
|
390 (if (zerop (buffer-size))
|
|
|
391 (kill-buffer feedmail-error-buffer)
|
|
|
392 (progn (display-buffer feedmail-error-buffer)
|
|
|
393 (error "Sending...failed")))
|
|
|
394 (set-buffer feedmail-raw-text-buffer))
|
|
|
395 ) ;; let
|
|
|
396 )
|
|
|
397
|
|
|
398
|
|
|
399 (defun feedmail-do-bcc (header-end)
|
|
|
400 "Delete BCC: and their continuation lines from the header area.
|
|
|
401 There may be multiple BCC: lines, and each may have arbitrarily
|
|
|
402 many continuation lines."
|
|
|
403 (let ((case-fold-search t))
|
|
|
404 (save-excursion (goto-char (point-min))
|
|
|
405 ;; iterate over all BCC: lines
|
|
|
406 (while (re-search-forward "^BCC:" header-end t)
|
|
|
407 (delete-region (match-beginning 0) (progn (forward-line 1) (point)))
|
|
|
408 ;; get rid of any continuation lines
|
|
|
409 (while (and (looking-at "^[ \t].*\n") (< (point) header-end))
|
|
|
410 (replace-match ""))
|
|
|
411 )
|
|
|
412 ) ;; save-excursion
|
|
|
413 ) ;; let
|
|
|
414 )
|
|
|
415
|
|
|
416 (defun feedmail-fill-to-cc-function (header-end)
|
|
|
417 "Smart filling of TO: and CC: headers. The filling tries to avoid
|
|
|
418 splitting lines except at commas. This avoids, in particular,
|
|
|
419 splitting within parenthesized comments in addresses."
|
|
|
420 (let ((case-fold-search t)
|
|
|
421 (fill-prefix "\t")
|
|
|
422 (fill-column feedmail-fill-to-cc-fill-column)
|
|
|
423 this-line
|
|
|
424 this-line-end)
|
|
|
425 (save-excursion (goto-char (point-min))
|
|
|
426 ;; iterate over all TO:/CC: lines
|
|
|
427 (while (re-search-forward "^\\(TO:\\|CC:\\)" header-end t)
|
|
|
428 (setq this-line (match-beginning 0))
|
|
|
429 (forward-line 1)
|
|
|
430 ;; get any continuation lines
|
|
|
431 (while (and (looking-at "^[ \t]+") (< (point) header-end))
|
|
|
432 (replace-match " ")
|
|
|
433 (forward-line 1))
|
|
|
434 (setq this-line-end (point-marker))
|
|
|
435
|
|
|
436 ;; The general idea is to break only on commas. Change
|
|
|
437 ;; all the blanks to something unprintable; change the
|
|
|
438 ;; commas to blanks; fill the region; change it back.
|
|
|
439 (subst-char-in-region this-line this-line-end ? 2 t) ;; blank --> C-b
|
|
|
440 (subst-char-in-region this-line this-line-end ?, ? t) ;; comma --> blank
|
|
|
441 (fill-region-as-paragraph this-line this-line-end)
|
|
|
442
|
|
|
443 (subst-char-in-region this-line this-line-end ? ?, t) ;; comma <-- blank
|
|
|
444 (subst-char-in-region this-line this-line-end 2 ? t) ;; blank <-- C-b
|
|
|
445
|
|
|
446 ;; look out for missing commas before continuation lines
|
|
|
447 (save-excursion
|
|
|
448 (goto-char this-line)
|
|
|
449 (while (re-search-forward "\\([^,]\\)\n\t[ ]*" this-line-end t)
|
|
|
450 (replace-match "\\1,\n\t")))
|
|
|
451 )
|
|
|
452 ) ;; while
|
|
|
453 ) ;; save-excursion
|
|
|
454 )
|
|
|
455
|
|
|
456
|
|
|
457 (defun feedmail-deduce-address-list (feedmail-text-buffer header-start header-end)
|
|
|
458 "Get address list suitable for command line use on simple /bin/mail."
|
|
|
459 (require 'mail-utils) ;; pick up mail-strip-quoted-names
|
|
|
460 (let
|
|
|
461 ((case-fold-search t)
|
|
|
462 (simple-address-list "")
|
|
|
463 this-line
|
|
|
464 this-line-end)
|
|
|
465 (unwind-protect
|
|
|
466 (save-excursion
|
|
|
467 (set-buffer feedmail-address-buffer) (erase-buffer)
|
|
|
468 (insert-buffer-substring feedmail-text-buffer header-start header-end)
|
|
|
469 (goto-char (point-min))
|
|
|
470 (while (re-search-forward "^\\(TO:\\|CC:\\|BCC:\\)" header-end t)
|
|
|
471 (replace-match "")
|
|
|
472 (setq this-line (match-beginning 0))
|
|
|
473 (forward-line 1)
|
|
|
474 ;; get any continuation lines
|
|
|
475 (while (and (looking-at "^[ \t]+") (< (point) header-end))
|
|
|
476 (forward-line 1))
|
|
|
477 (setq this-line-end (point-marker))
|
|
|
478 (setq simple-address-list
|
|
|
479 (concat simple-address-list " "
|
|
|
480 (mail-strip-quoted-names (buffer-substring this-line this-line-end))))
|
|
|
481 )
|
|
|
482 (erase-buffer)
|
|
|
483 (insert-string simple-address-list)
|
|
|
484 (subst-char-in-region (point-min) (point-max) 10 ? t) ;; newline --> blank
|
|
|
485 (subst-char-in-region (point-min) (point-max) ?, ? t) ;; comma --> blank
|
|
|
486 (subst-char-in-region (point-min) (point-max) 9 ? t) ;; tab --> blank
|
|
|
487
|
|
|
488 (goto-char (point-min))
|
|
|
489 ;; tidyness in case hook is not robust when it looks at this
|
|
|
490 (while (re-search-forward "[ \t]+" header-end t) (replace-match " "))
|
|
|
491
|
|
|
492 )
|
|
|
493 )
|
|
|
494 )
|
|
|
495 )
|
|
|
496
|
|
|
497
|
|
|
498 (defun feedmail-one-last-look (feedmail-prepped-text-buffer)
|
|
|
499 "Offer the user one last chance to give it up."
|
|
|
500 (save-excursion (save-window-excursion
|
|
|
501 (switch-to-buffer feedmail-prepped-text-buffer)
|
|
|
502 (y-or-n-p "Send this email? "))))
|
|
|
503
|
|
|
504
|
|
|
505 (provide 'feedmail)
|
