;;; 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 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;; 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.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
(require 'gnus-util)
(autoload 'message-make-date "message")
(autoload 'gnus-agent-read-servers-validate "gnus-agent")
-(autoload 'gnus-agent-load-alist "gnus-agent")
-(eval-when-compile (require 'cl))
+(autoload 'gnus-agent-save-local "gnus-agent")
+(autoload 'gnus-agent-possibly-alter-active "gnus-agent")
+
+(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))
(defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc")
"Your `.newsrc' file.
"Whether to create backup files.
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)))
(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)
(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)
(defun gnus-subscribe-hierarchical-interactive (groups)
(let ((groups (sort groups 'string<))
- prefixes prefix start ans group starts)
+ prefixes prefix start ans group starts real-group)
(while groups
(setq prefixes (list "^"))
(while (and groups prefixes)
- (while (not (string-match (car prefixes) (car groups)))
+ (while (not (string-match (car prefixes)
+ (gnus-group-real-name (car groups))))
(setq prefixes (cdr prefixes)))
(setq prefix (car prefixes))
(setq start (1- (length prefix)))
- (if (and (string-match "[^\\.]\\." (car groups) start)
+ (if (and (string-match "[^\\.]\\." (gnus-group-real-name (car groups))
+ start)
(cdr groups)
(setq prefix
- (concat "^" (substring (car groups) 0 (match-end 0))))
- (string-match prefix (cadr groups)))
+ (concat "^" (substring
+ (gnus-group-real-name (car groups))
+ 0 (match-end 0))))
+ (string-match prefix (gnus-group-real-name (cadr groups))))
(progn
(push prefix prefixes)
(message "Descend hierarchy %s? ([y]nsq): "
(substring prefix 1 (1- (length prefix)))))
(cond ((= ans ?n)
(while (and groups
- (string-match prefix
- (setq group (car groups))))
+ (setq group (car groups)
+ real-group (gnus-group-real-name group))
+ (string-match prefix real-group))
(push group gnus-killed-list)
(gnus-sethash group group gnus-killed-hashtb)
(setq groups (cdr groups)))
(setq starts (cdr starts)))
((= ans ?s)
(while (and groups
- (string-match prefix
- (setq group (car groups))))
+ (setq group (car groups)
+ real-group (gnus-group-real-name group))
+ (string-match prefix real-group))
(gnus-sethash group group gnus-killed-hashtb)
(gnus-subscribe-alphabetically (car groups))
(setq groups (cdr groups)))
"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)))
;; We subscribe the group by changing its level to `subscribed'.
(gnus-group-change-level
newsgroup gnus-level-default-subscribed
- gnus-level-killed (gnus-gethash (or next "dummy.group")
- gnus-newsrc-hashtb))
+ gnus-level-killed (gnus-group-entry (or next "dummy.group")))
(gnus-message 5 "Subscribe newsgroup: %s" newsgroup)
(run-hook-with-args 'gnus-subscribe-newsgroup-hooks newsgroup)
t))
(setq gnus-list-of-killed-groups nil
gnus-have-read-active-file nil
gnus-agent-covered-methods nil
+ gnus-agent-file-loading-local nil
+ gnus-agent-file-loading-cache nil
+ gnus-server-method-cache nil
gnus-newsrc-alist nil
gnus-newsrc-hashtb nil
gnus-killed-list nil
(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))
(when (or gnus-slave gnus-use-dribble-file)
(gnus-dribble-read-file))
- ;; Allow using GroupLens predictions.
- (when gnus-use-grouplens
- (bbb-login)
- (add-hook 'gnus-summary-mode-hook 'gnus-grouplens-mode))
-
;; Do the actual startup.
(if gnus-agent
(gnus-request-create-group "queue" '(nndraft "")))
(defun gnus-start-draft-setup ()
"Make sure the draft group exists."
(gnus-request-create-group "drafts" '(nndraft ""))
- (unless (gnus-gethash "nndraft:drafts" gnus-newsrc-hashtb)
+ (unless (gnus-group-entry "nndraft:drafts")
(let ((gnus-level-default-subscribed 1))
(gnus-subscribe-group "nndraft:drafts" nil '(nndraft "")))
(gnus-group-set-parameter
(set-buffer (setq gnus-dribble-buffer
(gnus-get-buffer-create
(file-name-nondirectory dribble-file))))
+ (make-variable-buffer-local file-precious-flag)
+ (setq 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))
;; 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 (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))))
;; If we don't read the complete active file, we fill in the
;; hashtb here.
(when (and (stringp entry)
oldlevel
(< oldlevel gnus-level-zombie))
- (setq entry (gnus-gethash entry gnus-newsrc-hashtb)))
+ (setq entry (gnus-group-entry entry)))
(if (and (not oldlevel)
(consp entry))
(setq oldlevel (gnus-info-level (nth 2 entry)))
(setq oldlevel (or oldlevel gnus-level-killed)))
(when (stringp previous)
- (setq previous (gnus-gethash previous gnus-newsrc-hashtb)))
+ (setq previous (gnus-group-entry previous)))
(if (and (>= oldlevel gnus-level-zombie)
- (gnus-gethash group gnus-newsrc-hashtb))
+ (gnus-group-entry group))
;; We are trying to subscribe a group that is already
;; subscribed.
() ; Do nothing.
entry)
(gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb)
(when (nth 3 entry)
- (setcdr (gnus-gethash (car (nth 3 entry))
- gnus-newsrc-hashtb)
+ (setcdr (gnus-group-entry (car (nth 3 entry)))
(cdr entry)))
(setcdr (cdr entry) (cdddr entry)))))
(gnus-sethash group (cons num previous)
gnus-newsrc-hashtb))
(when (cdr entry)
- (setcdr (gnus-gethash (caadr entry) gnus-newsrc-hashtb) entry))
+ (setcdr (gnus-group-entry (caadr entry)) entry))
(gnus-dribble-enter
(format
"(gnus-group-set-info '%S)" info)))))
(defun gnus-kill-newsgroup (newsgroup)
"Obsolete function. Kills a newsgroup."
(gnus-group-change-level
- (gnus-gethash newsgroup gnus-newsrc-hashtb) gnus-level-killed))
+ (gnus-group-entry newsgroup) gnus-level-killed))
(defun gnus-check-bogus-newsgroups (&optional confirm)
"Remove bogus newsgroups.
(lambda (group)
;; Remove all bogus subscribed groups by first killing them, and
;; then removing them from the list of killed groups.
- (when (setq entry (gnus-gethash group gnus-newsrc-hashtb))
+ (when (setq entry (gnus-group-entry group))
(gnus-group-change-level entry gnus-level-killed)
(setq gnus-killed-list (delete group gnus-killed-list))))
bogus '("group" "groups" "remove"))
(while (setq group (pop bogus))
;; Remove all bogus subscribed groups by first killing them, and
;; then removing them from the list of killed groups.
- (when (setq entry (gnus-gethash group gnus-newsrc-hashtb))
+ (when (setq entry (gnus-group-entry group))
(gnus-group-change-level entry gnus-level-killed)
(setq gnus-killed-list (delete group gnus-killed-list)))))
;; Then we remove all bogus groups from the list of killed and
(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)
- (when (and gnus-agent
- (gnus-agent-method-p method))
- ;; The agent may be storing articles that are no longer in the
- ;; server's active range. If that is the case, the active range
- ;; needs to be expanded such that the agent's articles can be
- ;; included in the summary.
- (let* ((gnus-command-method method)
- (alist (gnus-agent-load-alist group)))
- (if (and (car alist)
- (< (caar alist) (car active)))
- (setcar active (caar alist)))))
+ ;; If a cache is present, we may have to alter the active info.
+ (when gnus-use-cache
+ (inline (gnus-cache-possibly-alter-active
+ group active)))
+
+ ;; If the agent is enabled, we may have to alter the active info.
+ (when gnus-agent
+ (gnus-agent-possibly-alter-active group active))
(gnus-set-active group active)
;; Return the new active info.
active)))))
(defun gnus-get-unread-articles-in-group (info active &optional update)
- (when active
+ (when (and info active)
;; Allow the backend to update the info in the group.
(when (and update
(gnus-request-update-info
(let* ((range (gnus-info-read info))
(num 0))
+
+ ;; These checks are present in gnus-activate-group but skipped
+ ;; due to setting dont-check in the preceeding call.
+
;; If a cache is present, we may have to alter the active info.
(when (and gnus-use-cache info)
(inline (gnus-cache-possibly-alter-active
(gnus-info-group info) active)))
+
+ ;; If the agent is enabled, we may have to alter the active info.
+ (when (and gnus-agent info)
+ (gnus-agent-possibly-alter-active (gnus-info-group info) active info))
+
;; Modify the list of read articles according to what articles
;; are available; then tally the unread articles and add the
;; number to the group hash table entry.
(setq num (max 0 (- (cdr active) num)))))
;; Set the number of unread articles.
(when (and info
- (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb))
- (setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num))
+ (gnus-group-entry (gnus-info-group info)))
+ (setcar (gnus-group-entry (gnus-info-group info)) num))
num)))
;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb'
gnus-activate-foreign-newsgroups)
(t 0))
level))
- scanned-methods info group active method retrieve-groups)
+ (methods-cache nil)
+ (type-cache nil)
+ scanned-methods info group active method retrieve-groups cmethod
+ method-type ignore)
(gnus-message 6 "Checking new news...")
(while newsrc
;; 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.
- (if (and (setq method (gnus-info-method info))
- (not (inline
- (gnus-server-equal
- gnus-select-method
- (setq method (gnus-server-get-method nil method)))))
- (not (gnus-secondary-method-p method)))
- ;; These groups are foreign. Check the 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))))
- ;; These groups are native or secondary.
- (cond
- ;; We don't want these groups.
- ((> (gnus-info-level info) level)
- (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))))))
+ (when (setq method (gnus-info-method info))
+ (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-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))
+
+ (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-gethash group gnus-newsrc-hashtb)))
+ (let ((tmp (gnus-group-entry group)))
(when tmp
(setcar tmp 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-gethash group gnus-newsrc-hashtb) t)))))))
+ (setcar (gnus-group-entry group) t)))))))
(gnus-message 6 "Checking new news...done")))
(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
+ (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)))
(gnus-sethash
- (caar alist)
+ (car info)
;; Preserve number of unread articles in groups.
- (cons (and ohashtb (car (gnus-gethash (caar alist) ohashtb)))
+ (cons (and ohashtb (car (gnus-gethash (car info) ohashtb)))
prev)
gnus-newsrc-hashtb)
(setq prev alist
- alist (cdr alist)))))
+ 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."
(defun gnus-make-articles-unread (group articles)
"Mark ARTICLES in GROUP as unread."
- (let* ((info (nth 2 (or (gnus-gethash group gnus-newsrc-hashtb)
- (gnus-gethash (gnus-group-real-name group)
- gnus-newsrc-hashtb))))
+ (let* ((info (nth 2 (or (gnus-group-entry group)
+ (gnus-group-entry
+ (gnus-group-real-name group)))))
(ranges (gnus-info-read info))
news article)
(while articles
(defun gnus-make-ascending-articles-unread (group articles)
"Mark ascending ARTICLES in GROUP as unread."
- (let* ((entry (or (gnus-gethash group gnus-newsrc-hashtb)
- (gnus-gethash (gnus-group-real-name group)
- gnus-newsrc-hashtb)))
+ (let* ((entry (or (gnus-group-entry group)
+ (gnus-group-entry (gnus-group-real-name group))))
(info (nth 2 entry))
(ranges (gnus-info-read info))
(r ranges)
(setcdr range (1- article))
(setq modified t)
ranges))))))))
-
+
(when modified
(when (eq modified 'remove-null)
(setq r (delq nil r)))
(while (setq info (pop newsrc))
(when (inline
(gnus-server-equal
- (inline
- (gnus-find-method-for-group
- (gnus-info-group info) info))
- gmethod))
+ (inline
+ (gnus-find-method-for-group
+ (gnus-info-group info) info))
+ gmethod))
(push (gnus-group-real-name (gnus-info-group info))
groups)))
(gnus-read-active-file-2 groups method)))
(while (not (eobp))
(condition-case ()
(progn
- (narrow-to-region (point) (gnus-point-at-eol))
+ (narrow-to-region (point) (point-at-eol))
;; group gets set to a symbol interned in the hash table
;; (what a hack!!) - jwz
(setq group (let ((obarray hashtb)) (read cur)))
(unless ignore-errors
(gnus-message 3 "Warning - invalid active: %s"
(buffer-substring
- (gnus-point-at-bol) (gnus-point-at-eol))))))
+ (point-at-bol) (point-at-eol))))))
(widen)
(forward-line 1)))))
(gnus-online method)
(gnus-agent-method-p method))
(progn
- (gnus-agent-save-groups method)
+ (gnus-agent-save-active method)
(gnus-active-to-gnus-format method hashtb nil real-active))
(goto-char (point-min))
(gnus-convert-old-newsrc))))
(defun gnus-convert-old-newsrc ()
- "Convert old newsrc into the new format, if needed."
+ "Convert old newsrc formats into the current format, if needed."
(let ((fcv (and gnus-newsrc-file-version
- (gnus-continuum-version gnus-newsrc-file-version))))
- (cond
- ;; No .newsrc.eld file was loaded.
- ((null fcv) nil)
- ;; Gnus 5 .newsrc.eld was loaded.
- ((< fcv (gnus-continuum-version "September Gnus v0.1"))
- (gnus-convert-old-ticks)))))
-
-(defun gnus-convert-old-ticks ()
+ (gnus-continuum-version gnus-newsrc-file-version)))
+ (gcv (gnus-continuum-version)))
+ (when fcv
+ ;; A newsrc file was loaded.
+ (let (prompt-displayed
+ (converters
+ (sort
+ (mapcar (lambda (date-func)
+ (cons (gnus-continuum-version (car date-func))
+ date-func))
+ ;; This is a list of converters that must be run
+ ;; to bring the newsrc file up to the current
+ ;; version. If you create an incompatibility
+ ;; with older versions, you should create an
+ ;; entry here. The entry should consist of the
+ ;; current gnus version (hardcoded so that it
+ ;; 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
+ gnus-convert-old-ticks)
+ ("Oort Gnus v0.08" "legacy-gnus-agent"
+ gnus-agent-convert-to-compressed-agentview)
+ ("Gnus v5.10.7" "legacy-gnus-agent"
+ gnus-agent-unlist-expire-days)
+ ("Gnus v5.10.7" "legacy-gnus-agent"
+ gnus-agent-unhook-expire-days)))
+ #'car-less-than-car)))
+ ;; Skip converters older than the file version
+ (while (and converters (>= fcv (caar converters)))
+ (pop converters))
+
+ ;; Perform converters to bring older version up to date.
+ (when (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))
+ (func (nth 3 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 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 without converting"))
+ ((or (eq c ?y) (eq c ?Y))
+ (setq prompt-displayed t)
+ nil)
+ ((eq c ?\?)
+ (message "This conversion is irreversible. \
+ To be safe, you should backup your files before proceeding.")
+ (sit-for 5)
+ t)
+ (t
+ (gnus-message 3 "Ignoring unexpected input")
+ (sit-for 3)
+ t)))))
+
+ (funcall func convert-to)))
+ (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)
+ "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)
+ (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))
marks info dormant ticked)
(while (setq info (pop newsrc))
;; don't give a damn, frankly, my dear.
(concat gnus-newsrc-options
(buffer-substring
- (gnus-point-at-bol)
+ (point-at-bol)
;; Options may continue on the next line.
(or (and (re-search-forward "^[^ \t]" nil 'move)
- (progn (beginning-of-line) (point)))
+ (point-at-bol))
(point)))))
(forward-line -1))
(symbol
(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
;; The line was buggy.
(setq group nil)
(gnus-error 3.1 "Mangled line: %s"
- (buffer-substring (gnus-point-at-bol)
- (gnus-point-at-eol))))
+ (buffer-substring (point-at-bol)
+ (point-at-eol))))
nil))
;; Skip past ", ". Spaces are invalid in these ranges, but
;; we allow them, because it's a common mistake to put a
(while (re-search-forward "[ \t]-n" nil t)
(setq eol
(or (save-excursion
- (and (re-search-forward "[ \t]-n" (gnus-point-at-eol) t)
+ (and (re-search-forward "[ \t]-n" (point-at-eol) t)
(- (point) 2)))
- (gnus-point-at-eol)))
+ (point-at-eol)))
;; Search for all "words"...
(while (re-search-forward "[^ \t,\n]+" eol t)
(if (eq (char-after (match-beginning 0)) ?!)
;; from the variable gnus-newsrc-alist.
(when (and (or gnus-newsrc-alist gnus-killed-list)
gnus-current-startup-file)
+ ;; Save agent range limits for the currently active method.
+ (when gnus-agent
+ (gnus-agent-save-local force))
+
(save-excursion
(if (and (or gnus-use-dribble-file gnus-slave)
(not force)
(gnus-message 8 "Saving %s..." gnus-current-startup-file)
(gnus-gnus-to-newsrc-format)
(gnus-message 8 "Saving %s...done" gnus-current-startup-file))
+
;; Save .newsrc.eld.
(set-buffer (gnus-get-buffer-create " *Gnus-newsrc*"))
(make-local-variable 'version-control)
;; 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-slave-mode ()
"Minor mode for slave Gnusae."
- (gnus-add-minor-mode 'gnus-slave-mode " Slave" (make-sparse-keymap))
+ (add-minor-mode 'gnus-slave-mode " Slave" (make-sparse-keymap))
(gnus-run-hooks 'gnus-slave-mode-hook))
(defun gnus-slave-save-newsrc ()
(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
(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