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