[Enable mail splitting to work with non-ASCII nnml groups]
[gnus] / lisp / nnmail.el
index cb1fb79..b5880af 100644 (file)
@@ -1,6 +1,7 @@
 ;;; nnmail.el --- mail support functions for the Gnus mail backends
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002
-;;        Free Software Foundation, Inc.
+
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
+;;   2004, 2005, 2006, 2007 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news, mail
@@ -19,8 +20,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
 
 (eval-when-compile (require 'cl))
 
+(require 'gnus)                                ; for macro gnus-kill-buffer, at least
 (require 'nnheader)
 (require 'message)
-(require 'custom)
 (require 'gnus-util)
 (require 'mail-source)
 (require 'mm-util)
 
 (eval-and-compile
-  (autoload 'gnus-error "gnus-util")
-  (autoload 'gnus-buffer-live-p "gnus-util")
-  (autoload 'gnus-add-buffer "gnus"))
+  (autoload 'gnus-add-buffer "gnus")
+  (autoload 'gnus-kill-buffer "gnus"))
 
 (defgroup nnmail nil
   "Reading mail with Gnus."
@@ -49,7 +49,7 @@
   :group 'nnmail)
 
 (defgroup nnmail-prepare nil
-  "Preparing (or mangling) new mail after retrival."
+  "Preparing (or mangling) new mail after retrieval."
   :group 'nnmail)
 
 (defgroup nnmail-duplicate nil
@@ -119,6 +119,7 @@ If nil, the first match found will be used."
 (defcustom nnmail-split-fancy-with-parent-ignore-groups nil
   "Regexp that matches group names to be ignored when applying `nnmail-split-fancy-with-parent'.
 This can also be a list of regexps."
+  :version "22.1"
   :group 'nnmail-split
   :type '(choice (const :tag "none" nil)
                 (regexp :value ".*")
@@ -127,6 +128,7 @@ This can also be a list of regexps."
 (defcustom nnmail-cache-ignore-groups nil
   "Regexp that matches group names to be ignored when inserting message ids into the cache (`nnmail-cache-insert').
 This can also be a list of regexps."
+  :version "22.1"
   :group 'nnmail-split
   :type '(choice (const :tag "none" nil)
                 (regexp :value ".*")
@@ -167,10 +169,10 @@ can also be `immediate' and `never'."
 
 (defcustom nnmail-expiry-wait-function nil
   "Variable that holds function to specify how old articles should be before they are expired.
-  The function will be called with the name of the group that the
-expiry is to be performed in, and it should return an integer that
-says how many days an article can be stored before it is considered
-\"old\".  It can also return the values `never' and `immediate'.
+The function will be called with the name of the group that the expiry
+is to be performed in, and it should return an integer that says how
+many days an article can be stored before it is considered \"old\".
+It can also return the values `never' and `immediate'.
 
 Eg.:
 
@@ -224,6 +226,7 @@ From header will be expired to the group \"nnfolder:Work\";
 articles containing the sting \"IMPORTANT\" in the Subject header will
 be expired to the group \"nnfolder:IMPORTANT.YYYY.MMM\"; and
 everything else will be expired to \"nnfolder:Archive-YYYY\"."
+  :version "22.1"
   :group 'nnmail-expire
   :type '(repeat (list (choice :tag "Match against"
                               (string :tag "Header")
@@ -243,6 +246,10 @@ This variable is a list of mail source specifiers.
 This variable is obsolete; `mail-sources' should be used instead."
   :group 'nnmail-files
   :type 'sexp)
+(make-obsolete-variable 'nnmail-spool-file
+                       "This option is obsolete in Gnus 5.9.  \
+Use `mail-sources' instead.")
+;; revision 5.29 / p0-85 / Gnus 5.9
 
 (defcustom nnmail-resplit-incoming nil
   "*If non-nil, re-split incoming procmail sorted mail."
@@ -350,14 +357,84 @@ discarded after running the split process."
   :group 'nnmail-split
   :type 'hook)
 
+(defcustom nnmail-spool-hook nil
+  "*A hook called when a new article is spooled."
+  :version "22.1"
+  :group 'nnmail
+  :type 'hook)
+
 (defcustom nnmail-large-newsgroup 50
-  "*The number of the articles which indicates a large newsgroup or nil.
-If the number of the articles is greater than the value, verbose
+  "*The number of articles which indicates a large newsgroup or nil.
+If the number of articles is greater than the value, verbose
 messages will be shown to indicate the current status."
   :group 'nnmail-various
   :type '(choice (const :tag "infinite" nil)
                  (number :tag "count")))
 
+(define-widget 'nnmail-lazy 'default
+  "Base widget for recursive datastructures.
+
+This is copy of the `lazy' widget in Emacs 22.1 provided for compatibility."
+  :format "%{%t%}: %v"
+  :convert-widget 'widget-value-convert-widget
+  :value-create (lambda (widget)
+                  (let ((value (widget-get widget :value))
+                        (type (widget-get widget :type)))
+                    (widget-put widget :children
+                                (list (widget-create-child-value
+                                       widget (widget-convert type) value)))))
+  :value-delete 'widget-children-value-delete
+  :value-get (lambda (widget)
+               (widget-value (car (widget-get widget :children))))
+  :value-inline (lambda (widget)
+                  (widget-apply (car (widget-get widget :children))
+                                :value-inline))
+  :default-get (lambda (widget)
+                 (widget-default-get
+                  (widget-convert (widget-get widget :type))))
+  :match (lambda (widget value)
+           (widget-apply (widget-convert (widget-get widget :type))
+                         :match value))
+  :validate (lambda (widget)
+              (widget-apply (car (widget-get widget :children)) :validate)))
+
+(define-widget 'nnmail-split-fancy 'nnmail-lazy
+  "Widget for customizing splits in the variable of the same name."
+  :tag "Split"
+  :type '(menu-choice :value (any ".*value.*" "misc")
+                      :tag "Type"
+                      (string :tag "Destination")
+                      (list :tag "Use first match (|)" :value (|)
+                            (const :format "" |)
+                            (editable-list :inline t nnmail-split-fancy))
+                      (list :tag "Use all matches (&)" :value (&)
+                            (const :format "" &)
+                            (editable-list :inline t nnmail-split-fancy))
+                      (list :tag "Function with fixed arguments (:)"
+                            :value (:)
+                            (const :format "" :value :)
+                            function
+                            (editable-list :inline t (sexp :tag "Arg"))
+                            )
+                      (list :tag "Function with split arguments (!)"
+                            :value (!)
+                            (const :format "" !)
+                            function
+                            (editable-list :inline t nnmail-split-fancy))
+                      (list :tag "Field match"
+                            (choice :tag "Field"
+                                    regexp symbol)
+                            (choice :tag "Match"
+                                    regexp
+                                    (symbol :value mail))
+                            (repeat :inline t
+                                    :tag "Restrictions"
+                                    (group :inline t
+                                           (const :format "" -)
+                                           regexp))
+                            nnmail-split-fancy)
+                      (const :tag "Junk (delete mail)" junk)))
+
 (defcustom nnmail-split-fancy "mail.misc"
   "Incoming mail can be split according to this fancy variable.
 To enable this, set `nnmail-split-methods' to `nnmail-split-fancy'.
@@ -398,7 +475,7 @@ FIELD must match a complete field name.  VALUE must match a complete
 word according to the `nnmail-split-fancy-syntax-table' syntax table.
 You can use \".*\" in the regexps to match partial field names or words.
 
-FIELD and VALUE can also be lisp symbols, in that case they are expanded
+FIELD and VALUE can also be Lisp symbols, in that case they are expanded
 as specified in `nnmail-split-abbrev-alist'.
 
 GROUP can contain \\& and \\N which will substitute from matching
@@ -433,8 +510,7 @@ Example:
          ;; Unmatched mail goes to the catch all group.
          \"misc.misc\"))"
   :group 'nnmail-split
-  ;; Sigh!
-  :type 'sexp)
+  :type 'nnmail-split-fancy)
 
 (defcustom nnmail-split-abbrev-alist
   '((any . "from\\|to\\|cc\\|sender\\|apparently-to\\|resent-from\\|resent-to\\|resent-cc")
@@ -482,7 +558,7 @@ parameter.  It should return nil, `warn' or `delete'."
   :group 'nnmail
   :type '(repeat symbol))
 
-(defcustom nnmail-split-header-length-limit 512
+(defcustom nnmail-split-header-length-limit 2048
   "Header lines longer than this limit are excluded from the split function."
   :version "21.1"
   :group 'nnmail
@@ -490,11 +566,31 @@ parameter.  It should return nil, `warn' or `delete'."
 
 (defcustom nnmail-mail-splitting-charset nil
   "Default charset to be used when splitting incoming mail."
+  :version "22.1"
   :group 'nnmail
   :type 'symbol)
 
 (defcustom nnmail-mail-splitting-decodes nil
   "Whether the nnmail splitting functionality should MIME decode headers."
+  :version "22.1"
+  :group 'nnmail
+  :type 'boolean)
+
+(defcustom nnmail-split-fancy-match-partial-words nil
+  "Whether to match partial words when fancy splitting.
+Normally, regexes given in `nnmail-split-fancy' are implicitly surrounded
+by \"\\=\\<...\\>\".  If this variable is true, they are not implicitly\
+ surrounded
+by anything."
+  :version "22.1"
+  :group 'nnmail
+  :type 'boolean)
+
+(defcustom nnmail-split-lowercase-expanded t
+  "Whether to lowercase expanded entries (i.e. \\N) when splitting mails.
+This avoids the creation of multiple groups when users send to an address
+using different case (i.e. mailing-list@domain vs Mailing-List@Domain)."
+  :version "22.1"
   :group 'nnmail
   :type 'boolean)
 
@@ -506,13 +602,12 @@ parameter.  It should return nil, `warn' or `delete'."
 (defvar nnmail-split-history nil
   "List of group/article elements that say where the previous split put messages.")
 
-(defvar nnmail-split-fancy-syntax-table nil
+(defvar nnmail-split-fancy-syntax-table
+  (let ((table (make-syntax-table)))
+    ;; support the %-hack
+    (modify-syntax-entry ?\% "." table)
+    table)
   "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))
 
 (defvar nnmail-prepare-save-mail-hook nil
   "Hook called before saving mail.")
@@ -522,11 +617,6 @@ parameter.  It should return nil, `warn' or `delete'."
 
 \f
 
-(defconst nnmail-version "nnmail 1.0"
-  "nnmail version.")
-
-\f
-
 (defun nnmail-request-post (&optional server)
   (mail-send-and-exit nil))
 
@@ -569,9 +659,7 @@ parameter.  It should return nil, `warn' or `delete'."
          (expand-file-name group dir)
        ;; If not, we translate dots into slashes.
        (expand-file-name
-        (mm-encode-coding-string
-         (nnheader-replace-chars-in-string group ?. ?/)
-         nnmail-pathname-coding-system)
+        (nnheader-replace-chars-in-string group ?. ?/)
         dir))))
    (or file "")))
 
@@ -596,7 +684,7 @@ nn*-request-list should have been called before calling this function."
     (while (not (eobp))
       (condition-case err
          (progn
-           (narrow-to-region (point) (gnus-point-at-eol))
+           (narrow-to-region (point) (point-at-eol))
            (setq group (read buffer))
            (unless (stringp group)
              (setq group (symbol-name group)))
@@ -683,7 +771,7 @@ If SOURCE is a directory spec, try to return the group name component."
       (if (not (save-excursion
                 (and (re-search-backward
                       "^Content-Length:[ \t]*\\([0-9]+\\)" start t)
-                     (setq content-length (string-to-int
+                     (setq content-length (string-to-number
                                            (buffer-substring
                                             (match-beginning 1)
                                             (match-end 1))))
@@ -820,7 +908,7 @@ If SOURCE is a directory spec, try to return the group name component."
        (if (not (re-search-forward
                  "^Content-Length:[ \t]*\\([0-9]+\\)" nil t))
            (setq content-length nil)
-         (setq content-length (string-to-int (match-string 1)))
+         (setq content-length (string-to-number (match-string 1)))
          ;; We destroy the header, since none of the backends ever
          ;; use it, and we do not want to confuse other mailers by
          ;; having a (possibly) faulty header.
@@ -885,8 +973,8 @@ If SOURCE is a directory spec, try to return the group name component."
         start
         (if (search-forward "\n\n" nil t)
             (1- (point))
-        ;; This will never happen, but just to be on the safe side --
-      ;; if there is no head-body delimiter, we search a bit manually.
+          ;; This will never happen, but just to be on the safe side --
+          ;; if there is no head-body delimiter, we search a bit manually.
           (while (and (looking-at "From \\|[^ \t]+:")
                       (not (eobp)))
             (forward-line 1))
@@ -932,7 +1020,7 @@ If SOURCE is a directory spec, try to return the group name component."
      (if (search-forward "\n\n" nil t)
         (1- (point))
        ;; This will never happen, but just to be on the safe side --
-      ;; if there is no head-body delimiter, we search a bit manually.
+       ;; if there is no head-body delimiter, we search a bit manually.
        (while (and (looking-at "From \\|[^ \t]+:")
                   (not (eobp)))
         (forward-line 1))
@@ -956,6 +1044,9 @@ If SOURCE is a directory spec, try to return the group name component."
       (nnmail-check-duplication message-id func artnum-func))
     1))
 
+(defvar nnmail-group-names-not-encoded-p nil
+  "Non-nil means group names are not encoded.")
+
 (defun nnmail-split-incoming (incoming func &optional exit-func
                                       group artnum-func)
   "Go through the entire INCOMING file and pick out each individual mail.
@@ -965,7 +1056,8 @@ FUNC will be called with the buffer narrowed to each mail."
        (nnmail-split-methods (if (and group
                                       (not nnmail-resplit-incoming))
                                  (list (list group ""))
-                               nnmail-split-methods)))
+                               nnmail-split-methods))
+       (nnmail-group-names-not-encoded-p t))
     (save-excursion
       ;; Insert the incoming file.
       (set-buffer (get-buffer-create nnmail-article-buffer))
@@ -998,8 +1090,7 @@ FUNC will be called with the buffer narrowed to each mail."
 FUNC will be called with the group name to determine the article number."
   (let ((methods (or nnmail-split-methods '(("bogus" ""))))
        (obuf (current-buffer))
-       (beg (point-min))
-       end group-art method grp)
+       group-art method grp)
     (if (and (sequencep methods)
             (= (length methods) 1))
        ;; If there is only just one group to put everything in, we
@@ -1008,13 +1099,17 @@ FUNC will be called with the group name to determine the article number."
              (list (cons (caar methods) (funcall func (caar methods)))))
       ;; We do actual comparison.
       (save-excursion
-       ;; Find headers.
-       (goto-char beg)
-       (setq end (if (search-forward "\n\n" nil t) (point) (point-max)))
+       ;; Copy the article into the work buffer.
        (set-buffer nntp-server-buffer)
        (erase-buffer)
-       ;; Copy the headers into the work buffer.
-       (insert-buffer-substring obuf beg end)
+       (insert-buffer-substring obuf)
+       ;; Narrow to headers.
+       (narrow-to-region
+        (goto-char (point-min))
+        (if (search-forward "\n\n" nil t)
+            (point)
+          (point-max)))
+       (goto-char (point-min))
        ;; Decode MIME headers and charsets.
        (when nnmail-mail-splitting-decodes
          (let ((mail-parse-charset nnmail-mail-splitting-charset))
@@ -1031,7 +1126,7 @@ FUNC will be called with the group name to determine the article number."
        (while (not (eobp))
          (unless (< (move-to-column nnmail-split-header-length-limit)
                     nnmail-split-header-length-limit)
-           (delete-region (point) (progn (end-of-line) (point))))
+           (delete-region (point) (point-at-eol)))
          (forward-line 1))
        ;; Allow washing.
        (goto-char (point-min))
@@ -1041,7 +1136,7 @@ FUNC will be called with the group name to determine the article number."
        (if (and (symbolp nnmail-split-methods)
                 (fboundp nnmail-split-methods))
            (let ((split
-                  (condition-case nil
+                  (condition-case error-info
                       ;; `nnmail-split-methods' is a function, so we
                       ;; just call this function here and use the
                       ;; result.
@@ -1049,10 +1144,10 @@ FUNC will be called with the group name to determine the article number."
                           '("bogus"))
                     (error
                      (nnheader-message
-                      5 "Error in `nnmail-split-methods'; using `bogus' mail group")
+                      5 "Error in `nnmail-split-methods'; using `bogus' mail group: %S" error-info)
                      (sit-for 1)
                      '("bogus")))))
-             (setq split (gnus-remove-duplicates split))
+             (setq split (mm-delete-duplicates split))
              ;; The article may be "cross-posted" to `junk'.  What
              ;; to do?  Just remove the `junk' spec.  Don't really
              ;; see anything else to do...
@@ -1094,7 +1189,10 @@ FUNC will be called with the group name to determine the article number."
              (unless group-art
                (setq group-art
                      (list (cons (car method)
-                                 (funcall func (car method)))))))))
+                                 (funcall func (car method))))))))
+         ;; Fall back on "bogus" if all else fails.
+         (unless group-art
+           (setq group-art (list (cons "bogus" (funcall func "bogus"))))))
        ;; Produce a trace if non-empty.
        (when (and trace nnmail-split-trace)
          (let ((restore (current-buffer)))
@@ -1106,6 +1204,7 @@ FUNC will be called with the group name to determine the article number."
            (goto-char (point-min))
            (gnus-configure-windows 'split-trace)
            (set-buffer restore)))
+       (widen)
        ;; See whether the split methods returned `junk'.
        (if (equal group-art '(junk))
            nil
@@ -1149,11 +1248,11 @@ Return the number of characters in the body."
                     (progn (forward-line 1) (point))))
     (insert (format "Xref: %s" (system-name)))
     (while group-alist
-      (insert (format " %s:%d"
-                     (mm-encode-coding-string
-                      (caar group-alist)
-                      nnmail-pathname-coding-system)
-                     (cdar group-alist)))
+      (insert (if (mm-multibyte-p)
+                 (mm-string-as-multibyte
+                  (format " %s:%d" (caar group-alist) (cdar group-alist)))
+               (mm-string-as-unibyte
+                (format " %s:%d" (caar group-alist) (cdar group-alist)))))
       (setq group-alist (cdr group-alist)))
     (insert "\n")))
 
@@ -1178,7 +1277,8 @@ Return the number of characters in the body."
              nil t)
        (delete-region (match-beginning 2) (match-end 0))
        (beginning-of-line))
-      (when (re-search-forward "^Subject: +\\(\\(R[Ee]: +\\)+\\)R[Ee]: +" nil t)
+      (when (re-search-forward "^Subject: +\\(\\(R[Ee]: +\\)+\\)R[Ee]: +"
+                              nil t)
        (delete-region (match-beginning 1) (match-end 1))
        (beginning-of-line)))))
 
@@ -1186,10 +1286,20 @@ Return the number of characters in the body."
   "Translate TAB characters into SPACE characters."
   (subst-char-in-region (point-min) (point-max) ?\t ?  t))
 
-(defun nnmail-fix-eudora-headers ()
-  "Eudora has a broken References line, but an OK In-Reply-To."
+(defcustom nnmail-broken-references-mailers
+  "^X-Mailer:.*\\(Eudora\\|Pegasus\\)"
+  "Header line matching mailer producing bogus References lines.
+See `nnmail-ignore-broken-references'."
+  :group 'nnmail-prepare
+  :version "23.0" ;; No Gnus
+  :type 'regexp)
+
+(defun nnmail-ignore-broken-references ()
+  "Ignore the References line and use In-Reply-To
+
+Eudora has a broken References line, but an OK In-Reply-To."
   (goto-char (point-min))
-  (when (re-search-forward "^X-Mailer:.*Eudora" nil t)
+  (when (re-search-forward nnmail-broken-references-mailers nil t)
     (goto-char (point-min))
     (when (re-search-forward "^References:" nil t)
       (beginning-of-line)
@@ -1198,8 +1308,11 @@ Return the number of characters in the body."
     (when (re-search-forward "^\\(In-Reply-To:[^\n]+\\)\n[ \t]+" nil t)
       (replace-match "\\1" t))))
 
+(defalias 'nnmail-fix-eudora-headers 'nnmail-ignore-broken-references)
+(make-obsolete 'nnmail-fix-eudora-headers 'nnmail-ignore-broken-references)
+
 (custom-add-option 'nnmail-prepare-incoming-header-hook
-                  'nnmail-fix-eudora-headers)
+                  'nnmail-ignore-broken-references)
 
 ;;; Utility functions
 
@@ -1228,12 +1341,8 @@ to actually put the message in the right group."
 (defun nnmail-split-fancy ()
   "Fancy splitting method.
 See the documentation for the variable `nnmail-split-fancy' for details."
-  (let ((syntab (syntax-table)))
-    (unwind-protect
-       (progn
-         (set-syntax-table nnmail-split-fancy-syntax-table)
-         (nnmail-split-it nnmail-split-fancy))
-      (set-syntax-table syntab))))
+  (with-syntax-table nnmail-split-fancy-syntax-table
+    (nnmail-split-it nnmail-split-fancy)))
 
 (defvar nnmail-split-cache nil)
 ;; Alist of split expressions their equivalent regexps.
@@ -1324,16 +1433,18 @@ See the documentation for the variable `nnmail-split-fancy' for details."
                ;; correct match positions.
                (re-search-backward value start-of-value))
              (dolist (sp (nnmail-split-it (car split-rest)))
-               (unless (memq sp split-result)
+               (unless (member sp split-result)
                  (push sp split-result))))))
        split-result))
 
      ;; Not in cache, compute a regexp for the field/value pair.
      (t
-      (let* ((field (nth 0 split))
-            (value (nth 1 split))
-            partial-front regexp
-            partial-rear  regexp)
+      (let ((field (nth 0 split))
+           (value (nth 1 split))
+           (split-rest (cddr split))
+           partial-front
+           partial-rear
+           regexp)
        (if (symbolp value)
            (setq value (cdr (assq value nnmail-split-abbrev-alist))))
        (if (and (>= (length value) 2)
@@ -1345,6 +1456,15 @@ See the documentation for the variable `nnmail-split-fancy' for details."
                 (string= ".*" (substring value -2)))
            (setq value (substring value 0 -2)
                  partial-rear ""))
+       ;; Invert the match-partial-words behavior if the optional
+       ;; last element is specified.
+       (while (eq (car split-rest) '-)
+         (setq split-rest (cddr split-rest)))
+       (when (if (cadr split-rest)
+                 (not nnmail-split-fancy-match-partial-words)
+               nnmail-split-fancy-match-partial-words)
+         (setq partial-front ""
+               partial-rear ""))
        (setq regexp (concat "^\\(\\("
                             (if (symbolp field)
                                 (cdr (assq field nnmail-split-abbrev-alist))
@@ -1357,7 +1477,7 @@ See the documentation for the variable `nnmail-split-fancy' for details."
                             (or partial-rear "\\>")))
        (push (cons split regexp) nnmail-split-cache)
        ;; Now that it's in the cache, just call nnmail-split-it again
-    ;; on the same split, which will find it immediately in the cache.
+       ;; on the same split, which will find it immediately in the cache.
        (nnmail-split-it split))))))
 
 (defun nnmail-expand-newtext (newtext)
@@ -1386,7 +1506,10 @@ See the documentation for the variable `nnmail-split-fancy' for details."
              (setq N 0)
            (setq N (- c ?0)))
          (when (match-beginning N)
-           (push (buffer-substring (match-beginning N) (match-end N))
+           (push (if nnmail-split-lowercase-expanded
+                     (downcase (buffer-substring (match-beginning N)
+                                                 (match-end N)))
+                   (buffer-substring (match-beginning N) (match-end N)))
                  expanded))))
       (setq pos (1+ pos)))
     (if did-expand
@@ -1469,44 +1592,53 @@ See the documentation for the variable `nnmail-split-fancy' for details."
                           nnmail-message-id-cache-file nil 'silent)
       (set-buffer-modified-p nil)
       (setq nnmail-cache-buffer nil)
-      (kill-buffer (current-buffer)))))
+      (gnus-kill-buffer (current-buffer)))))
 
 ;; Compiler directives.
 (defvar group)
 (defvar group-art-list)
 (defvar group-art)
-(defun nnmail-cache-insert (id grp)
-  (when nnmail-treat-duplicates
-    ;; Store some information about the group this message is written
-    ;; to.  This is passed in as the grp argument -- all locations this
-    ;; has been called from have been checked and the group is available.
-    ;; The only ambiguous case is nnmail-check-duplication which will only
-    ;; pass the first (of possibly >1) group which matches. -Josh
-    (unless (gnus-buffer-live-p nnmail-cache-buffer)
-      (nnmail-cache-open))
-    (save-excursion
-      (set-buffer nnmail-cache-buffer)
-      (goto-char (point-max))
-      (if (and grp (not (string= "" grp))
-              (gnus-methods-equal-p gnus-command-method
-                                    (nnmail-cache-primary-mail-backend)))
-         (let ((regexp (if (consp nnmail-cache-ignore-groups)
-                           (mapconcat 'identity nnmail-cache-ignore-groups
-                                      "\\|")
-                         nnmail-cache-ignore-groups)))
-           (unless (and regexp (string-match regexp grp))
-             (insert id "\t" grp "\n")))
-       (insert id "\n")))))
+(defun nnmail-cache-insert (id grp &optional subject sender)
+  (when (stringp id)
+    ;; this will handle cases like `B r' where the group is nil
+    (let ((grp (or grp gnus-newsgroup-name "UNKNOWN")))
+      (run-hook-with-args 'nnmail-spool-hook
+                         id grp subject sender))
+    (when nnmail-treat-duplicates
+      ;; Store some information about the group this message is written
+      ;; to.  This is passed in as the grp argument -- all locations this
+      ;; has been called from have been checked and the group is available.
+      ;; The only ambiguous case is nnmail-check-duplication which will only
+      ;; pass the first (of possibly >1) group which matches. -Josh
+      (unless (gnus-buffer-live-p nnmail-cache-buffer)
+       (nnmail-cache-open))
+      (save-excursion
+       (set-buffer nnmail-cache-buffer)
+       (goto-char (point-max))
+       (if (and grp (not (string= "" grp))
+                (gnus-methods-equal-p gnus-command-method
+                                      (nnmail-cache-primary-mail-backend)))
+           (let ((regexp (if (consp nnmail-cache-ignore-groups)
+                             (mapconcat 'identity nnmail-cache-ignore-groups
+                                        "\\|")
+                           nnmail-cache-ignore-groups)))
+             (unless (and regexp (string-match regexp grp))
+               (insert id "\t" grp "\n")))
+         (insert id "\n"))))))
 
 (defun nnmail-cache-primary-mail-backend ()
   (let ((be-list (cons gnus-select-method gnus-secondary-select-methods))
        (be nil)
-       (res nil))
+       (res nil)
+        (get-new-mail nil))
     (while (and (null res) be-list)
       (setq be (car be-list))
       (setq be-list (cdr be-list))
       (when (and (gnus-method-option-p be 'respool)
-                (eval (intern (format "%s-get-new-mail" (car be)))))
+                 (setq get-new-mail
+                       (intern (format "%s-get-new-mail" (car be))))
+                 (boundp get-new-mail)
+                (symbol-value get-new-mail))
        (setq res be)))
     res))
 
@@ -1522,15 +1654,14 @@ See the documentation for the variable `nnmail-split-fancy' for details."
        (skip-chars-forward "^\n\r\t")
        (unless (looking-at "[\r\n]")
          (forward-char 1)
-         (buffer-substring (point)
-                           (progn (end-of-line) (point))))))))
+         (buffer-substring (point) (point-at-eol)))))))
 
 ;; Function for nnmail-split-fancy: look up all references in the
 ;; cache and if a match is found, return that group.
 (defun nnmail-split-fancy-with-parent ()
   "Split this message into the same group as its parent.
 This function can be used as an entry in `nnmail-split-fancy', for
-example like this: (: nnmail-split-fancy)
+example like this: (: nnmail-split-fancy-with-parent)
 For a message to be split, it looks for the parent message in the
 References or In-Reply-To header and then looks in the message id
 cache file (given by the variable `nnmail-message-id-cache-file') to
@@ -1581,7 +1712,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
                   (cond
                    ((memq nnmail-treat-duplicates '(warn delete))
                     nnmail-treat-duplicates)
-                   ((nnheader-functionp nnmail-treat-duplicates)
+                   ((functionp nnmail-treat-duplicates)
                     (funcall nnmail-treat-duplicates message-id))
                    (t
                     nnmail-treat-duplicates))))
@@ -1632,7 +1763,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
                                   &optional group spool-func)
   "Read new incoming mail."
   (let* ((sources (or mail-sources
-                     (if (listp nnmail-spool-file) nnmail-spool-file
+                     (if (listp nnmail-spool-file)
+                         nnmail-spool-file
                        (list nnmail-spool-file))))
         fetching-sources
         (group-in group)
@@ -1747,7 +1879,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
   (let (nnmail-cache-accepted-message-ids)
     ;; Don't enter Message-IDs into cache.
     ;; Let users hack it in TARGET function.
-    (when (nnheader-functionp target)
+    (when (functionp target)
       (setq target (funcall target group)))
     (unless (eq target 'delete)
       (when (or (gnus-request-group target)
@@ -1762,9 +1894,15 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
         (case-fold-search nil)
         (from (or (message-fetch-field "from") ""))
         (to (or (message-fetch-field "to") ""))
-        (date (date-to-time
-               (or (message-fetch-field "date") (current-time-string))))
+        (date (message-fetch-field "date"))
         (target 'delete))
+    (setq date (if date
+                  (condition-case err
+                      (date-to-time date)
+                    (error
+                     (message "%s" (error-message-string err))
+                     (current-time)))
+                (current-time)))
     (dolist (regexp-target-pair (reverse nnmail-fancy-expiry-targets) target)
       (setq header (car regexp-target-pair))
       (cond
@@ -1772,7 +1910,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
        ;; To or From header
        ((and (equal header 'to-from)
             (or (string-match (cadr regexp-target-pair) from)
-                (and (string-match message-dont-reply-to-names from)
+                (and (string-match (message-dont-reply-to-names) from)
                      (string-match (cadr regexp-target-pair) to))))
        (setq target (format-time-string (caddr regexp-target-pair) date)))
        ((and (not (equal header 'to-from))
@@ -1865,20 +2003,18 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
   (with-output-to-temp-buffer "*nnmail split history*"
     (with-current-buffer standard-output
       (fundamental-mode))              ; for Emacs 20.4+
-    (let ((history nnmail-split-history)
-         elem)
-      (while (setq elem (pop history))
+      (dolist (elem nnmail-split-history)
        (princ (mapconcat (lambda (ga)
                            (concat (car ga) ":" (int-to-string (cdr ga))))
                          elem
                          ", "))
-       (princ "\n")))))
+       (princ "\n"))))
 
 (defun nnmail-purge-split-history (group)
   "Remove all instances of GROUP from `nnmail-split-history'."
   (let ((history nnmail-split-history))
     (while history
-      (setcar history (gnus-delete-if (lambda (e) (string= (car e) group))
+      (setcar history (gnus-remove-if (lambda (e) (string= (car e) group))
                                      (car history)))
       (pop history))
     (setq nnmail-split-history (delq nil nnmail-split-history))))
@@ -1905,4 +2041,5 @@ Doesn't change point."
 
 (provide 'nnmail)
 
+;;; arch-tag: fe8f671a-50db-428a-bb5d-f00462f72ed7
 ;;; nnmail.el ends here