* gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Improved to speed
[gnus] / lisp / nnmail.el
index 8b342e3..69fa9f7 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>
@@ -37,7 +37,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."
@@ -76,8 +77,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
@@ -189,6 +189,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."
@@ -327,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.
 
@@ -345,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.
@@ -427,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
@@ -439,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*"
@@ -478,7 +522,7 @@ parameter.  It should return nil, `warn' or `delete'."
   mm-text-coding-system
   "Coding system used in reading inbox")
 
-(defvar nnmail-pathname-coding-system 'iso-8859-1
+(defvar nnmail-pathname-coding-system nil
   "*Coding system for pathname.")
 
 (defun nnmail-find-file (file)
@@ -541,8 +585,8 @@ nn*-request-list should have been called before calling this function."
            (setq group (read buffer))
            (unless (stringp group)
              (setq group (symbol-name group)))
-           (if (and (numberp (setq max (read nntp-server-buffer)))
-                    (numberp (setq min (read nntp-server-buffer))))
+           (if (and (numberp (setq max (read buffer)))
+                    (numberp (setq min (read buffer))))
                (push (list group (cons min max))
                      group-assoc)))
        (error nil))
@@ -663,7 +707,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 ".
@@ -692,7 +736,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 ".
@@ -935,7 +979,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)
@@ -954,6 +998,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.
+       (let ((mail-parse-charset nnmail-mail-splitting-charset))
+         (mail-decode-encoded-word-region (point-min) (point-max)))
        ;; Fold continuation lines.
        (goto-char (point-min))
        (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
@@ -983,8 +1030,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))
@@ -1032,13 +1079,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)))
@@ -1185,7 +1231,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.
@@ -1224,13 +1270,13 @@ 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,
-               ;; start-of-value is the the point just before the
-              ;; beginning of the value, whereas after-header-name is
-               ;; the point just after the field name.
+               ;; The searched regexp is \(\(FIELD\).*\)\(VALUE\).
+               ;; So, start-of-value is the point just before the
+               ;; beginning of the value, whereas after-header-name
+               ;; is the point just after the field name.
                (start-of-value (match-end 1))
                (after-header-name (match-end 2)))
            ;; Start the next search just before the beginning of the
@@ -1254,7 +1300,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
              (let ((value (nth 1 split)))
                (if (symbolp value)
                    (setq value (cdr (assq value nnmail-split-abbrev-alist))))
-       ;; Someone might want to do a \N sub on this match, so get the
+               ;; Someone might want to do a \N sub on this match, so get the
                ;; correct match positions.
                (re-search-backward value start-of-value))
              (dolist (sp (nnmail-split-it (car split-rest)))
@@ -1376,6 +1422,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)
@@ -1482,7 +1529,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)))
@@ -1491,7 +1541,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)))
@@ -1679,6 +1729,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.
@@ -1687,6 +1739,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