X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/be520aca79dd429d55012a1916bdc97f06773fc5..6651c01506b4c903a8e473544ee4f7af9c555bca:/lisp/gnus/gnus-start.el diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 719d0c9e47..15bbf01c46 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -1,6 +1,6 @@ ;;; gnus-start.el --- startup functions for Gnus -;; Copyright (C) 1996-2011 Free Software Foundation, Inc. +;; Copyright (C) 1996-2012 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -763,8 +763,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)) @@ -832,13 +832,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 @@ -1034,7 +1043,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. @@ -1354,8 +1363,8 @@ 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))))) @@ -1442,7 +1451,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 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)) @@ -1491,8 +1504,6 @@ 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. @@ -1502,13 +1513,6 @@ 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-propagate-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)) @@ -1597,7 +1601,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)) @@ -1654,7 +1658,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)) @@ -1669,7 +1673,7 @@ 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) @@ -1693,12 +1697,28 @@ If SCAN, request a scan of that group as well." ;; If we have primary/secondary select methods, but no groups from ;; them, we still want to issue a retrieval request from them. - (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)))) + (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 + (gnus-check-backend-function + 'retrieve-group-data-early (car method)) + (not (gnus-method-denied-p method))) + (when (ignore-errors (gnus-get-function method 'open-server)) + (unless (gnus-server-opened method) + (gnus-open-server method)) + (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) @@ -2201,7 +2221,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)) @@ -2413,7 +2433,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 @@ -2523,7 +2545,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.