/[emacs]/emacs/lisp/gnus/nnmail.el
ViewVC logotype

Diff of /emacs/lisp/gnus/nnmail.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.16.2.2 by miles, Tue Oct 14 23:34:51 2003 UTC revision 1.16.2.3 by miles, Thu Sep 16 00:12:16 2004 UTC
# Line 1  Line 1 
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>
# Line 28  Line 28 
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)
# Line 36  Line 37 
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."
# Line 76  Line 77 
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
# Line 86  else, you could do something like this: Line 86  else, you could do something like this:
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,
# Line 104  The last element should always have \"\" Line 104  The last element should always have \"\"
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    
# Line 115  If nil, the first match found will be us Line 116  If nil, the first match found will be us
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.
# Line 145  number of days) -- this doesn't have to Line 162  number of days) -- this doesn't have to
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
# Line 176  called in a buffer narrowed to the messa Line 193  called in a buffer narrowed to the messa
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    
# Line 237  running (\"xwatch\", etc.) Line 288  running (\"xwatch\", etc.)
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.
# Line 299  discarded after running the split proces Line 350  discarded after running the split proces
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.
# Line 336  GROUP: Mail will be stored in GROUP (a s Line 457  GROUP: Mail will be stored in GROUP (a s
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.
# Line 363  Example: Line 490  Example:
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")
# Line 418  parameter.  It should return nil, `warn' Line 544  parameter.  It should return nil, `warn'
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
# Line 430  parameter.  It should return nil, `warn' Line 556  parameter.  It should return nil, `warn'
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.")
# Line 451  parameter.  It should return nil, `warn' Line 605  parameter.  It should return nil, `warn'
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    
# Line 474  parameter.  It should return nil, `warn' Line 623  parameter.  It should return nil, `warn'
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))
# Line 529  nn*-request-list should have been called Line 678  nn*-request-list should have been called
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))
# Line 715  If SOURCE is a directory spec, try to re Line 864  If SOURCE is a directory spec, try to re
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)
# Line 887  If SOURCE is a directory spec, try to re Line 1038  If SOURCE is a directory spec, try to re
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))
# Line 895  FUNC will be called with the buffer narr Line 1046  FUNC will be called with the buffer narr
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))
# Line 923  FUNC will be called with the buffer narr Line 1074  FUNC will be called with the buffer narr
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
# Line 935  FUNC will be called with the group name Line 1085  FUNC will be called with the group name
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)
# Line 954  FUNC will be called with the group name Line 1112  FUNC will be called with the group name
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))
# Line 971  FUNC will be called with the group name Line 1129  FUNC will be called with the group name
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))
# Line 1017  FUNC will be called with the group name Line 1175  FUNC will be called with the group name
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
# Line 1091  Return the number of characters in the b Line 1252  Return the number of characters in the b
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."
# Line 1113  Return the number of characters in the b Line 1281  Return the number of characters in the b
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
# Line 1145  See the documentation for the variable ` Line 1335  See the documentation for the variable `
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.
# Line 1168  See the documentation for the variable ` Line 1358  See the documentation for the variable `
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.
# Line 1184  See the documentation for the variable ` Line 1376  See the documentation for the variable `
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
# Line 1218  See the documentation for the variable ` Line 1410  See the documentation for the variable `
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    
# Line 1226  See the documentation for the variable ` Line 1418  See the documentation for the variable `
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)
# Line 1273  See the documentation for the variable ` Line 1476  See the documentation for the variable `
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
# Line 1329  See the documentation for the variable ` Line 1535  See the documentation for the variable `
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)
# Line 1355  See the documentation for the variable ` Line 1562  See the documentation for the variable `
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
# Line 1411  See the documentation for the variable ` Line 1620  See the documentation for the variable `
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)
# Line 1458  See the documentation for the variable ` Line 1682  See the documentation for the variable `
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))))
# Line 1475  See the documentation for the variable ` Line 1699  See the documentation for the variable `
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)
# Line 1542  See the documentation for the variable ` Line 1766  See the documentation for the variable `
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)
# Line 1568  See the documentation for the variable ` Line 1791  See the documentation for the variable `
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.
# Line 1611  See the documentation for the variable ` Line 1835  See the documentation for the variable `
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))
# Line 1619  See the documentation for the variable ` Line 1843  See the documentation for the variable `
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."
# Line 1719  See the documentation for the variable ` Line 1979  See the documentation for the variable `
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))))

Legend:
Removed from v.1.16.2.2  
changed lines
  Added in v.1.16.2.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26