* message.el (message-tool-bar-map): Commented out MIME-Edit buttons.

[elisp/gnus.git-] / lisp / nnmail.el

diff --git a/lisp/nnmail.el b/lisp/nnmail.el
index a7ca27f..bd95e69 100644 (file)
--- a/lisp/nnmail.el
+++ b/lisp/nnmail.el
@@ -1,5 +1,5 @@
 ;;; nnmail.el --- mail support functions for the Gnus mail backends
 ;;; 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>
 ;;        Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>

@@ -56,7 +56,7 @@
   :group 'nnmail)
 
 (defgroup nnmail-split nil
   :group 'nnmail)
 
 (defgroup nnmail-split nil

-  "Organizing the incomming mail in folders."
+  "Organizing the incoming mail in folders."

   :group 'nnmail)
 
 (defgroup nnmail-files nil
   :group 'nnmail)
 
 (defgroup nnmail-files nil

@@ -76,8 +76,7 @@
   "Various mail options."
   :group 'nnmail)
 
   "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
   "*Incoming mail will be split according to this variable.
 
 If you'd like, for instance, one mail group for mail from the

@@ -104,7 +103,8 @@ The last element should always have \"\" as the regexp.
 
 This variable can also have a function as its value."
   :group 'nnmail-split
 
 This variable can also have a function as its value."
   :group 'nnmail-split

-  :type '(choice (repeat :tag "Alist" (group (string :tag "Name") regexp))
+  :type '(choice (repeat :tag "Alist" (group (string :tag "Name")
+                                            (choice regexp function)))

                 (function-item nnmail-split-fancy)
                 (function :tag "Other")))
 
                 (function-item nnmail-split-fancy)
                 (function :tag "Other")))
 

@@ -116,8 +116,16 @@ If nil, the first match found will be used."
   :type 'boolean)
 
 (defcustom nnmail-split-fancy-with-parent-ignore-groups nil
   :type 'boolean)
 
 (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."
+  "Regexp that matches group names to be ignored when applying `nnmail-split-fancy-with-parent'.
+This can also be a list of regexps."
+  :group 'nnmail-split
+  :type '(choice (const :tag "none" nil)
+                (regexp :value ".*")
+                (repeat :value (".*") regexp)))
+
+(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."

   :group 'nnmail-split
   :type '(choice (const :tag "none" nil)
                 (regexp :value ".*")
   :group 'nnmail-split
   :type '(choice (const :tag "none" nil)
                 (regexp :value ".*")

@@ -189,6 +197,39 @@ The return value should be `delete' or a group name (a string)."
                 (function :format "%v" nnmail-)
                 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."
 (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."

@@ -309,11 +350,12 @@ discarded after running the split process."
   :type 'hook)
 
 (defcustom nnmail-large-newsgroup 50
   :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
 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.
 
 (defcustom nnmail-split-fancy "mail.misc"
   "Incoming mail can be split according to this fancy variable.

@@ -327,7 +369,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
 \(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.
 
   otherwise process SPLIT.  Multiple RESTRICTs add up, further
   restricting the possibility of processing SPLIT.
 

@@ -348,8 +390,8 @@ GROUP: Mail will be stored in GROUP (a string).
 junk: Mail will be deleted.  Use with care!  Do not submerge in water!
   Example:
   (setq nnmail-split-fancy
 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...))
+       '(| (\"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.
 
 FIELD must match a complete field name.  VALUE must match a complete
 word according to the `nnmail-split-fancy-syntax-table' syntax table.

@@ -433,7 +475,7 @@ parameter.  It should return nil, `warn' or `delete'."
                 (const warn)
                 (const 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
   "*Extra headers to parse."
   :version "21.1"
   :group 'nnmail

@@ -445,6 +487,16 @@ parameter.  It should return nil, `warn' or `delete'."
   :group 'nnmail
   :type 'integer)
 
   :group 'nnmail
   :type 'integer)
 

+(defcustom nnmail-mail-splitting-charset nil
+  "Default charset to be used when splitting incoming mail."
+  :group 'nnmail
+  :type 'symbol)
+
+(defcustom nnmail-mail-splitting-decodes t
+  "Whether the nnmail splitting functionality should MIME decode headers."
+  :group 'nnmail
+  :type 'boolean)
+

 ;;; Internal variables.
 
 (defvar nnmail-article-buffer " *nnmail incoming*"
 ;;; Internal variables.
 
 (defvar nnmail-article-buffer " *nnmail incoming*"

@@ -671,7 +723,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."
 
 (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 ".
   ;; brain-dead Unix mbox format:
   ;;
   ;; 1) Search for "^From ".

@@ -700,7 +752,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."
 
 (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 ".
   ;; brain-dead Unix mbox format:
   ;;
   ;; 1) Search for "^From ".

@@ -780,7 +832,7 @@ If SOURCE is a directory spec, try to return the group name component."
        (setq head-end (point))
        ;; We try the Content-Length value.  The idea: skip over the header
        ;; separator, then check what happens content-length bytes into the
        (setq head-end (point))
        ;; We try the Content-Length value.  The idea: skip over the header
        ;; separator, then check what happens content-length bytes into the

-       ;; message body.  This should be either the end ot the buffer, the
+       ;; message body.  This should be either the end of the buffer, the

        ;; message separator or a blank line followed by the separator.
        ;; The blank line should probably be deleted.  If neither of the
        ;; three is met, the content-length header is probably invalid.
        ;; message separator or a blank line followed by the separator.
        ;; The blank line should probably be deleted.  If neither of the
        ;; three is met, the content-length header is probably invalid.

@@ -943,7 +995,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."
 (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)
        (obuf (current-buffer))
        (beg (point-min))
        end group-art method grp)

@@ -962,6 +1014,10 @@ 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)
        (erase-buffer)
        ;; Copy the headers into the work buffer.
        (insert-buffer-substring obuf beg end)

+       ;; Decode MIME headers and charsets.
+       (when nnmail-mail-splitting-decodes
+         (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)
        ;; Fold continuation lines.
        (goto-char (point-min))
        (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)

@@ -991,8 +1047,8 @@ FUNC will be called with the group name to determine the article number."
                       (or (funcall nnmail-split-methods)
                           '("bogus"))
                     (error
                       (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))
                      (sit-for 1)
                      '("bogus")))))
              (setq split (gnus-remove-duplicates split))

@@ -1040,13 +1096,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)
                                  (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)
            (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)))
            (goto-char (point-min))
            (gnus-configure-windows 'split-trace)
            (set-buffer restore)))

@@ -1171,7 +1226,7 @@ to actually put the message in the right group."
 
 (defun nnmail-split-fancy ()
   "Fancy splitting method.
 
 (defun nnmail-split-fancy ()
   "Fancy splitting method.

-See the documentation for the variable `nnmail-split-fancy' for documentation."
+See the documentation for the variable `nnmail-split-fancy' for details."

   (let ((syntab (syntax-table)))
     (unwind-protect
        (progn
   (let ((syntab (syntax-table)))
     (unwind-protect
        (progn

@@ -1193,7 +1248,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
      ;; 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.
       (list (nnmail-expand-newtext split)))
 
      ;; Junk the message.

@@ -1216,6 +1271,8 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
 
      ;; Builtin : operation.
      ((eq (car split) ':)
 
      ;; Builtin : operation.
      ((eq (car split) ':)

+      (when nnmail-split-tracing
+       (push split nnmail-split-trace))

       (nnmail-split-it (save-excursion (eval (cdr split)))))
 
      ;; Builtin ! operation.
       (nnmail-split-it (save-excursion (eval (cdr split)))))
 
      ;; Builtin ! operation.

@@ -1232,7 +1289,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
        (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,
          (let ((split-rest (cddr split))
                (end (match-end 0))
                ;; The searched regexp is \(\(FIELD\).*\)\(VALUE\).  So,

@@ -1417,35 +1474,28 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
 (defvar group)
 (defvar group-art-list)
 (defvar group-art)
 (defvar group)
 (defvar group-art-list)
 (defvar group-art)

-(defun nnmail-cache-insert (id)
+(defun nnmail-cache-insert (id grp)

   (when nnmail-treat-duplicates
     ;; Store some information about the group this message is written
   (when nnmail-treat-duplicates
     ;; Store some information about the group this message is written

-    ;; to.  This function might have been called from various places.
-    ;; Sometimes, a function up in the calling sequence has an
-    ;; argument GROUP which is bound to a string, the group name.  At
-    ;; other times, there is a function up in the calling sequence
-    ;; which has an argument GROUP-ART which is a list of pairs, and
-    ;; the car of a pair is a group name.  Should we check that the
-    ;; length of the list is equal to 1? -- kai
-    (let ((g nil))
-      (cond ((and (boundp 'group) group)
-            (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 "")))
-      (unless (gnus-buffer-live-p nnmail-cache-buffer)
-       (nnmail-cache-open))
-      (save-excursion
-       (set-buffer nnmail-cache-buffer)
-       (goto-char (point-max))
-       (if (and g (not (string= "" g))
-                (gnus-methods-equal-p gnus-command-method
-                                      (nnmail-cache-primary-mail-backend)))
-           (insert id "\t" g "\n")
-         (insert id "\n"))))))
+    ;; 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))
 
 (defun nnmail-cache-primary-mail-backend ()
   (let ((be-list (cons gnus-select-method gnus-secondary-select-methods))

@@ -1469,7 +1519,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
       (when (search-backward id nil t)
        (beginning-of-line)
        (skip-chars-forward "^\n\r\t")
       (when (search-backward id nil t)
        (beginning-of-line)
        (skip-chars-forward "^\n\r\t")

-       (unless (eolp)
+       (unless (looking-at "[\r\n]")

          (forward-char 1)
          (buffer-substring (point)
                            (progn (end-of-line) (point))))))))
          (forward-char 1)
          (buffer-substring (point)
                            (progn (end-of-line) (point))))))))

@@ -1502,7 +1552,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
        (nnmail-cache-open))
       (mapcar (lambda (x)
                (setq res (or (nnmail-cache-fetch-group x) res))
        (nnmail-cache-open))
       (mapcar (lambda (x)
                (setq res (or (nnmail-cache-fetch-group x) res))

-               (when (or (string= "drafts" res)
+               (when (or (member res '("delayed" "drafts" "queue"))

                          (and regexp res (string-match regexp res)))
                  (setq res nil)))
              references)
                          (and regexp res (string-match regexp res)))
                  (setq res nil)))
              references)

@@ -1547,7 +1597,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
      ((not duplication)
       (funcall func (setq group-art
                          (nreverse (nnmail-article-group artnum-func))))
      ((not duplication)
       (funcall func (setq group-art
                          (nreverse (nnmail-article-group artnum-func))))

-      (nnmail-cache-insert message-id))
+      (nnmail-cache-insert message-id (caar group-art)))

      ((eq action 'delete)
       (setq group-art nil))
      ((eq action 'warn)
      ((eq action 'delete)
       (setq group-art nil))
      ((eq action 'warn)

@@ -1699,7 +1749,38 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
     (when (nnheader-functionp target)
       (setq target (funcall target group)))
     (unless (eq target 'delete)
     (when (nnheader-functionp target)
       (setq target (funcall target group)))
     (unless (eq target 'delete)

-      (gnus-request-accept-article target nil nil t))))
+      (when (or (gnus-request-group target)
+               (gnus-request-create-group target))
+       (let ((group-art (gnus-request-accept-article target nil nil t)))
+         (when (consp group-art)
+           (gnus-group-mark-article-read target (cdr group-art))))))))
+
+(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)
+                          (or
+                           (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."
 
 (defun nnmail-check-syntax ()
   "Check (and modify) the syntax of the message in the current buffer."