X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-start.el;h=fdf6b9255d74206f475d90407a890c88bc66aa42;hp=16a733d1452683f696168131c2447171ddb8f62e;hb=06e3d74faa6b1196f0a7b877acc1bb6b6c1563a8;hpb=7cce28b2d41e11d65102b8910ee9efc361b720ca diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index 16a733d14..fdf6b9255 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -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 - -