X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fnnmail.el;h=01cab6febe3b0ce09357a1d8988b9764d2c49cc5;hp=3228055eddf13a89e9da549dd01ccfe527bf616c;hb=7ada0e6e0f4f19dc0dab261c854dbef104eb3468;hpb=6d3039252bb175eba53a2028cbf3c0e90112388d

diff --git a/lisp/nnmail.el b/lisp/nnmail.el
index 3228055ed..01cab6feb 100644
--- a/lisp/nnmail.el
+++ b/lisp/nnmail.el
@@ -1,17 +1,17 @@
 ;;; nnmail.el --- mail support functions for the Gnus mail backends
 
 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;;   2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;;   2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news, mail
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -19,9 +19,7 @@
 ;; GNU General Public License for more details.
 
 ;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -41,9 +39,8 @@
 (require 'mm-util)
 (require 'gnus-int)
 
-(eval-and-compile
-  (autoload 'gnus-add-buffer "gnus")
-  (autoload 'gnus-kill-buffer "gnus"))
+(autoload 'gnus-add-buffer "gnus")
+(autoload 'gnus-kill-buffer "gnus")
 
 (defgroup nnmail nil
   "Reading mail with Gnus."
@@ -107,7 +104,9 @@ mail belongs in that group.
 
 The last element should always have \"\" as the regexp.
 
-This variable can also have a function as its value."
+This variable can also have a function as its value, and it can
+also have a fancy split method as its value.  See
+`nnmail-split-fancy' for an explanation of that syntax."
   :group 'nnmail-split
   :type '(choice (repeat :tag "Alist" (group (string :tag "Name")
 					     (choice regexp function)))
@@ -202,7 +201,7 @@ 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-)
+		 function
 		 string))
 
 (defcustom nnmail-fancy-expiry-targets nil
@@ -228,7 +227,7 @@ Example:
 
 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
+articles containing the string \"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 "22.1"
@@ -245,9 +244,8 @@ If non-nil, also update the cache when copy or move articles."
   :group 'nnmail
   :type 'boolean)
 
-(make-obsolete-variable 'nnmail-spool-file
-			"This option is obsolete in Gnus 5.9.  \
-Use `mail-sources' instead.")
+(make-obsolete-variable 'nnmail-spool-file 'mail-sources
+			"Gnus 5.9 (Emacs 22.1)")
 ;; revision 5.29 / p0-85 / Gnus 5.9
 ;; Variable removed in No Gnus v0.7
 
@@ -269,7 +267,7 @@ It scans low-level sorted spools even when not required."
   :type 'function)
 
 (defcustom nnmail-crosspost-link-function
-  (if (string-match "windows-nt\\|emx" (symbol-name system-type))
+  (if (string-match "windows-nt" (symbol-name system-type))
       'copy-file
     'add-name-to-file)
   "*Function called to create a copy of a file.
@@ -618,6 +616,7 @@ using different case (i.e. mailing-list@domain vs Mailing-List@Domain)."
 
 (defvar nnmail-split-tracing nil)
 (defvar nnmail-split-trace nil)
+(defvar nnmail-inhibit-default-split-group nil)
 
 
 
@@ -631,7 +630,14 @@ using different case (i.e. mailing-list@domain vs Mailing-List@Domain)."
   mm-text-coding-system
   "Coding system used in reading inbox")
 
-(defvar nnmail-pathname-coding-system nil
+(defvar nnmail-pathname-coding-system
+  ;; This causes Emacs 22.2 and 22.3 to issue a useless warning.
+  ;;(if (and (featurep 'xemacs) (featurep 'file-coding))
+  (if (featurep 'xemacs)
+      (if (featurep 'file-coding)
+	  ;; Work around a bug in many XEmacs 21.5 betas.
+	  ;; Cf. http://thread.gmane.org/gmane.emacs.gnus.general/68134
+	  (setq file-name-coding-system (coding-system-aliasee 'file-name))))
   "*Coding system for file name.")
 
 (defun nnmail-find-file (file)
@@ -671,8 +677,7 @@ using different case (i.e. mailing-list@domain vs Mailing-List@Domain)."
   "Returns an assoc of group names and active ranges.
 nn*-request-list should have been called before calling this function."
   ;; Go through all groups from the active list.
-  (save-excursion
-    (set-buffer nntp-server-buffer)
+  (with-current-buffer nntp-server-buffer
     (nnmail-parse-active)))
 
 (defun nnmail-parse-active ()
@@ -960,7 +965,7 @@ If SOURCE is a directory spec, try to return the group name component."
 	(goto-char end)))
     count))
 
-(defun nnmail-process-mmdf-mail-format (func artnum-func)
+(defun nnmail-process-mmdf-mail-format (func artnum-func &optional junk-func)
   (let ((delim "^\^A\^A\^A\^A$")
 	(case-fold-search t)
 	(count 0)
@@ -1008,7 +1013,7 @@ If SOURCE is a directory spec, try to return the group name component."
 	    (narrow-to-region start (point))
 	    (goto-char (point-min))
 	    (incf count)
-	    (nnmail-check-duplication message-id func artnum-func)
+	    (nnmail-check-duplication message-id func artnum-func junk-func)
 	    (setq end (point-max))))
 	(goto-char end)
 	(forward-line 2)))
@@ -1053,9 +1058,11 @@ If SOURCE is a directory spec, try to return the group name component."
   "Non-nil means group names are not encoded.")
 
 (defun nnmail-split-incoming (incoming func &optional exit-func
-				       group artnum-func)
+				       group artnum-func junk-func)
   "Go through the entire INCOMING file and pick out each individual mail.
-FUNC will be called with the buffer narrowed to each mail."
+FUNC will be called with the buffer narrowed to each mail.
+INCOMING can also be a buffer object.  In that case, the mail
+will be copied over from that buffer."
   (let ( ;; If this is a group-specific split, we bind the split
 	;; methods to just this group.
 	(nnmail-split-methods (if (and group
@@ -1063,12 +1070,13 @@ FUNC will be called with the buffer narrowed to each mail."
 				  (list (list group ""))
 				nnmail-split-methods))
 	(nnmail-group-names-not-encoded-p t))
-    (save-excursion
-      ;; Insert the incoming file.
-      (set-buffer (get-buffer-create nnmail-article-buffer))
+    ;; Insert the incoming file.
+    (with-current-buffer (get-buffer-create nnmail-article-buffer)
       (erase-buffer)
-      (let ((coding-system-for-read nnmail-incoming-coding-system))
-	(mm-insert-file-contents incoming))
+      (if (bufferp incoming)
+	  (insert-buffer-substring incoming)
+	(let ((coding-system-for-read nnmail-incoming-coding-system))
+	  (mm-insert-file-contents incoming)))
       (prog1
 	  (if (zerop (buffer-size))
 	      0
@@ -1081,7 +1089,8 @@ FUNC will be called with the buffer narrowed to each mail."
 		       (looking-at "BABYL OPTIONS:"))
 		   (nnmail-process-babyl-mail-format func artnum-func))
 		  ((looking-at "\^A\^A\^A\^A")
-		   (nnmail-process-mmdf-mail-format func artnum-func))
+		   (nnmail-process-mmdf-mail-format
+		    func artnum-func junk-func))
 		  ((looking-at "Return-Path:")
 		   (nnmail-process-maildir-mail-format func artnum-func))
 		  (t
@@ -1090,22 +1099,22 @@ FUNC will be called with the buffer narrowed to each mail."
 	  (funcall exit-func))
 	(kill-buffer (current-buffer))))))
 
-(defun nnmail-article-group (func &optional trace)
+(defun nnmail-article-group (func &optional trace junk-func)
   "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 (or nnmail-split-methods '(("bogus" ""))))
 	(obuf (current-buffer))
 	group-art method grp)
     (if (and (sequencep methods)
-	     (= (length methods) 1))
+	     (= (length methods) 1)
+	     (not nnmail-inhibit-default-split-group))
 	;; If there is only just one group to put everything in, we
 	;; just return a list with just this one method in.
 	(setq group-art
 	      (list (cons (caar methods) (funcall func (caar methods)))))
       ;; We do actual comparison.
-      (save-excursion
-	;; Copy the article into the work buffer.
-	(set-buffer nntp-server-buffer)
+      ;; Copy the article into the work buffer.
+      (with-current-buffer nntp-server-buffer
 	(erase-buffer)
 	(insert-buffer-substring obuf)
 	;; Narrow to headers.
@@ -1138,27 +1147,41 @@ FUNC will be called with the group name to determine the article number."
 	(run-hooks 'nnmail-split-hook)
 	(when (setq nnmail-split-tracing trace)
 	  (setq nnmail-split-trace nil))
-	(if (and (symbolp nnmail-split-methods)
-		 (fboundp nnmail-split-methods))
-	    (let ((split
-		   (condition-case error-info
-		       ;; `nnmail-split-methods' is a function, so we
-		       ;; just call this function here and use the
-		       ;; result.
-		       (or (funcall nnmail-split-methods)
-			   '("bogus"))
-		     (error
-		      (nnheader-message
-		       5 "Error in `nnmail-split-methods'; using `bogus' mail group: %S" error-info)
-		      (sit-for 1)
-		      '("bogus")))))
+	(if (or (and (symbolp nnmail-split-methods)
+		     (fboundp nnmail-split-methods))
+		(and (listp nnmail-split-methods)
+		     ;; Not a regular split method, so it has to be a
+		     ;; fancy one.
+		     (not (let ((top-element (car-safe nnmail-split-methods)))
+			    (and (= 2 (length top-element))
+				 (stringp (nth 0 top-element))
+				 (stringp (nth 1 top-element)))))))
+	    (let* ((method-function
+		    (if (and (symbolp nnmail-split-methods)
+			     (fboundp nnmail-split-methods))
+			nnmail-split-methods
+		      'nnmail-split-fancy))
+		   (split
+		    (condition-case error-info
+			;; `nnmail-split-methods' is a function, so we
+			;; just call this function here and use the
+			;; result.
+			(or (funcall method-function)
+			    (and (not nnmail-inhibit-default-split-group)
+				 '("bogus")))
+		      (error
+		       (nnheader-message
+			5 "Error in `nnmail-split-methods'; using `bogus' mail group: %S" error-info)
+		       (sit-for 1)
+		       '("bogus")))))
 	      (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...
-	      (let (elem)
-		(while (setq elem (car (memq 'junk split)))
-		  (setq split (delq elem split))))
+	      (when (and (memq 'junk split)
+			 junk-func)
+		(funcall junk-func 'junk))
+	      (setq split (delq 'junk split))
 	      (when split
 		(setq group-art
 		      (mapcar
@@ -1191,12 +1214,14 @@ FUNC will be called with the group name to determine the article number."
 			group-art))
 	      ;; This is the final group, which is used as a
 	      ;; catch-all.
-	      (unless group-art
+	      (when (and (not group-art)
+			 (not nnmail-inhibit-default-split-group))
 		(setq group-art
 		      (list (cons (car method)
 				  (funcall func (car method))))))))
 	  ;; Fall back on "bogus" if all else fails.
-	  (unless group-art
+	  (when (and (not group-art)
+		     (not nnmail-inhibit-default-split-group))
 	    (setq group-art (list (cons "bogus" (funcall func "bogus"))))))
 	;; Produce a trace if non-empty.
 	(when (and trace nnmail-split-trace)
@@ -1314,7 +1339,7 @@ Eudora has a broken References line, but an OK In-Reply-To."
       (replace-match "\\1" t))))
 
 (defalias 'nnmail-fix-eudora-headers 'nnmail-ignore-broken-references)
-(make-obsolete 'nnmail-fix-eudora-headers 'nnmail-ignore-broken-references)
+(make-obsolete 'nnmail-fix-eudora-headers 'nnmail-ignore-broken-references "Emacs 23.1")
 
 (custom-add-option 'nnmail-prepare-incoming-header-hook
 		   'nnmail-ignore-broken-references)
@@ -1569,10 +1594,9 @@ See the documentation for the variable `nnmail-split-fancy' for details."
 	  (and nnmail-cache-buffer
 	       (buffer-name nnmail-cache-buffer)))
       ()				; The buffer is open.
-    (save-excursion
-      (set-buffer
+    (with-current-buffer
        (setq nnmail-cache-buffer
-	     (get-buffer-create " *nnmail message-id cache*")))
+	     (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))
@@ -1584,8 +1608,7 @@ See the documentation for the variable `nnmail-split-fancy' for details."
 	     nnmail-treat-duplicates
 	     (buffer-name nnmail-cache-buffer)
 	     (buffer-modified-p nnmail-cache-buffer))
-    (save-excursion
-      (set-buffer nnmail-cache-buffer)
+    (with-current-buffer nnmail-cache-buffer
       ;; Weed out the excess number of Message-IDs.
       (goto-char (point-max))
       (when (search-backward "\n" nil t nnmail-message-id-cache-length)
@@ -1602,10 +1625,6 @@ See the documentation for the variable `nnmail-split-fancy' for details."
       (setq nnmail-cache-buffer nil)
       (gnus-kill-buffer (current-buffer)))))
 
-;; Compiler directives.
-(defvar group)
-(defvar group-art-list)
-(defvar group-art)
 (defun nnmail-cache-insert (id grp &optional subject sender)
   (when (stringp id)
     ;; this will handle cases like `B r' where the group is nil
@@ -1620,8 +1639,7 @@ See the documentation for the variable `nnmail-split-fancy' for details."
       ;; 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)
+      (with-current-buffer nnmail-cache-buffer
 	(goto-char (point-max))
 	(if (and grp (not (string= "" grp))
 		 (gnus-methods-equal-p gnus-command-method
@@ -1654,8 +1672,7 @@ See the documentation for the variable `nnmail-split-fancy' for details."
 ;; cache.
 (defun nnmail-cache-fetch-group (id)
   (when (and nnmail-treat-duplicates nnmail-cache-buffer)
-    (save-excursion
-      (set-buffer nnmail-cache-buffer)
+    (with-current-buffer nnmail-cache-buffer
       (goto-char (point-max))
       (when (search-backward id nil t)
 	(beginning-of-line)
@@ -1699,8 +1716,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
 
 (defun nnmail-cache-id-exists-p (id)
   (when nnmail-treat-duplicates
-    (save-excursion
-      (set-buffer nnmail-cache-buffer)
+    (with-current-buffer nnmail-cache-buffer
       (goto-char (point-max))
       (search-backward id nil t))))
 
@@ -1710,7 +1726,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
       (message-narrow-to-head)
       (message-fetch-field header))))
 
-(defun nnmail-check-duplication (message-id func artnum-func)
+(defun nnmail-check-duplication (message-id func artnum-func
+					    &optional junk-func)
   (run-hooks 'nnmail-prepare-incoming-message-hook)
   ;; If this is a duplicate message, then we do not save it.
   (let* ((duplication (nnmail-cache-id-exists-p message-id))
@@ -1735,7 +1752,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
     (cond
      ((not duplication)
       (funcall func (setq group-art
-			  (nreverse (nnmail-article-group artnum-func))))
+			  (nreverse (nnmail-article-group
+				     artnum-func nil junk-func))))
       (nnmail-cache-insert message-id (caar group-art)))
      ((eq action 'delete)
       (setq group-art nil))
@@ -1820,8 +1838,6 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
       ;; The we go through all the existing mail source specification
       ;; and fetch the mail from each.
       (while (setq source (pop fetching-sources))
-	(nnheader-message 4 "%s: Reading incoming mail from %s..."
-			  method (car source))
 	(when (setq new
 		    (mail-source-fetch
 		     source
@@ -1839,8 +1855,9 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
 	  (incf i)))
       ;; If we did indeed read any incoming spools, we save all info.
       (if (zerop total)
-	  (nnheader-message 4 "%s: Reading incoming mail (no new mail)...done"
-			    method (car source))
+	  (when mail-source-plugged
+	    (nnheader-message 4 "%s: Reading incoming mail (no new mail)...done"
+			      method (car source)))
 	(nnmail-save-active
 	 (nnmail-get-value "%s-group-alist" method)
 	 (nnmail-get-value "%s-active-file" method))
@@ -1855,9 +1872,12 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
       (run-hooks 'nnmail-post-get-new-mail-hook))))
 
 (defun nnmail-expired-article-p (group time force &optional inhibit)
-  "Say whether an article that is TIME old in GROUP should be expired."
+  "Say whether an article that is TIME old in GROUP should be expired.
+If TIME is nil, then return the cutoff time for oldness instead."
   (if force
-      t
+      (if (null time)
+	  (current-time)
+	t)
     (let ((days (or (and nnmail-expiry-wait-function
 			 (funcall nnmail-expiry-wait-function group))
 		    nnmail-expiry-wait)))
@@ -1868,14 +1888,18 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
 	     nil)
 	    ((eq days 'immediate)
 	     ;; We expire all articles on sight.
-	     t)
+	     (if (null time)
+		 (current-time)
+	       t))
 	    ((equal time '(0 0))
 	    ;; This is an ange-ftp group, and we don't have any dates.
 	     nil)
 	    ((numberp days)
 	     (setq days (days-to-time days))
 	     ;; Compare the time with the current time.
-	     (ignore-errors (time-less-p days (time-since time))))))))
+	     (if (null time)
+		 (time-subtract (current-time) days)
+	       (ignore-errors (time-less-p days (time-since time)))))))))
 
 (declare-function gnus-group-mark-article-read "gnus-group" (group article))
 
@@ -1890,7 +1914,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
     (unless (eq target 'delete)
       (when (or (gnus-request-group target)
 		(gnus-request-create-group target))
-	(let ((group-art (gnus-request-accept-article target nil nil t)))
+	(let ((group-art (gnus-request-accept-article target nil t t)))
 	  (when (consp group-art)
 	    (gnus-group-mark-article-read target (cdr group-art))))))))
 
@@ -2049,5 +2073,4 @@ Doesn't change point."
 
 (provide 'nnmail)
 
-;; arch-tag: fe8f671a-50db-428a-bb5d-f00462f72ed7
 ;;; nnmail.el ends here