X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-start.el;h=f7d7d885646db85163e43663161b128fe0d1101c;hb=15a65996727617efe97de72cb1e694d4cd59aa67;hp=e3b0089cea971b3e9200d0b22d8f711630d6f4bc;hpb=d0f0dd2c198f772401ff7ab2435c30dc7fe05668;p=gnus

diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el
index e3b0089ce..f7d7d8856 100644
--- a/lisp/gnus-start.el
+++ b/lisp/gnus-start.el
@@ -1,6 +1,6 @@
 ;;; gnus-start.el --- startup functions for Gnus
 
-;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
@@ -832,13 +832,22 @@ prompt the user for the name of an NNTP server to use."
      gnus-current-startup-file)
    "-dribble"))
 
-(defun gnus-dribble-enter (string)
-  "Enter STRING into the dribble buffer."
+(defun gnus-dribble-enter (string &optional regexp)
+  "Enter STRING into the dribble buffer.
+If REGEXP is given, lines that match it will be deleted."
   (when (and (not gnus-dribble-ignore)
 	     gnus-dribble-buffer
 	     (buffer-name gnus-dribble-buffer))
     (let ((obuf (current-buffer)))
       (set-buffer gnus-dribble-buffer)
+      (when regexp
+	(goto-char (point-min))
+	(let (end)
+	  (while (re-search-forward regexp nil t)
+	    (unless (bolp) (forward-line 1))
+	    (setq end (point))
+	    (goto-char (match-beginning 0))
+	    (delete-region (point-at-bol) end))))
       (goto-char (point-max))
       (insert string "\n")
       ;; This has been commented by Josh Huber <huber@alum.wpi.edu>
@@ -1034,7 +1043,7 @@ If LEVEL is non-nil, the news will be set up at level LEVEL."
 
     ;; Find the number of unread articles in each non-dead group.
     (let ((gnus-read-active-file (and (not level) gnus-read-active-file)))
-      (gnus-get-unread-articles level))))
+      (gnus-get-unread-articles level dont-connect))))
 
 (defun gnus-call-subscribe-functions (method group)
   "Call METHOD to subscribe GROUP.
@@ -1354,8 +1363,8 @@ for new groups, and subscribe the new groups as zombies."
 	  (when (cdr entry)
 	    (setcdr (gnus-group-entry (caadr entry)) entry))
 	  (gnus-dribble-enter
-	   (format
-	    "(gnus-group-set-info '%S)" info)))))
+	   (format "(gnus-group-set-info '%S)" info)
+	   (concat "^(gnus-group-set-info '(\"" (regexp-quote group) "\"")))))
       (when gnus-group-change-level-function
 	(funcall gnus-group-change-level-function
 		 group level oldlevel previous)))))
@@ -1442,7 +1451,11 @@ newsgroup."
 (defun gnus-activate-group (group &optional scan dont-check method
 				  dont-sub-check)
   "Check whether a group has been activated or not.
-If SCAN, request a scan of that group as well."
+If SCAN, request a scan of that group as well.  If METHOD, use
+that select method instead of determining the method based on the
+group name.  If DONT-CHECK, don't check check whether the group
+actually exists.  If DONT-SUB-CHECK or DONT-CHECK, don't let the
+backend check whether the group actually exists."
   (let ((method (or method (inline (gnus-find-method-for-group group))))
 	active)
     (and (inline (gnus-check-server method))
@@ -1491,6 +1504,8 @@ If SCAN, request a scan of that group as well."
 	     ;; Return the new active info.
 	     active)))))
 
+(defvar gnus-propagate-marks)		; gnus-sum
+
 (defun gnus-get-unread-articles-in-group (info active &optional update)
   (when (and info active)
     ;; Allow the backend to update the info in the group.
@@ -1595,7 +1610,7 @@ If SCAN, request a scan of that group as well."
 
 ;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb'
 ;; and compute how many unread articles there are in each group.
-(defun gnus-get-unread-articles (&optional level)
+(defun gnus-get-unread-articles (&optional level dont-connect one-level)
   (setq gnus-server-method-cache nil)
   (require 'gnus-agent)
   (let* ((newsrc (cdr gnus-newsrc-alist))
@@ -1652,7 +1667,7 @@ If SCAN, request a scan of that group as well."
 	(push (setq method-group-list (list method method-type nil nil))
 	      type-cache))
       ;; Only add groups that need updating.
-      (if (<= (gnus-info-level info)
+      (if (funcall (if one-level #'= #'<=) (gnus-info-level info)
 	      (if (eq (cadr method-group-list) 'foreign)
 		  foreign-level
 		alevel))
@@ -1667,7 +1682,7 @@ If SCAN, request a scan of that group as well."
 
     ;; Sort the methods based so that the primary and secondary
     ;; methods come first.  This is done for legacy reasons to try to
-    ;; ensure that side-effect behaviour doesn't change from previous
+    ;; ensure that side-effect behavior doesn't change from previous
     ;; Gnus versions.
     (setq type-cache
 	  (sort (nreverse type-cache)
@@ -1691,12 +1706,28 @@ If SCAN, request a scan of that group as well."
 
     ;; If we have primary/secondary select methods, but no groups from
     ;; them, we still want to issue a retrieval request from them.
-    (dolist (method (cons gnus-select-method
-			  gnus-secondary-select-methods))
-      (when (and (not (assoc method type-cache))
-		 (gnus-check-backend-function 'request-list (car method)))
-	(with-current-buffer nntp-server-buffer
-	  (gnus-read-active-file-1 method nil))))
+    (unless dont-connect
+      (dolist (method (cons gnus-select-method
+			    gnus-secondary-select-methods))
+	(when (and (not (assoc method type-cache))
+		   (gnus-check-backend-function 'request-list (car method)))
+	  (with-current-buffer nntp-server-buffer
+	    (gnus-read-active-file-1 method nil)))))
+
+    ;; Clear out all the early methods.
+    (dolist (elem type-cache)
+      (destructuring-bind (method method-type infos dummy) elem
+	(when (and method
+		   infos
+		   (gnus-check-backend-function
+		    'retrieve-group-data-early (car method))
+		   (not (gnus-method-denied-p method)))
+	  (when (ignore-errors (gnus-get-function method 'open-server))
+	    (unless (gnus-server-opened method)
+	      (gnus-open-server method))
+	    (when (gnus-server-opened method)
+	      ;; Just mark this server as "cleared".
+	      (gnus-retrieve-group-data-early method nil))))))
 
     ;; Start early async retrieval of data.
     (let ((done-methods nil)
@@ -2272,7 +2303,19 @@ If FORCE is non-nil, the .newsrc file is read."
 	  (gnus-message 5 "Reading %s...done" newsrc-file)))
 
       ;; Convert old to new.
-      (gnus-convert-old-newsrc))))
+      (gnus-convert-old-newsrc)
+      (gnus-clean-old-newsrc))))
+
+(defun gnus-clean-old-newsrc ()
+  (when gnus-newsrc-file-version
+    (when (< (gnus-continuum-version gnus-newsrc-file-version)
+	     (gnus-continuum-version "Ma Gnus v0.02"))
+      ;; Remove old `exist' marks from old nnimap groups.
+      (dolist (info (cdr gnus-newsrc-alist))
+	(let ((exist (assoc 'unexist (gnus-info-marks info))))
+	  (when exist
+	    (gnus-info-set-marks
+	     info (delete exist (gnus-info-marks info)))))))))
 
 (defun gnus-convert-old-newsrc ()
   "Convert old newsrc formats into the current format, if needed."
@@ -2521,7 +2564,7 @@ If FORCE is non-nil, the .newsrc file is read."
        ((or (eq symbol options-symbol)
 	    (eq symbol Options-symbol))
 	(setq gnus-newsrc-options
-	      ;; This concating is quite inefficient, but since our
+	      ;; This concatting is quite inefficient, but since our
 	      ;; thorough studies show that approx 99.37% of all
 	      ;; .newsrc files only contain a single options line, we
 	      ;; don't give a damn, frankly, my dear.