annotate lisp/nnmail.el @ 15417:4b19cdee5567

Comment change.
author Richard M. Stallman <rms@gnu.org>
date Wed, 12 Jun 1996 17:56:46 +0000
parents 1e407d249337
children 530d0d516a42
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
13401
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1 ;;; nnmail.el --- mail support functions for the Gnus mail backends
14169
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 13999
diff changeset
2
13401
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
3 ;; Copyright (C) 1995 Free Software Foundation, Inc.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
4
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
5 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
6 ;; Keywords: news, mail
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
7
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
8 ;; This file is part of GNU Emacs.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
9
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
11 ;; it under the terms of the GNU General Public License as published by
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
12 ;; the Free Software Foundation; either version 2, or (at your option)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
13 ;; any later version.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
14
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
15 ;; GNU Emacs is distributed in the hope that it will be useful,
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
18 ;; GNU General Public License for more details.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
19
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
20 ;; You should have received a copy of the GNU General Public License
14169
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 13999
diff changeset
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 13999
diff changeset
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 13999
diff changeset
23 ;; Boston, MA 02111-1307, USA.
13401
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
24
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
25 ;;; Commentary:
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
26
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
27 ;;; Code:
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
28
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
29 (require 'nnheader)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
30 (require 'rmail)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
31 (require 'timezone)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
32 (require 'sendmail)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
33
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
34 (defvar nnmail-split-methods
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
35 '(("mail.misc" ""))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
36 "*Incoming mail will be split according to this variable.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
37
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
38 If you'd like, for instance, one mail group for mail from the
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
39 \"4ad-l\" mailing list, one group for junk mail and one for everything
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
40 else, you could do something like this:
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
41
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
42 (setq nnmail-split-methods
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
43 '((\"mail.4ad\" \"From:.*4ad\")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
44 (\"mail.junk\" \"From:.*Lars\\\\|Subject:.*buy\")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
45 (\"mail.misc\" \"\")))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
46
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
47 As you can see, this variable is a list of lists, where the first
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
48 element in each \"rule\" is the name of the group (which, by the way,
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
49 does not have to be called anything beginning with \"mail\",
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
50 \"yonka.zow\" is a fine, fine name), and the second is a regexp that
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
51 nnmail will try to match on the header to find a fit.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
52
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
53 The second element can also be a function. In that case, it will be
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
54 called narrowed to the headers with the first element of the rule as
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
55 the argument. It should return a non-nil value if it thinks that the
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
56 mail belongs in that group.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
57
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
58 The last element should always have \"\" as the regexp.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
59
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
60 This variable can also have a function as its value.")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
61
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
62 ;; Suggested by Erik Selberg <speed@cs.washington.edu>.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
63 (defvar nnmail-crosspost t
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
64 "*If non-nil, do crossposting if several split methods match the mail.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
65 If nil, the first match found will be used.")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
66
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
67 ;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit).
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
68 (defvar nnmail-keep-last-article nil
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
69 "*If non-nil, nnmail will never delete the last expired article in a
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
70 directory. You may need to set this variable if other programs are putting
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
71 new mail into folder numbers that Gnus has marked as expired.")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
72
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
73 (defvar nnmail-expiry-wait 7
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
74 "*Articles that are older than `nnmail-expiry-wait' days will be expired.")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
75
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
76 (defvar nnmail-expiry-wait-function nil
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
77 "*Variable that holds function to specify how old articles should be before they are expired.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
78 The function will be called with the name of the group that the
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
79 expiry is to be performed in, and it should return an integer that
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
80 says how many days an article can be stored before it is considered
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
81 'old'.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
82
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
83 Eg.:
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
84
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
85 (setq nnmail-expiry-wait-function
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
86 (lambda (newsgroup)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
87 (cond ((string-match \"private\" newsgroup) 31)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
88 ((string-match \"junk\" newsgroup) 1)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
89 (t 7))))")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
90
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
91 (defvar nnmail-spool-file
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
92 (or (getenv "MAIL")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
93 (concat "/usr/spool/mail/" (user-login-name)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
94 "Where the mail backends will look for incoming mail.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
95 This variable is \"/usr/spool/mail/$user\" by default.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
96 If this variable is nil, no mail backends will read incoming mail.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
97 If this variable is a list, all files mentioned in this list will be
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
98 used as incoming mailboxes.")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
99
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
100 (defvar nnmail-use-procmail nil
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
101 "*If non-nil, the mail backends will look in `nnmail-procmail-directory' for spool files.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
102 The file(s) in `nnmail-spool-file' will also be read.")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
103
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
104 (defvar nnmail-procmail-directory "~/incoming/"
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
105 "*When using procmail (and the like), incoming mail is put in this directory.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
106 The Gnus mail backends will read the mail from this directory.")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
107
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
108 (defvar nnmail-procmail-suffix ".spool"
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
109 "*Suffix of files created by procmail (and the like).
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
110 This variable might be a suffix-regexp to match the suffixes of
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
111 several files - eg. \".spool[0-9]*\".")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
112
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
113 (defvar nnmail-resplit-incoming nil
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
114 "*If non-nil, re-split incoming procmail sorted mail.")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
115
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
116 (defvar nnmail-movemail-program "movemail"
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
117 "*A command to be executed to move mail from the inbox.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
118 The default is \"movemail\".")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
119
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
120 (defvar nnmail-read-incoming-hook nil
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
121 "*Hook that will be run after the incoming mail has been transferred.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
122 The incoming mail is moved from `nnmail-spool-file' (which normally is
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
123 something like \"/usr/spool/mail/$user\") to the user's home
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
124 directory. This hook is called after the incoming mail box has been
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
125 emptied, and can be used to call any mail box programs you have
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
126 running (\"xwatch\", etc.)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
127
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
128 Eg.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
129
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
130 (add-hook 'nnmail-read-incoming-hook
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
131 (lambda ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
132 (start-process \"mailsend\" nil
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
133 \"/local/bin/mailsend\" \"read\" \"mbox\")))")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
134
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
135 ;; Suggested by Erik Selberg <speed@cs.washington.edu>.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
136 (defvar nnmail-prepare-incoming-hook nil
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
137 "*Hook called before treating incoming mail.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
138 The hook is run in a buffer with all the new, incoming mail.")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
139
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
140 ;; Suggested by Mejia Pablo J <pjm9806@usl.edu>.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
141 (defvar nnmail-tmp-directory nil
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
142 "*If non-nil, use this directory for temporary storage when reading incoming mail.")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
143
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
144 (defvar nnmail-large-newsgroup 50
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
145 "*The number of the articles which indicates a large newsgroup.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
146 If the number of the articles is greater than the value, verbose
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
147 messages will be shown to indicate the current status.")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
148
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
149 (defvar nnmail-split-fancy "mail.misc"
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
150 "*Incoming mail can be split according to this fancy variable.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
151 To enable this, set `nnmail-split-methods' to `nnmail-split-fancy'.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
152
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
153 The format is this variable is SPLIT, where SPLIT can be one of
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
154 the following:
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
155
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
156 GROUP: Mail will be stored in GROUP (a string).
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
157
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
158 \(FIELD VALUE SPLIT): If the message field FIELD (a regexp) contains
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
159 VALUE (a regexp), store the messages as specified by SPLIT.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
160
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
161 \(| SPLIT...): Process each SPLIT expression until one of them matches.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
162 A SPLIT expression is said to match if it will cause the mail
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
163 message to be stored in one or more groups.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
164
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
165 \(& SPLIT...): Process each SPLIT expression.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
166
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
167 FIELD must match a complete field name. VALUE must match a complete
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
168 word according to the fundamental mode syntax table. You can use .*
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
169 in the regexps to match partial field names or words.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
170
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
171 FIELD and VALUE can also be lisp symbols, in that case they are expanded
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
172 as specified in `nnmail-split-abbrev-alist'.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
173
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
174 Example:
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
175
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
176 \(setq nnmail-split-methods 'nnmail-split-fancy
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
177 nnmail-split-fancy
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
178 ;; Messages from the mailer deamon are not crossposted to any of
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
179 ;; the ordinary groups. Warnings are put in a separate group
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
180 ;; from real errors.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
181 '(| (\"from\" mail (| (\"subject\" \"warn.*\" \"mail.warning\")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
182 \"mail.misc\"))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
183 ;; Non-error messages are crossposted to all relevant
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
184 ;; groups, but we don't crosspost between the group for the
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
185 ;; (ding) list and the group for other (ding) related mail.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
186 (& (| (any \"ding@ifi\\\\.uio\\\\.no\" \"ding.list\")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
187 (\"subject\" \"ding\" \"ding.misc\"))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
188 ;; Other mailing lists...
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
189 (any \"procmail@informatik\\\\.rwth-aachen\\\\.de\" \"procmail.list\")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
190 (any \"SmartList@informatik\\\\.rwth-aachen\\\\.de\" \"SmartList.list\")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
191 ;; People...
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
192 (any \"larsi@ifi\\\\.uio\\\\.no\" \"people.Lars Magne Ingebrigtsen\"))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
193 ;; Unmatched mail goes to the catch all group.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
194 \"misc.misc\"))")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
195
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
196 (defvar nnmail-split-abbrev-alist
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
197 '((any . "from\\|to\\|cc\\|sender\\|apparently-to")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
198 (mail . "mailer-daemon\\|postmaster"))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
199 "*Alist of abbreviations allowed in `nnmail-split-fancy'.")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
200
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
201 (defvar nnmail-delete-incoming t
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
202 "*If non-nil, the mail backends will delete incoming files after splitting.")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
203
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
204 (defvar nnmail-message-id-cache-length 1000
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
205 "*The approximate number of Message-IDs nnmail will keep in its cache.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
206 If this variable is nil, no checking on duplicate messages will be
13999
844367c3fd0f (nnmail-message-id-cache-length): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 13401
diff changeset
207 performed.")
13401
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
208
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
209 (defvar nnmail-message-id-cache-file "~/.nnmail-cache"
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
210 "*The file name of the nnmail Message-ID cache.")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
211
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
212 (defvar nnmail-delete-duplicates nil
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
213 "*If non-nil, nnmail will delete any duplicate mails it sees.")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
214
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
215
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
216
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
217 (defconst nnmail-version "nnmail 1.0"
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
218 "nnmail version.")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
219
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
220
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
221
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
222 (defun nnmail-request-post (&optional server)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
223 (mail-send-and-exit nil))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
224
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
225 (defun nnmail-request-post-buffer (post group subject header article-buffer
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
226 info follow-to respect-poster)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
227 (let ((method-address (cdr (assq 'to-address (nth 5 info))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
228 from date to reply-to message-of
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
229 references message-id cc new-cc sendto elt)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
230 (setq method-address
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
231 (if (and (stringp method-address)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
232 (string= method-address ""))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
233 nil method-address))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
234 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
235 (set-buffer (get-buffer-create "*mail*"))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
236 (mail-mode)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
237 (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
238 (if (and (buffer-modified-p)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
239 (> (buffer-size) 0)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
240 (not (y-or-n-p "Unsent mail being composed; erase it? ")))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
241 ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
242 (erase-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
243 (if post
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
244 (progn
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
245 (mail-setup method-address subject nil nil nil nil)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
246 (auto-save-mode auto-save-default))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
247 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
248 (set-buffer article-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
249 (goto-char (point-min))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
250 (narrow-to-region (point-min)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
251 (progn (search-forward "\n\n") (point)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
252 (let ((buffer-read-only nil))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
253 (set-text-properties (point-min) (point-max) nil))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
254 (setq from (mail-header-from header))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
255 (setq date (mail-header-date header))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
256 (and from
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
257 (let ((stop-pos
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
258 (string-match " *at \\| *@ \\| *(\\| *<" from)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
259 (setq message-of
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
260 (concat (if stop-pos (substring from 0 stop-pos) from)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
261 "'s message of " date))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
262 (setq cc (mail-strip-quoted-names (or (mail-fetch-field "cc") "")))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
263 (setq to (mail-strip-quoted-names (or (mail-fetch-field "to") "")))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
264 (setq new-cc (rmail-dont-reply-to
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
265 (concat (or to "")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
266 (if cc (concat (if to ", " "") cc) ""))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
267 (let ((rmail-dont-reply-to-names
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
268 (regexp-quote (mail-strip-quoted-names
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
269 (or method-address reply-to from "")))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
270 (setq new-cc (rmail-dont-reply-to new-cc)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
271 (setq subject (mail-header-subject header))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
272 (or (string-match "^[Rr][Ee]:" subject)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
273 (setq subject (concat "Re: " subject)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
274 (setq reply-to (mail-fetch-field "reply-to"))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
275 (setq references (mail-header-references header))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
276 (setq message-id (mail-header-id header))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
277 (widen))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
278 (setq news-reply-yank-from from)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
279 (setq news-reply-yank-message-id message-id)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
280
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
281 ;; Gather the "to" addresses out of the follow-to list and remove
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
282 ;; them as we go.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
283 (if (and follow-to (listp follow-to))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
284 (while (setq elt (assoc "To" follow-to))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
285 (setq sendto (concat sendto (and sendto ", ") (cdr elt)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
286 (setq follow-to (delq elt follow-to))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
287 (mail-setup (if (and follow-to (listp follow-to))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
288 sendto
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
289 (or method-address reply-to from ""))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
290 subject message-of
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
291 (if (zerop (length new-cc)) nil new-cc)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
292 article-buffer nil)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
293 (auto-save-mode auto-save-default)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
294 ;; Note that "To" elements should already be in the message.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
295 (if (and follow-to (listp follow-to))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
296 (progn
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
297 (goto-char (point-min))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
298 (re-search-forward "^To:" nil t)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
299 (beginning-of-line)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
300 (forward-line 1)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
301 (while follow-to
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
302 (insert
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
303 (car (car follow-to)) ": " (cdr (car follow-to)) "\n")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
304 (setq follow-to (cdr follow-to)))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
305 (nnheader-insert-references references message-id)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
306 (current-buffer))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
307
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
308 (defun nnmail-find-file (file)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
309 "Insert FILE in server buffer safely."
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
310 (set-buffer nntp-server-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
311 (erase-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
312 (condition-case ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
313 (progn (insert-file-contents file) t)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
314 (file-error nil)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
315
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
316 (defun nnmail-article-pathname (group mail-dir)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
317 "Make pathname for GROUP."
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
318 (concat (file-name-as-directory (expand-file-name mail-dir))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
319 (nnmail-replace-chars-in-string group ?. ?/) "/"))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
320
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
321 (defun nnmail-replace-chars-in-string (string from to)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
322 "Replace characters in STRING from FROM to TO."
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
323 (let ((string (substring string 0)) ;Copy string.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
324 (len (length string))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
325 (idx 0))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
326 ;; Replace all occurrences of FROM with TO.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
327 (while (< idx len)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
328 (if (= (aref string idx) from)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
329 (aset string idx to))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
330 (setq idx (1+ idx)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
331 string))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
332
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
333 (defun nnmail-days-between (date1 date2)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
334 ;; Return the number of days between date1 and date2.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
335 (let ((d1 (mapcar (lambda (s) (and s (string-to-int s)) )
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
336 (timezone-parse-date date1)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
337 (d2 (mapcar (lambda (s) (and s (string-to-int s)) )
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
338 (timezone-parse-date date2))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
339 (- (timezone-absolute-from-gregorian
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
340 (nth 1 d1) (nth 2 d1) (car d1))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
341 (timezone-absolute-from-gregorian
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
342 (nth 1 d2) (nth 2 d2) (car d2)))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
343
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
344 ;; Function taken from rmail.el.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
345 (defun nnmail-move-inbox (inbox tofile)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
346 (let ((inbox (file-truename
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
347 (expand-file-name (substitute-in-file-name inbox))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
348 movemail popmail errors)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
349 ;; Check whether the inbox is to be moved to the special tmp dir.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
350 (if nnmail-tmp-directory
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
351 (setq tofile (concat (file-name-as-directory nnmail-tmp-directory)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
352 (file-name-nondirectory tofile))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
353 ;; Make the filename unique.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
354 (setq tofile (nnmail-make-complex-temp-name (expand-file-name tofile)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
355 ;; We create the directory the tofile is to reside in if it
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
356 ;; doesn't exist.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
357 (or (file-exists-p (file-name-directory tofile))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
358 (make-directory tofile 'parents))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
359 ;; If getting from mail spool directory,
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
360 ;; use movemail to move rather than just renaming,
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
361 ;; so as to interlock with the mailer.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
362 (or (setq popmail (string-match "^po:" (file-name-nondirectory inbox)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
363 (setq movemail t))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
364 (if popmail (setq inbox (file-name-nondirectory inbox)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
365 (if movemail
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
366 ;; On some systems, /usr/spool/mail/foo is a directory
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
367 ;; and the actual inbox is /usr/spool/mail/foo/foo.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
368 (if (file-directory-p inbox)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
369 (setq inbox (expand-file-name (user-login-name) inbox))))
15416
1e407d249337 (nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents: 14323
diff changeset
370 (cond
1e407d249337 (nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents: 14323
diff changeset
371 (popmail
1e407d249337 (nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents: 14323
diff changeset
372 (if (and rmail-pop-password-required (not rmail-pop-password))
1e407d249337 (nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents: 14323
diff changeset
373 (setq rmail-pop-password
1e407d249337 (nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents: 14323
diff changeset
374 (rmail-read-passwd
1e407d249337 (nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents: 14323
diff changeset
375 (format "Password for %s: "
1e407d249337 (nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents: 14323
diff changeset
376 (substring tofile (+ popmail 3))))))
1e407d249337 (nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents: 14323
diff changeset
377 (message "Getting mail from post office ..."))
1e407d249337 (nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents: 14323
diff changeset
378 ((or (and (file-exists-p tofile)
1e407d249337 (nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents: 14323
diff changeset
379 (/= 0 (nth 7 (file-attributes tofile))))
1e407d249337 (nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents: 14323
diff changeset
380 (and (file-exists-p inbox)
1e407d249337 (nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents: 14323
diff changeset
381 (/= 0 (nth 7 (file-attributes inbox)))))
1e407d249337 (nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents: 14323
diff changeset
382 (message "Getting mail from %s..." inbox)))
13401
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
383 ;; Set TOFILE if have not already done so, and
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
384 ;; rename or copy the file INBOX to TOFILE if and as appropriate.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
385 (cond ((or (file-exists-p tofile) (and (not popmail)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
386 (not (file-exists-p inbox))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
387 nil)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
388 ((and (not movemail) (not popmail))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
389 ;; Try copying. If that fails (perhaps no space),
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
390 ;; rename instead.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
391 (condition-case nil
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
392 (copy-file inbox tofile nil)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
393 (error
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
394 ;; Third arg is t so we can replace existing file TOFILE.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
395 (rename-file inbox tofile t)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
396 ;; Make the real inbox file empty.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
397 ;; Leaving it deleted could cause lossage
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
398 ;; because mailers often won't create the file.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
399 (condition-case ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
400 (write-region (point) (point) inbox)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
401 (file-error nil)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
402 (t
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
403 (unwind-protect
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
404 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
405 (setq errors (generate-new-buffer " *nnmail loss*"))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
406 (buffer-disable-undo errors)
15416
1e407d249337 (nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents: 14323
diff changeset
407 (if rmail-pop-password
1e407d249337 (nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents: 14323
diff changeset
408 (call-process
1e407d249337 (nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents: 14323
diff changeset
409 (expand-file-name nnmail-movemail-program exec-directory)
1e407d249337 (nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents: 14323
diff changeset
410 nil errors nil inbox tofile rmail-pop-password)
1e407d249337 (nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents: 14323
diff changeset
411 (call-process
1e407d249337 (nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents: 14323
diff changeset
412 (expand-file-name nnmail-movemail-program exec-directory)
1e407d249337 (nnmail-move-inbox): Prompt for POP3 password if
Richard M. Stallman <rms@gnu.org>
parents: 14323
diff changeset
413 nil errors nil inbox tofile))
13401
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
414 (if (not (buffer-modified-p errors))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
415 ;; No output => movemail won
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
416 nil
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
417 (set-buffer errors)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
418 (subst-char-in-region (point-min) (point-max) ?\n ?\ )
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
419 (goto-char (point-max))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
420 (skip-chars-backward " \t")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
421 (delete-region (point) (point-max))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
422 (goto-char (point-min))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
423 (if (looking-at "movemail: ")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
424 (delete-region (point-min) (match-end 0)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
425 (beep t)
14323
b418ef5f5ae1 (nnmail-move-inbox): Pass proper format string to message.
Karl Heuer <kwzh@gnu.org>
parents: 14169
diff changeset
426 (message "movemail: %s"
b418ef5f5ae1 (nnmail-move-inbox): Pass proper format string to message.
Karl Heuer <kwzh@gnu.org>
parents: 14169
diff changeset
427 (buffer-substring (point-min)
b418ef5f5ae1 (nnmail-move-inbox): Pass proper format string to message.
Karl Heuer <kwzh@gnu.org>
parents: 14169
diff changeset
428 (point-max)))
13401
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
429 (sit-for 3)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
430 nil)))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
431 (and errors
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
432 (buffer-name errors)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
433 (kill-buffer errors))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
434 tofile))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
435
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
436
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
437 (defun nnmail-get-active ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
438 "Returns an assoc of group names and active ranges.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
439 nn*-request-list should have been called before calling this function."
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
440 (let (group-assoc)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
441 ;; Go through all groups from the active list.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
442 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
443 (set-buffer nntp-server-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
444 (goto-char (point-min))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
445 (while (re-search-forward
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
446 "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)" nil t)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
447 (setq group-assoc
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
448 (cons (list (buffer-substring (match-beginning 1)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
449 (match-end 1))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
450 (cons (string-to-int
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
451 (buffer-substring (match-beginning 3)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
452 (match-end 3)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
453 (string-to-int
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
454 (buffer-substring (match-beginning 2)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
455 (match-end 2)))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
456 group-assoc))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
457
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
458 ;; ;; In addition, add all groups mentioned in `nnmail-split-methods'.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
459 ;; (let ((methods (and (not (symbolp nnmail-split-methods))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
460 ;; nnmail-split-methods)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
461 ;; (while methods
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
462 ;; (if (not (assoc (car (car methods)) group-assoc))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
463 ;; (setq group-assoc
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
464 ;; (cons (list (car (car methods)) (cons 1 0))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
465 ;; group-assoc)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
466 ;; (setq methods (cdr methods)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
467
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
468 group-assoc))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
469
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
470 (defun nnmail-save-active (group-assoc file-name)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
471 (let (group)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
472 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
473 (set-buffer (get-buffer-create " *nnmail active*"))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
474 (buffer-disable-undo (current-buffer))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
475 (erase-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
476 (while group-assoc
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
477 (setq group (car group-assoc))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
478 (insert (format "%s %d %d y\n" (car group) (cdr (car (cdr group)) )
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
479 (car (car (cdr group)))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
480 (setq group-assoc (cdr group-assoc)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
481 (write-region 1 (point-max) (expand-file-name file-name) nil 'nomesg)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
482 (kill-buffer (current-buffer)))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
483
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
484 (defun nnmail-get-split-group (file group)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
485 (if (or (eq nnmail-spool-file 'procmail)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
486 nnmail-use-procmail)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
487 (cond (group group)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
488 ((string-match (concat "^" (expand-file-name
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
489 (file-name-as-directory
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
490 nnmail-procmail-directory))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
491 "\\(.*\\)" nnmail-procmail-suffix "$")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
492 (expand-file-name file))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
493 (substring (expand-file-name file)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
494 (match-beginning 1) (match-end 1)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
495 (t
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
496 group))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
497 group))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
498
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
499 (defun nnmail-split-incoming (incoming func &optional dont-kill group)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
500 "Go through the entire INCOMING file and pick out each individual mail.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
501 FUNC will be called with the buffer narrowed to each mail."
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
502 (let ((delim (concat "^" rmail-unix-mail-delimiter))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
503 ;; If this is a group-specific split, we bind the split
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
504 ;; methods to just this group.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
505 (nnmail-split-methods (if (and group
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
506 (or (eq nnmail-spool-file 'procmail)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
507 nnmail-use-procmail)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
508 (not nnmail-resplit-incoming))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
509 (list (list group ""))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
510 nnmail-split-methods))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
511 start end content-length do-search message-id)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
512 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
513 ;; Open the message-id cache.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
514 (nnmail-cache-open)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
515 ;; Insert the incoming file.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
516 (set-buffer (get-buffer-create " *nnmail incoming*"))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
517 (buffer-disable-undo (current-buffer))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
518 (erase-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
519 (insert-file-contents incoming)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
520 (goto-char (point-min))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
521 (save-excursion (run-hooks 'nnmail-prepare-incoming-hook))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
522 ;; Go to the beginning of the first mail...
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
523 (if (and (re-search-forward delim nil t)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
524 (goto-char (match-beginning 0)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
525 ;; and then carry on until the bitter end.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
526 (while (not (eobp))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
527 (setq start (point))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
528 ;; Skip all the headers in case there are more "From "s...
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
529 (if (not (search-forward "\n\n" nil t))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
530 (forward-line 1))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
531 ;; Find the Message-ID header.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
532 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
533 (if (re-search-backward "^Message-ID:[ \t]*\\(<[^>]*>\\)" nil t)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
534 (setq message-id (buffer-substring (match-beginning 1)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
535 (match-end 1)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
536 ;; There is no Message-ID here, so we create one.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
537 (forward-line -1)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
538 (insert "Message-ID: " (setq message-id (nnmail-message-id))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
539 "\n")))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
540 ;; Look for a Content-Length header.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
541 (if (not (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
542 (and (re-search-backward
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
543 "^Content-Length: \\([0-9]+\\)" start t)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
544 (setq content-length (string-to-int
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
545 (buffer-substring
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
546 (match-beginning 1)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
547 (match-end 1))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
548 ;; We destroy the header, since none of
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
549 ;; the backends ever use it, and we do not
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
550 ;; want to confuse other mailers by having
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
551 ;; a (possibly) faulty header.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
552 (progn (insert "X-") t))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
553 (setq do-search t)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
554 (if (or (= (+ (point) content-length) (point-max))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
555 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
556 (goto-char (+ (point) content-length))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
557 (looking-at delim)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
558 (progn
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
559 (goto-char (+ (point) content-length))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
560 (setq do-search nil))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
561 (setq do-search t)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
562 ;; Go to the beginning of the next article - or to the end
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
563 ;; of the buffer.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
564 (if do-search
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
565 (if (re-search-forward delim nil t)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
566 (goto-char (match-beginning 0))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
567 (goto-char (point-max))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
568 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
569 (save-restriction
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
570 (narrow-to-region start (point))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
571 (goto-char (point-min))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
572 ;; If this is a duplicate message, then we do not save it.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
573 (if (nnmail-cache-id-exists-p message-id)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
574 (delete-region (point-min) (point-max))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
575 (nnmail-cache-insert message-id)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
576 (funcall func))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
577 (setq end (point-max))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
578 (goto-char end)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
579 ;; Close the message-id cache.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
580 (nnmail-cache-close)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
581 (if dont-kill
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
582 (current-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
583 (kill-buffer (current-buffer))))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
584
13999
844367c3fd0f (nnmail-message-id-cache-length): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 13401
diff changeset
585 ;; Mail crossposts suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
13401
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
586 (defun nnmail-article-group (func)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
587 "Look at the headers and return an alist of groups that match.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
588 FUNC will be called with the group name to determine the article number."
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
589 (let ((methods nnmail-split-methods)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
590 (obuf (current-buffer))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
591 (beg (point-min))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
592 end group-art)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
593 (if (and (sequencep methods) (= (length methods) 1))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
594 ;; If there is only just one group to put everything in, we
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
595 ;; just return a list with just this one method in.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
596 (setq group-art
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
597 (list (cons (car (car methods))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
598 (funcall func (car (car methods))))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
599 ;; We do actual comparison.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
600 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
601 ;; Find headers.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
602 (goto-char beg)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
603 (setq end (if (search-forward "\n\n" nil t) (point) (point-max)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
604 (set-buffer (get-buffer-create " *nnmail work*"))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
605 (buffer-disable-undo (current-buffer))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
606 (erase-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
607 ;; Copy the headers into the work buffer.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
608 (insert-buffer-substring obuf beg end)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
609 ;; Fold continuation lines.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
610 (goto-char (point-min))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
611 (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
612 (replace-match " " t t))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
613 (if (and (symbolp nnmail-split-methods)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
614 (fboundp nnmail-split-methods))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
615 (setq group-art
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
616 (mapcar
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
617 (lambda (group) (cons group (funcall func group)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
618 (condition-case nil
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
619 (funcall nnmail-split-methods)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
620 (error
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
621 (message "\
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
622 Problems with `nnmail-split-methods', using `bogus' mail group")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
623 (sit-for 1)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
624 '("bogus")))))
13999
844367c3fd0f (nnmail-message-id-cache-length): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 13401
diff changeset
625 ;; Go through the split methods to find a match.
13401
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
626 (while (and methods (or nnmail-crosspost (not group-art)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
627 (goto-char (point-max))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
628 (if (or (cdr methods)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
629 (not (equal "" (nth 1 (car methods)))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
630 (if (and (condition-case ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
631 (if (stringp (nth 1 (car methods)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
632 (re-search-backward
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
633 (car (cdr (car methods))) nil t)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
634 ;; Suggested by Brian Edmonds
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
635 ;; <edmonds@cs.ubc.ca>.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
636 (funcall (nth 1 (car methods))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
637 (car (car methods))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
638 (error nil))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
639 ;; Don't enter the article into the same group twice.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
640 (not (assoc (car (car methods)) group-art)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
641 (setq group-art
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
642 (cons (cons (car (car methods))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
643 (funcall func (car (car methods))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
644 group-art)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
645 (or group-art
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
646 (setq group-art
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
647 (list (cons (car (car methods))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
648 (funcall func (car (car methods))))))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
649 (setq methods (cdr methods))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
650 (kill-buffer (current-buffer))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
651 group-art))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
652
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
653 (defun nnmail-insert-lines ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
654 "Insert how many lines and chars there are in the body of the mail."
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
655 (let (lines chars)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
656 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
657 (goto-char (point-min))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
658 (if (search-forward "\n\n" nil t)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
659 (progn
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
660 (setq chars (- (point-max) (point)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
661 (setq lines (- (count-lines (point) (point-max)) 1))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
662 (forward-char -1)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
663 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
664 (if (re-search-backward "^Lines: " nil t)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
665 (delete-region (point) (progn (forward-line 1) (point)))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
666 (insert (format "Lines: %d\n" lines))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
667 chars)))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
668
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
669 (defun nnmail-insert-xref (group-alist)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
670 "Insert an Xref line based on the (group . article) alist."
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
671 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
672 (goto-char (point-min))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
673 (if (search-forward "\n\n" nil t)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
674 (progn
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
675 (forward-char -1)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
676 (if (re-search-backward "^Xref: " nil t)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
677 (delete-region (match-beginning 0)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
678 (progn (forward-line 1) (point))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
679 (insert (format "Xref: %s" (system-name)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
680 (while group-alist
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
681 (insert (format " %s:%d" (car (car group-alist))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
682 (cdr (car group-alist))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
683 (setq group-alist (cdr group-alist)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
684 (insert "\n")))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
685
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
686 ;; Written by byer@mv.us.adobe.com (Scott Byer).
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
687 (defun nnmail-make-complex-temp-name (prefix)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
688 (let ((newname (make-temp-name prefix))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
689 (newprefix prefix))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
690 (while (file-exists-p newname)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
691 (setq newprefix (concat newprefix "x"))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
692 (setq newname (make-temp-name newprefix)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
693 newname))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
694
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
695 ;; Written by Per Abrahamsen <amanda@iesd.auc.dk>.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
696
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
697 (defun nnmail-split-fancy ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
698 "Fancy splitting method.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
699 See the documentation for the variable `nnmail-split-fancy' for documentation."
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
700 (nnmail-split-it nnmail-split-fancy))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
701
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
702 (defvar nnmail-split-cache nil)
13999
844367c3fd0f (nnmail-message-id-cache-length): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 13401
diff changeset
703 ;; Alist of split expressions their equivalent regexps.
13401
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
704
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
705 (defun nnmail-split-it (split)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
706 ;; Return a list of groups matching SPLIT.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
707 (cond ((stringp split)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
708 ;; A group.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
709 (list split))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
710 ((eq (car split) '&)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
711 (apply 'nconc (mapcar 'nnmail-split-it (cdr split))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
712 ((eq (car split) '|)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
713 (let (done)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
714 (while (and (not done) (cdr split))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
715 (setq split (cdr split)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
716 done (nnmail-split-it (car split))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
717 done)) ((assq split nnmail-split-cache)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
718 ;; A compiled match expression.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
719 (goto-char (point-max))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
720 (if (re-search-backward (cdr (assq split nnmail-split-cache)) nil t)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
721 (nnmail-split-it (nth 2 split))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
722 (t
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
723 ;; An uncompiled match.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
724 (let* ((field (nth 0 split))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
725 (value (nth 1 split))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
726 (regexp (concat "^\\("
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
727 (if (symbolp field)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
728 (cdr (assq field
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
729 nnmail-split-abbrev-alist))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
730 field)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
731 "\\):.*\\<\\("
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
732 (if (symbolp value)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
733 (cdr (assq value
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
734 nnmail-split-abbrev-alist))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
735 value)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
736 "\\>\\)")))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
737 (setq nnmail-split-cache
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
738 (cons (cons split regexp) nnmail-split-cache))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
739 (goto-char (point-max))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
740 (if (re-search-backward regexp nil t)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
741 (nnmail-split-it (nth 2 split)))))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
742
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
743 ;; Get a list of spool files to read.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
744 (defun nnmail-get-spool-files (&optional group)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
745 (if (null nnmail-spool-file)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
746 ;; No spool file whatsoever.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
747 nil)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
748 (let* ((procmails
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
749 ;; If procmail is used to get incoming mail, the files
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
750 ;; are stored in this directory.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
751 (and (file-exists-p nnmail-procmail-directory)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
752 (directory-files
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
753 nnmail-procmail-directory
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
754 t (concat (if group group "")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
755 nnmail-procmail-suffix "$") t)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
756 (p procmails))
13999
844367c3fd0f (nnmail-message-id-cache-length): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 13401
diff changeset
757 ;; Remove any directories that inadvertently match the procmail
13401
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
758 ;; suffix, which might happen if the suffix is "".
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
759 (while p
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
760 (and (or (file-directory-p (car p))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
761 (file-symlink-p (car p)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
762 (setq procmails (delete (car p) procmails)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
763 (setq p (cdr p)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
764 (cond ((listp nnmail-spool-file)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
765 (append nnmail-spool-file procmails))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
766 ((stringp nnmail-spool-file)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
767 (cons nnmail-spool-file procmails))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
768 (t
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
769 procmails))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
770
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
771 ;; Activate a backend only if it isn't already activated.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
772 ;; If FORCE, re-read the active file even if the backend is
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
773 ;; already activated.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
774 (defun nnmail-activate (backend &optional force)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
775 (let (file timestamp file-time)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
776 (if (or (not (symbol-value (intern (format "%s-group-alist" backend))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
777 force
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
778 (and (setq file (condition-case ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
779 (symbol-value (intern (format "%s-active-file"
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
780 backend)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
781 (error nil)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
782 (setq file-time (nth 5 (file-attributes file)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
783 (or (not
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
784 (setq timestamp
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
785 (condition-case ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
786 (symbol-value (intern
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
787 (format "%s-active-timestamp"
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
788 backend)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
789 (error 'none))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
790 (not (consp timestamp))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
791 (equal timestamp '(0 0))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
792 (> (nth 0 file-time) (nth 0 timestamp))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
793 (and (= (nth 0 file-time) (nth 0 timestamp))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
794 (> (nth 1 file-time) (nth 1 timestamp))))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
795 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
796 (or (eq timestamp 'none)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
797 (set (intern (format "%s-active-timestamp" backend))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
798 (current-time)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
799 (funcall (intern (format "%s-request-list" backend)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
800 (set (intern (format "%s-group-alist" backend))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
801 (nnmail-get-active))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
802 t))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
803
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
804 (defun nnmail-message-id ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
805 (concat "<" (nnmail-unique-id) "@totally-fudged-out-message-id>"))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
806
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
807 (defvar nnmail-unique-id-char nil)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
808
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
809 (defun nnmail-number-base36 (num len)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
810 (if (if (< len 0) (<= num 0) (= len 0))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
811 ""
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
812 (concat (nnmail-number-base36 (/ num 36) (1- len))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
813 (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210"
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
814 (% num 36))))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
815
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
816 (defun nnmail-unique-id ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
817 (setq nnmail-unique-id-char
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
818 (% (1+ (or nnmail-unique-id-char (logand (random t) (1- (lsh 1 20)))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
819 ;; (current-time) returns 16-bit ints,
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
820 ;; and 2^16*25 just fits into 4 digits i base 36.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
821 (* 25 25)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
822 (let ((tm (if (fboundp 'current-time)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
823 (current-time) '(12191 46742 287898))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
824 (concat
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
825 (nnmail-number-base36 (+ (car tm)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
826 (lsh (% nnmail-unique-id-char 25) 16)) 4)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
827 (nnmail-number-base36 (+ (nth 1 tm)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
828 (lsh (/ nnmail-unique-id-char 25) 16)) 4))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
829
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
830 ;;;
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
831 ;;; nnmail duplicate handling
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
832 ;;;
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
833
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
834 (defvar nnmail-cache-buffer nil)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
835
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
836 (defun nnmail-cache-open ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
837 (if (or (not nnmail-delete-duplicates)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
838 (and nnmail-cache-buffer
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
839 (buffer-name nnmail-cache-buffer)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
840 () ; The buffer is open.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
841 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
842 (set-buffer
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
843 (setq nnmail-cache-buffer
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
844 (get-buffer-create " *nnmail message-id cache*")))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
845 (buffer-disable-undo (current-buffer))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
846 (and (file-exists-p nnmail-message-id-cache-file)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
847 (insert-file-contents nnmail-message-id-cache-file))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
848 (current-buffer))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
849
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
850 (defun nnmail-cache-close ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
851 (if (or (not nnmail-cache-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
852 (not nnmail-delete-duplicates)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
853 (not (buffer-name nnmail-cache-buffer))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
854 (not (buffer-modified-p nnmail-cache-buffer)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
855 () ; The buffer is closed.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
856 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
857 (set-buffer nnmail-cache-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
858 ;; Weed out the excess number of Message-IDs.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
859 (goto-char (point-max))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
860 (and (search-backward "\n" nil t nnmail-message-id-cache-length)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
861 (progn
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
862 (beginning-of-line)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
863 (delete-region (point-min) (point))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
864 ;; Save the buffer.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
865 (or (file-exists-p (file-name-directory nnmail-message-id-cache-file))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
866 (make-directory (file-name-directory nnmail-message-id-cache-file)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
867 t))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
868 (write-region (point-min) (point-max)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
869 nnmail-message-id-cache-file nil 'silent)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
870 (set-buffer-modified-p nil))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
871
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
872 (defun nnmail-cache-insert (id)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
873 (and nnmail-delete-duplicates
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
874 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
875 (set-buffer nnmail-cache-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
876 (goto-char (point-max))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
877 (insert id "\n"))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
878
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
879 (defun nnmail-cache-id-exists-p (id)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
880 (and nnmail-delete-duplicates
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
881 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
882 (set-buffer nnmail-cache-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
883 (goto-char (point-max))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
884 (search-backward id nil t))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
885
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
886
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
887 (provide 'nnmail)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
888
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
889 ;;; nnmail.el ends here