;;; gnus-start.el --- startup functions for Gnus
-;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
+;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;;; Code:
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'static))
+
(require 'gnus)
(require 'gnus-win)
(require 'gnus-int)
(require 'gnus-spec)
(require 'gnus-range)
(require 'gnus-util)
-(require 'message)
-(eval-when-compile (require 'cl))
+(autoload 'message-make-date "message")
+(autoload 'gnus-agent-read-servers-validate "gnus-agent")
+(autoload 'gnus-agent-save-local "gnus-agent")
+(autoload 'gnus-agent-possibly-alter-active "gnus-agent")
+(eval-when-compile
+ (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.
:group 'gnus-start
:type 'file)
+(defcustom gnus-product-directory
+ (nnheader-concat gnus-directory (concat "." gnus-product-name))
+ "Product depend data files directory."
+ :group 'gnus-start
+ :type '(choice directory (const nil)))
+
+(defcustom gnus-backup-startup-file 'never
+ "Whether to create backup files.
+This variable takes the same values as the `version-control'
+variable."
+ :version "21.4"
+ :group 'gnus-start
+ :type '(choice (const :tag "Never" never)
+ (const :tag "If existing" nil)
+ (other :tag "Always" t)))
+
+(defcustom gnus-save-startup-file-via-temp-buffer t
+ "Whether to write the startup file contents to a buffer then save
+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 "21.4"
+ :group 'gnus-start
+ :type '(choice (const :tag "Write via buffer" t)
+ (const :tag "Write directly to file" nil)))
+
(defcustom gnus-init-file (nnheader-concat gnus-home-directory ".gnus")
"Your Gnus Emacs-Lisp startup file name.
If a file with the `.el' or `.elc' suffixes exists, it will be read instead."
(directory-file-name installation-directory))
"site-lisp/gnus-init")
(error nil))
- "*The site-wide Gnus Emacs-Lisp startup file name, or nil if none.
+ "The site-wide Gnus Emacs-Lisp startup file name, or nil if none.
If a file with the `.el' or `.elc' suffixes exists, it will be read instead."
:group 'gnus-start
:type '(choice file (const nil)))
(const some)
(const t)))
-(defcustom gnus-level-subscribed 5
- "*Groups with levels less than or equal to this variable are subscribed."
- :group 'gnus-group-levels
- :type 'integer)
+(defconst gnus-level-subscribed 5
+ "Groups with levels less than or equal to this variable are subscribed.")
-(defcustom gnus-level-unsubscribed 7
- "*Groups with levels less than or equal to this variable are unsubscribed.
+(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."
- :group 'gnus-group-levels
- :type 'integer)
+less than this variable, are subscribed.")
-(defcustom gnus-level-zombie 8
- "*Groups with this level are zombie groups."
- :group 'gnus-group-levels
- :type 'integer)
+(defconst gnus-level-zombie 8
+ "Groups with this level are zombie groups.")
-(defcustom gnus-level-killed 9
- "*Groups with this level are killed."
- :group 'gnus-group-levels
- :type 'integer)
+(defconst gnus-level-killed 9
+ "Groups with this level are killed.")
(defcustom gnus-level-default-subscribed 3
"*New subscribed groups will be subscribed at this level."
:type '(choice integer
(const :tag "none" nil)))
+(defcustom gnus-read-newsrc-file t
+ "*Non-nil means that Gnus will read the `.newsrc' file.
+Gnus always reads its own startup file, which is called
+\".newsrc.eld\". The file called \".newsrc\" is in a format that can
+be readily understood by other newsreaders. If you don't plan on
+using other newsreaders, set this variable to nil to save some time on
+entry."
+ :version "21.1"
+ :group 'gnus-newsrc
+ :type 'boolean)
+
(defcustom gnus-save-newsrc-file t
"*Non-nil means that Gnus will save the `.newsrc' file.
Gnus always saves its own startup file, which is called
This variable can also be a regexp. In that case, all groups that do
not match this regexp will be removed before saving the list."
:group 'gnus-newsrc
- :type 'boolean)
+ :type '(radio (sexp :format "Non-nil\n"
+ :match (lambda (widget value)
+ (and value (not (stringp value))))
+ :value t)
+ (const nil)
+ (regexp :format "%t: %v\n" :size 0)))
(defcustom gnus-ignored-newsgroups
- (purecopy (mapconcat 'identity
- '("^to\\." ; not "real" groups
- "^[0-9. \t]+ " ; all digits in name
- "[][\"#'()]" ; bogus characters
- )
- "\\|"))
+ (mapconcat 'identity
+ '("^to\\." ; not "real" groups
+ "^[0-9. \t]+\\( \\|$\\)" ; all digits in name
+ "^[\"][]\"[#'()]" ; bogus characters
+ )
+ "\\|")
"*A regexp to match uninteresting newsgroups in the active file.
Any lines in the active file matching this regular expression are
removed from the newsgroup list before anything else is done to it,
:type 'regexp)
(defcustom gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies
- "*Function called with a group name when new group is detected.
+ "*Function(s) called with a group name when new group is detected.
A few pre-made functions are supplied: `gnus-subscribe-randomly'
inserts new groups at the beginning of the list of groups;
`gnus-subscribe-alphabetically' inserts new groups in strict
alphabetic order; `gnus-subscribe-hierarchically' inserts new groups
in hierarchical newsgroup order; `gnus-subscribe-interactively' asks
for your decision; `gnus-subscribe-killed' kills all new groups;
-`gnus-subscribe-zombies' will make all new groups into zombies."
+`gnus-subscribe-zombies' will make all new groups into zombies;
+`gnus-subscribe-topics' will enter groups into the topics that
+claim them."
:group 'gnus-group-new
:type '(radio (function-item gnus-subscribe-randomly)
(function-item gnus-subscribe-alphabetically)
(function-item gnus-subscribe-interactively)
(function-item gnus-subscribe-killed)
(function-item gnus-subscribe-zombies)
- function))
+ (function-item gnus-subscribe-topics)
+ function
+ (repeat function)))
+
+(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."
+ :group 'gnus-group-new
+ :type 'hook)
(defcustom gnus-subscribe-options-newsgroup-method
'gnus-subscribe-alphabetically
- "*This function is called to subscribe newsgroups mentioned on \"options -n\" lines.
+ "*Function(s) called to subscribe newsgroups mentioned on \"options -n\" lines.
If, for instance, you want to subscribe to all newsgroups in the
\"no\" and \"alt\" hierarchies, you'd put the following in your
.newsrc file:
(function-item gnus-subscribe-interactively)
(function-item gnus-subscribe-killed)
(function-item gnus-subscribe-zombies)
- function))
+ (function-item gnus-subscribe-topics)
+ function
+ (repeat function)))
(defcustom gnus-subscribe-hierarchical-interactive nil
"*If non-nil, Gnus will offer to subscribe hierarchically.
:type 'boolean)
(defcustom gnus-auto-subscribed-groups
- "nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl"
+ "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl\\|^nnmaildir"
"*All new groups that match this regexp will be subscribed automatically.
Note that this variable only deals with new groups. It has no effect
whatsoever on old groups.
:group 'gnus-start
:type 'hook)
-(defcustom gnus-setup-news-hook nil
+(defcustom gnus-setup-news-hook
+ '(gnus-fixup-nnimap-unread-after-getting-new-news)
"A hook after reading the .newsrc file, but before generating the buffer."
:group 'gnus-start
:type 'hook)
+(defcustom gnus-get-top-new-news-hook nil
+ "A hook run just before Gnus checks for new news globally."
+ :group 'gnus-group-new
+ :type 'hook)
+
(defcustom gnus-get-new-news-hook nil
"A hook run just before Gnus checks for new news."
:group 'gnus-group-new
:type 'hook)
(defcustom gnus-after-getting-new-news-hook
- (when (gnus-boundp 'display-time-timer)
- '(display-time-event-handler))
- "*A hook run after Gnus checks for new news."
+ '(gnus-display-time-event-handler
+ gnus-fixup-nnimap-unread-after-getting-new-news)
+ "A hook run after Gnus checks for new news when Gnus is already running."
:group 'gnus-group-new
:type 'hook)
+(defcustom gnus-read-newsrc-el-hook nil
+ "A hook called after reading the newsrc.eld? file."
+ :group 'gnus-newsrc
+ :type 'hook)
+
(defcustom gnus-save-newsrc-hook nil
"A hook called before saving any of the newsrc files."
:group 'gnus-newsrc
:group 'gnus-newsrc
:type 'hook)
+(defcustom gnus-group-mode-hook nil
+ "Hook for Gnus group mode."
+ :group 'gnus-group-various
+ :options '(gnus-topic-mode)
+ :type 'hook)
+
(defcustom gnus-always-read-dribble-file nil
- "Uncoditionally read the dribble file."
+ "Unconditionally read the dribble file."
:group 'gnus-newsrc
:type 'boolean)
-(defvar gnus-startup-file-coding-system 'ctext
- "*Coding system for startup file.")
-
;;; Internal variables
+(defvar gnus-ding-file-coding-system 'ctext
+ "Coding system for ding file.")
+;; Note that the ding file for T-gnus ought not to have byte-codes.
+
(defvar gnus-newsrc-file-version nil)
(defvar gnus-override-subscribe-method nil)
(defvar gnus-dribble-buffer nil)
(if gnus-init-inhibit
(setq gnus-init-inhibit nil)
(setq gnus-init-inhibit inhibit-next)
- (let ((files (list gnus-site-init-file gnus-init-file))
- file)
- (while files
- (and (setq file (pop files))
- (or (and (file-exists-p file)
- ;; Don't try to load a directory.
- (not (file-directory-p file)))
- (file-exists-p (concat file ".el"))
- (file-exists-p (concat file ".elc")))
- (condition-case var
- (load file nil t)
- (error
- (error "Error in %s: %s" file var)))))))))
+ (dolist (file (list gnus-site-init-file gnus-init-file))
+ (when (and file
+ (locate-library file))
+ (if (or debug-on-error debug-on-quit)
+ (load file nil t)
+ (condition-case var
+ (load file nil t)
+ (error
+ (error "Error in %s: %s" file (cadr var))))))))))
;; For subscribing new newsgroup
(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)))
(gnus-subscribe-newsgroup newsgroup))
(defun gnus-subscribe-alphabetically (newgroup)
- "Subscribe new NEWSGROUP and insert it in alphabetical order."
+ "Subscribe new NEWGROUP and insert it in alphabetical order."
(let ((groups (cdr gnus-newsrc-alist))
before)
(while (and (not before) groups)
(gnus-subscribe-newsgroup newgroup before)))
(defun gnus-subscribe-hierarchically (newgroup)
- "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order."
+ "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))
- (let ((groupkey newgroup)
- before)
- (while (and (not before) groupkey)
- (goto-char (point-min))
- (let ((groupkey-re
- (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
- (while (and (re-search-forward groupkey-re nil t)
- (progn
- (setq before (match-string 1))
- (string< before newgroup)))))
- ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
- (setq groupkey
- (when (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
- (substring groupkey (match-beginning 1) (match-end 1)))))
- (gnus-subscribe-newsgroup newgroup before))
- (kill-buffer (current-buffer))))
+ (prog1
+ (let ((groupkey newgroup) before)
+ (while (and (not before) groupkey)
+ (goto-char (point-min))
+ (let ((groupkey-re
+ (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
+ (while (and (re-search-forward groupkey-re nil t)
+ (progn
+ (setq before (match-string 1))
+ (string< before newgroup)))))
+ ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
+ (setq groupkey
+ (when (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
+ (substring groupkey (match-beginning 1) (match-end 1)))))
+ (gnus-subscribe-newsgroup newgroup before))
+ (kill-buffer (current-buffer)))))
(defun gnus-subscribe-interactively (group)
"Subscribe the new GROUP interactively.
;; 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-message 5 "Subscribe newsgroup: %s" newsgroup)))
+ 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))
(defun gnus-read-active-file-p ()
"Say whether the active file has been read from `gnus-select-method'."
;;; General various misc type functions.
;; Silence byte-compiler.
-(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)
-
-(defun gnus-clear-system ()
- "Clear all variables and buffers."
- ;; Clear Gnus variables.
+(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))
+
+(defun gnus-clear-quick-file-variables ()
+ "Clear all variables in quick startup files."
(let ((variables gnus-variable-list))
+ ;; Clear Gnus variables.
(while variables
(set (car variables) nil)
(setq variables (cdr variables))))
+ (let ((files gnus-product-variable-file-list))
+ (while files
+ (let ((variables (nthcdr 3 (car files))))
+ (while variables
+ (set (car variables) nil)
+ (setq variables (cdr variables))))
+ (setq files (cdr files)))))
+
+(defun gnus-close-all-servers ()
+ "Close all servers."
+ (interactive)
+ (dolist (server gnus-opened-servers)
+ (gnus-close-server (car server))))
+
+(defun gnus-clear-system ()
+ "Clear all variables and buffers."
+ ;; Clear gnus variables.
+ (gnus-clear-quick-file-variables)
;; Clear other internal variables.
(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
gnus-newsgroup-unreads nil
nnoo-state-alist nil
gnus-current-select-method nil
+ nnmail-split-history nil
gnus-ephemeral-servers nil)
(gnus-shutdown 'gnus)
;; Kill the startup file.
(kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil))))
(gnus-kill-buffer nntp-server-buffer)
;; Kill Gnus buffers.
- (let ((buffers (gnus-buffers)))
- (when buffers
- (mapcar 'kill-buffer buffers)))
+ (dolist (buffer (gnus-buffers))
+ (gnus-kill-buffer buffer))
;; Remove Gnus frames.
(gnus-kill-gnus-frames))
(nnheader-init-server-buffer)
(setq gnus-slave slave)
(gnus-read-init-file)
+ (if gnus-agent
+ (gnus-agentize))
(when gnus-simple-splash
(setq gnus-simple-splash nil)
(cond
- (gnus-xemacs
+ ((featurep 'xemacs)
(gnus-xmas-splash))
- ((and (eq window-system 'x)
+ ((and window-system
(= (frame-height) (1+ (window-height))))
(gnus-x-splash))))
(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 "")))
+ (gnus-request-create-group "drafts" '(nndraft ""))
(gnus-setup-news nil level dont-connect)
(gnus-run-hooks 'gnus-setup-news-hook)
(gnus-start-draft-setup)
(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
"nndraft:drafts" 'gnus-dummy '((gnus-draft-mode)))))
-;;;###autoload
-(defun gnus-unload ()
- "Unload all Gnus features."
- (interactive)
- (unless (boundp 'load-history)
- (error "Sorry, `gnus-unload' is not implemented in this Emacs version"))
- (let ((history load-history)
- feature)
- (while history
- (and (string-match "^\\(gnus\\|nn\\)" (caar history))
- (setq feature (cdr (assq 'provide (car history))))
- (unload-feature feature 'force))
- (setq history (cdr history)))))
-
\f
;;;
;;; Dribble file
(set-buffer gnus-dribble-buffer)
(goto-char (point-max))
(insert string "\n")
- (set-window-point (get-buffer-window (current-buffer)) (point-max))
+ ;; This has been commented by Josh Huber <huber@alum.wpi.edu>
+ ;; It causes problems with both XEmacs and Emacs 21, and doesn't
+ ;; seem to be of much value. (FIXME: remove this after we make sure
+ ;; 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)
(set-buffer-modified-p nil)
(let ((auto (make-auto-save-file-name))
(gnus-dribble-ignore t)
+ (purpose nil)
modes)
(when (or (file-exists-p auto) (file-exists-p dribble-file))
;; Load whichever file is newest -- the auto save file
(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))
;; Possibly eval the file later.
(when (or gnus-always-read-dribble-file
(gnus-y-or-n-p
- "Gnus auto-save file exists. Do you want to read it? "))
+ (if purpose
+ "Gnus exited on purpose without saving; read auto-save file anyway? "
+ "Gnus auto-save file exists. Do you want to read it? ")))
(setq gnus-dribble-eval-file t)))))))
(defun gnus-dribble-eval-file ()
"Setup news information.
If RAWFILE is non-nil, the .newsrc file will also be read.
If LEVEL is non-nil, the news will be set up at level LEVEL."
- (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile)))))
+ (require 'nnmail)
+ (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile))))
+ ;; Binding this variable will inhibit multiple fetchings
+ ;; of the same mail source.
+ (nnmail-fetched-sources (list t)))
(when init
;; Clear some variables to re-initialize news information.
;; Make sure the archive server is available to all and sundry.
(when gnus-message-archive-method
- (setq gnus-server-alist (delq (assoc "archive" gnus-server-alist)
- gnus-server-alist))
- (push (cons "archive" gnus-message-archive-method)
- gnus-server-alist))
+ (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)))
;; If we don't read the complete active file, we fill in the
;; hashtb here.
(eq gnus-read-active-file 'some))
(gnus-update-active-hashtb-from-killed))
+ ;; Validate agent covered methods now that gnus-server-alist has
+ ;; been initialized.
+ ;; NOTE: This is here for one purpose only. By validating the
+ ;; agentized server's, it converts the old 5.10.3, and earlier,
+ ;; format to the current format. That enables the agent code
+ ;; within gnus-read-active-file to function correctly.
+ (if gnus-agent
+ (gnus-agent-read-servers-validate))
+
;; Read the active file and create `gnus-active-hashtb'.
;; If `gnus-read-active-file' is nil, then we just create an empty
;; hash table. The partial filling out of the hash table will be
;; See whether we need to read the description file.
(when (and (boundp 'gnus-group-line-format)
+ (stringp gnus-group-line-format)
(let ((case-fold-search nil))
(string-match "%[-,0-9]*D" gnus-group-line-format))
(not gnus-description-hashtb)
gnus-plugged)
(gnus-find-new-newsgroups))
+ ;; Check and remove bogus newsgroups.
+ (when (and init gnus-check-bogus-newsgroups
+ gnus-read-active-file (not level)
+ (gnus-server-opened gnus-select-method))
+ (gnus-check-bogus-newsgroups))
+
;; We might read in new NoCeM messages here.
(when (and gnus-use-nocem
(not 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))
-
- (when (and init gnus-check-bogus-newsgroups
- gnus-read-active-file (not level)
- (gnus-server-opened gnus-select-method))
- (gnus-check-bogus-newsgroups))))
+ (gnus-get-unread-articles level))))
+
+(defun gnus-call-subscribe-functions (method group)
+ "Call METHOD to subscribe GROUP.
+If no function returns `non-nil', call `gnus-subscribe-zombies'."
+ (unless (cond
+ ((functionp method)
+ (funcall method group))
+ ((listp method)
+ (catch 'found
+ (dolist (func method)
+ (if (funcall func group)
+ (throw 'found t)))
+ nil))
+ (t nil))
+ (gnus-subscribe-zombies group)))
(defun gnus-find-new-newsgroups (&optional arg)
"Search for new newsgroups and add them.
-Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method.'
+Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method'.
The `-n' option line from .newsrc is respected.
With 1 C-u, use the `ask-server' method to query the server for new
(let* ((gnus-subscribe-newsgroup-method
gnus-subscribe-newsgroup-method)
(check (cond
- ((or (and (= (or arg 1) 4)
- (not (listp gnus-check-new-newsgroups)))
- (null gnus-read-active-file)
- (eq gnus-read-active-file 'some))
- 'ask-server)
- ((= (or arg 1) 16)
- (setq gnus-subscribe-newsgroup-method
- 'gnus-subscribe-zombies)
- t)
- (t gnus-check-new-newsgroups))))
+ ((or (and (= (or arg 1) 4)
+ (not (listp gnus-check-new-newsgroups)))
+ (null gnus-read-active-file)
+ (eq gnus-read-active-file 'some))
+ 'ask-server)
+ ((= (or arg 1) 16)
+ (setq gnus-subscribe-newsgroup-method
+ 'gnus-subscribe-zombies)
+ t)
+ (t gnus-check-new-newsgroups))))
(unless (gnus-check-first-time-used)
(if (or (consp check)
(eq check 'ask-server))
(gnus-message 5 "Looking for new newsgroups...")
(unless gnus-have-read-active-file
(gnus-read-active-file))
- (setq gnus-newsrc-last-checked-date (current-time-string))
+ (setq gnus-newsrc-last-checked-date (message-make-date))
(unless gnus-killed-hashtb
(gnus-make-hashtable-from-killed))
;; Go though every newsgroup in `gnus-active-hashtb' and compare
((eq do-sub 'subscribe)
(setq groups (1+ groups))
(gnus-sethash group group gnus-killed-hashtb)
- (funcall gnus-subscribe-options-newsgroup-method group))
+ (gnus-call-subscribe-functions
+ gnus-subscribe-options-newsgroup-method group))
((eq do-sub 'ignore)
nil)
(t
(gnus-sethash group group gnus-killed-hashtb)
(if gnus-subscribe-hierarchical-interactive
(push group new-newsgroups)
- (funcall gnus-subscribe-newsgroup-method group)))))))
+ (gnus-call-subscribe-functions
+ gnus-subscribe-newsgroup-method group)))))))
gnus-active-hashtb)
(when new-newsgroups
(gnus-subscribe-hierarchical-interactive new-newsgroups))
(and regs (cdar regs))))))
(defun gnus-ask-server-for-new-groups ()
- (let* ((date (or gnus-newsrc-last-checked-date (current-time-string)))
+ (let* ((new-date (message-make-date))
+ (date (or gnus-newsrc-last-checked-date new-date))
(methods (cons gnus-select-method
(nconc
(when (gnus-archive-server-wanted-p)
gnus-check-new-newsgroups)
gnus-secondary-select-methods))))
(groups 0)
- (new-date (current-time-string))
group new-newsgroups got-new method hashtb
gnus-override-subscribe-method)
(unless gnus-killed-hashtb
((eq do-sub 'subscribe)
(incf groups)
(gnus-sethash group group gnus-killed-hashtb)
- (funcall gnus-subscribe-options-newsgroup-method group))
+ (gnus-call-subscribe-functions
+ gnus-subscribe-options-newsgroup-method group))
((eq do-sub 'ignore)
nil)
(t
(gnus-sethash group group gnus-killed-hashtb)
(if gnus-subscribe-hierarchical-interactive
(push group new-newsgroups)
- (funcall gnus-subscribe-newsgroup-method group)))))))
+ (gnus-call-subscribe-functions
+ gnus-subscribe-newsgroup-method group)))))))
hashtb))
(when new-newsgroups
(gnus-subscribe-hierarchical-interactive new-newsgroups)))
- (if (> groups 0)
- (gnus-message 5 "%d new newsgroup%s arrived"
- groups (if (> groups 1) "s have" " has"))
- (gnus-message 5 "No new newsgroups"))
+ (if (> groups 0)
+ (gnus-message 5 "%d new newsgroup%s arrived"
+ groups (if (> groups 1) "s have" " has"))
+ (gnus-message 5 "No new newsgroups"))
(when got-new
(setq gnus-newsrc-last-checked-date new-date))
got-new))
(defun gnus-check-first-time-used ()
(catch 'ended
- (let ((files (list gnus-current-startup-file
- (concat gnus-current-startup-file ".el")
- (concat gnus-current-startup-file ".eld")
- gnus-startup-file
- (concat gnus-startup-file ".el")
- (concat gnus-startup-file ".eld"))))
- (while files
- (when (file-exists-p (pop files))
- (throw 'ended nil))))
+ ;; First check if any of the following files exist. If they do,
+ ;; it's not the first time the user has used Gnus.
+ (dolist (file (list (concat gnus-current-startup-file ".el")
+ (concat gnus-current-startup-file ".eld")
+ (concat gnus-startup-file ".el")
+ (concat gnus-startup-file ".eld")))
+ (when (file-exists-p file)
+ (throw 'ended nil)))
(gnus-message 6 "First time user; subscribing you to default groups")
(unless (gnus-read-active-file-p)
(let ((gnus-read-active-file t))
(gnus-read-active-file)))
- (setq gnus-newsrc-last-checked-date (current-time-string))
- (let ((groups gnus-default-subscribed-newsgroups)
+ (setq gnus-newsrc-last-checked-date (message-make-date))
+ ;; Subscribe to the default newsgroups.
+ (let ((groups (or gnus-default-subscribed-newsgroups
+ gnus-backup-default-subscribed-newsgroups))
group)
(if (eq groups t)
- nil
- (setq groups (or groups gnus-backup-default-subscribed-newsgroups))
- (mapatoms
- (lambda (sym)
- (if (null (setq group (symbol-name sym)))
- ()
- (let ((do-sub (gnus-matches-options-n group)))
- (cond
- ((eq do-sub 'subscribe)
- (gnus-sethash group group gnus-killed-hashtb)
- (funcall gnus-subscribe-options-newsgroup-method group))
- ((eq do-sub 'ignore)
- nil)
- (t
- (push group gnus-killed-list))))))
- gnus-active-hashtb)
- (while groups
- (when (gnus-active (car groups))
+ ;; If t, we subscribe (or not) all groups as if they were new.
+ (mapatoms
+ (lambda (sym)
+ (when (setq group (symbol-name sym))
+ (let ((do-sub (gnus-matches-options-n group)))
+ (cond
+ ((eq do-sub 'subscribe)
+ (gnus-sethash group group gnus-killed-hashtb)
+ (gnus-call-subscribe-functions
+ gnus-subscribe-options-newsgroup-method group))
+ ((eq do-sub 'ignore)
+ nil)
+ (t
+ (push group gnus-killed-list))))))
+ gnus-active-hashtb)
+ (dolist (group groups)
+ ;; Only subscribe the default groups that are activated.
+ (when (gnus-active group)
(gnus-group-change-level
- (car groups) gnus-level-default-subscribed gnus-level-killed))
- (setq groups (cdr groups)))
+ group gnus-level-default-subscribed gnus-level-killed)))
(save-excursion
(set-buffer gnus-group-buffer)
- (gnus-group-make-help-group))
+ ;; Don't error if the group already exists. This happens when a
+ ;; first-time user types 'F'. -- didier
+ (gnus-group-make-help-group t))
(when gnus-novice-user
(gnus-message 7 "`A k' to list killed groups"))))))
-(defun gnus-subscribe-group (group previous &optional method)
+(defun gnus-subscribe-group (group &optional previous method)
+ "Subscribe GROUP and put it after PREVIOUS."
(gnus-group-change-level
(if method
(list t group gnus-level-default-subscribed nil nil method)
group)
- gnus-level-default-subscribed gnus-level-killed previous t))
+ gnus-level-default-subscribed gnus-level-killed previous t)
+ t)
;; `gnus-group-change-level' is the fundamental function for changing
;; subscription levels of newsgroups. This might mean just changing
(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.
;; it from the newsrc hash table and assoc.
(cond
((>= oldlevel gnus-level-zombie)
- (if (= oldlevel gnus-level-zombie)
- (setq gnus-zombie-list (delete group gnus-zombie-list))
- (setq gnus-killed-list (delete group gnus-killed-list))))
+ ;; oldlevel could be wrong.
+ (setq gnus-zombie-list (delete group gnus-zombie-list))
+ (setq gnus-killed-list (delete group gnus-killed-list)))
(t
(when (and (>= level gnus-level-zombie)
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)))))
(unless (gnus-group-foreign-p group)
(if (= level gnus-level-zombie)
(push group gnus-zombie-list)
- (push group gnus-killed-list))))
+ (if (= oldlevel gnus-level-killed)
+ ;; Remove from active hashtb.
+ (unintern group gnus-active-hashtb)
+ ;; Don't add it into killed-list if it was killed.
+ (push group gnus-killed-list)))))
(t
;; If the list is to be entered into the newsrc assoc, and
;; it was killed, we have to create an entry in the newsrc
(setq active (gnus-active group))
(setq num
(if active (- (1+ (cdr active)) (car active)) t))
- ;; Shorten the select method if possible, if we need to
- ;; store it at all (native groups).
- (let ((method (gnus-method-simplify
- (or gnus-override-subscribe-method
- (gnus-group-method group)))))
- (if method
- (setq info (list group level nil nil method))
- (setq info (list group level nil)))))
+ ;; Shorten the select method if possible, if we need to
+ ;; store it at all (native groups).
+ (let ((method (gnus-method-simplify
+ (or gnus-override-subscribe-method
+ (gnus-group-method group)))))
+ (if method
+ (setq info (list group level nil nil method))
+ (setq info (list group level nil)))))
(unless previous
(setq previous
(let ((p gnus-newsrc-alist))
(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.
(setq info (pop newsrc)
group (gnus-info-group info))
(unless (or (gnus-active group) ; Active
- (gnus-info-method info)) ; Foreign
+ (and (gnus-info-method info)
+ (not (gnus-secondary-method-p
+ (gnus-info-method info))))) ; Foreign
;; Found a bogus newsgroup.
(push group bogus)))
(if confirm
(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))
(gnus-check-backend-function 'request-scan (car method))
(gnus-request-scan group method))
t)
- (condition-case ()
+ (if (or debug-on-error debug-on-quit)
(inline (gnus-request-group group dont-check method))
- (error nil)
- (quit nil))
- (setq active (gnus-parse-active))
- ;; If there are no articles in the group, the GROUP
- ;; 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))
- (gnus-active group))
- (gnus-active group)
- (gnus-set-active group active)
- ;; Return the new active info.
- active))))
+ (condition-case nil
+ (inline (gnus-request-group group dont-check method))
+ ;;(error nil)
+ (quit
+ (message "Quit activating %s" group)
+ nil)))
+ (unless dont-check
+ (setq active (gnus-parse-active))
+ ;; If there are no articles in the group, the GROUP
+ ;; 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))
+ (gnus-active group))
+ (gnus-active group)
+
+ ;; 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.
;; Then we want to peel off any elements that are higher
;; than the upper active limit.
(let ((srange range))
- ;; Go past all legal elements.
+ ;; Go past all valid elements.
(while (and (cdr srange)
(<= (or (and (atom (cadr srange))
(cadr srange))
(cdr active)))
(setq srange (cdr srange)))
(when (cdr srange)
- ;; Nuke all remaining illegal elements.
+ ;; Nuke all remaining invalid elements.
(setcdr srange nil))
;; Adjust the final element.
(setq range (cdr range)))
(setq num (max 0 (- (cdr active) num)))))
;; Set the number of unread articles.
- (when info
- (setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num))
+ (when (and info
+ (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'
;; and compute how many unread articles there are in each 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)))
(foreign-level
gnus-activate-foreign-newsgroups)
(t 0))
level))
- info group active method)
- (gnus-message 5 "Checking new news...")
+ (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
(setq active (gnus-active (setq group (gnus-info-group
;; 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.
- (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 (<= (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 gnus-plugged active)
- (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.
- (when (and (<= (gnus-info-level info) level)
- (not gnus-read-active-file))
- (setq active (gnus-activate-group group 'scan))
- (inline (gnus-close-group group))))
+
+ ;; 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))
+ (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 (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 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.
- (if active
- (inline (gnus-get-unread-articles-in-group info active t))
+ (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)
- (setcar (gnus-gethash group gnus-newsrc-hashtb) t)))
+ (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)))))))
- (gnus-message 5 "Checking new news...done")))
+ (gnus-message 6 "Checking new news...done")))
;; 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
+ (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
(setq article (pop articles)) ranges)
(push article news)))
(when news
+ ;; Enter this list into the group info.
(gnus-info-set-read
info (gnus-remove-from-range (gnus-info-read info) (nreverse news)))
+
+ ;; Set the number of unread articles in gnus-newsrc-hashtb.
+ (gnus-get-unread-articles-in-group info (gnus-active group))
+
+ ;; Insert the change into the group buffer and the dribble file.
+ (gnus-group-update-group group t))))
+
+(defun gnus-make-ascending-articles-unread (group articles)
+ "Mark ascending ARTICLES in GROUP as unread."
+ (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)
+ modified)
+
+ (while articles
+ (let ((article (pop articles))) ; get the next article to remove from ranges
+ (while (let ((range (car ranges))) ; note the current range
+ (if (atom range) ; single value range
+ (cond ((not range)
+ ;; the articles extend past the end of the ranges
+ ;; OK - I'm done
+ (setq articles nil))
+ ((< range article)
+ ;; this range preceeds the article. Leave the range unmodified.
+ (pop ranges)
+ ranges)
+ ((= range article)
+ ;; this range exactly matches the article; REMOVE THE RANGE.
+ ;; NOTE: When the range being removed is the last range, the list is corrupted by inserting null at its end.
+ (setcar ranges (cadr ranges))
+ (setcdr ranges (cddr ranges))
+ (setq modified (if (car ranges) t 'remove-null))
+ nil))
+ (let ((min (car range))
+ (max (cdr range)))
+ ;; I have a min/max range to consider
+ (cond ((> min max) ; invalid range introduced by splitter
+ (setcar ranges (cadr ranges))
+ (setcdr ranges (cddr ranges))
+ (setq modified (if (car ranges) t 'remove-null))
+ ranges)
+ ((= min max)
+ ;; replace min/max range with a single-value range
+ (setcar ranges min)
+ ranges)
+ ((< max article)
+ ;; this range preceeds the article. Leave the range unmodified.
+ (pop ranges)
+ ranges)
+ ((< article min)
+ ;; this article preceeds the range. Return null to move to the
+ ;; next article
+ nil)
+ (t
+ ;; this article splits the range into two parts
+ (setcdr ranges (cons (cons (1+ article) max) (cdr ranges)))
+ (setcdr range (1- article))
+ (setq modified t)
+ ranges))))))))
+
+ (when modified
+ (when (eq modified 'remove-null)
+ (setq r (delq nil r)))
+ ;; Enter this list into the group info.
+ (gnus-info-set-read info r)
+
+ ;; Set the number of unread articles in gnus-newsrc-hashtb.
+ (gnus-get-unread-articles-in-group info (gnus-active group))
+
+ ;; Insert the change into the group buffer and the dribble file.
(gnus-group-update-group group t))))
;; Enter all dead groups into the hashtb.
(defun gnus-read-active-file (&optional force not-native)
(gnus-group-set-mode-line)
(let ((methods
- (append
- (if (and (not not-native)
- (gnus-check-server gnus-select-method))
- ;; The native server is available.
- (cons gnus-select-method gnus-secondary-select-methods)
- ;; The native server is down, so we just do the
- ;; secondary ones.
- gnus-secondary-select-methods)
- ;; Also read from the archive server.
- (when (gnus-archive-server-wanted-p)
- (list "archive"))))
- list-type)
+ (mapcar
+ (lambda (m) (if (stringp m) (gnus-server-get-method nil m) m))
+ (append
+ (if (and (not not-native)
+ (gnus-check-server gnus-select-method))
+ ;; The native server is available.
+ (cons gnus-select-method gnus-secondary-select-methods)
+ ;; The native server is down, so we just do the
+ ;; secondary ones.
+ gnus-secondary-select-methods)
+ ;; Also read from the archive server.
+ (when (gnus-archive-server-wanted-p)
+ (list "archive")))))
+ method)
(setq gnus-have-read-active-file nil)
(save-excursion
(set-buffer nntp-server-buffer)
- (while methods
- (let* ((method (if (stringp (car methods))
- (gnus-server-get-method nil (car methods))
- (car methods)))
- (where (nth 1 method))
- (mesg (format "Reading active file%s via %s..."
- (if (and where (not (zerop (length where))))
- (concat " from " where) "")
- (car method))))
+ (while (setq method (pop methods))
+ ;; Only do each method once, in case the methods appear more
+ ;; than once in this list.
+ (unless (member method methods)
+ (if (or debug-on-error debug-on-quit)
+ (gnus-read-active-file-1 method force)
+ (condition-case ()
+ (gnus-read-active-file-1 method force)
+ ;; We catch C-g so that we can continue past servers
+ ;; that do not respond.
+ (quit
+ (message "Quit reading the active file")
+ nil))))))))
+
+(defun gnus-read-active-file-1 (method force)
+ (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)
+ (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))
+ (cond
+ ((and (eq gnus-read-active-file 'some)
+ (gnus-check-backend-function 'retrieve-groups (car method))
+ (not force))
+ (let ((newsrc (cdr gnus-newsrc-alist))
+ (gmethod (gnus-server-get-method nil method))
+ groups info)
+ (while (setq info (pop newsrc))
+ (when (inline
+ (gnus-server-equal
+ (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)))
+ ((null method)
+ t)
+ (t
+ (if (not (gnus-request-list method))
+ (unless (equal method gnus-message-archive-method)
+ (gnus-error 1 "Cannot read active file from %s server"
+ (car method)))
(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))
- (gnus-request-scan nil method))
- (cond
- ((and (eq gnus-read-active-file 'some)
- (gnus-check-backend-function 'retrieve-groups (car method))
- (not force))
- (let ((newsrc (cdr gnus-newsrc-alist))
- (gmethod (gnus-server-get-method nil method))
- groups info)
- (while (setq info (pop newsrc))
- (when (inline
- (gnus-server-equal
- (inline
- (gnus-find-method-for-group
- (gnus-info-group info) info))
- gmethod))
- (push (gnus-group-real-name (gnus-info-group info))
- groups)))
- (when groups
- (gnus-check-server method)
- (setq list-type (gnus-retrieve-groups groups method))
- (cond
- ((not list-type)
- (gnus-error
- 1.2 "Cannot read partial active file from %s server."
- (car method)))
- ((eq list-type 'active)
- (gnus-active-to-gnus-format
- method gnus-active-hashtb nil t))
- (t
- (gnus-groups-to-gnus-format
- method gnus-active-hashtb t))))))
- ((null method)
- t)
- (t
- (if (not (gnus-request-list method))
- (unless (equal method gnus-message-archive-method)
- (gnus-error 1 "Cannot read active file from %s server"
- (car method)))
- (gnus-message 5 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)
- (gnus-message 5 "%sdone" mesg))))))
- (setq methods (cdr methods))))))
-
-(defun gnus-ignored-newsgroups-has-to-p ()
- "Non-nil iff gnus-ignored-newsgroups includes \"^to\\\\.\" as an element."
- ;; note this regexp is the same as:
- ;; (concat (regexp-quote "^to\\.") "\\($\\|" (regexp-quote "\\|") "\\)")
- (string-match "\\^to\\\\\\.\\($\\|\\\\|\\)" gnus-ignored-newsgroups))
+ (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)
+ (gnus-message 5 "%sdone" mesg)))))))
+
+(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)
+ (gnus-check-server method)
+ (let ((list-type (gnus-retrieve-groups groups method)))
+ (cond ((not list-type)
+ (gnus-error
+ 1.2 "Cannot read partial active file from %s server."
+ (car method)))
+ ((eq list-type 'active)
+ (gnus-active-to-gnus-format method gnus-active-hashtb nil t))
+ (t
+ (gnus-groups-to-gnus-format method gnus-active-hashtb t)))))))
;; Read an active file and place the results in `gnus-active-hashtb'.
(defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors
(gnus-make-hashtable 4096)))))))
;; Delete unnecessary lines.
(goto-char (point-min))
- (cond ((gnus-ignored-newsgroups-has-to-p)
- (delete-matching-lines gnus-ignored-newsgroups))
- ((string= gnus-ignored-newsgroups "")
- (delete-matching-lines "^to\\."))
- (t
- (delete-matching-lines (concat "^to\\.\\|"
- gnus-ignored-newsgroups))))
-
- ;; Make the group names readable as a lisp expression even if they
- ;; contain special characters.
- (goto-char (point-max))
- (while (re-search-backward "[][';?()#]" nil t)
- (insert ?\\))
+ (cond
+ ((string= gnus-ignored-newsgroups "")
+ (delete-matching-lines "^to\\."))
+ (t
+ (delete-matching-lines (concat "^to\\.\\|" gnus-ignored-newsgroups))))
+
+ (goto-char (point-min))
+ (unless (re-search-forward "[\\\"]" nil t)
+ ;; Make the group names readable as a lisp expression even if they
+ ;; contain special characters.
+ (goto-char (point-max))
+ (while (re-search-backward "[][';?()#]" nil t)
+ (insert ?\\)))
;; Let the Gnus agent save the active file.
- (when (and gnus-agent real-active)
+ (when (and gnus-agent real-active (gnus-online method))
(gnus-agent-save-active method))
;; If these are groups from a foreign select method, we insert the
(let ((prefix (gnus-group-prefixed-name "" method)))
(goto-char (point-min))
(while (and (not (eobp))
- (progn (insert prefix)
- (zerop (forward-line 1)))))))
+ (progn
+ (when (= (following-char) ?\")
+ (forward-char 1))
+ (insert prefix)
+ (zerop (forward-line 1)))))))
;; Store the active file in a hash table.
(goto-char (point-min))
(let (group max min)
(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)))
+ ;; ### The extended group name scheme makes
+ ;; the previous optimization strategy sort of pointless...
+ (when (stringp group)
+ (setq group (intern group hashtb)))
(if (and (numberp (setq max (read cur)))
(numberp (setq min (read cur)))
(progn
(symbolp group)
(set group nil))
(unless ignore-errors
- (gnus-message 3 "Warning - illegal active: %s"
+ (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-group-prefixed-name "" method))))
;; Let the Gnus agent save the active file.
- (when (and gnus-agent real-active)
- (gnus-agent-save-groups method))
-
- (goto-char (point-min))
- ;; We split this into to separate loops, one with the prefix
- ;; and one without to speed the reading up somewhat.
- (if prefix
- (let (min max opoint group)
+ (if (and gnus-agent
+ real-active
+ (gnus-online method)
+ (gnus-agent-method-p method))
+ (progn
+ (gnus-agent-save-active method)
+ (gnus-active-to-gnus-format method hashtb nil real-active))
+
+ (goto-char (point-min))
+ ;; We split this into to separate loops, one with the prefix
+ ;; and one without to speed the reading up somewhat.
+ (if prefix
+ (let (min max opoint group)
+ (while (not (eobp))
+ (condition-case ()
+ (progn
+ (read cur) (read cur)
+ (setq min (read cur)
+ max (read cur)
+ opoint (point))
+ (skip-chars-forward " \t")
+ (insert prefix)
+ (goto-char opoint)
+ (set (let ((obarray hashtb)) (read cur))
+ (cons min max)))
+ (error (and group (symbolp group) (set group nil))))
+ (forward-line 1)))
+ (let (min max group)
(while (not (eobp))
(condition-case ()
- (progn
+ (when (eq (char-after) ?2)
(read cur) (read cur)
(setq min (read cur)
- max (read cur)
- opoint (point))
- (skip-chars-forward " \t")
- (insert prefix)
- (goto-char opoint)
- (set (let ((obarray hashtb)) (read cur))
+ max (read cur))
+ (set (setq group (let ((obarray hashtb)) (read cur)))
(cons min max)))
(error (and group (symbolp group) (set group nil))))
- (forward-line 1)))
- (let (min max group)
- (while (not (eobp))
- (condition-case ()
- (when (eq (char-after) ?2)
- (read cur) (read cur)
- (setq min (read cur)
- max (read cur))
- (set (setq group (let ((obarray hashtb)) (read cur)))
- (cons min max)))
- (error (and group (symbolp group) (set group nil))))
- (forward-line 1))))))
+ (forward-line 1)))))))
(defun gnus-read-newsrc-file (&optional force)
"Read startup file.
If FORCE is non-nil, the .newsrc file is read."
;; Reset variables that might be defined in the .newsrc.eld file.
- (let ((variables gnus-variable-list))
- (while variables
- (set (car variables) nil)
- (setq variables (cdr variables))))
+ (gnus-clear-quick-file-variables)
(let* ((newsrc-file gnus-current-startup-file)
(quick-file (concat newsrc-file ".el")))
(save-excursion
;; file (ticked articles, killed groups, foreign methods, etc.)
(gnus-read-newsrc-el-file quick-file)
- (when (and (file-exists-p gnus-current-startup-file)
+ (when (and gnus-read-newsrc-file
+ (file-exists-p gnus-current-startup-file)
(or force
(and (file-newer-than-file-p newsrc-file quick-file)
(file-newer-than-file-p newsrc-file
(buffer-disable-undo)
(gnus-newsrc-to-gnus-format)
(kill-buffer (current-buffer))
- (gnus-message 5 "Reading %s...done" newsrc-file)))
-
- ;; Convert old to new.
- (gnus-convert-old-newsrc))))
+ (gnus-message 5 "Reading %s...done" newsrc-file))))))
+(quote (;; T-gnus doesn't provide those functions.
(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 ()
+ (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)
+ ("No Gnus v0.2" "legacy-gnus-agent"
+ gnus-agent-unlist-expire-days)
+ ("No Gnus v0.2" "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)))
+ (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))
(gnus-info-read info)
(nconc (gnus-uncompress-range dormant)
(gnus-uncompress-range ticked)))))))))
+))
+
+(defun gnus-load (file &optional coding-system)
+ "Load FILE, but in such a way that read errors can be reported."
+ (with-temp-buffer
+ (if coding-system
+ (insert-file-contents-as-coding-system coding-system file)
+ (insert-file-contents file))
+ (while (not (eobp))
+ (condition-case type
+ (let ((form (read (current-buffer))))
+ (eval form))
+ (error
+ (unless (eq (car type) 'end-of-file)
+ (let ((error (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)))))))))
(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)
- (condition-case nil
- (let ((coding-system-for-read gnus-startup-file-coding-system))
- (load ding-file t t t))
- (error
- (ding)
- (unless (gnus-yes-or-no-p
- (format "Error in %s; continue? " ding-file))
- (error "Error in %s" ding-file))))
- (when gnus-newsrc-assoc
- (setq gnus-newsrc-alist gnus-newsrc-assoc)))
+ (when (file-exists-p ding-file)
+ ;; We always, always read the .eld file.
+ (gnus-message 5 "Reading %s..." ding-file)
+ (let (gnus-newsrc-assoc)
+ (gnus-load ding-file gnus-ding-file-coding-system)
+;; ;; Older versions of `gnus-format-specs' are no longer valid
+;; ;; in Oort Gnus 0.01.
+;; (let ((version
+;; (and gnus-newsrc-file-version
+;; (gnus-continuum-version gnus-newsrc-file-version))))
+;; (when (or (not version)
+;; (< version 5.090009))
+;; (setq gnus-format-specs gnus-default-format-specs)))
+ (when gnus-newsrc-assoc
+ (setq gnus-newsrc-alist gnus-newsrc-assoc))))
(gnus-make-hashtable-from-newsrc-alist)
(when (file-newer-than-file-p file ding-file)
;; Old format quick file
(gnus-message 5 "Reading %s..." file)
;; The .el file is newer than the .eld file, so we read that one
;; as well.
- (gnus-read-old-newsrc-el-file file))))
+ (gnus-read-old-newsrc-el-file file)))
+ (when (and gnus-product-directory
+ (file-directory-p gnus-product-directory))
+ (let ((list gnus-product-variable-file-list))
+ (while list
+ (apply 'gnus-product-read-variable-file-1 (car list))
+ (setq list (cdr list)))))
+ (gnus-run-hooks 'gnus-read-newsrc-el-hook))
+
+;;(defun gnus-re-read-newsrc-el-file (file)
+;; "Attempt to re-read .newsrc.eld file. Returns nil if successful.
+;;The backup file \".newsrc.eld_\" will be created before re-reading."
+;; (message "Error in %s; retrying..." file)
+;; (if (and
+;; (condition-case nil
+;; (let ((backup (concat file "_")))
+;; (copy-file file backup 'ok-if-already-exists 'keep-time)
+;; (message " (The backup file %s has been created)" backup)
+;; t)
+;; (error nil))
+;; (progn
+;; (insert-file-contents-as-binary file nil nil nil 'replace)
+;; (goto-char (point-min))
+;; (when (re-search-forward
+;; "^[\t ]*([\t\n\r ]*setq[\t\n\r ]+gnus-format-specs" nil t)
+;; (delete-region (goto-char (match-beginning 0)) (forward-list 1))
+;; (decode-coding-region (point-min) (point-max)
+;; gnus-ding-file-coding-system)
+;; (condition-case nil
+;; (progn
+;; (eval-region (point-min) (point-max))
+;; t)
+;; (error nil)))))
+;; (prog1
+;; nil
+;; (message "Error in %s; retrying...done" file))
+;; (message "Error in %s; retrying...failed" file)
+;; t))
+
+(defun gnus-product-read-variable-file-1 (file checking-methods coding
+ &rest variables)
+ (let (error gnus-product-file-version method file-ver)
+ (when (or (condition-case err
+ (let ((coding-system-for-read coding))
+ (load (expand-file-name file gnus-product-directory)
+ nil nil t)
+ nil)
+ (error
+ (message "Error while reading %s: %s"
+ (expand-file-name file gnus-product-directory)
+ (error-message-string err))
+ (setq error t)))
+ (and (setq method (assq 'product-version checking-methods))
+ (not (and (setq file-ver
+ (cdr (assq 'product-version
+ gnus-product-file-version)))
+ (zerop (product-version-compare file-ver
+ (cadr method))))))
+ (and (assq 'emacs-version checking-methods)
+ (not (and (assq 'emacs-version gnus-product-file-version)
+ (string-equal
+ emacs-version
+ (cdr (assq 'emacs-version
+ gnus-product-file-version))))))
+ (and (assq 'correct-string-widths checking-methods)
+ (not (and (assq 'correct-string-widths
+ gnus-product-file-version)
+ (eq (and gnus-use-correct-string-widths t)
+ (and (cdr (assq 'correct-string-widths
+ gnus-product-file-version))
+ t))))))
+ (unless error
+ (message "\"%s\" seems to have mismatched contents, updating..."
+ file))
+ (while variables
+ (set (car variables) nil)
+ (gnus-product-variable-touch (car variables))
+ (setq variables (cdr variables))))))
;; Parse the old-style quick startup file
(defun gnus-read-old-newsrc-el-file (file)
;; 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
;; 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 illegal in these ranges, but
+ ;; Skip past ", ". Spaces are invalid in these ranges, but
;; we allow them, because it's a common mistake to put a
;; space after the comma.
(skip-chars-forward ", "))
(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)) ?!)
(setq gnus-newsrc-options-n out))))
+(eval-and-compile
+ (defalias 'gnus-long-file-names
+ (if (fboundp 'msdos-long-file-names)
+ 'msdos-long-file-names
+ (lambda () t))))
+
(defun gnus-save-newsrc-file (&optional force)
"Save .newsrc file."
;; Note: We cannot save .newsrc file if all newsgroups are removed
;; 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)
- (setq version-control 'never)
+ (setq version-control gnus-backup-startup-file)
(setq buffer-file-name
(concat gnus-current-startup-file ".eld"))
(setq default-directory (file-name-directory buffer-file-name))
(buffer-disable-undo)
(erase-buffer)
- (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file)
- (gnus-gnus-to-quick-newsrc-format)
- (gnus-run-hooks 'gnus-save-quick-newsrc-hook)
- (let ((coding-system-for-write gnus-startup-file-coding-system))
- (save-buffer))
- (kill-buffer (current-buffer))
+ (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file)
+
+ (if gnus-save-startup-file-via-temp-buffer
+ (let ((coding-system-for-write gnus-ding-file-coding-system)
+ (standard-output (current-buffer)))
+ (gnus-gnus-to-quick-newsrc-format)
+ (gnus-run-hooks 'gnus-save-quick-newsrc-hook)
+ (save-buffer))
+ (let ((coding-system-for-write gnus-ding-file-coding-system)
+ (version-control gnus-backup-startup-file)
+ (startup-file (concat gnus-current-startup-file ".eld"))
+ (working-dir (file-name-directory gnus-current-startup-file))
+ working-file
+ (i -1))
+ ;; Generate the name of a non-existent file.
+ (while (progn (setq working-file
+ (format
+ (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"))
+ working-dir (setq i (1+ i))))
+ (file-exists-p working-file)))
+
+ (unwind-protect
+ (progn
+ (gnus-with-output-to-file working-file
+ (gnus-gnus-to-quick-newsrc-format)
+ (gnus-run-hooks 'gnus-save-quick-newsrc-hook))
+
+ ;; These bindings will mislead the current buffer
+ ;; into thinking that it is visiting the startup
+ ;; file.
+ (let ((buffer-backed-up nil)
+ (buffer-file-name startup-file)
+ (file-precious-flag t)
+ (setmodes (file-modes startup-file)))
+ ;; Backup the current version of the startup file.
+ (backup-buffer)
+
+ ;; Replace the existing startup file with the temp file.
+ (rename-file working-file startup-file t)
+ (gnus-set-file-modes startup-file setmodes)))
+ (condition-case nil
+ (delete-file working-file)
+ (file-error nil)))))
+
+ (gnus-kill-buffer (current-buffer))
(gnus-message
5 "Saving %s.eld...done" gnus-current-startup-file))
(gnus-dribble-delete-file)
- (gnus-group-set-mode-line)))))
-
-(defun gnus-gnus-to-quick-newsrc-format ()
- "Insert Gnus variables such as gnus-newsrc-alist in lisp format."
- (let ((print-quoted t)
- (print-escape-newlines t))
- (insert ";; -*- emacs-lisp -*-\n")
- (insert ";; Gnus startup file.\n")
- (insert "\
+ (gnus-group-set-mode-line))))
+ (when gnus-product-directory
+ (gnus-product-save-variable-file)))
+
+;; Call the function above at C-x C-c.
+(defadvice save-buffers-kill-emacs (before save-gnus-newsrc-file-maybe
+ activate preactivate)
+ "Save .newsrc and .newsrc.eld when Emacs is killed."
+ (when (gnus-alive-p)
+ (gnus-run-hooks 'gnus-exit-gnus-hook)
+ (gnus-offer-save-summaries)
+ (gnus-save-newsrc-file)))
+
+(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")
+ (if name
+ (princ (format ";; %s\n" name))
+ (princ ";; Gnus startup file.\n"))
+
+ (unless minimal
+ (princ "\
;; Never delete this file -- if you want to force Gnus to read the
;; .newsrc file (if you have one), touch .newsrc instead.\n")
- (insert "(setq gnus-newsrc-file-version "
- (prin1-to-string gnus-version) ")\n")
- (let* ((gnus-killed-list
+ (princ "(setq gnus-newsrc-file-version ")
+ (princ (gnus-prin1-to-string gnus-version))
+ (princ ")\n"))
+
+ (let* ((print-quoted t)
+ (print-readably t)
+ (print-escape-multibyte nil)
+ (print-escape-nonascii t)
+ (print-length nil)
+ (print-level nil)
+ (print-escape-newlines t)
+ (gnus-killed-list
(if (and gnus-save-killed-list
(stringp gnus-save-killed-list))
(gnus-strip-killed-list)
gnus-killed-list))
(variables
- (if gnus-save-killed-list gnus-variable-list
- ;; Remove the `gnus-killed-list' from the list of variables
- ;; to be saved, if required.
- (delq 'gnus-killed-list (copy-sequence gnus-variable-list))))
+ (or specific-variables
+ (if gnus-save-killed-list gnus-variable-list
+ ;; Remove the `gnus-killed-list' from the list of variables
+ ;; to be saved, if required.
+ (delq 'gnus-killed-list (copy-sequence gnus-variable-list)))))
;; Peel off the "dummy" group.
(gnus-newsrc-alist (cdr gnus-newsrc-alist))
variable)
(while variables
(when (and (boundp (setq variable (pop variables)))
(symbol-value variable))
- (insert "(setq " (symbol-name variable) " '")
- (gnus-prin1 (symbol-value variable))
- (insert ")\n"))))))
+ (princ "(setq ")
+ (princ (symbol-name variable))
+ (princ " '")
+ (prin1 (symbol-value variable))
+ (princ ")\n")))))
+
+(defun gnus-product-variable-touch (&rest variables)
+ (while variables
+ (put (pop variables) 'gnus-product-variable 'dirty)))
+
+(defun gnus-product-variables-dirty-p (variables)
+ (catch 'done
+ (while variables
+ (when (eq (get (car variables) 'gnus-product-variable) 'dirty)
+ (throw 'done t))
+ (setq variables (cdr variables)))))
+
+(defun gnus-product-save-variable-file (&optional force)
+ "Save all product variables to files, when need to be saved."
+ (let ((list gnus-product-variable-file-list))
+ (gnus-make-directory gnus-product-directory)
+ (while list
+ (apply 'gnus-product-save-variable-file-1 force (car list))
+ (setq list (cdr list)))))
+
+(defun gnus-product-save-variable-file-1 (force file checking-methods coding
+ &rest variables)
+ "Save a product variable file, when need to be saved."
+ (when (or force
+ (gnus-product-variables-dirty-p variables))
+ (let ((product (product-find 'gnus-vers)))
+ (set-buffer (gnus-get-buffer-create " *gnus-product*"))
+ (make-local-variable 'version-control)
+ (setq version-control 'never)
+ (setq file (expand-file-name file gnus-product-directory)
+ buffer-file-name file
+ default-directory (file-name-directory file))
+ (buffer-disable-undo)
+ (erase-buffer)
+ (gnus-message 5 "Saving %s..." file)
+ (apply 'gnus-product-quick-file-format product checking-methods coding
+ variables)
+ (save-buffer-as-coding-system coding)
+ (kill-buffer (current-buffer))
+ (while variables
+ (put (car variables) 'gnus-product-variable nil)
+ (setq variables (cdr variables)))
+ (gnus-message
+ 5 "Saving %s...done" file))))
+
+(defun gnus-product-quick-file-format (product checking-methods
+ coding &rest variables)
+ "Insert gnus product depend variables in lisp format."
+ (let ((print-quoted t)
+ (print-escape-newlines t)
+ print-length print-level variable param)
+ (insert (format ";; -*- Mode: emacs-lisp; coding: %s -*-\n" coding))
+ (insert (format ";; %s startup file.\n" (product-name product)))
+ (when (setq param (cdr (assq 'product-version checking-methods)))
+ (insert "(or (>= (product-version-compare "
+ "(product-version (product-find 'gnus-vers))\n"
+ "\t\t\t\t '" (apply 'prin1-to-string param) ")\n"
+ "\t0)\n"
+ " (error \"This file was created by later version of "
+ "gnus.\"))\n"))
+ (insert "(setq gnus-product-file-version\n"
+ " '((product-version . "
+ (prin1-to-string (product-version product)) ")\n"
+ "\t(emacs-version . "
+ (prin1-to-string emacs-version) ")\n"
+ "\t(correct-string-widths . "
+ (if gnus-use-correct-string-widths "t" "nil")
+ ")))\n")
+ (while variables
+ (when (and (boundp (setq variable (pop variables)))
+ (symbol-value variable))
+ (insert "(setq " (symbol-name variable) " '")
+ (gnus-prin1 (symbol-value variable))
+ (insert ")\n")))))
(defun gnus-strip-killed-list ()
"Return the killed list minus the groups that match `gnus-save-killed-list'."
(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 ()
(save-excursion
(set-buffer gnus-dribble-buffer)
(let ((slave-name
- (make-temp-name (concat gnus-current-startup-file "-slave-")))
+ (mm-make-temp-file (concat gnus-current-startup-file "-slave-")))
(modes (ignore-errors
(file-modes (concat gnus-current-startup-file ".eld")))))
- (gnus-write-buffer slave-name)
+ (gnus-write-buffer-as-coding-system gnus-ding-file-coding-system
+ 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
(while slave-files
(erase-buffer)
(setq file (nth 1 (car slave-files)))
- (insert-file-contents file)
+ (nnheader-insert-file-contents file)
(when (condition-case ()
(progn
(eval-buffer (current-buffer))
(gnus-message 5 "Reading descriptions file via %s..." (car method))
(cond
+ ((null (gnus-get-function method 'request-list-newsgroups t))
+ t)
((not (gnus-check-server method))
(gnus-message 1 "Couldn't open server")
nil)
(skip-chars-forward " \t")
;; ... which leads to this line being effectively ignored.
(when (symbolp group)
- (let ((str (buffer-substring
- (point) (progn (end-of-line) (point))))
- (coding
- (and (boundp 'enable-multibyte-characters)
- enable-multibyte-characters
- (fboundp 'gnus-mule-get-coding-system)
- (gnus-mule-get-coding-system (symbol-name group)))))
- (when coding
- (setq str (decode-coding-string str (car coding))))
+ (let* ((str (buffer-substring
+ (point) (progn (end-of-line) (point))))
+ (name (symbol-name group))
+ (charset
+ (or (gnus-group-name-charset method name)
+ (gnus-parameter-charset name)
+ gnus-default-charset)))
+ ;; Fixme: Don't decode in unibyte mode.
+ (when (and str charset (featurep 'mule))
+ (setq str (decode-coding-string str charset)))
(set group str)))
(forward-line 1))))
(gnus-message 5 "Reading descriptions file...done")
;;;###autoload
(defun gnus-declare-backend (name &rest abilities)
- "Declare backend NAME with ABILITIES as a Gnus backend."
+ "Declare back end NAME with ABILITIES as a Gnus back end."
(setq gnus-valid-select-methods
(nconc gnus-valid-select-methods
- (list (apply 'list name abilities)))))
+ (list (apply 'list name abilities))))
+ (gnus-redefine-select-method-widget))
(defun gnus-set-default-directory ()
"Set the default directory in the current buffer to `gnus-default-directory'.
(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))))
+
+;;;###autoload
+(defun gnus-fixup-nnimap-unread-after-getting-new-news ()
+ (let (server group info)
+ (mapatoms
+ (lambda (sym)
+ (when (and (setq group (symbol-name sym))
+ (gnus-group-entry group)
+ (setq info (symbol-value sym)))
+ (gnus-sethash group (cons (nth 2 info) (cdr (gnus-group-entry group)))
+ gnus-newsrc-hashtb)))
+ (if (boundp 'nnimap-mailbox-info)
+ (symbol-value 'nnimap-mailbox-info)
+ (make-vector 1 0)))))
+
+
(provide 'gnus-start)
;;; gnus-start.el ends here