Synch with Oort Gnus.
[elisp/gnus.git-] / lisp / nnmail.el
index 9a6af66..dd1d67f 100644 (file)
@@ -1,5 +1,5 @@
 ;;; nnmail.el --- mail support functions for the Gnus mail backends
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002
 ;;        Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -36,7 +36,8 @@
 
 (eval-and-compile
   (autoload 'gnus-error "gnus-util")
-  (autoload 'gnus-buffer-live-p "gnus-util"))
+  (autoload 'gnus-buffer-live-p "gnus-util")
+  (autoload 'gnus-add-buffer "gnus"))
 
 (defgroup nnmail nil
   "Reading mail with Gnus."
@@ -75,8 +76,7 @@
   "Various mail options."
   :group 'nnmail)
 
-(defcustom nnmail-split-methods
-  '(("mail.misc" ""))
+(defcustom nnmail-split-methods '(("mail.misc" ""))
   "*Incoming mail will be split according to this variable.
 
 If you'd like, for instance, one mail group for mail from the
@@ -188,6 +188,39 @@ The return value should be `delete' or a group name (a string)."
                 (function :format "%v" nnmail-)
                 string))
 
+(defcustom nnmail-fancy-expiry-targets nil
+  "Determine expiry target based on articles using fancy techniques.
+
+This is a list of (\"HEADER\" \"REGEXP\" \"TARGET\") entries.  If
+`nnmail-expiry-target' is set to the function
+`nnmail-fancy-expiry-target' and HEADER of the article matches REGEXP,
+the message will be expired to a group determined by invoking
+`format-time-string' with TARGET used as the format string and the
+time extracted from the articles' Date header (if missing the current
+time is used).
+
+In the special cases that HEADER is the symbol `to-from', the regexp
+will try to match against both the From and the To header.
+
+Example:
+
+\(setq nnmail-fancy-expiry-targets
+      '((to-from \"boss\" \"nnfolder:Work\")
+       (\"Subject\" \"IMPORTANT\" \"nnfolder:IMPORTANT.%Y.%b\")
+       (\"from\" \".*\" \"nnfolder:Archive-%Y\")))
+
+In this case, articles containing the string \"boss\" in the To or the
+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\"."
+  :group 'nnmail-expire
+  :type '(repeat (list (choice :tag "Match against"
+                              (string :tag "Header")
+                              (const to-from))
+                      regexp
+                      (string :tag "Target group format string"))))
+
 (defcustom nnmail-cache-accepted-message-ids nil
   "If non-nil, put Message-IDs of Gcc'd articles into the duplicate cache.
 If non-nil, also update the cache when copy or move articles."
@@ -308,11 +341,12 @@ discarded after running the split process."
   :type 'hook)
 
 (defcustom nnmail-large-newsgroup 50
-  "*The number of the articles which indicates a large newsgroup.
+  "*The number of the articles which indicates a large newsgroup or nil.
 If the number of the articles is greater than the value, verbose
 messages will be shown to indicate the current status."
   :group 'nnmail-various
-  :type 'integer)
+  :type '(choice (const :tag "infinite" nil)
+                 (number :tag "count")))
 
 (defcustom nnmail-split-fancy "mail.misc"
   "Incoming mail can be split according to this fancy variable.
@@ -326,7 +360,7 @@ GROUP: Mail will be stored in GROUP (a string).
 \(FIELD VALUE [- RESTRICT [- RESTRICT [...]]] SPLIT): If the message
   field FIELD (a regexp) contains VALUE (a regexp), store the messages
   as specified by SPLIT.  If RESTRICT (a regexp) matches some string
-  after FIELD and before the end of the matched VALUE, return NIL,
+  after FIELD and before the end of the matched VALUE, return nil,
   otherwise process SPLIT.  Multiple RESTRICTs add up, further
   restricting the possibility of processing SPLIT.
 
@@ -344,6 +378,12 @@ GROUP: Mail will be stored in GROUP (a string).
   return value FUNCTION should be a split, which is then recursively
   processed.
 
+junk: Mail will be deleted.  Use with care!  Do not submerge in water!
+  Example:
+  (setq nnmail-split-fancy
+       '(| (\"Subject\" \"MAKE MONEY FAST\" junk)
+           ...other.rules.omitted...))
+
 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.
@@ -426,7 +466,7 @@ parameter.  It should return nil, `warn' or `delete'."
                 (const warn)
                 (const delete)))
 
-(defcustom nnmail-extra-headers nil
+(defcustom nnmail-extra-headers '(To Newsgroups)
   "*Extra headers to parse."
   :version "21.1"
   :group 'nnmail
@@ -438,6 +478,11 @@ parameter.  It should return nil, `warn' or `delete'."
   :group 'nnmail
   :type 'integer)
 
+(defcustom nnmail-mail-splitting-charset nil
+  "Default charset to be used when splitting incoming mail."
+  :group 'nnmail
+  :type 'symbol)
+
 ;;; Internal variables.
 
 (defvar nnmail-article-buffer " *nnmail incoming*"
@@ -477,7 +522,7 @@ parameter.  It should return nil, `warn' or `delete'."
   nnheader-text-coding-system
   "Coding system used in reading inbox")
 
-(defvar nnmail-pathname-coding-system 'binary
+(defvar nnmail-pathname-coding-system nil
   "*Coding system for pathname.")
 
 (defun nnmail-find-file (file)
@@ -664,7 +709,7 @@ If SOURCE is a directory spec, try to return the group name component."
 
 (defsubst nnmail-search-unix-mail-delim ()
   "Put point at the beginning of the next Unix mbox message."
-  ;; Algorithm used to find the the next article in the
+  ;; Algorithm used to find the next article in the
   ;; brain-dead Unix mbox format:
   ;;
   ;; 1) Search for "^From ".
@@ -693,7 +738,7 @@ If SOURCE is a directory spec, try to return the group name component."
 
 (defun nnmail-search-unix-mail-delim-backward ()
   "Put point at the beginning of the current Unix mbox message."
-  ;; Algorithm used to find the the next article in the
+  ;; Algorithm used to find the next article in the
   ;; brain-dead Unix mbox format:
   ;;
   ;; 1) Search for "^From ".
@@ -936,7 +981,7 @@ FUNC will be called with the buffer narrowed to each mail."
 (defun nnmail-article-group (func &optional trace)
   "Look at the headers and return an alist of groups that match.
 FUNC will be called with the group name to determine the article number."
-  (let ((methods nnmail-split-methods)
+  (let ((methods (or nnmail-split-methods '(("bogus" ""))))
        (obuf (current-buffer))
        (beg (point-min))
        end group-art method grp)
@@ -955,6 +1000,9 @@ FUNC will be called with the group name to determine the article number."
        (erase-buffer)
        ;; Copy the headers into the work buffer.
        (insert-buffer-substring obuf beg end)
+       ;; Decode MIME headers and charsets.
+       (mime-decode-header-in-region (point-min) (point-max)
+                                     nnmail-mail-splitting-charset)
        ;; Fold continuation lines.
        (goto-char (point-min))
        (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
@@ -984,8 +1032,8 @@ FUNC will be called with the group name to determine the article number."
                       (or (funcall nnmail-split-methods)
                           '("bogus"))
                     (error
-                     (nnheader-message 5
-                                       "Error in `nnmail-split-methods'; using `bogus' mail group")
+                     (nnheader-message
+                      5 "Error in `nnmail-split-methods'; using `bogus' mail group")
                      (sit-for 1)
                      '("bogus")))))
              (setq split (gnus-remove-duplicates split))
@@ -1033,13 +1081,12 @@ FUNC will be called with the group name to determine the article number."
                                  (funcall func (car method)))))))))
        ;; Produce a trace if non-empty.
        (when (and trace nnmail-split-trace)
-         (let ((trace (nreverse nnmail-split-trace))
-               (restore (current-buffer)))
+         (let ((restore (current-buffer)))
            (nnheader-set-temp-buffer "*Split Trace*")
            (gnus-add-buffer)
-           (while trace
-             (insert (car trace) "\n")
-             (setq trace (cdr trace)))
+           (dolist (trace (nreverse nnmail-split-trace))
+             (prin1 trace (current-buffer))
+             (insert "\n"))
            (goto-char (point-min))
            (gnus-configure-windows 'split-trace)
            (set-buffer restore)))
@@ -1186,7 +1233,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
      ;; A group name.  Do the \& and \N subs into the string.
      ((stringp split)
       (when nnmail-split-tracing
-       (push (format "\"%s\"" split) nnmail-split-trace))
+       (push split nnmail-split-trace))
       (list (nnmail-expand-newtext split)))
 
      ;; Junk the message.
@@ -1225,7 +1272,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
        (while (and (goto-char end-point)
                    (re-search-backward (cdr cached-pair) nil t))
          (when nnmail-split-tracing
-           (push (cdr cached-pair) nnmail-split-trace))
+           (push split nnmail-split-trace))
          (let ((split-rest (cddr split))
                (end (match-end 0))
                ;; The searched regexp is \(\(FIELD\).*\)\(VALUE\).  So,
@@ -1377,6 +1424,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
       (set-buffer
        (setq nnmail-cache-buffer
             (get-buffer-create " *nnmail message-id cache*")))
+      (gnus-add-buffer)
       (when (file-exists-p nnmail-message-id-cache-file)
        (nnheader-insert-file-contents nnmail-message-id-cache-file))
       (set-buffer-modified-p nil)
@@ -1483,7 +1531,10 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
         (references nil)
         (res nil)
         (regexp (if (consp nnmail-split-fancy-with-parent-ignore-groups)
-                    (mapconcat 'nnmail-split-fancy-with-parent-ignore-groups " *\\|")
+                    (mapconcat
+                     (lambda (x) (format "\\(%s\\)" x))
+                     nnmail-split-fancy-with-parent-ignore-groups
+                     "\\|")
                   nnmail-split-fancy-with-parent-ignore-groups)))
     (when refstr
       (setq references (nreverse (gnus-split-references refstr)))
@@ -1492,7 +1543,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
       (mapcar (lambda (x)
                (setq res (or (nnmail-cache-fetch-group x) res))
                (when (or (string= "drafts" res)
-                         (and regexp (string-match regexp res)))
+                         (and regexp res (string-match regexp res)))
                  (setq res nil)))
              references)
       res)))
@@ -1680,6 +1731,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
             (ignore-errors (time-less-p days (time-since time))))))))
 
 (defun nnmail-expiry-target-group (target group)
+  ;; Do not invoke this from nntp-server-buffer!  At least nnfolder clears
+  ;; that buffer if the nnfolder group isn't selected.
   (let (nnmail-cache-accepted-message-ids)
     ;; Don't enter Message-IDs into cache.
     ;; Let users hack it in TARGET function.
@@ -1688,6 +1741,31 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
     (unless (eq target 'delete)
       (gnus-request-accept-article target nil nil t))))
 
+(defun nnmail-fancy-expiry-target (group)
+  "Returns a target expiry group determined by `nnmail-fancy-expiry-targets'."
+  (let* (header
+        (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))))
+        (target 'delete))
+    (dolist (regexp-target-pair (reverse nnmail-fancy-expiry-targets) target)
+      (setq header (car regexp-target-pair))
+      (cond
+       ;; If the header is to-from then match against the
+       ;; 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)
+                     (string-match (cadr regexp-target-pair) to))))
+       (setq target (format-time-string (caddr regexp-target-pair) date)))
+       ((and (not (equal header 'to-from))
+            (string-match (cadr regexp-target-pair)
+                          (message-fetch-field header)))
+       (setq target
+             (format-time-string (caddr regexp-target-pair) date)))))))
+
 (defun nnmail-check-syntax ()
   "Check (and modify) the syntax of the message in the current buffer."
   (save-restriction