Mercurial > emacs
annotate lisp/nnmail.el @ 15417:4b19cdee5567
Comment change.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Wed, 12 Jun 1996 17:56:46 +0000 |
parents | 1e407d249337 |
children | 530d0d516a42 |
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)))) | |
15416
1e407d249337
(nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents:
14323
diff
changeset
|
370 (cond |
1e407d249337
(nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents:
14323
diff
changeset
|
371 (popmail |
1e407d249337
(nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents:
14323
diff
changeset
|
372 (if (and rmail-pop-password-required (not rmail-pop-password)) |
1e407d249337
(nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents:
14323
diff
changeset
|
373 (setq rmail-pop-password |
1e407d249337
(nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents:
14323
diff
changeset
|
374 (rmail-read-passwd |
1e407d249337
(nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents:
14323
diff
changeset
|
375 (format "Password for %s: " |
1e407d249337
(nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents:
14323
diff
changeset
|
376 (substring tofile (+ popmail 3)))))) |
1e407d249337
(nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents:
14323
diff
changeset
|
377 (message "Getting mail from post office ...")) |
1e407d249337
(nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents:
14323
diff
changeset
|
378 ((or (and (file-exists-p tofile) |
1e407d249337
(nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents:
14323
diff
changeset
|
379 (/= 0 (nth 7 (file-attributes tofile)))) |
1e407d249337
(nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents:
14323
diff
changeset
|
380 (and (file-exists-p inbox) |
1e407d249337
(nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents:
14323
diff
changeset
|
381 (/= 0 (nth 7 (file-attributes inbox))))) |
1e407d249337
(nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents:
14323
diff
changeset
|
382 (message "Getting mail from %s..." inbox))) |
13401 | 383 ;; Set TOFILE if have not already done so, and |
384 ;; rename or copy the file INBOX to TOFILE if and as appropriate. | |
385 (cond ((or (file-exists-p tofile) (and (not popmail) | |
386 (not (file-exists-p inbox)))) | |
387 nil) | |
388 ((and (not movemail) (not popmail)) | |
389 ;; Try copying. If that fails (perhaps no space), | |
390 ;; rename instead. | |
391 (condition-case nil | |
392 (copy-file inbox tofile nil) | |
393 (error | |
394 ;; Third arg is t so we can replace existing file TOFILE. | |
395 (rename-file inbox tofile t))) | |
396 ;; Make the real inbox file empty. | |
397 ;; Leaving it deleted could cause lossage | |
398 ;; because mailers often won't create the file. | |
399 (condition-case () | |
400 (write-region (point) (point) inbox) | |
401 (file-error nil))) | |
402 (t | |
403 (unwind-protect | |
404 (save-excursion | |
405 (setq errors (generate-new-buffer " *nnmail loss*")) | |
406 (buffer-disable-undo errors) | |
15416
1e407d249337
(nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents:
14323
diff
changeset
|
407 (if rmail-pop-password |
1e407d249337
(nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents:
14323
diff
changeset
|
408 (call-process |
1e407d249337
(nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents:
14323
diff
changeset
|
409 (expand-file-name nnmail-movemail-program exec-directory) |
1e407d249337
(nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents:
14323
diff
changeset
|
410 nil errors nil inbox tofile rmail-pop-password) |
1e407d249337
(nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents:
14323
diff
changeset
|
411 (call-process |
1e407d249337
(nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents:
14323
diff
changeset
|
412 (expand-file-name nnmail-movemail-program exec-directory) |
1e407d249337
(nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents:
14323
diff
changeset
|
413 nil errors nil inbox tofile)) |
13401 | 414 (if (not (buffer-modified-p errors)) |
415 ;; No output => movemail won | |
416 nil | |
417 (set-buffer errors) | |
418 (subst-char-in-region (point-min) (point-max) ?\n ?\ ) | |
419 (goto-char (point-max)) | |
420 (skip-chars-backward " \t") | |
421 (delete-region (point) (point-max)) | |
422 (goto-char (point-min)) | |
423 (if (looking-at "movemail: ") | |
424 (delete-region (point-min) (match-end 0))) | |
425 (beep t) | |
14323
b418ef5f5ae1
(nnmail-move-inbox): Pass proper format string to message.
Karl Heuer <kwzh@gnu.org>
parents:
14169
diff
changeset
|
426 (message "movemail: %s" |
b418ef5f5ae1
(nnmail-move-inbox): Pass proper format string to message.
Karl Heuer <kwzh@gnu.org>
parents:
14169
diff
changeset
|
427 (buffer-substring (point-min) |
b418ef5f5ae1
(nnmail-move-inbox): Pass proper format string to message.
Karl Heuer <kwzh@gnu.org>
parents:
14169
diff
changeset
|
428 (point-max))) |
13401 | 429 (sit-for 3) |
430 nil))))) | |
431 (and errors | |
432 (buffer-name errors) | |
433 (kill-buffer errors)) | |
434 tofile)) | |
435 | |
436 | |
437 (defun nnmail-get-active () | |
438 "Returns an assoc of group names and active ranges. | |
439 nn*-request-list should have been called before calling this function." | |
440 (let (group-assoc) | |
441 ;; Go through all groups from the active list. | |
442 (save-excursion | |
443 (set-buffer nntp-server-buffer) | |
444 (goto-char (point-min)) | |
445 (while (re-search-forward | |
446 "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)" nil t) | |
447 (setq group-assoc | |
448 (cons (list (buffer-substring (match-beginning 1) | |
449 (match-end 1)) | |
450 (cons (string-to-int | |
451 (buffer-substring (match-beginning 3) | |
452 (match-end 3))) | |
453 (string-to-int | |
454 (buffer-substring (match-beginning 2) | |
455 (match-end 2))))) | |
456 group-assoc)))) | |
457 | |
458 ;; ;; In addition, add all groups mentioned in `nnmail-split-methods'. | |
459 ;; (let ((methods (and (not (symbolp nnmail-split-methods)) | |
460 ;; nnmail-split-methods))) | |
461 ;; (while methods | |
462 ;; (if (not (assoc (car (car methods)) group-assoc)) | |
463 ;; (setq group-assoc | |
464 ;; (cons (list (car (car methods)) (cons 1 0)) | |
465 ;; group-assoc))) | |
466 ;; (setq methods (cdr methods))) | |
467 | |
468 group-assoc)) | |
469 | |
470 (defun nnmail-save-active (group-assoc file-name) | |
471 (let (group) | |
472 (save-excursion | |
473 (set-buffer (get-buffer-create " *nnmail active*")) | |
474 (buffer-disable-undo (current-buffer)) | |
475 (erase-buffer) | |
476 (while group-assoc | |
477 (setq group (car group-assoc)) | |
478 (insert (format "%s %d %d y\n" (car group) (cdr (car (cdr group)) ) | |
479 (car (car (cdr group))))) | |
480 (setq group-assoc (cdr group-assoc))) | |
481 (write-region 1 (point-max) (expand-file-name file-name) nil 'nomesg) | |
482 (kill-buffer (current-buffer))))) | |
483 | |
484 (defun nnmail-get-split-group (file group) | |
485 (if (or (eq nnmail-spool-file 'procmail) | |
486 nnmail-use-procmail) | |
487 (cond (group group) | |
488 ((string-match (concat "^" (expand-file-name | |
489 (file-name-as-directory | |
490 nnmail-procmail-directory)) | |
491 "\\(.*\\)" nnmail-procmail-suffix "$") | |
492 (expand-file-name file)) | |
493 (substring (expand-file-name file) | |
494 (match-beginning 1) (match-end 1))) | |
495 (t | |
496 group)) | |
497 group)) | |
498 | |
499 (defun nnmail-split-incoming (incoming func &optional dont-kill group) | |
500 "Go through the entire INCOMING file and pick out each individual mail. | |
501 FUNC will be called with the buffer narrowed to each mail." | |
502 (let ((delim (concat "^" rmail-unix-mail-delimiter)) | |
503 ;; If this is a group-specific split, we bind the split | |
504 ;; methods to just this group. | |
505 (nnmail-split-methods (if (and group | |
506 (or (eq nnmail-spool-file 'procmail) | |
507 nnmail-use-procmail) | |
508 (not nnmail-resplit-incoming)) | |
509 (list (list group "")) | |
510 nnmail-split-methods)) | |
511 start end content-length do-search message-id) | |
512 (save-excursion | |
513 ;; Open the message-id cache. | |
514 (nnmail-cache-open) | |
515 ;; Insert the incoming file. | |
516 (set-buffer (get-buffer-create " *nnmail incoming*")) | |
517 (buffer-disable-undo (current-buffer)) | |
518 (erase-buffer) | |
519 (insert-file-contents incoming) | |
520 (goto-char (point-min)) | |
521 (save-excursion (run-hooks 'nnmail-prepare-incoming-hook)) | |
522 ;; Go to the beginning of the first mail... | |
523 (if (and (re-search-forward delim nil t) | |
524 (goto-char (match-beginning 0))) | |
525 ;; and then carry on until the bitter end. | |
526 (while (not (eobp)) | |
527 (setq start (point)) | |
528 ;; Skip all the headers in case there are more "From "s... | |
529 (if (not (search-forward "\n\n" nil t)) | |
530 (forward-line 1)) | |
531 ;; Find the Message-ID header. | |
532 (save-excursion | |
533 (if (re-search-backward "^Message-ID:[ \t]*\\(<[^>]*>\\)" nil t) | |
534 (setq message-id (buffer-substring (match-beginning 1) | |
535 (match-end 1))) | |
536 ;; There is no Message-ID here, so we create one. | |
537 (forward-line -1) | |
538 (insert "Message-ID: " (setq message-id (nnmail-message-id)) | |
539 "\n"))) | |
540 ;; Look for a Content-Length header. | |
541 (if (not (save-excursion | |
542 (and (re-search-backward | |
543 "^Content-Length: \\([0-9]+\\)" start t) | |
544 (setq content-length (string-to-int | |
545 (buffer-substring | |
546 (match-beginning 1) | |
547 (match-end 1)))) | |
548 ;; We destroy the header, since none of | |
549 ;; the backends ever use it, and we do not | |
550 ;; want to confuse other mailers by having | |
551 ;; a (possibly) faulty header. | |
552 (progn (insert "X-") t)))) | |
553 (setq do-search t) | |
554 (if (or (= (+ (point) content-length) (point-max)) | |
555 (save-excursion | |
556 (goto-char (+ (point) content-length)) | |
557 (looking-at delim))) | |
558 (progn | |
559 (goto-char (+ (point) content-length)) | |
560 (setq do-search nil)) | |
561 (setq do-search t))) | |
562 ;; Go to the beginning of the next article - or to the end | |
563 ;; of the buffer. | |
564 (if do-search | |
565 (if (re-search-forward delim nil t) | |
566 (goto-char (match-beginning 0)) | |
567 (goto-char (point-max)))) | |
568 (save-excursion | |
569 (save-restriction | |
570 (narrow-to-region start (point)) | |
571 (goto-char (point-min)) | |
572 ;; If this is a duplicate message, then we do not save it. | |
573 (if (nnmail-cache-id-exists-p message-id) | |
574 (delete-region (point-min) (point-max)) | |
575 (nnmail-cache-insert message-id) | |
576 (funcall func)) | |
577 (setq end (point-max)))) | |
578 (goto-char end))) | |
579 ;; Close the message-id cache. | |
580 (nnmail-cache-close) | |
581 (if dont-kill | |
582 (current-buffer) | |
583 (kill-buffer (current-buffer)))))) | |
584 | |
13999
844367c3fd0f
(nnmail-message-id-cache-length): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
13401
diff
changeset
|
585 ;; Mail crossposts suggested by Brian Edmonds <edmonds@cs.ubc.ca>. |
13401 | 586 (defun nnmail-article-group (func) |
587 "Look at the headers and return an alist of groups that match. | |
588 FUNC will be called with the group name to determine the article number." | |
589 (let ((methods nnmail-split-methods) | |
590 (obuf (current-buffer)) | |
591 (beg (point-min)) | |
592 end group-art) | |
593 (if (and (sequencep methods) (= (length methods) 1)) | |
594 ;; If there is only just one group to put everything in, we | |
595 ;; just return a list with just this one method in. | |
596 (setq group-art | |
597 (list (cons (car (car methods)) | |
598 (funcall func (car (car methods)))))) | |
599 ;; We do actual comparison. | |
600 (save-excursion | |
601 ;; Find headers. | |
602 (goto-char beg) | |
603 (setq end (if (search-forward "\n\n" nil t) (point) (point-max))) | |
604 (set-buffer (get-buffer-create " *nnmail work*")) | |
605 (buffer-disable-undo (current-buffer)) | |
606 (erase-buffer) | |
607 ;; Copy the headers into the work buffer. | |
608 (insert-buffer-substring obuf beg end) | |
609 ;; Fold continuation lines. | |
610 (goto-char (point-min)) | |
611 (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) | |
612 (replace-match " " t t)) | |
613 (if (and (symbolp nnmail-split-methods) | |
614 (fboundp nnmail-split-methods)) | |
615 (setq group-art | |
616 (mapcar | |
617 (lambda (group) (cons group (funcall func group))) | |
618 (condition-case nil | |
619 (funcall nnmail-split-methods) | |
620 (error | |
621 (message "\ | |
622 Problems with `nnmail-split-methods', using `bogus' mail group") | |
623 (sit-for 1) | |
624 '("bogus"))))) | |
13999
844367c3fd0f
(nnmail-message-id-cache-length): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
13401
diff
changeset
|
625 ;; Go through the split methods to find a match. |
13401 | 626 (while (and methods (or nnmail-crosspost (not group-art))) |
627 (goto-char (point-max)) | |
628 (if (or (cdr methods) | |
629 (not (equal "" (nth 1 (car methods))))) | |
630 (if (and (condition-case () | |
631 (if (stringp (nth 1 (car methods))) | |
632 (re-search-backward | |
633 (car (cdr (car methods))) nil t) | |
634 ;; Suggested by Brian Edmonds | |
635 ;; <edmonds@cs.ubc.ca>. | |
636 (funcall (nth 1 (car methods)) | |
637 (car (car methods)))) | |
638 (error nil)) | |
639 ;; Don't enter the article into the same group twice. | |
640 (not (assoc (car (car methods)) group-art))) | |
641 (setq group-art | |
642 (cons (cons (car (car methods)) | |
643 (funcall func (car (car methods)))) | |
644 group-art))) | |
645 (or group-art | |
646 (setq group-art | |
647 (list (cons (car (car methods)) | |
648 (funcall func (car (car methods)))))))) | |
649 (setq methods (cdr methods)))) | |
650 (kill-buffer (current-buffer)) | |
651 group-art)))) | |
652 | |
653 (defun nnmail-insert-lines () | |
654 "Insert how many lines and chars there are in the body of the mail." | |
655 (let (lines chars) | |
656 (save-excursion | |
657 (goto-char (point-min)) | |
658 (if (search-forward "\n\n" nil t) | |
659 (progn | |
660 (setq chars (- (point-max) (point))) | |
661 (setq lines (- (count-lines (point) (point-max)) 1)) | |
662 (forward-char -1) | |
663 (save-excursion | |
664 (if (re-search-backward "^Lines: " nil t) | |
665 (delete-region (point) (progn (forward-line 1) (point))))) | |
666 (insert (format "Lines: %d\n" lines)) | |
667 chars))))) | |
668 | |
669 (defun nnmail-insert-xref (group-alist) | |
670 "Insert an Xref line based on the (group . article) alist." | |
671 (save-excursion | |
672 (goto-char (point-min)) | |
673 (if (search-forward "\n\n" nil t) | |
674 (progn | |
675 (forward-char -1) | |
676 (if (re-search-backward "^Xref: " nil t) | |
677 (delete-region (match-beginning 0) | |
678 (progn (forward-line 1) (point)))) | |
679 (insert (format "Xref: %s" (system-name))) | |
680 (while group-alist | |
681 (insert (format " %s:%d" (car (car group-alist)) | |
682 (cdr (car group-alist)))) | |
683 (setq group-alist (cdr group-alist))) | |
684 (insert "\n"))))) | |
685 | |
686 ;; Written by byer@mv.us.adobe.com (Scott Byer). | |
687 (defun nnmail-make-complex-temp-name (prefix) | |
688 (let ((newname (make-temp-name prefix)) | |
689 (newprefix prefix)) | |
690 (while (file-exists-p newname) | |
691 (setq newprefix (concat newprefix "x")) | |
692 (setq newname (make-temp-name newprefix))) | |
693 newname)) | |
694 | |
695 ;; Written by Per Abrahamsen <amanda@iesd.auc.dk>. | |
696 | |
697 (defun nnmail-split-fancy () | |
698 "Fancy splitting method. | |
699 See the documentation for the variable `nnmail-split-fancy' for documentation." | |
700 (nnmail-split-it nnmail-split-fancy)) | |
701 | |
702 (defvar nnmail-split-cache nil) | |
13999
844367c3fd0f
(nnmail-message-id-cache-length): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
13401
diff
changeset
|
703 ;; Alist of split expressions their equivalent regexps. |
13401 | 704 |
705 (defun nnmail-split-it (split) | |
706 ;; Return a list of groups matching SPLIT. | |
707 (cond ((stringp split) | |
708 ;; A group. | |
709 (list split)) | |
710 ((eq (car split) '&) | |
711 (apply 'nconc (mapcar 'nnmail-split-it (cdr split)))) | |
712 ((eq (car split) '|) | |
713 (let (done) | |
714 (while (and (not done) (cdr split)) | |
715 (setq split (cdr split) | |
716 done (nnmail-split-it (car split)))) | |
717 done)) ((assq split nnmail-split-cache) | |
718 ;; A compiled match expression. | |
719 (goto-char (point-max)) | |
720 (if (re-search-backward (cdr (assq split nnmail-split-cache)) nil t) | |
721 (nnmail-split-it (nth 2 split)))) | |
722 (t | |
723 ;; An uncompiled match. | |
724 (let* ((field (nth 0 split)) | |
725 (value (nth 1 split)) | |
726 (regexp (concat "^\\(" | |
727 (if (symbolp field) | |
728 (cdr (assq field | |
729 nnmail-split-abbrev-alist)) | |
730 field) | |
731 "\\):.*\\<\\(" | |
732 (if (symbolp value) | |
733 (cdr (assq value | |
734 nnmail-split-abbrev-alist)) | |
735 value) | |
736 "\\>\\)"))) | |
737 (setq nnmail-split-cache | |
738 (cons (cons split regexp) nnmail-split-cache)) | |
739 (goto-char (point-max)) | |
740 (if (re-search-backward regexp nil t) | |
741 (nnmail-split-it (nth 2 split))))))) | |
742 | |
743 ;; Get a list of spool files to read. | |
744 (defun nnmail-get-spool-files (&optional group) | |
745 (if (null nnmail-spool-file) | |
746 ;; No spool file whatsoever. | |
747 nil) | |
748 (let* ((procmails | |
749 ;; If procmail is used to get incoming mail, the files | |
750 ;; are stored in this directory. | |
751 (and (file-exists-p nnmail-procmail-directory) | |
752 (directory-files | |
753 nnmail-procmail-directory | |
754 t (concat (if group group "") | |
755 nnmail-procmail-suffix "$") t))) | |
756 (p procmails)) | |
13999
844367c3fd0f
(nnmail-message-id-cache-length): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
13401
diff
changeset
|
757 ;; Remove any directories that inadvertently match the procmail |
13401 | 758 ;; suffix, which might happen if the suffix is "". |
759 (while p | |
760 (and (or (file-directory-p (car p)) | |
761 (file-symlink-p (car p))) | |
762 (setq procmails (delete (car p) procmails))) | |
763 (setq p (cdr p))) | |
764 (cond ((listp nnmail-spool-file) | |
765 (append nnmail-spool-file procmails)) | |
766 ((stringp nnmail-spool-file) | |
767 (cons nnmail-spool-file procmails)) | |
768 (t | |
769 procmails)))) | |
770 | |
771 ;; Activate a backend only if it isn't already activated. | |
772 ;; If FORCE, re-read the active file even if the backend is | |
773 ;; already activated. | |
774 (defun nnmail-activate (backend &optional force) | |
775 (let (file timestamp file-time) | |
776 (if (or (not (symbol-value (intern (format "%s-group-alist" backend)))) | |
777 force | |
778 (and (setq file (condition-case () | |
779 (symbol-value (intern (format "%s-active-file" | |
780 backend))) | |
781 (error nil))) | |
782 (setq file-time (nth 5 (file-attributes file))) | |
783 (or (not | |
784 (setq timestamp | |
785 (condition-case () | |
786 (symbol-value (intern | |
787 (format "%s-active-timestamp" | |
788 backend))) | |
789 (error 'none)))) | |
790 (not (consp timestamp)) | |
791 (equal timestamp '(0 0)) | |
792 (> (nth 0 file-time) (nth 0 timestamp)) | |
793 (and (= (nth 0 file-time) (nth 0 timestamp)) | |
794 (> (nth 1 file-time) (nth 1 timestamp)))))) | |
795 (save-excursion | |
796 (or (eq timestamp 'none) | |
797 (set (intern (format "%s-active-timestamp" backend)) | |
798 (current-time))) | |
799 (funcall (intern (format "%s-request-list" backend))) | |
800 (set (intern (format "%s-group-alist" backend)) | |
801 (nnmail-get-active)))) | |
802 t)) | |
803 | |
804 (defun nnmail-message-id () | |
805 (concat "<" (nnmail-unique-id) "@totally-fudged-out-message-id>")) | |
806 | |
807 (defvar nnmail-unique-id-char nil) | |
808 | |
809 (defun nnmail-number-base36 (num len) | |
810 (if (if (< len 0) (<= num 0) (= len 0)) | |
811 "" | |
812 (concat (nnmail-number-base36 (/ num 36) (1- len)) | |
813 (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210" | |
814 (% num 36)))))) | |
815 | |
816 (defun nnmail-unique-id () | |
817 (setq nnmail-unique-id-char | |
818 (% (1+ (or nnmail-unique-id-char (logand (random t) (1- (lsh 1 20))))) | |
819 ;; (current-time) returns 16-bit ints, | |
820 ;; and 2^16*25 just fits into 4 digits i base 36. | |
821 (* 25 25))) | |
822 (let ((tm (if (fboundp 'current-time) | |
823 (current-time) '(12191 46742 287898)))) | |
824 (concat | |
825 (nnmail-number-base36 (+ (car tm) | |
826 (lsh (% nnmail-unique-id-char 25) 16)) 4) | |
827 (nnmail-number-base36 (+ (nth 1 tm) | |
828 (lsh (/ nnmail-unique-id-char 25) 16)) 4)))) | |
829 | |
830 ;;; | |
831 ;;; nnmail duplicate handling | |
832 ;;; | |
833 | |
834 (defvar nnmail-cache-buffer nil) | |
835 | |
836 (defun nnmail-cache-open () | |
837 (if (or (not nnmail-delete-duplicates) | |
838 (and nnmail-cache-buffer | |
839 (buffer-name nnmail-cache-buffer))) | |
840 () ; The buffer is open. | |
841 (save-excursion | |
842 (set-buffer | |
843 (setq nnmail-cache-buffer | |
844 (get-buffer-create " *nnmail message-id cache*"))) | |
845 (buffer-disable-undo (current-buffer)) | |
846 (and (file-exists-p nnmail-message-id-cache-file) | |
847 (insert-file-contents nnmail-message-id-cache-file)) | |
848 (current-buffer)))) | |
849 | |
850 (defun nnmail-cache-close () | |
851 (if (or (not nnmail-cache-buffer) | |
852 (not nnmail-delete-duplicates) | |
853 (not (buffer-name nnmail-cache-buffer)) | |
854 (not (buffer-modified-p nnmail-cache-buffer))) | |
855 () ; The buffer is closed. | |
856 (save-excursion | |
857 (set-buffer nnmail-cache-buffer) | |
858 ;; Weed out the excess number of Message-IDs. | |
859 (goto-char (point-max)) | |
860 (and (search-backward "\n" nil t nnmail-message-id-cache-length) | |
861 (progn | |
862 (beginning-of-line) | |
863 (delete-region (point-min) (point)))) | |
864 ;; Save the buffer. | |
865 (or (file-exists-p (file-name-directory nnmail-message-id-cache-file)) | |
866 (make-directory (file-name-directory nnmail-message-id-cache-file) | |
867 t)) | |
868 (write-region (point-min) (point-max) | |
869 nnmail-message-id-cache-file nil 'silent) | |
870 (set-buffer-modified-p nil)))) | |
871 | |
872 (defun nnmail-cache-insert (id) | |
873 (and nnmail-delete-duplicates | |
874 (save-excursion | |
875 (set-buffer nnmail-cache-buffer) | |
876 (goto-char (point-max)) | |
877 (insert id "\n")))) | |
878 | |
879 (defun nnmail-cache-id-exists-p (id) | |
880 (and nnmail-delete-duplicates | |
881 (save-excursion | |
882 (set-buffer nnmail-cache-buffer) | |
883 (goto-char (point-max)) | |
884 (search-backward id nil t)))) | |
885 | |
886 | |
887 (provide 'nnmail) | |
888 | |
889 ;;; nnmail.el ends here |