Mercurial > emacs
annotate lisp/nnmail.el @ 14064:d090a0a25ac8
(Fcase_table_p): Harmonize arguments with documentation.
author | Erik Naggum <erik@naggum.no> |
---|---|
date | Tue, 09 Jan 1996 00:30:49 +0000 |
parents | 844367c3fd0f |
children | 83f275dcd93a |
rev | line source |
---|---|
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 | |
13999
844367c3fd0f
(nnmail-message-id-cache-length): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
13401
diff
changeset
|
205 performed.") |
13401 | 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 | |
13999
844367c3fd0f
(nnmail-message-id-cache-length): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
13401
diff
changeset
|
573 ;; Mail crossposts suggested by Brian Edmonds <edmonds@cs.ubc.ca>. |
13401 | 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"))))) | |
13999
844367c3fd0f
(nnmail-message-id-cache-length): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
13401
diff
changeset
|
613 ;; Go through the split methods to find a match. |
13401 | 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) | |
13999
844367c3fd0f
(nnmail-message-id-cache-length): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
13401
diff
changeset
|
691 ;; Alist of split expressions their equivalent regexps. |
13401 | 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)) | |
13999
844367c3fd0f
(nnmail-message-id-cache-length): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
13401
diff
changeset
|
745 ;; Remove any directories that inadvertently match the procmail |
13401 | 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 |