;;; gnus-start.el --- startup functions for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;;; 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."
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)
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))
(defcustom gnus-ignored-newsgroups
(mapconcat 'identity
'("^to\\." ; not "real" groups
- "^[0-9. \t]+ " ; all digits in name
+ "^[0-9. \t]+\\( \\|$\\)" ; all digits in name
"^[\"][]\"[#'()]" ; bogus characters
)
"\\|")
: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
(function-item gnus-subscribe-killed)
(function-item gnus-subscribe-zombies)
(function-item gnus-subscribe-topics)
- function))
+ 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."
+ :version "21.4"
+ :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."
+ :version "21.4"
+ :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 when Gnus is already running."
+ '(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 'binary
- "*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
- (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))
- (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
(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)
(gnus-group-first-unread-group)
(gnus-configure-windows 'group)
(gnus-group-set-mode-line)
+ ;; For reading Info.
+ (set-language-info "Japanese" 'gnus-info "gnus-ja")
(gnus-run-hooks 'gnus-started-hook))))))
(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)
(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 ()
;; 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.
(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)))
(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)
(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))
+ (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)
- (when (eq groups t)
- ;; 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)
- (funcall gnus-subscribe-options-newsgroup-method group))
- ((eq do-sub 'ignore)
- nil)
- (t
- (push group gnus-killed-list))))))
- gnus-active-hashtb)
+ (if (eq groups t)
+ ;; 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)
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.
;; 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
(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
- (message "Quit activating %s" group)
- 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.
(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))
- scanned-methods info group active method retrievegroups)
- (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
;; nil for non-foreign groups that the user has requested not be checked
;; t for unchecked foreign groups or bogus groups, or groups that can't
;; be checked, for one reason or other.
- (if (and (setq method (gnus-info-method info))
- (not (inline
- (gnus-server-equal
- gnus-select-method
- (setq method (gnus-server-get-method nil method)))))
- (not (gnus-secondary-method-p method)))
- ;; These groups are foreign. Check the level.
- (when (and (<= (gnus-info-level info) foreign-level)
- (setq active (gnus-activate-group group 'scan)))
- ;; Let the Gnus agent save the active file.
- (when (and gnus-agent 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.
- (cond
- ;; We don't want these groups.
- ((> (gnus-info-level info) level)
- (setq active 'ignore))
- ;; Activate groups.
- ((not gnus-read-active-file)
- (if (gnus-check-backend-function 'retrieve-groups group)
- ;; if server support gnus-retrieve-groups we push
- ;; the group onto retrievegroups for later checking
- (if (assoc method retrievegroups)
- (setcdr (assoc method retrievegroups)
- (cons group (cdr (assoc method retrievegroups))))
- (push (list method group) retrievegroups))
- ;; hack: `nnmail-get-new-mail' changes the mail-source depending
- ;; on the group, so we must perform a scan for every group
- ;; if the users has any directory mail sources.
- ;; hack: if `nnmail-scan-directory-mail-source-once' is non-nil,
- ;; for it scan all spool files even when the groups are
- ;; not required.
- (if (and
- (or nnmail-scan-directory-mail-source-once
- (null (assq 'directory
- (or mail-sources
- (if (listp nnmail-spool-file)
- nnmail-spool-file
- (list nnmail-spool-file))))))
- (member method scanned-methods))
- (setq active (gnus-activate-group group))
- (setq active (gnus-activate-group group 'scan))
- (push method scanned-methods))
- (when active
- (gnus-close-group group))))))
+ (when (setq method (gnus-info-method info))
+ (if (setq cmethod (assoc method methods-cache))
+ (setq method (cdr cmethod))
+ (setq cmethod (inline (gnus-server-get-method nil method)))
+ (push (cons method cmethod) methods-cache)
+ (setq method cmethod)))
+ (when (and method
+ (not (setq method-type (cdr (assoc method type-cache)))))
+ (setq method-type
+ (cond
+ ((gnus-secondary-method-p method)
+ 'secondary)
+ ((inline (gnus-server-equal gnus-select-method method))
+ 'primary)
+ (t
+ 'foreign)))
+ (push (cons method method-type) type-cache))
+
+ (setq ignore nil)
+ (cond ((and method (eq method-type 'foreign))
+ ;; These groups are foreign. Check the level.
+ (if (<= (gnus-info-level info) foreign-level)
+ (when (setq active (gnus-activate-group group 'scan))
+ ;; Let the Gnus agent save the active file.
+ (when (and gnus-agent active (gnus-online method))
+ (gnus-agent-save-group-info
+ method (gnus-group-real-name group) active))
+ (unless (inline (gnus-virtual-group-p group))
+ (inline (gnus-close-group group)))
+ (when (fboundp (intern (concat (symbol-name (car method))
+ "-request-update-info")))
+ (inline (gnus-request-update-info info method))))
+ (setq ignore t)))
+ ;; These groups are native or secondary.
+ ((> (gnus-info-level info) level)
+ ;; We don't want these groups.
+ (setq active 'ignore))
+ ;; Activate groups.
+ ((not gnus-read-active-file)
+ (if (gnus-check-backend-function 'retrieve-groups group)
+ ;; if server support gnus-retrieve-groups we push
+ ;; the group onto retrievegroups for later checking
+ (if (assoc method retrieve-groups)
+ (setcdr (assoc method retrieve-groups)
+ (cons group (cdr (assoc method retrieve-groups))))
+ (push (list method group) retrieve-groups))
+ ;; hack: `nnmail-get-new-mail' changes the mail-source depending
+ ;; on the group, so we must perform a scan for every group
+ ;; if the users has any directory mail sources.
+ ;; hack: if `nnmail-scan-directory-mail-source-once' is non-nil,
+ ;; for it scan all spool files even when the groups are
+ ;; not required.
+ (if (and
+ (or nnmail-scan-directory-mail-source-once
+ (null (assq 'directory
+ (or mail-sources
+ (if (listp nnmail-spool-file)
+ nnmail-spool-file
+ (list nnmail-spool-file))))))
+ (member method scanned-methods))
+ (setq active (gnus-activate-group group))
+ (setq active (gnus-activate-group group 'scan))
+ (push method scanned-methods))
+ (when active
+ (gnus-close-group group)))))
;; Get the number of unread articles in the group.
(cond
((eq active 'ignore)
;; Don't do anything.
)
+ ((and active ignore)
+ ;; The level of the foreign group is higher than the specified
+ ;; value.
+ )
(active
(inline (gnus-get-unread-articles-in-group info active t)))
(t
;; The group couldn't be reached, so we nix out the number of
;; unread articles and stuff.
(gnus-set-active group nil)
- (let ((tmp (gnus-gethash group gnus-newsrc-hashtb)))
- (if tmp (setcar tmp 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.
- (while retrievegroups
- (let* ((mg (pop retrievegroups))
- (method (or (car mg) gnus-select-method))
- (groups (cdr mg)))
+ (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-gethash group gnus-newsrc-hashtb) t)))))))
-
- (gnus-message 5 "Checking new news...done")))
+ ;; 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 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.
;; Only do each method once, in case the methods appear more
;; than once in this list.
(unless (member method methods)
- (condition-case ()
+ (if (or debug-on-error debug-on-quit)
(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)))))))
+ (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)
(while (setq info (pop newsrc))
(when (inline
(gnus-server-equal
- (inline
- (gnus-find-method-for-group
- (gnus-info-group info) info))
- gmethod))
+ (inline
+ (gnus-find-method-for-group
+ (gnus-info-group info) info))
+ gmethod))
(push (gnus-group-real-name (gnus-info-group info))
groups)))
(gnus-read-active-file-2 groups method)))
(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."
+ "Read an active file for GROUPS in METHOD using `gnus-retrieve-groups'."
(when groups
(save-excursion
(set-buffer nntp-server-buffer)
(insert ?\\)))
;; Let the Gnus agent save the active file.
- (when (and gnus-agent real-active gnus-plugged)
+ (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
(goto-char (point-min))
(let (group max min)
(while (not (eobp))
- (condition-case err
+ (condition-case ()
(progn
- (narrow-to-region (point) (gnus-point-at-eol))
+ (narrow-to-region (point) (point-at-eol))
;; group gets set to a symbol interned in the hash table
;; (what a hack!!) - jwz
(setq group (let ((obarray hashtb)) (read cur)))
(unless ignore-errors
(gnus-message 3 "Warning - invalid active: %s"
(buffer-substring
- (gnus-point-at-bol) (gnus-point-at-eol))))))
+ (point-at-bol) (point-at-eol))))))
(widen)
(forward-line 1)))))
;; Let the Gnus agent save the active file.
(if (and gnus-agent
real-active
- gnus-plugged
+ (gnus-online method)
(gnus-agent-method-p method))
(progn
- (gnus-agent-save-groups method)
+ (gnus-agent-save-active method)
(gnus-active-to-gnus-format method hashtb nil real-active))
(goto-char (point-min))
"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
(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)
+ ("Gnus v5.10.7" "legacy-gnus-agent"
+ gnus-agent-unlist-expire-days)
+ ("Gnus v5.10.7" "legacy-gnus-agent"
+ gnus-agent-unhook-expire-days)))
+ #'car-less-than-car)))
+ ;; Skip converters older than the file version
+ (while (and converters (>= fcv (caar converters)))
+ (pop converters))
+
+ ;; Perform converters to bring older version up to date.
+ (when (and converters (< fcv (caar converters)))
+ (while (and converters (< fcv (caar converters)))
+ (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 invalid in these ranges, but
;; we allow them, because it's a common mistake to put a
(while (re-search-forward "[ \t]-n" nil t)
(setq eol
(or (save-excursion
- (and (re-search-forward "[ \t]-n" (gnus-point-at-eol) t)
+ (and (re-search-forward "[ \t]-n" (point-at-eol) t)
(- (point) 2)))
- (gnus-point-at-eol)))
+ (point-at-eol)))
;; Search for all "words"...
(while (re-search-forward "[^ \t,\n]+" eol t)
(if (eq (char-after (match-beginning 0)) ?!)
(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")))))
- (let ((coding-system-for-write gnus-startup-file-coding-system))
- (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
(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 (or (featurep 'xemacs)
- (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 (mm-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))))
(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)))))
+
+(defun gnus-check-reasonable-setup ()
+ ;; Check whether nnml and nnfolder share a directory.
+ (let ((display-warn
+ (if (fboundp 'display-warning)
+ 'display-warning
+ (lambda (type message)
+ (if noninteractive
+ (message "Warning (%s): %s" type message)
+ (let (window)
+ (with-current-buffer (get-buffer-create "*Warnings*")
+ (goto-char (point-max))
+ (unless (bolp)
+ (insert "\n"))
+ (insert (format "Warning (%s): %s\n" type message))
+ (setq window (display-buffer (current-buffer)))
+ (set-window-start
+ window
+ (prog2
+ (forward-line (- 1 (window-height window)))
+ (point)
+ (goto-char (point-max))))))))))
+ method active actives match)
+ (dolist (server gnus-server-alist)
+ (setq method (gnus-server-to-method server)
+ active (intern (format "%s-active-file" (car method))))
+ (when (and (member (car method) '(nnml nnfolder))
+ (gnus-server-opened method)
+ (boundp active))
+ (when (setq match (assoc (symbol-value active) actives))
+ (funcall display-warn 'gnus-server
+ (format "%s and %s share the same active file %s"
+ (car method)
+ (cadr match)
+ (car match))))
+ (push (list (symbol-value active) method) actives)))))
+
(provide 'gnus-start)
;;; gnus-start.el ends here