Split -request-update-info into -request-marks and -update-info.
[gnus] / lisp / gnus-start.el
index 16a733d..fdf6b92 100644 (file)
@@ -268,7 +268,7 @@ not match this regexp will be removed before saving the list."
   (mapconcat 'identity
             '("^to\\."                 ; not "real" groups
               "^[0-9. \t]+\\( \\|$\\)" ; all digits in name
-              "^[\"][]\"[#'()]"        ; bogus characters
+              "^[\"][\"#'()]"  ; bogus characters
               )
             "\\|")
   "*A regexp to match uninteresting newsgroups in the active file.
@@ -594,8 +594,7 @@ Can be used to turn version control on or off."
 (defun gnus-subscribe-hierarchically (newgroup)
   "Subscribe new NEWGROUP and insert it in hierarchical newsgroup order."
   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
-  (save-excursion
-    (set-buffer (nnheader-find-file-noselect gnus-current-startup-file))
+  (with-current-buffer (nnheader-find-file-noselect gnus-current-startup-file)
     (prog1
        (let ((groupkey newgroup) before)
          (while (and (not before) groupkey)
@@ -706,6 +705,7 @@ the first newsgroup."
        nnoo-state-alist nil
        gnus-current-select-method nil
        nnmail-split-history nil
+       gnus-extended-servers nil
        gnus-ephemeral-servers nil)
   (gnus-shutdown 'gnus)
   ;; Kill the startup file.
@@ -857,8 +857,7 @@ prompt the user for the name of an NNTP server to use."
       ;; it's not needed).
       ;; (set-window-point (get-buffer-window (current-buffer)) (point-max))
       (bury-buffer gnus-dribble-buffer)
-      (save-excursion
-       (set-buffer gnus-group-buffer)
+      (with-current-buffer gnus-group-buffer
        (gnus-group-set-mode-line))
       (set-buffer obuf))))
 
@@ -871,10 +870,9 @@ prompt the user for the name of an NNTP server to use."
   (let ((dribble-file (gnus-dribble-file-name)))
     (unless (file-exists-p (file-name-directory dribble-file))
       (make-directory (file-name-directory dribble-file) t))
-    (save-excursion
-      (set-buffer (setq gnus-dribble-buffer
-                       (gnus-get-buffer-create
-                        (file-name-nondirectory dribble-file))))
+    (with-current-buffer (setq gnus-dribble-buffer
+                              (gnus-get-buffer-create
+                               (file-name-nondirectory dribble-file)))
       (set (make-local-variable 'file-precious-flag) t)
       (erase-buffer)
       (setq buffer-file-name dribble-file)
@@ -923,8 +921,7 @@ prompt the user for the name of an NNTP server to use."
   (when (file-exists-p (gnus-dribble-file-name))
     (delete-file (gnus-dribble-file-name)))
   (when gnus-dribble-buffer
-    (save-excursion
-      (set-buffer gnus-dribble-buffer)
+    (with-current-buffer gnus-dribble-buffer
       (let ((auto (make-auto-save-file-name)))
        (when (file-exists-p auto)
          (delete-file auto))
@@ -934,14 +931,12 @@ prompt the user for the name of an NNTP server to use."
 (defun gnus-dribble-save ()
   (when (and gnus-dribble-buffer
             (buffer-name gnus-dribble-buffer))
-    (save-excursion
-      (set-buffer gnus-dribble-buffer)
+    (with-current-buffer gnus-dribble-buffer
       (save-buffer))))
 
 (defun gnus-dribble-clear ()
   (when (gnus-buffer-exists-p gnus-dribble-buffer)
-    (save-excursion
-      (set-buffer gnus-dribble-buffer)
+    (with-current-buffer gnus-dribble-buffer
       (erase-buffer)
       (set-buffer-modified-p nil)
       (setq buffer-saved-size (buffer-size)))))
@@ -1302,8 +1297,7 @@ for new groups, and subscribe the new groups as zombies."
          (when (gnus-active group)
            (gnus-group-change-level
             group gnus-level-default-subscribed gnus-level-killed)))
-       (save-excursion
-         (set-buffer gnus-group-buffer)
+       (with-current-buffer gnus-group-buffer
          ;; Don't error if the group already exists. This happens when a
          ;; first-time user types 'F'. -- didier
          (gnus-group-make-help-group t))
@@ -1526,7 +1520,8 @@ newsgroup."
          (when (> (cdr cache-active) (cdr active))
            (setcdr active (cdr cache-active))))))))
 
-(defun gnus-activate-group (group &optional scan dont-check method)
+(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."
   (let ((method (or method (inline (gnus-find-method-for-group group))))
@@ -1541,9 +1536,13 @@ If SCAN, request a scan of that group as well."
                (gnus-request-scan group method))
           t)
         (if (or debug-on-error debug-on-quit)
-            (inline (gnus-request-group group dont-check method))
+            (inline (gnus-request-group group (or dont-sub-check dont-check)
+                                        method
+                                        (gnus-get-info group)))
           (condition-case nil
-              (inline (gnus-request-group group dont-check method))
+              (inline (gnus-request-group group (or dont-sub-check dont-check)
+                                          method
+                                          (gnus-get-info group)))
             ;;(error nil)
             (quit
              (message "Quit activating %s" group)
@@ -1674,61 +1673,69 @@ If SCAN, request a scan of that group as well."
   (let* ((newsrc (cdr gnus-newsrc-alist))
         (alevel (or level gnus-activate-level (1+ gnus-level-subscribed)))
         (foreign-level
-         (min
-          (cond ((and gnus-activate-foreign-newsgroups
-                      (not (numberp gnus-activate-foreign-newsgroups)))
-                 (1+ gnus-level-subscribed))
-                ((numberp gnus-activate-foreign-newsgroups)
-                 gnus-activate-foreign-newsgroups)
-                (t 0))
-          alevel))
+         (or
+          level
+          (min
+           (cond ((and gnus-activate-foreign-newsgroups
+                       (not (numberp gnus-activate-foreign-newsgroups)))
+                  (1+ gnus-level-subscribed))
+                 ((numberp gnus-activate-foreign-newsgroups)
+                  gnus-activate-foreign-newsgroups)
+                 (t 0))
+           alevel)))
         (methods-cache nil)
         (type-cache nil)
+        (gnus-agent-article-local-times 0)
+        (archive-method (gnus-server-to-method "archive"))
         infos info group active method cmethod
-        method-type method-group-list)
+        method-type method-group-list entry)
     (gnus-message 6 "Checking new news...")
 
     (while newsrc
       (setq active (gnus-active (setq group (gnus-info-group
                                             (setq info (pop newsrc))))))
-
-      ;; Check newsgroups.  If the user doesn't want to check them, or
-      ;; they can't be checked (for instance, if the news server can't
-      ;; be reached) we just set the number of unread articles in this
-      ;; newsgroup to t.  This means that Gnus thinks that there are
-      ;; unread articles, but it has no idea how many.
-
-      ;; To be more explicit:
-      ;; >0 for an active group with messages
-      ;; 0 for an active group with no unread messages
-      ;; nil for non-foreign groups that the user has requested not be checked
-      ;; t for unchecked foreign groups or bogus groups, or groups that can't
-      ;;   be checked, for one reason or other.
-
       ;; First go through all the groups, see what select methods they
       ;; belong to, and then collect them into lists per unique select
       ;; method.
       (if (not (setq method (gnus-info-method info)))
          (setq method gnus-select-method)
+       ;; There may be several similar methods.  Possibly extend the
+       ;; method.
        (if (setq cmethod (assoc method methods-cache))
            (setq method (cdr cmethod))
-         (setq cmethod (inline (gnus-server-get-method nil method)))
+         (setq cmethod (if (stringp method)
+                           (gnus-server-to-method method)
+                         (inline (gnus-find-method-for-group
+                                  (gnus-info-group info) info))))
          (push (cons method cmethod) methods-cache)
          (setq method cmethod)))
       (setq method-group-list (assoc method type-cache))
       (unless method-group-list
        (setq method-type
              (cond
-              ((gnus-secondary-method-p method)
+              ((or (gnus-secondary-method-p method)
+                   (and (gnus-archive-server-wanted-p)
+                        (gnus-methods-equal-p archive-method method)))
                'secondary)
               ((inline (gnus-server-equal gnus-select-method method))
                'primary)
               (t
                'foreign)))
-       (push (setq method-group-list (list method method-type nil))
+       (push (setq method-group-list (list method method-type nil nil))
              type-cache))
-      (setcar (nthcdr 2 method-group-list)
-             (cons info (nth 2 method-group-list))))
+      ;; Only add groups that need updating.
+      (if (<= (gnus-info-level info)
+             (if (eq (cadr method-group-list) 'foreign)
+                 foreign-level
+               alevel))
+         (setcar (nthcdr 2 method-group-list)
+                 (cons info (nth 2 method-group-list)))
+       ;; The group is inactive, so we nix out the number of unread articles.
+       ;; It leads `(gnus-group-unread group)' to return t.  See also
+       ;; `gnus-group-prepare-flat'.
+       (unless active
+         (when (setq entry (gnus-group-entry group))
+           (setcar entry t)))))
 
     ;; Sort the methods based so that the primary and secondary
     ;; methods come first.  This is done for legacy reasons to try to
@@ -1740,28 +1747,39 @@ If SCAN, request a scan of that group as well."
                  (< (gnus-method-rank (cadr c1) (car c1))
                     (gnus-method-rank (cadr c2) (car c2))))))
 
-    (while type-cache
-      (setq method (nth 0 (car type-cache))
-           method-type (nth 1 (car type-cache))
-           infos (nth 2 (car type-cache)))
-      (pop type-cache)
-
-      ;; See if any of the groups from this method require updating.
-      (when (block nil
-             (dolist (info infos)
-               (when (<= (gnus-info-level info)
-                         (if (eq method-type 'foreign)
-                             foreign-level
-                           alevel))
-                 (return t))))
-       (gnus-read-active-for-groups method infos)
-       (dolist (info infos)
-         (inline (gnus-get-unread-articles-in-group
-                  info (gnus-active (gnus-info-group info)))))))
+    ;; 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)))
+         (unless (gnus-server-opened method)
+           (gnus-open-server method))
+         (when (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))))))
+
+    ;; Do the rest of the retrieval.
+    (dolist (elem type-cache)
+      (destructuring-bind (method method-type infos early-data) elem
+       (when (and method infos)
+         (let ((updatep (gnus-check-backend-function
+                         'request-update-info (car method))))
+           ;; See if any of the groups from this method require updating.
+           (gnus-read-active-for-groups method infos early-data)
+           (dolist (info infos)
+             (inline (gnus-get-unread-articles-in-group
+                      info (gnus-active (gnus-info-group info))
+                      updatep)))))))
     (gnus-message 6 "Checking new news...done")))
 
 (defun gnus-method-rank (type method)
   (cond
+   ;; Get info for virtual groups last.
+   ((eq (car method) 'nnvirtual)
+    200)
    ((eq type 'primary)
     1)
    ;; Compute the rank of the secondary methods based on where they
@@ -1770,7 +1788,7 @@ If SCAN, request a scan of that group as well."
     (let ((i 2))
       (block nil
        (dolist (smethod gnus-secondary-select-methods)
-         (when (equalp method smethod)
+         (when (equal method smethod)
            (return i))
          (incf i))
        i)))
@@ -1778,20 +1796,28 @@ If SCAN, request a scan of that group as well."
    (t
     100)))
 
-(defun gnus-read-active-for-groups (method infos)
+(defun gnus-read-active-for-groups (method infos early-data)
   (with-current-buffer nntp-server-buffer
     (cond
+     ((and
+       (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)
+      (gnus-agent-save-active method))
      ((gnus-check-backend-function 'retrieve-groups (car method))
-      (gnus-read-active-file-2
-       (mapcar (lambda (info)
-                (gnus-group-real-name (gnus-info-group info)))
-              infos)
-       method))
+      (when (gnus-check-backend-function 'request-scan (car method))
+       (gnus-request-scan nil method))
+      (let (groups)
+       (gnus-read-active-file-2
+        (dolist (info infos (nreverse groups))
+          (push (gnus-group-real-name (gnus-info-group info)) groups))
+        method)))
      ((gnus-check-backend-function 'request-list (car method))
-      (gnus-read-active-file-1 method nil))
+      (gnus-read-active-file-1 method nil infos))
      (t
       (dolist (info infos)
-       (gnus-activate-group (gnus-info-group info) nil nil method))))))
+       (gnus-activate-group (gnus-info-group info) nil nil method t))))))
 
 ;; Create a hash table out of the newsrc alist.  The `car's of the
 ;; alist elements are used as keys.
@@ -1813,14 +1839,18 @@ If SCAN, request a scan of that group as well."
        (if (setq rest (member method methods))
            (gnus-info-set-method info (car rest))
          (push method methods)))
-      (gnus-sethash
-       (car info)
-       ;; Preserve number of unread articles in groups.
-       (cons (and ohashtb (car (gnus-gethash (car info) ohashtb)))
-            prev)
-       gnus-newsrc-hashtb)
-      (setq prev alist
-           alist (cdr alist)))
+      ;; Check for duplicates.
+      (if (gnus-gethash (car info) gnus-newsrc-hashtb)
+         ;; Remove this entry from the alist.
+         (setcdr prev (cddr prev))
+       (gnus-sethash
+        (car info)
+        ;; Preserve number of unread articles in groups.
+        (cons (and ohashtb (car (gnus-gethash (car info) ohashtb)))
+              prev)
+        gnus-newsrc-hashtb)
+       (setq prev alist))
+      (setq alist (cdr alist)))
     ;; Make the same select-methods in `gnus-server-alist' identical
     ;; as well.
     (while methods
@@ -1842,8 +1872,7 @@ If SCAN, request a scan of that group as well."
 
 (defun gnus-parse-active ()
   "Parse active info in the nntp server buffer."
-  (save-excursion
-    (set-buffer nntp-server-buffer)
+  (with-current-buffer nntp-server-buffer
     (goto-char (point-min))
     ;; Parse the result we got from `gnus-request-group'.
     (when (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+")
@@ -1997,8 +2026,7 @@ If SCAN, request a scan of that group as well."
             (list "archive")))))
        method)
     (setq gnus-have-read-active-file nil)
-    (save-excursion
-      (set-buffer nntp-server-buffer)
+    (with-current-buffer nntp-server-buffer
       (while (setq method (pop methods))
        ;; Only do each method once, in case the methods appear more
        ;; than once in this list.
@@ -2013,18 +2041,19 @@ If SCAN, request a scan of that group as well."
               (message "Quit reading the active file")
               nil))))))))
 
-(defun gnus-read-active-file-1 (method force)
+(defun gnus-read-active-file-1 (method force &optional infos)
   (let (where mesg)
     (setq where (nth 1 method)
          mesg (format "Reading active file%s via %s..."
                       (if (and where (not (zerop (length where))))
                           (concat " from " where) "")
                       (car method)))
-    (gnus-message 5 mesg)
+    (gnus-message 5 "%s" mesg)
     (when (gnus-check-server method)
       ;; Request that the backend scan its incoming messages.
-      (when (and gnus-agent
-                (gnus-online method)
+      (when (and (or (and gnus-agent
+                         (gnus-online method))
+                    (not gnus-agent))
                 (gnus-check-backend-function 'request-scan (car method)))
        (gnus-request-scan nil method))
       (cond
@@ -2051,7 +2080,7 @@ If SCAN, request a scan of that group as well."
            (unless (equal method gnus-message-archive-method)
              (gnus-error 1 "Cannot read active file from %s server"
                          (car method)))
-         (gnus-message 5 mesg)
+         (gnus-message 5 "%s" mesg)
          (gnus-active-to-gnus-format method gnus-active-hashtb nil t)
          ;; We mark this active file as read.
          (push method gnus-have-read-active-file)
@@ -2060,8 +2089,7 @@ If SCAN, request a scan of that group as well."
 (defun gnus-read-active-file-2 (groups method)
   "Read an active file for GROUPS in METHOD using `gnus-retrieve-groups'."
   (when groups
-    (save-excursion
-      (set-buffer nntp-server-buffer)
+    (with-current-buffer nntp-server-buffer
       (gnus-check-server method)
       (let ((list-type (gnus-retrieve-groups groups method)))
        (cond ((not list-type)
@@ -2742,8 +2770,7 @@ If FORCE is non-nil, the .newsrc file is read."
               (not force)
               (or (not gnus-dribble-buffer)
                   (not (buffer-name gnus-dribble-buffer))
-                  (zerop (save-excursion
-                           (set-buffer gnus-dribble-buffer)
+                  (zerop (with-current-buffer gnus-dribble-buffer
                            (buffer-size)))))
          (gnus-message 4 "(No changes need to be saved)")
        (gnus-run-hooks 'gnus-save-newsrc-hook)
@@ -2877,8 +2904,7 @@ If FORCE is non-nil, the .newsrc file is read."
 
 (defun gnus-gnus-to-newsrc-format ()
   ;; Generate and save the .newsrc file.
-  (save-excursion
-    (set-buffer (create-file-buffer gnus-current-startup-file))
+  (with-current-buffer (create-file-buffer gnus-current-startup-file)
     (let ((newsrc (cdr gnus-newsrc-alist))
          (standard-output (current-buffer))
          info ranges range method)
@@ -2951,8 +2977,7 @@ If FORCE is non-nil, the .newsrc file is read."
   (gnus-run-hooks 'gnus-slave-mode-hook))
 
 (defun gnus-slave-save-newsrc ()
-  (save-excursion
-    (set-buffer gnus-dribble-buffer)
+  (with-current-buffer gnus-dribble-buffer
     (let ((slave-name
           (mm-make-temp-file (concat gnus-current-startup-file "-slave-")))
          (modes (ignore-errors
@@ -2976,8 +3001,7 @@ If FORCE is non-nil, the .newsrc file is read."
     (if (not slave-files)
        ()                              ; There are no slave files to read.
       (gnus-message 7 "Reading slave newsrcs...")
-      (save-excursion
-       (set-buffer (gnus-get-buffer-create " *gnus slave*"))
+      (with-current-buffer (gnus-get-buffer-create " *gnus slave*")
        (setq slave-files
              (sort (mapcar (lambda (file)
                              (list (nth 5 (file-attributes file)) file))
@@ -3097,8 +3121,7 @@ If FORCE is non-nil, the .newsrc file is read."
 (defun gnus-group-get-description (group)
   "Get the description of a group by sending XGTITLE to the server."
   (when (gnus-request-group-description group)
-    (save-excursion
-      (set-buffer nntp-server-buffer)
+    (with-current-buffer nntp-server-buffer
       (goto-char (point-min))
       (when (looking-at "[^ \t]+[ \t]+\\(.*\\)")
        (match-string 1)))))
@@ -3178,5 +3201,3 @@ If this variable is nil, don't do anything."
 (provide 'gnus-start)
 
 ;;; gnus-start.el ends here
-
-