Try to prune the Gnus registry if it's full.
[gnus] / lisp / gnus-start.el
index e970ca7..719d0c9 100644 (file)
@@ -864,6 +864,7 @@ prompt the user for the name of an NNTP server to use."
                               (gnus-get-buffer-create
                                (file-name-nondirectory dribble-file)))
       (set (make-local-variable 'file-precious-flag) t)
+      (setq buffer-save-without-query t)
       (erase-buffer)
       (setq buffer-file-name dribble-file)
       (auto-save-mode t)
@@ -1305,16 +1306,13 @@ for new groups, and subscribe the new groups as zombies."
        ((>= level gnus-level-zombie)
        ;; Remove from the hash table.
        (gnus-sethash group nil gnus-newsrc-hashtb)
-       ;; We do not enter foreign groups into the list of dead
-       ;; groups.
-       (unless (gnus-group-foreign-p group)
-         (if (= level gnus-level-zombie)
-             (push group gnus-zombie-list)
-           (if (= oldlevel gnus-level-killed)
-               ;; Remove from active hashtb.
-               (unintern group gnus-active-hashtb)
-             ;; Don't add it into killed-list if it was killed.
-             (push group gnus-killed-list)))))
+       (if (= level gnus-level-zombie)
+           (push group gnus-zombie-list)
+         (if (= oldlevel gnus-level-killed)
+             ;; Remove from active hashtb.
+             (unintern group gnus-active-hashtb)
+           ;; Don't add it into killed-list if it was killed.
+           (push group gnus-killed-list))))
        (t
        ;; If the list is to be entered into the newsrc assoc, and
        ;; it was killed, we have to create an entry in the newsrc
@@ -1464,9 +1462,10 @@ If SCAN, request a scan of that group as well."
               (inline (gnus-request-group group (or dont-sub-check dont-check)
                                           method
                                           (gnus-get-info group)))
-            ;;(error nil)
             (quit
-             (message "Quit activating %s" group)
+             (if debug-on-quit
+                 (debug "Quit")
+               (message "Quit activating %s" group))
              nil)))
         (unless dont-check
           (setq active (gnus-parse-active))
@@ -1492,6 +1491,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.
@@ -1512,7 +1513,7 @@ If SCAN, request a scan of that group as well."
           (num 0))
 
       ;; These checks are present in gnus-activate-group but skipped
-      ;; due to setting dont-check in the preceeding call.
+      ;; due to setting dont-check in the preceding call.
 
       ;; If a cache is present, we may have to alter the active info.
       (when (and gnus-use-cache info)
@@ -1689,27 +1690,6 @@ If SCAN, request a scan of that group as well."
                            method))
              (setcar elem method))
            (push (list method 'ok) methods)))))
-    ;; Start early async retrieval of data.
-    (dolist (elem type-cache)
-      (destructuring-bind (method method-type infos dummy) elem
-       (when (and method infos
-                  (not (gnus-method-denied-p method)))
-         ;; If the open-server method doesn't exist, then the method
-         ;; itself doesn't exist, so we ignore it.
-         (if (not (ignore-errors (gnus-get-function method 'open-server)))
-             (setq type-cache (delq elem type-cache))
-           (unless (gnus-server-opened method)
-             (gnus-open-server method))
-           (when (and
-                  (gnus-server-opened method)
-                  (gnus-check-backend-function
-                   'retrieve-group-data-early (car method)))
-             (when (gnus-check-backend-function 'request-scan (car method))
-               (gnus-request-scan nil method))
-             ;; Store the token we get back from -early so that we
-             ;; can pass it to -finish later.
-             (setcar (nthcdr 3 elem)
-                     (gnus-retrieve-group-data-early method infos)))))))
 
     ;; If we have primary/secondary select methods, but no groups from
     ;; them, we still want to issue a retrieval request from them.
@@ -1720,10 +1700,44 @@ If SCAN, request a scan of that group as well."
        (with-current-buffer nntp-server-buffer
          (gnus-read-active-file-1 method nil))))
 
+    ;; Start early async retrieval of data.
+    (let ((done-methods nil)
+         sanity-spec)
+      (dolist (elem type-cache)
+       (destructuring-bind (method method-type infos dummy) elem
+         (setq sanity-spec (list (car method) (cadr method)))
+         (when (and method infos
+                    (not (gnus-method-denied-p method)))
+           ;; If the open-server method doesn't exist, then the method
+           ;; itself doesn't exist, so we ignore it.
+           (if (not (ignore-errors (gnus-get-function method 'open-server)))
+               (setq type-cache (delq elem type-cache))
+             (unless (gnus-server-opened method)
+               (gnus-open-server method))
+             (when (and
+                    ;; This is a sanity check, so that we never
+                    ;; attempt to start two async requests to the
+                    ;; same server, because that will fail.  This
+                    ;; should never happen, since the methods should
+                    ;; be unique at this point, but apparently it
+                    ;; does happen in the wild with some setups.
+                    (not (member sanity-spec done-methods))
+                    (gnus-server-opened method)
+                    (gnus-check-backend-function
+                     'retrieve-group-data-early (car method)))
+               (push sanity-spec done-methods)
+               (when (gnus-check-backend-function 'request-scan (car method))
+                 (gnus-request-scan nil method))
+               ;; Store the token we get back from -early so that we
+               ;; can pass it to -finish later.
+               (setcar (nthcdr 3 elem)
+                       (gnus-retrieve-group-data-early method infos))))))))
+
     ;; Do the rest of the retrieval.
     (dolist (elem type-cache)
       (destructuring-bind (method method-type infos early-data) elem
-       (when (and method infos)
+       (when (and method infos
+                  (not (gnus-method-denied-p method)))
          (let ((updatep (gnus-check-backend-function
                          'request-update-info (car method))))
            ;; See if any of the groups from this method require updating.
@@ -1761,6 +1775,7 @@ If SCAN, request a scan of that group as well."
      ;; Finish up getting the data from the methods that have -early
      ;; methods.
      ((and
+       early-data
        (gnus-check-backend-function 'finish-retrieve-group-infos (car method))
        (or (not (gnus-agent-method-p method))
           (gnus-online method)))
@@ -1885,7 +1900,7 @@ If SCAN, request a scan of that group as well."
                             ;; OK - I'm done
                             (setq articles nil))
                            ((< range article)
-                            ;; this range preceeds the article. Leave the range unmodified.
+                            ;; this range precedes the article. Leave the range unmodified.
                             (pop ranges)
                             ranges)
                            ((= range article)
@@ -1908,11 +1923,11 @@ If SCAN, request a scan of that group as well."
                             (setcar ranges min)
                             ranges)
                            ((< max article)
-                            ;; this range preceeds the article. Leave the range unmodified.
+                            ;; this range precedes the article. Leave the range unmodified.
                             (pop ranges)
                             ranges)
                            ((< article min)
-                            ;; this article preceeds the range.  Return null to move to the
+                            ;; this article precedes the range.  Return null to move to the
                             ;; next article
                             nil)
                            (t
@@ -2005,7 +2020,9 @@ If SCAN, request a scan of that group as well."
              ;; We catch C-g so that we can continue past servers
              ;; that do not respond.
              (quit
-              (message "Quit reading the active file")
+              (if debug-on-quit
+                  (debug "Quit")
+                (message "Quit reading the active file"))
               nil))))))))
 
 (defun gnus-read-active-file-1 (method force)
@@ -2869,7 +2886,8 @@ If FORCE is non-nil, the .newsrc file is read."
       (pop list))
     (nreverse olist)))
 
-(defun gnus-gnus-to-newsrc-format ()
+(defun gnus-gnus-to-newsrc-format (&optional foreign-ok)
+  (interactive (list (gnus-y-or-n-p "write foreign groups too? ")))
   ;; Generate and save the .newsrc file.
   (with-current-buffer (create-file-buffer gnus-current-startup-file)
     (let ((newsrc (cdr gnus-newsrc-alist))
@@ -2891,7 +2909,8 @@ If FORCE is non-nil, the .newsrc file is read."
        ;; Don't write foreign groups to .newsrc.
        (when (or (null (setq method (gnus-info-method info)))
                  (equal method "native")
-                 (inline (gnus-server-equal method gnus-select-method)))
+                 (inline (gnus-server-equal method gnus-select-method))
+                  foreign-ok)
          (insert (gnus-info-group info)
                  (if (> (gnus-info-level info) gnus-level-subscribed)
                      "!" ":"))