;;; gnus-start.el --- startup functions for Gnus
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006 Free Software Foundation, Inc.
+;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(autoload 'gnus-agent-possibly-alter-active "gnus-agent")
(eval-when-compile
- (require 'cl)
+ (require 'cl))
- (defvar gnus-agent-covered-methods nil)
- (defvar gnus-agent-file-loading-local nil)
- (defvar gnus-agent-file-loading-cache nil))
+(defvar gnus-agent-covered-methods)
+(defvar gnus-agent-file-loading-local)
+(defvar gnus-agent-file-loading-cache)
(defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc")
"Your `.newsrc' file.
:type 'file)
(defcustom gnus-backup-startup-file 'never
- "Whether to create backup files.
+ "Control use of version numbers for backups of `gnus-startup-file'.
This variable takes the same values as the `version-control'
variable."
:version "22.1"
(defconst gnus-level-unsubscribed 7
"Groups with levels less than or equal to this variable are unsubscribed.
-Groups with levels less than `gnus-level-subscribed', which should be
-less than this variable, are subscribed.")
+
+Groups with levels less than `gnus-level-subscribed', which
+should be less than this variable, are subscribed. Groups with
+levels from `gnus-level-subscribed' (exclusive) upto this
+variable (inclusive) are unsubscribed. See also
+`gnus-level-zombie', `gnus-level-killed' and the Info node `(gnus)Group
+Levels' for details.")
(defconst gnus-level-zombie 8
"Groups with this level are zombie groups.")
(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.
options -n no.all alt.all
-Gnus will the subscribe all new newsgroups in these hierarchies with
-the subscription method in this variable."
+Gnus will then subscribe all new newsgroups in these hierarchies
+with the subscription method in this variable."
:group 'gnus-group-new
:type '(radio (function-item gnus-subscribe-randomly)
(function-item gnus-subscribe-alphabetically)
(defcustom gnus-options-subscribe nil
"*All new groups matching this regexp will be subscribed unconditionally.
-Note that this variable deals only with new newsgroups. This variable
+Note that this variable deals only with new newsgroups. This variable
does not affect old newsgroups.
New groups that match this regexp will not be handled by
(defcustom gnus-options-not-subscribe nil
"*All new groups matching this regexp will be ignored.
-Note that this variable deals only with new newsgroups. This variable
+Note that this variable deals only with new newsgroups. This variable
does not affect old (already subscribed) newsgroups."
:group 'gnus-group-new
:type '(choice regexp
: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
:type 'hook)
(defcustom gnus-before-startup-hook nil
- "A hook called at before startup.
+ "A hook called before startup.
This hook is called as the first thing when Gnus is started."
:group 'gnus-start
:type 'hook)
: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)
: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)
;;; Internal variables
+;; Fixme: deal with old emacs-mule when mm-universal-coding-system is
+;; utf-8-emacs.
(defvar gnus-ding-file-coding-system mm-universal-coding-system
"Coding system for ding file.")
(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)
(defun gnus-subscribe-newsgroup (newsgroup &optional next)
"Subscribe new NEWSGROUP.
-If NEXT is non-nil, it is inserted before NEXT. Otherwise it is made
+If NEXT is non-nil, it is inserted before NEXT. Otherwise it is made
the first newsgroup."
(save-excursion
(goto-char (point-min))
;;; General various misc type functions.
;; Silence byte-compiler.
-(eval-when-compile
- (defvar gnus-current-headers)
- (defvar gnus-thread-indent-array)
- (defvar gnus-newsgroup-name)
- (defvar gnus-newsgroup-headers)
- (defvar gnus-group-list-mode)
- (defvar gnus-group-mark-positions)
- (defvar gnus-newsgroup-data)
- (defvar gnus-newsgroup-unreads)
- (defvar nnoo-state-alist)
- (defvar gnus-current-select-method)
- (defvar mail-sources)
- (defvar nnmail-scan-directory-mail-source-once)
- (defvar nnmail-split-history)
- (defvar nnmail-spool-file))
+(defvar gnus-current-headers)
+(defvar gnus-thread-indent-array)
+(defvar gnus-newsgroup-name)
+(defvar gnus-newsgroup-headers)
+(defvar gnus-group-list-mode)
+(defvar gnus-group-mark-positions)
+(defvar gnus-newsgroup-data)
+(defvar gnus-newsgroup-unreads)
+(defvar nnoo-state-alist)
+(defvar gnus-current-select-method)
+(defvar mail-sources)
+(defvar nnmail-scan-directory-mail-source-once)
+(defvar nnmail-split-history)
+(defvar nnmail-spool-file)
(defun gnus-close-all-servers ()
"Close all servers."
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.
(defun gnus-1 (&optional arg dont-connect slave)
"Read network news.
If ARG is non-nil and a positive number, Gnus will use that as the
-startup level. If ARG is non-nil and not a positive number, Gnus will
+startup level. If ARG is non-nil and not a positive number, Gnus will
prompt the user for the name of an NNTP server to use."
(interactive "P")
(when gnus-select-method
(push (cons "native" gnus-select-method)
gnus-predefined-server-alist))
-
+
(if gnus-agent
(gnus-agentize))
(cond
((featurep 'xemacs)
(gnus-xmas-splash))
- ((and window-system
- (= (frame-height) (1+ (window-height))))
+ (window-system
(gnus-x-splash))))
(let ((level (and (numberp arg) (> arg 0) arg))
(defun gnus-start-draft-setup ()
"Make sure the draft group exists."
+ (interactive)
(gnus-request-create-group "drafts" '(nndraft ""))
(unless (gnus-group-entry "nndraft:drafts")
(let ((gnus-level-default-subscribed 1))
;; 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))))
(defun gnus-dribble-read-file ()
"Read the dribble file from disk."
(let ((dribble-file (gnus-dribble-file-name)))
- (save-excursion
- (set-buffer (setq gnus-dribble-buffer
- (gnus-get-buffer-create
- (file-name-nondirectory dribble-file))))
+ (unless (file-exists-p (file-name-directory dribble-file))
+ (make-directory (file-name-directory dribble-file) t))
+ (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)
(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))
(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)))))
(gnus-read-newsrc-file rawfile))
;; Make sure the archive server is available to all and sundry.
- (when gnus-message-archive-method
- (unless (assoc "archive" gnus-server-alist)
- (let ((method (or (and (stringp gnus-message-archive-method)
- (gnus-server-to-method
- gnus-message-archive-method))
- gnus-message-archive-method)))
- ;; Check whether the archive method is writable.
- (unless (or (stringp method)
- (memq 'respool (assoc (format "%s" (car method))
- gnus-valid-select-methods)))
- (setq method "archive")) ;; The default.
- (push (if (stringp method)
- `("archive"
- nnfolder
- ,method
- (nnfolder-directory
- ,(nnheader-concat message-directory method))
- (nnfolder-active-file
- ,(nnheader-concat message-directory
- (concat method "/active")))
- (nnfolder-get-new-mail nil)
- (nnfolder-inhibit-expiry t))
- (cons "archive" method))
- gnus-server-alist))))
+ (let ((method (or (and (stringp gnus-message-archive-method)
+ (gnus-server-to-method
+ gnus-message-archive-method))
+ gnus-message-archive-method)))
+ ;; Check whether the archive method is writable.
+ (unless (or (not method)
+ (stringp method)
+ (memq 'respool (assoc (format "%s" (car method))
+ gnus-valid-select-methods)))
+ (setq method "archive")) ;; The default.
+ (when (stringp method)
+ (setq method `(nnfolder
+ ,method
+ (nnfolder-directory
+ ,(nnheader-concat message-directory method))
+ (nnfolder-active-file
+ ,(nnheader-concat message-directory
+ (concat method "/active")))
+ (nnfolder-get-new-mail nil)
+ (nnfolder-inhibit-expiry t))))
+ (if (assoc "archive" gnus-server-alist)
+ (when gnus-update-message-archive-method
+ (if method
+ (setcdr (assoc "archive" gnus-server-alist) method)
+ (setq gnus-server-alist (delq (assoc "archive" gnus-server-alist)
+ gnus-server-alist))))
+ (when method
+ (push (cons "archive" method) gnus-server-alist))))
;; If we don't read the complete active file, we fill in the
;; hashtb here.
(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))
(setq killed (cdr killed)))))
;; We want to inline a function from gnus-cache, so we cheat here:
+(defvar gnus-cache-active-hashtb)
(eval-when-compile
- (defvar gnus-cache-active-hashtb)
(defun gnus-cache-possibly-alter-active (group active)
"Alter the ACTIVE info for GROUP to reflect the articles in the cache."
(when gnus-cache-active-hashtb
(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))))
(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)
(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))
(defun gnus-get-unread-articles (&optional level)
(setq gnus-server-method-cache nil)
(let* ((newsrc (cdr gnus-newsrc-alist))
- (level (or level gnus-activate-level (1+ gnus-level-subscribed)))
+ (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))
- level))
+ (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)
- scanned-methods info group active method retrieve-groups cmethod
- method-type ignore)
+ (gnus-agent-article-local-times 0)
+ (archive-method (gnus-server-to-method "archive"))
+ infos info group active method cmethod
+ 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.
- (when (setq method (gnus-info-method info))
+ ;; 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)))
- (when (and method
- (not (setq method-type (cdr (assoc method type-cache)))))
+ (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 (cons method method-type) type-cache))
-
- (setq ignore nil)
- (cond ((and method (eq method-type 'foreign))
- ;; These groups are foreign. Check the level.
- (if (<= (gnus-info-level info) foreign-level)
- (when (setq active (gnus-activate-group group 'scan))
- ;; Let the Gnus agent save the active file.
- (when (and gnus-agent active (gnus-online method))
- (gnus-agent-save-group-info
- method (gnus-group-real-name group) active))
- (unless (inline (gnus-virtual-group-p group))
- (inline (gnus-close-group group)))
- (when (fboundp (intern (concat (symbol-name (car method))
- "-request-update-info")))
- (inline (gnus-request-update-info info method))))
- (setq ignore t)))
- ;; These groups are native or secondary.
- ((> (gnus-info-level info) level)
- ;; We don't want these groups.
- (setq active 'ignore))
- ;; Activate groups.
- ((not gnus-read-active-file)
- (if (gnus-check-backend-function 'retrieve-groups group)
- ;; if server support gnus-retrieve-groups we push
- ;; the group onto retrievegroups for later checking
- (if (assoc method retrieve-groups)
- (setcdr (assoc method retrieve-groups)
- (cons group (cdr (assoc method retrieve-groups))))
- (push (list method group) retrieve-groups))
- ;; hack: `nnmail-get-new-mail' changes the mail-source depending
- ;; on the group, so we must perform a scan for every group
- ;; if the users has any directory mail sources.
- ;; hack: if `nnmail-scan-directory-mail-source-once' is non-nil,
- ;; for it scan all spool files even when the groups are
- ;; not required.
- (if (and
- (or nnmail-scan-directory-mail-source-once
- (null (assq 'directory
- (or mail-sources
- (if (listp nnmail-spool-file)
- nnmail-spool-file
- (list nnmail-spool-file))))))
- (member method scanned-methods))
- (setq active (gnus-activate-group group))
- (setq active (gnus-activate-group group 'scan))
- (push method scanned-methods))
- (when active
- (gnus-close-group group)))))
-
- ;; Get the number of unread articles in the group.
- (cond
- ((eq active 'ignore)
- ;; Don't do anything.
- )
- ((and active ignore)
- ;; The level of the foreign group is higher than the specified
- ;; value.
- )
- (active
- (inline (gnus-get-unread-articles-in-group info active t)))
- (t
- ;; The group couldn't be reached, so we nix out the number of
- ;; unread articles and stuff.
- (gnus-set-active group nil)
- (let ((tmp (gnus-group-entry group)))
- &nbs
projects / gnus / blobdiff