Merge from gnus--rel--5.10
[gnus] / lisp / nnmail.el
index 8e195fa..0df256e 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, 2003, 2004
-;;        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:
 
@@ -48,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
@@ -118,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 ".*")
@@ -126,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 ".*")
@@ -223,7 +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 "21.4"
+  :version "22.1"
   :group 'nnmail-expire
   :type '(repeat (list (choice :tag "Match against"
                               (string :tag "Header")
@@ -352,6 +355,7 @@ discarded after running the split process."
 
 (defcustom nnmail-spool-hook nil
   "*A hook called when a new article is spooled."
+  :version "22.1"
   :group 'nnmail
   :type 'hook)
 
@@ -366,14 +370,14 @@ messages will be shown to indicate the current status."
 (define-widget 'nnmail-lazy 'default
   "Base widget for recursive datastructures.
 
-This is copy of the `lazy' widget in Emacs 21.4 provided for compatibility."
+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-put widget :children
+                                (list (widget-create-child-value
                                        widget (widget-convert type) value)))))
   :value-delete 'widget-children-value-delete
   :value-get (lambda (widget)
@@ -405,7 +409,7 @@ This is copy of the `lazy' widget in Emacs 21.4 provided for compatibility."
                       (list :tag "Function with fixed arguments (:)"
                             :value (:)
                             (const :format "" :value :)
-                            function 
+                            function
                             (editable-list :inline t (sexp :tag "Arg"))
                             )
                       (list :tag "Function with split arguments (!)"
@@ -413,11 +417,11 @@ This is copy of the `lazy' widget in Emacs 21.4 provided for compatibility."
                             (const :format "" !)
                             function
                             (editable-list :inline t nnmail-split-fancy))
-                      (list :tag "Field match" 
-                            (choice :tag "Field" 
+                      (list :tag "Field match"
+                            (choice :tag "Field"
                                     regexp symbol)
                             (choice :tag "Match"
-                                    regexp 
+                                    regexp
                                     (symbol :value mail))
                             (repeat :inline t
                                     :tag "Restrictions"
@@ -550,7 +554,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
@@ -558,13 +562,13 @@ parameter.  It should return nil, `warn' or `delete'."
 
 (defcustom nnmail-mail-splitting-charset nil
   "Default charset to be used when splitting incoming mail."
-  :version "21.4"
+  :version "22.1"
   :group 'nnmail
   :type 'symbol)
 
 (defcustom nnmail-mail-splitting-decodes nil
   "Whether the nnmail splitting functionality should MIME decode headers."
-  :version "21.4"
+  :version "22.1"
   :group 'nnmail
   :type 'boolean)
 
@@ -574,6 +578,7 @@ 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)
 
@@ -581,6 +586,7 @@ by anything."
   "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)
 
@@ -763,7 +769,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))))
@@ -900,7 +906,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.
@@ -1124,7 +1130,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.
@@ -1132,10 +1138,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...
@@ -1274,10 +1280,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)
@@ -1286,8 +1302,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
 
@@ -1414,11 +1433,12 @@ See the documentation for the variable `nnmail-split-fancy' for details."
 
      ;; Not in cache, compute a regexp for the field/value pair.
      (t
-      (let* ((field (nth 0 split))
-            (value (nth 1 split))
-            partial-front
-            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)
@@ -1430,7 +1450,13 @@ See the documentation for the variable `nnmail-split-fancy' for details."
                 (string= ".*" (substring value -2)))
            (setq value (substring value 0 -2)
                  partial-rear ""))
-       (when nnmail-split-fancy-match-partial-words
+       ;; 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 "^\\(\\("
@@ -1445,7 +1471,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)
@@ -1570,7 +1596,7 @@ See the documentation for the variable `nnmail-split-fancy' for details."
   (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 
+      (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
@@ -1593,7 +1619,7 @@ See the documentation for the variable `nnmail-split-fancy' for details."
              (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)
@@ -1861,9 +1887,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
@@ -1871,7 +1903,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))