1 |
;;; nnmail.el --- mail support functions for the Gnus mail backends |
;;; nnmail.el --- mail support functions for the Gnus mail backends |
2 |
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2002 |
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 |
3 |
;; Free Software Foundation, Inc. |
;; Free Software Foundation, Inc. |
4 |
|
|
5 |
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
28 |
|
|
29 |
(eval-when-compile (require 'cl)) |
(eval-when-compile (require 'cl)) |
30 |
|
|
31 |
|
(require 'gnus) ; for macro gnus-kill-buffer, at least |
32 |
(require 'nnheader) |
(require 'nnheader) |
33 |
(require 'message) |
(require 'message) |
34 |
(require 'custom) |
(require 'custom) |
37 |
(require 'mm-util) |
(require 'mm-util) |
38 |
|
|
39 |
(eval-and-compile |
(eval-and-compile |
40 |
(autoload 'gnus-error "gnus-util") |
(autoload 'gnus-add-buffer "gnus") |
41 |
(autoload 'gnus-buffer-live-p "gnus-util")) |
(autoload 'gnus-kill-buffer "gnus")) |
42 |
|
|
43 |
(defgroup nnmail nil |
(defgroup nnmail nil |
44 |
"Reading mail with Gnus." |
"Reading mail with Gnus." |
77 |
"Various mail options." |
"Various mail options." |
78 |
:group 'nnmail) |
:group 'nnmail) |
79 |
|
|
80 |
(defcustom nnmail-split-methods |
(defcustom nnmail-split-methods '(("mail.misc" "")) |
|
'(("mail.misc" "")) |
|
81 |
"*Incoming mail will be split according to this variable. |
"*Incoming mail will be split according to this variable. |
82 |
|
|
83 |
If you'd like, for instance, one mail group for mail from the |
If you'd like, for instance, one mail group for mail from the |
86 |
|
|
87 |
(setq nnmail-split-methods |
(setq nnmail-split-methods |
88 |
'((\"mail.4ad\" \"From:.*4ad\") |
'((\"mail.4ad\" \"From:.*4ad\") |
89 |
(\"mail.junk\" \"From:.*Lars\\\\|Subject:.*buy\") |
(\"mail.junk\" \"From:.*Lars\\\\|Subject:.*buy\") |
90 |
(\"mail.misc\" \"\"))) |
(\"mail.misc\" \"\"))) |
91 |
|
|
92 |
As you can see, this variable is a list of lists, where the first |
As you can see, this variable is a list of lists, where the first |
93 |
element in each \"rule\" is the name of the group (which, by the way, |
element in each \"rule\" is the name of the group (which, by the way, |
104 |
|
|
105 |
This variable can also have a function as its value." |
This variable can also have a function as its value." |
106 |
:group 'nnmail-split |
:group 'nnmail-split |
107 |
:type '(choice (repeat :tag "Alist" (group (string :tag "Name") regexp)) |
:type '(choice (repeat :tag "Alist" (group (string :tag "Name") |
108 |
|
(choice regexp function))) |
109 |
(function-item nnmail-split-fancy) |
(function-item nnmail-split-fancy) |
110 |
(function :tag "Other"))) |
(function :tag "Other"))) |
111 |
|
|
116 |
:group 'nnmail-split |
:group 'nnmail-split |
117 |
:type 'boolean) |
:type 'boolean) |
118 |
|
|
119 |
|
(defcustom nnmail-split-fancy-with-parent-ignore-groups nil |
120 |
|
"Regexp that matches group names to be ignored when applying `nnmail-split-fancy-with-parent'. |
121 |
|
This can also be a list of regexps." |
122 |
|
:group 'nnmail-split |
123 |
|
:type '(choice (const :tag "none" nil) |
124 |
|
(regexp :value ".*") |
125 |
|
(repeat :value (".*") regexp))) |
126 |
|
|
127 |
|
(defcustom nnmail-cache-ignore-groups nil |
128 |
|
"Regexp that matches group names to be ignored when inserting message ids into the cache (`nnmail-cache-insert'). |
129 |
|
This can also be a list of regexps." |
130 |
|
:group 'nnmail-split |
131 |
|
:type '(choice (const :tag "none" nil) |
132 |
|
(regexp :value ".*") |
133 |
|
(repeat :value (".*") regexp))) |
134 |
|
|
135 |
;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit). |
;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit). |
136 |
(defcustom nnmail-keep-last-article nil |
(defcustom nnmail-keep-last-article nil |
137 |
"If non-nil, nnmail will never delete/move a group's last article. |
"If non-nil, nnmail will never delete/move a group's last article. |
162 |
can also be `immediate' and `never'." |
can also be `immediate' and `never'." |
163 |
:group 'nnmail-expire |
:group 'nnmail-expire |
164 |
:type '(choice (const immediate) |
:type '(choice (const immediate) |
165 |
(integer :tag "days") |
(number :tag "days") |
166 |
(const never))) |
(const never))) |
167 |
|
|
168 |
(defcustom nnmail-expiry-wait-function nil |
(defcustom nnmail-expiry-wait-function nil |
169 |
"Variable that holds function to specify how old articles should be before they are expired. |
"Variable that holds function to specify how old articles should be before they are expired. |
170 |
The function will be called with the name of the group that the |
The function will be called with the name of the group that the expiry |
171 |
expiry is to be performed in, and it should return an integer that |
is to be performed in, and it should return an integer that says how |
172 |
says how many days an article can be stored before it is considered |
many days an article can be stored before it is considered \"old\". |
173 |
\"old\". It can also return the values `never' and `immediate'. |
It can also return the values `never' and `immediate'. |
174 |
|
|
175 |
Eg.: |
Eg.: |
176 |
|
|
177 |
\(setq nnmail-expiry-wait-function |
\(setq nnmail-expiry-wait-function |
178 |
(lambda (newsgroup) |
(lambda (newsgroup) |
179 |
(cond ((string-match \"private\" newsgroup) 31) |
(cond ((string-match \"private\" newsgroup) 31) |
180 |
((string-match \"junk\" newsgroup) 1) |
((string-match \"junk\" newsgroup) 1) |
181 |
((string-match \"important\" newsgroup) 'never) |
((string-match \"important\" newsgroup) 'never) |
182 |
(t 7))))" |
(t 7))))" |
183 |
:group 'nnmail-expire |
:group 'nnmail-expire |
193 |
receives one argument, the name of the group the message comes from. |
receives one argument, the name of the group the message comes from. |
194 |
The return value should be `delete' or a group name (a string)." |
The return value should be `delete' or a group name (a string)." |
195 |
:version "21.1" |
:version "21.1" |
196 |
:group 'nnmail-expire |
:group 'nnmail-expire |
197 |
:type '(choice (const delete) |
:type '(choice (const delete) |
198 |
(function :format "%v" nnmail-) |
(function :format "%v" nnmail-) |
199 |
string)) |
string)) |
200 |
|
|
201 |
|
(defcustom nnmail-fancy-expiry-targets nil |
202 |
|
"Determine expiry target based on articles using fancy techniques. |
203 |
|
|
204 |
|
This is a list of (\"HEADER\" \"REGEXP\" \"TARGET\") entries. If |
205 |
|
`nnmail-expiry-target' is set to the function |
206 |
|
`nnmail-fancy-expiry-target' and HEADER of the article matches REGEXP, |
207 |
|
the message will be expired to a group determined by invoking |
208 |
|
`format-time-string' with TARGET used as the format string and the |
209 |
|
time extracted from the articles' Date header (if missing the current |
210 |
|
time is used). |
211 |
|
|
212 |
|
In the special cases that HEADER is the symbol `to-from', the regexp |
213 |
|
will try to match against both the From and the To header. |
214 |
|
|
215 |
|
Example: |
216 |
|
|
217 |
|
\(setq nnmail-fancy-expiry-targets |
218 |
|
'((to-from \"boss\" \"nnfolder:Work\") |
219 |
|
(\"Subject\" \"IMPORTANT\" \"nnfolder:IMPORTANT.%Y.%b\") |
220 |
|
(\"from\" \".*\" \"nnfolder:Archive-%Y\"))) |
221 |
|
|
222 |
|
In this case, articles containing the string \"boss\" in the To or the |
223 |
|
From header will be expired to the group \"nnfolder:Work\"; |
224 |
|
articles containing the sting \"IMPORTANT\" in the Subject header will |
225 |
|
be expired to the group \"nnfolder:IMPORTANT.YYYY.MMM\"; and |
226 |
|
everything else will be expired to \"nnfolder:Archive-YYYY\"." |
227 |
|
:group 'nnmail-expire |
228 |
|
:type '(repeat (list (choice :tag "Match against" |
229 |
|
(string :tag "Header") |
230 |
|
(const to-from)) |
231 |
|
regexp |
232 |
|
(string :tag "Target group format string")))) |
233 |
|
|
234 |
(defcustom nnmail-cache-accepted-message-ids nil |
(defcustom nnmail-cache-accepted-message-ids nil |
235 |
"If non-nil, put Message-IDs of Gcc'd articles into the duplicate cache." |
"If non-nil, put Message-IDs of Gcc'd articles into the duplicate cache. |
236 |
|
If non-nil, also update the cache when copy or move articles." |
237 |
:group 'nnmail |
:group 'nnmail |
238 |
:type 'boolean) |
:type 'boolean) |
239 |
|
|
288 |
Eg. |
Eg. |
289 |
|
|
290 |
\(add-hook 'nnmail-read-incoming-hook |
\(add-hook 'nnmail-read-incoming-hook |
291 |
(lambda () |
(lambda () |
292 |
(call-process \"/local/bin/mailsend\" nil nil nil |
(call-process \"/local/bin/mailsend\" nil nil nil |
293 |
\"read\" nnmail-spool-file))) |
\"read\" nnmail-spool-file))) |
294 |
|
|
295 |
If you have xwatch running, this will alert it that mail has been |
If you have xwatch running, this will alert it that mail has been |
296 |
read. |
read. |
350 |
:group 'nnmail-split |
:group 'nnmail-split |
351 |
:type 'hook) |
:type 'hook) |
352 |
|
|
353 |
|
(defcustom nnmail-spool-hook nil |
354 |
|
"*A hook called when a new article is spooled." |
355 |
|
:group 'nnmail |
356 |
|
:type 'hook) |
357 |
|
|
358 |
(defcustom nnmail-large-newsgroup 50 |
(defcustom nnmail-large-newsgroup 50 |
359 |
"*The number of the articles which indicates a large newsgroup. |
"*The number of articles which indicates a large newsgroup or nil. |
360 |
If the number of the articles is greater than the value, verbose |
If the number of articles is greater than the value, verbose |
361 |
messages will be shown to indicate the current status." |
messages will be shown to indicate the current status." |
362 |
:group 'nnmail-various |
:group 'nnmail-various |
363 |
:type 'integer) |
:type '(choice (const :tag "infinite" nil) |
364 |
|
(number :tag "count"))) |
365 |
|
|
366 |
|
(define-widget 'nnmail-lazy 'default |
367 |
|
"Base widget for recursive datastructures. |
368 |
|
|
369 |
|
This is copy of the `lazy' widget in Emacs 21.4 provided for compatibility." |
370 |
|
:format "%{%t%}: %v" |
371 |
|
:convert-widget 'widget-value-convert-widget |
372 |
|
:value-create (lambda (widget) |
373 |
|
(let ((value (widget-get widget :value)) |
374 |
|
(type (widget-get widget :type))) |
375 |
|
(widget-put widget :children |
376 |
|
(list (widget-create-child-value |
377 |
|
widget (widget-convert type) value))))) |
378 |
|
:value-delete 'widget-children-value-delete |
379 |
|
:value-get (lambda (widget) |
380 |
|
(widget-value (car (widget-get widget :children)))) |
381 |
|
:value-inline (lambda (widget) |
382 |
|
(widget-apply (car (widget-get widget :children)) |
383 |
|
:value-inline)) |
384 |
|
:default-get (lambda (widget) |
385 |
|
(widget-default-get |
386 |
|
(widget-convert (widget-get widget :type)))) |
387 |
|
:match (lambda (widget value) |
388 |
|
(widget-apply (widget-convert (widget-get widget :type)) |
389 |
|
:match value)) |
390 |
|
:validate (lambda (widget) |
391 |
|
(widget-apply (car (widget-get widget :children)) :validate))) |
392 |
|
|
393 |
|
(define-widget 'nnmail-split-fancy 'nnmail-lazy |
394 |
|
"Widget for customizing splits in the variable of the same name." |
395 |
|
:tag "Split" |
396 |
|
:type '(menu-choice :value (any ".*value.*" "misc") |
397 |
|
:tag "Type" |
398 |
|
(string :tag "Destination") |
399 |
|
(list :tag "Use first match (|)" :value (|) |
400 |
|
(const :format "" |) |
401 |
|
(editable-list :inline t nnmail-split-fancy)) |
402 |
|
(list :tag "Use all matches (&)" :value (&) |
403 |
|
(const :format "" &) |
404 |
|
(editable-list :inline t nnmail-split-fancy)) |
405 |
|
(list :tag "Function with fixed arguments (:)" |
406 |
|
:value (: nil) |
407 |
|
(const :format "" :value :) |
408 |
|
function |
409 |
|
(editable-list :inline t (sexp :tag "Arg")) |
410 |
|
) |
411 |
|
(list :tag "Function with split arguments (!)" |
412 |
|
:value (! nil) |
413 |
|
(const :format "" !) |
414 |
|
function |
415 |
|
(editable-list :inline t nnmail-split-fancy)) |
416 |
|
(list :tag "Field match" |
417 |
|
(choice :tag "Field" |
418 |
|
regexp symbol) |
419 |
|
(choice :tag "Match" |
420 |
|
regexp |
421 |
|
(symbol :value mail)) |
422 |
|
(repeat :inline t |
423 |
|
:tag "Restrictions" |
424 |
|
(group :inline t |
425 |
|
(const :format "" -) |
426 |
|
regexp)) |
427 |
|
nnmail-split-fancy) |
428 |
|
(const :tag "Junk (delete mail)" junk))) |
429 |
|
|
430 |
(defcustom nnmail-split-fancy "mail.misc" |
(defcustom nnmail-split-fancy "mail.misc" |
431 |
"Incoming mail can be split according to this fancy variable. |
"Incoming mail can be split according to this fancy variable. |
457 |
return value FUNCTION should be a split, which is then recursively |
return value FUNCTION should be a split, which is then recursively |
458 |
processed. |
processed. |
459 |
|
|
460 |
|
junk: Mail will be deleted. Use with care! Do not submerge in water! |
461 |
|
Example: |
462 |
|
(setq nnmail-split-fancy |
463 |
|
'(| (\"Subject\" \"MAKE MONEY FAST\" junk) |
464 |
|
...other.rules.omitted...)) |
465 |
|
|
466 |
FIELD must match a complete field name. VALUE must match a complete |
FIELD must match a complete field name. VALUE must match a complete |
467 |
word according to the `nnmail-split-fancy-syntax-table' syntax table. |
word according to the `nnmail-split-fancy-syntax-table' syntax table. |
468 |
You can use \".*\" in the regexps to match partial field names or words. |
You can use \".*\" in the regexps to match partial field names or words. |
490 |
;; Other mailing lists... |
;; Other mailing lists... |
491 |
(any \"procmail@informatik\\\\.rwth-aachen\\\\.de\" \"procmail.list\") |
(any \"procmail@informatik\\\\.rwth-aachen\\\\.de\" \"procmail.list\") |
492 |
(any \"SmartList@informatik\\\\.rwth-aachen\\\\.de\" \"SmartList.list\") |
(any \"SmartList@informatik\\\\.rwth-aachen\\\\.de\" \"SmartList.list\") |
493 |
;; Both lists below have the same suffix, so prevent |
;; Both lists below have the same suffix, so prevent |
494 |
;; cross-posting to mkpkg.list of messages posted only to |
;; cross-posting to mkpkg.list of messages posted only to |
495 |
;; the bugs- list, but allow cross-posting when the |
;; the bugs- list, but allow cross-posting when the |
496 |
;; message was really cross-posted. |
;; message was really cross-posted. |
497 |
(any \"bugs-mypackage@somewhere\" \"mypkg.bugs\") |
(any \"bugs-mypackage@somewhere\" \"mypkg.bugs\") |
498 |
(any \"mypackage@somewhere\" - \"bugs-mypackage\" \"mypkg.list\") |
(any \"mypackage@somewhere\" - \"bugs-mypackage\" \"mypkg.list\") |
499 |
;; |
;; |
500 |
;; People... |
;; People... |
501 |
(any \"larsi@ifi\\\\.uio\\\\.no\" \"people.Lars Magne Ingebrigtsen\")) |
(any \"larsi@ifi\\\\.uio\\\\.no\" \"people.Lars Magne Ingebrigtsen\")) |
502 |
;; Unmatched mail goes to the catch all group. |
;; Unmatched mail goes to the catch all group. |
503 |
\"misc.misc\"))" |
\"misc.misc\"))" |
504 |
:group 'nnmail-split |
:group 'nnmail-split |
505 |
;; Sigh! |
:type 'nnmail-split-fancy) |
|
:type 'sexp) |
|
506 |
|
|
507 |
(defcustom nnmail-split-abbrev-alist |
(defcustom nnmail-split-abbrev-alist |
508 |
'((any . "from\\|to\\|cc\\|sender\\|apparently-to\\|resent-from\\|resent-to\\|resent-cc") |
'((any . "from\\|to\\|cc\\|sender\\|apparently-to\\|resent-from\\|resent-to\\|resent-cc") |
544 |
(const warn) |
(const warn) |
545 |
(const delete))) |
(const delete))) |
546 |
|
|
547 |
(defcustom nnmail-extra-headers nil |
(defcustom nnmail-extra-headers '(To Newsgroups) |
548 |
"*Extra headers to parse." |
"*Extra headers to parse." |
549 |
:version "21.1" |
:version "21.1" |
550 |
:group 'nnmail |
:group 'nnmail |
556 |
:group 'nnmail |
:group 'nnmail |
557 |
:type 'integer) |
:type 'integer) |
558 |
|
|
559 |
|
(defcustom nnmail-mail-splitting-charset nil |
560 |
|
"Default charset to be used when splitting incoming mail." |
561 |
|
:group 'nnmail |
562 |
|
:type 'symbol) |
563 |
|
|
564 |
|
(defcustom nnmail-mail-splitting-decodes nil |
565 |
|
"Whether the nnmail splitting functionality should MIME decode headers." |
566 |
|
:group 'nnmail |
567 |
|
:type 'boolean) |
568 |
|
|
569 |
|
(defcustom nnmail-split-fancy-match-partial-words nil |
570 |
|
"Whether to match partial words when fancy splitting. |
571 |
|
Normally, regexes given in `nnmail-split-fancy' are implicitly surrounded |
572 |
|
by \"\\=\\<...\\>\". If this variable is true, they are not implicitly\ |
573 |
|
surrounded |
574 |
|
by anything." |
575 |
|
:group 'nnmail |
576 |
|
:type 'boolean) |
577 |
|
|
578 |
|
(defcustom nnmail-split-lowercase-expanded t |
579 |
|
"Whether to lowercase expanded entries (i.e. \\N) when splitting mails. |
580 |
|
This avoids the creation of multiple groups when users send to an address |
581 |
|
using different case (i.e. mailing-list@domain vs Mailing-List@Domain)." |
582 |
|
:group 'nnmail |
583 |
|
:type 'boolean) |
584 |
|
|
585 |
;;; Internal variables. |
;;; Internal variables. |
586 |
|
|
587 |
|
(defvar nnmail-article-buffer " *nnmail incoming*" |
588 |
|
"The buffer used for splitting incoming mails.") |
589 |
|
|
590 |
(defvar nnmail-split-history nil |
(defvar nnmail-split-history nil |
591 |
"List of group/article elements that say where the previous split put messages.") |
"List of group/article elements that say where the previous split put messages.") |
592 |
|
|
593 |
(defvar nnmail-split-fancy-syntax-table nil |
(defvar nnmail-split-fancy-syntax-table |
594 |
|
(let ((table (make-syntax-table))) |
595 |
|
;; support the %-hack |
596 |
|
(modify-syntax-entry ?\% "." table) |
597 |
|
table) |
598 |
"Syntax table used by `nnmail-split-fancy'.") |
"Syntax table used by `nnmail-split-fancy'.") |
|
(unless (syntax-table-p nnmail-split-fancy-syntax-table) |
|
|
(setq nnmail-split-fancy-syntax-table |
|
|
(copy-syntax-table (standard-syntax-table))) |
|
|
;; support the %-hack |
|
|
(modify-syntax-entry ?\% "." nnmail-split-fancy-syntax-table)) |
|
599 |
|
|
600 |
(defvar nnmail-prepare-save-mail-hook nil |
(defvar nnmail-prepare-save-mail-hook nil |
601 |
"Hook called before saving mail.") |
"Hook called before saving mail.") |
605 |
|
|
606 |
|
|
607 |
|
|
|
(defconst nnmail-version "nnmail 1.0" |
|
|
"nnmail version.") |
|
|
|
|
|
|
|
|
|
|
608 |
(defun nnmail-request-post (&optional server) |
(defun nnmail-request-post (&optional server) |
609 |
(mail-send-and-exit nil)) |
(mail-send-and-exit nil)) |
610 |
|
|
623 |
(set-buffer nntp-server-buffer) |
(set-buffer nntp-server-buffer) |
624 |
(delete-region (point-min) (point-max)) |
(delete-region (point-min) (point-max)) |
625 |
(let ((format-alist nil) |
(let ((format-alist nil) |
626 |
(after-insert-file-functions nil)) |
(after-insert-file-functions nil)) |
627 |
(condition-case () |
(condition-case () |
628 |
(let ((coding-system-for-read nnmail-file-coding-system) |
(let ((coding-system-for-read nnmail-file-coding-system) |
629 |
(auto-mode-alist (mm-auto-mode-alist)) |
(auto-mode-alist (mm-auto-mode-alist)) |
678 |
(setq group (read buffer)) |
(setq group (read buffer)) |
679 |
(unless (stringp group) |
(unless (stringp group) |
680 |
(setq group (symbol-name group))) |
(setq group (symbol-name group))) |
681 |
(if (and (numberp (setq max (read nntp-server-buffer))) |
(if (and (numberp (setq max (read buffer))) |
682 |
(numberp (setq min (read nntp-server-buffer)))) |
(numberp (setq min (read buffer)))) |
683 |
(push (list group (cons min max)) |
(push (list group (cons min max)) |
684 |
group-assoc))) |
group-assoc))) |
685 |
(error nil)) |
(error nil)) |
864 |
(if (not (and (re-search-forward "^From " nil t) |
(if (not (and (re-search-forward "^From " nil t) |
865 |
(goto-char (match-beginning 0)))) |
(goto-char (match-beginning 0)))) |
866 |
;; Possibly wrong format? |
;; Possibly wrong format? |
867 |
(error "Error, unknown mail format! (Possibly corrupted.)") |
(error "Error, unknown mail format! (Possibly corrupted %s `%s'.)" |
868 |
|
(if (buffer-file-name) "file" "buffer") |
869 |
|
(or (buffer-file-name) (buffer-name))) |
870 |
;; Carry on until the bitter end. |
;; Carry on until the bitter end. |
871 |
(while (not (eobp)) |
(while (not (eobp)) |
872 |
(setq start (point) |
(setq start (point) |
1038 |
group artnum-func) |
group artnum-func) |
1039 |
"Go through the entire INCOMING file and pick out each individual mail. |
"Go through the entire INCOMING file and pick out each individual mail. |
1040 |
FUNC will be called with the buffer narrowed to each mail." |
FUNC will be called with the buffer narrowed to each mail." |
1041 |
(let (;; If this is a group-specific split, we bind the split |
(let ( ;; If this is a group-specific split, we bind the split |
1042 |
;; methods to just this group. |
;; methods to just this group. |
1043 |
(nnmail-split-methods (if (and group |
(nnmail-split-methods (if (and group |
1044 |
(not nnmail-resplit-incoming)) |
(not nnmail-resplit-incoming)) |
1046 |
nnmail-split-methods))) |
nnmail-split-methods))) |
1047 |
(save-excursion |
(save-excursion |
1048 |
;; Insert the incoming file. |
;; Insert the incoming file. |
1049 |
(set-buffer (get-buffer-create " *nnmail incoming*")) |
(set-buffer (get-buffer-create nnmail-article-buffer)) |
1050 |
(erase-buffer) |
(erase-buffer) |
1051 |
(let ((coding-system-for-read nnmail-incoming-coding-system)) |
(let ((coding-system-for-read nnmail-incoming-coding-system)) |
1052 |
(mm-insert-file-contents incoming)) |
(mm-insert-file-contents incoming)) |
1074 |
(defun nnmail-article-group (func &optional trace) |
(defun nnmail-article-group (func &optional trace) |
1075 |
"Look at the headers and return an alist of groups that match. |
"Look at the headers and return an alist of groups that match. |
1076 |
FUNC will be called with the group name to determine the article number." |
FUNC will be called with the group name to determine the article number." |
1077 |
(let ((methods nnmail-split-methods) |
(let ((methods (or nnmail-split-methods '(("bogus" "")))) |
1078 |
(obuf (current-buffer)) |
(obuf (current-buffer)) |
1079 |
(beg (point-min)) |
group-art method grp) |
|
end group-art method grp) |
|
1080 |
(if (and (sequencep methods) |
(if (and (sequencep methods) |
1081 |
(= (length methods) 1)) |
(= (length methods) 1)) |
1082 |
;; If there is only just one group to put everything in, we |
;; If there is only just one group to put everything in, we |
1085 |
(list (cons (caar methods) (funcall func (caar methods))))) |
(list (cons (caar methods) (funcall func (caar methods))))) |
1086 |
;; We do actual comparison. |
;; We do actual comparison. |
1087 |
(save-excursion |
(save-excursion |
1088 |
;; Find headers. |
;; Copy the article into the work buffer. |
|
(goto-char beg) |
|
|
(setq end (if (search-forward "\n\n" nil t) (point) (point-max))) |
|
1089 |
(set-buffer nntp-server-buffer) |
(set-buffer nntp-server-buffer) |
1090 |
(erase-buffer) |
(erase-buffer) |
1091 |
;; Copy the headers into the work buffer. |
(insert-buffer-substring obuf) |
1092 |
(insert-buffer-substring obuf beg end) |
;; Narrow to headers. |
1093 |
|
(narrow-to-region |
1094 |
|
(goto-char (point-min)) |
1095 |
|
(if (search-forward "\n\n" nil t) |
1096 |
|
(point) |
1097 |
|
(point-max))) |
1098 |
|
(goto-char (point-min)) |
1099 |
|
;; Decode MIME headers and charsets. |
1100 |
|
(when nnmail-mail-splitting-decodes |
1101 |
|
(let ((mail-parse-charset nnmail-mail-splitting-charset)) |
1102 |
|
(mail-decode-encoded-word-region (point-min) (point-max)))) |
1103 |
;; Fold continuation lines. |
;; Fold continuation lines. |
1104 |
(goto-char (point-min)) |
(goto-char (point-min)) |
1105 |
(while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) |
(while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) |
1112 |
(while (not (eobp)) |
(while (not (eobp)) |
1113 |
(unless (< (move-to-column nnmail-split-header-length-limit) |
(unless (< (move-to-column nnmail-split-header-length-limit) |
1114 |
nnmail-split-header-length-limit) |
nnmail-split-header-length-limit) |
1115 |
(delete-region (point) (progn (end-of-line) (point)))) |
(delete-region (point) (gnus-point-at-eol))) |
1116 |
(forward-line 1)) |
(forward-line 1)) |
1117 |
;; Allow washing. |
;; Allow washing. |
1118 |
(goto-char (point-min)) |
(goto-char (point-min)) |
1129 |
(or (funcall nnmail-split-methods) |
(or (funcall nnmail-split-methods) |
1130 |
'("bogus")) |
'("bogus")) |
1131 |
(error |
(error |
1132 |
(nnheader-message 5 |
(nnheader-message |
1133 |
"Error in `nnmail-split-methods'; using `bogus' mail group") |
5 "Error in `nnmail-split-methods'; using `bogus' mail group") |
1134 |
(sit-for 1) |
(sit-for 1) |
1135 |
'("bogus"))))) |
'("bogus"))))) |
1136 |
(setq split (gnus-remove-duplicates split)) |
(setq split (gnus-remove-duplicates split)) |
1175 |
(unless group-art |
(unless group-art |
1176 |
(setq group-art |
(setq group-art |
1177 |
(list (cons (car method) |
(list (cons (car method) |
1178 |
(funcall func (car method))))))))) |
(funcall func (car method)))))))) |
1179 |
|
;; Fall back on "bogus" if all else fails. |
1180 |
|
(unless group-art |
1181 |
|
(setq group-art (list (cons "bogus" (funcall func "bogus")))))) |
1182 |
;; Produce a trace if non-empty. |
;; Produce a trace if non-empty. |
1183 |
(when (and trace nnmail-split-trace) |
(when (and trace nnmail-split-trace) |
1184 |
(let ((trace (nreverse nnmail-split-trace)) |
(let ((restore (current-buffer))) |
|
(restore (current-buffer))) |
|
1185 |
(nnheader-set-temp-buffer "*Split Trace*") |
(nnheader-set-temp-buffer "*Split Trace*") |
1186 |
(gnus-add-buffer) |
(gnus-add-buffer) |
1187 |
(while trace |
(dolist (trace (nreverse nnmail-split-trace)) |
1188 |
(insert (car trace) "\n") |
(prin1 trace (current-buffer)) |
1189 |
(setq trace (cdr trace))) |
(insert "\n")) |
1190 |
(goto-char (point-min)) |
(goto-char (point-min)) |
1191 |
(gnus-configure-windows 'split-trace) |
(gnus-configure-windows 'split-trace) |
1192 |
(set-buffer restore))) |
(set-buffer restore))) |
1193 |
|
(widen) |
1194 |
;; See whether the split methods returned `junk'. |
;; See whether the split methods returned `junk'. |
1195 |
(if (equal group-art '(junk)) |
(if (equal group-art '(junk)) |
1196 |
nil |
nil |
1252 |
|
|
1253 |
(defun nnmail-remove-list-identifiers () |
(defun nnmail-remove-list-identifiers () |
1254 |
"Remove list identifiers from Subject headers." |
"Remove list identifiers from Subject headers." |
1255 |
(let ((regexp (if (stringp nnmail-list-identifiers) nnmail-list-identifiers |
(let ((regexp |
1256 |
(mapconcat 'identity nnmail-list-identifiers " *\\|")))) |
(if (consp nnmail-list-identifiers) |
1257 |
|
(mapconcat 'identity nnmail-list-identifiers " *\\|") |
1258 |
|
nnmail-list-identifiers))) |
1259 |
(when regexp |
(when regexp |
1260 |
(goto-char (point-min)) |
(goto-char (point-min)) |
1261 |
(when (re-search-forward |
(while (re-search-forward |
1262 |
(concat "^Subject: +\\(Re: +\\)?\\(" regexp " *\\)") |
(concat "^Subject: +\\(R[Ee]: +\\)*\\(" regexp " *\\)") |
1263 |
nil t) |
nil t) |
1264 |
(delete-region (match-beginning 2) (match-end 0)))))) |
(delete-region (match-beginning 2) (match-end 0)) |
1265 |
|
(beginning-of-line)) |
1266 |
|
(when (re-search-forward "^Subject: +\\(\\(R[Ee]: +\\)+\\)R[Ee]: +" |
1267 |
|
nil t) |
1268 |
|
(delete-region (match-beginning 1) (match-end 1)) |
1269 |
|
(beginning-of-line))))) |
1270 |
|
|
1271 |
(defun nnmail-remove-tabs () |
(defun nnmail-remove-tabs () |
1272 |
"Translate TAB characters into SPACE characters." |
"Translate TAB characters into SPACE characters." |
1281 |
(beginning-of-line) |
(beginning-of-line) |
1282 |
(insert "X-Gnus-Broken-Eudora-")) |
(insert "X-Gnus-Broken-Eudora-")) |
1283 |
(goto-char (point-min)) |
(goto-char (point-min)) |
1284 |
(when (re-search-forward "^In-Reply-To:[^\n]+\\(\n[ \t]+\\)" nil t) |
(when (re-search-forward "^\\(In-Reply-To:[^\n]+\\)\n[ \t]+" nil t) |
1285 |
(replace-match "" t t nil 1)))) |
(replace-match "\\1" t)))) |
1286 |
|
|
1287 |
(custom-add-option 'nnmail-prepare-incoming-header-hook |
(custom-add-option 'nnmail-prepare-incoming-header-hook |
1288 |
'nnmail-fix-eudora-headers) |
'nnmail-fix-eudora-headers) |
1289 |
|
|
1290 |
;;; Utility functions |
;;; Utility functions |
1291 |
|
|
1292 |
|
(defun nnmail-do-request-post (accept-func &optional server) |
1293 |
|
"Utility function to directly post a message to an nnmail-derived group. |
1294 |
|
Calls ACCEPT-FUNC (which should be `nnchoke-request-accept-article') |
1295 |
|
to actually put the message in the right group." |
1296 |
|
(let ((success t)) |
1297 |
|
(dolist (mbx (message-unquote-tokens |
1298 |
|
(message-tokenize-header |
1299 |
|
(message-fetch-field "Newsgroups") ", ")) success) |
1300 |
|
(let ((to-newsgroup (gnus-group-prefixed-name mbx gnus-command-method))) |
1301 |
|
(or (gnus-active to-newsgroup) |
1302 |
|
(gnus-activate-group to-newsgroup) |
1303 |
|
(if (gnus-y-or-n-p (format "No such group: %s. Create it? " |
1304 |
|
to-newsgroup)) |
1305 |
|
(or (and (gnus-request-create-group |
1306 |
|
to-newsgroup gnus-command-method) |
1307 |
|
(gnus-activate-group to-newsgroup nil nil |
1308 |
|
gnus-command-method)) |
1309 |
|
(error "Couldn't create group %s" to-newsgroup))) |
1310 |
|
(error "No such group: %s" to-newsgroup)) |
1311 |
|
(unless (funcall accept-func mbx (nth 1 gnus-command-method)) |
1312 |
|
(setq success nil)))))) |
1313 |
|
|
1314 |
(defun nnmail-split-fancy () |
(defun nnmail-split-fancy () |
1315 |
"Fancy splitting method. |
"Fancy splitting method. |
1316 |
See the documentation for the variable `nnmail-split-fancy' for documentation." |
See the documentation for the variable `nnmail-split-fancy' for details." |
1317 |
(let ((syntab (syntax-table))) |
(let ((syntab (syntax-table))) |
1318 |
(unwind-protect |
(unwind-protect |
1319 |
(progn |
(progn |
1335 |
;; A group name. Do the \& and \N subs into the string. |
;; A group name. Do the \& and \N subs into the string. |
1336 |
((stringp split) |
((stringp split) |
1337 |
(when nnmail-split-tracing |
(when nnmail-split-tracing |
1338 |
(push (format "\"%s\"" split) nnmail-split-trace)) |
(push split nnmail-split-trace)) |
1339 |
(list (nnmail-expand-newtext split))) |
(list (nnmail-expand-newtext split))) |
1340 |
|
|
1341 |
;; Junk the message. |
;; Junk the message. |
1358 |
|
|
1359 |
;; Builtin : operation. |
;; Builtin : operation. |
1360 |
((eq (car split) ':) |
((eq (car split) ':) |
1361 |
|
(when nnmail-split-tracing |
1362 |
|
(push split nnmail-split-trace)) |
1363 |
(nnmail-split-it (save-excursion (eval (cdr split))))) |
(nnmail-split-it (save-excursion (eval (cdr split))))) |
1364 |
|
|
1365 |
;; Builtin ! operation. |
;; Builtin ! operation. |
1376 |
(while (and (goto-char end-point) |
(while (and (goto-char end-point) |
1377 |
(re-search-backward (cdr cached-pair) nil t)) |
(re-search-backward (cdr cached-pair) nil t)) |
1378 |
(when nnmail-split-tracing |
(when nnmail-split-tracing |
1379 |
(push (cdr cached-pair) nnmail-split-trace)) |
(push split nnmail-split-trace)) |
1380 |
(let ((split-rest (cddr split)) |
(let ((split-rest (cddr split)) |
1381 |
(end (match-end 0)) |
(end (match-end 0)) |
1382 |
;; The searched regexp is \(\(FIELD\).*\)\(VALUE\). So, |
;; The searched regexp is \(\(FIELD\).*\)\(VALUE\). |
1383 |
;; start-of-value is the point just before the |
;; So, start-of-value is the point just before the |
1384 |
;; beginning of the value, whereas after-header-name is |
;; beginning of the value, whereas after-header-name |
1385 |
;; the point just after the field name. |
;; is the point just after the field name. |
1386 |
(start-of-value (match-end 1)) |
(start-of-value (match-end 1)) |
1387 |
(after-header-name (match-end 2))) |
(after-header-name (match-end 2))) |
1388 |
;; Start the next search just before the beginning of the |
;; Start the next search just before the beginning of the |
1410 |
;; correct match positions. |
;; correct match positions. |
1411 |
(re-search-backward value start-of-value)) |
(re-search-backward value start-of-value)) |
1412 |
(dolist (sp (nnmail-split-it (car split-rest))) |
(dolist (sp (nnmail-split-it (car split-rest))) |
1413 |
(unless (memq sp split-result) |
(unless (member sp split-result) |
1414 |
(push sp split-result)))))) |
(push sp split-result)))))) |
1415 |
split-result)) |
split-result)) |
1416 |
|
|
1418 |
(t |
(t |
1419 |
(let* ((field (nth 0 split)) |
(let* ((field (nth 0 split)) |
1420 |
(value (nth 1 split)) |
(value (nth 1 split)) |
1421 |
partial regexp) |
partial-front |
1422 |
|
partial-rear |
1423 |
|
regexp) |
1424 |
(if (symbolp value) |
(if (symbolp value) |
1425 |
(setq value (cdr (assq value nnmail-split-abbrev-alist)))) |
(setq value (cdr (assq value nnmail-split-abbrev-alist)))) |
1426 |
(if (and (>= (length value) 2) |
(if (and (>= (length value) 2) |
1427 |
(string= ".*" (substring value 0 2))) |
(string= ".*" (substring value 0 2))) |
1428 |
(setq value (substring value 2) |
(setq value (substring value 2) |
1429 |
partial "")) |
partial-front "")) |
1430 |
|
;; Same trick for the rear of the regexp |
1431 |
|
(if (and (>= (length value) 2) |
1432 |
|
(string= ".*" (substring value -2))) |
1433 |
|
(setq value (substring value 0 -2) |
1434 |
|
partial-rear "")) |
1435 |
|
(when nnmail-split-fancy-match-partial-words |
1436 |
|
(setq partial-front "" |
1437 |
|
partial-rear "")) |
1438 |
(setq regexp (concat "^\\(\\(" |
(setq regexp (concat "^\\(\\(" |
1439 |
(if (symbolp field) |
(if (symbolp field) |
1440 |
(cdr (assq field nnmail-split-abbrev-alist)) |
(cdr (assq field nnmail-split-abbrev-alist)) |
1441 |
field) |
field) |
1442 |
"\\):.*\\)" |
"\\):.*\\)" |
1443 |
(or partial "\\<") |
(or partial-front "\\<") |
1444 |
"\\(" |
"\\(" |
1445 |
value |
value |
1446 |
"\\)\\>")) |
"\\)" |
1447 |
|
(or partial-rear "\\>"))) |
1448 |
(push (cons split regexp) nnmail-split-cache) |
(push (cons split regexp) nnmail-split-cache) |
1449 |
;; Now that it's in the cache, just call nnmail-split-it again |
;; Now that it's in the cache, just call nnmail-split-it again |
1450 |
;; on the same split, which will find it immediately in the cache. |
;; on the same split, which will find it immediately in the cache. |
1451 |
(nnmail-split-it split)))))) |
(nnmail-split-it split)))))) |
1452 |
|
|
1453 |
(defun nnmail-expand-newtext (newtext) |
(defun nnmail-expand-newtext (newtext) |
1476 |
(setq N 0) |
(setq N 0) |
1477 |
(setq N (- c ?0))) |
(setq N (- c ?0))) |
1478 |
(when (match-beginning N) |
(when (match-beginning N) |
1479 |
(push (buffer-substring (match-beginning N) (match-end N)) |
(push (if nnmail-split-lowercase-expanded |
1480 |
|
(downcase (buffer-substring (match-beginning N) |
1481 |
|
(match-end N))) |
1482 |
|
(buffer-substring (match-beginning N) (match-end N))) |
1483 |
expanded)))) |
expanded)))) |
1484 |
(setq pos (1+ pos))) |
(setq pos (1+ pos))) |
1485 |
(if did-expand |
(if did-expand |
1535 |
(set-buffer |
(set-buffer |
1536 |
(setq nnmail-cache-buffer |
(setq nnmail-cache-buffer |
1537 |
(get-buffer-create " *nnmail message-id cache*"))) |
(get-buffer-create " *nnmail message-id cache*"))) |
1538 |
|
(gnus-add-buffer) |
1539 |
(when (file-exists-p nnmail-message-id-cache-file) |
(when (file-exists-p nnmail-message-id-cache-file) |
1540 |
(nnheader-insert-file-contents nnmail-message-id-cache-file)) |
(nnheader-insert-file-contents nnmail-message-id-cache-file)) |
1541 |
(set-buffer-modified-p nil) |
(set-buffer-modified-p nil) |
1562 |
nnmail-message-id-cache-file nil 'silent) |
nnmail-message-id-cache-file nil 'silent) |
1563 |
(set-buffer-modified-p nil) |
(set-buffer-modified-p nil) |
1564 |
(setq nnmail-cache-buffer nil) |
(setq nnmail-cache-buffer nil) |
1565 |
(kill-buffer (current-buffer))))) |
(gnus-kill-buffer (current-buffer))))) |
1566 |
|
|
1567 |
;; Compiler directives. |
;; Compiler directives. |
1568 |
(defvar group) |
(defvar group) |
1569 |
(defvar group-art-list) |
(defvar group-art-list) |
1570 |
(defvar group-art) |
(defvar group-art) |
1571 |
(defun nnmail-cache-insert (id) |
(defun nnmail-cache-insert (id grp &optional subject sender) |
1572 |
(when nnmail-treat-duplicates |
(when (stringp id) |
1573 |
;; Store some information about the group this message is written |
;; this will handle cases like `B r' where the group is nil |
1574 |
;; to. This function might have been called from various places. |
(let ((grp (or grp gnus-newsgroup-name "UNKNOWN"))) |
1575 |
;; Sometimes, a function up in the calling sequence has an |
(run-hook-with-args 'nnmail-spool-hook |
1576 |
;; argument GROUP which is bound to a string, the group name. At |
id grp subject sender)) |
1577 |
;; other times, there is a function up in the calling sequence |
(when nnmail-treat-duplicates |
1578 |
;; which has an argument GROUP-ART which is a list of pairs, and |
;; Store some information about the group this message is written |
1579 |
;; the car of a pair is a group name. Should we check that the |
;; to. This is passed in as the grp argument -- all locations this |
1580 |
;; length of the list is equal to 1? -- kai |
;; has been called from have been checked and the group is available. |
1581 |
(let ((g nil)) |
;; The only ambiguous case is nnmail-check-duplication which will only |
1582 |
(cond ((and (boundp 'group) group) |
;; pass the first (of possibly >1) group which matches. -Josh |
|
(setq g group)) |
|
|
((and (boundp 'group-art-list) group-art-list |
|
|
(listp group-art-list)) |
|
|
(setq g (caar group-art-list))) |
|
|
((and (boundp 'group-art) group-art (listp group-art)) |
|
|
(setq g (caar group-art))) |
|
|
(t (setq g ""))) |
|
1583 |
(unless (gnus-buffer-live-p nnmail-cache-buffer) |
(unless (gnus-buffer-live-p nnmail-cache-buffer) |
1584 |
(nnmail-cache-open)) |
(nnmail-cache-open)) |
1585 |
(save-excursion |
(save-excursion |
1586 |
(set-buffer nnmail-cache-buffer) |
(set-buffer nnmail-cache-buffer) |
1587 |
(goto-char (point-max)) |
(goto-char (point-max)) |
1588 |
(if (and g (not (string= "" g)) |
(if (and grp (not (string= "" grp)) |
1589 |
(gnus-methods-equal-p gnus-command-method |
(gnus-methods-equal-p gnus-command-method |
1590 |
(nnmail-cache-primary-mail-backend))) |
(nnmail-cache-primary-mail-backend))) |
1591 |
(insert id "\t" g "\n") |
(let ((regexp (if (consp nnmail-cache-ignore-groups) |
1592 |
(insert id "\n")))))) |
(mapconcat 'identity nnmail-cache-ignore-groups |
1593 |
|
"\\|") |
1594 |
|
nnmail-cache-ignore-groups))) |
1595 |
|
(unless (and regexp (string-match regexp grp)) |
1596 |
|
(insert id "\t" grp "\n"))) |
1597 |
|
(insert id "\n")))))) |
1598 |
|
|
1599 |
(defun nnmail-cache-primary-mail-backend () |
(defun nnmail-cache-primary-mail-backend () |
1600 |
(let ((be-list (cons gnus-select-method gnus-secondary-select-methods)) |
(let ((be-list (cons gnus-select-method gnus-secondary-select-methods)) |
1601 |
(be nil) |
(be nil) |
1602 |
(res nil)) |
(res nil) |
1603 |
|
(get-new-mail nil)) |
1604 |
(while (and (null res) be-list) |
(while (and (null res) be-list) |
1605 |
(setq be (car be-list)) |
(setq be (car be-list)) |
1606 |
(setq be-list (cdr be-list)) |
(setq be-list (cdr be-list)) |
1607 |
(when (and (gnus-method-option-p be 'respool) |
(when (and (gnus-method-option-p be 'respool) |
1608 |
(eval (intern (format "%s-get-new-mail" (car be))))) |
(setq get-new-mail |
1609 |
(setq res be))) |
(intern (format "%s-get-new-mail" (car be)))) |
1610 |
|
(boundp get-new-mail) |
1611 |
|
(symbol-value get-new-mail)) |
1612 |
|
(setq res be))) |
1613 |
res)) |
res)) |
1614 |
|
|
1615 |
;; Fetch the group name corresponding to the message id stored in the |
;; Fetch the group name corresponding to the message id stored in the |
1620 |
(set-buffer nnmail-cache-buffer) |
(set-buffer nnmail-cache-buffer) |
1621 |
(goto-char (point-max)) |
(goto-char (point-max)) |
1622 |
(when (search-backward id nil t) |
(when (search-backward id nil t) |
1623 |
(beginning-of-line) |
(beginning-of-line) |
1624 |
(skip-chars-forward "^\n\r\t") |
(skip-chars-forward "^\n\r\t") |
1625 |
(unless (eolp) |
(unless (looking-at "[\r\n]") |
1626 |
(forward-char 1) |
(forward-char 1) |
1627 |
(buffer-substring (point) |
(buffer-substring (point) (gnus-point-at-eol))))))) |
|
(progn (end-of-line) (point)))))))) |
|
1628 |
|
|
1629 |
;; Function for nnmail-split-fancy: look up all references in the |
;; Function for nnmail-split-fancy: look up all references in the |
1630 |
;; cache and if a match is found, return that group. |
;; cache and if a match is found, return that group. |
1631 |
(defun nnmail-split-fancy-with-parent () |
(defun nnmail-split-fancy-with-parent () |
1632 |
|
"Split this message into the same group as its parent. |
1633 |
|
This function can be used as an entry in `nnmail-split-fancy', for |
1634 |
|
example like this: (: nnmail-split-fancy-with-parent) |
1635 |
|
For a message to be split, it looks for the parent message in the |
1636 |
|
References or In-Reply-To header and then looks in the message id |
1637 |
|
cache file (given by the variable `nnmail-message-id-cache-file') to |
1638 |
|
see which group that message was put in. This group is returned. |
1639 |
|
|
1640 |
|
See the Info node `(gnus)Fancy Mail Splitting' for more details." |
1641 |
(let* ((refstr (or (message-fetch-field "references") |
(let* ((refstr (or (message-fetch-field "references") |
1642 |
(message-fetch-field "in-reply-to"))) |
(message-fetch-field "in-reply-to"))) |
1643 |
(references nil) |
(references nil) |
1644 |
(res nil)) |
(res nil) |
1645 |
|
(regexp (if (consp nnmail-split-fancy-with-parent-ignore-groups) |
1646 |
|
(mapconcat |
1647 |
|
(lambda (x) (format "\\(%s\\)" x)) |
1648 |
|
nnmail-split-fancy-with-parent-ignore-groups |
1649 |
|
"\\|") |
1650 |
|
nnmail-split-fancy-with-parent-ignore-groups))) |
1651 |
(when refstr |
(when refstr |
1652 |
(setq references (nreverse (gnus-split-references refstr))) |
(setq references (nreverse (gnus-split-references refstr))) |
1653 |
(unless (gnus-buffer-live-p nnmail-cache-buffer) |
(unless (gnus-buffer-live-p nnmail-cache-buffer) |
1654 |
(nnmail-cache-open)) |
(nnmail-cache-open)) |
1655 |
(mapcar (lambda (x) |
(mapcar (lambda (x) |
1656 |
(setq res (or (nnmail-cache-fetch-group x) res)) |
(setq res (or (nnmail-cache-fetch-group x) res)) |
1657 |
(when (string= "drafts" res) |
(when (or (member res '("delayed" "drafts" "queue")) |
1658 |
(setq res nil))) |
(and regexp res (string-match regexp res))) |
1659 |
references) |
(setq res nil))) |
1660 |
|
references) |
1661 |
res))) |
res))) |
1662 |
|
|
1663 |
(defun nnmail-cache-id-exists-p (id) |
(defun nnmail-cache-id-exists-p (id) |
1682 |
(cond |
(cond |
1683 |
((memq nnmail-treat-duplicates '(warn delete)) |
((memq nnmail-treat-duplicates '(warn delete)) |
1684 |
nnmail-treat-duplicates) |
nnmail-treat-duplicates) |
1685 |
((nnheader-functionp nnmail-treat-duplicates) |
((functionp nnmail-treat-duplicates) |
1686 |
(funcall nnmail-treat-duplicates message-id)) |
(funcall nnmail-treat-duplicates message-id)) |
1687 |
(t |
(t |
1688 |
nnmail-treat-duplicates)))) |
nnmail-treat-duplicates)))) |
1699 |
((not duplication) |
((not duplication) |
1700 |
(funcall func (setq group-art |
(funcall func (setq group-art |
1701 |
(nreverse (nnmail-article-group artnum-func)))) |
(nreverse (nnmail-article-group artnum-func)))) |
1702 |
(nnmail-cache-insert message-id)) |
(nnmail-cache-insert message-id (caar group-art))) |
1703 |
((eq action 'delete) |
((eq action 'delete) |
1704 |
(setq group-art nil)) |
(setq group-art nil)) |
1705 |
((eq action 'warn) |
((eq action 'warn) |
1766 |
(setq source (append source |
(setq source (append source |
1767 |
(list |
(list |
1768 |
:predicate |
:predicate |
1769 |
`(lambda (file) |
(gnus-byte-compile |
1770 |
(string-match |
`(lambda (file) |
1771 |
,(concat |
(string-equal |
1772 |
(regexp-quote (concat group suffix)) |
,(concat group suffix) |
1773 |
"$") |
(file-name-nondirectory file))))))))) |
|
file))))))) |
|
1774 |
(when nnmail-fetched-sources |
(when nnmail-fetched-sources |
1775 |
(if (member source nnmail-fetched-sources) |
(if (member source nnmail-fetched-sources) |
1776 |
(setq source nil) |
(setq source nil) |
1791 |
(when (setq new |
(when (setq new |
1792 |
(mail-source-fetch |
(mail-source-fetch |
1793 |
source |
source |
1794 |
`(lambda (file orig-file) |
(gnus-byte-compile |
1795 |
(nnmail-split-incoming |
`(lambda (file orig-file) |
1796 |
file ',(intern (format "%s-save-mail" method)) |
(nnmail-split-incoming |
1797 |
',spool-func |
file ',(intern (format "%s-save-mail" method)) |
1798 |
(if (equal file orig-file) |
',spool-func |
1799 |
nil |
(if (equal file orig-file) |
1800 |
(nnmail-get-split-group orig-file ',source)) |
nil |
1801 |
',(intern (format "%s-active-number" method)))))) |
(nnmail-get-split-group orig-file ',source)) |
1802 |
|
',(intern (format "%s-active-number" method))))))) |
1803 |
(incf total new) |
(incf total new) |
1804 |
(incf i))) |
(incf i))) |
1805 |
;; If we did indeed read any incoming spools, we save all info. |
;; If we did indeed read any incoming spools, we save all info. |
1835 |
;; We expire all articles on sight. |
;; We expire all articles on sight. |
1836 |
t) |
t) |
1837 |
((equal time '(0 0)) |
((equal time '(0 0)) |
1838 |
;; This is an ange-ftp group, and we don't have any dates. |
;; This is an ange-ftp group, and we don't have any dates. |
1839 |
nil) |
nil) |
1840 |
((numberp days) |
((numberp days) |
1841 |
(setq days (days-to-time days)) |
(setq days (days-to-time days)) |
1843 |
(ignore-errors (time-less-p days (time-since time)))))))) |
(ignore-errors (time-less-p days (time-since time)))))))) |
1844 |
|
|
1845 |
(defun nnmail-expiry-target-group (target group) |
(defun nnmail-expiry-target-group (target group) |
1846 |
(when (nnheader-functionp target) |
;; Do not invoke this from nntp-server-buffer! At least nnfolder clears |
1847 |
(setq target (funcall target group))) |
;; that buffer if the nnfolder group isn't selected. |
1848 |
(unless (eq target 'delete) |
(let (nnmail-cache-accepted-message-ids) |
1849 |
(gnus-request-accept-article target nil nil t))) |
;; Don't enter Message-IDs into cache. |
1850 |
|
;; Let users hack it in TARGET function. |
1851 |
|
(when (functionp target) |
1852 |
|
(setq target (funcall target group))) |
1853 |
|
(unless (eq target 'delete) |
1854 |
|
(when (or (gnus-request-group target) |
1855 |
|
(gnus-request-create-group target)) |
1856 |
|
(let ((group-art (gnus-request-accept-article target nil nil t))) |
1857 |
|
(when (consp group-art) |
1858 |
|
(gnus-group-mark-article-read target (cdr group-art)))))))) |
1859 |
|
|
1860 |
|
(defun nnmail-fancy-expiry-target (group) |
1861 |
|
"Returns a target expiry group determined by `nnmail-fancy-expiry-targets'." |
1862 |
|
(let* (header |
1863 |
|
(case-fold-search nil) |
1864 |
|
(from (or (message-fetch-field "from") "")) |
1865 |
|
(to (or (message-fetch-field "to") "")) |
1866 |
|
(date (date-to-time |
1867 |
|
(or (message-fetch-field "date") (current-time-string)))) |
1868 |
|
(target 'delete)) |
1869 |
|
(dolist (regexp-target-pair (reverse nnmail-fancy-expiry-targets) target) |
1870 |
|
(setq header (car regexp-target-pair)) |
1871 |
|
(cond |
1872 |
|
;; If the header is to-from then match against the |
1873 |
|
;; To or From header |
1874 |
|
((and (equal header 'to-from) |
1875 |
|
(or (string-match (cadr regexp-target-pair) from) |
1876 |
|
(and (string-match message-dont-reply-to-names from) |
1877 |
|
(string-match (cadr regexp-target-pair) to)))) |
1878 |
|
(setq target (format-time-string (caddr regexp-target-pair) date))) |
1879 |
|
((and (not (equal header 'to-from)) |
1880 |
|
(string-match (cadr regexp-target-pair) |
1881 |
|
(or |
1882 |
|
(message-fetch-field header) |
1883 |
|
""))) |
1884 |
|
(setq target |
1885 |
|
(format-time-string (caddr regexp-target-pair) date))))))) |
1886 |
|
|
1887 |
(defun nnmail-check-syntax () |
(defun nnmail-check-syntax () |
1888 |
"Check (and modify) the syntax of the message in the current buffer." |
"Check (and modify) the syntax of the message in the current buffer." |
1979 |
"Remove all instances of GROUP from `nnmail-split-history'." |
"Remove all instances of GROUP from `nnmail-split-history'." |
1980 |
(let ((history nnmail-split-history)) |
(let ((history nnmail-split-history)) |
1981 |
(while history |
(while history |
1982 |
(setcar history (gnus-delete-if (lambda (e) (string= (car e) group)) |
(setcar history (gnus-remove-if (lambda (e) (string= (car e) group)) |
1983 |
(car history))) |
(car history))) |
1984 |
(pop history)) |
(pop history)) |
1985 |
(setq nnmail-split-history (delq nil nnmail-split-history)))) |
(setq nnmail-split-history (delq nil nnmail-split-history)))) |