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