gnus-start.el: always check newsrc timestamp when saving it.
[gnus] / lisp / gnus-start.el
index 8663d67..0c0246a 100644 (file)
@@ -1,7 +1,6 @@
 ;;; gnus-start.el --- startup functions for Gnus
 
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2015 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
@@ -31,6 +30,7 @@
 (require 'gnus-spec)
 (require 'gnus-range)
 (require 'gnus-util)
+(require 'gnus-cloud)
 (autoload 'message-make-date "message")
 (autoload 'gnus-agent-read-servers-validate "gnus-agent")
 (autoload 'gnus-agent-save-local "gnus-agent")
@@ -86,14 +86,6 @@ If a file with the `.el' or `.elc' suffixes exists, it will be read instead."
   :group 'gnus-start
   :type '(choice file (const nil)))
 
-(defcustom gnus-default-subscribed-newsgroups nil
-  "List of newsgroups to subscribe, when a user runs Gnus the first time.
-The value should be a list of strings.
-If it is t, Gnus will not do anything special the first time it is
-started; it'll just use the normal newsgroups subscription methods."
-  :group 'gnus-start
-  :type '(choice (repeat string) (const :tag "Nothing special" t)))
-
 (defcustom gnus-use-dribble-file t
   "*Non-nil means that Gnus will use a dribble file to store user updates.
 If Emacs should crash without saving the .newsrc files, complete
@@ -119,7 +111,7 @@ ask the servers (primary, secondary, and archive servers) to list new
 groups since the last time it checked:
   1. This variable is `ask-server'.
   2. This variable is a list of select methods (see below).
-  3. `gnus-read-active-file' is nil or `some'.
+  3. Option `gnus-read-active-file' is nil or `some'.
   4. A prefix argument is given to `gnus-find-new-newsgroups' interactively.
 
 Thus, if this variable is `ask-server' or a list of select methods or
@@ -130,7 +122,7 @@ This variable can be a list of select methods which Gnus will query with
 the `ask-server' method in addition to the primary, secondary, and archive
 servers.
 
-Eg.
+E.g.:
   (setq gnus-check-new-newsgroups
        '((nntp \"some.server\") (nntp \"other.server\")))
 
@@ -300,7 +292,9 @@ claim them."
                function
                (repeat function)))
 
-(defcustom gnus-subscribe-newsgroup-hooks nil
+(define-obsolete-variable-alias 'gnus-subscribe-newsgroup-hooks
+  'gnus-subscribe-newsgroup-functions "24.3")
+(defcustom gnus-subscribe-newsgroup-functions nil
   "*Hooks run after you subscribe to a new group.
 The hooks will be called with new group's name as argument."
   :version "22.1"
@@ -341,8 +335,17 @@ hierarchy in its entirety."
   :group 'gnus-group-new
   :type 'boolean)
 
+(defcustom gnus-auto-subscribed-categories '(mail post-mail)
+  "*New groups from methods of these categories will be subscribed automatically.
+Note that this variable only deals with new groups.  It has no
+effect whatsoever on old groups.  The default is to automatically
+subscribe all groups from mail-like backends."
+  :version "24.1"
+  :group 'gnus-group-new
+  :type '(repeat symbol))
+
 (defcustom gnus-auto-subscribed-groups
-  "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl\\|^nnmaildir"
+  "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl\\|^nnmaildir\\|^nnimap"
   "*All new groups that match this regexp will be subscribed automatically.
 Note that this variable only deals with new groups.  It has no effect
 whatsoever on old groups.
@@ -380,13 +383,6 @@ disc."
   :group 'gnus-newsrc
   :type 'boolean)
 
-(defcustom gnus-use-backend-marks nil
-  "If non-nil, Gnus will store and retrieve marks from the backends.
-This means that marks will be stored both in .newsrc.eld and in
-the backend, and will slow operation down somewhat."
-  :group 'gnus-newsrc
-  :type 'boolean)
-
 (defcustom gnus-check-bogus-groups-hook nil
   "A hook run after removing bogus groups."
   :group 'gnus-start-server
@@ -400,7 +396,16 @@ This hook is called after Gnus is connected to the NNTP server."
 
 (defcustom gnus-before-startup-hook nil
   "A hook called before startup.
-This hook is called as the first thing when Gnus is started."
+This hook is called as the first thing when Gnus is started.
+See also `gnus-before-resume-hook'."
+  :group 'gnus-start
+  :type 'hook)
+
+(defcustom gnus-before-resume-hook nil
+  "A hook called before resuming Gnus after suspend.
+This hook is called as the first thing when Gnus is resumed after a suspend.
+See also `gnus-before-startup-hook'."
+  :version "24.4"
   :group 'gnus-start
   :type 'hook)
 
@@ -644,8 +649,9 @@ the first newsgroup."
     (gnus-group-change-level
      newsgroup gnus-level-default-subscribed
      gnus-level-killed (gnus-group-entry (or next "dummy.group")))
+    (gnus-request-update-group-status newsgroup 'subscribe)
     (gnus-message 5 "Subscribe newsgroup: %s" newsgroup)
-    (run-hook-with-args 'gnus-subscribe-newsgroup-hooks newsgroup)
+    (run-hook-with-args 'gnus-subscribe-newsgroup-functions newsgroup)
     t))
 
 (defun gnus-read-active-file-p ()
@@ -753,6 +759,7 @@ prompt the user for the name of an NNTP server to use."
 
   (if (gnus-alive-p)
       (progn
+       (gnus-run-hooks 'gnus-before-resume-hook)
        (switch-to-buffer gnus-group-buffer)
        (gnus-group-get-new-news
         (and (numberp arg)
@@ -769,8 +776,8 @@ prompt the user for the name of an NNTP server to use."
     ;; Add "native" to gnus-predefined-server-alist just to have a
     ;; name for the native select method.
     (when gnus-select-method
-      (push (cons "native" gnus-select-method)
-           gnus-predefined-server-alist))
+      (add-to-list 'gnus-predefined-server-alist
+                  (cons "native" gnus-select-method)))
 
     (if gnus-agent
        (gnus-agentize))
@@ -784,10 +791,9 @@ prompt the user for the name of an NNTP server to use."
                    (gnus-start-news-server (and arg (not level))))))
        (if (and (not dont-connect)
                 (not did-connect))
+           ;; Couldn't connect to the server, so bail out.
            (gnus-group-quit)
          (gnus-run-hooks 'gnus-startup-hook)
-         ;; NNTP server is successfully open.
-
          ;; Find the current startup file name.
          (setq gnus-current-startup-file
                (gnus-make-newsrc-file gnus-startup-file))
@@ -797,11 +803,10 @@ prompt the user for the name of an NNTP server to use."
            (gnus-dribble-read-file))
 
          ;; Do the actual startup.
-         (if gnus-agent
-             (gnus-request-create-group "queue" '(nndraft "")))
-         (gnus-request-create-group "drafts" '(nndraft ""))
          (gnus-setup-news nil level dont-connect)
          (gnus-run-hooks 'gnus-setup-news-hook)
+         (when gnus-agent
+           (gnus-request-create-group "queue" '(nndraft "")))
          (gnus-start-draft-setup)
          ;; Generate the group buffer.
          (gnus-group-list-groups level)
@@ -816,10 +821,10 @@ prompt the user for the name of an NNTP server to use."
   (gnus-request-create-group "drafts" '(nndraft ""))
   (unless (gnus-group-entry "nndraft:drafts")
     (let ((gnus-level-default-subscribed 1))
-      (gnus-subscribe-group "nndraft:drafts" nil '(nndraft ""))))
+      (gnus-subscribe-group "nndraft:drafts" nil '(nndraft "")))
+    (setcar (gnus-group-entry "nndraft:drafts") 0))
   (unless (equal (gnus-group-get-parameter "nndraft:drafts" 'gnus-dummy t)
                 '((gnus-draft-mode)))
-    (gnus-message 3 "Setting up drafts group")
     (gnus-group-set-parameter
      "nndraft:drafts" 'gnus-dummy '((gnus-draft-mode)))))
 
@@ -840,13 +845,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>
@@ -872,8 +886,14 @@ 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)
+      ;; The buffer may be shrunk a lot when deleting old entries.
+      ;; It caused the auto-saving to stop.
+      (if (featurep 'emacs)
+         (set (make-local-variable 'auto-save-include-big-deletions) t)
+       (set (make-local-variable 'disable-auto-save-when-buffer-shrinks) nil))
       (auto-save-mode t)
       (buffer-disable-undo)
       (bury-buffer (current-buffer))
@@ -930,7 +950,8 @@ prompt the user for the name of an NNTP server to use."
   (when (and gnus-dribble-buffer
             (buffer-name gnus-dribble-buffer))
     (with-current-buffer gnus-dribble-buffer
-      (save-buffer))))
+      (when (> (buffer-size) 0)
+       (save-buffer)))))
 
 (defun gnus-dribble-clear ()
   (when (gnus-buffer-exists-p gnus-dribble-buffer)
@@ -996,27 +1017,8 @@ If LEVEL is non-nil, the news will be set up at level LEVEL."
     (when (or (null gnus-read-active-file)
              (eq gnus-read-active-file 'some))
       (gnus-update-active-hashtb-from-killed))
-
-    ;; Validate agent covered methods now that gnus-server-alist has
-    ;; been initialized.
-    ;; NOTE: This is here for one purpose only.  By validating the
-    ;; agentized server's, it converts the old 5.10.3, and earlier,
-    ;; format to the current format.  That enables the agent code
-    ;; within gnus-read-active-file to function correctly.
-    (if gnus-agent
-        (gnus-agent-read-servers-validate))
-
-    ;; Read the active file and create `gnus-active-hashtb'.
-    ;; If `gnus-read-active-file' is nil, then we just create an empty
-    ;; hash table.  The partial filling out of the hash table will be
-    ;; done in `gnus-get-unread-articles'.
-    (and gnus-read-active-file
-        (not level)
-        (gnus-read-active-file nil dont-connect))
-
     (unless gnus-active-hashtb
       (setq gnus-active-hashtb (gnus-make-hashtable 4096)))
-
     ;; Initialize the cache.
     (when gnus-use-cache
       (gnus-cache-open))
@@ -1060,7 +1062,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.
@@ -1158,6 +1160,12 @@ for new groups, and subscribe the new groups as zombies."
    ((and gnus-options-subscribe
         (string-match gnus-options-subscribe group))
     'subscribe)
+   ((let ((do-subscribe nil))
+      (dolist (category gnus-auto-subscribed-categories)
+       (when (gnus-member-of-valid category group)
+         (setq do-subscribe t)))
+      do-subscribe)
+    'subscribe)
    ((and gnus-auto-subscribed-groups
         (string-match gnus-auto-subscribed-groups group))
     'subscribe)
@@ -1326,16 +1334,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
@@ -1377,17 +1382,12 @@ 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)))))
 
-(defun gnus-kill-newsgroup (newsgroup)
-  "Obsolete function.  Kills a newsgroup."
-  (gnus-group-change-level
-   (gnus-group-entry newsgroup) gnus-level-killed))
-
 (defun gnus-check-bogus-newsgroups (&optional confirm)
   "Remove bogus newsgroups.
 If CONFIRM is non-nil, the user has to confirm the deletion of every
@@ -1465,7 +1465,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 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))
@@ -1485,9 +1489,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))
@@ -1522,18 +1527,11 @@ If SCAN, request a scan of that group as well."
                              (gnus-info-group info)))))
       (gnus-activate-group (gnus-info-group info) nil t))
 
-    ;; Allow backends to update marks, 
-    (when gnus-use-backend-marks
-      (let ((method (inline (gnus-find-method-for-group
-                            (gnus-info-group info)))))
-       (when (gnus-check-backend-function 'request-marks (car method))
-         (gnus-request-marks info method))))
-
     (let* ((range (gnus-info-read info))
           (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)
@@ -1617,7 +1615,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))
@@ -1674,7 +1672,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))
@@ -1689,38 +1687,91 @@ 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)
                (lambda (c1 c2)
                  (< (gnus-method-rank (cadr c1) (car c1))
                     (gnus-method-rank (cadr c2) (car c2))))))
-
-    ;; Start early async retrieval of data.
+    ;; Go through the list of servers and possibly extend methods that
+    ;; aren't equal (and that need extension; i.e., they are async).
+    (let ((methods nil))
+      (dolist (elem type-cache)
+       (destructuring-bind (method method-type infos dummy) elem
+         (let ((gnus-opened-servers methods))
+           (when (and (gnus-similar-server-opened method)
+                      (gnus-check-backend-function
+                       'retrieve-group-data-early (car method)))
+             (setq method (gnus-server-extend-method
+                           (gnus-info-group (car infos))
+                           method))
+             (setcar elem method))
+           (push (list method 'ok) methods)))))
+
+    ;; If we have primary/secondary select methods, but no groups from
+    ;; them, we still want to issue a retrieval request from them.
+    (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
+       (when (and method
+                  infos
+                  (gnus-check-backend-function
+                   'retrieve-group-data-early (car method))
                   (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))
+         (when (ignore-errors (gnus-get-function method 'open-server))
            (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))
-             (setcar (nthcdr 3 elem)
-                     (gnus-retrieve-group-data-early method infos)))))))
+           (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)
+         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.
@@ -1755,12 +1806,19 @@ If SCAN, request a scan of that group as well."
 (defun gnus-read-active-for-groups (method infos early-data)
   (with-current-buffer nntp-server-buffer
     (cond
+     ;; 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)))
       (gnus-finish-retrieve-group-infos method infos early-data)
+      ;; We may have altered the data now, so mark the dribble buffer
+      ;; as dirty so that it gets saved.
+      (gnus-dribble-touch)
       (gnus-agent-save-active method))
+     ;; Most backends have -retrieve-groups.
      ((gnus-check-backend-function 'retrieve-groups (car method))
       (when (gnus-check-backend-function 'request-scan (car method))
        (gnus-request-scan nil method))
@@ -1769,8 +1827,11 @@ If SCAN, request a scan of that group as well."
         (dolist (info infos (nreverse groups))
           (push (gnus-group-real-name (gnus-info-group info)) groups))
         method)))
+     ;; Virtually all backends have -request-list.
      ((gnus-check-backend-function 'request-list (car method))
-      (gnus-read-active-file-1 method nil infos))
+      (gnus-read-active-file-1 method nil))
+     ;; Except nnvirtual and friends, where we request each group, one
+     ;; by one.
      (t
       (dolist (info infos)
        (gnus-activate-group (gnus-info-group info) nil nil method t))))))
@@ -1876,7 +1937,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)
@@ -1899,11 +1960,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
@@ -1996,10 +2057,12 @@ 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 &optional infos)
+(defun gnus-read-active-file-1 (method force)
   (let (where mesg)
     (setq where (nth 1 method)
          mesg (format "Reading active file%s via %s..."
@@ -2175,7 +2238,7 @@ If SCAN, request a scan of that group as well."
             (gnus-online method)
             (gnus-agent-method-p method))
        (progn
-         (gnus-agent-save-active method)
+         (gnus-agent-save-active method t)
          (gnus-active-to-gnus-format method hashtb nil real-active))
 
       (goto-char (point-min))
@@ -2248,7 +2311,12 @@ 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 (&optional force)
+  ;; Currently no cleanups.
+  )
 
 (defun gnus-convert-old-newsrc ()
   "Convert old newsrc formats into the current format, if needed."
@@ -2387,7 +2455,9 @@ If FORCE is non-nil, the .newsrc file is read."
        (when gnus-newsrc-assoc
          (setq gnus-newsrc-alist gnus-newsrc-assoc))))
     (dolist (elem gnus-newsrc-alist)
-      (setcar elem (mm-string-as-unibyte (car elem))))
+      ;; Protect against broken .newsrc.el files.
+      (when (car elem)
+       (setcar elem (mm-string-as-unibyte (car elem)))))
     (gnus-make-hashtable-from-newsrc-alist)
     (when (file-newer-than-file-p file ding-file)
       ;; Old format quick file
@@ -2497,7 +2567,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.
@@ -2713,6 +2783,7 @@ If FORCE is non-nil, the .newsrc file is read."
       'msdos-long-file-names
       (lambda () t))))
 
+(defvar gnus-save-newsrc-file-last-timestamp nil)
 (defun gnus-save-newsrc-file (&optional force)
   "Save .newsrc file."
   ;; Note: We cannot save .newsrc file if all newsgroups are removed
@@ -2751,12 +2822,29 @@ If FORCE is non-nil, the .newsrc file is read."
          (erase-buffer)
           (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file)
 
+          ;; check timestamp of `gnus-current-startup-file'.eld against
+          ;; `gnus-save-newsrc-file-last-timestamp'
+          (let* ((checkfile (concat gnus-current-startup-file ".eld"))
+                 (mtime (nth 5 (file-attributes checkfile))))
+            (when (and gnus-save-newsrc-file-last-timestamp
+                       (time-less-p gnus-save-newsrc-file-last-timestamp
+                                    mtime))
+              (unless (y-or-n-p
+                       (format "%s was updated externally after %s, save?"
+                               checkfile
+                               (format-time-string
+                                "%c"
+                                gnus-save-newsrc-file-last-timestamp)))
+                (error "Couldn't save %s: updated externally" checkfile))))
+
           (if gnus-save-startup-file-via-temp-buffer
               (let ((coding-system-for-write gnus-ding-file-coding-system)
                     (standard-output (current-buffer)))
                 (gnus-gnus-to-quick-newsrc-format)
                 (gnus-run-hooks 'gnus-save-quick-newsrc-hook)
-                (save-buffer))
+                (save-buffer)
+                (setq gnus-save-newsrc-file-last-timestamp
+                            (nth 5 (file-attributes buffer-file-name))))
             (let ((coding-system-for-write gnus-ding-file-coding-system)
                   (version-control gnus-backup-startup-file)
                   (startup-file (concat gnus-current-startup-file ".eld"))
@@ -2791,7 +2879,9 @@ If FORCE is non-nil, the .newsrc file is read."
 
                       ;; Replace the existing startup file with the temp file.
                       (rename-file working-file startup-file t)
-                      (gnus-set-file-modes startup-file setmodes)))
+                      (gnus-set-file-modes startup-file setmodes)
+                      (setq gnus-save-newsrc-file-last-timestamp
+                            (nth 5 (file-attributes startup-file)))))
                 (condition-case nil
                     (delete-file working-file)
                   (file-error nil)))))
@@ -2860,7 +2950,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))
@@ -2882,7 +2973,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)
                      "!" ":"))