X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fnnmail.el;h=f56495010c495764c14d25328aec4fe9f1ce88c4;hb=36bd162f4f7cd40453b8683e796730836c352b2a;hp=85404c5625feba392bfa5e539102bd5caaf6f385;hpb=4305c2ea86b2e1d044bfb8b98e5558504bc09781;p=elisp%2Fgnus.git-

diff --git a/lisp/nnmail.el b/lisp/nnmail.el
index 85404c5..f564950 100644
--- a/lisp/nnmail.el
+++ b/lisp/nnmail.el
@@ -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."
@@ -114,6 +115,14 @@ If nil, the first match found will be used."
   :group 'nnmail-split
   :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."
+  :group 'nnmail-split
+  :type '(choice (const :tag "none" nil)
+		 (regexp :value ".*")
+		 (repeat :value (".*") regexp)))
+
 ;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit).
 (defcustom nnmail-keep-last-article nil
   "If non-nil, nnmail will never delete/move a group's last article.
@@ -175,10 +184,43 @@ called in a buffer narrowed to the message in question.  The function
 receives one argument, the name of the group the message comes from.
 The return value should be `delete' or a group name (a string)."
   :version "21.1"
-    :group 'nnmail-expire
-    :type '(choice (const delete)
-		   (function :format "%v" nnmail-)
-		   string))
+  :group 'nnmail-expire
+  :type '(choice (const delete)
+		 (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.
@@ -336,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.
@@ -469,7 +517,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)
@@ -533,8 +581,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))
@@ -1369,6 +1417,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)
@@ -1473,14 +1522,21 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
   (let* ((refstr (or (message-fetch-field "references")
 		     (message-fetch-field "in-reply-to")))
 	 (references nil)
-	 (res nil))
+	 (res nil)
+	 (regexp (if (consp 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)))
       (unless (gnus-buffer-live-p nnmail-cache-buffer)
 	(nnmail-cache-open))
       (mapcar (lambda (x)
 		(setq res (or (nnmail-cache-fetch-group x) res))
-		(when (string= "drafts" res)
+		(when (or (string= "drafts" res)
+			  (and regexp res (string-match regexp res)))
 		  (setq res nil)))
 	      references)
       res)))
@@ -1591,10 +1647,11 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
 	    (setq source (append source
 				 (list
 				  :predicate
-				  `(lambda (file)
-				     (string-equal
-				      ,(concat group suffix)
-				      (file-name-nondirectory file))))))))
+				  (gnus-byte-compile
+				   `(lambda (file)
+				      (string-equal
+				       ,(concat group suffix)
+				       (file-name-nondirectory file)))))))))
 	(when nnmail-fetched-sources
 	  (if (member source nnmail-fetched-sources)
 	      (setq source nil)
@@ -1615,14 +1672,15 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
 	(when (setq new
 		    (mail-source-fetch
 		     source
-		     `(lambda (file orig-file)
-			(nnmail-split-incoming
-			 file ',(intern (format "%s-save-mail" method))
-			 ',spool-func
-			 (if (equal file orig-file)
-			     nil
-			   (nnmail-get-split-group orig-file ',source))
-			 ',(intern (format "%s-active-number" method))))))
+		     (gnus-byte-compile
+		      `(lambda (file orig-file)
+			 (nnmail-split-incoming
+			  file ',(intern (format "%s-save-mail" method))
+			  ',spool-func
+			  (if (equal file orig-file)
+			      nil
+			    (nnmail-get-split-group orig-file ',source))
+			  ',(intern (format "%s-active-number" method)))))))
 	  (incf total new)
 	  (incf i)))
       ;; If we did indeed read any incoming spools, we save all info.
@@ -1666,6 +1724,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.
@@ -1674,6 +1734,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