comparison lisp/gnus/nnmail.el @ 70:131b0175ea99 r20-0b30

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