;;; gnus-start.el --- startup functions for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
(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
+ (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.
:group 'gnus-start
:type 'file)
+(defcustom gnus-backup-startup-file 'never
+ "Whether to create backup files.
+This variable takes the same values as the `version-control'
+variable."
+ :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."
+ :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."
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
(mapconcat 'identity
(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."
+ "*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)
: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
- '(gnus-display-time-event-handler)
+ '(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
"Unconditionally read the dribble file."
:group 'gnus-newsrc
:type 'boolean)
-(defvar gnus-startup-file-coding-system mm-universal-coding-system
- "*Coding system for startup file.")
-
;;; Internal variables
+(defvar gnus-ding-file-coding-system mm-universal-coding-system
+ "Coding system for ding file.")
+
(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
- (let ((coding-system-for-read
- gnus-startup-file-coding-system))
- (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))
;; 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))
;;; 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)
+(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-close-all-servers ()
"Close all servers."
(defun gnus-clear-system ()
"Clear all variables and buffers."
;; Clear Gnus variables.
- (let ((variables gnus-variable-list))
+ (let ((variables (remove 'gnus-format-specs gnus-variable-list)))
(while variables
(set (car variables) nil)
(setq variables (cdr 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
(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)
(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.
-\(For some value of `all' or `Gnus'.) Currently, features whose names
-have prefixes `gnus-', `nn', `mm-' or `rfc' are unloaded. Use
-cautiously -- unloading may cause trouble."
- (interactive)
- (dolist (feature features)
- (if (string-match "^\\(gnus-\\|nn\\|mm-\\|rfc\\)" (symbol-name feature))
- (unload-feature feature 'force))))
-
\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)
(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
- (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
"Call METHOD to subscribe GROUP.
If no function returns `non-nil', call `gnus-subscribe-zombies'."
(unless (cond
- ((gnus-functionp method)
+ ((functionp method)
(funcall method group))
((listp method)
(catch 'found
(catch 'ended
;; 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 gnus-current-startup-file
- (concat gnus-current-startup-file ".el")
+ (dolist (file (list (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")))
(when (file-exists-p file)
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 &optional previous method)
- "Subcribe GROUP and put it after PREVIOUS."
+ "Subscribe GROUP and put it after PREVIOUS."
(gnus-group-change-level
(if method
(list t group gnus-level-default-subscribed nil nil method)
(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-ne