shr: Render td content with shr-descend
[gnus] / lisp / gnus-start.el
index e25d31e..8663d67 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.
@@ -380,6 +380,13 @@ 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
@@ -402,8 +409,7 @@ This hook is called as the first thing when Gnus is started."
   :group 'gnus-start
   :type 'hook)
 
-(defcustom gnus-setup-news-hook
-  '(gnus-fixup-nnimap-unread-after-getting-new-news)
+(defcustom gnus-setup-news-hook nil
   "A hook after reading the .newsrc file, but before generating the buffer."
   :group 'gnus-start
   :type 'hook)
@@ -420,9 +426,9 @@ This hook is called as the first thing when Gnus is started."
   :type 'hook)
 
 (defcustom gnus-after-getting-new-news-hook
-  '(gnus-display-time-event-handler
-    gnus-fixup-nnimap-unread-after-getting-new-news)
+  '(gnus-display-time-event-handler)
   "*A hook run after Gnus checks for new news when Gnus is already running."
+  :version "24.1"
   :group 'gnus-group-new
   :type 'hook)
 
@@ -705,6 +711,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.
@@ -768,14 +775,6 @@ prompt the user for the name of an NNTP server to use."
     (if gnus-agent
        (gnus-agentize))
 
-    (when gnus-simple-splash
-      (setq gnus-simple-splash nil)
-      (cond
-       ((featurep 'xemacs)
-       (gnus-xmas-splash))
-       (window-system
-       (gnus-x-splash))))
-
     (let ((level (and (numberp arg) (> arg 0) arg))
          did-connect)
       (unwind-protect
@@ -1056,15 +1055,6 @@ If LEVEL is non-nil, the news will be set up at level LEVEL."
               (gnus-server-opened gnus-select-method))
       (gnus-check-bogus-newsgroups))
 
-    ;; We might read in new NoCeM messages here.
-    (when (and (not dont-connect)
-              gnus-use-nocem
-              (or (and (numberp gnus-use-nocem)
-                       (numberp level)
-                       (>= level gnus-use-nocem))
-                  (not level)))
-      (gnus-nocem-scan-groups))
-
     ;; Read any slave files.
     (gnus-master-read-slave-newsrc)
 
@@ -1110,53 +1100,53 @@ for new groups, and subscribe the new groups as zombies."
                        'gnus-subscribe-zombies)
                  t)
                 (t gnus-check-new-newsgroups))))
-    (unless (gnus-check-first-time-used)
-      (if (or (consp check)
-             (eq check 'ask-server))
-         ;; Ask the server for new groups.
-         (gnus-ask-server-for-new-groups)
-       ;; Go through the active hashtb and look for new groups.
-       (let ((groups 0)
-             group new-newsgroups)
-         (gnus-message 5 "Looking for new newsgroups...")
-         (unless gnus-have-read-active-file
-           (gnus-read-active-file))
-         (setq gnus-newsrc-last-checked-date (message-make-date))
-         (unless gnus-killed-hashtb
-           (gnus-make-hashtable-from-killed))
-         ;; Go though every newsgroup in `gnus-active-hashtb' and compare
-         ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'.
-         (mapatoms
-          (lambda (sym)
-            (if (or (null (setq group (symbol-name sym)))
-                    (not (boundp sym))
-                    (null (symbol-value sym))
-                    (gnus-gethash group gnus-killed-hashtb)
-                    (gnus-gethash group gnus-newsrc-hashtb))
-                ()
-              (let ((do-sub (gnus-matches-options-n group)))
-                (cond
-                 ((eq do-sub 'subscribe)
-                  (setq groups (1+ groups))
-                  (gnus-sethash group group gnus-killed-hashtb)
-                  (gnus-call-subscribe-functions
-                   gnus-subscribe-options-newsgroup-method group))
-                 ((eq do-sub 'ignore)
-                  nil)
-                 (t
-                  (setq groups (1+ groups))
-                  (gnus-sethash group group gnus-killed-hashtb)
-                  (if gnus-subscribe-hierarchical-interactive
-                      (push group new-newsgroups)
-                    (gnus-call-subscribe-functions
-                     gnus-subscribe-newsgroup-method group)))))))
-          gnus-active-hashtb)
-         (when new-newsgroups
-           (gnus-subscribe-hierarchical-interactive new-newsgroups))
-         (if (> groups 0)
-             (gnus-message 5 "%d new newsgroup%s arrived."
-                           groups (if (> groups 1) "s have" " has"))
-           (gnus-message 5 "No new newsgroups.")))))))
+    (if (or (consp check)
+            (eq check 'ask-server))
+        ;; Ask the server for new groups.
+        (gnus-ask-server-for-new-groups)
+      ;; Go through the active hashtb and look for new groups.
+      (let ((groups 0)
+            group new-newsgroups)
+        (gnus-message 5 "Looking for new newsgroups...")
+        (unless gnus-have-read-active-file
+          (gnus-read-active-file))
+        (setq gnus-newsrc-last-checked-date (message-make-date))
+        (unless gnus-killed-hashtb
+          (gnus-make-hashtable-from-killed))
+        ;; Go though every newsgroup in `gnus-active-hashtb' and compare
+        ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'.
+        (mapatoms
+         (lambda (sym)
+           (if (or (null (setq group (symbol-name sym)))
+                   (not (boundp sym))
+                   (null (symbol-value sym))
+                   (gnus-gethash group gnus-killed-hashtb)
+                   (gnus-gethash group gnus-newsrc-hashtb))
+               ()
+             (let ((do-sub (gnus-matches-options-n group)))
+               (cond
+                ((eq do-sub 'subscribe)
+                 (setq groups (1+ groups))
+                 (gnus-sethash group group gnus-killed-hashtb)
+                 (gnus-call-subscribe-functions
+                  gnus-subscribe-options-newsgroup-method group))
+                ((eq do-sub 'ignore)
+                 nil)
+                (t
+                 (setq groups (1+ groups))
+                 (gnus-sethash group group gnus-killed-hashtb)
+                 (if gnus-subscribe-hierarchical-interactive
+                     (push group new-newsgroups)
+                   (gnus-call-subscribe-functions
+                    gnus-subscribe-newsgroup-method group)))))))
+         gnus-active-hashtb)
+        (when new-newsgroups
+          (gnus-subscribe-hierarchical-interactive new-newsgroups))
+        (if (> groups 0)
+            (gnus-message 5 "%d new newsgroup%s arrived."
+                          groups (if (> groups 1) "s have" " has"))
+          (gnus-message 5 "No new newsgroups."))
+       groups))))
 
 (defun gnus-matches-options-n (group)
   ;; Returns `subscribe' if the group is to be unconditionally
@@ -1254,54 +1244,7 @@ for new groups, and subscribe the new groups as zombies."
       (gnus-message 5 "No new newsgroups"))
     (when got-new
       (setq gnus-newsrc-last-checked-date new-date))
-    got-new))
-
-(defun gnus-check-first-time-used ()
-  (catch 'ended
-    ;; First check if any of the following files exist.  If they do,
-    ;; it's not the first time the user has used Gnus.
-    (dolist (file (list (concat gnus-current-startup-file ".el")
-                       (concat gnus-current-startup-file ".eld")
-                       (concat gnus-startup-file ".el")
-                       (concat gnus-startup-file ".eld")))
-      (when (file-exists-p file)
-       (throw 'ended nil)))
-    (gnus-message 6 "First time user; subscribing you to default groups")
-    (unless (gnus-read-active-file-p)
-      (let ((gnus-read-active-file t))
-       (gnus-read-active-file)))
-    (setq gnus-newsrc-last-checked-date (message-make-date))
-    ;; Subscribe to the default newsgroups.
-    (let ((groups (or gnus-default-subscribed-newsgroups
-                     gnus-backup-default-subscribed-newsgroups))
-         group)
-      (if (eq groups t)
-         ;; If t, we subscribe (or not) all groups as if they were new.
-         (mapatoms
-          (lambda (sym)
-            (when (setq group (symbol-name sym))
-              (let ((do-sub (gnus-matches-options-n group)))
-                (cond
-                 ((eq do-sub 'subscribe)
-                  (gnus-sethash group group gnus-killed-hashtb)
-                  (gnus-call-subscribe-functions
-                   gnus-subscribe-options-newsgroup-method group))
-                 ((eq do-sub 'ignore)
-                  nil)
-                 (t
-                  (push group gnus-killed-list))))))
-          gnus-active-hashtb)
-       (dolist (group groups)
-         ;; Only subscribe the default groups that are activated.
-         (when (gnus-active group)
-           (gnus-group-change-level
-            group gnus-level-default-subscribed gnus-level-killed)))
-       (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))
-       (when gnus-novice-user
-         (gnus-message 7 "`A k' to list killed groups"))))))
+    new-newsgroups))
 
 (defun gnus-subscribe-group (group &optional previous method)
   "Subscribe GROUP and put it after PREVIOUS."
@@ -1467,7 +1410,7 @@ newsgroup."
          (push group bogus)))
       (if confirm
          (map-y-or-n-p
-          "Remove bogus group %s? "
+          (format "Remove bogus group %%s (of %d groups)? " (length bogus))
           (lambda (group)
             ;; Remove all bogus subscribed groups by first killing them, and
             ;; then removing them from the list of killed groups.
@@ -1536,10 +1479,12 @@ If SCAN, request a scan of that group as well."
           t)
         (if (or debug-on-error debug-on-quit)
             (inline (gnus-request-group group (or dont-sub-check dont-check)
-                                        method))
+                                        method
+                                        (gnus-get-info group)))
           (condition-case nil
               (inline (gnus-request-group group (or dont-sub-check dont-check)
-                                          method))
+                                          method
+                                          (gnus-get-info group)))
             ;;(error nil)
             (quit
              (message "Quit activating %s" group)
@@ -1577,6 +1522,13 @@ 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))
 
@@ -1667,6 +1619,7 @@ If SCAN, request a scan of that group as well."
 ;; and compute how many unread articles there are in each group.
 (defun gnus-get-unread-articles (&optional level)
   (setq gnus-server-method-cache nil)
+  (require 'gnus-agent)
   (let* ((newsrc (cdr gnus-newsrc-alist))
         (alevel (or level gnus-activate-level (1+ gnus-level-subscribed)))
         (foreign-level
@@ -1691,28 +1644,19 @@ If SCAN, request a scan of that group as well."
     (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))
@@ -1757,24 +1701,34 @@ If SCAN, request a scan of that group as well."
     (dolist (elem type-cache)
       (destructuring-bind (method method-type infos dummy) elem
        (when (and method infos
-                  (not (gnus-method-denied-p 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))
+           (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))
-           (dolist (info infos)
-             (gnus-request-scan (gnus-info-group info) method)))
-         (setcar (nthcdr 3 elem)
-                 (gnus-retrieve-group-data-early method infos)))))
+             (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)
-         ;; 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))))))))
+         (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)
@@ -1805,11 +1759,11 @@ If SCAN, request a scan of that group as well."
        (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-finish-retrieve-group-infos method infos early-data)
+      (gnus-agent-save-active method))
      ((gnus-check-backend-function 'retrieve-groups (car method))
       (when (gnus-check-backend-function 'request-scan (car method))
-       (dolist (info infos)
-         (gnus-request-scan (gnus-info-group info) method)))
+       (gnus-request-scan nil method))
       (let (groups)
        (gnus-read-active-file-2
         (dolist (info infos (nreverse groups))
@@ -2032,7 +1986,9 @@ If SCAN, request a scan of that group as well."
       (while (setq method (pop methods))
        ;; Only do each method once, in case the methods appear more
        ;; than once in this list.
-       (unless (member method methods)
+       (when (and (not (member method methods))
+                  ;; Check whether the backend exists.
+                  (ignore-errors (gnus-get-function method 'open-server)))
          (if (or debug-on-error debug-on-quit)
              (gnus-read-active-file-1 method force)
            (condition-case ()
@@ -2050,17 +2006,14 @@ If SCAN, request a scan of that group as well."
                       (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 (or (and gnus-agent
                          (gnus-online method))
                     (not gnus-agent))
                 (gnus-check-backend-function 'request-scan (car method)))
-       (if infos
-           (dolist (info infos)
-             (gnus-request-scan (gnus-info-group info) method))
-         (gnus-request-scan nil method)))
+       (gnus-request-scan nil method))
       (cond
        ((and (eq gnus-read-active-file 'some)
             (gnus-check-backend-function 'retrieve-groups (car method))
@@ -2085,10 +2038,10 @@ 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)
+         (add-to-list 'gnus-have-read-active-file method)
          (gnus-message 5 "%sdone" mesg)))))))
 
 (defun gnus-read-active-file-2 (groups method)
@@ -3153,20 +3106,6 @@ If this variable is nil, don't do anything."
           (gnus-boundp 'display-time-timer))
       (display-time-event-handler)))
 
-;;;###autoload
-(defun gnus-fixup-nnimap-unread-after-getting-new-news ()
-  (let (server group info)
-    (mapatoms
-     (lambda (sym)
-       (when (and (setq group (symbol-name sym))
-                 (gnus-group-entry group)
-                 (setq info (symbol-value sym)))
-        (gnus-sethash group (cons (nth 2 info) (cdr (gnus-group-entry group)))
-                      gnus-newsrc-hashtb)))
-     (if (boundp 'nnimap-mailbox-info)
-        (symbol-value 'nnimap-mailbox-info)
-       (make-vector 1 0)))))
-
 (defun gnus-check-reasonable-setup ()
   ;; Check whether nnml and nnfolder share a directory.
   (let ((display-warn