;;; gnus-start.el --- startup functions for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001
;; 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-range)
(require 'gnus-util)
(require 'message)
-(eval-when-compile (require 'cl))
(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-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)
(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."
+ :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 '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)
+ "A hook run after Gnus checks for new news when Gnus is already running."
:group 'gnus-group-new
:type 'hook)
:group 'gnus-newsrc
:type 'boolean)
-(defvar gnus-startup-file-coding-system 'binary
+(defvar gnus-startup-file-coding-system (static-if (boundp 'MULE)
+ '*ctext*
+ 'ctext)
"*Coding system for startup file.")
+(defvar gnus-ding-file-coding-system gnus-startup-file-coding-system
+ "*Coding system for ding file.")
+;; Note that the ding file for T-gnus ought not to have byte-codes.
+
;;; Internal variables
(defvar gnus-newsrc-file-version nil)
(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))
+ (load file nil t)
(error
(error "Error in %s: %s" file var)))))))))
;; 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.
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-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'."
(defvar nnoo-state-alist)
(defvar gnus-current-select-method)
-(defun gnus-clear-system ()
- "Clear all variables and buffers."
- ;; Clear Gnus variables.
+(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-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.
(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))))
(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 ()
;;;###autoload
(defun gnus-unload ()
- "Unload all Gnus features."
+ "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)
- (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)))))
+ (dolist (feature features)
+ (if (string-match "^\\(gnus-\\|nn\\|mm-\\|rfc\\)" (symbol-name feature))
+ (unload-feature feature 'force))))
\f
;;;
(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
(file-exists-p dribble-file)
(setq modes (file-modes gnus-current-startup-file)))
(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.
;; 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
+ ((gnus-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)))
(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 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")))
+ (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))
(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."
(gnus-group-change-level
;; 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)
(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 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
(condition-case ()
(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))))
+ (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)
+ (gnus-set-active group active)
+ ;; Return the new active info.
+ active)))))
(defun gnus-get-unread-articles-in-group (info active &optional update)
(when active
gnus-activate-foreign-newsgroups)
(t 0))
level))
- scanned-methods info group active method retrievegroups)
+ scanned-methods info group active method retrieve-groups)
(gnus-message 5 "Checking new news...")
(while newsrc
(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))
+ (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
(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))
+ (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.
- (if (and (null (assq 'directory
+ ;; 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)
+ (if (listp nnmail-spool-file)
nnmail-spool-file
- (list nnmail-spool-file)))))
- (member method scanned-methods))
+ (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))
- (inline (gnus-close-group group))))))
+ (when active
+ (gnus-close-group group))))))
;; Get the number of unread articles in the group.
(cond
;; unread articles and stuff.
(gnus-set-active group nil)
(let ((tmp (gnus-gethash group gnus-newsrc-hashtb)))
- (if tmp (setcar tmp t))))))
+ (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)))
- (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))))))
+ (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")))
(gnus-read-active-file-1 method force)
;; We catch C-g so that we can continue past servers
;; that do not respond.
- (quit nil)))))))
+ (quit
+ (message "Quit reading the active file")
+ nil)))))))
(defun gnus-read-active-file-1 (method force)
(let (where mesg)
(gnus-check-server method)
(let ((list-type (gnus-retrieve-groups groups method)))
(cond ((not list-type)
- (gnus-error
+ (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
real-active)
"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))))
-
-(defun gnus-convert-old-newsrc ()
- "Convert old newsrc into the new 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 ()
- (let ((newsrc (cdr gnus-newsrc-alist))
- marks info dormant ticked)
- (while (setq info (pop newsrc))
- (when (setq marks (gnus-info-marks info))
- (setq dormant (cdr (assq 'dormant marks))
- ticked (cdr (assq 'tick marks)))
- (when (or dormant ticked)
- (gnus-info-set-read
- info
- (gnus-add-to-range
- (gnus-info-read info)
- (nconc (gnus-uncompress-range dormant)
- (gnus-uncompress-range ticked)))))))))
+ (gnus-message 5 "Reading %s...done" newsrc-file))))))
(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
+ (when (file-exists-p ding-file)
+ (with-temp-buffer
+ (condition-case nil
+ (progn
+ (insert-file-contents-as-coding-system
+ gnus-ding-file-coding-system ding-file)
+ (eval-region (point-min) (point-max)))
+ (error
+ (ding)
+ (or (not (or (zerop (buffer-size))
+ (eq 'binary gnus-startup-file-coding-system)
+ (gnus-re-read-newsrc-el-file ding-file)))
+ (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)))
+ (error "Error in %s" ding-file)))))
+ (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))))))
+
+(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)
+ (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-startup-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)
+ (input-coding-system coding))
+ (load (expand-file-name file gnus-product-directory) t nil t)
+ nil)
+ (error
+ (message "%s" err)
+ (setq error t)))
+ (and (assq 'emacs-version checking-methods)
+ (not (string= emacs-version
+ (cdr (assq 'emacs-version
+ gnus-product-file-version)))))
+ (and (setq method (assq 'product-version checking-methods))
+ (or (not (setq file-ver
+ (cdr (assq 'product-version
+ gnus-product-file-version))))
+ (< (product-version-compare file-ver (cadr method)) 0))))
+ (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)
(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))
+ (save-buffer-as-coding-system gnus-ding-file-coding-system)
(kill-buffer (current-buffer))
(gnus-message
5 "Saving %s.eld...done" gnus-current-startup-file))
(gnus-dribble-delete-file)
- (gnus-group-set-mode-line)))))
+ (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 ()
"Insert Gnus variables such as gnus-newsrc-alist in lisp format."
(gnus-prin1 (symbol-value variable))
(insert ")\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)
+ 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")
+ (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'."
(let ((list gnus-killed-list)
(make-temp-name (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)))))
(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))
(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 gnus-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))))
+ (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")
"Declare backend NAME with ABILITIES as a Gnus backend."
(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)))
+(defun gnus-display-time-event-handler ()
+ "Like `display-time-event-handler', but test `display-time-timer'."
+ (when (gnus-boundp 'display-time-timer)
+ (display-time-event-handler)))
+
(provide 'gnus-start)
;;; gnus-start.el ends here
projects / elisp / gnus.git- / blobdiff