;;; gnus-start.el --- startup functions for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
-;; Free Software Foundation, Inc.
+
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;; 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., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(autoload 'gnus-agent-save-local "gnus-agent")
(autoload 'gnus-agent-possibly-alter-active "gnus-agent")
-(eval-when-compile
- (require 'cl)
+(eval-when-compile
+ (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"
:group 'gnus-start
:type '(choice (const :tag "Never" never)
(const :tag "If existing" nil)
the buffer or write directly to the file. The buffer is faster
because all of the contents are written at once. The direct write
uses considerably less memory."
+ :version "22.1"
:group 'gnus-start
:type '(choice (const :tag "Write via buffer" t)
(const :tag "Write directly to file" nil)))
(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.")
(and value (not (stringp value))))
:value t)
(const nil)
- (regexp :format "%t: %v\n" :size 0)))
+ regexp))
(defcustom gnus-ignored-newsgroups
(mapconcat 'identity
(defcustom gnus-subscribe-newsgroup-hooks nil
"*Hooks run after you subscribe to a new group.
The hooks will be called with new group's name as argument."
+ :version "22.1"
:group 'gnus-group-new
:type 'hook)
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
: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)
(defcustom gnus-get-top-new-news-hook nil
"A hook run just before Gnus checks for new news globally."
+ :version "22.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.")
"Subscribe the new GROUP interactively.
It is inserted in hierarchical newsgroup order if subscribed. If not,
it is killed."
- (if (gnus-y-or-n-p (format "Subscribe new newsgroup: %s " group))
+ (if (gnus-y-or-n-p (format "Subscribe new newsgroup %s? " group))
(gnus-subscribe-hierarchically group)
(push group gnus-killed-list)))
(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."
(defun gnus-no-server-1 (&optional arg slave)
"Read network news.
-If ARG is a positive number, Gnus will use that as the
-startup level. If ARG is nil, Gnus will be started at level 2.
-If ARG is non-nil and not a positive number, Gnus will
-prompt the user for the name of an NNTP server to use.
-As opposed to `gnus', this command will not connect to the local server."
+If ARG is a positive number, Gnus will use that as the startup
+level. If ARG is nil, Gnus will be started at level 2
+\(`gnus-level-default-subscribed' minus one). If ARG is non-nil
+and not a positive number, Gnus will prompt the user for the name
+of an NNTP server to use. As opposed to \\[gnus], this command
+will not connect to the local server."
(interactive "P")
(let ((val (or arg (1- gnus-level-default-subscribed))))
(gnus val t slave)
(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")
(nnheader-init-server-buffer)
(setq gnus-slave slave)
(gnus-read-init-file)
+
+ ;; 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))
+
(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))
- (gnus-subscribe-group "nndraft:drafts" nil '(nndraft "")))
+ (gnus-subscribe-group "nndraft:drafts" nil '(nndraft ""))))
+ (unless (equal (gnus-group-get-parameter "nndraft:drafts" 'gnus-dummy t)
+ '((gnus-draft-mode)))
+ (gnus-message 3 "Setting up drafts group")
(gnus-group-set-parameter
"nndraft:drafts" 'gnus-dummy '((gnus-draft-mode)))))
(defun gnus-dribble-read-file ()
"Read the dribble file from disk."
(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))))
+ (set (make-local-variable 'file-precious-flag) t)
(erase-buffer)
(setq buffer-file-name dribble-file)
(auto-save-mode t)
(when (and (file-exists-p gnus-current-startup-file)
(file-exists-p dribble-file)
(setq modes (file-modes gnus-current-startup-file)))
- (set-file-modes dribble-file modes))
+ (gnus-set-file-modes dribble-file modes))
(goto-char (point-min))
(when (search-forward "Gnus was exited on purpose" nil t)
(setq purpose t))
(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)
- (push `("archive"
- nnfolder
- "archive"
- (nnfolder-directory
- ,(nnheader-concat message-directory "archive"))
- (nnfolder-active-file
- ,(nnheader-concat message-directory "archive/active"))
- (nnfolder-get-new-mail nil)
- (nnfolder-inhibit-expiry t))
- 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.
(gnus-check-bogus-newsgroups))
;; We might read in new NoCeM messages here.
- (when (and gnus-use-nocem
- (not level)
- (not dont-connect))
+ (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.
(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
(setcdr active (cdr cache-active))))))))
(defun gnus-activate-group (group &optional scan dont-check method)
- ;; Check whether a group has been activated or not.
- ;; If SCAN, request a scan of that group as well.
+ "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))))
active)
(and (inline (gnus-check-server method))
;; command may have responded with the `(0 . 0)'. We
;; ignore this if we already have an active entry
;; for the group.
- (if (and (zerop (car active))
- (zerop (cdr active))
+ (if (and (zerop (or (car active) 0))
+ (zerop (or (cdr active) 0))
(gnus-active group))
(gnus-active group)
(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
((numberp gnus-activate-foreign-newsgroups)
gnus-activate-foreign-newsgroups)
(t 0))
- level))
+ alevel))
(methods-cache nil)
(type-cache nil)
- scanned-methods info group active method retrieve-groups cmethod
- method-type)
+ (gnus-agent-article-local-times 0)
+ infos info group active method cmethod
+ method-type method-group-list)
(gnus-message 6 "Checking new news...")
(while newsrc
(setq active (gnus-active (setq group (gnus-info-group
- (setq info (pop newsrc))))))
+ (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
;; 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)
(if (setq cmethod (assoc method methods-cache))
(setq method (cdr cmethod))
(setq cmethod (inline (gnus-server-get-method nil method)))
(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)
- 'secondary)
- ((inline (gnus-server-equal gnus-select-method method))
- 'primary)
- (t
- 'foreign)))
- (push (cons method method-type) type-cache))
-
- (cond ((and method (eq method-type 'foreign))
- ;; These groups are foreign. Check the level.
- (if (<= (gnus-info-level info) foreign-level)
- (when (and (<= (gnus-info-level info) foreign-level)
- (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 active 'ignore)))
- ;; 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.
- )
- (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)))
- (when tmp
- (setcar tmp t))))))
-
- ;; iterate through groups on methods which support gnus-retrieve-groups
- ;; and fetch a partial active file and use it to find new news.
- (dolist (rg retrieve-groups)
- (let ((method (or (car rg) gnus-select-method))
- (groups (cdr rg)))
- (when (gnus-check-server method)
- ;; Request that the backend scan its incoming messages.
- (when (gnus-check-backend-function 'request-scan (car method))
- (gnus-request-scan nil method))
- (gnus-read-active-file-2
- (mapcar (lambda (group) (gnus-group-real-name group)) groups)
- method)
- (dolist (group groups)
- (cond
- ((setq active (gnus-active (gnus-info-group
- (setq info (gnus-get-info group)))))
- (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)
- (setcar (gnus-group-entry group) t)))))))
-
+ (cond
+ ((gnus-secondary-method-p method)
+ 'secondary)
+ ((inline (gnus-server-equal gnus-select-method method))
+ 'primary)
+ (t
+ 'foreign)))
+ (push (setq method-group-list (list method method-type nil))
+ type-cache))
+ (setcar (nthcdr 2 method-group-list)
+ (cons info (nth 2 method-group-list))))
+
+ ;; 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
+ ;; Gnus versions.
+ (setq type-cache
+ (sort (nreverse type-cache)
+ (lambda (c1 c2)
+ (< (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)
+
+ (when method
+ ;; 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))))))))
(gnus-message 6 "Checking new news...done")))
+(defun gnus-method-rank (type method)
+ (cond
+ ((eq type 'primary)
+ 1)
+ ;; Compute the rank of the secondary methods based on where they
+ ;; are in the secondary select list.
+ ((eq type 'secondary)
+ (let ((i 2))
+ (block nil
+ (dolist (smethod gnus-secondary-select-methods)
+ (when (equalp method smethod)
+ (return i))
+ (incf i))
+ i)))
+ ;; Just say that all foreign groups have the same rank.
+ (t
+ 100)))
+
+(defun gnus-read-active-for-groups (method infos)
+ (with-current-buffer nntp-server-buffer
+ (cond
+ ((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))
+ ((gnus-check-backend-function 'request-list (car method))
+ (gnus-read-active-file-1 method nil))
+ (t
+ (dolist (info infos)
+ (gnus-activate-group (gnus-info-group info) nil nil method))))))
+
;; Create a hash table out of the newsrc alist. The `car's of the
;; alist elements are used as keys.
(defun gnus-make-hashtable-from-newsrc-alist ()
(let ((alist gnus-newsrc-alist)
(ohashtb gnus-newsrc-hashtb)
- prev)
+ prev info method rest methods)
(setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist)))
(setq alist
(setq prev (setq gnus-newsrc-alist
gnus-newsrc-alist
(cons (list "dummy.group" 0 nil) alist)))))
(while alist
- (gnus-sethash
- (caar alist)
- ;; Preserve number of unread articles in groups.
- (cons (and ohashtb (car (gnus-gethash (caar alist) ohashtb)))
- prev)
- gnus-newsrc-hashtb)
- (setq prev alist
- alist (cdr alist)))))
+ (setq info (car alist))
+ ;; Make the same select-methods identical Lisp objects.
+ (when (setq method (gnus-info-method info))
+ (if (setq rest (member method methods))
+ (gnus-info-set-method info (car rest))
+ (push method methods)))
+ ;; 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
+ (setq method (pop methods))
+ (when (setq rest (rassoc method gnus-server-alist))
+ (setcdr rest method)))))
(defun gnus-make-hashtable-from-killed ()
"Create a hash table from the killed and zombie lists."
(setcdr range (1- article))
(setq modified t)
ranges))))))))
-
+
(when modified
(when (eq modified 'remove-null)
(setq r (delq nil r)))
(while lists
(setq killed (car lists))
(while killed
- (gnus-sethash (car killed) nil hashtb)
+ (gnus-sethash (mm-string-as-unibyte (car killed)) nil hashtb)
(setq killed (cdr killed)))
(setq lists (cdr lists)))))
(gnus-message 5 mesg)
(when (gnus-check-server method)
;; Request that the backend scan its incoming messages.
- (when (gnus-check-backend-function 'request-scan (car method))
+ (when (and gnus-agent
+ (gnus-online method)
+ (gnus-check-backend-function 'request-scan (car method)))
(gnus-request-scan nil method))
(cond
((and (eq gnus-read-active-file 'some)
(if (equal method gnus-select-method)
(gnus-make-hashtable
(count-lines (point-min) (point-max)))
- (gnus-make-hashtable 4096)))))))
+ (gnus-make-hashtable 4096))))))
+ group max min)
;; Delete unnecessary lines.
(goto-char (point-min))
(cond
(insert prefix)
(zerop (forward-line 1)))))))
;; Store the active file in a hash table.
- (goto-char (point-min))
- (let (group max min)
+ ;; Use a unibyte buffer in order to make `read' read non-ASCII
+ ;; group names (which have been encoded) as unibyte strings.
+ (mm-with-unibyte-buffer
+ (insert-buffer-substring cur)
+ (setq cur (current-buffer))
+ (goto-char (point-min))
(while (not (eobp))
(condition-case ()
(progn
(defun gnus-convert-old-newsrc ()
"Convert old newsrc formats into the current format, if needed."
(let ((fcv (and gnus-newsrc-file-version
- (gnus-continuum-version gnus-newsrc-file-version))))
+ (gnus-continuum-version gnus-newsrc-file-version)))
+ (gcv (gnus-continuum-version)))
(when fcv
- ;; A .newsrc.eld file was loaded.
+ ;; A newsrc file was loaded.
(let (prompt-displayed
(converters
(sort
;; doesn't change with each release) and the
;; function that must be applied to convert the
;; previous version into the current version.
- '(("September Gnus v0.1" nil
+ '(("September Gnus v0.1" nil
gnus-convert-old-ticks)
("Oort Gnus v0.08" "legacy-gnus-agent"
gnus-agent-convert-to-compressed-agentview)
- ("No Gnus v0.2" "legacy-gnus-agent"
+ ("Gnus v5.10.7" "legacy-gnus-agent"
gnus-agent-unlist-expire-days)
- ("No Gnus v0.2" "legacy-gnus-agent"
+ ("Gnus v5.10.7" "legacy-gnus-agent"
gnus-agent-unhook-expire-days)))
#'car-less-than-car)))
;; Skip converters older than the file version
;; Perform converters to bring older version up to date.
(when (and converters (< fcv (caar converters)))
- (while (and converters (< fcv (caar converters)))
+ (while (and converters (< fcv (caar converters))
+ (<= (caar converters) gcv))
(let* ((converter-spec (pop converters))
(convert-to (nth 1 converter-spec))
(load-from (nth 2 converter-spec))
(when (and load-from
(not (fboundp func)))
(load load-from t))
-
(or prompt-displayed
(not (gnus-convert-converter-needs-prompt func))
(while (let (c
(cursor-in-echo-area t)
(echo-keystrokes 0))
- (message "Convert newsrc from version '%s' to '%s'? (n/y/?)"
+ (message "Convert gnus from version '%s' to '%s'? (n/y/?)"
gnus-newsrc-file-version gnus-version)
(setq c (read-char-exclusive))
(cond ((or (eq c ?n) (eq c ?N))
- (error "Can not start gnus using old (unconverted) newsrc"))
+ (error "Can not start gnus without converting"))
((or (eq c ?y) (eq c ?Y))
(setq prompt-displayed t)
nil)
((eq c ?\?)
(message "This conversion is irreversible. \
- You should backup your files before proceeding.")
+ To be safe, you should backup your files before proceeding.")
(sit-for 5)
t)
(t
t)))))
(funcall func convert-to)))
- (gnus-dribble-enter
- (format ";Converted newsrc from version '%s' to '%s'? (n/y/?)"
+ (gnus-dribble-enter
+ (format ";Converted gnus from version '%s' to '%s'."
gnus-newsrc-file-version gnus-version)))))))
(defun gnus-convert-mark-converter-prompt (converter no-prompt)
- (setplist converter
- (let* ((symbol 'gnus-convert-no-prompt)
- (value (delq symbol (symbol-plist converter))))
- (if no-prompt
- (cons symbol value)
- value))))
+ "Indicate whether CONVERTER requires gnus-convert-old-newsrc to
+ display the conversion prompt. NO-PROMPT may be nil (prompt),
+ t (no prompt), or any form that can be called as a function.
+ The form should return either t or nil."
+ (put converter 'gnus-convert-no-prompt no-prompt))
(defun gnus-convert-converter-needs-prompt (converter)
- (not (memq 'gnus-convert-no-prompt (symbol-plist converter))))
+ (let ((no-prompt (get converter 'gnus-convert-no-prompt)))
+ (not (if (memq no-prompt '(t nil))
+ no-prompt
+ (funcall no-prompt)))))
(defun gnus-convert-old-ticks (converting-to)
(let ((newsrc (cdr gnus-newsrc-alist))
(eval form))
(error
(unless (eq (car type) 'end-of-file)
- (let ((error (format "Error in %s line %d" file
- (count-lines (point-min) (point)))))
+ (let ((errmsg (format "Error in %s line %d" file
+ (count-lines (point-min) (point)))))
(ding)
- (unless (gnus-yes-or-no-p (concat error "; continue? "))
- (error "%s" error)))))))))
+ (unless (gnus-yes-or-no-p (concat errmsg "; continue? "))
+ (error "%s" errmsg)))))))))
(defun gnus-read-newsrc-el-file (file)
(let ((ding-file (concat file "d")))
;; We always, always read the .eld file.
(gnus-message 5 "Reading %s..." ding-file)
(let (gnus-newsrc-assoc)
- (let ((coding-system-for-read gnus-ding-file-coding-system))
- (gnus-load ding-file))
+ (gnus-load ding-file)
;; Older versions of `gnus-format-specs' are no longer valid
;; in Oort Gnus 0.01.
(let ((version
(setq gnus-format-specs gnus-default-format-specs)))
(when gnus-newsrc-assoc
(setq gnus-newsrc-alist gnus-newsrc-assoc))))
+ (dolist (elem gnus-newsrc-alist)
+ (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
(cond
((looking-at "[0-9]+")
;; We narrow and read a number instead of buffer-substring/
- ;; string-to-int because it's faster. narrow/widen is
+ ;; string-to-number because it's faster. narrow/widen is
;; faster than save-restriction/narrow, and save-restriction
;; produces a garbage object.
(setq num1 (progn
(if (and (eq system-type 'ms-dos)
(not (gnus-long-file-names)))
"%s#%d.tm#" ; MSDOS limits files to 8+3
- (if (memq system-type '(vax-vms axp-vms))
- "%s$tmp$%d"
- "%s#tmp#%d"))
+ "%s#tmp#%d")
working-dir (setq i (1+ i))))
(file-exists-p working-file)))
;; Replace the existing startup file with the temp file.
(rename-file working-file startup-file t)
- (set-file-modes startup-file setmodes)))
+ (gnus-set-file-modes startup-file setmodes)))
(condition-case nil
(delete-file working-file)
(file-error nil)))))
(defun gnus-gnus-to-quick-newsrc-format (&optional minimal name &rest specific-variables)
"Print Gnus variables such as `gnus-newsrc-alist' in Lisp format."
- (princ ";; -*- emacs-lisp -*-\n")
+ (princ (format ";; -*- mode:emacs-lisp; coding: %s; -*-\n"
+ gnus-ding-file-coding-system))
(if name
(princ (format ";; %s\n" name))
(princ ";; Gnus startup file.\n"))
(print-escape-nonascii t)
(print-length nil)
(print-level nil)
+ (print-circle nil)
(print-escape-newlines t)
(gnus-killed-list
(if (and gnus-save-killed-list
(while variables
(when (and (boundp (setq variable (pop variables)))
(symbol-value variable))
- (princ "(setq ")
+ (princ "\n(setq ")
(princ (symbol-name variable))
(princ " '")
(prin1 (symbol-value variable))
(setq default-directory (file-name-directory buffer-file-name))
(buffer-disable-undo)
(erase-buffer)
+ ;; Use a unibyte buffer since group names are unibyte strings;
+ ;; in particular, non-ASCII group names are the ones encoded by
+ ;; a certain coding system.
+ (mm-disable-multibyte)
;; Write options.
(when gnus-newsrc-options
(insert gnus-newsrc-options))
(delete-file gnus-startup-file)
(clear-visited-file-modtime))
(gnus-run-hooks 'gnus-save-standard-newsrc-hook)
- (save-buffer)
+ (let ((coding-system-for-write 'raw-text))
+ (save-buffer))
(kill-buffer (current-buffer)))))
\f
(defun gnus-slave-mode ()
"Minor mode for slave Gnusae."
+ ;; FIXME: gnus-slave-mode appears to never be set (i.e. it'll always be nil):
+ ;; Remove, or fix and use define-minor-mode.
(add-minor-mode 'gnus-slave-mode " Slave" (make-sparse-keymap))
(gnus-run-hooks 'gnus-slave-mode-hook))
(let ((coding-system-for-write gnus-ding-file-coding-system))
(gnus-write-buffer slave-name))
(when modes
- (set-file-modes slave-name modes)))))
+ (gnus-set-file-modes slave-name modes)))))
(defun gnus-master-read-slave-newsrc ()
(let ((slave-files
nil)
(t
(save-excursion
+ ;; FIXME: Shouldn't save-restriction be done after set-buffer?
(save-restriction
(set-buffer nntp-server-buffer)
(goto-char (point-min))
(file-name-as-directory (expand-file-name gnus-default-directory))
default-directory)))
-(eval-and-compile
-(defalias 'gnus-display-time-event-handler
- (if (gnus-boundp 'display-time-timer)
- 'display-time-event-handler
- (lambda () "Does nothing as `display-time-timer' is not bound.
-Would otherwise be an alias for `display-time-event-handler'." nil))))
+(defun gnus-display-time-event-handler ()
+ (if (and (fboundp 'display-time-event-handler)
+ (gnus-boundp 'display-time-timer))
+ (display-time-event-handler)))
;;;###autoload
(defun gnus-fixup-nnimap-unread-after-getting-new-news ()
(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
+ (if (fboundp 'display-warning)
+ 'display-warning
+ (lambda (type message)
+ (if noninteractive
+ (message "Warning (%s): %s" type message)
+ (let (window)
+ (with-current-buffer (get-buffer-create "*Warnings*")
+ (goto-char (point-max))
+ (unless (bolp)
+ (insert "\n"))
+ (insert (format "Warning (%s): %s\n" type message))
+ (setq window (display-buffer (current-buffer)))
+ (set-window-start
+ window
+ (prog2
+ (forward-line (- 1 (window-height window)))
+ (point)
+ (goto-char (point-max))))))))))
+ method active actives match)
+ (dolist (server gnus-server-alist)
+ (setq method (gnus-server-to-method server)
+ active (intern (format "%s-active-file" (car method))))
+ (when (and (member (car method) '(nnml nnfolder))
+ (gnus-server-opened method)
+ (boundp active))
+ (when (setq match (assoc (symbol-value active) actives))
+ (funcall display-warn 'gnus-server
+ (format "%s and %s share the same active file %s"
+ (car method)
+ (cadr match)
+ (car match))))
+ (push (list (symbol-value active) method) actives)))))
(provide 'gnus-start)
-;;; arch-tag: f4584a22-b7b7-4853-abfc-a637329af5d2
;;; gnus-start.el ends here
-
-
projects / gnus / blobdiff