Mercurial > hg > xemacs-beta
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 |