|
13401
|
1 ;;; nnmail.el --- mail support functions for the Gnus mail backends
|
|
|
2 ;; Copyright (C) 1995 Free Software Foundation, Inc.
|
|
|
3
|
|
|
4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
|
|
|
5 ;; Keywords: news, mail
|
|
|
6
|
|
|
7 ;; This file is part of GNU Emacs.
|
|
|
8
|
|
|
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
|
10 ;; it under the terms of the GNU General Public License as published by
|
|
|
11 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
12 ;; any later version.
|
|
|
13
|
|
|
14 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
17 ;; GNU General Public License for more details.
|
|
|
18
|
|
|
19 ;; You should have received a copy of the GNU General Public License
|
|
|
20 ;; along with GNU Emacs; see the file COPYING. If not, write to
|
|
|
21 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
22
|
|
|
23 ;;; Commentary:
|
|
|
24
|
|
|
25 ;;; Code:
|
|
|
26
|
|
|
27 (require 'nnheader)
|
|
|
28 (require 'rmail)
|
|
|
29 (require 'timezone)
|
|
|
30 (require 'sendmail)
|
|
|
31
|
|
|
32 (defvar nnmail-split-methods
|
|
|
33 '(("mail.misc" ""))
|
|
|
34 "*Incoming mail will be split according to this variable.
|
|
|
35
|
|
|
36 If you'd like, for instance, one mail group for mail from the
|
|
|
37 \"4ad-l\" mailing list, one group for junk mail and one for everything
|
|
|
38 else, you could do something like this:
|
|
|
39
|
|
|
40 (setq nnmail-split-methods
|
|
|
41 '((\"mail.4ad\" \"From:.*4ad\")
|
|
|
42 (\"mail.junk\" \"From:.*Lars\\\\|Subject:.*buy\")
|
|
|
43 (\"mail.misc\" \"\")))
|
|
|
44
|
|
|
45 As you can see, this variable is a list of lists, where the first
|
|
|
46 element in each \"rule\" is the name of the group (which, by the way,
|
|
|
47 does not have to be called anything beginning with \"mail\",
|
|
|
48 \"yonka.zow\" is a fine, fine name), and the second is a regexp that
|
|
|
49 nnmail will try to match on the header to find a fit.
|
|
|
50
|
|
|
51 The second element can also be a function. In that case, it will be
|
|
|
52 called narrowed to the headers with the first element of the rule as
|
|
|
53 the argument. It should return a non-nil value if it thinks that the
|
|
|
54 mail belongs in that group.
|
|
|
55
|
|
|
56 The last element should always have \"\" as the regexp.
|
|
|
57
|
|
|
58 This variable can also have a function as its value.")
|
|
|
59
|
|
|
60 ;; Suggested by Erik Selberg <speed@cs.washington.edu>.
|
|
|
61 (defvar nnmail-crosspost t
|
|
|
62 "*If non-nil, do crossposting if several split methods match the mail.
|
|
|
63 If nil, the first match found will be used.")
|
|
|
64
|
|
|
65 ;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit).
|
|
|
66 (defvar nnmail-keep-last-article nil
|
|
|
67 "*If non-nil, nnmail will never delete the last expired article in a
|
|
|
68 directory. You may need to set this variable if other programs are putting
|
|
|
69 new mail into folder numbers that Gnus has marked as expired.")
|
|
|
70
|
|
|
71 (defvar nnmail-expiry-wait 7
|
|
|
72 "*Articles that are older than `nnmail-expiry-wait' days will be expired.")
|
|
|
73
|
|
|
74 (defvar nnmail-expiry-wait-function nil
|
|
|
75 "*Variable that holds function to specify how old articles should be before they are expired.
|
|
|
76 The function will be called with the name of the group that the
|
|
|
77 expiry is to be performed in, and it should return an integer that
|
|
|
78 says how many days an article can be stored before it is considered
|
|
|
79 'old'.
|
|
|
80
|
|
|
81 Eg.:
|
|
|
82
|
|
|
83 (setq nnmail-expiry-wait-function
|
|
|
84 (lambda (newsgroup)
|
|
|
85 (cond ((string-match \"private\" newsgroup) 31)
|
|
|
86 ((string-match \"junk\" newsgroup) 1)
|
|
|
87 (t 7))))")
|
|
|
88
|
|
|
89 (defvar nnmail-spool-file
|
|
|
90 (or (getenv "MAIL")
|
|
|
91 (concat "/usr/spool/mail/" (user-login-name)))
|
|
|
92 "Where the mail backends will look for incoming mail.
|
|
|
93 This variable is \"/usr/spool/mail/$user\" by default.
|
|
|
94 If this variable is nil, no mail backends will read incoming mail.
|
|
|
95 If this variable is a list, all files mentioned in this list will be
|
|
|
96 used as incoming mailboxes.")
|
|
|
97
|
|
|
98 (defvar nnmail-use-procmail nil
|
|
|
99 "*If non-nil, the mail backends will look in `nnmail-procmail-directory' for spool files.
|
|
|
100 The file(s) in `nnmail-spool-file' will also be read.")
|
|
|
101
|
|
|
102 (defvar nnmail-procmail-directory "~/incoming/"
|
|
|
103 "*When using procmail (and the like), incoming mail is put in this directory.
|
|
|
104 The Gnus mail backends will read the mail from this directory.")
|
|
|
105
|
|
|
106 (defvar nnmail-procmail-suffix ".spool"
|
|
|
107 "*Suffix of files created by procmail (and the like).
|
|
|
108 This variable might be a suffix-regexp to match the suffixes of
|
|
|
109 several files - eg. \".spool[0-9]*\".")
|
|
|
110
|
|
|
111 (defvar nnmail-resplit-incoming nil
|
|
|
112 "*If non-nil, re-split incoming procmail sorted mail.")
|
|
|
113
|
|
|
114 (defvar nnmail-movemail-program "movemail"
|
|
|
115 "*A command to be executed to move mail from the inbox.
|
|
|
116 The default is \"movemail\".")
|
|
|
117
|
|
|
118 (defvar nnmail-read-incoming-hook nil
|
|
|
119 "*Hook that will be run after the incoming mail has been transferred.
|
|
|
120 The incoming mail is moved from `nnmail-spool-file' (which normally is
|
|
|
121 something like \"/usr/spool/mail/$user\") to the user's home
|
|
|
122 directory. This hook is called after the incoming mail box has been
|
|
|
123 emptied, and can be used to call any mail box programs you have
|
|
|
124 running (\"xwatch\", etc.)
|
|
|
125
|
|
|
126 Eg.
|
|
|
127
|
|
|
128 (add-hook 'nnmail-read-incoming-hook
|
|
|
129 (lambda ()
|
|
|
130 (start-process \"mailsend\" nil
|
|
|
131 \"/local/bin/mailsend\" \"read\" \"mbox\")))")
|
|
|
132
|
|
|
133 ;; Suggested by Erik Selberg <speed@cs.washington.edu>.
|
|
|
134 (defvar nnmail-prepare-incoming-hook nil
|
|
|
135 "*Hook called before treating incoming mail.
|
|
|
136 The hook is run in a buffer with all the new, incoming mail.")
|
|
|
137
|
|
|
138 ;; Suggested by Mejia Pablo J <pjm9806@usl.edu>.
|
|
|
139 (defvar nnmail-tmp-directory nil
|
|
|
140 "*If non-nil, use this directory for temporary storage when reading incoming mail.")
|
|
|
141
|
|
|
142 (defvar nnmail-large-newsgroup 50
|
|
|
143 "*The number of the articles which indicates a large newsgroup.
|
|
|
144 If the number of the articles is greater than the value, verbose
|
|
|
145 messages will be shown to indicate the current status.")
|
|
|
146
|
|
|
147 (defvar nnmail-split-fancy "mail.misc"
|
|
|
148 "*Incoming mail can be split according to this fancy variable.
|
|
|
149 To enable this, set `nnmail-split-methods' to `nnmail-split-fancy'.
|
|
|
150
|
|
|
151 The format is this variable is SPLIT, where SPLIT can be one of
|
|
|
152 the following:
|
|
|
153
|
|
|
154 GROUP: Mail will be stored in GROUP (a string).
|
|
|
155
|
|
|
156 \(FIELD VALUE SPLIT): If the message field FIELD (a regexp) contains
|
|
|
157 VALUE (a regexp), store the messages as specified by SPLIT.
|
|
|
158
|
|
|
159 \(| SPLIT...): Process each SPLIT expression until one of them matches.
|
|
|
160 A SPLIT expression is said to match if it will cause the mail
|
|
|
161 message to be stored in one or more groups.
|
|
|
162
|
|
|
163 \(& SPLIT...): Process each SPLIT expression.
|
|
|
164
|
|
|
165 FIELD must match a complete field name. VALUE must match a complete
|
|
|
166 word according to the fundamental mode syntax table. You can use .*
|
|
|
167 in the regexps to match partial field names or words.
|
|
|
168
|
|
|
169 FIELD and VALUE can also be lisp symbols, in that case they are expanded
|
|
|
170 as specified in `nnmail-split-abbrev-alist'.
|
|
|
171
|
|
|
172 Example:
|
|
|
173
|
|
|
174 \(setq nnmail-split-methods 'nnmail-split-fancy
|
|
|
175 nnmail-split-fancy
|
|
|
176 ;; Messages from the mailer deamon are not crossposted to any of
|
|
|
177 ;; the ordinary groups. Warnings are put in a separate group
|
|
|
178 ;; from real errors.
|
|
|
179 '(| (\"from\" mail (| (\"subject\" \"warn.*\" \"mail.warning\")
|
|
|
180 \"mail.misc\"))
|
|
|
181 ;; Non-error messages are crossposted to all relevant
|
|
|
182 ;; groups, but we don't crosspost between the group for the
|
|
|
183 ;; (ding) list and the group for other (ding) related mail.
|
|
|
184 (& (| (any \"ding@ifi\\\\.uio\\\\.no\" \"ding.list\")
|
|
|
185 (\"subject\" \"ding\" \"ding.misc\"))
|
|
|
186 ;; Other mailing lists...
|
|
|
187 (any \"procmail@informatik\\\\.rwth-aachen\\\\.de\" \"procmail.list\")
|
|
|
188 (any \"SmartList@informatik\\\\.rwth-aachen\\\\.de\" \"SmartList.list\")
|
|
|
189 ;; People...
|
|
|
190 (any \"larsi@ifi\\\\.uio\\\\.no\" \"people.Lars Magne Ingebrigtsen\"))
|
|
|
191 ;; Unmatched mail goes to the catch all group.
|
|
|
192 \"misc.misc\"))")
|
|
|
193
|
|
|
194 (defvar nnmail-split-abbrev-alist
|
|
|
195 '((any . "from\\|to\\|cc\\|sender\\|apparently-to")
|
|
|
196 (mail . "mailer-daemon\\|postmaster"))
|
|
|
197 "*Alist of abbreviations allowed in `nnmail-split-fancy'.")
|
|
|
198
|
|
|
199 (defvar nnmail-delete-incoming t
|
|
|
200 "*If non-nil, the mail backends will delete incoming files after splitting.")
|
|
|
201
|
|
|
202 (defvar nnmail-message-id-cache-length 1000
|
|
|
203 "*The approximate number of Message-IDs nnmail will keep in its cache.
|
|
|
204 If this variable is nil, no checking on duplicate messages will be
|
|
|
205 perfomed.")
|
|
|
206
|
|
|
207 (defvar nnmail-message-id-cache-file "~/.nnmail-cache"
|
|
|
208 "*The file name of the nnmail Message-ID cache.")
|
|
|
209
|
|
|
210 (defvar nnmail-delete-duplicates nil
|
|
|
211 "*If non-nil, nnmail will delete any duplicate mails it sees.")
|
|
|
212
|
|
|
213
|
|
|
214
|
|
|
215 (defconst nnmail-version "nnmail 1.0"
|
|
|
216 "nnmail version.")
|
|
|
217
|
|
|
218
|
|
|
219
|
|
|
220 (defun nnmail-request-post (&optional server)
|
|
|
221 (mail-send-and-exit nil))
|
|
|
222
|
|
|
223 (defun nnmail-request-post-buffer (post group subject header article-buffer
|
|
|
224 info follow-to respect-poster)
|
|
|
225 (let ((method-address (cdr (assq 'to-address (nth 5 info))))
|
|
|
226 from date to reply-to message-of
|
|
|
227 references message-id cc new-cc sendto elt)
|
|
|
228 (setq method-address
|
|
|
229 (if (and (stringp method-address)
|
|
|
230 (string= method-address ""))
|
|
|
231 nil method-address))
|
|
|
232 (save-excursion
|
|
|
233 (set-buffer (get-buffer-create "*mail*"))
|
|
|
234 (mail-mode)
|
|
|
235 (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit)
|
|
|
236 (if (and (buffer-modified-p)
|
|
|
237 (> (buffer-size) 0)
|
|
|
238 (not (y-or-n-p "Unsent mail being composed; erase it? ")))
|
|
|
239 ()
|
|
|
240 (erase-buffer)
|
|
|
241 (if post
|
|
|
242 (progn
|
|
|
243 (mail-setup method-address subject nil nil nil nil)
|
|
|
244 (auto-save-mode auto-save-default))
|
|
|
245 (save-excursion
|
|
|
246 (set-buffer article-buffer)
|
|
|
247 (goto-char (point-min))
|
|
|
248 (narrow-to-region (point-min)
|
|
|
249 (progn (search-forward "\n\n") (point)))
|
|
|
250 (let ((buffer-read-only nil))
|
|
|
251 (set-text-properties (point-min) (point-max) nil))
|
|
|
252 (setq from (mail-header-from header))
|
|
|
253 (setq date (mail-header-date header))
|
|
|
254 (and from
|
|
|
255 (let ((stop-pos
|
|
|
256 (string-match " *at \\| *@ \\| *(\\| *<" from)))
|
|
|
257 (setq message-of
|
|
|
258 (concat (if stop-pos (substring from 0 stop-pos) from)
|
|
|
259 "'s message of " date))))
|
|
|
260 (setq cc (mail-strip-quoted-names (or (mail-fetch-field "cc") "")))
|
|
|
261 (setq to (mail-strip-quoted-names (or (mail-fetch-field "to") "")))
|
|
|
262 (setq new-cc (rmail-dont-reply-to
|
|
|
263 (concat (or to "")
|
|
|
264 (if cc (concat (if to ", " "") cc) ""))))
|
|
|
265 (let ((rmail-dont-reply-to-names
|
|
|
266 (regexp-quote (mail-strip-quoted-names
|
|
|
267 (or method-address reply-to from "")))))
|
|
|
268 (setq new-cc (rmail-dont-reply-to new-cc)))
|
|
|
269 (setq subject (mail-header-subject header))
|
|
|
270 (or (string-match "^[Rr][Ee]:" subject)
|
|
|
271 (setq subject (concat "Re: " subject)))
|
|
|
272 (setq reply-to (mail-fetch-field "reply-to"))
|
|
|
273 (setq references (mail-header-references header))
|
|
|
274 (setq message-id (mail-header-id header))
|
|
|
275 (widen))
|
|
|
276 (setq news-reply-yank-from from)
|
|
|
277 (setq news-reply-yank-message-id message-id)
|
|
|
278
|
|
|
279 ;; Gather the "to" addresses out of the follow-to list and remove
|
|
|
280 ;; them as we go.
|
|
|
281 (if (and follow-to (listp follow-to))
|
|
|
282 (while (setq elt (assoc "To" follow-to))
|
|
|
283 (setq sendto (concat sendto (and sendto ", ") (cdr elt)))
|
|
|
284 (setq follow-to (delq elt follow-to))))
|
|
|
285 (mail-setup (if (and follow-to (listp follow-to))
|
|
|
286 sendto
|
|
|
287 (or method-address reply-to from ""))
|
|
|
288 subject message-of
|
|
|
289 (if (zerop (length new-cc)) nil new-cc)
|
|
|
290 article-buffer nil)
|
|
|
291 (auto-save-mode auto-save-default)
|
|
|
292 ;; Note that "To" elements should already be in the message.
|
|
|
293 (if (and follow-to (listp follow-to))
|
|
|
294 (progn
|
|
|
295 (goto-char (point-min))
|
|
|
296 (re-search-forward "^To:" nil t)
|
|
|
297 (beginning-of-line)
|
|
|
298 (forward-line 1)
|
|
|
299 (while follow-to
|
|
|
300 (insert
|
|
|
301 (car (car follow-to)) ": " (cdr (car follow-to)) "\n")
|
|
|
302 (setq follow-to (cdr follow-to)))))
|
|
|
303 (nnheader-insert-references references message-id)))
|
|
|
304 (current-buffer))))
|
|
|
305
|
|
|
306 (defun nnmail-find-file (file)
|
|
|
307 "Insert FILE in server buffer safely."
|
|
|
308 (set-buffer nntp-server-buffer)
|
|
|
309 (erase-buffer)
|
|
|
310 (condition-case ()
|
|
|
311 (progn (insert-file-contents file) t)
|
|
|
312 (file-error nil)))
|
|
|
313
|
|
|
314 (defun nnmail-article-pathname (group mail-dir)
|
|
|
315 "Make pathname for GROUP."
|
|
|
316 (concat (file-name-as-directory (expand-file-name mail-dir))
|
|
|
317 (nnmail-replace-chars-in-string group ?. ?/) "/"))
|
|
|
318
|
|
|
319 (defun nnmail-replace-chars-in-string (string from to)
|
|
|
320 "Replace characters in STRING from FROM to TO."
|
|
|
321 (let ((string (substring string 0)) ;Copy string.
|
|
|
322 (len (length string))
|
|
|
323 (idx 0))
|
|
|
324 ;; Replace all occurrences of FROM with TO.
|
|
|
325 (while (< idx len)
|
|
|
326 (if (= (aref string idx) from)
|
|
|
327 (aset string idx to))
|
|
|
328 (setq idx (1+ idx)))
|
|
|
329 string))
|
|
|
330
|
|
|
331 (defun nnmail-days-between (date1 date2)
|
|
|
332 ;; Return the number of days between date1 and date2.
|
|
|
333 (let ((d1 (mapcar (lambda (s) (and s (string-to-int s)) )
|
|
|
334 (timezone-parse-date date1)))
|
|
|
335 (d2 (mapcar (lambda (s) (and s (string-to-int s)) )
|
|
|
336 (timezone-parse-date date2))))
|
|
|
337 (- (timezone-absolute-from-gregorian
|
|
|
338 (nth 1 d1) (nth 2 d1) (car d1))
|
|
|
339 (timezone-absolute-from-gregorian
|
|
|
340 (nth 1 d2) (nth 2 d2) (car d2)))))
|
|
|
341
|
|
|
342 ;; Function taken from rmail.el.
|
|
|
343 (defun nnmail-move-inbox (inbox tofile)
|
|
|
344 (let ((inbox (file-truename
|
|
|
345 (expand-file-name (substitute-in-file-name inbox))))
|
|
|
346 movemail popmail errors)
|
|
|
347 ;; Check whether the inbox is to be moved to the special tmp dir.
|
|
|
348 (if nnmail-tmp-directory
|
|
|
349 (setq tofile (concat (file-name-as-directory nnmail-tmp-directory)
|
|
|
350 (file-name-nondirectory tofile))))
|
|
|
351 ;; Make the filename unique.
|
|
|
352 (setq tofile (nnmail-make-complex-temp-name (expand-file-name tofile)))
|
|
|
353 ;; We create the directory the tofile is to reside in if it
|
|
|
354 ;; doesn't exist.
|
|
|
355 (or (file-exists-p (file-name-directory tofile))
|
|
|
356 (make-directory tofile 'parents))
|
|
|
357 ;; If getting from mail spool directory,
|
|
|
358 ;; use movemail to move rather than just renaming,
|
|
|
359 ;; so as to interlock with the mailer.
|
|
|
360 (or (setq popmail (string-match "^po:" (file-name-nondirectory inbox)))
|
|
|
361 (setq movemail t))
|
|
|
362 (if popmail (setq inbox (file-name-nondirectory inbox)))
|
|
|
363 (if movemail
|
|
|
364 ;; On some systems, /usr/spool/mail/foo is a directory
|
|
|
365 ;; and the actual inbox is /usr/spool/mail/foo/foo.
|
|
|
366 (if (file-directory-p inbox)
|
|
|
367 (setq inbox (expand-file-name (user-login-name) inbox))))
|
|
|
368 (if popmail
|
|
|
369 (message "Getting mail from post office ...")
|
|
|
370 (if (or (and (file-exists-p tofile)
|
|
|
371 (/= 0 (nth 7 (file-attributes tofile))))
|
|
|
372 (and (file-exists-p inbox)
|
|
|
373 (/= 0 (nth 7 (file-attributes inbox)))))
|
|
|
374 (message "Getting mail from %s..." inbox)))
|
|
|
375 ;; Set TOFILE if have not already done so, and
|
|
|
376 ;; rename or copy the file INBOX to TOFILE if and as appropriate.
|
|
|
377 (cond ((or (file-exists-p tofile) (and (not popmail)
|
|
|
378 (not (file-exists-p inbox))))
|
|
|
379 nil)
|
|
|
380 ((and (not movemail) (not popmail))
|
|
|
381 ;; Try copying. If that fails (perhaps no space),
|
|
|
382 ;; rename instead.
|
|
|
383 (condition-case nil
|
|
|
384 (copy-file inbox tofile nil)
|
|
|
385 (error
|
|
|
386 ;; Third arg is t so we can replace existing file TOFILE.
|
|
|
387 (rename-file inbox tofile t)))
|
|
|
388 ;; Make the real inbox file empty.
|
|
|
389 ;; Leaving it deleted could cause lossage
|
|
|
390 ;; because mailers often won't create the file.
|
|
|
391 (condition-case ()
|
|
|
392 (write-region (point) (point) inbox)
|
|
|
393 (file-error nil)))
|
|
|
394 (t
|
|
|
395 (unwind-protect
|
|
|
396 (save-excursion
|
|
|
397 (setq errors (generate-new-buffer " *nnmail loss*"))
|
|
|
398 (buffer-disable-undo errors)
|
|
|
399 (call-process
|
|
|
400 (expand-file-name nnmail-movemail-program exec-directory)
|
|
|
401 nil errors nil inbox tofile)
|
|
|
402 (if (not (buffer-modified-p errors))
|
|
|
403 ;; No output => movemail won
|
|
|
404 nil
|
|
|
405 (set-buffer errors)
|
|
|
406 (subst-char-in-region (point-min) (point-max) ?\n ?\ )
|
|
|
407 (goto-char (point-max))
|
|
|
408 (skip-chars-backward " \t")
|
|
|
409 (delete-region (point) (point-max))
|
|
|
410 (goto-char (point-min))
|
|
|
411 (if (looking-at "movemail: ")
|
|
|
412 (delete-region (point-min) (match-end 0)))
|
|
|
413 (beep t)
|
|
|
414 (message (concat "movemail: "
|
|
|
415 (buffer-substring (point-min)
|
|
|
416 (point-max))))
|
|
|
417 (sit-for 3)
|
|
|
418 nil)))))
|
|
|
419 (and errors
|
|
|
420 (buffer-name errors)
|
|
|
421 (kill-buffer errors))
|
|
|
422 tofile))
|
|
|
423
|
|
|
424
|
|
|
425 (defun nnmail-get-active ()
|
|
|
426 "Returns an assoc of group names and active ranges.
|
|
|
427 nn*-request-list should have been called before calling this function."
|
|
|
428 (let (group-assoc)
|
|
|
429 ;; Go through all groups from the active list.
|
|
|
430 (save-excursion
|
|
|
431 (set-buffer nntp-server-buffer)
|
|
|
432 (goto-char (point-min))
|
|
|
433 (while (re-search-forward
|
|
|
434 "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)" nil t)
|
|
|
435 (setq group-assoc
|
|
|
436 (cons (list (buffer-substring (match-beginning 1)
|
|
|
437 (match-end 1))
|
|
|
438 (cons (string-to-int
|
|
|
439 (buffer-substring (match-beginning 3)
|
|
|
440 (match-end 3)))
|
|
|
441 (string-to-int
|
|
|
442 (buffer-substring (match-beginning 2)
|
|
|
443 (match-end 2)))))
|
|
|
444 group-assoc))))
|
|
|
445
|
|
|
446 ;; ;; In addition, add all groups mentioned in `nnmail-split-methods'.
|
|
|
447 ;; (let ((methods (and (not (symbolp nnmail-split-methods))
|
|
|
448 ;; nnmail-split-methods)))
|
|
|
449 ;; (while methods
|
|
|
450 ;; (if (not (assoc (car (car methods)) group-assoc))
|
|
|
451 ;; (setq group-assoc
|
|
|
452 ;; (cons (list (car (car methods)) (cons 1 0))
|
|
|
453 ;; group-assoc)))
|
|
|
454 ;; (setq methods (cdr methods)))
|
|
|
455
|
|
|
456 group-assoc))
|
|
|
457
|
|
|
458 (defun nnmail-save-active (group-assoc file-name)
|
|
|
459 (let (group)
|
|
|
460 (save-excursion
|
|
|
461 (set-buffer (get-buffer-create " *nnmail active*"))
|
|
|
462 (buffer-disable-undo (current-buffer))
|
|
|
463 (erase-buffer)
|
|
|
464 (while group-assoc
|
|
|
465 (setq group (car group-assoc))
|
|
|
466 (insert (format "%s %d %d y\n" (car group) (cdr (car (cdr group)) )
|
|
|
467 (car (car (cdr group)))))
|
|
|
468 (setq group-assoc (cdr group-assoc)))
|
|
|
469 (write-region 1 (point-max) (expand-file-name file-name) nil 'nomesg)
|
|
|
470 (kill-buffer (current-buffer)))))
|
|
|
471
|
|
|
472 (defun nnmail-get-split-group (file group)
|
|
|
473 (if (or (eq nnmail-spool-file 'procmail)
|
|
|
474 nnmail-use-procmail)
|
|
|
475 (cond (group group)
|
|
|
476 ((string-match (concat "^" (expand-file-name
|
|
|
477 (file-name-as-directory
|
|
|
478 nnmail-procmail-directory))
|
|
|
479 "\\(.*\\)" nnmail-procmail-suffix "$")
|
|
|
480 (expand-file-name file))
|
|
|
481 (substring (expand-file-name file)
|
|
|
482 (match-beginning 1) (match-end 1)))
|
|
|
483 (t
|
|
|
484 group))
|
|
|
485 group))
|
|
|
486
|
|
|
487 (defun nnmail-split-incoming (incoming func &optional dont-kill group)
|
|
|
488 "Go through the entire INCOMING file and pick out each individual mail.
|
|
|
489 FUNC will be called with the buffer narrowed to each mail."
|
|
|
490 (let ((delim (concat "^" rmail-unix-mail-delimiter))
|
|
|
491 ;; If this is a group-specific split, we bind the split
|
|
|
492 ;; methods to just this group.
|
|
|
493 (nnmail-split-methods (if (and group
|
|
|
494 (or (eq nnmail-spool-file 'procmail)
|
|
|
495 nnmail-use-procmail)
|
|
|
496 (not nnmail-resplit-incoming))
|
|
|
497 (list (list group ""))
|
|
|
498 nnmail-split-methods))
|
|
|
499 start end content-length do-search message-id)
|
|
|
500 (save-excursion
|
|
|
501 ;; Open the message-id cache.
|
|
|
502 (nnmail-cache-open)
|
|
|
503 ;; Insert the incoming file.
|
|
|
504 (set-buffer (get-buffer-create " *nnmail incoming*"))
|
|
|
505 (buffer-disable-undo (current-buffer))
|
|
|
506 (erase-buffer)
|
|
|
507 (insert-file-contents incoming)
|
|
|
508 (goto-char (point-min))
|
|
|
509 (save-excursion (run-hooks 'nnmail-prepare-incoming-hook))
|
|
|
510 ;; Go to the beginning of the first mail...
|
|
|
511 (if (and (re-search-forward delim nil t)
|
|
|
512 (goto-char (match-beginning 0)))
|
|
|
513 ;; and then carry on until the bitter end.
|
|
|
514 (while (not (eobp))
|
|
|
515 (setq start (point))
|
|
|
516 ;; Skip all the headers in case there are more "From "s...
|
|
|
517 (if (not (search-forward "\n\n" nil t))
|
|
|
518 (forward-line 1))
|
|
|
519 ;; Find the Message-ID header.
|
|
|
520 (save-excursion
|
|
|
521 (if (re-search-backward "^Message-ID:[ \t]*\\(<[^>]*>\\)" nil t)
|
|
|
522 (setq message-id (buffer-substring (match-beginning 1)
|
|
|
523 (match-end 1)))
|
|
|
524 ;; There is no Message-ID here, so we create one.
|
|
|
525 (forward-line -1)
|
|
|
526 (insert "Message-ID: " (setq message-id (nnmail-message-id))
|
|
|
527 "\n")))
|
|
|
528 ;; Look for a Content-Length header.
|
|
|
529 (if (not (save-excursion
|
|
|
530 (and (re-search-backward
|
|
|
531 "^Content-Length: \\([0-9]+\\)" start t)
|
|
|
532 (setq content-length (string-to-int
|
|
|
533 (buffer-substring
|
|
|
534 (match-beginning 1)
|
|
|
535 (match-end 1))))
|
|
|
536 ;; We destroy the header, since none of
|
|
|
537 ;; the backends ever use it, and we do not
|
|
|
538 ;; want to confuse other mailers by having
|
|
|
539 ;; a (possibly) faulty header.
|
|
|
540 (progn (insert "X-") t))))
|
|
|
541 (setq do-search t)
|
|
|
542 (if (or (= (+ (point) content-length) (point-max))
|
|
|
543 (save-excursion
|
|
|
544 (goto-char (+ (point) content-length))
|
|
|
545 (looking-at delim)))
|
|
|
546 (progn
|
|
|
547 (goto-char (+ (point) content-length))
|
|
|
548 (setq do-search nil))
|
|
|
549 (setq do-search t)))
|
|
|
550 ;; Go to the beginning of the next article - or to the end
|
|
|
551 ;; of the buffer.
|
|
|
552 (if do-search
|
|
|
553 (if (re-search-forward delim nil t)
|
|
|
554 (goto-char (match-beginning 0))
|
|
|
555 (goto-char (point-max))))
|
|
|
556 (save-excursion
|
|
|
557 (save-restriction
|
|
|
558 (narrow-to-region start (point))
|
|
|
559 (goto-char (point-min))
|
|
|
560 ;; If this is a duplicate message, then we do not save it.
|
|
|
561 (if (nnmail-cache-id-exists-p message-id)
|
|
|
562 (delete-region (point-min) (point-max))
|
|
|
563 (nnmail-cache-insert message-id)
|
|
|
564 (funcall func))
|
|
|
565 (setq end (point-max))))
|
|
|
566 (goto-char end)))
|
|
|
567 ;; Close the message-id cache.
|
|
|
568 (nnmail-cache-close)
|
|
|
569 (if dont-kill
|
|
|
570 (current-buffer)
|
|
|
571 (kill-buffer (current-buffer))))))
|
|
|
572
|
|
|
573 ;; Mail crossposts syggested by Brian Edmonds <edmonds@cs.ubc.ca>.
|
|
|
574 (defun nnmail-article-group (func)
|
|
|
575 "Look at the headers and return an alist of groups that match.
|
|
|
576 FUNC will be called with the group name to determine the article number."
|
|
|
577 (let ((methods nnmail-split-methods)
|
|
|
578 (obuf (current-buffer))
|
|
|
579 (beg (point-min))
|
|
|
580 end group-art)
|
|
|
581 (if (and (sequencep methods) (= (length methods) 1))
|
|
|
582 ;; If there is only just one group to put everything in, we
|
|
|
583 ;; just return a list with just this one method in.
|
|
|
584 (setq group-art
|
|
|
585 (list (cons (car (car methods))
|
|
|
586 (funcall func (car (car methods))))))
|
|
|
587 ;; We do actual comparison.
|
|
|
588 (save-excursion
|
|
|
589 ;; Find headers.
|
|
|
590 (goto-char beg)
|
|
|
591 (setq end (if (search-forward "\n\n" nil t) (point) (point-max)))
|
|
|
592 (set-buffer (get-buffer-create " *nnmail work*"))
|
|
|
593 (buffer-disable-undo (current-buffer))
|
|
|
594 (erase-buffer)
|
|
|
595 ;; Copy the headers into the work buffer.
|
|
|
596 (insert-buffer-substring obuf beg end)
|
|
|
597 ;; Fold continuation lines.
|
|
|
598 (goto-char (point-min))
|
|
|
599 (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
|
|
|
600 (replace-match " " t t))
|
|
|
601 (if (and (symbolp nnmail-split-methods)
|
|
|
602 (fboundp nnmail-split-methods))
|
|
|
603 (setq group-art
|
|
|
604 (mapcar
|
|
|
605 (lambda (group) (cons group (funcall func group)))
|
|
|
606 (condition-case nil
|
|
|
607 (funcall nnmail-split-methods)
|
|
|
608 (error
|
|
|
609 (message "\
|
|
|
610 Problems with `nnmail-split-methods', using `bogus' mail group")
|
|
|
611 (sit-for 1)
|
|
|
612 '("bogus")))))
|
|
|
613 ;; Go throught the split methods to find a match.
|
|
|
614 (while (and methods (or nnmail-crosspost (not group-art)))
|
|
|
615 (goto-char (point-max))
|
|
|
616 (if (or (cdr methods)
|
|
|
617 (not (equal "" (nth 1 (car methods)))))
|
|
|
618 (if (and (condition-case ()
|
|
|
619 (if (stringp (nth 1 (car methods)))
|
|
|
620 (re-search-backward
|
|
|
621 (car (cdr (car methods))) nil t)
|
|
|
622 ;; Suggested by Brian Edmonds
|
|
|
623 ;; <edmonds@cs.ubc.ca>.
|
|
|
624 (funcall (nth 1 (car methods))
|
|
|
625 (car (car methods))))
|
|
|
626 (error nil))
|
|
|
627 ;; Don't enter the article into the same group twice.
|
|
|
628 (not (assoc (car (car methods)) group-art)))
|
|
|
629 (setq group-art
|
|
|
630 (cons (cons (car (car methods))
|
|
|
631 (funcall func (car (car methods))))
|
|
|
632 group-art)))
|
|
|
633 (or group-art
|
|
|
634 (setq group-art
|
|
|
635 (list (cons (car (car methods))
|
|
|
636 (funcall func (car (car methods))))))))
|
|
|
637 (setq methods (cdr methods))))
|
|
|
638 (kill-buffer (current-buffer))
|
|
|
639 group-art))))
|
|
|
640
|
|
|
641 (defun nnmail-insert-lines ()
|
|
|
642 "Insert how many lines and chars there are in the body of the mail."
|
|
|
643 (let (lines chars)
|
|
|
644 (save-excursion
|
|
|
645 (goto-char (point-min))
|
|
|
646 (if (search-forward "\n\n" nil t)
|
|
|
647 (progn
|
|
|
648 (setq chars (- (point-max) (point)))
|
|
|
649 (setq lines (- (count-lines (point) (point-max)) 1))
|
|
|
650 (forward-char -1)
|
|
|
651 (save-excursion
|
|
|
652 (if (re-search-backward "^Lines: " nil t)
|
|
|
653 (delete-region (point) (progn (forward-line 1) (point)))))
|
|
|
654 (insert (format "Lines: %d\n" lines))
|
|
|
655 chars)))))
|
|
|
656
|
|
|
657 (defun nnmail-insert-xref (group-alist)
|
|
|
658 "Insert an Xref line based on the (group . article) alist."
|
|
|
659 (save-excursion
|
|
|
660 (goto-char (point-min))
|
|
|
661 (if (search-forward "\n\n" nil t)
|
|
|
662 (progn
|
|
|
663 (forward-char -1)
|
|
|
664 (if (re-search-backward "^Xref: " nil t)
|
|
|
665 (delete-region (match-beginning 0)
|
|
|
666 (progn (forward-line 1) (point))))
|
|
|
667 (insert (format "Xref: %s" (system-name)))
|
|
|
668 (while group-alist
|
|
|
669 (insert (format " %s:%d" (car (car group-alist))
|
|
|
670 (cdr (car group-alist))))
|
|
|
671 (setq group-alist (cdr group-alist)))
|
|
|
672 (insert "\n")))))
|
|
|
673
|
|
|
674 ;; Written by byer@mv.us.adobe.com (Scott Byer).
|
|
|
675 (defun nnmail-make-complex-temp-name (prefix)
|
|
|
676 (let ((newname (make-temp-name prefix))
|
|
|
677 (newprefix prefix))
|
|
|
678 (while (file-exists-p newname)
|
|
|
679 (setq newprefix (concat newprefix "x"))
|
|
|
680 (setq newname (make-temp-name newprefix)))
|
|
|
681 newname))
|
|
|
682
|
|
|
683 ;; Written by Per Abrahamsen <amanda@iesd.auc.dk>.
|
|
|
684
|
|
|
685 (defun nnmail-split-fancy ()
|
|
|
686 "Fancy splitting method.
|
|
|
687 See the documentation for the variable `nnmail-split-fancy' for documentation."
|
|
|
688 (nnmail-split-it nnmail-split-fancy))
|
|
|
689
|
|
|
690 (defvar nnmail-split-cache nil)
|
|
|
691 ;; Alist of split expresions their equivalent regexps.
|
|
|
692
|
|
|
693 (defun nnmail-split-it (split)
|
|
|
694 ;; Return a list of groups matching SPLIT.
|
|
|
695 (cond ((stringp split)
|
|
|
696 ;; A group.
|
|
|
697 (list split))
|
|
|
698 ((eq (car split) '&)
|
|
|
699 (apply 'nconc (mapcar 'nnmail-split-it (cdr split))))
|
|
|
700 ((eq (car split) '|)
|
|
|
701 (let (done)
|
|
|
702 (while (and (not done) (cdr split))
|
|
|
703 (setq split (cdr split)
|
|
|
704 done (nnmail-split-it (car split))))
|
|
|
705 done)) ((assq split nnmail-split-cache)
|
|
|
706 ;; A compiled match expression.
|
|
|
707 (goto-char (point-max))
|
|
|
708 (if (re-search-backward (cdr (assq split nnmail-split-cache)) nil t)
|
|
|
709 (nnmail-split-it (nth 2 split))))
|
|
|
710 (t
|
|
|
711 ;; An uncompiled match.
|
|
|
712 (let* ((field (nth 0 split))
|
|
|
713 (value (nth 1 split))
|
|
|
714 (regexp (concat "^\\("
|
|
|
715 (if (symbolp field)
|
|
|
716 (cdr (assq field
|
|
|
717 nnmail-split-abbrev-alist))
|
|
|
718 field)
|
|
|
719 "\\):.*\\<\\("
|
|
|
720 (if (symbolp value)
|
|
|
721 (cdr (assq value
|
|
|
722 nnmail-split-abbrev-alist))
|
|
|
723 value)
|
|
|
724 "\\>\\)")))
|
|
|
725 (setq nnmail-split-cache
|
|
|
726 (cons (cons split regexp) nnmail-split-cache))
|
|
|
727 (goto-char (point-max))
|
|
|
728 (if (re-search-backward regexp nil t)
|
|
|
729 (nnmail-split-it (nth 2 split)))))))
|
|
|
730
|
|
|
731 ;; Get a list of spool files to read.
|
|
|
732 (defun nnmail-get-spool-files (&optional group)
|
|
|
733 (if (null nnmail-spool-file)
|
|
|
734 ;; No spool file whatsoever.
|
|
|
735 nil)
|
|
|
736 (let* ((procmails
|
|
|
737 ;; If procmail is used to get incoming mail, the files
|
|
|
738 ;; are stored in this directory.
|
|
|
739 (and (file-exists-p nnmail-procmail-directory)
|
|
|
740 (directory-files
|
|
|
741 nnmail-procmail-directory
|
|
|
742 t (concat (if group group "")
|
|
|
743 nnmail-procmail-suffix "$") t)))
|
|
|
744 (p procmails))
|
|
|
745 ;; Remove any directories that inadvertantly match the procmail
|
|
|
746 ;; suffix, which might happen if the suffix is "".
|
|
|
747 (while p
|
|
|
748 (and (or (file-directory-p (car p))
|
|
|
749 (file-symlink-p (car p)))
|
|
|
750 (setq procmails (delete (car p) procmails)))
|
|
|
751 (setq p (cdr p)))
|
|
|
752 (cond ((listp nnmail-spool-file)
|
|
|
753 (append nnmail-spool-file procmails))
|
|
|
754 ((stringp nnmail-spool-file)
|
|
|
755 (cons nnmail-spool-file procmails))
|
|
|
756 (t
|
|
|
757 procmails))))
|
|
|
758
|
|
|
759 ;; Activate a backend only if it isn't already activated.
|
|
|
760 ;; If FORCE, re-read the active file even if the backend is
|
|
|
761 ;; already activated.
|
|
|
762 (defun nnmail-activate (backend &optional force)
|
|
|
763 (let (file timestamp file-time)
|
|
|
764 (if (or (not (symbol-value (intern (format "%s-group-alist" backend))))
|
|
|
765 force
|
|
|
766 (and (setq file (condition-case ()
|
|
|
767 (symbol-value (intern (format "%s-active-file"
|
|
|
768 backend)))
|
|
|
769 (error nil)))
|
|
|
770 (setq file-time (nth 5 (file-attributes file)))
|
|
|
771 (or (not
|
|
|
772 (setq timestamp
|
|
|
773 (condition-case ()
|
|
|
774 (symbol-value (intern
|
|
|
775 (format "%s-active-timestamp"
|
|
|
776 backend)))
|
|
|
777 (error 'none))))
|
|
|
778 (not (consp timestamp))
|
|
|
779 (equal timestamp '(0 0))
|
|
|
780 (> (nth 0 file-time) (nth 0 timestamp))
|
|
|
781 (and (= (nth 0 file-time) (nth 0 timestamp))
|
|
|
782 (> (nth 1 file-time) (nth 1 timestamp))))))
|
|
|
783 (save-excursion
|
|
|
784 (or (eq timestamp 'none)
|
|
|
785 (set (intern (format "%s-active-timestamp" backend))
|
|
|
786 (current-time)))
|
|
|
787 (funcall (intern (format "%s-request-list" backend)))
|
|
|
788 (set (intern (format "%s-group-alist" backend))
|
|
|
789 (nnmail-get-active))))
|
|
|
790 t))
|
|
|
791
|
|
|
792 (defun nnmail-message-id ()
|
|
|
793 (concat "<" (nnmail-unique-id) "@totally-fudged-out-message-id>"))
|
|
|
794
|
|
|
795 (defvar nnmail-unique-id-char nil)
|
|
|
796
|
|
|
797 (defun nnmail-number-base36 (num len)
|
|
|
798 (if (if (< len 0) (<= num 0) (= len 0))
|
|
|
799 ""
|
|
|
800 (concat (nnmail-number-base36 (/ num 36) (1- len))
|
|
|
801 (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210"
|
|
|
802 (% num 36))))))
|
|
|
803
|
|
|
804 (defun nnmail-unique-id ()
|
|
|
805 (setq nnmail-unique-id-char
|
|
|
806 (% (1+ (or nnmail-unique-id-char (logand (random t) (1- (lsh 1 20)))))
|
|
|
807 ;; (current-time) returns 16-bit ints,
|
|
|
808 ;; and 2^16*25 just fits into 4 digits i base 36.
|
|
|
809 (* 25 25)))
|
|
|
810 (let ((tm (if (fboundp 'current-time)
|
|
|
811 (current-time) '(12191 46742 287898))))
|
|
|
812 (concat
|
|
|
813 (nnmail-number-base36 (+ (car tm)
|
|
|
814 (lsh (% nnmail-unique-id-char 25) 16)) 4)
|
|
|
815 (nnmail-number-base36 (+ (nth 1 tm)
|
|
|
816 (lsh (/ nnmail-unique-id-char 25) 16)) 4))))
|
|
|
817
|
|
|
818 ;;;
|
|
|
819 ;;; nnmail duplicate handling
|
|
|
820 ;;;
|
|
|
821
|
|
|
822 (defvar nnmail-cache-buffer nil)
|
|
|
823
|
|
|
824 (defun nnmail-cache-open ()
|
|
|
825 (if (or (not nnmail-delete-duplicates)
|
|
|
826 (and nnmail-cache-buffer
|
|
|
827 (buffer-name nnmail-cache-buffer)))
|
|
|
828 () ; The buffer is open.
|
|
|
829 (save-excursion
|
|
|
830 (set-buffer
|
|
|
831 (setq nnmail-cache-buffer
|
|
|
832 (get-buffer-create " *nnmail message-id cache*")))
|
|
|
833 (buffer-disable-undo (current-buffer))
|
|
|
834 (and (file-exists-p nnmail-message-id-cache-file)
|
|
|
835 (insert-file-contents nnmail-message-id-cache-file))
|
|
|
836 (current-buffer))))
|
|
|
837
|
|
|
838 (defun nnmail-cache-close ()
|
|
|
839 (if (or (not nnmail-cache-buffer)
|
|
|
840 (not nnmail-delete-duplicates)
|
|
|
841 (not (buffer-name nnmail-cache-buffer))
|
|
|
842 (not (buffer-modified-p nnmail-cache-buffer)))
|
|
|
843 () ; The buffer is closed.
|
|
|
844 (save-excursion
|
|
|
845 (set-buffer nnmail-cache-buffer)
|
|
|
846 ;; Weed out the excess number of Message-IDs.
|
|
|
847 (goto-char (point-max))
|
|
|
848 (and (search-backward "\n" nil t nnmail-message-id-cache-length)
|
|
|
849 (progn
|
|
|
850 (beginning-of-line)
|
|
|
851 (delete-region (point-min) (point))))
|
|
|
852 ;; Save the buffer.
|
|
|
853 (or (file-exists-p (file-name-directory nnmail-message-id-cache-file))
|
|
|
854 (make-directory (file-name-directory nnmail-message-id-cache-file)
|
|
|
855 t))
|
|
|
856 (write-region (point-min) (point-max)
|
|
|
857 nnmail-message-id-cache-file nil 'silent)
|
|
|
858 (set-buffer-modified-p nil))))
|
|
|
859
|
|
|
860 (defun nnmail-cache-insert (id)
|
|
|
861 (and nnmail-delete-duplicates
|
|
|
862 (save-excursion
|
|
|
863 (set-buffer nnmail-cache-buffer)
|
|
|
864 (goto-char (point-max))
|
|
|
865 (insert id "\n"))))
|
|
|
866
|
|
|
867 (defun nnmail-cache-id-exists-p (id)
|
|
|
868 (and nnmail-delete-duplicates
|
|
|
869 (save-excursion
|
|
|
870 (set-buffer nnmail-cache-buffer)
|
|
|
871 (goto-char (point-max))
|
|
|
872 (search-backward id nil t))))
|
|
|
873
|
|
|
874
|
|
|
875 (provide 'nnmail)
|
|
|
876
|
|
|
877 ;;; nnmail.el ends here
|
