|
17493
|
1 ;;; nnmail.el --- mail support functions for the Gnus mail backends
|
|
31716
|
2 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
|
|
|
3 ;; Free Software Foundation, Inc.
|
|
17493
|
4
|
|
24357
|
5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
|
|
17493
|
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
|
|
|
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.
|
|
|
24
|
|
|
25 ;;; Commentary:
|
|
|
26
|
|
|
27 ;;; Code:
|
|
|
28
|
|
19522
|
29 (eval-when-compile (require 'cl))
|
|
|
30
|
|
17493
|
31 (require 'nnheader)
|
|
|
32 (require 'message)
|
|
|
33 (require 'custom)
|
|
24357
|
34 (require 'gnus-util)
|
|
31716
|
35 (require 'mail-source)
|
|
|
36 (require 'mm-util)
|
|
17493
|
37
|
|
|
38 (eval-and-compile
|
|
24357
|
39 (autoload 'gnus-error "gnus-util")
|
|
31716
|
40 (autoload 'gnus-buffer-live-p "gnus-util"))
|
|
17493
|
41
|
|
|
42 (defgroup nnmail nil
|
|
|
43 "Reading mail with Gnus."
|
|
|
44 :group 'gnus)
|
|
|
45
|
|
|
46 (defgroup nnmail-retrieve nil
|
|
|
47 "Retrieving new mail."
|
|
|
48 :group 'nnmail)
|
|
|
49
|
|
|
50 (defgroup nnmail-prepare nil
|
|
|
51 "Preparing (or mangling) new mail after retrival."
|
|
|
52 :group 'nnmail)
|
|
|
53
|
|
|
54 (defgroup nnmail-duplicate nil
|
|
|
55 "Handling of duplicate mail messages."
|
|
|
56 :group 'nnmail)
|
|
|
57
|
|
|
58 (defgroup nnmail-split nil
|
|
|
59 "Organizing the incomming mail in folders."
|
|
|
60 :group 'nnmail)
|
|
|
61
|
|
|
62 (defgroup nnmail-files nil
|
|
|
63 "Mail files."
|
|
|
64 :group 'gnus-files
|
|
|
65 :group 'nnmail)
|
|
|
66
|
|
|
67 (defgroup nnmail-expire nil
|
|
|
68 "Expiring old mail."
|
|
|
69 :group 'nnmail)
|
|
|
70
|
|
|
71 (defgroup nnmail-procmail nil
|
|
|
72 "Interfacing with procmail and other mail agents."
|
|
|
73 :group 'nnmail)
|
|
|
74
|
|
|
75 (defgroup nnmail-various nil
|
|
|
76 "Various mail options."
|
|
|
77 :group 'nnmail)
|
|
|
78
|
|
|
79 (defcustom nnmail-split-methods
|
|
|
80 '(("mail.misc" ""))
|
|
24357
|
81 "*Incoming mail will be split according to this variable.
|
|
17493
|
82
|
|
|
83 If you'd like, for instance, one mail group for mail from the
|
|
|
84 \"4ad-l\" mailing list, one group for junk mail and one for everything
|
|
|
85 else, you could do something like this:
|
|
|
86
|
|
|
87 (setq nnmail-split-methods
|
|
|
88 '((\"mail.4ad\" \"From:.*4ad\")
|
|
|
89 (\"mail.junk\" \"From:.*Lars\\\\|Subject:.*buy\")
|
|
|
90 (\"mail.misc\" \"\")))
|
|
|
91
|
|
|
92 As you can see, this variable is a list of lists, where the first
|
|
|
93 element in each \"rule\" is the name of the group (which, by the way,
|
|
|
94 does not have to be called anything beginning with \"mail\",
|
|
|
95 \"yonka.zow\" is a fine, fine name), and the second is a regexp that
|
|
|
96 nnmail will try to match on the header to find a fit.
|
|
|
97
|
|
|
98 The second element can also be a function. In that case, it will be
|
|
|
99 called narrowed to the headers with the first element of the rule as
|
|
|
100 the argument. It should return a non-nil value if it thinks that the
|
|
|
101 mail belongs in that group.
|
|
|
102
|
|
|
103 The last element should always have \"\" as the regexp.
|
|
|
104
|
|
|
105 This variable can also have a function as its value."
|
|
|
106 :group 'nnmail-split
|
|
|
107 :type '(choice (repeat :tag "Alist" (group (string :tag "Name") regexp))
|
|
|
108 (function-item nnmail-split-fancy)
|
|
|
109 (function :tag "Other")))
|
|
|
110
|
|
|
111 ;; Suggested by Erik Selberg <speed@cs.washington.edu>.
|
|
|
112 (defcustom nnmail-crosspost t
|
|
|
113 "If non-nil, do crossposting if several split methods match the mail.
|
|
|
114 If nil, the first match found will be used."
|
|
|
115 :group 'nnmail-split
|
|
|
116 :type 'boolean)
|
|
|
117
|
|
|
118 ;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit).
|
|
|
119 (defcustom nnmail-keep-last-article nil
|
|
19969
|
120 "If non-nil, nnmail will never delete/move a group's last article.
|
|
|
121 It can be marked expirable, so it will be deleted when it is no longer last.
|
|
|
122
|
|
17493
|
123 You may need to set this variable if other programs are putting
|
|
|
124 new mail into folder numbers that Gnus has marked as expired."
|
|
|
125 :group 'nnmail-procmail
|
|
|
126 :group 'nnmail-various
|
|
|
127 :type 'boolean)
|
|
|
128
|
|
|
129 (defcustom nnmail-use-long-file-names nil
|
|
|
130 "If non-nil the mail backends will use long file and directory names.
|
|
|
131 If nil, groups like \"mail.misc\" will end up in directories like
|
|
|
132 \"mail/misc/\"."
|
|
|
133 :group 'nnmail-files
|
|
|
134 :type 'boolean)
|
|
|
135
|
|
|
136 (defcustom nnmail-default-file-modes 384
|
|
|
137 "Set the mode bits of all new mail files to this integer."
|
|
|
138 :group 'nnmail-files
|
|
|
139 :type 'integer)
|
|
|
140
|
|
|
141 (defcustom nnmail-expiry-wait 7
|
|
|
142 "*Expirable articles that are older than this will be expired.
|
|
|
143 This variable can either be a number (which will be interpreted as a
|
|
|
144 number of days) -- this doesn't have to be an integer. This variable
|
|
|
145 can also be `immediate' and `never'."
|
|
|
146 :group 'nnmail-expire
|
|
|
147 :type '(choice (const immediate)
|
|
|
148 (integer :tag "days")
|
|
|
149 (const never)))
|
|
|
150
|
|
|
151 (defcustom nnmail-expiry-wait-function nil
|
|
|
152 "Variable that holds function to specify how old articles should be before they are expired.
|
|
|
153 The function will be called with the name of the group that the
|
|
|
154 expiry is to be performed in, and it should return an integer that
|
|
|
155 says how many days an article can be stored before it is considered
|
|
|
156 \"old\". It can also return the values `never' and `immediate'.
|
|
|
157
|
|
|
158 Eg.:
|
|
|
159
|
|
|
160 \(setq nnmail-expiry-wait-function
|
|
|
161 (lambda (newsgroup)
|
|
|
162 (cond ((string-match \"private\" newsgroup) 31)
|
|
|
163 ((string-match \"junk\" newsgroup) 1)
|
|
|
164 ((string-match \"important\" newsgroup) 'never)
|
|
|
165 (t 7))))"
|
|
|
166 :group 'nnmail-expire
|
|
|
167 :type '(choice (const :tag "nnmail-expiry-wait" nil)
|
|
|
168 (function :format "%v" nnmail-)))
|
|
|
169
|
|
31716
|
170 (defcustom nnmail-expiry-target 'delete
|
|
|
171 "*Variable that says where expired messages should end up.
|
|
|
172 The default value is `delete' (which says to delete the messages),
|
|
|
173 but it can also be a string or a function. If it is a string, expired
|
|
|
174 messages end up in that group. If it is a function, the function is
|
|
|
175 called in a buffer narrowed to the message in question. The function
|
|
|
176 receives one argument, the name of the group the message comes from.
|
|
|
177 The return value should be `delete' or a group name (a string)."
|
|
33398
|
178 :version "21.1"
|
|
31716
|
179 :group 'nnmail-expire
|
|
|
180 :type '(choice (const delete)
|
|
|
181 (function :format "%v" nnmail-)
|
|
|
182 string))
|
|
|
183
|
|
17493
|
184 (defcustom nnmail-cache-accepted-message-ids nil
|
|
|
185 "If non-nil, put Message-IDs of Gcc'd articles into the duplicate cache."
|
|
|
186 :group 'nnmail
|
|
|
187 :type 'boolean)
|
|
|
188
|
|
32101
|
189 (defcustom nnmail-spool-file '((file))
|
|
24357
|
190 "*Where the mail backends will look for incoming mail.
|
|
31716
|
191 This variable is a list of mail source specifiers.
|
|
|
192 This variable is obsolete; `mail-sources' should be used instead."
|
|
17493
|
193 :group 'nnmail-files
|
|
31716
|
194 :type 'sexp)
|
|
17493
|
195
|
|
31716
|
196 (defcustom nnmail-resplit-incoming nil
|
|
|
197 "*If non-nil, re-split incoming procmail sorted mail."
|
|
17493
|
198 :group 'nnmail-procmail
|
|
|
199 :type 'boolean)
|
|
|
200
|
|
31716
|
201 (defcustom nnmail-scan-directory-mail-source-once nil
|
|
|
202 "*If non-nil, scan all incoming procmail sorted mails once.
|
|
|
203 It scans low-level sorted spools even when not required."
|
|
33398
|
204 :version "21.1"
|
|
17493
|
205 :group 'nnmail-procmail
|
|
|
206 :type 'boolean)
|
|
|
207
|
|
|
208 (defcustom nnmail-delete-file-function 'delete-file
|
|
|
209 "Function called to delete files in some mail backends."
|
|
|
210 :group 'nnmail-files
|
|
|
211 :type 'function)
|
|
|
212
|
|
|
213 (defcustom nnmail-crosspost-link-function
|
|
24357
|
214 (if (string-match "windows-nt\\|emx" (symbol-name system-type))
|
|
17493
|
215 'copy-file
|
|
|
216 'add-name-to-file)
|
|
24357
|
217 "*Function called to create a copy of a file.
|
|
17493
|
218 This is `add-name-to-file' by default, which means that crossposts
|
|
|
219 will use hard links. If your file system doesn't allow hard
|
|
|
220 links, you could set this variable to `copy-file' instead."
|
|
|
221 :group 'nnmail-files
|
|
|
222 :type '(radio (function-item add-name-to-file)
|
|
|
223 (function-item copy-file)
|
|
|
224 (function :tag "Other")))
|
|
|
225
|
|
|
226 (defcustom nnmail-read-incoming-hook
|
|
|
227 (if (eq system-type 'windows-nt)
|
|
|
228 '(nnheader-ms-strip-cr)
|
|
|
229 nil)
|
|
24357
|
230 "*Hook that will be run after the incoming mail has been transferred.
|
|
31785
|
231 The incoming mail is moved from the specified spool file (which normally is
|
|
17493
|
232 something like \"/usr/spool/mail/$user\") to the user's home
|
|
|
233 directory. This hook is called after the incoming mail box has been
|
|
|
234 emptied, and can be used to call any mail box programs you have
|
|
|
235 running (\"xwatch\", etc.)
|
|
|
236
|
|
|
237 Eg.
|
|
|
238
|
|
|
239 \(add-hook 'nnmail-read-incoming-hook
|
|
31716
|
240 (lambda ()
|
|
|
241 (call-process \"/local/bin/mailsend\" nil nil nil
|
|
|
242 \"read\" nnmail-spool-file)))
|
|
17493
|
243
|
|
|
244 If you have xwatch running, this will alert it that mail has been
|
|
|
245 read.
|
|
|
246
|
|
|
247 If you use `display-time', you could use something like this:
|
|
|
248
|
|
|
249 \(add-hook 'nnmail-read-incoming-hook
|
|
|
250 (lambda ()
|
|
|
251 ;; Update the displayed time, since that will clear out
|
|
|
252 ;; the flag that says you have mail.
|
|
|
253 (when (eq (process-status \"display-time\") 'run)
|
|
|
254 (display-time-filter display-time-process \"\"))))"
|
|
|
255 :group 'nnmail-prepare
|
|
|
256 :type 'hook)
|
|
|
257
|
|
|
258 (defcustom nnmail-prepare-incoming-hook nil
|
|
|
259 "Hook called before treating incoming mail.
|
|
|
260 The hook is run in a buffer with all the new, incoming mail."
|
|
|
261 :group 'nnmail-prepare
|
|
|
262 :type 'hook)
|
|
|
263
|
|
|
264 (defcustom nnmail-prepare-incoming-header-hook nil
|
|
|
265 "Hook called narrowed to the headers of each message.
|
|
|
266 This can be used to remove excessive spaces (and stuff like
|
|
|
267 that) from the headers before splitting and saving the messages."
|
|
|
268 :group 'nnmail-prepare
|
|
|
269 :type 'hook)
|
|
|
270
|
|
|
271 (defcustom nnmail-prepare-incoming-message-hook nil
|
|
|
272 "Hook called narrowed to each message."
|
|
|
273 :group 'nnmail-prepare
|
|
|
274 :type 'hook)
|
|
|
275
|
|
|
276 (defcustom nnmail-list-identifiers nil
|
|
|
277 "Regexp that matches list identifiers to be removed.
|
|
|
278 This can also be a list of regexps."
|
|
|
279 :group 'nnmail-prepare
|
|
|
280 :type '(choice (const :tag "none" nil)
|
|
24357
|
281 (regexp :value ".*")
|
|
|
282 (repeat :value (".*") regexp)))
|
|
17493
|
283
|
|
|
284 (defcustom nnmail-pre-get-new-mail-hook nil
|
|
|
285 "Hook called just before starting to handle new incoming mail."
|
|
|
286 :group 'nnmail-retrieve
|
|
|
287 :type 'hook)
|
|
|
288
|
|
|
289 (defcustom nnmail-post-get-new-mail-hook nil
|
|
|
290 "Hook called just after finishing handling new incoming mail."
|
|
|
291 :group 'nnmail-retrieve
|
|
|
292 :type 'hook)
|
|
|
293
|
|
|
294 (defcustom nnmail-split-hook nil
|
|
|
295 "Hook called before deciding where to split an article.
|
|
|
296 The functions in this hook are free to modify the buffer
|
|
|
297 contents in any way they choose -- the buffer contents are
|
|
|
298 discarded after running the split process."
|
|
|
299 :group 'nnmail-split
|
|
|
300 :type 'hook)
|
|
|
301
|
|
|
302 (defcustom nnmail-large-newsgroup 50
|
|
|
303 "*The number of the articles which indicates a large newsgroup.
|
|
|
304 If the number of the articles is greater than the value, verbose
|
|
|
305 messages will be shown to indicate the current status."
|
|
|
306 :group 'nnmail-various
|
|
|
307 :type 'integer)
|
|
|
308
|
|
|
309 (defcustom nnmail-split-fancy "mail.misc"
|
|
|
310 "Incoming mail can be split according to this fancy variable.
|
|
|
311 To enable this, set `nnmail-split-methods' to `nnmail-split-fancy'.
|
|
|
312
|
|
24357
|
313 The format of this variable is SPLIT, where SPLIT can be one of
|
|
17493
|
314 the following:
|
|
|
315
|
|
|
316 GROUP: Mail will be stored in GROUP (a string).
|
|
|
317
|
|
31716
|
318 \(FIELD VALUE [- RESTRICT [- RESTRICT [...]]] SPLIT): If the message
|
|
|
319 field FIELD (a regexp) contains VALUE (a regexp), store the messages
|
|
|
320 as specified by SPLIT. If RESTRICT (a regexp) matches some string
|
|
|
321 after FIELD and before the end of the matched VALUE, return NIL,
|
|
|
322 otherwise process SPLIT. Multiple RESTRICTs add up, further
|
|
|
323 restricting the possibility of processing SPLIT.
|
|
17493
|
324
|
|
|
325 \(| SPLIT...): Process each SPLIT expression until one of them matches.
|
|
|
326 A SPLIT expression is said to match if it will cause the mail
|
|
|
327 message to be stored in one or more groups.
|
|
|
328
|
|
|
329 \(& SPLIT...): Process each SPLIT expression.
|
|
|
330
|
|
|
331 \(: FUNCTION optional args): Call FUNCTION with the optional args, in
|
|
|
332 the buffer containing the message headers. The return value FUNCTION
|
|
|
333 should be a split, which is then recursively processed.
|
|
|
334
|
|
31716
|
335 \(! FUNCTION SPLIT): Call FUNCTION with the result of SPLIT. The
|
|
|
336 return value FUNCTION should be a split, which is then recursively
|
|
|
337 processed.
|
|
|
338
|
|
17493
|
339 FIELD must match a complete field name. VALUE must match a complete
|
|
|
340 word according to the `nnmail-split-fancy-syntax-table' syntax table.
|
|
|
341 You can use \".*\" in the regexps to match partial field names or words.
|
|
|
342
|
|
|
343 FIELD and VALUE can also be lisp symbols, in that case they are expanded
|
|
|
344 as specified in `nnmail-split-abbrev-alist'.
|
|
|
345
|
|
|
346 GROUP can contain \\& and \\N which will substitute from matching
|
|
|
347 \\(\\) patterns in the previous VALUE.
|
|
|
348
|
|
|
349 Example:
|
|
|
350
|
|
|
351 \(setq nnmail-split-methods 'nnmail-split-fancy
|
|
|
352 nnmail-split-fancy
|
|
|
353 ;; Messages from the mailer daemon are not crossposted to any of
|
|
|
354 ;; the ordinary groups. Warnings are put in a separate group
|
|
|
355 ;; from real errors.
|
|
|
356 '(| (\"from\" mail (| (\"subject\" \"warn.*\" \"mail.warning\")
|
|
|
357 \"mail.misc\"))
|
|
|
358 ;; Non-error messages are crossposted to all relevant
|
|
|
359 ;; groups, but we don't crosspost between the group for the
|
|
|
360 ;; (ding) list and the group for other (ding) related mail.
|
|
|
361 (& (| (any \"ding@ifi\\\\.uio\\\\.no\" \"ding.list\")
|
|
|
362 (\"subject\" \"ding\" \"ding.misc\"))
|
|
|
363 ;; Other mailing lists...
|
|
|
364 (any \"procmail@informatik\\\\.rwth-aachen\\\\.de\" \"procmail.list\")
|
|
|
365 (any \"SmartList@informatik\\\\.rwth-aachen\\\\.de\" \"SmartList.list\")
|
|
31716
|
366 ;; Both lists below have the same suffix, so prevent
|
|
|
367 ;; cross-posting to mkpkg.list of messages posted only to
|
|
|
368 ;; the bugs- list, but allow cross-posting when the
|
|
|
369 ;; message was really cross-posted.
|
|
|
370 (any \"bugs-mypackage@somewhere\" \"mypkg.bugs\")
|
|
|
371 (any \"mypackage@somewhere\" - \"bugs-mypackage\" \"mypkg.list\")
|
|
|
372 ;;
|
|
17493
|
373 ;; People...
|
|
|
374 (any \"larsi@ifi\\\\.uio\\\\.no\" \"people.Lars Magne Ingebrigtsen\"))
|
|
|
375 ;; Unmatched mail goes to the catch all group.
|
|
|
376 \"misc.misc\"))"
|
|
|
377 :group 'nnmail-split
|
|
|
378 ;; Sigh!
|
|
|
379 :type 'sexp)
|
|
|
380
|
|
|
381 (defcustom nnmail-split-abbrev-alist
|
|
|
382 '((any . "from\\|to\\|cc\\|sender\\|apparently-to\\|resent-from\\|resent-to\\|resent-cc")
|
|
|
383 (mail . "mailer-daemon\\|postmaster\\|uucp")
|
|
|
384 (to . "to\\|cc\\|apparently-to\\|resent-to\\|resent-cc")
|
|
19969
|
385 (from . "from\\|sender\\|resent-from")
|
|
|
386 (nato . "to\\|cc\\|resent-to\\|resent-cc")
|
|
|
387 (naany . "from\\|to\\|cc\\|sender\\|resent-from\\|resent-to\\|resent-cc"))
|
|
24357
|
388 "*Alist of abbreviations allowed in `nnmail-split-fancy'."
|
|
17493
|
389 :group 'nnmail-split
|
|
|
390 :type '(repeat (cons :format "%v" symbol regexp)))
|
|
|
391
|
|
|
392 (defcustom nnmail-message-id-cache-length 1000
|
|
|
393 "*The approximate number of Message-IDs nnmail will keep in its cache.
|
|
|
394 If this variable is nil, no checking on duplicate messages will be
|
|
|
395 performed."
|
|
|
396 :group 'nnmail-duplicate
|
|
|
397 :type '(choice (const :tag "disable" nil)
|
|
|
398 (integer :format "%v")))
|
|
|
399
|
|
|
400 (defcustom nnmail-message-id-cache-file "~/.nnmail-cache"
|
|
|
401 "*The file name of the nnmail Message-ID cache."
|
|
|
402 :group 'nnmail-duplicate
|
|
|
403 :group 'nnmail-files
|
|
|
404 :type 'file)
|
|
|
405
|
|
|
406 (defcustom nnmail-treat-duplicates 'warn
|
|
|
407 "*If non-nil, nnmail keep a cache of Message-IDs to discover mail duplicates.
|
|
31716
|
408 Three values are valid: nil, which means that nnmail is not to keep a
|
|
17493
|
409 Message-ID cache; `warn', which means that nnmail should insert extra
|
|
|
410 headers to warn the user about the duplication (this is the default);
|
|
|
411 and `delete', which means that nnmail will delete duplicated mails.
|
|
|
412
|
|
|
413 This variable can also be a function. It will be called from a buffer
|
|
|
414 narrowed to the article in question with the Message-ID as a
|
|
|
415 parameter. It should return nil, `warn' or `delete'."
|
|
|
416 :group 'nnmail-duplicate
|
|
|
417 :type '(choice (const :tag "off" nil)
|
|
|
418 (const warn)
|
|
|
419 (const delete)))
|
|
|
420
|
|
31716
|
421 (defcustom nnmail-extra-headers nil
|
|
|
422 "*Extra headers to parse."
|
|
33398
|
423 :version "21.1"
|
|
31716
|
424 :group 'nnmail
|
|
|
425 :type '(repeat symbol))
|
|
|
426
|
|
|
427 (defcustom nnmail-split-header-length-limit 512
|
|
|
428 "Header lines longer than this limit are excluded from the split function."
|
|
33398
|
429 :version "21.1"
|
|
31716
|
430 :group 'nnmail
|
|
|
431 :type 'integer)
|
|
|
432
|
|
17493
|
433 ;;; Internal variables.
|
|
|
434
|
|
|
435 (defvar nnmail-split-history nil
|
|
|
436 "List of group/article elements that say where the previous split put messages.")
|
|
|
437
|
|
|
438 (defvar nnmail-split-fancy-syntax-table nil
|
|
|
439 "Syntax table used by `nnmail-split-fancy'.")
|
|
|
440 (unless (syntax-table-p nnmail-split-fancy-syntax-table)
|
|
|
441 (setq nnmail-split-fancy-syntax-table
|
|
|
442 (copy-syntax-table (standard-syntax-table)))
|
|
|
443 ;; support the %-hack
|
|
|
444 (modify-syntax-entry ?\% "." nnmail-split-fancy-syntax-table))
|
|
|
445
|
|
|
446 (defvar nnmail-prepare-save-mail-hook nil
|
|
|
447 "Hook called before saving mail.")
|
|
|
448
|
|
24357
|
449 (defvar nnmail-split-tracing nil)
|
|
|
450 (defvar nnmail-split-trace nil)
|
|
|
451
|
|
17493
|
452
|
|
|
453
|
|
|
454 (defconst nnmail-version "nnmail 1.0"
|
|
|
455 "nnmail version.")
|
|
|
456
|
|
|
457
|
|
|
458
|
|
|
459 (defun nnmail-request-post (&optional server)
|
|
|
460 (mail-send-and-exit nil))
|
|
|
461
|
|
24357
|
462 (defvar nnmail-file-coding-system 'raw-text
|
|
|
463 "Coding system used in nnmail.")
|
|
|
464
|
|
31716
|
465 (defvar nnmail-incoming-coding-system
|
|
|
466 mm-text-coding-system
|
|
|
467 "Coding system used in reading inbox")
|
|
|
468
|
38861
f8833aa83b5e
* gnus-art.el (gnus-output-to-file): Bind file-name-coding-system.
ShengHuo ZHU <zsh@cs.rochester.edu>
diff
changeset
|
469 (defvar nnmail-pathname-coding-system nil
|
|
31716
|
470 "*Coding system for pathname.")
|
|
19593
|
471
|
|
17493
|
472 (defun nnmail-find-file (file)
|
|
|
473 "Insert FILE in server buffer safely."
|
|
|
474 (set-buffer nntp-server-buffer)
|
|
31716
|
475 (delete-region (point-min) (point-max))
|
|
17493
|
476 (let ((format-alist nil)
|
|
|
477 (after-insert-file-functions nil))
|
|
|
478 (condition-case ()
|
|
19593
|
479 (let ((coding-system-for-read nnmail-file-coding-system)
|
|
31716
|
480 (auto-mode-alist (mm-auto-mode-alist))
|
|
|
481 (file-name-coding-system nnmail-pathname-coding-system))
|
|
19593
|
482 (insert-file-contents file)
|
|
|
483 t)
|
|
17493
|
484 (file-error nil))))
|
|
|
485
|
|
|
486 (defun nnmail-group-pathname (group dir &optional file)
|
|
|
487 "Make pathname for GROUP."
|
|
|
488 (concat
|
|
|
489 (let ((dir (file-name-as-directory (expand-file-name dir))))
|
|
31716
|
490 (setq group (nnheader-replace-duplicate-chars-in-string
|
|
|
491 (nnheader-replace-chars-in-string group ?/ ?_)
|
|
|
492 ?. ?_))
|
|
24357
|
493 (setq group (nnheader-translate-file-chars group))
|
|
17493
|
494 ;; If this directory exists, we use it directly.
|
|
31716
|
495 (file-name-as-directory
|
|
|
496 (if (or nnmail-use-long-file-names
|
|
|
497 (file-directory-p (concat dir group)))
|
|
|
498 (expand-file-name group dir)
|
|
|
499 ;; If not, we translate dots into slashes.
|
|
|
500 (expand-file-name
|
|
|
501 (mm-encode-coding-string
|
|
|
502 (nnheader-replace-chars-in-string group ?. ?/)
|
|
|
503 nnmail-pathname-coding-system)
|
|
|
504 dir))))
|
|
17493
|
505 (or file "")))
|
|
|
506
|
|
|
507 (defun nnmail-get-active ()
|
|
|
508 "Returns an assoc of group names and active ranges.
|
|
|
509 nn*-request-list should have been called before calling this function."
|
|
31716
|
510 ;; Go through all groups from the active list.
|
|
|
511 (save-excursion
|
|
|
512 (set-buffer nntp-server-buffer)
|
|
|
513 (nnmail-parse-active)))
|
|
|
514
|
|
|
515 (defun nnmail-parse-active ()
|
|
|
516 "Parse the active file in the current buffer and return an alist."
|
|
|
517 (goto-char (point-min))
|
|
|
518 (unless (re-search-forward "[\\\"]" nil t)
|
|
|
519 (goto-char (point-max))
|
|
|
520 (while (re-search-backward "[][';?()#]" nil t)
|
|
|
521 (insert ?\\)))
|
|
|
522 (goto-char (point-min))
|
|
|
523 (let ((buffer (current-buffer))
|
|
|
524 group-assoc group max min)
|
|
|
525 (while (not (eobp))
|
|
|
526 (condition-case err
|
|
|
527 (progn
|
|
|
528 (narrow-to-region (point) (gnus-point-at-eol))
|
|
|
529 (setq group (read buffer))
|
|
|
530 (unless (stringp group)
|
|
|
531 (setq group (symbol-name group)))
|
|
|
532 (if (and (numberp (setq max (read nntp-server-buffer)))
|
|
|
533 (numberp (setq min (read nntp-server-buffer))))
|
|
|
534 (push (list group (cons min max))
|
|
|
535 group-assoc)))
|
|
|
536 (error nil))
|
|
|
537 (widen)
|
|
|
538 (forward-line 1))
|
|
17493
|
539 group-assoc))
|
|
|
540
|
|
31716
|
541 (defvar nnmail-active-file-coding-system 'raw-text
|
|
19593
|
542 "*Coding system for active file.")
|
|
|
543
|
|
17493
|
544 (defun nnmail-save-active (group-assoc file-name)
|
|
|
545 "Save GROUP-ASSOC in ACTIVE-FILE."
|
|
19593
|
546 (let ((coding-system-for-write nnmail-active-file-coding-system))
|
|
|
547 (when file-name
|
|
31716
|
548 (with-temp-file file-name
|
|
19593
|
549 (nnmail-generate-active group-assoc)))))
|
|
17493
|
550
|
|
|
551 (defun nnmail-generate-active (alist)
|
|
|
552 "Generate an active file from group-alist ALIST."
|
|
|
553 (erase-buffer)
|
|
|
554 (let (group)
|
|
|
555 (while (setq group (pop alist))
|
|
31716
|
556 (insert (format "%S %d %d y\n" (intern (car group)) (cdadr group)
|
|
|
557 (caadr group))))
|
|
|
558 (goto-char (point-max))
|
|
|
559 (while (search-backward "\\." nil t)
|
|
|
560 (delete-char 1))))
|
|
17493
|
561
|
|
31716
|
562 (defun nnmail-get-split-group (file source)
|
|
17493
|
563 "Find out whether this FILE is to be split into GROUP only.
|
|
31716
|
564 If SOURCE is a directory spec, try to return the group name component."
|
|
|
565 (if (eq (car source) 'directory)
|
|
|
566 (let ((file (file-name-nondirectory file)))
|
|
|
567 (mail-source-bind (directory source)
|
|
|
568 (if (string-match (concat (regexp-quote suffix) "$") file)
|
|
|
569 (substring file 0 (match-beginning 0))
|
|
|
570 nil)))
|
|
|
571 nil))
|
|
17493
|
572
|
|
|
573 (defun nnmail-process-babyl-mail-format (func artnum-func)
|
|
|
574 (let ((case-fold-search t)
|
|
31716
|
575 (count 0)
|
|
17493
|
576 start message-id content-length do-search end)
|
|
|
577 (while (not (eobp))
|
|
24357
|
578 (goto-char (point-min))
|
|
17493
|
579 (re-search-forward
|
|
|
580 " \n0, *unseen,+\n\\(\\*\\*\\* EOOH \\*\\*\\*\n\\)?" nil t)
|
|
|
581 (goto-char (match-end 0))
|
|
|
582 (delete-region (match-beginning 0) (match-end 0))
|
|
|
583 (narrow-to-region
|
|
|
584 (setq start (point))
|
|
|
585 (progn
|
|
|
586 ;; Skip all the headers in case there are more "From "s...
|
|
|
587 (or (search-forward "\n\n" nil t)
|
|
|
588 (search-forward-regexp "^[^:]*\\( .*\\|\\)$" nil t)
|
|
|
589 (search-forward " "))
|
|
|
590 (point)))
|
|
|
591 ;; Unquote the ">From " line, if any.
|
|
|
592 (goto-char (point-min))
|
|
|
593 (when (looking-at ">From ")
|
|
|
594 (replace-match "X-From-Line: ") )
|
|
|
595 (run-hooks 'nnmail-prepare-incoming-header-hook)
|
|
|
596 (goto-char (point-max))
|
|
|
597 ;; Find the Message-ID header.
|
|
|
598 (save-excursion
|
|
|
599 (if (re-search-backward
|
|
|
600 "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]*>\\)" nil t)
|
|
|
601 (setq message-id (buffer-substring (match-beginning 1)
|
|
|
602 (match-end 1)))
|
|
|
603 ;; There is no Message-ID here, so we create one.
|
|
|
604 (save-excursion
|
|
|
605 (when (re-search-backward "^Message-ID[ \t]*:" nil t)
|
|
|
606 (beginning-of-line)
|
|
|
607 (insert "Original-")))
|
|
|
608 (forward-line -1)
|
|
|
609 (insert "Message-ID: " (setq message-id (nnmail-message-id))
|
|
|
610 "\n")))
|
|
|
611 ;; Look for a Content-Length header.
|
|
|
612 (if (not (save-excursion
|
|
|
613 (and (re-search-backward
|
|
|
614 "^Content-Length:[ \t]*\\([0-9]+\\)" start t)
|
|
|
615 (setq content-length (string-to-int
|
|
|
616 (buffer-substring
|
|
|
617 (match-beginning 1)
|
|
|
618 (match-end 1))))
|
|
|
619 ;; We destroy the header, since none of
|
|
|
620 ;; the backends ever use it, and we do not
|
|
|
621 ;; want to confuse other mailers by having
|
|
|
622 ;; a (possibly) faulty header.
|
|
|
623 (progn (insert "X-") t))))
|
|
|
624 (setq do-search t)
|
|
|
625 (widen)
|
|
|
626 (if (or (= (+ (point) content-length) (point-max))
|
|
|
627 (save-excursion
|
|
|
628 (goto-char (+ (point) content-length))
|
|
|
629 (looking-at " ")))
|
|
|
630 (progn
|
|
|
631 (goto-char (+ (point) content-length))
|
|
|
632 (setq do-search nil))
|
|
|
633 (setq do-search t)))
|
|
|
634 (widen)
|
|
|
635 ;; Go to the beginning of the next article - or to the end
|
|
|
636 ;; of the buffer.
|
|
|
637 (when do-search
|
|
|
638 (if (re-search-forward "^ " nil t)
|
|
|
639 (goto-char (match-beginning 0))
|
|
|
640 (goto-char (1- (point-max)))))
|
|
|
641 (delete-char 1) ; delete ^_
|
|
|
642 (save-excursion
|
|
|
643 (save-restriction
|
|
|
644 (narrow-to-region start (point))
|
|
|
645 (goto-char (point-min))
|
|
|
646 (nnmail-check-duplication message-id func artnum-func)
|
|
31716
|
647 (incf count)
|
|
17493
|
648 (setq end (point-max))))
|
|
31716
|
649 (goto-char end))
|
|
|
650 count))
|
|
17493
|
651
|
|
|
652 (defsubst nnmail-search-unix-mail-delim ()
|
|
|
653 "Put point at the beginning of the next Unix mbox message."
|
|
|
654 ;; Algorithm used to find the the next article in the
|
|
|
655 ;; brain-dead Unix mbox format:
|
|
|
656 ;;
|
|
|
657 ;; 1) Search for "^From ".
|
|
|
658 ;; 2) If we find it, then see whether the previous
|
|
|
659 ;; line is blank and the next line looks like a header.
|
|
|
660 ;; Then it's possible that this is a mail delim, and we use it.
|
|
|
661 (let ((case-fold-search nil)
|
|
|
662 found)
|
|
|
663 (while (not found)
|
|
|
664 (if (not (re-search-forward "^From " nil t))
|
|
|
665 (setq found 'no)
|
|
|
666 (save-excursion
|
|
|
667 (beginning-of-line)
|
|
|
668 (when (and (or (bobp)
|
|
|
669 (save-excursion
|
|
|
670 (forward-line -1)
|
|
31716
|
671 (eq (char-after) ?\n)))
|
|
17493
|
672 (save-excursion
|
|
|
673 (forward-line 1)
|
|
19969
|
674 (while (looking-at ">From \\|From ")
|
|
17493
|
675 (forward-line 1))
|
|
|
676 (looking-at "[^ \n\t:]+[ \n\t]*:")))
|
|
|
677 (setq found 'yes)))))
|
|
|
678 (beginning-of-line)
|
|
|
679 (eq found 'yes)))
|
|
|
680
|
|
|
681 (defun nnmail-search-unix-mail-delim-backward ()
|
|
|
682 "Put point at the beginning of the current Unix mbox message."
|
|
|
683 ;; Algorithm used to find the the next article in the
|
|
|
684 ;; brain-dead Unix mbox format:
|
|
|
685 ;;
|
|
|
686 ;; 1) Search for "^From ".
|
|
|
687 ;; 2) If we find it, then see whether the previous
|
|
|
688 ;; line is blank and the next line looks like a header.
|
|
|
689 ;; Then it's possible that this is a mail delim, and we use it.
|
|
|
690 (let ((case-fold-search nil)
|
|
|
691 found)
|
|
|
692 (while (not found)
|
|
|
693 (if (not (re-search-backward "^From " nil t))
|
|
|
694 (setq found 'no)
|
|
|
695 (save-excursion
|
|
|
696 (beginning-of-line)
|
|
|
697 (when (and (or (bobp)
|
|
|
698 (save-excursion
|
|
|
699 (forward-line -1)
|
|
31716
|
700 (eq (char-after) ?\n)))
|
|
17493
|
701 (save-excursion
|
|
|
702 (forward-line 1)
|
|
19969
|
703 (while (looking-at ">From \\|From ")
|
|
17493
|
704 (forward-line 1))
|
|
|
705 (looking-at "[^ \n\t:]+[ \n\t]*:")))
|
|
|
706 (setq found 'yes)))))
|
|
|
707 (beginning-of-line)
|
|
|
708 (eq found 'yes)))
|
|
|
709
|
|
|
710 (defun nnmail-process-unix-mail-format (func artnum-func)
|
|
|
711 (let ((case-fold-search t)
|
|
31716
|
712 (count 0)
|
|
17493
|
713 start message-id content-length end skip head-end)
|
|
|
714 (goto-char (point-min))
|
|
|
715 (if (not (and (re-search-forward "^From " nil t)
|
|
|
716 (goto-char (match-beginning 0))))
|
|
|
717 ;; Possibly wrong format?
|
|
31716
|
718 (error "Error, unknown mail format! (Possibly corrupted.)")
|
|
17493
|
719 ;; Carry on until the bitter end.
|
|
|
720 (while (not (eobp))
|
|
|
721 (setq start (point)
|
|
|
722 end nil)
|
|
|
723 ;; Find the end of the head.
|
|
|
724 (narrow-to-region
|
|
|
725 start
|
|
|
726 (if (search-forward "\n\n" nil t)
|
|
|
727 (1- (point))
|
|
|
728 ;; This will never happen, but just to be on the safe side --
|
|
|
729 ;; if there is no head-body delimiter, we search a bit manually.
|
|
|
730 (while (and (looking-at "From \\|[^ \t]+:")
|
|
|
731 (not (eobp)))
|
|
|
732 (forward-line 1))
|
|
|
733 (point)))
|
|
|
734 ;; Find the Message-ID header.
|
|
|
735 (goto-char (point-min))
|
|
|
736 (if (re-search-forward "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]+>\\)" nil t)
|
|
|
737 (setq message-id (match-string 1))
|
|
|
738 (save-excursion
|
|
|
739 (when (re-search-forward "^Message-ID[ \t]*:" nil t)
|
|
|
740 (beginning-of-line)
|
|
|
741 (insert "Original-")))
|
|
|
742 ;; There is no Message-ID here, so we create one.
|
|
|
743 (forward-line 1)
|
|
|
744 (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
|
|
|
745 ;; Look for a Content-Length header.
|
|
|
746 (goto-char (point-min))
|
|
|
747 (if (not (re-search-forward
|
|
|
748 "^Content-Length:[ \t]*\\([0-9]+\\)" nil t))
|
|
|
749 (setq content-length nil)
|
|
|
750 (setq content-length (string-to-int (match-string 1)))
|
|
|
751 ;; We destroy the header, since none of the backends ever
|
|
|
752 ;; use it, and we do not want to confuse other mailers by
|
|
|
753 ;; having a (possibly) faulty header.
|
|
|
754 (beginning-of-line)
|
|
|
755 (insert "X-"))
|
|
|
756 (run-hooks 'nnmail-prepare-incoming-header-hook)
|
|
|
757 ;; Find the end of this article.
|
|
|
758 (goto-char (point-max))
|
|
|
759 (widen)
|
|
|
760 (setq head-end (point))
|
|
|
761 ;; We try the Content-Length value. The idea: skip over the header
|
|
|
762 ;; separator, then check what happens content-length bytes into the
|
|
|
763 ;; message body. This should be either the end ot the buffer, the
|
|
|
764 ;; message separator or a blank line followed by the separator.
|
|
|
765 ;; The blank line should probably be deleted. If neither of the
|
|
|
766 ;; three is met, the content-length header is probably invalid.
|
|
|
767 (when content-length
|
|
|
768 (forward-line 1)
|
|
|
769 (setq skip (+ (point) content-length))
|
|
|
770 (goto-char skip)
|
|
|
771 (cond ((or (= skip (point-max))
|
|
|
772 (= (1+ skip) (point-max)))
|
|
|
773 (setq end (point-max)))
|
|
|
774 ((looking-at "From ")
|
|
|
775 (setq end skip))
|
|
|
776 ((looking-at "[ \t]*\n\\(From \\)")
|
|
|
777 (setq end (match-beginning 1)))
|
|
|
778 (t (setq end nil))))
|
|
|
779 (if end
|
|
|
780 (goto-char end)
|
|
|
781 ;; No Content-Length, so we find the beginning of the next
|
|
|
782 ;; article or the end of the buffer.
|
|
|
783 (goto-char head-end)
|
|
|
784 (or (nnmail-search-unix-mail-delim)
|
|
|
785 (goto-char (point-max))))
|
|
|
786 ;; Allow the backend to save the article.
|
|
|
787 (save-excursion
|
|
|
788 (save-restriction
|
|
|
789 (narrow-to-region start (point))
|
|
|
790 (goto-char (point-min))
|
|
31716
|
791 (incf count)
|
|
17493
|
792 (nnmail-check-duplication message-id func artnum-func)
|
|
|
793 (setq end (point-max))))
|
|
31716
|
794 (goto-char end)))
|
|
|
795 count))
|
|
17493
|
796
|
|
|
797 (defun nnmail-process-mmdf-mail-format (func artnum-func)
|
|
|
798 (let ((delim "^\^A\^A\^A\^A$")
|
|
|
799 (case-fold-search t)
|
|
31716
|
800 (count 0)
|
|
17493
|
801 start message-id end)
|
|
|
802 (goto-char (point-min))
|
|
|
803 (if (not (and (re-search-forward delim nil t)
|
|
|
804 (forward-line 1)))
|
|
|
805 ;; Possibly wrong format?
|
|
31716
|
806 (error "Error, unknown mail format! (Possibly corrupted.)")
|
|
17493
|
807 ;; Carry on until the bitter end.
|
|
|
808 (while (not (eobp))
|
|
|
809 (setq start (point))
|
|
|
810 ;; Find the end of the head.
|
|
|
811 (narrow-to-region
|
|
|
812 start
|
|
|
813 (if (search-forward "\n\n" nil t)
|
|
|
814 (1- (point))
|
|
|
815 ;; This will never happen, but just to be on the safe side --
|
|
|
816 ;; if there is no head-body delimiter, we search a bit manually.
|
|
|
817 (while (and (looking-at "From \\|[^ \t]+:")
|
|
|
818 (not (eobp)))
|
|
|
819 (forward-line 1))
|
|
|
820 (point)))
|
|
|
821 ;; Find the Message-ID header.
|
|
|
822 (goto-char (point-min))
|
|
|
823 (if (re-search-forward "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]+>\\)" nil t)
|
|
|
824 (setq message-id (match-string 1))
|
|
|
825 ;; There is no Message-ID here, so we create one.
|
|
|
826 (save-excursion
|
|
|
827 (when (re-search-backward "^Message-ID[ \t]*:" nil t)
|
|
|
828 (beginning-of-line)
|
|
|
829 (insert "Original-")))
|
|
|
830 (forward-line 1)
|
|
|
831 (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
|
|
|
832 (run-hooks 'nnmail-prepare-incoming-header-hook)
|
|
|
833 ;; Find the end of this article.
|
|
|
834 (goto-char (point-max))
|
|
|
835 (widen)
|
|
|
836 (if (re-search-forward delim nil t)
|
|
|
837 (beginning-of-line)
|
|
|
838 (goto-char (point-max)))
|
|
|
839 ;; Allow the backend to save the article.
|
|
|
840 (save-excursion
|
|
|
841 (save-restriction
|
|
|
842 (narrow-to-region start (point))
|
|
|
843 (goto-char (point-min))
|
|
31716
|
844 (incf count)
|
|
17493
|
845 (nnmail-check-duplication message-id func artnum-func)
|
|
|
846 (setq end (point-max))))
|
|
|
847 (goto-char end)
|
|
31716
|
848 (forward-line 2)))
|
|
|
849 count))
|
|
|
850
|
|
|
851 (defun nnmail-process-maildir-mail-format (func artnum-func)
|
|
|
852 ;; In a maildir, every file contains exactly one mail.
|
|
|
853 (let ((case-fold-search t)
|
|
|
854 message-id)
|
|
|
855 (goto-char (point-min))
|
|
|
856 ;; Find the end of the head.
|
|
|
857 (narrow-to-region
|
|
|
858 (point-min)
|
|
|
859 (if (search-forward "\n\n" nil t)
|
|
|
860 (1- (point))
|
|
|
861 ;; This will never happen, but just to be on the safe side --
|
|
|
862 ;; if there is no head-body delimiter, we search a bit manually.
|
|
|
863 (while (and (looking-at "From \\|[^ \t]+:")
|
|
|
864 (not (eobp)))
|
|
|
865 (forward-line 1))
|
|
|
866 (point)))
|
|
|
867 ;; Find the Message-ID header.
|
|
|
868 (goto-char (point-min))
|
|
|
869 (if (re-search-forward "^Message-ID:[ \t]*\\(<[^>]+>\\)" nil t)
|
|
|
870 (setq message-id (match-string 1))
|
|
|
871 ;; There is no Message-ID here, so we create one.
|
|
|
872 (save-excursion
|
|
|
873 (when (re-search-backward "^Message-ID[ \t]*:" nil t)
|
|
|
874 (beginning-of-line)
|
|
|
875 (insert "Original-")))
|
|
|
876 (forward-line 1)
|
|
|
877 (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
|
|
|
878 (run-hooks 'nnmail-prepare-incoming-header-hook)
|
|
|
879 ;; Allow the backend to save the article.
|
|
|
880 (widen)
|
|
|
881 (save-excursion
|
|
|
882 (goto-char (point-min))
|
|
|
883 (nnmail-check-duplication message-id func artnum-func))
|
|
|
884 1))
|
|
17493
|
885
|
|
|
886 (defun nnmail-split-incoming (incoming func &optional exit-func
|
|
|
887 group artnum-func)
|
|
|
888 "Go through the entire INCOMING file and pick out each individual mail.
|
|
|
889 FUNC will be called with the buffer narrowed to each mail."
|
|
|
890 (let (;; If this is a group-specific split, we bind the split
|
|
|
891 ;; methods to just this group.
|
|
|
892 (nnmail-split-methods (if (and group
|
|
|
893 (not nnmail-resplit-incoming))
|
|
|
894 (list (list group ""))
|
|
|
895 nnmail-split-methods)))
|
|
|
896 (save-excursion
|
|
|
897 ;; Insert the incoming file.
|
|
|
898 (set-buffer (get-buffer-create " *nnmail incoming*"))
|
|
|
899 (erase-buffer)
|
|
31716
|
900 (let ((coding-system-for-read nnmail-incoming-coding-system))
|
|
|
901 (mm-insert-file-contents incoming))
|
|
|
902 (prog1
|
|
|
903 (if (zerop (buffer-size))
|
|
|
904 0
|
|
|
905 (goto-char (point-min))
|
|
|
906 (save-excursion (run-hooks 'nnmail-prepare-incoming-hook))
|
|
|
907 ;; Handle both babyl, MMDF and unix mail formats, since
|
|
|
908 ;; movemail will use the former when fetching from a
|
|
|
909 ;; mailbox, the latter when fetching from a file.
|
|
|
910 (cond ((or (looking-at "\^L")
|
|
|
911 (looking-at "BABYL OPTIONS:"))
|
|
|
912 (nnmail-process-babyl-mail-format func artnum-func))
|
|
|
913 ((looking-at "\^A\^A\^A\^A")
|
|
|
914 (nnmail-process-mmdf-mail-format func artnum-func))
|
|
|
915 ((looking-at "Return-Path:")
|
|
|
916 (nnmail-process-maildir-mail-format func artnum-func))
|
|
|
917 (t
|
|
|
918 (nnmail-process-unix-mail-format func artnum-func))))
|
|
|
919 (when exit-func
|
|
|
920 (funcall exit-func))
|
|
|
921 (kill-buffer (current-buffer))))))
|
|
17493
|
922
|
|
24357
|
923 (defun nnmail-article-group (func &optional trace)
|
|
17493
|
924 "Look at the headers and return an alist of groups that match.
|
|
|
925 FUNC will be called with the group name to determine the article number."
|
|
|
926 (let ((methods nnmail-split-methods)
|
|
|
927 (obuf (current-buffer))
|
|
|
928 (beg (point-min))
|
|
31716
|
929 end group-art method grp)
|
|
24357
|
930 (if (and (sequencep methods)
|
|
|
931 (= (length methods) 1))
|
|
17493
|
932 ;; If there is only just one group to put everything in, we
|
|
|
933 ;; just return a list with just this one method in.
|
|
|
934 (setq group-art
|
|
|
935 (list (cons (caar methods) (funcall func (caar methods)))))
|
|
|
936 ;; We do actual comparison.
|
|
|
937 (save-excursion
|
|
|
938 ;; Find headers.
|
|
|
939 (goto-char beg)
|
|
|
940 (setq end (if (search-forward "\n\n" nil t) (point) (point-max)))
|
|
|
941 (set-buffer nntp-server-buffer)
|
|
|
942 (erase-buffer)
|
|
|
943 ;; Copy the headers into the work buffer.
|
|
|
944 (insert-buffer-substring obuf beg end)
|
|
|
945 ;; Fold continuation lines.
|
|
|
946 (goto-char (point-min))
|
|
|
947 (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
|
|
|
948 (replace-match " " t t))
|
|
24357
|
949 ;; Nuke pathologically long headers. Since Gnus applies
|
|
|
950 ;; pathologically complex regexps to the buffer, lines
|
|
|
951 ;; that are looong will take longer than the Universe's
|
|
|
952 ;; existence to process.
|
|
|
953 (goto-char (point-min))
|
|
|
954 (while (not (eobp))
|
|
31716
|
955 (unless (< (move-to-column nnmail-split-header-length-limit)
|
|
|
956 nnmail-split-header-length-limit)
|
|
|
957 (delete-region (point) (progn (end-of-line) (point))))
|
|
|
958 (forward-line 1))
|
|
17493
|
959 ;; Allow washing.
|
|
24357
|
960 (goto-char (point-min))
|
|
17493
|
961 (run-hooks 'nnmail-split-hook)
|
|
24357
|
962 (when (setq nnmail-split-tracing trace)
|
|
|
963 (setq nnmail-split-trace nil))
|
|
17493
|
964 (if (and (symbolp nnmail-split-methods)
|
|
|
965 (fboundp nnmail-split-methods))
|
|
|
966 (let ((split
|
|
|
967 (condition-case nil
|
|
19969
|
968 ;; `nnmail-split-methods' is a function, so we
|
|
|
969 ;; just call this function here and use the
|
|
|
970 ;; result.
|
|
17493
|
971 (or (funcall nnmail-split-methods)
|
|
|
972 '("bogus"))
|
|
|
973 (error
|
|
24357
|
974 (nnheader-message 5
|
|
31716
|
975 "Error in `nnmail-split-methods'; using `bogus' mail group")
|
|
17493
|
976 (sit-for 1)
|
|
|
977 '("bogus")))))
|
|
24357
|
978 (setq split (gnus-remove-duplicates split))
|
|
19969
|
979 ;; The article may be "cross-posted" to `junk'. What
|
|
|
980 ;; to do? Just remove the `junk' spec. Don't really
|
|
|
981 ;; see anything else to do...
|
|
|
982 (let (elem)
|
|
|
983 (while (setq elem (car (memq 'junk split)))
|
|
|
984 (setq split (delq elem split))))
|
|
|
985 (when split
|
|
17493
|
986 (setq group-art
|
|
|
987 (mapcar
|
|
|
988 (lambda (group) (cons group (funcall func group)))
|
|
|
989 split))))
|
|
|
990 ;; Go through the split methods to find a match.
|
|
24357
|
991 (while (and methods
|
|
|
992 (or nnmail-crosspost
|
|
|
993 (not group-art)))
|
|
17493
|
994 (goto-char (point-max))
|
|
24357
|
995 (setq method (pop methods)
|
|
31716
|
996 grp (car method))
|
|
17493
|
997 (if (or methods
|
|
|
998 (not (equal "" (nth 1 method))))
|
|
|
999 (when (and
|
|
|
1000 (ignore-errors
|
|
|
1001 (if (stringp (nth 1 method))
|
|
31716
|
1002 (let ((expand (string-match "\\\\[0-9&]" grp))
|
|
|
1003 (pos (re-search-backward (cadr method)
|
|
|
1004 nil t)))
|
|
|
1005 (and expand
|
|
|
1006 (setq grp (nnmail-expand-newtext grp)))
|
|
|
1007 pos)
|
|
17493
|
1008 ;; Function to say whether this is a match.
|
|
31716
|
1009 (funcall (nth 1 method) grp)))
|
|
17493
|
1010 ;; Don't enter the article into the same
|
|
|
1011 ;; group twice.
|
|
31716
|
1012 (not (assoc grp group-art)))
|
|
|
1013 (push (cons grp (funcall func grp))
|
|
17493
|
1014 group-art))
|
|
|
1015 ;; This is the final group, which is used as a
|
|
|
1016 ;; catch-all.
|
|
|
1017 (unless group-art
|
|
|
1018 (setq group-art
|
|
|
1019 (list (cons (car method)
|
|
|
1020 (funcall func (car method)))))))))
|
|
24357
|
1021 ;; Produce a trace if non-empty.
|
|
|
1022 (when (and trace nnmail-split-trace)
|
|
|
1023 (let ((trace (nreverse nnmail-split-trace))
|
|
|
1024 (restore (current-buffer)))
|
|
|
1025 (nnheader-set-temp-buffer "*Split Trace*")
|
|
|
1026 (gnus-add-buffer)
|
|
|
1027 (while trace
|
|
|
1028 (insert (car trace) "\n")
|
|
|
1029 (setq trace (cdr trace)))
|
|
|
1030 (goto-char (point-min))
|
|
|
1031 (gnus-configure-windows 'split-trace)
|
|
|
1032 (set-buffer restore)))
|
|
17493
|
1033 ;; See whether the split methods returned `junk'.
|
|
|
1034 (if (equal group-art '(junk))
|
|
|
1035 nil
|
|
19969
|
1036 ;; The article may be "cross-posted" to `junk'. What
|
|
|
1037 ;; to do? Just remove the `junk' spec. Don't really
|
|
|
1038 ;; see anything else to do...
|
|
|
1039 (let (elem)
|
|
|
1040 (while (setq elem (car (memq 'junk group-art)))
|
|
|
1041 (setq group-art (delq elem group-art)))
|
|
|
1042 (nreverse group-art)))))))
|
|
17493
|
1043
|
|
|
1044 (defun nnmail-insert-lines ()
|
|
|
1045 "Insert how many lines there are in the body of the mail.
|
|
|
1046 Return the number of characters in the body."
|
|
|
1047 (let (lines chars)
|
|
|
1048 (save-excursion
|
|
|
1049 (goto-char (point-min))
|
|
31716
|
1050 (unless (search-forward "\n\n" nil t)
|
|
|
1051 (goto-char (point-max))
|
|
|
1052 (insert "\n"))
|
|
|
1053 (setq chars (- (point-max) (point)))
|
|
|
1054 (setq lines (count-lines (point) (point-max)))
|
|
|
1055 (forward-char -1)
|
|
|
1056 (save-excursion
|
|
|
1057 (when (re-search-backward "^Lines: " nil t)
|
|
|
1058 (delete-region (point) (progn (forward-line 1) (point)))))
|
|
|
1059 (beginning-of-line)
|
|
|
1060 (insert (format "Lines: %d\n" (max lines 0)))
|
|
|
1061 chars)))
|
|
17493
|
1062
|
|
|
1063 (defun nnmail-insert-xref (group-alist)
|
|
|
1064 "Insert an Xref line based on the (group . article) alist."
|
|
|
1065 (save-excursion
|
|
|
1066 (goto-char (point-min))
|
|
31716
|
1067 (unless (search-forward "\n\n" nil t)
|
|
|
1068 (goto-char (point-max))
|
|
|
1069 (insert "\n"))
|
|
|
1070 (forward-char -1)
|
|
|
1071 (when (re-search-backward "^Xref: " nil t)
|
|
|
1072 (delete-region (match-beginning 0)
|
|
|
1073 (progn (forward-line 1) (point))))
|
|
|
1074 (insert (format "Xref: %s" (system-name)))
|
|
|
1075 (while group-alist
|
|
|
1076 (insert (format " %s:%d"
|
|
|
1077 (mm-encode-coding-string
|
|
|
1078 (caar group-alist)
|
|
|
1079 nnmail-pathname-coding-system)
|
|
|
1080 (cdar group-alist)))
|
|
|
1081 (setq group-alist (cdr group-alist)))
|
|
|
1082 (insert "\n")))
|
|
17493
|
1083
|
|
|
1084 ;;; Message washing functions
|
|
|
1085
|
|
|
1086 (defun nnmail-remove-leading-whitespace ()
|
|
|
1087 "Remove excessive whitespace from all headers."
|
|
|
1088 (goto-char (point-min))
|
|
|
1089 (while (re-search-forward "^\\([^ :]+: \\) +" nil t)
|
|
|
1090 (replace-match "\\1" t)))
|
|
|
1091
|
|
|
1092 (defun nnmail-remove-list-identifiers ()
|
|
|
1093 "Remove list identifiers from Subject headers."
|
|
|
1094 (let ((regexp (if (stringp nnmail-list-identifiers) nnmail-list-identifiers
|
|
31716
|
1095 (mapconcat 'identity nnmail-list-identifiers " *\\|"))))
|
|
17493
|
1096 (when regexp
|
|
|
1097 (goto-char (point-min))
|
|
|
1098 (when (re-search-forward
|
|
31716
|
1099 (concat "^Subject: +\\(Re: +\\)?\\(" regexp " *\\)")
|
|
17493
|
1100 nil t)
|
|
|
1101 (delete-region (match-beginning 2) (match-end 0))))))
|
|
|
1102
|
|
|
1103 (defun nnmail-remove-tabs ()
|
|
|
1104 "Translate TAB characters into SPACE characters."
|
|
|
1105 (subst-char-in-region (point-min) (point-max) ?\t ? t))
|
|
|
1106
|
|
31716
|
1107 (defun nnmail-fix-eudora-headers ()
|
|
|
1108 "Eudora has a broken References line, but an OK In-Reply-To."
|
|
|
1109 (goto-char (point-min))
|
|
|
1110 (when (re-search-forward "^X-Mailer:.*Eudora" nil t)
|
|
|
1111 (goto-char (point-min))
|
|
|
1112 (when (re-search-forward "^References:" nil t)
|
|
|
1113 (beginning-of-line)
|
|
|
1114 (insert "X-Gnus-Broken-Eudora-"))
|
|
|
1115 (goto-char (point-min))
|
|
|
1116 (when (re-search-forward "^In-Reply-To:[^\n]+\\(\n[ \t]+\\)" nil t)
|
|
|
1117 (replace-match "" t t nil 1))))
|
|
17493
|
1118
|
|
31716
|
1119 (custom-add-option 'nnmail-prepare-incoming-header-hook
|
|
|
1120 'nnmail-fix-eudora-headers)
|
|
17493
|
1121
|
|
31716
|
1122 ;;; Utility functions
|
|
17493
|
1123
|
|
|
1124 (defun nnmail-split-fancy ()
|
|
|
1125 "Fancy splitting method.
|
|
|
1126 See the documentation for the variable `nnmail-split-fancy' for documentation."
|
|
|
1127 (let ((syntab (syntax-table)))
|
|
|
1128 (unwind-protect
|
|
|
1129 (progn
|
|
|
1130 (set-syntax-table nnmail-split-fancy-syntax-table)
|
|
|
1131 (nnmail-split-it nnmail-split-fancy))
|
|
|
1132 (set-syntax-table syntab))))
|
|
|
1133
|
|
|
1134 (defvar nnmail-split-cache nil)
|
|
|
1135 ;; Alist of split expressions their equivalent regexps.
|
|
|
1136
|
|
|
1137 (defun nnmail-split-it (split)
|
|
|
1138 ;; Return a list of groups matching SPLIT.
|
|
24357
|
1139 (let (cached-pair)
|
|
|
1140 (cond
|
|
|
1141 ;; nil split
|
|
|
1142 ((null split)
|
|
|
1143 nil)
|
|
17493
|
1144
|
|
24357
|
1145 ;; A group name. Do the \& and \N subs into the string.
|
|
|
1146 ((stringp split)
|
|
|
1147 (when nnmail-split-tracing
|
|
|
1148 (push (format "\"%s\"" split) nnmail-split-trace))
|
|
|
1149 (list (nnmail-expand-newtext split)))
|
|
17493
|
1150
|
|
24357
|
1151 ;; Junk the message.
|
|
|
1152 ((eq split 'junk)
|
|
|
1153 (when nnmail-split-tracing
|
|
|
1154 (push "junk" nnmail-split-trace))
|
|
|
1155 (list 'junk))
|
|
|
1156
|
|
|
1157 ;; Builtin & operation.
|
|
|
1158 ((eq (car split) '&)
|
|
|
1159 (apply 'nconc (mapcar 'nnmail-split-it (cdr split))))
|
|
17493
|
1160
|
|
24357
|
1161 ;; Builtin | operation.
|
|
|
1162 ((eq (car split) '|)
|
|
|
1163 (let (done)
|
|
|
1164 (while (and (not done) (cdr split))
|
|
|
1165 (setq split (cdr split)
|
|
|
1166 done (nnmail-split-it (car split))))
|
|
|
1167 done))
|
|
17493
|
1168
|
|
24357
|
1169 ;; Builtin : operation.
|
|
|
1170 ((eq (car split) ':)
|
|
|
1171 (nnmail-split-it (save-excursion (eval (cdr split)))))
|
|
17493
|
1172
|
|
31716
|
1173 ;; Builtin ! operation.
|
|
|
1174 ((eq (car split) '!)
|
|
|
1175 (funcall (cadr split) (nnmail-split-it (caddr split))))
|
|
|
1176
|
|
24357
|
1177 ;; Check the cache for the regexp for this split.
|
|
|
1178 ((setq cached-pair (assq split nnmail-split-cache))
|
|
31716
|
1179 (let (split-result
|
|
|
1180 (end-point (point-max))
|
|
|
1181 (value (nth 1 split)))
|
|
|
1182 (if (symbolp value)
|
|
|
1183 (setq value (cdr (assq value nnmail-split-abbrev-alist))))
|
|
|
1184 (while (and (goto-char end-point)
|
|
|
1185 (re-search-backward (cdr cached-pair) nil t))
|
|
|
1186 (when nnmail-split-tracing
|
|
|
1187 (push (cdr cached-pair) nnmail-split-trace))
|
|
|
1188 (let ((split-rest (cddr split))
|
|
|
1189 (end (match-end 0))
|
|
|
1190 ;; The searched regexp is \(\(FIELD\).*\)\(VALUE\). So,
|
|
|
1191 ;; start-of-value is the the point just before the
|
|
|
1192 ;; beginning of the value, whereas after-header-name is
|
|
|
1193 ;; the point just after the field name.
|
|
|
1194 (start-of-value (match-end 1))
|
|
|
1195 (after-header-name (match-end 2)))
|
|
|
1196 ;; Start the next search just before the beginning of the
|
|
|
1197 ;; VALUE match.
|
|
|
1198 (setq end-point (1- start-of-value))
|
|
|
1199 ;; Handle - RESTRICTs
|
|
|
1200 (while (eq (car split-rest) '-)
|
|
|
1201 ;; RESTRICT must start after-header-name and
|
|
|
1202 ;; end after start-of-value, so that, for
|
|
|
1203 ;; (any "foo" - "x-foo" "foo.list")
|
|
|
1204 ;; we do not exclude foo.list just because
|
|
|
1205 ;; the header is: ``To: x-foo, foo''
|
|
|
1206 (goto-char end)
|
|
|
1207 (if (and (re-search-backward (cadr split-rest)
|
|
|
1208 after-header-name t)
|
|
|
1209 (> (match-end 0) start-of-value))
|
|
|
1210 (setq split-rest nil)
|
|
|
1211 (setq split-rest (cddr split-rest))))
|
|
|
1212 (when split-rest
|
|
|
1213 (goto-char end)
|
|
|
1214 (let ((value (nth 1 split)))
|
|
|
1215 (if (symbolp value)
|
|
|
1216 (setq value (cdr (assq value nnmail-split-abbrev-alist))))
|
|
|
1217 ;; Someone might want to do a \N sub on this match, so get the
|
|
|
1218 ;; correct match positions.
|
|
|
1219 (re-search-backward value start-of-value))
|
|
|
1220 (dolist (sp (nnmail-split-it (car split-rest)))
|
|
|
1221 (unless (memq sp split-result)
|
|
|
1222 (push sp split-result))))))
|
|
|
1223 split-result))
|
|
17493
|
1224
|
|
24357
|
1225 ;; Not in cache, compute a regexp for the field/value pair.
|
|
|
1226 (t
|
|
|
1227 (let* ((field (nth 0 split))
|
|
|
1228 (value (nth 1 split))
|
|
31716
|
1229 partial regexp)
|
|
|
1230 (if (symbolp value)
|
|
|
1231 (setq value (cdr (assq value nnmail-split-abbrev-alist))))
|
|
|
1232 (if (and (>= (length value) 2)
|
|
|
1233 (string= ".*" (substring value 0 2)))
|
|
|
1234 (setq value (substring value 2)
|
|
|
1235 partial ""))
|
|
|
1236 (setq regexp (concat "^\\(\\("
|
|
24357
|
1237 (if (symbolp field)
|
|
|
1238 (cdr (assq field nnmail-split-abbrev-alist))
|
|
|
1239 field)
|
|
31716
|
1240 "\\):.*\\)"
|
|
|
1241 (or partial "\\<")
|
|
|
1242 "\\("
|
|
|
1243 value
|
|
|
1244 "\\)\\>"))
|
|
24357
|
1245 (push (cons split regexp) nnmail-split-cache)
|
|
|
1246 ;; Now that it's in the cache, just call nnmail-split-it again
|
|
|
1247 ;; on the same split, which will find it immediately in the cache.
|
|
|
1248 (nnmail-split-it split))))))
|
|
17493
|
1249
|
|
|
1250 (defun nnmail-expand-newtext (newtext)
|
|
|
1251 (let ((len (length newtext))
|
|
|
1252 (pos 0)
|
|
|
1253 c expanded beg N did-expand)
|
|
|
1254 (while (< pos len)
|
|
|
1255 (setq beg pos)
|
|
|
1256 (while (and (< pos len)
|
|
|
1257 (not (= (aref newtext pos) ?\\)))
|
|
|
1258 (setq pos (1+ pos)))
|
|
|
1259 (unless (= beg pos)
|
|
|
1260 (push (substring newtext beg pos) expanded))
|
|
|
1261 (when (< pos len)
|
|
24357
|
1262 ;; We hit a \; expand it.
|
|
|
1263 (setq did-expand t
|
|
|
1264 pos (1+ pos)
|
|
|
1265 c (aref newtext pos))
|
|
17493
|
1266 (if (not (or (= c ?\&)
|
|
|
1267 (and (>= c ?1)
|
|
|
1268 (<= c ?9))))
|
|
24357
|
1269 ;; \ followed by some character we don't expand.
|
|
17493
|
1270 (push (char-to-string c) expanded)
|
|
|
1271 ;; \& or \N
|
|
|
1272 (if (= c ?\&)
|
|
|
1273 (setq N 0)
|
|
|
1274 (setq N (- c ?0)))
|
|
|
1275 (when (match-beginning N)
|
|
|
1276 (push (buffer-substring (match-beginning N) (match-end N))
|
|
|
1277 expanded))))
|
|
|
1278 (setq pos (1+ pos)))
|
|
|
1279 (if did-expand
|
|
|
1280 (apply 'concat (nreverse expanded))
|
|
|
1281 newtext)))
|
|
|
1282
|
|
|
1283 ;; Activate a backend only if it isn't already activated.
|
|
|
1284 ;; If FORCE, re-read the active file even if the backend is
|
|
|
1285 ;; already activated.
|
|
|
1286 (defun nnmail-activate (backend &optional force)
|
|
24357
|
1287 (nnheader-init-server-buffer)
|
|
17493
|
1288 (let (file timestamp file-time)
|
|
|
1289 (if (or (not (symbol-value (intern (format "%s-group-alist" backend))))
|
|
|
1290 force
|
|
|
1291 (and (setq file (ignore-errors
|
|
|
1292 (symbol-value (intern (format "%s-active-file"
|
|
|
1293 backend)))))
|
|
|
1294 (setq file-time (nth 5 (file-attributes file)))
|
|
|
1295 (or (not
|
|
|
1296 (setq timestamp
|
|
|
1297 (condition-case ()
|
|
|
1298 (symbol-value (intern
|
|
|
1299 (format "%s-active-timestamp"
|
|
|
1300 backend)))
|
|
|
1301 (error 'none))))
|
|
|
1302 (not (consp timestamp))
|
|
|
1303 (equal timestamp '(0 0))
|
|
|
1304 (> (nth 0 file-time) (nth 0 timestamp))
|
|
|
1305 (and (= (nth 0 file-time) (nth 0 timestamp))
|
|
|
1306 (> (nth 1 file-time) (nth 1 timestamp))))))
|
|
|
1307 (save-excursion
|
|
|
1308 (or (eq timestamp 'none)
|
|
|
1309 (set (intern (format "%s-active-timestamp" backend))
|
|
|
1310 file-time))
|
|
|
1311 (funcall (intern (format "%s-request-list" backend)))))
|
|
|
1312 t))
|
|
|
1313
|
|
|
1314 (defun nnmail-message-id ()
|
|
|
1315 (concat "<" (message-unique-id) "@totally-fudged-out-message-id>"))
|
|
|
1316
|
|
|
1317 ;;;
|
|
|
1318 ;;; nnmail duplicate handling
|
|
|
1319 ;;;
|
|
|
1320
|
|
|
1321 (defvar nnmail-cache-buffer nil)
|
|
|
1322
|
|
|
1323 (defun nnmail-cache-open ()
|
|
|
1324 (if (or (not nnmail-treat-duplicates)
|
|
|
1325 (and nnmail-cache-buffer
|
|
|
1326 (buffer-name nnmail-cache-buffer)))
|
|
|
1327 () ; The buffer is open.
|
|
|
1328 (save-excursion
|
|
|
1329 (set-buffer
|
|
|
1330 (setq nnmail-cache-buffer
|
|
|
1331 (get-buffer-create " *nnmail message-id cache*")))
|
|
|
1332 (when (file-exists-p nnmail-message-id-cache-file)
|
|
|
1333 (nnheader-insert-file-contents nnmail-message-id-cache-file))
|
|
|
1334 (set-buffer-modified-p nil)
|
|
|
1335 (current-buffer))))
|
|
|
1336
|
|
|
1337 (defun nnmail-cache-close ()
|
|
|
1338 (when (and nnmail-cache-buffer
|
|
|
1339 nnmail-treat-duplicates
|
|
|
1340 (buffer-name nnmail-cache-buffer)
|
|
|
1341 (buffer-modified-p nnmail-cache-buffer))
|
|
|
1342 (save-excursion
|
|
|
1343 (set-buffer nnmail-cache-buffer)
|
|
|
1344 ;; Weed out the excess number of Message-IDs.
|
|
|
1345 (goto-char (point-max))
|
|
|
1346 (when (search-backward "\n" nil t nnmail-message-id-cache-length)
|
|
|
1347 (progn
|
|
|
1348 (beginning-of-line)
|
|
|
1349 (delete-region (point-min) (point))))
|
|
|
1350 ;; Save the buffer.
|
|
|
1351 (or (file-exists-p (file-name-directory nnmail-message-id-cache-file))
|
|
|
1352 (make-directory (file-name-directory nnmail-message-id-cache-file)
|
|
|
1353 t))
|
|
|
1354 (nnmail-write-region (point-min) (point-max)
|
|
|
1355 nnmail-message-id-cache-file nil 'silent)
|
|
|
1356 (set-buffer-modified-p nil)
|
|
|
1357 (setq nnmail-cache-buffer nil)
|
|
|
1358 (kill-buffer (current-buffer)))))
|
|
|
1359
|
|
31716
|
1360 ;; Compiler directives.
|
|
|
1361 (defvar group)
|
|
|
1362 (defvar group-art-list)
|
|
|
1363 (defvar group-art)
|
|
17493
|
1364 (defun nnmail-cache-insert (id)
|
|
|
1365 (when nnmail-treat-duplicates
|
|
31716
|
1366 ;; Store some information about the group this message is written
|
|
|
1367 ;; to. This function might have been called from various places.
|
|
|
1368 ;; Sometimes, a function up in the calling sequence has an
|
|
|
1369 ;; argument GROUP which is bound to a string, the group name. At
|
|
|
1370 ;; other times, there is a function up in the calling sequence
|
|
|
1371 ;; which has an argument GROUP-ART which is a list of pairs, and
|
|
|
1372 ;; the car of a pair is a group name. Should we check that the
|
|
|
1373 ;; length of the list is equal to 1? -- kai
|
|
|
1374 (let ((g nil))
|
|
|
1375 (cond ((and (boundp 'group) group)
|
|
|
1376 (setq g group))
|
|
|
1377 ((and (boundp 'group-art-list) group-art-list
|
|
|
1378 (listp group-art-list))
|
|
|
1379 (setq g (caar group-art-list)))
|
|
|
1380 ((and (boundp 'group-art) group-art (listp group-art))
|
|
|
1381 (setq g (caar group-art)))
|
|
|
1382 (t (setq g "")))
|
|
|
1383 (unless (gnus-buffer-live-p nnmail-cache-buffer)
|
|
|
1384 (nnmail-cache-open))
|
|
|
1385 (save-excursion
|
|
|
1386 (set-buffer nnmail-cache-buffer)
|
|
|
1387 (goto-char (point-max))
|
|
|
1388 (if (and g (not (string= "" g))
|
|
|
1389 (gnus-methods-equal-p gnus-command-method
|
|
|
1390 (nnmail-cache-primary-mail-backend)))
|
|
|
1391 (insert id "\t" g "\n")
|
|
|
1392 (insert id "\n"))))))
|
|
|
1393
|
|
|
1394 (defun nnmail-cache-primary-mail-backend ()
|
|
|
1395 (let ((be-list (cons gnus-select-method gnus-secondary-select-methods))
|
|
|
1396 (be nil)
|
|
|
1397 (res nil))
|
|
|
1398 (while (and (null res) be-list)
|
|
|
1399 (setq be (car be-list))
|
|
|
1400 (setq be-list (cdr be-list))
|
|
|
1401 (when (and (gnus-method-option-p be 'respool)
|
|
|
1402 (eval (intern (format "%s-get-new-mail" (car be)))))
|
|
|
1403 (setq res be)))
|
|
|
1404 res))
|
|
|
1405
|
|
|
1406 ;; Fetch the group name corresponding to the message id stored in the
|
|
|
1407 ;; cache.
|
|
|
1408 (defun nnmail-cache-fetch-group (id)
|
|
|
1409 (when (and nnmail-treat-duplicates nnmail-cache-buffer)
|
|
17493
|
1410 (save-excursion
|
|
|
1411 (set-buffer nnmail-cache-buffer)
|
|
|
1412 (goto-char (point-max))
|
|
31716
|
1413 (when (search-backward id nil t)
|
|
|
1414 (beginning-of-line)
|
|
|
1415 (skip-chars-forward "^\n\r\t")
|
|
|
1416 (unless (eolp)
|
|
|
1417 (forward-char 1)
|
|
|
1418 (buffer-substring (point)
|
|
|
1419 (progn (end-of-line) (point))))))))
|
|
|
1420
|
|
|
1421 ;; Function for nnmail-split-fancy: look up all references in the
|
|
|
1422 ;; cache and if a match is found, return that group.
|
|
|
1423 (defun nnmail-split-fancy-with-parent ()
|
|
|
1424 (let* ((refstr (or (message-fetch-field "references")
|
|
|
1425 (message-fetch-field "in-reply-to")))
|
|
|
1426 (references nil)
|
|
|
1427 (res nil))
|
|
|
1428 (when refstr
|
|
|
1429 (setq references (nreverse (gnus-split-references refstr)))
|
|
|
1430 (unless (gnus-buffer-live-p nnmail-cache-buffer)
|
|
|
1431 (nnmail-cache-open))
|
|
|
1432 (mapcar (lambda (x)
|
|
|
1433 (setq res (or (nnmail-cache-fetch-group x) res))
|
|
|
1434 (when (string= "drafts" res)
|
|
|
1435 (setq res nil)))
|
|
|
1436 references)
|
|
|
1437 res)))
|
|
17493
|
1438
|
|
|
1439 (defun nnmail-cache-id-exists-p (id)
|
|
|
1440 (when nnmail-treat-duplicates
|
|
|
1441 (save-excursion
|
|
|
1442 (set-buffer nnmail-cache-buffer)
|
|
|
1443 (goto-char (point-max))
|
|
|
1444 (search-backward id nil t))))
|
|
|
1445
|
|
|
1446 (defun nnmail-fetch-field (header)
|
|
|
1447 (save-excursion
|
|
|
1448 (save-restriction
|
|
|
1449 (message-narrow-to-head)
|
|
|
1450 (message-fetch-field header))))
|
|
|
1451
|
|
|
1452 (defun nnmail-check-duplication (message-id func artnum-func)
|
|
|
1453 (run-hooks 'nnmail-prepare-incoming-message-hook)
|
|
|
1454 ;; If this is a duplicate message, then we do not save it.
|
|
|
1455 (let* ((duplication (nnmail-cache-id-exists-p message-id))
|
|
|
1456 (case-fold-search t)
|
|
|
1457 (action (when duplication
|
|
|
1458 (cond
|
|
|
1459 ((memq nnmail-treat-duplicates '(warn delete))
|
|
|
1460 nnmail-treat-duplicates)
|
|
|
1461 ((nnheader-functionp nnmail-treat-duplicates)
|
|
|
1462 (funcall nnmail-treat-duplicates message-id))
|
|
|
1463 (t
|
|
|
1464 nnmail-treat-duplicates))))
|
|
|
1465 group-art)
|
|
31716
|
1466 ;; We insert a line that says what the mail source is.
|
|
|
1467 (let ((case-fold-search t))
|
|
|
1468 (goto-char (point-min))
|
|
|
1469 (re-search-forward "^message-id[ \t]*:" nil t)
|
|
|
1470 (beginning-of-line)
|
|
|
1471 (insert (format "X-Gnus-Mail-Source: %s\n" mail-source-string)))
|
|
|
1472
|
|
17493
|
1473 ;; Let the backend save the article (or not).
|
|
|
1474 (cond
|
|
|
1475 ((not duplication)
|
|
|
1476 (funcall func (setq group-art
|
|
31716
|
1477 (nreverse (nnmail-article-group artnum-func))))
|
|
|
1478 (nnmail-cache-insert message-id))
|
|
17493
|
1479 ((eq action 'delete)
|
|
|
1480 (setq group-art nil))
|
|
|
1481 ((eq action 'warn)
|
|
|
1482 ;; We insert a warning.
|
|
|
1483 (let ((case-fold-search t))
|
|
|
1484 (goto-char (point-min))
|
|
|
1485 (re-search-forward "^message-id[ \t]*:" nil t)
|
|
|
1486 (beginning-of-line)
|
|
|
1487 (insert
|
|
|
1488 "Gnus-Warning: This is a duplicate of message " message-id "\n")
|
|
|
1489 (funcall func (setq group-art
|
|
|
1490 (nreverse (nnmail-article-group artnum-func))))))
|
|
|
1491 (t
|
|
|
1492 (funcall func (setq group-art
|
|
|
1493 (nreverse (nnmail-article-group artnum-func))))))
|
|
|
1494 ;; Add the group-art list to the history list.
|
|
|
1495 (if group-art
|
|
|
1496 (push group-art nnmail-split-history)
|
|
|
1497 (delete-region (point-min) (point-max)))))
|
|
|
1498
|
|
|
1499 ;;; Get new mail.
|
|
|
1500
|
|
31716
|
1501 (defvar nnmail-fetched-sources nil)
|
|
|
1502
|
|
17493
|
1503 (defun nnmail-get-value (&rest args)
|
|
|
1504 (let ((sym (intern (apply 'format args))))
|
|
|
1505 (when (boundp sym)
|
|
|
1506 (symbol-value sym))))
|
|
|
1507
|
|
|
1508 (defun nnmail-get-new-mail (method exit-func temp
|
|
|
1509 &optional group spool-func)
|
|
|
1510 "Read new incoming mail."
|
|
31716
|
1511 (let* ((sources (or mail-sources
|
|
|
1512 (if (listp nnmail-spool-file) nnmail-spool-file
|
|
|
1513 (list nnmail-spool-file))))
|
|
|
1514 fetching-sources
|
|
17493
|
1515 (group-in group)
|
|
31716
|
1516 (i 0)
|
|
|
1517 (new 0)
|
|
|
1518 (total 0)
|
|
|
1519 incoming incomings source)
|
|
31785
|
1520 (when (and (nnmail-get-value "%s-get-new-mail" method)
|
|
|
1521 sources)
|
|
31716
|
1522 (while (setq source (pop sources))
|
|
|
1523 ;; Be compatible with old values.
|
|
|
1524 (cond
|
|
|
1525 ((stringp source)
|
|
|
1526 (setq source
|
|
|
1527 (cond
|
|
|
1528 ((string-match "^po:" source)
|
|
|
1529 (list 'pop :user (substring source (match-end 0))))
|
|
|
1530 ((file-directory-p source)
|
|
|
1531 (list 'directory :path source))
|
|
|
1532 (t
|
|
|
1533 (list 'file :path source)))))
|
|
|
1534 ((eq source 'procmail)
|
|
|
1535 (message "Invalid value for nnmail-spool-file: `procmail'")
|
|
|
1536 nil))
|
|
|
1537 ;; Hack to only fetch the contents of a single group's spool file.
|
|
|
1538 (when (and (eq (car source) 'directory)
|
|
|
1539 (null nnmail-scan-directory-mail-source-once)
|
|
|
1540 group)
|
|
|
1541 (mail-source-bind (directory source)
|
|
|
1542 (setq source (append source
|
|
|
1543 (list
|
|
|
1544 :predicate
|
|
|
1545 `(lambda (file)
|
|
|
1546 (string-match
|
|
|
1547 ,(concat
|
|
|
1548 (regexp-quote (concat group suffix))
|
|
|
1549 "$")
|
|
|
1550 file)))))))
|
|
|
1551 (when nnmail-fetched-sources
|
|
|
1552 (if (member source nnmail-fetched-sources)
|
|
|
1553 (setq source nil)
|
|
|
1554 (push source nnmail-fetched-sources)
|
|
|
1555 (push source fetching-sources)))))
|
|
|
1556 (when fetching-sources
|
|
17493
|
1557 ;; We first activate all the groups.
|
|
|
1558 (nnmail-activate method)
|
|
|
1559 ;; Allow the user to hook.
|
|
|
1560 (run-hooks 'nnmail-pre-get-new-mail-hook)
|
|
|
1561 ;; Open the message-id cache.
|
|
|
1562 (nnmail-cache-open)
|
|
31716
|
1563 ;; The we go through all the existing mail source specification
|
|
|
1564 ;; and fetch the mail from each.
|
|
|
1565 (while (setq source (pop fetching-sources))
|
|
|
1566 (nnheader-message 4 "%s: Reading incoming mail from %s..."
|
|
|
1567 method (car source))
|
|
|
1568 (when (setq new
|
|
|
1569 (mail-source-fetch
|
|
|
1570 source
|
|
|
1571 `(lambda (file orig-file)
|
|
|
1572 (nnmail-split-incoming
|
|
|
1573 file ',(intern (format "%s-save-mail" method))
|
|
|
1574 ',spool-func
|
|
35453
|
1575 (if (equal file orig-file)
|
|
|
1576 nil
|
|
|
1577 (nnmail-get-split-group orig-file ',source))
|
|
31716
|
1578 ',(intern (format "%s-active-number" method))))))
|
|
|
1579 (incf total new)
|
|
|
1580 (incf i)))
|
|
17493
|
1581 ;; If we did indeed read any incoming spools, we save all info.
|
|
31716
|
1582 (if (zerop total)
|
|
|
1583 (nnheader-message 4 "%s: Reading incoming mail (no new mail)...done"
|
|
|
1584 method (car source))
|
|
17493
|
1585 (nnmail-save-active
|
|
|
1586 (nnmail-get-value "%s-group-alist" method)
|
|
|
1587 (nnmail-get-value "%s-active-file" method))
|
|
|
1588 (when exit-func
|
|
|
1589 (funcall exit-func))
|
|
|
1590 (run-hooks 'nnmail-read-incoming-hook)
|
|
31716
|
1591 (nnheader-message 4 "%s: Reading incoming mail (%d new)...done" method
|
|
|
1592 total))
|
|
17493
|
1593 ;; Close the message-id cache.
|
|
|
1594 (nnmail-cache-close)
|
|
|
1595 ;; Allow the user to hook.
|
|
31716
|
1596 (run-hooks 'nnmail-post-get-new-mail-hook))))
|
|
17493
|
1597
|
|
|
1598 (defun nnmail-expired-article-p (group time force &optional inhibit)
|
|
|
1599 "Say whether an article that is TIME old in GROUP should be expired."
|
|
|
1600 (if force
|
|
|
1601 t
|
|
|
1602 (let ((days (or (and nnmail-expiry-wait-function
|
|
|
1603 (funcall nnmail-expiry-wait-function group))
|
|
|
1604 nnmail-expiry-wait)))
|
|
|
1605 (cond ((or (eq days 'never)
|
|
|
1606 (and (not force)
|
|
|
1607 inhibit))
|
|
|
1608 ;; This isn't an expirable group.
|
|
|
1609 nil)
|
|
|
1610 ((eq days 'immediate)
|
|
|
1611 ;; We expire all articles on sight.
|
|
|
1612 t)
|
|
|
1613 ((equal time '(0 0))
|
|
|
1614 ;; This is an ange-ftp group, and we don't have any dates.
|
|
|
1615 nil)
|
|
|
1616 ((numberp days)
|
|
31716
|
1617 (setq days (days-to-time days))
|
|
17493
|
1618 ;; Compare the time with the current time.
|
|
31716
|
1619 (ignore-errors (time-less-p days (time-since time))))))))
|
|
17493
|
1620
|
|
31716
|
1621 (defun nnmail-expiry-target-group (target group)
|
|
|
1622 (when (nnheader-functionp target)
|
|
|
1623 (setq target (funcall target group)))
|
|
|
1624 (unless (eq target 'delete)
|
|
|
1625 (gnus-request-accept-article target nil nil t)))
|
|
17493
|
1626
|
|
|
1627 (defun nnmail-check-syntax ()
|
|
|
1628 "Check (and modify) the syntax of the message in the current buffer."
|
|
|
1629 (save-restriction
|
|
|
1630 (message-narrow-to-head)
|
|
|
1631 (let ((case-fold-search t))
|
|
|
1632 (unless (re-search-forward "^Message-ID[ \t]*:" nil t)
|
|
|
1633 (insert "Message-ID: " (nnmail-message-id) "\n")))))
|
|
|
1634
|
|
|
1635 (defun nnmail-write-region (start end filename &optional append visit lockname)
|
|
|
1636 "Do a `write-region', and then set the file modes."
|
|
19593
|
1637 (let ((coding-system-for-write nnmail-file-coding-system)
|
|
31716
|
1638 (file-name-coding-system nnmail-pathname-coding-system))
|
|
19593
|
1639 (write-region start end filename append visit lockname)
|
|
|
1640 (set-file-modes filename nnmail-default-file-modes)))
|
|
17493
|
1641
|
|
|
1642 ;;;
|
|
|
1643 ;;; Status functions
|
|
|
1644 ;;;
|
|
|
1645
|
|
|
1646 (defun nnmail-replace-status (name value)
|
|
|
1647 "Make status NAME and VALUE part of the current status line."
|
|
|
1648 (save-restriction
|
|
|
1649 (message-narrow-to-head)
|
|
|
1650 (let ((status (nnmail-decode-status)))
|
|
|
1651 (setq status (delq (member name status) status))
|
|
|
1652 (when value
|
|
|
1653 (push (cons name value) status))
|
|
|
1654 (message-remove-header "status")
|
|
|
1655 (goto-char (point-max))
|
|
|
1656 (insert "Status: " (nnmail-encode-status status) "\n"))))
|
|
|
1657
|
|
|
1658 (defun nnmail-decode-status ()
|
|
|
1659 "Return a status-value alist from STATUS."
|
|
|
1660 (goto-char (point-min))
|
|
|
1661 (when (re-search-forward "^Status: " nil t)
|
|
|
1662 (let (name value status)
|
|
|
1663 (save-restriction
|
|
|
1664 ;; Narrow to the status.
|
|
|
1665 (narrow-to-region
|
|
|
1666 (point)
|
|
|
1667 (if (re-search-forward "^[^ \t]" nil t)
|
|
|
1668 (1- (point))
|
|
|
1669 (point-max)))
|
|
|
1670 ;; Go through all elements and add them to the list.
|
|
|
1671 (goto-char (point-min))
|
|
|
1672 (while (re-search-forward "[^ \t=]+" nil t)
|
|
|
1673 (setq name (match-string 0))
|
|
31716
|
1674 (if (not (eq (char-after) ?=))
|
|
17493
|
1675 ;; Implied "yes".
|
|
|
1676 (setq value "yes")
|
|
|
1677 (forward-char 1)
|
|
31716
|
1678 (if (not (eq (char-after) ?\"))
|
|
17493
|
1679 (if (not (looking-at "[^ \t]"))
|
|
|
1680 ;; Implied "no".
|
|
|
1681 (setq value "no")
|
|
|
1682 ;; Unquoted value.
|
|
|
1683 (setq value (match-string 0))
|
|
|
1684 (goto-char (match-end 0)))
|
|
|
1685 ;; Quoted value.
|
|
|
1686 (setq value (read (current-buffer)))))
|
|
|
1687 (push (cons name value) status)))
|
|
|
1688 status)))
|
|
|
1689
|
|
|
1690 (defun nnmail-encode-status (status)
|
|
|
1691 "Return a status string from STATUS."
|
|
|
1692 (mapconcat
|
|
|
1693 (lambda (elem)
|
|
|
1694 (concat
|
|
|
1695 (car elem) "="
|
|
|
1696 (if (string-match "[ \t]" (cdr elem))
|
|
|
1697 (prin1-to-string (cdr elem))
|
|
|
1698 (cdr elem))))
|
|
|
1699 status " "))
|
|
|
1700
|
|
|
1701 (defun nnmail-split-history ()
|
|
|
1702 "Generate an overview of where the last mail split put articles."
|
|
|
1703 (interactive)
|
|
|
1704 (unless nnmail-split-history
|
|
|
1705 (error "No current split history"))
|
|
|
1706 (with-output-to-temp-buffer "*nnmail split history*"
|
|
31716
|
1707 (with-current-buffer standard-output
|
|
|
1708 (fundamental-mode)) ; for Emacs 20.4+
|
|
17493
|
1709 (let ((history nnmail-split-history)
|
|
|
1710 elem)
|
|
|
1711 (while (setq elem (pop history))
|
|
|
1712 (princ (mapconcat (lambda (ga)
|
|
|
1713 (concat (car ga) ":" (int-to-string (cdr ga))))
|
|
|
1714 elem
|
|
|
1715 ", "))
|
|
|
1716 (princ "\n")))))
|
|
|
1717
|
|
24357
|
1718 (defun nnmail-purge-split-history (group)
|
|
|
1719 "Remove all instances of GROUP from `nnmail-split-history'."
|
|
|
1720 (let ((history nnmail-split-history))
|
|
|
1721 (while history
|
|
|
1722 (setcar history (gnus-delete-if (lambda (e) (string= (car e) group))
|
|
|
1723 (car history)))
|
|
|
1724 (pop history))
|
|
|
1725 (setq nnmail-split-history (delq nil nnmail-split-history))))
|
|
|
1726
|
|
17493
|
1727 (defun nnmail-new-mail-p (group)
|
|
|
1728 "Say whether GROUP has new mail."
|
|
|
1729 (let ((his nnmail-split-history)
|
|
|
1730 found)
|
|
|
1731 (while his
|
|
|
1732 (when (assoc group (pop his))
|
|
|
1733 (setq found t
|
|
|
1734 his nil)))
|
|
|
1735 found))
|
|
|
1736
|
|
24357
|
1737 (defun nnmail-within-headers-p ()
|
|
|
1738 "Check to see if point is within the headers of a unix mail message.
|
|
|
1739 Doesn't change point."
|
|
|
1740 (let ((pos (point)))
|
|
|
1741 (save-excursion
|
|
|
1742 (and (nnmail-search-unix-mail-delim-backward)
|
|
|
1743 (not (search-forward "\n\n" pos t))))))
|
|
|
1744
|
|
17493
|
1745 (run-hooks 'nnmail-load-hook)
|
|
|
1746
|
|
|
1747 (provide 'nnmail)
|
|
|
1748
|
|
|
1749 ;;; nnmail.el ends here
|
