X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-start.el;h=c77e00cfa772f08e9bc114810cc9b70ff8cff592;hb=d760bac8635b552c28cfc2ee5b24cf25f633bdbb;hp=b9665a569dfd98e0321afe1dc8a52af9586d318e;hpb=1792b98237a890b61a94f7c6e9dd74cae16e4e96;p=gnus diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index b9665a569..c77e00cfa 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -1,5 +1,5 @@ ;;; gnus-start.el --- startup functions for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -32,8 +32,17 @@ (require 'gnus-spec) (require 'gnus-range) (require 'gnus-util) -(require 'message) -(eval-when-compile (require 'cl)) +(autoload 'message-make-date "message") +(autoload 'gnus-agent-read-servers-validate "gnus-agent") +(autoload 'gnus-agent-save-local "gnus-agent") +(autoload 'gnus-agent-possibly-alter-active "gnus-agent") + +(eval-when-compile + (require 'cl) + + (defvar gnus-agent-covered-methods nil) + (defvar gnus-agent-file-loading-local nil) + (defvar gnus-agent-file-loading-cache nil)) (defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc") "Your `.newsrc' file. @@ -41,6 +50,24 @@ :group 'gnus-start :type 'file) +(defcustom gnus-backup-startup-file 'never + "Whether to create backup files. +This variable takes the same values as the `version-control' +variable." + :group 'gnus-start + :type '(choice (const :tag "Never" never) + (const :tag "If existing" nil) + (other :tag "Always" t))) + +(defcustom gnus-save-startup-file-via-temp-buffer t + "Whether to write the startup file contents to a buffer then save +the buffer or write directly to the file. The buffer is faster +because all of the contents are written at once. The direct write +uses considerably less memory." + :group 'gnus-start + :type '(choice (const :tag "Write via buffer" t) + (const :tag "Write directly to file" nil))) + (defcustom gnus-init-file (nnheader-concat gnus-home-directory ".gnus") "Your Gnus Emacs-Lisp startup file name. If a file with the `.el' or `.elc' suffixes exists, it will be read instead." @@ -224,7 +251,12 @@ nil if you set this variable to nil. This variable can also be a regexp. In that case, all groups that do not match this regexp will be removed before saving the list." :group 'gnus-newsrc - :type 'boolean) + :type '(radio (sexp :format "Non-nil\n" + :match (lambda (widget value) + (and value (not (stringp value)))) + :value t) + (const nil) + (regexp :format "%t: %v\n" :size 0))) (defcustom gnus-ignored-newsgroups (mapconcat 'identity @@ -263,8 +295,8 @@ claim them." (repeat function))) (defcustom gnus-subscribe-newsgroup-hooks nil - "*Hooks run after you subscribe to a new group. The hooks will be called -with new group's name as argument." + "*Hooks run after you subscribe to a new group. +The hooks will be called with new group's name as argument." :group 'gnus-group-new :type 'hook) @@ -303,7 +335,7 @@ hierarchy in its entirety." :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. @@ -363,22 +395,34 @@ This hook is called as the first thing when Gnus is started." :group 'gnus-start :type 'hook) -(defcustom gnus-setup-news-hook nil +(defcustom gnus-setup-news-hook + '(gnus-fixup-nnimap-unread-after-getting-new-news) "A hook after reading the .newsrc file, but before generating the buffer." :group 'gnus-start :type 'hook) +(defcustom gnus-get-top-new-news-hook nil + "A hook run just before Gnus checks for new news globally." + :group 'gnus-group-new + :type 'hook) + (defcustom gnus-get-new-news-hook nil "A hook run just before Gnus checks for new news." :group 'gnus-group-new :type 'hook) (defcustom gnus-after-getting-new-news-hook - '(gnus-display-time-event-handler) + '(gnus-display-time-event-handler + gnus-fixup-nnimap-unread-after-getting-new-news) "*A hook run after Gnus checks for new news when Gnus is already running." :group 'gnus-group-new :type 'hook) +(defcustom gnus-read-newsrc-el-hook nil + "A hook called after reading the newsrc.eld? file." + :group 'gnus-newsrc + :type 'hook) + (defcustom gnus-save-newsrc-hook nil "A hook called before saving any of the newsrc files." :group 'gnus-newsrc @@ -396,6 +440,12 @@ Can be used to turn version control on or off." :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 @@ -403,11 +453,8 @@ Can be used to turn version control on or off." ;;; Internal variables -(defvar gnus-startup-file-coding-system 'binary - "*Coding system for startup file.") - (defvar gnus-ding-file-coding-system mm-universal-coding-system - "*Coding system for ding file.") + "Coding system for ding file.") (defvar gnus-newsrc-file-version nil) (defvar gnus-override-subscribe-method nil) @@ -435,21 +482,15 @@ Can be used to turn version control on or off." (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 @@ -525,7 +566,7 @@ Can be used to turn version control on or off." (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) @@ -535,7 +576,7 @@ Can be used to turn version control on or off." (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)) @@ -581,8 +622,7 @@ the first newsgroup." ;; We subscribe the group by changing its level to `subscribed'. (gnus-group-change-level newsgroup gnus-level-default-subscribed - gnus-level-killed (gnus-gethash (or next "dummy.group") - gnus-newsrc-hashtb)) + gnus-level-killed (gnus-group-entry (or next "dummy.group"))) (gnus-message 5 "Subscribe newsgroup: %s" newsgroup) (run-hook-with-args 'gnus-subscribe-newsgroup-hooks newsgroup) t)) @@ -594,16 +634,21 @@ the first newsgroup." ;;; General various misc type functions. ;; Silence byte-compiler. -(defvar gnus-current-headers) -(defvar gnus-thread-indent-array) -(defvar gnus-newsgroup-name) -(defvar gnus-newsgroup-headers) -(defvar gnus-group-list-mode) -(defvar gnus-group-mark-positions) -(defvar gnus-newsgroup-data) -(defvar gnus-newsgroup-unreads) -(defvar nnoo-state-alist) -(defvar gnus-current-select-method) +(eval-when-compile + (defvar gnus-current-headers) + (defvar gnus-thread-indent-array) + (defvar gnus-newsgroup-name) + (defvar gnus-newsgroup-headers) + (defvar gnus-group-list-mode) + (defvar gnus-group-mark-positions) + (defvar gnus-newsgroup-data) + (defvar gnus-newsgroup-unreads) + (defvar nnoo-state-alist) + (defvar gnus-current-select-method) + (defvar mail-sources) + (defvar nnmail-scan-directory-mail-source-once) + (defvar nnmail-split-history) + (defvar nnmail-spool-file)) (defun gnus-close-all-servers () "Close all servers." @@ -614,13 +659,17 @@ the first newsgroup." (defun gnus-clear-system () "Clear all variables and buffers." ;; Clear Gnus variables. - (let ((variables gnus-variable-list)) + (let ((variables (remove 'gnus-format-specs gnus-variable-list))) (while variables (set (car variables) nil) (setq variables (cdr variables)))) ;; Clear other internal variables. (setq gnus-list-of-killed-groups nil gnus-have-read-active-file nil + gnus-agent-covered-methods nil + gnus-agent-file-loading-local nil + gnus-agent-file-loading-cache nil + gnus-server-method-cache nil gnus-newsrc-alist nil gnus-newsrc-hashtb nil gnus-killed-list nil @@ -655,9 +704,8 @@ the first newsgroup." (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)) @@ -695,6 +743,8 @@ prompt the user for the name of an NNTP server to use." (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) @@ -726,12 +776,10 @@ prompt the user for the name of an NNTP server to use." (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) @@ -745,23 +793,12 @@ prompt the user for the name of an NNTP server to use." (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)))) - ;;; ;;; Dribble file @@ -788,7 +825,11 @@ cautiously -- unloading may cause trouble." (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 + ;; 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) @@ -900,10 +941,17 @@ If LEVEL is non-nil, the news will be set up at level LEVEL." ;; 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. @@ -911,6 +959,15 @@ If LEVEL is non-nil, the news will be set up at level LEVEL." (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 @@ -977,7 +1034,7 @@ If LEVEL is non-nil, the news will be set up at level LEVEL." "Call METHOD to subscribe GROUP. If no function returns `non-nil', call `gnus-subscribe-zombies'." (unless (cond - ((gnus-functionp method) + ((functionp method) (funcall method group)) ((listp method) (catch 'found @@ -1161,10 +1218,8 @@ for new groups, and subscribe the new groups as zombies." (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) @@ -1201,12 +1256,14 @@ for new groups, and subscribe the new groups as zombies." 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) @@ -1241,16 +1298,16 @@ for new groups, and subscribe the new groups as zombies." (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. @@ -1274,8 +1331,7 @@ for new groups, and subscribe the new groups as zombies." 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))))) @@ -1335,7 +1391,7 @@ for new groups, and subscribe the new groups as zombies." (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))))) @@ -1346,7 +1402,7 @@ for new groups, and subscribe the new groups as zombies." (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. @@ -1374,14 +1430,14 @@ newsgroup." (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 @@ -1436,24 +1492,37 @@ newsgroup." (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 @@ -1466,10 +1535,19 @@ newsgroup." (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. @@ -1536,13 +1614,15 @@ newsgroup." (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 @@ -1554,12 +1634,15 @@ newsgroup." gnus-activate-foreign-newsgroups) (t 0)) level)) - scanned-methods info group active method retrieve-groups) - (gnus-message 5 "Checking new news...") + (methods-cache nil) + (type-cache nil) + scanned-methods info group active method retrieve-groups cmethod + method-type) + (gnus-message 6 "Checking new news...") (while newsrc (setq active (gnus-active (setq group (gnus-info-group - (setq info (pop newsrc)))))) + (setq info (pop newsrc)))))) ;; Check newsgroups. If the user doesn't want to check them, or ;; they can't be checked (for instance, if the news server can't @@ -1573,57 +1656,69 @@ newsgroup." ;; 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 retrieve-groups) - (setcdr (assoc method retrieve-groups) - (cons group (cdr (assoc method retrieve-groups)))) - (push (list method group) retrieve-groups)) - ;; hack: `nnmail-get-new-mail' changes the mail-source depending - ;; on the group, so we must perform a scan for every group - ;; if the users has any directory mail sources. - ;; hack: if `nnmail-scan-directory-mail-source-once' is non-nil, - ;; for it scan all spool files even when the groups are - ;; not required. - (if (and - (or nnmail-scan-directory-mail-source-once - (null (assq 'directory - (or mail-sources - (if (listp nnmail-spool-file) - nnmail-spool-file - (list nnmail-spool-file)))))) - (member method scanned-methods)) - (setq active (gnus-activate-group group)) - (setq active (gnus-activate-group group 'scan)) - (push method scanned-methods)) - (when active - (gnus-close-group group)))))) + (when (setq method (gnus-info-method info)) + (if (setq cmethod (assoc method methods-cache)) + (setq method (cdr cmethod)) + (setq cmethod (inline (gnus-server-get-method nil method))) + (push (cons method cmethod) methods-cache) + (setq method cmethod))) + (when (and method + (not (setq method-type (cdr (assoc method type-cache))))) + (setq method-type + (cond + ((gnus-secondary-method-p method) + 'secondary) + ((inline (gnus-server-equal gnus-select-method method)) + 'primary) + (t + 'foreign))) + (push (cons method method-type) type-cache)) + + (cond ((and method (eq method-type 'foreign)) + ;; These groups are foreign. Check the level. + (when (and (<= (gnus-info-level info) foreign-level) + (setq active (gnus-activate-group group 'scan))) + ;; Let the Gnus agent save the active file. + (when (and gnus-agent active (gnus-online method)) + (gnus-agent-save-group-info + method (gnus-group-real-name group) active)) + (unless (inline (gnus-virtual-group-p group)) + (inline (gnus-close-group group))) + (when (fboundp (intern (concat (symbol-name (car method)) + "-request-update-info"))) + (inline (gnus-request-update-info info method))))) + ;; These groups are native or secondary. + ((> (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 @@ -1636,7 +1731,7 @@ newsgroup." ;; The group couldn't be reached, so we nix out the number of ;; unread articles and stuff. (gnus-set-active group nil) - (let ((tmp (gnus-gethash group gnus-newsrc-hashtb))) + (let ((tmp (gnus-group-entry group))) (when tmp (setcar tmp t)))))) @@ -1650,8 +1745,8 @@ newsgroup." (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) + (mapcar (lambda (group) (gnus-group-real-name group)) groups) + method) (dolist (group groups) (cond ((setq active (gnus-active (gnus-info-group @@ -1661,9 +1756,9 @@ newsgroup." ;; The group couldn't be reached, so we nix out the number of ;; unread articles and stuff. (gnus-set-active group nil) - (setcar (gnus-gethash group gnus-newsrc-hashtb) t))))))) + (setcar (gnus-group-entry group) t))))))) - (gnus-message 5 "Checking new news...done"))) + (gnus-message 6 "Checking new news...done"))) ;; Create a hash table out of the newsrc alist. The `car's of the ;; alist elements are used as keys. @@ -1713,9 +1808,9 @@ newsgroup." (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 @@ -1723,8 +1818,81 @@ newsgroup." (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. @@ -1790,13 +1958,15 @@ newsgroup." ;; 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) @@ -1820,10 +1990,10 @@ newsgroup." (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))) @@ -1841,7 +2011,7 @@ newsgroup." (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) @@ -1888,7 +2058,7 @@ newsgroup." (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 @@ -1908,9 +2078,9 @@ newsgroup." (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))) @@ -1942,7 +2112,7 @@ newsgroup." (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))))) @@ -1964,10 +2134,10 @@ newsgroup." ;; 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)) @@ -2005,7 +2175,7 @@ newsgroup." "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)) + (let ((variables (remove 'gnus-format-specs gnus-variable-list))) (while variables (set (car variables) nil) (setq variables (cdr variables)))) @@ -2043,17 +2213,91 @@ If FORCE is non-nil, the .newsrc file is read." (gnus-convert-old-newsrc)))) (defun gnus-convert-old-newsrc () - "Convert old newsrc into the new format, if needed." + "Convert old newsrc formats into the current format, if needed." (let ((fcv (and gnus-newsrc-file-version (gnus-continuum-version gnus-newsrc-file-version)))) - (cond - ;; No .newsrc.eld file was loaded. - ((null fcv) nil) - ;; Gnus 5 .newsrc.eld was loaded. - ((< fcv (gnus-continuum-version "September Gnus v0.1")) - (gnus-convert-old-ticks))))) - -(defun gnus-convert-old-ticks () + (when fcv + ;; A .newsrc.eld file was loaded. + (let (prompt-displayed + (converters + (sort + (mapcar (lambda (date-func) + (cons (gnus-continuum-version (car date-func)) + date-func)) + ;; This is a list of converters that must be run + ;; to bring the newsrc file up to the current + ;; version. If you create an incompatibility + ;; with older versions, you should create an + ;; entry here. The entry should consist of the + ;; current gnus version (hardcoded so that it + ;; doesn't change with each release) and the + ;; function that must be applied to convert the + ;; previous version into the current version. + '(("September Gnus v0.1" nil + gnus-convert-old-ticks) + ("Oort Gnus v0.08" "legacy-gnus-agent" + gnus-agent-convert-to-compressed-agentview) + ("No Gnus v0.2" "legacy-gnus-agent" + gnus-agent-unlist-expire-days) + ("No Gnus v0.2" "legacy-gnus-agent" + gnus-agent-unhook-expire-days))) + #'car-less-than-car))) + ;; Skip converters older than the file version + (while (and converters (>= fcv (caar converters))) + (pop converters)) + + ;; Perform converters to bring older version up to date. + (when (and converters (< fcv (caar converters))) + (while (and converters (< fcv (caar converters))) + (let* ((converter-spec (pop converters)) + (convert-to (nth 1 converter-spec)) + (load-from (nth 2 converter-spec)) + (func (nth 3 converter-spec))) + (when (and load-from + (not (fboundp func))) + (load load-from t)) + + (or prompt-displayed + (not (gnus-convert-converter-needs-prompt func)) + (while (let (c + (cursor-in-echo-area t) + (echo-keystrokes 0)) + (message "Convert newsrc 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 using old (unconverted) newsrc")) + ((or (eq c ?y) (eq c ?Y)) + (setq prompt-displayed t) + nil) + ((eq c ?\?) + (message "This conversion is irreversible. \ + 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 newsrc from version '%s' to '%s'? (n/y/?)" + gnus-newsrc-file-version gnus-version))))))) + +(defun gnus-convert-mark-converter-prompt (converter no-prompt) + (setplist converter + (let* ((symbol 'gnus-convert-no-prompt) + (value (delq symbol (symbol-plist converter)))) + (if no-prompt + (cons symbol value) + value)))) + +(defun gnus-convert-converter-needs-prompt (converter) + (not (memq 'gnus-convert-no-prompt (symbol-plist converter)))) + +(defun gnus-convert-old-ticks (converting-to) (let ((newsrc (cdr gnus-newsrc-alist)) marks info dormant ticked) (while (setq info (pop newsrc)) @@ -2068,36 +2312,48 @@ If FORCE is non-nil, the .newsrc file is read." (nconc (gnus-uncompress-range dormant) (gnus-uncompress-range ticked))))))))) +(defun gnus-load (file) + "Load FILE, but in such a way that read errors can be reported." + (with-temp-buffer + (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-ding-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)))) - ;; 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.090002)) - (setq gnus-format-specs nil))) - (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) + (let ((coding-system-for-read gnus-ding-file-coding-system)) + (gnus-load ding-file)) + ;; 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))) + (gnus-run-hooks 'gnus-read-newsrc-el-hook)) ;; Parse the old-style quick startup file (defun gnus-read-old-newsrc-el-file (file) @@ -2205,10 +2461,10 @@ If FORCE is non-nil, the .newsrc file is read." ;; 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 @@ -2276,8 +2532,8 @@ If FORCE is non-nil, the .newsrc file is read." ;; 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 @@ -2386,9 +2642,9 @@ If FORCE is non-nil, the .newsrc file is read." (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)) ?!) @@ -2409,12 +2665,22 @@ If FORCE is non-nil, the .newsrc file is read." (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) @@ -2432,48 +2698,104 @@ If FORCE is non-nil, the .newsrc file is read." (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-ding-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) + (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)) +(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")) - (insert ";; -*- emacs-lisp -*-\n") - (insert ";; Gnus startup file.\n") - (insert "\ + (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) @@ -2481,9 +2803,11 @@ If FORCE is non-nil, the .newsrc file is read." (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-strip-killed-list () "Return the killed list minus the groups that match `gnus-save-killed-list'." @@ -2560,14 +2884,14 @@ If FORCE is non-nil, the .newsrc file is read." (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-ding-file-coding-system)) @@ -2696,7 +3020,9 @@ If FORCE is non-nil, the .newsrc file is read." (name (symbol-name group)) (charset (or (gnus-group-name-charset method name) - (gnus-parameter-charset name)))) + (gnus-parameter-charset name) + gnus-default-charset))) + ;; Fixme: Don't decode in unibyte mode. (when (and str charset (featurep 'mule)) (setq str (mm-decode-coding-string str charset))) (set group str))) @@ -2715,7 +3041,7 @@ If FORCE is non-nil, the .newsrc file is read." ;;;###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)))) @@ -2730,11 +3056,30 @@ If this variable is nil, don't do anything." (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))) +(eval-and-compile +(defalias 'gnus-display-time-event-handler + (if (gnus-boundp 'display-time-timer) + 'display-time-event-handler + (lambda () "Does nothing as `display-time-timer' is not bound. +Would otherwise be an alias for `display-time-event-handler'." nil)))) + +;;;###autoload +(defun gnus-fixup-nnimap-unread-after-getting-new-news () + (let (server group info) + (mapatoms + (lambda (sym) + (when (and (setq group (symbol-name sym)) + (gnus-group-entry group) + (setq info (symbol-value sym))) + (gnus-sethash group (cons (nth 2 info) (cdr (gnus-group-entry group))) + gnus-newsrc-hashtb))) + (if (boundp 'nnimap-mailbox-info) + (symbol-value 'nnimap-mailbox-info) + (make-vector 1 0))))) + (provide 'gnus-start) ;;; gnus-start.el ends here + +