Update copyright notices for 2013.
[bpt/emacs.git] / lisp / gnus / nnmail.el
CommitLineData
eec82323 1;;; nnmail.el --- mail support functions for the Gnus mail backends
e84b4b86 2
ab422c4d 3;; Copyright (C) 1995-2013 Free Software Foundation, Inc.
eec82323 4
6748645f 5;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
eec82323
LMI
6;; Keywords: news, mail
7
8;; This file is part of GNU Emacs.
9
5e809f55 10;; GNU Emacs is free software: you can redistribute it and/or modify
eec82323 11;; it under the terms of the GNU General Public License as published by
5e809f55
GM
12;; the Free Software Foundation, either version 3 of the License, or
13;; (at your option) any later version.
eec82323
LMI
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
5e809f55 21;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
eec82323
LMI
22
23;;; Commentary:
24
25;;; Code:
26
f0b7f5a8 27;; For Emacs <22.2 and XEmacs.
163a3c6a
GM
28(eval-and-compile
29 (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
30
0df953b6
RS
31(eval-when-compile (require 'cl))
32
23f87bed 33(require 'gnus) ; for macro gnus-kill-buffer, at least
eec82323 34(require 'nnheader)
eec82323 35(require 'message)
6748645f 36(require 'gnus-util)
16409b0b
GM
37(require 'mail-source)
38(require 'mm-util)
163a3c6a 39(require 'gnus-int)
eec82323 40
8abf1b22
GM
41(autoload 'gnus-add-buffer "gnus")
42(autoload 'gnus-kill-buffer "gnus")
89b163db
G
43(eval-when-compile
44 (autoload 'mail-send-and-exit "sendmail" nil t))
eec82323
LMI
45
46(defgroup nnmail nil
47 "Reading mail with Gnus."
48 :group 'gnus)
49
50(defgroup nnmail-retrieve nil
51 "Retrieving new mail."
52 :group 'nnmail)
53
54(defgroup nnmail-prepare nil
e72c9bcc 55 "Preparing (or mangling) new mail after retrieval."
eec82323
LMI
56 :group 'nnmail)
57
58(defgroup nnmail-duplicate nil
59 "Handling of duplicate mail messages."
60 :group 'nnmail)
61
62(defgroup nnmail-split nil
8f688cb0 63 "Organizing the incoming mail in folders."
eec82323
LMI
64 :group 'nnmail)
65
66(defgroup nnmail-files nil
67 "Mail files."
68 :group 'gnus-files
69 :group 'nnmail)
70
71(defgroup nnmail-expire nil
72 "Expiring old mail."
73 :group 'nnmail)
74
75(defgroup nnmail-procmail nil
76 "Interfacing with procmail and other mail agents."
77 :group 'nnmail)
78
79(defgroup nnmail-various nil
80 "Various mail options."
81 :group 'nnmail)
82
23f87bed 83(defcustom nnmail-split-methods '(("mail.misc" ""))
6748645f 84 "*Incoming mail will be split according to this variable.
eec82323
LMI
85
86If you'd like, for instance, one mail group for mail from the
87\"4ad-l\" mailing list, one group for junk mail and one for everything
88else, you could do something like this:
89
90 (setq nnmail-split-methods
91 '((\"mail.4ad\" \"From:.*4ad\")
23f87bed
MB
92 (\"mail.junk\" \"From:.*Lars\\\\|Subject:.*buy\")
93 (\"mail.misc\" \"\")))
eec82323
LMI
94
95As you can see, this variable is a list of lists, where the first
96element in each \"rule\" is the name of the group (which, by the way,
97does not have to be called anything beginning with \"mail\",
98\"yonka.zow\" is a fine, fine name), and the second is a regexp that
99nnmail will try to match on the header to find a fit.
100
101The second element can also be a function. In that case, it will be
102called narrowed to the headers with the first element of the rule as
103the argument. It should return a non-nil value if it thinks that the
104mail belongs in that group.
105
106The last element should always have \"\" as the regexp.
107
a3f57c41
G
108This variable can also have a function as its value, and it can
109also have a fancy split method as its value. See
110`nnmail-split-fancy' for an explanation of that syntax."
eec82323 111 :group 'nnmail-split
23f87bed
MB
112 :type '(choice (repeat :tag "Alist" (group (string :tag "Name")
113 (choice regexp function)))
eec82323
LMI
114 (function-item nnmail-split-fancy)
115 (function :tag "Other")))
116
117;; Suggested by Erik Selberg <speed@cs.washington.edu>.
118(defcustom nnmail-crosspost t
119 "If non-nil, do crossposting if several split methods match the mail.
120If nil, the first match found will be used."
121 :group 'nnmail-split
122 :type 'boolean)
123
23f87bed
MB
124(defcustom nnmail-split-fancy-with-parent-ignore-groups nil
125 "Regexp that matches group names to be ignored when applying `nnmail-split-fancy-with-parent'.
126This can also be a list of regexps."
bf247b6e 127 :version "22.1"
23f87bed
MB
128 :group 'nnmail-split
129 :type '(choice (const :tag "none" nil)
130 (regexp :value ".*")
131 (repeat :value (".*") regexp)))
132
133(defcustom nnmail-cache-ignore-groups nil
134 "Regexp that matches group names to be ignored when inserting message ids into the cache (`nnmail-cache-insert').
135This can also be a list of regexps."
bf247b6e 136 :version "22.1"
23f87bed
MB
137 :group 'nnmail-split
138 :type '(choice (const :tag "none" nil)
139 (regexp :value ".*")
140 (repeat :value (".*") regexp)))
141
eec82323
LMI
142;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit).
143(defcustom nnmail-keep-last-article nil
a8151ef7
LMI
144 "If non-nil, nnmail will never delete/move a group's last article.
145It can be marked expirable, so it will be deleted when it is no longer last.
146
eec82323
LMI
147You may need to set this variable if other programs are putting
148new mail into folder numbers that Gnus has marked as expired."
149 :group 'nnmail-procmail
150 :group 'nnmail-various
151 :type 'boolean)
152
153(defcustom nnmail-use-long-file-names nil
154 "If non-nil the mail backends will use long file and directory names.
155If nil, groups like \"mail.misc\" will end up in directories like
156\"mail/misc/\"."
157 :group 'nnmail-files
158 :type 'boolean)
159
160(defcustom nnmail-default-file-modes 384
161 "Set the mode bits of all new mail files to this integer."
162 :group 'nnmail-files
163 :type 'integer)
164
165(defcustom nnmail-expiry-wait 7
166 "*Expirable articles that are older than this will be expired.
167This variable can either be a number (which will be interpreted as a
168number of days) -- this doesn't have to be an integer. This variable
169can also be `immediate' and `never'."
170 :group 'nnmail-expire
171 :type '(choice (const immediate)
23f87bed 172 (number :tag "days")
eec82323
LMI
173 (const never)))
174
175(defcustom nnmail-expiry-wait-function nil
176 "Variable that holds function to specify how old articles should be before they are expired.
23f87bed
MB
177The function will be called with the name of the group that the expiry
178is to be performed in, and it should return an integer that says how
179many days an article can be stored before it is considered \"old\".
180It can also return the values `never' and `immediate'.
eec82323
LMI
181
182Eg.:
183
184\(setq nnmail-expiry-wait-function
185 (lambda (newsgroup)
23f87bed
MB
186 (cond ((string-match \"private\" newsgroup) 31)
187 ((string-match \"junk\" newsgroup) 1)
eec82323
LMI
188 ((string-match \"important\" newsgroup) 'never)
189 (t 7))))"
190 :group 'nnmail-expire
191 :type '(choice (const :tag "nnmail-expiry-wait" nil)
192 (function :format "%v" nnmail-)))
193
16409b0b
GM
194(defcustom nnmail-expiry-target 'delete
195 "*Variable that says where expired messages should end up.
196The default value is `delete' (which says to delete the messages),
197but it can also be a string or a function. If it is a string, expired
198messages end up in that group. If it is a function, the function is
199called in a buffer narrowed to the message in question. The function
200receives one argument, the name of the group the message comes from.
201The return value should be `delete' or a group name (a string)."
4693ed4e 202 :version "21.1"
23f87bed
MB
203 :group 'nnmail-expire
204 :type '(choice (const delete)
9091f2d3 205 function
23f87bed
MB
206 string))
207
208(defcustom nnmail-fancy-expiry-targets nil
209 "Determine expiry target based on articles using fancy techniques.
210
211This is a list of (\"HEADER\" \"REGEXP\" \"TARGET\") entries. If
212`nnmail-expiry-target' is set to the function
213`nnmail-fancy-expiry-target' and HEADER of the article matches REGEXP,
214the message will be expired to a group determined by invoking
215`format-time-string' with TARGET used as the format string and the
216time extracted from the articles' Date header (if missing the current
217time is used).
218
219In the special cases that HEADER is the symbol `to-from', the regexp
220will try to match against both the From and the To header.
221
222Example:
223
224\(setq nnmail-fancy-expiry-targets
225 '((to-from \"boss\" \"nnfolder:Work\")
226 (\"Subject\" \"IMPORTANT\" \"nnfolder:IMPORTANT.%Y.%b\")
227 (\"from\" \".*\" \"nnfolder:Archive-%Y\")))
228
229In this case, articles containing the string \"boss\" in the To or the
230From header will be expired to the group \"nnfolder:Work\";
1d77b63e 231articles containing the string \"IMPORTANT\" in the Subject header will
23f87bed
MB
232be expired to the group \"nnfolder:IMPORTANT.YYYY.MMM\"; and
233everything else will be expired to \"nnfolder:Archive-YYYY\"."
bf247b6e 234 :version "22.1"
23f87bed
MB
235 :group 'nnmail-expire
236 :type '(repeat (list (choice :tag "Match against"
237 (string :tag "Header")
238 (const to-from))
239 regexp
240 (string :tag "Target group format string"))))
16409b0b 241
eec82323 242(defcustom nnmail-cache-accepted-message-ids nil
23f87bed
MB
243 "If non-nil, put Message-IDs of Gcc'd articles into the duplicate cache.
244If non-nil, also update the cache when copy or move articles."
eec82323
LMI
245 :group 'nnmail
246 :type 'boolean)
247
265ac10b
SM
248(make-obsolete-variable 'nnmail-spool-file 'mail-sources
249 "Gnus 5.9 (Emacs 22.1)")
8aed9ac5 250;; revision 5.29 / p0-85 / Gnus 5.9
b890d447 251;; Variable removed in No Gnus v0.7
eec82323 252
16409b0b
GM
253(defcustom nnmail-resplit-incoming nil
254 "*If non-nil, re-split incoming procmail sorted mail."
eec82323
LMI
255 :group 'nnmail-procmail
256 :type 'boolean)
257
16409b0b
GM
258(defcustom nnmail-scan-directory-mail-source-once nil
259 "*If non-nil, scan all incoming procmail sorted mails once.
260It scans low-level sorted spools even when not required."
4693ed4e 261 :version "21.1"
eec82323
LMI
262 :group 'nnmail-procmail
263 :type 'boolean)
264
265(defcustom nnmail-delete-file-function 'delete-file
266 "Function called to delete files in some mail backends."
267 :group 'nnmail-files
268 :type 'function)
269
270(defcustom nnmail-crosspost-link-function
f5ec697d 271 (if (string-match "windows-nt" (symbol-name system-type))
eec82323
LMI
272 'copy-file
273 'add-name-to-file)
6748645f 274 "*Function called to create a copy of a file.
eec82323
LMI
275This is `add-name-to-file' by default, which means that crossposts
276will use hard links. If your file system doesn't allow hard
277links, you could set this variable to `copy-file' instead."
278 :group 'nnmail-files
279 :type '(radio (function-item add-name-to-file)
280 (function-item copy-file)
281 (function :tag "Other")))
282
eec82323
LMI
283(defcustom nnmail-read-incoming-hook
284 (if (eq system-type 'windows-nt)
285 '(nnheader-ms-strip-cr)
286 nil)
6748645f 287 "*Hook that will be run after the incoming mail has been transferred.
8b93df01 288The incoming mail is moved from the specified spool file (which normally is
eec82323
LMI
289something like \"/usr/spool/mail/$user\") to the user's home
290directory. This hook is called after the incoming mail box has been
291emptied, and can be used to call any mail box programs you have
292running (\"xwatch\", etc.)
293
294Eg.
295
296\(add-hook 'nnmail-read-incoming-hook
23f87bed
MB
297 (lambda ()
298 (call-process \"/local/bin/mailsend\" nil nil nil
01c52d31
MB
299 \"read\"
300 ;; The incoming mail box file.
301 (expand-file-name (user-login-name)
302 rmail-spool-directory))))
eec82323
LMI
303
304If you have xwatch running, this will alert it that mail has been
305read.
306
307If you use `display-time', you could use something like this:
308
309\(add-hook 'nnmail-read-incoming-hook
310 (lambda ()
311 ;; Update the displayed time, since that will clear out
312 ;; the flag that says you have mail.
313 (when (eq (process-status \"display-time\") 'run)
314 (display-time-filter display-time-process \"\"))))"
315 :group 'nnmail-prepare
316 :type 'hook)
317
eec82323
LMI
318(defcustom nnmail-prepare-incoming-hook nil
319 "Hook called before treating incoming mail.
320The hook is run in a buffer with all the new, incoming mail."
321 :group 'nnmail-prepare
322 :type 'hook)
323
324(defcustom nnmail-prepare-incoming-header-hook nil
325 "Hook called narrowed to the headers of each message.
326This can be used to remove excessive spaces (and stuff like
327that) from the headers before splitting and saving the messages."
328 :group 'nnmail-prepare
329 :type 'hook)
330
331(defcustom nnmail-prepare-incoming-message-hook nil
332 "Hook called narrowed to each message."
333 :group 'nnmail-prepare
334 :type 'hook)
335
336(defcustom nnmail-list-identifiers nil
337 "Regexp that matches list identifiers to be removed.
338This can also be a list of regexps."
339 :group 'nnmail-prepare
340 :type '(choice (const :tag "none" nil)
6748645f
LMI
341 (regexp :value ".*")
342 (repeat :value (".*") regexp)))
eec82323
LMI
343
344(defcustom nnmail-pre-get-new-mail-hook nil
345 "Hook called just before starting to handle new incoming mail."
346 :group 'nnmail-retrieve
347 :type 'hook)
348
349(defcustom nnmail-post-get-new-mail-hook nil
350 "Hook called just after finishing handling new incoming mail."
351 :group 'nnmail-retrieve
352 :type 'hook)
353
354(defcustom nnmail-split-hook nil
355 "Hook called before deciding where to split an article.
356The functions in this hook are free to modify the buffer
357contents in any way they choose -- the buffer contents are
358discarded after running the split process."
359 :group 'nnmail-split
360 :type 'hook)
361
23f87bed
MB
362(defcustom nnmail-spool-hook nil
363 "*A hook called when a new article is spooled."
bf247b6e 364 :version "22.1"
23f87bed
MB
365 :group 'nnmail
366 :type 'hook)
367
eec82323 368(defcustom nnmail-large-newsgroup 50
23f87bed
MB
369 "*The number of articles which indicates a large newsgroup or nil.
370If the number of articles is greater than the value, verbose
eec82323
LMI
371messages will be shown to indicate the current status."
372 :group 'nnmail-various
23f87bed
MB
373 :type '(choice (const :tag "infinite" nil)
374 (number :tag "count")))
375
376(define-widget 'nnmail-lazy 'default
377 "Base widget for recursive datastructures.
378
bf247b6e 379This is copy of the `lazy' widget in Emacs 22.1 provided for compatibility."
23f87bed
MB
380 :format "%{%t%}: %v"
381 :convert-widget 'widget-value-convert-widget
382 :value-create (lambda (widget)
383 (let ((value (widget-get widget :value))
384 (type (widget-get widget :type)))
bf247b6e
KS
385 (widget-put widget :children
386 (list (widget-create-child-value
23f87bed
MB
387 widget (widget-convert type) value)))))
388 :value-delete 'widget-children-value-delete
389 :value-get (lambda (widget)
390 (widget-value (car (widget-get widget :children))))
391 :value-inline (lambda (widget)
392 (widget-apply (car (widget-get widget :children))
393 :value-inline))
394 :default-get (lambda (widget)
395 (widget-default-get
396 (widget-convert (widget-get widget :type))))
397 :match (lambda (widget value)
398 (widget-apply (widget-convert (widget-get widget :type))
399 :match value))
400 :validate (lambda (widget)
401 (widget-apply (car (widget-get widget :children)) :validate)))
402
403(define-widget 'nnmail-split-fancy 'nnmail-lazy
404 "Widget for customizing splits in the variable of the same name."
405 :tag "Split"
406 :type '(menu-choice :value (any ".*value.*" "misc")
407 :tag "Type"
408 (string :tag "Destination")
409 (list :tag "Use first match (|)" :value (|)
410 (const :format "" |)
411 (editable-list :inline t nnmail-split-fancy))
412 (list :tag "Use all matches (&)" :value (&)
413 (const :format "" &)
414 (editable-list :inline t nnmail-split-fancy))
415 (list :tag "Function with fixed arguments (:)"
01c52d31 416 :value (:)
23f87bed 417 (const :format "" :value :)
bf247b6e 418 function
23f87bed
MB
419 (editable-list :inline t (sexp :tag "Arg"))
420 )
421 (list :tag "Function with split arguments (!)"
01c52d31 422 :value (!)
23f87bed
MB
423 (const :format "" !)
424 function
425 (editable-list :inline t nnmail-split-fancy))
bf247b6e
KS
426 (list :tag "Field match"
427 (choice :tag "Field"
23f87bed
MB
428 regexp symbol)
429 (choice :tag "Match"
bf247b6e 430 regexp
23f87bed
MB
431 (symbol :value mail))
432 (repeat :inline t
433 :tag "Restrictions"
434 (group :inline t
435 (const :format "" -)
436 regexp))
437 nnmail-split-fancy)
438 (const :tag "Junk (delete mail)" junk)))
eec82323
LMI
439
440(defcustom nnmail-split-fancy "mail.misc"
441 "Incoming mail can be split according to this fancy variable.
442To enable this, set `nnmail-split-methods' to `nnmail-split-fancy'.
443
6748645f 444The format of this variable is SPLIT, where SPLIT can be one of
eec82323
LMI
445the following:
446
447GROUP: Mail will be stored in GROUP (a string).
448
16409b0b 449\(FIELD VALUE [- RESTRICT [- RESTRICT [...]]] SPLIT): If the message
a1506d29 450 field FIELD (a regexp) contains VALUE (a regexp), store the messages
16409b0b 451 as specified by SPLIT. If RESTRICT (a regexp) matches some string
f0529b5b 452 after FIELD and before the end of the matched VALUE, return nil,
16409b0b
GM
453 otherwise process SPLIT. Multiple RESTRICTs add up, further
454 restricting the possibility of processing SPLIT.
eec82323
LMI
455
456\(| SPLIT...): Process each SPLIT expression until one of them matches.
457 A SPLIT expression is said to match if it will cause the mail
458 message to be stored in one or more groups.
459
460\(& SPLIT...): Process each SPLIT expression.
461
462\(: FUNCTION optional args): Call FUNCTION with the optional args, in
463 the buffer containing the message headers. The return value FUNCTION
464 should be a split, which is then recursively processed.
465
16409b0b
GM
466\(! FUNCTION SPLIT): Call FUNCTION with the result of SPLIT. The
467 return value FUNCTION should be a split, which is then recursively
468 processed.
469
23f87bed
MB
470junk: Mail will be deleted. Use with care! Do not submerge in water!
471 Example:
472 (setq nnmail-split-fancy
473 '(| (\"Subject\" \"MAKE MONEY FAST\" junk)
474 ...other.rules.omitted...))
475
eec82323
LMI
476FIELD must match a complete field name. VALUE must match a complete
477word according to the `nnmail-split-fancy-syntax-table' syntax table.
478You can use \".*\" in the regexps to match partial field names or words.
479
01c52d31 480FIELD and VALUE can also be Lisp symbols, in that case they are expanded
eec82323
LMI
481as specified in `nnmail-split-abbrev-alist'.
482
483GROUP can contain \\& and \\N which will substitute from matching
484\\(\\) patterns in the previous VALUE.
485
486Example:
487
488\(setq nnmail-split-methods 'nnmail-split-fancy
489 nnmail-split-fancy
490 ;; Messages from the mailer daemon are not crossposted to any of
491 ;; the ordinary groups. Warnings are put in a separate group
492 ;; from real errors.
493 '(| (\"from\" mail (| (\"subject\" \"warn.*\" \"mail.warning\")
494 \"mail.misc\"))
495 ;; Non-error messages are crossposted to all relevant
496 ;; groups, but we don't crosspost between the group for the
497 ;; (ding) list and the group for other (ding) related mail.
498 (& (| (any \"ding@ifi\\\\.uio\\\\.no\" \"ding.list\")
499 (\"subject\" \"ding\" \"ding.misc\"))
500 ;; Other mailing lists...
501 (any \"procmail@informatik\\\\.rwth-aachen\\\\.de\" \"procmail.list\")
502 (any \"SmartList@informatik\\\\.rwth-aachen\\\\.de\" \"SmartList.list\")
23f87bed
MB
503 ;; Both lists below have the same suffix, so prevent
504 ;; cross-posting to mkpkg.list of messages posted only to
505 ;; the bugs- list, but allow cross-posting when the
506 ;; message was really cross-posted.
507 (any \"bugs-mypackage@somewhere\" \"mypkg.bugs\")
508 (any \"mypackage@somewhere\" - \"bugs-mypackage\" \"mypkg.list\")
509 ;;
eec82323
LMI
510 ;; People...
511 (any \"larsi@ifi\\\\.uio\\\\.no\" \"people.Lars Magne Ingebrigtsen\"))
512 ;; Unmatched mail goes to the catch all group.
513 \"misc.misc\"))"
514 :group 'nnmail-split
23f87bed 515 :type 'nnmail-split-fancy)
eec82323
LMI
516
517(defcustom nnmail-split-abbrev-alist
518 '((any . "from\\|to\\|cc\\|sender\\|apparently-to\\|resent-from\\|resent-to\\|resent-cc")
519 (mail . "mailer-daemon\\|postmaster\\|uucp")
520 (to . "to\\|cc\\|apparently-to\\|resent-to\\|resent-cc")
a8151ef7
LMI
521 (from . "from\\|sender\\|resent-from")
522 (nato . "to\\|cc\\|resent-to\\|resent-cc")
523 (naany . "from\\|to\\|cc\\|sender\\|resent-from\\|resent-to\\|resent-cc"))
6748645f 524 "*Alist of abbreviations allowed in `nnmail-split-fancy'."
eec82323
LMI
525 :group 'nnmail-split
526 :type '(repeat (cons :format "%v" symbol regexp)))
527
eec82323
LMI
528(defcustom nnmail-message-id-cache-length 1000
529 "*The approximate number of Message-IDs nnmail will keep in its cache.
530If this variable is nil, no checking on duplicate messages will be
531performed."
532 :group 'nnmail-duplicate
533 :type '(choice (const :tag "disable" nil)
534 (integer :format "%v")))
535
52bec650
MB
536(defcustom nnmail-message-id-cache-file
537 (nnheader-concat gnus-home-directory ".nnmail-cache")
538 "The file name of the nnmail Message-ID cache."
eec82323
LMI
539 :group 'nnmail-duplicate
540 :group 'nnmail-files
541 :type 'file)
542
543(defcustom nnmail-treat-duplicates 'warn
544 "*If non-nil, nnmail keep a cache of Message-IDs to discover mail duplicates.
16409b0b 545Three values are valid: nil, which means that nnmail is not to keep a
eec82323
LMI
546Message-ID cache; `warn', which means that nnmail should insert extra
547headers to warn the user about the duplication (this is the default);
548and `delete', which means that nnmail will delete duplicated mails.
549
550This variable can also be a function. It will be called from a buffer
551narrowed to the article in question with the Message-ID as a
552parameter. It should return nil, `warn' or `delete'."
553 :group 'nnmail-duplicate
554 :type '(choice (const :tag "off" nil)
555 (const warn)
556 (const delete)))
557
89b163db 558(defcustom nnmail-extra-headers '(To Newsgroups Cc)
4d9db491
G
559 "Extra headers to parse.
560In addition to the standard headers, these extra headers will be
561included in NOV headers (and the like) when backends parse headers."
2a1e2476 562 :version "24.3"
16409b0b
GM
563 :group 'nnmail
564 :type '(repeat symbol))
565
ad136a7c 566(defcustom nnmail-split-header-length-limit 2048
16409b0b 567 "Header lines longer than this limit are excluded from the split function."
4693ed4e 568 :version "21.1"
16409b0b
GM
569 :group 'nnmail
570 :type 'integer)
571
23f87bed
MB
572(defcustom nnmail-mail-splitting-charset nil
573 "Default charset to be used when splitting incoming mail."
bf247b6e 574 :version "22.1"
23f87bed
MB
575 :group 'nnmail
576 :type 'symbol)
577
578(defcustom nnmail-mail-splitting-decodes nil
579 "Whether the nnmail splitting functionality should MIME decode headers."
bf247b6e 580 :version "22.1"
23f87bed
MB
581 :group 'nnmail
582 :type 'boolean)
583
584(defcustom nnmail-split-fancy-match-partial-words nil
585 "Whether to match partial words when fancy splitting.
586Normally, regexes given in `nnmail-split-fancy' are implicitly surrounded
587by \"\\=\\<...\\>\". If this variable is true, they are not implicitly\
588 surrounded
589by anything."
bf247b6e 590 :version "22.1"
23f87bed
MB
591 :group 'nnmail
592 :type 'boolean)
593
594(defcustom nnmail-split-lowercase-expanded t
595 "Whether to lowercase expanded entries (i.e. \\N) when splitting mails.
596This avoids the creation of multiple groups when users send to an address
597using different case (i.e. mailing-list@domain vs Mailing-List@Domain)."
bf247b6e 598 :version "22.1"
23f87bed
MB
599 :group 'nnmail
600 :type 'boolean)
601
eec82323
LMI
602;;; Internal variables.
603
23f87bed
MB
604(defvar nnmail-article-buffer " *nnmail incoming*"
605 "The buffer used for splitting incoming mails.")
606
eec82323
LMI
607(defvar nnmail-split-history nil
608 "List of group/article elements that say where the previous split put messages.")
609
23f87bed
MB
610(defvar nnmail-split-fancy-syntax-table
611 (let ((table (make-syntax-table)))
612 ;; support the %-hack
613 (modify-syntax-entry ?\% "." table)
614 table)
eec82323 615 "Syntax table used by `nnmail-split-fancy'.")
eec82323
LMI
616
617(defvar nnmail-prepare-save-mail-hook nil
618 "Hook called before saving mail.")
619
6748645f
LMI
620(defvar nnmail-split-tracing nil)
621(defvar nnmail-split-trace nil)
20a673b2 622(defvar nnmail-inhibit-default-split-group nil)
6748645f 623
eec82323
LMI
624\f
625
eec82323
LMI
626(defun nnmail-request-post (&optional server)
627 (mail-send-and-exit nil))
628
6748645f
LMI
629(defvar nnmail-file-coding-system 'raw-text
630 "Coding system used in nnmail.")
631
16409b0b
GM
632(defvar nnmail-incoming-coding-system
633 mm-text-coding-system
634 "Coding system used in reading inbox")
635
26b9f88d
MB
636(defvar nnmail-pathname-coding-system
637 ;; This causes Emacs 22.2 and 22.3 to issue a useless warning.
638 ;;(if (and (featurep 'xemacs) (featurep 'file-coding))
639 (if (featurep 'xemacs)
640 (if (featurep 'file-coding)
641 ;; Work around a bug in many XEmacs 21.5 betas.
642 ;; Cf. http://thread.gmane.org/gmane.emacs.gnus.general/68134
643 (setq file-name-coding-system (coding-system-aliasee 'file-name))))
35ef97a5 644 "*Coding system for file name.")
1613b43a 645
eec82323
LMI
646(defun nnmail-find-file (file)
647 "Insert FILE in server buffer safely."
648 (set-buffer nntp-server-buffer)
16409b0b 649 (delete-region (point-min) (point-max))
eec82323 650 (let ((format-alist nil)
23f87bed 651 (after-insert-file-functions nil))
eec82323 652 (condition-case ()
1613b43a 653 (let ((coding-system-for-read nnmail-file-coding-system)
16409b0b
GM
654 (auto-mode-alist (mm-auto-mode-alist))
655 (file-name-coding-system nnmail-pathname-coding-system))
1613b43a
KH
656 (insert-file-contents file)
657 t)
eec82323
LMI
658 (file-error nil))))
659
660(defun nnmail-group-pathname (group dir &optional file)
35ef97a5 661 "Make file name for GROUP."
eec82323
LMI
662 (concat
663 (let ((dir (file-name-as-directory (expand-file-name dir))))
16409b0b
GM
664 (setq group (nnheader-replace-duplicate-chars-in-string
665 (nnheader-replace-chars-in-string group ?/ ?_)
666 ?. ?_))
6748645f 667 (setq group (nnheader-translate-file-chars group))
eec82323 668 ;; If this directory exists, we use it directly.
16409b0b
GM
669 (file-name-as-directory
670 (if (or nnmail-use-long-file-names
671 (file-directory-p (concat dir group)))
672 (expand-file-name group dir)
673 ;; If not, we translate dots into slashes.
674 (expand-file-name
01c52d31 675 (nnheader-replace-chars-in-string group ?. ?/)
16409b0b 676 dir))))
eec82323
LMI
677 (or file "")))
678
eec82323
LMI
679(defun nnmail-get-active ()
680 "Returns an assoc of group names and active ranges.
681nn*-request-list should have been called before calling this function."
16409b0b 682 ;; Go through all groups from the active list.
20a673b2 683 (with-current-buffer nntp-server-buffer
16409b0b
GM
684 (nnmail-parse-active)))
685
686(defun nnmail-parse-active ()
687 "Parse the active file in the current buffer and return an alist."
688 (goto-char (point-min))
689 (unless (re-search-forward "[\\\"]" nil t)
690 (goto-char (point-max))
691 (while (re-search-backward "[][';?()#]" nil t)
692 (insert ?\\)))
693 (goto-char (point-min))
694 (let ((buffer (current-buffer))
695 group-assoc group max min)
696 (while (not (eobp))
697 (condition-case err
698 (progn
01c52d31 699 (narrow-to-region (point) (point-at-eol))
16409b0b
GM
700 (setq group (read buffer))
701 (unless (stringp group)
702 (setq group (symbol-name group)))
23f87bed
MB
703 (if (and (numberp (setq max (read buffer)))
704 (numberp (setq min (read buffer))))
1428d46b 705 (push (list (mm-string-as-unibyte group) (cons min max))
16409b0b
GM
706 group-assoc)))
707 (error nil))
708 (widen)
709 (forward-line 1))
eec82323
LMI
710 group-assoc))
711
16409b0b 712(defvar nnmail-active-file-coding-system 'raw-text
1613b43a
KH
713 "*Coding system for active file.")
714
eec82323
LMI
715(defun nnmail-save-active (group-assoc file-name)
716 "Save GROUP-ASSOC in ACTIVE-FILE."
1613b43a
KH
717 (let ((coding-system-for-write nnmail-active-file-coding-system))
718 (when file-name
16409b0b 719 (with-temp-file file-name
1428d46b 720 (mm-disable-multibyte)
1613b43a 721 (nnmail-generate-active group-assoc)))))
eec82323
LMI
722
723(defun nnmail-generate-active (alist)
724 "Generate an active file from group-alist ALIST."
725 (erase-buffer)
726 (let (group)
727 (while (setq group (pop alist))
16409b0b
GM
728 (insert (format "%S %d %d y\n" (intern (car group)) (cdadr group)
729 (caadr group))))
730 (goto-char (point-max))
731 (while (search-backward "\\." nil t)
732 (delete-char 1))))
eec82323 733
16409b0b 734(defun nnmail-get-split-group (file source)
eec82323 735 "Find out whether this FILE is to be split into GROUP only.
16409b0b
GM
736If SOURCE is a directory spec, try to return the group name component."
737 (if (eq (car source) 'directory)
738 (let ((file (file-name-nondirectory file)))
739 (mail-source-bind (directory source)
740 (if (string-match (concat (regexp-quote suffix) "$") file)
741 (substring file 0 (match-beginning 0))
742 nil)))
743 nil))
eec82323
LMI
744
745(defun nnmail-process-babyl-mail-format (func artnum-func)
746 (let ((case-fold-search t)
16409b0b 747 (count 0)
eec82323 748 start message-id content-length do-search end)
eec82323 749 (while (not (eobp))
6748645f 750 (goto-char (point-min))
eec82323
LMI
751 (re-search-forward
752 "\f\n0, *unseen,+\n\\(\\*\\*\\* EOOH \\*\\*\\*\n\\)?" nil t)
753 (goto-char (match-end 0))
754 (delete-region (match-beginning 0) (match-end 0))
755 (narrow-to-region
756 (setq start (point))
757 (progn
758 ;; Skip all the headers in case there are more "From "s...
759 (or (search-forward "\n\n" nil t)
760 (search-forward-regexp "^[^:]*\\( .*\\|\\)$" nil t)
761 (search-forward "\1f\f"))
762 (point)))
763 ;; Unquote the ">From " line, if any.
764 (goto-char (point-min))
765 (when (looking-at ">From ")
766 (replace-match "X-From-Line: ") )
767 (run-hooks 'nnmail-prepare-incoming-header-hook)
768 (goto-char (point-max))
769 ;; Find the Message-ID header.
770 (save-excursion
771 (if (re-search-backward
772 "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]*>\\)" nil t)
773 (setq message-id (buffer-substring (match-beginning 1)
774 (match-end 1)))
775 ;; There is no Message-ID here, so we create one.
776 (save-excursion
777 (when (re-search-backward "^Message-ID[ \t]*:" nil t)
778 (beginning-of-line)
779 (insert "Original-")))
780 (forward-line -1)
781 (insert "Message-ID: " (setq message-id (nnmail-message-id))
782 "\n")))
783 ;; Look for a Content-Length header.
784 (if (not (save-excursion
785 (and (re-search-backward
786 "^Content-Length:[ \t]*\\([0-9]+\\)" start t)
e9bd5782 787 (setq content-length (string-to-number
eec82323
LMI
788 (buffer-substring
789 (match-beginning 1)
790 (match-end 1))))
791 ;; We destroy the header, since none of
792 ;; the backends ever use it, and we do not
793 ;; want to confuse other mailers by having
794 ;; a (possibly) faulty header.
795 (progn (insert "X-") t))))
796 (setq do-search t)
797 (widen)
798 (if (or (= (+ (point) content-length) (point-max))
799 (save-excursion
800 (goto-char (+ (point) content-length))
801 (looking-at "\1f")))
802 (progn
803 (goto-char (+ (point) content-length))
804 (setq do-search nil))
805 (setq do-search t)))
806 (widen)
807 ;; Go to the beginning of the next article - or to the end
808 ;; of the buffer.
809 (when do-search
810 (if (re-search-forward "^\1f" nil t)
811 (goto-char (match-beginning 0))
812 (goto-char (1- (point-max)))))
813 (delete-char 1) ; delete ^_
814 (save-excursion
815 (save-restriction
816 (narrow-to-region start (point))
817 (goto-char (point-min))
818 (nnmail-check-duplication message-id func artnum-func)
16409b0b 819 (incf count)
eec82323 820 (setq end (point-max))))
16409b0b
GM
821 (goto-char end))
822 count))
eec82323
LMI
823
824(defsubst nnmail-search-unix-mail-delim ()
825 "Put point at the beginning of the next Unix mbox message."
b96fb65c 826 ;; Algorithm used to find the next article in the
eec82323
LMI
827 ;; brain-dead Unix mbox format:
828 ;;
829 ;; 1) Search for "^From ".
830 ;; 2) If we find it, then see whether the previous
831 ;; line is blank and the next line looks like a header.
832 ;; Then it's possible that this is a mail delim, and we use it.
833 (let ((case-fold-search nil)
834 found)
835 (while (not found)
836 (if (not (re-search-forward "^From " nil t))
837 (setq found 'no)
838 (save-excursion
839 (beginning-of-line)
840 (when (and (or (bobp)
841 (save-excursion
842 (forward-line -1)
16409b0b 843 (eq (char-after) ?\n)))
eec82323
LMI
844 (save-excursion
845 (forward-line 1)
a8151ef7 846 (while (looking-at ">From \\|From ")
eec82323
LMI
847 (forward-line 1))
848 (looking-at "[^ \n\t:]+[ \n\t]*:")))
849 (setq found 'yes)))))
850 (beginning-of-line)
851 (eq found 'yes)))
852
853(defun nnmail-search-unix-mail-delim-backward ()
854 "Put point at the beginning of the current Unix mbox message."
b96fb65c 855 ;; Algorithm used to find the next article in the
eec82323
LMI
856 ;; brain-dead Unix mbox format:
857 ;;
858 ;; 1) Search for "^From ".
859 ;; 2) If we find it, then see whether the previous
860 ;; line is blank and the next line looks like a header.
861 ;; Then it's possible that this is a mail delim, and we use it.
862 (let ((case-fold-search nil)
863 found)
864 (while (not found)
865 (if (not (re-search-backward "^From " nil t))
866 (setq found 'no)
867 (save-excursion
868 (beginning-of-line)
869 (when (and (or (bobp)
870 (save-excursion
871 (forward-line -1)
16409b0b 872 (eq (char-after) ?\n)))
eec82323
LMI
873 (save-excursion
874 (forward-line 1)
a8151ef7 875 (while (looking-at ">From \\|From ")
eec82323
LMI
876 (forward-line 1))
877 (looking-at "[^ \n\t:]+[ \n\t]*:")))
878 (setq found 'yes)))))
879 (beginning-of-line)
880 (eq found 'yes)))
881
882(defun nnmail-process-unix-mail-format (func artnum-func)
883 (let ((case-fold-search t)
16409b0b 884 (count 0)
eec82323
LMI
885 start message-id content-length end skip head-end)
886 (goto-char (point-min))
887 (if (not (and (re-search-forward "^From " nil t)
888 (goto-char (match-beginning 0))))
889 ;; Possibly wrong format?
23f87bed
MB
890 (error "Error, unknown mail format! (Possibly corrupted %s `%s'.)"
891 (if (buffer-file-name) "file" "buffer")
892 (or (buffer-file-name) (buffer-name)))
eec82323
LMI
893 ;; Carry on until the bitter end.
894 (while (not (eobp))
895 (setq start (point)
896 end nil)
897 ;; Find the end of the head.
898 (narrow-to-region
899 start
900 (if (search-forward "\n\n" nil t)
901 (1- (point))
902 ;; This will never happen, but just to be on the safe side --
903 ;; if there is no head-body delimiter, we search a bit manually.
904 (while (and (looking-at "From \\|[^ \t]+:")
905 (not (eobp)))
906 (forward-line 1))
907 (point)))
908 ;; Find the Message-ID header.
909 (goto-char (point-min))
910 (if (re-search-forward "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]+>\\)" nil t)
911 (setq message-id (match-string 1))
912 (save-excursion
913 (when (re-search-forward "^Message-ID[ \t]*:" nil t)
914 (beginning-of-line)
915 (insert "Original-")))
916 ;; There is no Message-ID here, so we create one.
917 (forward-line 1)
918 (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
919 ;; Look for a Content-Length header.
920 (goto-char (point-min))
921 (if (not (re-search-forward
922 "^Content-Length:[ \t]*\\([0-9]+\\)" nil t))
923 (setq content-length nil)
e9bd5782 924 (setq content-length (string-to-number (match-string 1)))
eec82323
LMI
925 ;; We destroy the header, since none of the backends ever
926 ;; use it, and we do not want to confuse other mailers by
927 ;; having a (possibly) faulty header.
928 (beginning-of-line)
929 (insert "X-"))
930 (run-hooks 'nnmail-prepare-incoming-header-hook)
931 ;; Find the end of this article.
932 (goto-char (point-max))
933 (widen)
934 (setq head-end (point))
935 ;; We try the Content-Length value. The idea: skip over the header
936 ;; separator, then check what happens content-length bytes into the
8f688cb0 937 ;; message body. This should be either the end of the buffer, the
eec82323
LMI
938 ;; message separator or a blank line followed by the separator.
939 ;; The blank line should probably be deleted. If neither of the
940 ;; three is met, the content-length header is probably invalid.
941 (when content-length
942 (forward-line 1)
943 (setq skip (+ (point) content-length))
944 (goto-char skip)
945 (cond ((or (= skip (point-max))
946 (= (1+ skip) (point-max)))
947 (setq end (point-max)))
948 ((looking-at "From ")
949 (setq end skip))
950 ((looking-at "[ \t]*\n\\(From \\)")
951 (setq end (match-beginning 1)))
952 (t (setq end nil))))
953 (if end
954 (goto-char end)
955 ;; No Content-Length, so we find the beginning of the next
956 ;; article or the end of the buffer.
957 (goto-char head-end)
958 (or (nnmail-search-unix-mail-delim)
959 (goto-char (point-max))))
960 ;; Allow the backend to save the article.
961 (save-excursion
962 (save-restriction
963 (narrow-to-region start (point))
964 (goto-char (point-min))
16409b0b 965 (incf count)
eec82323
LMI
966 (nnmail-check-duplication message-id func artnum-func)
967 (setq end (point-max))))
16409b0b
GM
968 (goto-char end)))
969 count))
eec82323 970
b069e5a6 971(defun nnmail-process-mmdf-mail-format (func artnum-func &optional junk-func)
eec82323
LMI
972 (let ((delim "^\^A\^A\^A\^A$")
973 (case-fold-search t)
16409b0b 974 (count 0)
eec82323
LMI
975 start message-id end)
976 (goto-char (point-min))
977 (if (not (and (re-search-forward delim nil t)
978 (forward-line 1)))
979 ;; Possibly wrong format?
16409b0b 980 (error "Error, unknown mail format! (Possibly corrupted.)")
eec82323
LMI
981 ;; Carry on until the bitter end.
982 (while (not (eobp))
983 (setq start (point))
984 ;; Find the end of the head.
985 (narrow-to-region
986 start
987 (if (search-forward "\n\n" nil t)
988 (1- (point))
989 ;; This will never happen, but just to be on the safe side --
990 ;; if there is no head-body delimiter, we search a bit manually.
991 (while (and (looking-at "From \\|[^ \t]+:")
992 (not (eobp)))
993 (forward-line 1))
994 (point)))
995 ;; Find the Message-ID header.
996 (goto-char (point-min))
997 (if (re-search-forward "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]+>\\)" nil t)
998 (setq message-id (match-string 1))
999 ;; There is no Message-ID here, so we create one.
1000 (save-excursion
1001 (when (re-search-backward "^Message-ID[ \t]*:" nil t)
1002 (beginning-of-line)
1003 (insert "Original-")))
1004 (forward-line 1)
1005 (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
1006 (run-hooks 'nnmail-prepare-incoming-header-hook)
1007 ;; Find the end of this article.
1008 (goto-char (point-max))
1009 (widen)
1010 (if (re-search-forward delim nil t)
1011 (beginning-of-line)
1012 (goto-char (point-max)))
1013 ;; Allow the backend to save the article.
1014 (save-excursion
1015 (save-restriction
1016 (narrow-to-region start (point))
1017 (goto-char (point-min))
16409b0b 1018 (incf count)
b069e5a6 1019 (nnmail-check-duplication message-id func artnum-func junk-func)
eec82323
LMI
1020 (setq end (point-max))))
1021 (goto-char end)
16409b0b
GM
1022 (forward-line 2)))
1023 count))
1024
1025(defun nnmail-process-maildir-mail-format (func artnum-func)
1026 ;; In a maildir, every file contains exactly one mail.
1027 (let ((case-fold-search t)
1028 message-id)
1029 (goto-char (point-min))
1030 ;; Find the end of the head.
1031 (narrow-to-region
1032 (point-min)
1033 (if (search-forward "\n\n" nil t)
1034 (1- (point))
1035 ;; This will never happen, but just to be on the safe side --
1036 ;; if there is no head-body delimiter, we search a bit manually.
1037 (while (and (looking-at "From \\|[^ \t]+:")
1038 (not (eobp)))
1039 (forward-line 1))
1040 (point)))
1041 ;; Find the Message-ID header.
1042 (goto-char (point-min))
1043 (if (re-search-forward "^Message-ID:[ \t]*\\(<[^>]+>\\)" nil t)
1044 (setq message-id (match-string 1))
1045 ;; There is no Message-ID here, so we create one.
1046 (save-excursion
1047 (when (re-search-backward "^Message-ID[ \t]*:" nil t)
1048 (beginning-of-line)
1049 (insert "Original-")))
1050 (forward-line 1)
1051 (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
1052 (run-hooks 'nnmail-prepare-incoming-header-hook)
1053 ;; Allow the backend to save the article.
1054 (widen)
1055 (save-excursion
1056 (goto-char (point-min))
1057 (nnmail-check-duplication message-id func artnum-func))
1058 1))
eec82323 1059
01c52d31
MB
1060(defvar nnmail-group-names-not-encoded-p nil
1061 "Non-nil means group names are not encoded.")
1062
eec82323 1063(defun nnmail-split-incoming (incoming func &optional exit-func
b069e5a6 1064 group artnum-func junk-func)
eec82323 1065 "Go through the entire INCOMING file and pick out each individual mail.
20a673b2
KY
1066FUNC will be called with the buffer narrowed to each mail.
1067INCOMING can also be a buffer object. In that case, the mail
1068will be copied over from that buffer."
23f87bed 1069 (let ( ;; If this is a group-specific split, we bind the split
eec82323
LMI
1070 ;; methods to just this group.
1071 (nnmail-split-methods (if (and group
eec82323
LMI
1072 (not nnmail-resplit-incoming))
1073 (list (list group ""))
01c52d31
MB
1074 nnmail-split-methods))
1075 (nnmail-group-names-not-encoded-p t))
20a673b2
KY
1076 ;; Insert the incoming file.
1077 (with-current-buffer (get-buffer-create nnmail-article-buffer)
eec82323 1078 (erase-buffer)
20a673b2
KY
1079 (if (bufferp incoming)
1080 (insert-buffer-substring incoming)
1081 (let ((coding-system-for-read nnmail-incoming-coding-system))
1082 (mm-insert-file-contents incoming)))
16409b0b
GM
1083 (prog1
1084 (if (zerop (buffer-size))
1085 0
1086 (goto-char (point-min))
1087 (save-excursion (run-hooks 'nnmail-prepare-incoming-hook))
1088 ;; Handle both babyl, MMDF and unix mail formats, since
1089 ;; movemail will use the former when fetching from a
1090 ;; mailbox, the latter when fetching from a file.
1091 (cond ((or (looking-at "\^L")
1092 (looking-at "BABYL OPTIONS:"))
1093 (nnmail-process-babyl-mail-format func artnum-func))
1094 ((looking-at "\^A\^A\^A\^A")
b069e5a6
G
1095 (nnmail-process-mmdf-mail-format
1096 func artnum-func junk-func))
16409b0b
GM
1097 ((looking-at "Return-Path:")
1098 (nnmail-process-maildir-mail-format func artnum-func))
1099 (t
1100 (nnmail-process-unix-mail-format func artnum-func))))
1101 (when exit-func
1102 (funcall exit-func))
1103 (kill-buffer (current-buffer))))))
eec82323 1104
b069e5a6 1105(defun nnmail-article-group (func &optional trace junk-func)
eec82323
LMI
1106 "Look at the headers and return an alist of groups that match.
1107FUNC will be called with the group name to determine the article number."
23f87bed 1108 (let ((methods (or nnmail-split-methods '(("bogus" ""))))
eec82323 1109 (obuf (current-buffer))
23f87bed 1110 group-art method grp)
6748645f 1111 (if (and (sequencep methods)
20a673b2
KY
1112 (= (length methods) 1)
1113 (not nnmail-inhibit-default-split-group))
eec82323
LMI
1114 ;; If there is only just one group to put everything in, we
1115 ;; just return a list with just this one method in.
1116 (setq group-art
1117 (list (cons (caar methods) (funcall func (caar methods)))))
1118 ;; We do actual comparison.
20a673b2
KY
1119 ;; Copy the article into the work buffer.
1120 (with-current-buffer nntp-server-buffer
eec82323 1121 (erase-buffer)
23f87bed
MB
1122 (insert-buffer-substring obuf)
1123 ;; Narrow to headers.
1124 (narrow-to-region
1125 (goto-char (point-min))
1126 (if (search-forward "\n\n" nil t)
1127 (point)
1128 (point-max)))
1129 (goto-char (point-min))
1130 ;; Decode MIME headers and charsets.
1131 (when nnmail-mail-splitting-decodes
1132 (let ((mail-parse-charset nnmail-mail-splitting-charset))
1133 (mail-decode-encoded-word-region (point-min) (point-max))))
eec82323
LMI
1134 ;; Fold continuation lines.
1135 (goto-char (point-min))
1136 (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
1137 (replace-match " " t t))
6748645f
LMI
1138 ;; Nuke pathologically long headers. Since Gnus applies
1139 ;; pathologically complex regexps to the buffer, lines
1140 ;; that are looong will take longer than the Universe's
1141 ;; existence to process.
1142 (goto-char (point-min))
1143 (while (not (eobp))
16409b0b
GM
1144 (unless (< (move-to-column nnmail-split-header-length-limit)
1145 nnmail-split-header-length-limit)
01c52d31 1146 (delete-region (point) (point-at-eol)))
16409b0b 1147 (forward-line 1))
eec82323 1148 ;; Allow washing.
6748645f 1149 (goto-char (point-min))
eec82323 1150 (run-hooks 'nnmail-split-hook)
6748645f
LMI
1151 (when (setq nnmail-split-tracing trace)
1152 (setq nnmail-split-trace nil))
a3f57c41
G
1153 (if (or (and (symbolp nnmail-split-methods)
1154 (fboundp nnmail-split-methods))
7920f982 1155 (not (consp (car-safe nnmail-split-methods)))
a3f57c41
G
1156 (and (listp nnmail-split-methods)
1157 ;; Not a regular split method, so it has to be a
1158 ;; fancy one.
1159 (not (let ((top-element (car-safe nnmail-split-methods)))
1160 (and (= 2 (length top-element))
1161 (stringp (nth 0 top-element))
1162 (stringp (nth 1 top-element)))))))
1163 (let* ((method-function
1164 (if (and (symbolp nnmail-split-methods)
1165 (fboundp nnmail-split-methods))
1166 nnmail-split-methods
1167 'nnmail-split-fancy))
1168 (split
1169 (condition-case error-info
1170 ;; `nnmail-split-methods' is a function, so we
1171 ;; just call this function here and use the
1172 ;; result.
1173 (or (funcall method-function)
1174 (and (not nnmail-inhibit-default-split-group)
1175 '("bogus")))
1176 (error
1177 (nnheader-message
1178 5 "Error in `nnmail-split-methods'; using `bogus' mail group: %S" error-info)
1179 (sit-for 1)
1180 '("bogus")))))
8753ddee 1181 (setq split (mm-delete-duplicates split))
a8151ef7
LMI
1182 ;; The article may be "cross-posted" to `junk'. What
1183 ;; to do? Just remove the `junk' spec. Don't really
1184 ;; see anything else to do...
b069e5a6
G
1185 (when (and (memq 'junk split)
1186 junk-func)
1187 (funcall junk-func 'junk))
1188 (setq split (delq 'junk split))
a8151ef7 1189 (when split
eec82323
LMI
1190 (setq group-art
1191 (mapcar
1192 (lambda (group) (cons group (funcall func group)))
1193 split))))
1194 ;; Go through the split methods to find a match.
6748645f
LMI
1195 (while (and methods
1196 (or nnmail-crosspost
1197 (not group-art)))
eec82323 1198 (goto-char (point-max))
6748645f 1199 (setq method (pop methods)
16409b0b 1200 grp (car method))
eec82323
LMI
1201 (if (or methods
1202 (not (equal "" (nth 1 method))))
1203 (when (and
1204 (ignore-errors
1205 (if (stringp (nth 1 method))
16409b0b
GM
1206 (let ((expand (string-match "\\\\[0-9&]" grp))
1207 (pos (re-search-backward (cadr method)
1208 nil t)))
1209 (and expand
1210 (setq grp (nnmail-expand-newtext grp)))
1211 pos)
eec82323 1212 ;; Function to say whether this is a match.
16409b0b 1213 (funcall (nth 1 method) grp)))
eec82323
LMI
1214 ;; Don't enter the article into the same
1215 ;; group twice.
16409b0b
GM
1216 (not (assoc grp group-art)))
1217 (push (cons grp (funcall func grp))
eec82323
LMI
1218 group-art))
1219 ;; This is the final group, which is used as a
1220 ;; catch-all.
20a673b2 1221 (when (and (not group-art)
4a3988d5
G
1222 (or (equal "" (nth 1 method))
1223 (not nnmail-inhibit-default-split-group)))
eec82323
LMI
1224 (setq group-art
1225 (list (cons (car method)
23f87bed
MB
1226 (funcall func (car method))))))))
1227 ;; Fall back on "bogus" if all else fails.
20a673b2
KY
1228 (when (and (not group-art)
1229 (not nnmail-inhibit-default-split-group))
23f87bed 1230 (setq group-art (list (cons "bogus" (funcall func "bogus"))))))
6748645f
LMI
1231 ;; Produce a trace if non-empty.
1232 (when (and trace nnmail-split-trace)
23f87bed 1233 (let ((restore (current-buffer)))
6748645f
LMI
1234 (nnheader-set-temp-buffer "*Split Trace*")
1235 (gnus-add-buffer)
23f87bed
MB
1236 (dolist (trace (nreverse nnmail-split-trace))
1237 (prin1 trace (current-buffer))
1238 (insert "\n"))
6748645f
LMI
1239 (goto-char (point-min))
1240 (gnus-configure-windows 'split-trace)
1241 (set-buffer restore)))
23f87bed 1242 (widen)
eec82323
LMI
1243 ;; See whether the split methods returned `junk'.
1244 (if (equal group-art '(junk))
1245 nil
a8151ef7
LMI
1246 ;; The article may be "cross-posted" to `junk'. What
1247 ;; to do? Just remove the `junk' spec. Don't really
1248 ;; see anything else to do...
1249 (let (elem)
1250 (while (setq elem (car (memq 'junk group-art)))
1251 (setq group-art (delq elem group-art)))
1252 (nreverse group-art)))))))
eec82323
LMI
1253
1254(defun nnmail-insert-lines ()
1255 "Insert how many lines there are in the body of the mail.
1256Return the number of characters in the body."
1257 (let (lines chars)
1258 (save-excursion
1259 (goto-char (point-min))
a1506d29 1260 (unless (search-forward "\n\n" nil t)
16409b0b
GM
1261 (goto-char (point-max))
1262 (insert "\n"))
1263 (setq chars (- (point-max) (point)))
1264 (setq lines (count-lines (point) (point-max)))
1265 (forward-char -1)
1266 (save-excursion
1267 (when (re-search-backward "^Lines: " nil t)
1268 (delete-region (point) (progn (forward-line 1) (point)))))
1269 (beginning-of-line)
1270 (insert (format "Lines: %d\n" (max lines 0)))
1271 chars)))
eec82323
LMI
1272
1273(defun nnmail-insert-xref (group-alist)
1274 "Insert an Xref line based on the (group . article) alist."
1275 (save-excursion
1276 (goto-char (point-min))
16409b0b
GM
1277 (unless (search-forward "\n\n" nil t)
1278 (goto-char (point-max))
1279 (insert "\n"))
1280 (forward-char -1)
1281 (when (re-search-backward "^Xref: " nil t)
1282 (delete-region (match-beginning 0)
1283 (progn (forward-line 1) (point))))
1284 (insert (format "Xref: %s" (system-name)))
1285 (while group-alist
01c52d31
MB
1286 (insert (if (mm-multibyte-p)
1287 (mm-string-as-multibyte
1288 (format " %s:%d" (caar group-alist) (cdar group-alist)))
1289 (mm-string-as-unibyte
1290 (format " %s:%d" (caar group-alist) (cdar group-alist)))))
16409b0b
GM
1291 (setq group-alist (cdr group-alist)))
1292 (insert "\n")))
eec82323
LMI
1293
1294;;; Message washing functions
1295
1296(defun nnmail-remove-leading-whitespace ()
1297 "Remove excessive whitespace from all headers."
1298 (goto-char (point-min))
1299 (while (re-search-forward "^\\([^ :]+: \\) +" nil t)
1300 (replace-match "\\1" t)))
1301
1302(defun nnmail-remove-list-identifiers ()
1303 "Remove list identifiers from Subject headers."
23f87bed
MB
1304 (let ((regexp
1305 (if (consp nnmail-list-identifiers)
1306 (mapconcat 'identity nnmail-list-identifiers " *\\|")
1307 nnmail-list-identifiers)))
eec82323
LMI
1308 (when regexp
1309 (goto-char (point-min))
23f87bed
MB
1310 (while (re-search-forward
1311 (concat "^Subject: +\\(R[Ee]: +\\)*\\(" regexp " *\\)")
1312 nil t)
1313 (delete-region (match-beginning 2) (match-end 0))
1314 (beginning-of-line))
1315 (when (re-search-forward "^Subject: +\\(\\(R[Ee]: +\\)+\\)R[Ee]: +"
1316 nil t)
1317 (delete-region (match-beginning 1) (match-end 1))
1318 (beginning-of-line)))))
eec82323
LMI
1319
1320(defun nnmail-remove-tabs ()
1321 "Translate TAB characters into SPACE characters."
1322 (subst-char-in-region (point-min) (point-max) ?\t ? t))
1323
01c52d31
MB
1324(defcustom nnmail-broken-references-mailers
1325 "^X-Mailer:.*\\(Eudora\\|Pegasus\\)"
1326 "Header line matching mailer producing bogus References lines.
1327See `nnmail-ignore-broken-references'."
1328 :group 'nnmail-prepare
330f707b 1329 :version "23.1" ;; No Gnus
01c52d31
MB
1330 :type 'regexp)
1331
1332(defun nnmail-ignore-broken-references ()
1333 "Ignore the References line and use In-Reply-To
1334
1335Eudora has a broken References line, but an OK In-Reply-To."
16409b0b 1336 (goto-char (point-min))
01c52d31 1337 (when (re-search-forward nnmail-broken-references-mailers nil t)
16409b0b
GM
1338 (goto-char (point-min))
1339 (when (re-search-forward "^References:" nil t)
1340 (beginning-of-line)
1341 (insert "X-Gnus-Broken-Eudora-"))
1342 (goto-char (point-min))
23f87bed
MB
1343 (when (re-search-forward "^\\(In-Reply-To:[^\n]+\\)\n[ \t]+" nil t)
1344 (replace-match "\\1" t))))
eec82323 1345
01c52d31 1346(defalias 'nnmail-fix-eudora-headers 'nnmail-ignore-broken-references)
265ac10b 1347(make-obsolete 'nnmail-fix-eudora-headers 'nnmail-ignore-broken-references "Emacs 23.1")
01c52d31 1348
16409b0b 1349(custom-add-option 'nnmail-prepare-incoming-header-hook
01c52d31 1350 'nnmail-ignore-broken-references)
eec82323 1351
16409b0b 1352;;; Utility functions
eec82323 1353
163a3c6a 1354(declare-function gnus-activate-group "gnus-start"
4f7a670a 1355 (group &optional scan dont-check method dont-sub-check))
163a3c6a 1356
23f87bed
MB
1357(defun nnmail-do-request-post (accept-func &optional server)
1358 "Utility function to directly post a message to an nnmail-derived group.
1359Calls ACCEPT-FUNC (which should be `nnchoke-request-accept-article')
1360to actually put the message in the right group."
1361 (let ((success t))
1362 (dolist (mbx (message-unquote-tokens
1363 (message-tokenize-header
1364 (message-fetch-field "Newsgroups") ", ")) success)
1365 (let ((to-newsgroup (gnus-group-prefixed-name mbx gnus-command-method)))
1366 (or (gnus-active to-newsgroup)
1367 (gnus-activate-group to-newsgroup)
1368 (if (gnus-y-or-n-p (format "No such group: %s. Create it? "
1369 to-newsgroup))
1370 (or (and (gnus-request-create-group
1371 to-newsgroup gnus-command-method)
1372 (gnus-activate-group to-newsgroup nil nil
1373 gnus-command-method))
1374 (error "Couldn't create group %s" to-newsgroup)))
1375 (error "No such group: %s" to-newsgroup))
1376 (unless (funcall accept-func mbx (nth 1 gnus-command-method))
1377 (setq success nil))))))
1378
eec82323
LMI
1379(defun nnmail-split-fancy ()
1380 "Fancy splitting method.
23f87bed 1381See the documentation for the variable `nnmail-split-fancy' for details."
01c52d31
MB
1382 (with-syntax-table nnmail-split-fancy-syntax-table
1383 (nnmail-split-it nnmail-split-fancy)))
eec82323
LMI
1384
1385(defvar nnmail-split-cache nil)
1386;; Alist of split expressions their equivalent regexps.
1387
1388(defun nnmail-split-it (split)
1389 ;; Return a list of groups matching SPLIT.
6748645f
LMI
1390 (let (cached-pair)
1391 (cond
1392 ;; nil split
1393 ((null split)
1394 nil)
1395
1396 ;; A group name. Do the \& and \N subs into the string.
1397 ((stringp split)
1398 (when nnmail-split-tracing
23f87bed 1399 (push split nnmail-split-trace))
6748645f
LMI
1400 (list (nnmail-expand-newtext split)))
1401
1402 ;; Junk the message.
1403 ((eq split 'junk)
1404 (when nnmail-split-tracing
1405 (push "junk" nnmail-split-trace))
1406 (list 'junk))
1407
1408 ;; Builtin & operation.
1409 ((eq (car split) '&)
1410 (apply 'nconc (mapcar 'nnmail-split-it (cdr split))))
1411
1412 ;; Builtin | operation.
1413 ((eq (car split) '|)
1414 (let (done)
1415 (while (and (not done) (cdr split))
1416 (setq split (cdr split)
1417 done (nnmail-split-it (car split))))
1418 done))
1419
1420 ;; Builtin : operation.
1421 ((eq (car split) ':)
23f87bed
MB
1422 (when nnmail-split-tracing
1423 (push split nnmail-split-trace))
6748645f
LMI
1424 (nnmail-split-it (save-excursion (eval (cdr split)))))
1425
16409b0b
GM
1426 ;; Builtin ! operation.
1427 ((eq (car split) '!)
1428 (funcall (cadr split) (nnmail-split-it (caddr split))))
1429
6748645f
LMI
1430 ;; Check the cache for the regexp for this split.
1431 ((setq cached-pair (assq split nnmail-split-cache))
16409b0b
GM
1432 (let (split-result
1433 (end-point (point-max))
1434 (value (nth 1 split)))
1435 (if (symbolp value)
1436 (setq value (cdr (assq value nnmail-split-abbrev-alist))))
1437 (while (and (goto-char end-point)
1438 (re-search-backward (cdr cached-pair) nil t))
1439 (when nnmail-split-tracing
23f87bed 1440 (push split nnmail-split-trace))
16409b0b
GM
1441 (let ((split-rest (cddr split))
1442 (end (match-end 0))
23f87bed
MB
1443 ;; The searched regexp is \(\(FIELD\).*\)\(VALUE\).
1444 ;; So, start-of-value is the point just before the
1445 ;; beginning of the value, whereas after-header-name
1446 ;; is the point just after the field name.
16409b0b
GM
1447 (start-of-value (match-end 1))
1448 (after-header-name (match-end 2)))
1449 ;; Start the next search just before the beginning of the
1450 ;; VALUE match.
1451 (setq end-point (1- start-of-value))
1452 ;; Handle - RESTRICTs
1453 (while (eq (car split-rest) '-)
1454 ;; RESTRICT must start after-header-name and
1455 ;; end after start-of-value, so that, for
1456 ;; (any "foo" - "x-foo" "foo.list")
1457 ;; we do not exclude foo.list just because
1458 ;; the header is: ``To: x-foo, foo''
1459 (goto-char end)
1460 (if (and (re-search-backward (cadr split-rest)
1461 after-header-name t)
1462 (> (match-end 0) start-of-value))
1463 (setq split-rest nil)
1464 (setq split-rest (cddr split-rest))))
1465 (when split-rest
1466 (goto-char end)
1467 (let ((value (nth 1 split)))
1468 (if (symbolp value)
1469 (setq value (cdr (assq value nnmail-split-abbrev-alist))))
1470 ;; Someone might want to do a \N sub on this match, so get the
1471 ;; correct match positions.
1472 (re-search-backward value start-of-value))
1473 (dolist (sp (nnmail-split-it (car split-rest)))
23f87bed 1474 (unless (member sp split-result)
16409b0b
GM
1475 (push sp split-result))))))
1476 split-result))
6748645f
LMI
1477
1478 ;; Not in cache, compute a regexp for the field/value pair.
1479 (t
61e66a15
MB
1480 (let ((field (nth 0 split))
1481 (value (nth 1 split))
1482 (split-rest (cddr split))
1483 partial-front
1484 partial-rear
1485 regexp)
16409b0b
GM
1486 (if (symbolp value)
1487 (setq value (cdr (assq value nnmail-split-abbrev-alist))))
1488 (if (and (>= (length value) 2)
1489 (string= ".*" (substring value 0 2)))
1490 (setq value (substring value 2)
23f87bed
MB
1491 partial-front ""))
1492 ;; Same trick for the rear of the regexp
1493 (if (and (>= (length value) 2)
1494 (string= ".*" (substring value -2)))
1495 (setq value (substring value 0 -2)
1496 partial-rear ""))
61e66a15
MB
1497 ;; Invert the match-partial-words behavior if the optional
1498 ;; last element is specified.
1499 (while (eq (car split-rest) '-)
1500 (setq split-rest (cddr split-rest)))
1501 (when (if (cadr split-rest)
1502 (not nnmail-split-fancy-match-partial-words)
1503 nnmail-split-fancy-match-partial-words)
23f87bed
MB
1504 (setq partial-front ""
1505 partial-rear ""))
16409b0b 1506 (setq regexp (concat "^\\(\\("
6748645f
LMI
1507 (if (symbolp field)
1508 (cdr (assq field nnmail-split-abbrev-alist))
1509 field)
16409b0b 1510 "\\):.*\\)"
23f87bed 1511 (or partial-front "\\<")
16409b0b
GM
1512 "\\("
1513 value
23f87bed
MB
1514 "\\)"
1515 (or partial-rear "\\>")))
6748645f
LMI
1516 (push (cons split regexp) nnmail-split-cache)
1517 ;; Now that it's in the cache, just call nnmail-split-it again
61e66a15 1518 ;; on the same split, which will find it immediately in the cache.
6748645f 1519 (nnmail-split-it split))))))
eec82323
LMI
1520
1521(defun nnmail-expand-newtext (newtext)
1522 (let ((len (length newtext))
1523 (pos 0)
1524 c expanded beg N did-expand)
1525 (while (< pos len)
1526 (setq beg pos)
1527 (while (and (< pos len)
1528 (not (= (aref newtext pos) ?\\)))
1529 (setq pos (1+ pos)))
1530 (unless (= beg pos)
1531 (push (substring newtext beg pos) expanded))
1532 (when (< pos len)
6748645f
LMI
1533 ;; We hit a \; expand it.
1534 (setq did-expand t
1535 pos (1+ pos)
1536 c (aref newtext pos))
eec82323
LMI
1537 (if (not (or (= c ?\&)
1538 (and (>= c ?1)
1539 (<= c ?9))))
6748645f 1540 ;; \ followed by some character we don't expand.
eec82323
LMI
1541 (push (char-to-string c) expanded)
1542 ;; \& or \N
1543 (if (= c ?\&)
1544 (setq N 0)
1545 (setq N (- c ?0)))
1546 (when (match-beginning N)
23f87bed
MB
1547 (push (if nnmail-split-lowercase-expanded
1548 (downcase (buffer-substring (match-beginning N)
1549 (match-end N)))
1550 (buffer-substring (match-beginning N) (match-end N)))
eec82323
LMI
1551 expanded))))
1552 (setq pos (1+ pos)))
1553 (if did-expand
1554 (apply 'concat (nreverse expanded))
1555 newtext)))
1556
eec82323
LMI
1557;; Activate a backend only if it isn't already activated.
1558;; If FORCE, re-read the active file even if the backend is
1559;; already activated.
1560(defun nnmail-activate (backend &optional force)
6748645f 1561 (nnheader-init-server-buffer)
eec82323
LMI
1562 (let (file timestamp file-time)
1563 (if (or (not (symbol-value (intern (format "%s-group-alist" backend))))
1564 force
1565 (and (setq file (ignore-errors
1566 (symbol-value (intern (format "%s-active-file"
1567 backend)))))
1568 (setq file-time (nth 5 (file-attributes file)))
1569 (or (not
1570 (setq timestamp
1571 (condition-case ()
1572 (symbol-value (intern
1573 (format "%s-active-timestamp"
1574 backend)))
1575 (error 'none))))
1576 (not (consp timestamp))
1577 (equal timestamp '(0 0))
1578 (> (nth 0 file-time) (nth 0 timestamp))
1579 (and (= (nth 0 file-time) (nth 0 timestamp))
1580 (> (nth 1 file-time) (nth 1 timestamp))))))
1581 (save-excursion
1582 (or (eq timestamp 'none)
1583 (set (intern (format "%s-active-timestamp" backend))
1584 file-time))
1585 (funcall (intern (format "%s-request-list" backend)))))
1586 t))
1587
1588(defun nnmail-message-id ()
1589 (concat "<" (message-unique-id) "@totally-fudged-out-message-id>"))
1590
1591;;;
1592;;; nnmail duplicate handling
1593;;;
1594
1595(defvar nnmail-cache-buffer nil)
1596
1597(defun nnmail-cache-open ()
1598 (if (or (not nnmail-treat-duplicates)
1599 (and nnmail-cache-buffer
1600 (buffer-name nnmail-cache-buffer)))
1601 () ; The buffer is open.
20a673b2 1602 (with-current-buffer
eec82323 1603 (setq nnmail-cache-buffer
20a673b2 1604 (get-buffer-create " *nnmail message-id cache*"))
23f87bed 1605 (gnus-add-buffer)
eec82323
LMI
1606 (when (file-exists-p nnmail-message-id-cache-file)
1607 (nnheader-insert-file-contents nnmail-message-id-cache-file))
1608 (set-buffer-modified-p nil)
1609 (current-buffer))))
1610
1611(defun nnmail-cache-close ()
1612 (when (and nnmail-cache-buffer
1613 nnmail-treat-duplicates
1614 (buffer-name nnmail-cache-buffer)
1615 (buffer-modified-p nnmail-cache-buffer))
20a673b2 1616 (with-current-buffer nnmail-cache-buffer
eec82323
LMI
1617 ;; Weed out the excess number of Message-IDs.
1618 (goto-char (point-max))
1619 (when (search-backward "\n" nil t nnmail-message-id-cache-length)
1620 (progn
1621 (beginning-of-line)
1622 (delete-region (point-min) (point))))
1623 ;; Save the buffer.
1624 (or (file-exists-p (file-name-directory nnmail-message-id-cache-file))
1625 (make-directory (file-name-directory nnmail-message-id-cache-file)
1626 t))
1627 (nnmail-write-region (point-min) (point-max)
1628 nnmail-message-id-cache-file nil 'silent)
1629 (set-buffer-modified-p nil)
1630 (setq nnmail-cache-buffer nil)
23f87bed 1631 (gnus-kill-buffer (current-buffer)))))
eec82323 1632
23f87bed
MB
1633(defun nnmail-cache-insert (id grp &optional subject sender)
1634 (when (stringp id)
1635 ;; this will handle cases like `B r' where the group is nil
1636 (let ((grp (or grp gnus-newsgroup-name "UNKNOWN")))
bf247b6e 1637 (run-hook-with-args 'nnmail-spool-hook
23f87bed
MB
1638 id grp subject sender))
1639 (when nnmail-treat-duplicates
1640 ;; Store some information about the group this message is written
1641 ;; to. This is passed in as the grp argument -- all locations this
1642 ;; has been called from have been checked and the group is available.
1643 ;; The only ambiguous case is nnmail-check-duplication which will only
1644 ;; pass the first (of possibly >1) group which matches. -Josh
16409b0b 1645 (unless (gnus-buffer-live-p nnmail-cache-buffer)
23f87bed 1646 (nnmail-cache-open))
20a673b2 1647 (with-current-buffer nnmail-cache-buffer
23f87bed
MB
1648 (goto-char (point-max))
1649 (if (and grp (not (string= "" grp))
1650 (gnus-methods-equal-p gnus-command-method
1651 (nnmail-cache-primary-mail-backend)))
1652 (let ((regexp (if (consp nnmail-cache-ignore-groups)
1653 (mapconcat 'identity nnmail-cache-ignore-groups
1654 "\\|")
1655 nnmail-cache-ignore-groups)))
1656 (unless (and regexp (string-match regexp grp))
1657 (insert id "\t" grp "\n")))
1658 (insert id "\n"))))))
bf247b6e 1659
16409b0b
GM
1660(defun nnmail-cache-primary-mail-backend ()
1661 (let ((be-list (cons gnus-select-method gnus-secondary-select-methods))
23f87bed
MB
1662 (be nil)
1663 (res nil)
1664 (get-new-mail nil))
16409b0b
GM
1665 (while (and (null res) be-list)
1666 (setq be (car be-list))
1667 (setq be-list (cdr be-list))
1668 (when (and (gnus-method-option-p be 'respool)
23f87bed
MB
1669 (setq get-new-mail
1670 (intern (format "%s-get-new-mail" (car be))))
1671 (boundp get-new-mail)
1672 (symbol-value get-new-mail))
1673 (setq res be)))
16409b0b
GM
1674 res))
1675
1676;; Fetch the group name corresponding to the message id stored in the
1677;; cache.
1678(defun nnmail-cache-fetch-group (id)
1679 (when (and nnmail-treat-duplicates nnmail-cache-buffer)
20a673b2 1680 (with-current-buffer nnmail-cache-buffer
eec82323 1681 (goto-char (point-max))
16409b0b 1682 (when (search-backward id nil t)
23f87bed
MB
1683 (beginning-of-line)
1684 (skip-chars-forward "^\n\r\t")
1685 (unless (looking-at "[\r\n]")
1686 (forward-char 1)
01c52d31 1687 (buffer-substring (point) (point-at-eol)))))))
16409b0b
GM
1688
1689;; Function for nnmail-split-fancy: look up all references in the
1690;; cache and if a match is found, return that group.
1691(defun nnmail-split-fancy-with-parent ()
23f87bed
MB
1692 "Split this message into the same group as its parent.
1693This function can be used as an entry in `nnmail-split-fancy', for
1694example like this: (: nnmail-split-fancy-with-parent)
1695For a message to be split, it looks for the parent message in the
1696References or In-Reply-To header and then looks in the message id
1697cache file (given by the variable `nnmail-message-id-cache-file') to
1698see which group that message was put in. This group is returned.
1699
1700See the Info node `(gnus)Fancy Mail Splitting' for more details."
16409b0b 1701 (let* ((refstr (or (message-fetch-field "references")
23f87bed
MB
1702 (message-fetch-field "in-reply-to")))
1703 (references nil)
1704 (res nil)
1705 (regexp (if (consp nnmail-split-fancy-with-parent-ignore-groups)
1706 (mapconcat
1707 (lambda (x) (format "\\(%s\\)" x))
1708 nnmail-split-fancy-with-parent-ignore-groups
1709 "\\|")
1710 nnmail-split-fancy-with-parent-ignore-groups)))
16409b0b
GM
1711 (when refstr
1712 (setq references (nreverse (gnus-split-references refstr)))
1713 (unless (gnus-buffer-live-p nnmail-cache-buffer)
23f87bed 1714 (nnmail-cache-open))
01c52d31
MB
1715 (dolist (x references)
1716 (setq res (or (nnmail-cache-fetch-group x) res))
1717 (when (or (member res '("delayed" "drafts" "queue"))
1718 (and regexp res (string-match regexp res)))
1719 (setq res nil)))
16409b0b 1720 res)))
eec82323
LMI
1721
1722(defun nnmail-cache-id-exists-p (id)
1723 (when nnmail-treat-duplicates
20a673b2 1724 (with-current-buffer nnmail-cache-buffer
eec82323
LMI
1725 (goto-char (point-max))
1726 (search-backward id nil t))))
1727
1728(defun nnmail-fetch-field (header)
1729 (save-excursion
1730 (save-restriction
1731 (message-narrow-to-head)
1732 (message-fetch-field header))))
1733
b069e5a6
G
1734(defun nnmail-check-duplication (message-id func artnum-func
1735 &optional junk-func)
eec82323
LMI
1736 (run-hooks 'nnmail-prepare-incoming-message-hook)
1737 ;; If this is a duplicate message, then we do not save it.
1738 (let* ((duplication (nnmail-cache-id-exists-p message-id))
1739 (case-fold-search t)
1740 (action (when duplication
1741 (cond
1742 ((memq nnmail-treat-duplicates '(warn delete))
1743 nnmail-treat-duplicates)
23f87bed 1744 ((functionp nnmail-treat-duplicates)
eec82323
LMI
1745 (funcall nnmail-treat-duplicates message-id))
1746 (t
1747 nnmail-treat-duplicates))))
1748 group-art)
16409b0b
GM
1749 ;; We insert a line that says what the mail source is.
1750 (let ((case-fold-search t))
1751 (goto-char (point-min))
1752 (re-search-forward "^message-id[ \t]*:" nil t)
1753 (beginning-of-line)
1754 (insert (format "X-Gnus-Mail-Source: %s\n" mail-source-string)))
1755
eec82323
LMI
1756 ;; Let the backend save the article (or not).
1757 (cond
1758 ((not duplication)
eec82323 1759 (funcall func (setq group-art
b069e5a6
G
1760 (nreverse (nnmail-article-group
1761 artnum-func nil junk-func))))
23f87bed 1762 (nnmail-cache-insert message-id (caar group-art)))
eec82323
LMI
1763 ((eq action 'delete)
1764 (setq group-art nil))
1765 ((eq action 'warn)
1766 ;; We insert a warning.
1767 (let ((case-fold-search t))
1768 (goto-char (point-min))
1769 (re-search-forward "^message-id[ \t]*:" nil t)
1770 (beginning-of-line)
1771 (insert
1772 "Gnus-Warning: This is a duplicate of message " message-id "\n")
1773 (funcall func (setq group-art
1774 (nreverse (nnmail-article-group artnum-func))))))
1775 (t
1776 (funcall func (setq group-art
1777 (nreverse (nnmail-article-group artnum-func))))))
1778 ;; Add the group-art list to the history list.
1779 (if group-art
1780 (push group-art nnmail-split-history)
1781 (delete-region (point-min) (point-max)))))
1782
1783;;; Get new mail.
1784
16409b0b
GM
1785(defvar nnmail-fetched-sources nil)
1786
eec82323
LMI
1787(defun nnmail-get-value (&rest args)
1788 (let ((sym (intern (apply 'format args))))
1789 (when (boundp sym)
1790 (symbol-value sym))))
1791
1792(defun nnmail-get-new-mail (method exit-func temp
a1da1e37 1793 &optional group spool-func)
eec82323 1794 "Read new incoming mail."
a1da1e37
MB
1795 (nnmail-get-new-mail-1 method exit-func temp group nil spool-func))
1796
1797(defun nnmail-get-new-mail-1 (method exit-func temp
1798 group in-group spool-func)
b890d447 1799 (let* ((sources mail-sources)
16409b0b 1800 fetching-sources
16409b0b
GM
1801 (i 0)
1802 (new 0)
1803 (total 0)
53964682 1804 source)
8b93df01
DL
1805 (when (and (nnmail-get-value "%s-get-new-mail" method)
1806 sources)
16409b0b 1807 (while (setq source (pop sources))
a1da1e37
MB
1808 ;; Use group's parameter
1809 (when (eq (car source) 'group)
1810 (let ((mail-sources
1811 (list
1812 (gnus-group-find-parameter
1813 (concat (symbol-name method) ":" group)
1814 'mail-source t))))
1815 (nnmail-get-new-mail-1 method exit-func temp
1816 group group spool-func))
1817 (setq source nil))
16409b0b
GM
1818 ;; Hack to only fetch the contents of a single group's spool file.
1819 (when (and (eq (car source) 'directory)
1820 (null nnmail-scan-directory-mail-source-once)
1821 group)
1822 (mail-source-bind (directory source)
1823 (setq source (append source
1824 (list
1825 :predicate
23f87bed
MB
1826 (gnus-byte-compile
1827 `(lambda (file)
1828 (string-equal
1829 ,(concat group suffix)
1830 (file-name-nondirectory file)))))))))
16409b0b
GM
1831 (when nnmail-fetched-sources
1832 (if (member source nnmail-fetched-sources)
1833 (setq source nil)
1834 (push source nnmail-fetched-sources)
1835 (push source fetching-sources)))))
1836 (when fetching-sources
eec82323
LMI
1837 ;; We first activate all the groups.
1838 (nnmail-activate method)
1839 ;; Allow the user to hook.
1840 (run-hooks 'nnmail-pre-get-new-mail-hook)
1841 ;; Open the message-id cache.
1842 (nnmail-cache-open)
16409b0b
GM
1843 ;; The we go through all the existing mail source specification
1844 ;; and fetch the mail from each.
1845 (while (setq source (pop fetching-sources))
16409b0b 1846 (when (setq new
138c0212
LMI
1847 (condition-case cond
1848 (mail-source-fetch
1849 source
1850 (gnus-byte-compile
1851 `(lambda (file orig-file)
1852 (nnmail-split-incoming
1853 file ',(intern (format "%s-save-mail" method))
1854 ',spool-func
1855 (or in-group
1856 (if (equal file orig-file)
1857 nil
1858 (nnmail-get-split-group orig-file
1859 ',source)))
1860 ',(intern (format "%s-active-number" method))))))
1861 ((error quit)
1862 (message "Mail source %s failed: %s" source cond)
1863 0)))
16409b0b
GM
1864 (incf total new)
1865 (incf i)))
eec82323 1866 ;; If we did indeed read any incoming spools, we save all info.
16409b0b 1867 (if (zerop total)
8c3e17f8
LMI
1868 (when mail-source-plugged
1869 (nnheader-message 4 "%s: Reading incoming mail (no new mail)...done"
1870 method (car source)))
e9d1aaff
KY
1871 (nnmail-save-active
1872 (nnmail-get-value "%s-group-alist" method)
1873 (nnmail-get-value "%s-active-file" method))
eec82323
LMI
1874 (when exit-func
1875 (funcall exit-func))
1876 (run-hooks 'nnmail-read-incoming-hook)
16409b0b
GM
1877 (nnheader-message 4 "%s: Reading incoming mail (%d new)...done" method
1878 total))
eec82323
LMI
1879 ;; Close the message-id cache.
1880 (nnmail-cache-close)
1881 ;; Allow the user to hook.
16409b0b 1882 (run-hooks 'nnmail-post-get-new-mail-hook))))
eec82323
LMI
1883
1884(defun nnmail-expired-article-p (group time force &optional inhibit)
0617bb00
LMI
1885 "Say whether an article that is TIME old in GROUP should be expired.
1886If TIME is nil, then return the cutoff time for oldness instead."
eec82323 1887 (if force
0617bb00
LMI
1888 (if (null time)
1889 (current-time)
1890 t)
eec82323
LMI
1891 (let ((days (or (and nnmail-expiry-wait-function
1892 (funcall nnmail-expiry-wait-function group))
1893 nnmail-expiry-wait)))
1894 (cond ((or (eq days 'never)
1895 (and (not force)
1896 inhibit))
1897 ;; This isn't an expirable group.
1898 nil)
1899 ((eq days 'immediate)
1900 ;; We expire all articles on sight.
0617bb00
LMI
1901 (if (null time)
1902 (current-time)
1903 t))
eec82323 1904 ((equal time '(0 0))
23f87bed 1905 ;; This is an ange-ftp group, and we don't have any dates.
eec82323
LMI
1906 nil)
1907 ((numberp days)
16409b0b 1908 (setq days (days-to-time days))
eec82323 1909 ;; Compare the time with the current time.
0617bb00
LMI
1910 (if (null time)
1911 (time-subtract (current-time) days)
1912 (ignore-errors (time-less-p days (time-since time)))))))))
16409b0b 1913
163a3c6a
GM
1914(declare-function gnus-group-mark-article-read "gnus-group" (group article))
1915
16409b0b 1916(defun nnmail-expiry-target-group (target group)
23f87bed
MB
1917 ;; Do not invoke this from nntp-server-buffer! At least nnfolder clears
1918 ;; that buffer if the nnfolder group isn't selected.
1919 (let (nnmail-cache-accepted-message-ids)
1920 ;; Don't enter Message-IDs into cache.
1921 ;; Let users hack it in TARGET function.
1922 (when (functionp target)
1923 (setq target (funcall target group)))
1924 (unless (eq target 'delete)
1925 (when (or (gnus-request-group target)
1926 (gnus-request-create-group target))
549c9aed 1927 (let ((group-art (gnus-request-accept-article target nil nil t)))
5be93fc8
LMI
1928 (when (and (consp group-art)
1929 (cdr group-art))
23f87bed
MB
1930 (gnus-group-mark-article-read target (cdr group-art))))))))
1931
1932(defun nnmail-fancy-expiry-target (group)
1933 "Returns a target expiry group determined by `nnmail-fancy-expiry-targets'."
1934 (let* (header
1935 (case-fold-search nil)
1936 (from (or (message-fetch-field "from") ""))
1937 (to (or (message-fetch-field "to") ""))
58090a8d 1938 (date (message-fetch-field "date"))
23f87bed 1939 (target 'delete))
58090a8d
MB
1940 (setq date (if date
1941 (condition-case err
1942 (date-to-time date)
1943 (error
1944 (message "%s" (error-message-string err))
1945 (current-time)))
1946 (current-time)))
23f87bed
MB
1947 (dolist (regexp-target-pair (reverse nnmail-fancy-expiry-targets) target)
1948 (setq header (car regexp-target-pair))
1949 (cond
1950 ;; If the header is to-from then match against the
1951 ;; To or From header
1952 ((and (equal header 'to-from)
1953 (or (string-match (cadr regexp-target-pair) from)
5255e3ff
MB
1954 (and (string-match (cadr regexp-target-pair) to)
1955 (let ((rmail-dont-reply-to-names
01c52d31 1956 (message-dont-reply-to-names)))
5255e3ff 1957 (equal (rmail-dont-reply-to from) "")))))
23f87bed
MB
1958 (setq target (format-time-string (caddr regexp-target-pair) date)))
1959 ((and (not (equal header 'to-from))
1960 (string-match (cadr regexp-target-pair)
1961 (or
1962 (message-fetch-field header)
1963 "")))
1964 (setq target
1965 (format-time-string (caddr regexp-target-pair) date)))))))
eec82323
LMI
1966
1967(defun nnmail-check-syntax ()
1968 "Check (and modify) the syntax of the message in the current buffer."
1969 (save-restriction
1970 (message-narrow-to-head)
1971 (let ((case-fold-search t))
1972 (unless (re-search-forward "^Message-ID[ \t]*:" nil t)
1973 (insert "Message-ID: " (nnmail-message-id) "\n")))))
1974
1975(defun nnmail-write-region (start end filename &optional append visit lockname)
1976 "Do a `write-region', and then set the file modes."
1613b43a 1977 (let ((coding-system-for-write nnmail-file-coding-system)
16409b0b 1978 (file-name-coding-system nnmail-pathname-coding-system))
1613b43a
KH
1979 (write-region start end filename append visit lockname)
1980 (set-file-modes filename nnmail-default-file-modes)))
eec82323
LMI
1981
1982;;;
1983;;; Status functions
1984;;;
1985
1986(defun nnmail-replace-status (name value)
1987 "Make status NAME and VALUE part of the current status line."
1988 (save-restriction
1989 (message-narrow-to-head)
1990 (let ((status (nnmail-decode-status)))
1991 (setq status (delq (member name status) status))
1992 (when value
1993 (push (cons name value) status))
1994 (message-remove-header "status")
1995 (goto-char (point-max))
1996 (insert "Status: " (nnmail-encode-status status) "\n"))))
1997
1998(defun nnmail-decode-status ()
1999 "Return a status-value alist from STATUS."
2000 (goto-char (point-min))
2001 (when (re-search-forward "^Status: " nil t)
2002 (let (name value status)
2003 (save-restriction
2004 ;; Narrow to the status.
2005 (narrow-to-region
2006 (point)
2007 (if (re-search-forward "^[^ \t]" nil t)
2008 (1- (point))
2009 (point-max)))
2010 ;; Go through all elements and add them to the list.
2011 (goto-char (point-min))
2012 (while (re-search-forward "[^ \t=]+" nil t)
2013 (setq name (match-string 0))
16409b0b 2014 (if (not (eq (char-after) ?=))
eec82323
LMI
2015 ;; Implied "yes".
2016 (setq value "yes")
2017 (forward-char 1)
16409b0b 2018 (if (not (eq (char-after) ?\"))
eec82323
LMI
2019 (if (not (looking-at "[^ \t]"))
2020 ;; Implied "no".
2021 (setq value "no")
2022 ;; Unquoted value.
2023 (setq value (match-string 0))
2024 (goto-char (match-end 0)))
2025 ;; Quoted value.
2026 (setq value (read (current-buffer)))))
2027 (push (cons name value) status)))
2028 status)))
2029
2030(defun nnmail-encode-status (status)
2031 "Return a status string from STATUS."
2032 (mapconcat
2033 (lambda (elem)
2034 (concat
2035 (car elem) "="
2036 (if (string-match "[ \t]" (cdr elem))
2037 (prin1-to-string (cdr elem))
2038 (cdr elem))))
2039 status " "))
2040
2041(defun nnmail-split-history ()
2042 "Generate an overview of where the last mail split put articles."
2043 (interactive)
2044 (unless nnmail-split-history
2045 (error "No current split history"))
2046 (with-output-to-temp-buffer "*nnmail split history*"
16409b0b
GM
2047 (with-current-buffer standard-output
2048 (fundamental-mode)) ; for Emacs 20.4+
01c52d31 2049 (dolist (elem nnmail-split-history)
eec82323
LMI
2050 (princ (mapconcat (lambda (ga)
2051 (concat (car ga) ":" (int-to-string (cdr ga))))
2052 elem
2053 ", "))
01c52d31 2054 (princ "\n"))))
eec82323 2055
6748645f
LMI
2056(defun nnmail-purge-split-history (group)
2057 "Remove all instances of GROUP from `nnmail-split-history'."
2058 (let ((history nnmail-split-history))
2059 (while history
23f87bed 2060 (setcar history (gnus-remove-if (lambda (e) (string= (car e) group))
6748645f
LMI
2061 (car history)))
2062 (pop history))
2063 (setq nnmail-split-history (delq nil nnmail-split-history))))
2064
eec82323
LMI
2065(defun nnmail-new-mail-p (group)
2066 "Say whether GROUP has new mail."
2067 (let ((his nnmail-split-history)
2068 found)
2069 (while his
2070 (when (assoc group (pop his))
2071 (setq found t
2072 his nil)))
2073 found))
2074
6748645f
LMI
2075(defun nnmail-within-headers-p ()
2076 "Check to see if point is within the headers of a unix mail message.
2077Doesn't change point."
2078 (let ((pos (point)))
2079 (save-excursion
2080 (and (nnmail-search-unix-mail-delim-backward)
2081 (not (search-forward "\n\n" pos t))))))
2082
eec82323
LMI
2083(run-hooks 'nnmail-load-hook)
2084
2085(provide 'nnmail)
2086
2087;;; nnmail.el ends here