emacs: lisp/gnus/gnus-start.el comparison

comparison lisp/gnus/gnus-start.el @ 31716:9968f55ad26e

Update to emacs-21-branch of the Gnus CVS repository.

author	Gerd Moellmann <gerd@gnu.org>
date	Tue, 19 Sep 2000 13:37:09 +0000
parents	fb6b9c37cdc4
children	65104da03c90

comparison

equal deleted inserted replaced

-:7c896543d225
+:9968f55ad26e
 ;;; gnus-start.el --- startup functions for Gnus
-;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000
+;;        Free Software Foundation, Inc.
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
 ;; This file is part of GNU Emacs.
 (condition-case nil
 (concat (file-name-directory
 	       (directory-file-name installation-directory))
 	      "site-lisp/gnus-init")
 (error nil))
-"*The site-wide Gnus Emacs-Lisp startup file name, or nil if none.
+"The site-wide Gnus Emacs-Lisp startup file name, or nil if none.
 If a file with the `.el' or `.elc' suffixes exists, it will be read instead."
 :group 'gnus-start
 :type '(choice file (const nil)))
 (defcustom gnus-default-subscribed-newsgroups nil
 :group 'gnus-start-server
 :type '(choice (const nil)
 		 (const some)
 		 (const t)))
-(defcustom gnus-level-subscribed 5
+(defconst gnus-level-subscribed 5
-"*Groups with levels less than or equal to this variable are subscribed."
+"Groups with levels less than or equal to this variable are subscribed.")
-:group 'gnus-group-levels
-:type 'integer)
+(defconst gnus-level-unsubscribed 7
+"Groups with levels less than or equal to this variable are unsubscribed.
-(defcustom gnus-level-unsubscribed 7
-"*Groups with levels less than or equal to this variable are unsubscribed.
 Groups with levels less than `gnus-level-subscribed', which should be
-less than this variable, are subscribed."
+less than this variable, are subscribed.")
-:group 'gnus-group-levels
-:type 'integer)
+(defconst gnus-level-zombie 8
+"Groups with this level are zombie groups.")
-(defcustom gnus-level-zombie 8
-"*Groups with this level are zombie groups."
+(defconst gnus-level-killed 9
-:group 'gnus-group-levels
+"Groups with this level are killed.")
-:type 'integer)
-(defcustom gnus-level-killed 9
-"*Groups with this level are killed."
-:group 'gnus-group-levels
-:type 'integer)
 (defcustom gnus-level-default-subscribed 3
 "*New subscribed groups will be subscribed at this level."
 :group 'gnus-group-levels
 :type 'integer)
 but you won't be told how many unread articles there are in the
 groups."
 :group 'gnus-group-levels
 :type '(choice integer
 		 (const :tag "none" nil)))
+(defcustom gnus-read-newsrc-file t
+"*Non-nil means that Gnus will read the `.newsrc' file.
+Gnus always reads its own startup file, which is called
+\".newsrc.eld\".  The file called \".newsrc\" is in a format that can
+be readily understood by other newsreaders.  If you don't plan on
+using other newsreaders, set this variable to nil to save some time on
+entry."
+:group 'gnus-newsrc
+:type 'boolean)
 (defcustom gnus-save-newsrc-file t
 "*Non-nil means that Gnus will save the `.newsrc' file.
 Gnus always saves its own startup file, which is called
 \".newsrc.eld\".  The file called \".newsrc\" is in a format that can
 not match this regexp will be removed before saving the list."
 :group 'gnus-newsrc
 :type 'boolean)
 (defcustom gnus-ignored-newsgroups
-(purecopy (mapconcat 'identity
+(mapconcat 'identity
-		       '("^to\\."	; not "real" groups
+	     '("^to\\."			; not "real" groups
-			 "^[0-9. \t]+ " ; all digits in name
+	       "^[0-9. \t]+ "		; all digits in name
-			 "[][\"#'()]"	; bogus characters
+	       "^[\"][]\"[#'()]"	; bogus characters
-			 )
+	       )
-		       "\\|"))
+	     "\\|")
 "*A regexp to match uninteresting newsgroups in the active file.
 Any lines in the active file matching this regular expression are
 removed from the newsgroup list before anything else is done to it,
 thus making them effectively non-existent."
 :group 'gnus-group-new
 inserts new groups at the beginning of the list of groups;
 `gnus-subscribe-alphabetically' inserts new groups in strict
 alphabetic order; `gnus-subscribe-hierarchically' inserts new groups
 in hierarchical newsgroup order; `gnus-subscribe-interactively' asks
 for your decision; `gnus-subscribe-killed' kills all new groups;
-`gnus-subscribe-zombies' will make all new groups into zombies."
+`gnus-subscribe-zombies' will make all new groups into zombies;
+`gnus-subscribe-topics' will enter groups into the topics that
+claim them."
 :group 'gnus-group-new
 :type '(radio (function-item gnus-subscribe-randomly)
 		(function-item gnus-subscribe-alphabetically)
 		(function-item gnus-subscribe-hierarchically)
 		(function-item gnus-subscribe-interactively)
 		(function-item gnus-subscribe-killed)
 		(function-item gnus-subscribe-zombies)
+		(function-item gnus-subscribe-topics)
 		function))
 (defcustom gnus-subscribe-options-newsgroup-method
 'gnus-subscribe-alphabetically
 "*This function is called to subscribe newsgroups mentioned on \"options -n\" lines.
 :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."
+"*A hook run after Gnus checks for new news when Gnus is already running."
 :group 'gnus-group-new
 :type 'hook)
 (defcustom gnus-save-newsrc-hook nil
 "A hook called before saving any of the newsrc files."
 Can be used to turn version control on or off."
 :group 'gnus-newsrc
 :type 'hook)
 (defcustom gnus-always-read-dribble-file nil
-"Uncoditionally read the dribble file."
+"Unconditionally read the dribble file."
 :group 'gnus-newsrc
 :type 'boolean)
-(defvar gnus-startup-file-coding-system 'binary
-"*Coding system for startup file.")
 (defvar gnus-startup-file-coding-system 'binary
 "*Coding system for startup file.")
 ;;; Internal variables
 	gnus-group-mark-positions nil
 	gnus-newsgroup-data 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.
 (and gnus-current-startup-file
 (get-file-buffer gnus-current-startup-file)
 (gnus-group-set-parameter
 "nndraft:drafts" 'gnus-dummy '((gnus-draft-mode)))))
 ;;;###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)
+(dolist (feature features)
-(error "Sorry, `gnus-unload' is not implemented in this Emacs version"))
+(if (string-match "^\\(gnus-\\|nn\\|mm-\\|rfc\\)" (symbol-name feature))
-(let ((history load-history)
+	(unload-feature feature 'force))))
-	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)))))
 ;;;
 ;;; Dribble file
 ;;;
 			(gnus-get-buffer-create
 			 (file-name-nondirectory dribble-file))))
 (erase-buffer)
 (setq buffer-file-name dribble-file)
 (auto-save-mode t)
-(buffer-disable-undo (current-buffer))
+(buffer-disable-undo)
 (bury-buffer (current-buffer))
 (set-buffer-modified-p nil)
 (let ((auto (make-auto-save-file-name))
 	    (gnus-dribble-ignore t)
 	    modes)
 (defun gnus-setup-news (&optional rawfile level dont-connect)
 "Setup news information.
 If RAWFILE is non-nil, the .newsrc file will also be read.
 If LEVEL is non-nil, the news will be set up at level LEVEL."
-(let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile)))))
+(require 'nnmail)
+(let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile))))
+	;; Binding this variable will inhibit multiple fetchings
+	;; of the same mail source.
+	(nnmail-fetched-sources (list t)))
 (when init
 ;; Clear some variables to re-initialize news information.
 (setq gnus-newsrc-alist nil
 	    gnus-active-hashtb nil)
 	       (gnus-server-opened gnus-select-method))
 (gnus-check-bogus-newsgroups))))
 (defun gnus-find-new-newsgroups (&optional arg)
 "Search for new newsgroups and add them.
-Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method.'
+Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method'.
 The `-n' option line from .newsrc is respected.
 With 1 C-u, use the `ask-server' method to query the server for new
 groups.
 With 2 C-u's, use most complete method possible to query the server
 for new groups, and subscribe the new groups as zombies."
 (interactive "p")
 (let* ((gnus-subscribe-newsgroup-method
 	  gnus-subscribe-newsgroup-method)
 	 (check (cond
-		((or (and (= (or arg 1) 4)
+		 ((or (and (= (or arg 1) 4)
-			  (not (listp gnus-check-new-newsgroups)))
+			   (not (listp gnus-check-new-newsgroups)))
-		     (null gnus-read-active-file)
+		      (null gnus-read-active-file)
-		     (eq gnus-read-active-file 'some))
+		      (eq gnus-read-active-file 'some))
-		 'ask-server)
+		  'ask-server)
-		((= (or arg 1) 16)
+		 ((= (or arg 1) 16)
-		 (setq gnus-subscribe-newsgroup-method
+		  (setq gnus-subscribe-newsgroup-method
-		       'gnus-subscribe-zombies)
+			'gnus-subscribe-zombies)
-		 t)
+		  t)
-		(t gnus-check-new-newsgroups))))
+		 (t gnus-check-new-newsgroups))))
 (unless (gnus-check-first-time-used)
 (if (or (consp check)
 	      (eq check 'ask-server))
 	  ;; Ask the server for new groups.
 	  (gnus-ask-server-for-new-groups)
 		     (push group new-newsgroups)
 		   (funcall gnus-subscribe-newsgroup-method group)))))))
 	 hashtb))
 (when new-newsgroups
 	(gnus-subscribe-hierarchical-interactive new-newsgroups)))
 (if (> groups 0)
-	 (gnus-message 5 "%d new newsgroup%s arrived"
+	(gnus-message 5 "%d new newsgroup%s arrived"
-		       groups (if (> groups 1) "s have" " has"))
+		      groups (if (> groups 1) "s have" " has"))
 (gnus-message 5 "No new newsgroups"))
 (when got-new
 (setq gnus-newsrc-last-checked-date new-date))
 got-new))
 (defun gnus-check-first-time-used ()
-(if (or (> (length gnus-newsrc-alist) 1)
+(catch 'ended
-	  (file-exists-p gnus-startup-file)
+;; First check if any of the following files exist.  If they do,
-	  (file-exists-p (concat gnus-startup-file ".el"))
+;; it's not the first time the user has used Gnus.
-	  (file-exists-p (concat gnus-startup-file ".eld")))
+(dolist (file (list gnus-current-startup-file
-nil
+			(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)
+;; Subscribe to the default newsgroups.
+(let ((groups (or gnus-default-subscribed-newsgroups
+		      gnus-backup-default-subscribed-newsgroups))
 	  group)
-(if (eq groups t)
+(when (eq groups t)
-	  nil
+	;; If t, we subscribe (or not) all groups as if they were new.
-	(setq groups (or groups gnus-backup-default-subscribed-newsgroups))
 	(mapatoms
 	 (lambda (sym)
-	   (if (null (setq group (symbol-name 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)
-	(while groups
+	(dolist (group groups)
-	  (when (gnus-active (car 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))
+	     group gnus-level-default-subscribed gnus-level-killed)))
-	  (setq groups (cdr groups)))
 	(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 previous &optional method)
+(defun gnus-subscribe-group (group &optional previous method)
+"Subcribe GROUP and put it after PREVIOUS."
 (gnus-group-change-level
 (if method
 (list t group gnus-level-default-subscribed nil nil method)
 group)
-gnus-level-default-subscribed gnus-level-killed previous t))
+gnus-level-default-subscribed gnus-level-killed previous t)
+t)
 ;; `gnus-group-change-level' is the fundamental function for changing
 ;; subscription levels of newsgroups.  This might mean just changing
 ;; from level 1 to 2, which is pretty trivial, from 2 to 6 or back
 ;; again, which subscribes/unsubscribes a group, which is equally
 	      (setq info (cdr entry)
 		    num (car entry))
 	    (setq active (gnus-active group))
 	    (setq num
 		  (if active (- (1+ (cdr active)) (car active)) t))
-	    ;; Check whether the group is foreign.  If so, the
+	    ;; Shorten the select method if possible, if we need to
-	    ;; foreign select method has to be entered into the
+	    ;; store it at all (native groups).
-	    ;; info.
+	    (let ((method (gnus-method-simplify
-	    (let ((method (or gnus-override-subscribe-method
+			   (or gnus-override-subscribe-method
-			      (gnus-group-method group))))
+			       (gnus-group-method group)))))
-	      (if (eq method gnus-select-method)
+	      (if method
-		  (setq info (list group level nil))
+		  (setq info (list group level nil nil method))
-		(setq info (list group level nil nil method)))))
+		(setq info (list group level nil)))))
 	  (unless previous
 	    (setq previous
 		  (let ((p gnus-newsrc-alist))
 		    (while (cddr p)
 		      (setq p (cdr p)))
 		(gnus-check-backend-function 'request-scan (car method))
 		(gnus-request-scan group method))
 	   t)
 	 (condition-case ()
 	     (inline (gnus-request-group group dont-check method))
-	   (error nil)
+	   ;;(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
 		   (< (cdar range) (car active)))
 	  (setcdr (car range) (1- (car active))))
 	;; Then we want to peel off any elements that are higher
 	;; than the upper active limit.
 	(let ((srange range))
-	  ;; Go past all legal elements.
+	  ;; Go past all valid elements.
 	  (while (and (cdr srange)
 		      (<= (or (and (atom (cadr srange))
 				   (cadr srange))
 			      (caadr srange))
 			  (cdr active)))
 	    (setq srange (cdr srange)))
 	  (when (cdr srange)
-	    ;; Nuke all remaining illegal elements.
+	    ;; Nuke all remaining invalid elements.
 	    (setcdr srange nil))
 	  ;; Adjust the final element.
 	  (when (and (not (atom (car srange)))
 		     (> (cdar srange) (cdr active)))
 		  (1+ gnus-level-subscribed))
 		 ((numberp gnus-activate-foreign-newsgroups)
 		  gnus-activate-foreign-newsgroups)
 		 (t 0))
 	   level))
-	 info group active method)
+	 scanned-methods info group active method retrievegroups)
 (gnus-message 5 "Checking new news...")
 (while newsrc
 (setq active (gnus-active (setq group (gnus-info-group
 					     (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
 ;; be reached) we just set the number of unread articles in this
 ;; newsgroup to t.  This means that Gnus thinks that there are
 ;; unread articles, but it has no idea how many.
+;; To be more explicit:
+;; >0 for an active group with messages
+;; 0 for an active group with no unread messages
+;; nil for non-foreign groups that the user has requested not be checked
+;; t for unchecked foreign groups or bogus groups, or groups that can't
+;;   be checked, for one reason or other.
 (if (and (setq method (gnus-info-method info))
 	       (not (inline
 		      (gnus-server-equal
 		       gnus-select-method
 		       (setq method (gnus-server-get-method nil method)))))
 	       (not (gnus-secondary-method-p method)))
 	  ;; These groups are foreign.  Check the level.
-	  (when (<= (gnus-info-level info) foreign-level)
+	  (when (and (<= (gnus-info-level info) foreign-level)
-	    (setq active (gnus-activate-group group 'scan))
+(setq active (gnus-activate-group group 'scan)))
 	    ;; Let the Gnus agent save the active file.
 	    (when (and gnus-agent gnus-plugged active)
 	      (gnus-agent-save-group-info
 	       method (gnus-group-real-name group) active))
 	    (unless (inline (gnus-virtual-group-p group))
 	      (inline (gnus-close-group group)))
 	    (when (fboundp (intern (concat (symbol-name (car method))
 					   "-request-update-info")))
 	      (inline (gnus-request-update-info info method))))
 	;; These groups are native or secondary.
-	(when (and (<= (gnus-info-level info) level)
+	(cond
-		   (not gnus-read-active-file))
+	 ;; We don't want these groups.
-	  (setq active (gnus-activate-group group 'scan))
+	 ((> (gnus-info-level info) level)
-	  (inline (gnus-close-group group))))
+	  (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))))))
 ;; Get the number of unread articles in the group.
-(if active
+(cond
-	  (inline (gnus-get-unread-articles-in-group info active t))
+((eq active 'ignore)
+	;; Don't do anything.
+	)
+(active
+	(inline (gnus-get-unread-articles-in-group info active t)))
+(t
 	;; The group couldn't be reached, so we nix out the number of
 	;; unread articles and stuff.
 	(gnus-set-active group nil)
-	(setcar (gnus-gethash group gnus-newsrc-hashtb) t)))
+	(let ((tmp (gnus-gethash group gnus-newsrc-hashtb)))
+	  (if 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)))
+	(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")))
 ;; Create a hash table out of the newsrc alist.  The `car's of the
 ;; alist elements are used as keys.
 ;; Get the active file(s) from the backend(s).
 (defun gnus-read-active-file (&optional force not-native)
 (gnus-group-set-mode-line)
 (let ((methods
-	 (append
+	 (mapcar
-	  (if (and (not not-native)
+	  (lambda (m) (if (stringp m) (gnus-server-get-method nil m) m))
-		   (gnus-check-server gnus-select-method))
+	  (append
-	      ;; The native server is available.
+	   (if (and (not not-native)
-	      (cons gnus-select-method gnus-secondary-select-methods)
+		    (gnus-check-server gnus-select-method))
-	    ;; The native server is down, so we just do the
+	       ;; The native server is available.
-	    ;; secondary ones.
+	       (cons gnus-select-method gnus-secondary-select-methods)
-	    gnus-secondary-select-methods)
+	     ;; The native server is down, so we just do the
-	  ;; Also read from the archive server.
+	     ;; secondary ones.
-	  (when (gnus-archive-server-wanted-p)
+	     gnus-secondary-select-methods)
-	    (list "archive"))))
+	   ;; Also read from the archive server.
-	list-type)
+	   (when (gnus-archive-server-wanted-p)
+	     (list "archive")))))
+	method)
 (setq gnus-have-read-active-file nil)
 (save-excursion
 (set-buffer nntp-server-buffer)
-(while methods
+(while (setq method (pop methods))
-	(let* ((method (if (stringp (car methods))
+	;; Only do each method once, in case the methods appear more
-			   (gnus-server-get-method nil (car methods))
+	;; than once in this list.
-			 (car methods)))
+	(unless (member method methods)
-	       (where (nth 1 method))
+	  (condition-case ()
-	       (mesg (format "Reading active file%s via %s..."
+	      (gnus-read-active-file-1 method force)
-			     (if (and where (not (zerop (length where))))
+	    ;; We catch C-g so that we can continue past servers
-				 (concat " from " where) "")
+	    ;; that do not respond.
-			     (car method))))
+	    (quit nil)))))))
+(defun gnus-read-active-file-1 (method force)
+(let (where mesg)
+(setq where (nth 1 method)
+	  mesg (format "Reading active file%s via %s..."
+		       (if (and where (not (zerop (length where))))
+			   (concat " from " where) "")
+		       (car method)))
+(gnus-message 5 mesg)
+(when (gnus-check-server method)
+;; Request that the backend scan its incoming messages.
+(when (gnus-check-backend-function 'request-scan (car method))
+	(gnus-request-scan nil method))
+(cond
+((and (eq gnus-read-active-file 'some)
+	     (gnus-check-backend-function 'retrieve-groups (car method))
+	     (not force))
+	(let ((newsrc (cdr gnus-newsrc-alist))
+	      (gmethod (gnus-server-get-method nil method))
+	      groups info)
+	  (while (setq info (pop newsrc))
+	    (when (inline
+		    (gnus-server-equal
+		     (inline
+		       (gnus-find-method-for-group
+			(gnus-info-group info) info))
+		     gmethod))
+	      (push (gnus-group-real-name (gnus-info-group info))
+		    groups)))
+	  (gnus-read-active-file-2 groups method)))
+((null method)
+	t)
+(t
+	(if (not (gnus-request-list method))
+	    (unless (equal method gnus-message-archive-method)
+	      (gnus-error 1 "Cannot read active file from %s server"
+			  (car method)))
 	  (gnus-message 5 mesg)
-	  (when (gnus-check-server method)
+	  (gnus-active-to-gnus-format method gnus-active-hashtb nil t)
-	    ;; Request that the backend scan its incoming messages.
+	  ;; We mark this active file as read.
-	    (when (gnus-check-backend-function 'request-scan (car method))
+	  (push method gnus-have-read-active-file)
-	      (gnus-request-scan nil method))
+	  (gnus-message 5 "%sdone" mesg)))))))
-	    (cond
-	     ((and (eq gnus-read-active-file 'some)
+(defun gnus-read-active-file-2 (groups method)
-		   (gnus-check-backend-function 'retrieve-groups (car method))
+"Read an active file for GROUPS in METHOD using gnus-retrieve-groups."
-		   (not force))
+(when groups
-	      (let ((newsrc (cdr gnus-newsrc-alist))
+(save-excursion
-		    (gmethod (gnus-server-get-method nil method))
+(set-buffer nntp-server-buffer)
-		    groups info)
+(gnus-check-server method)
-		(while (setq info (pop newsrc))
+(let ((list-type (gnus-retrieve-groups groups method)))
-		  (when (inline
+	(cond ((not list-type)
-			  (gnus-server-equal
+	       (gnus-error
-			   (inline
+		1.2 "Cannot read partial active file from %s server."
-			     (gnus-find-method-for-group
+		(car method)))
-			      (gnus-info-group info) info))
+	      ((eq list-type 'active)
-			   gmethod))
+	       (gnus-active-to-gnus-format method gnus-active-hashtb nil t))
-		    (push (gnus-group-real-name (gnus-info-group info))
+	      (t
-			  groups)))
+	       (gnus-groups-to-gnus-format method gnus-active-hashtb t)))))))
-		(when groups
-		  (gnus-check-server method)
-		  (setq list-type (gnus-retrieve-groups groups method))
-		  (cond
-		   ((not list-type)
-		    (gnus-error
-		     1.2 "Cannot read partial active file from %s server."
-		     (car method)))
-		   ((eq list-type 'active)
-		    (gnus-active-to-gnus-format
-		     method gnus-active-hashtb nil t))
-		   (t
-		    (gnus-groups-to-gnus-format
-		     method gnus-active-hashtb t))))))
-	     ((null method)
-	      t)
-	     (t
-	      (if (not (gnus-request-list method))
-		  (unless (equal method gnus-message-archive-method)
-		    (gnus-error 1 "Cannot read active file from %s server"
-				(car method)))
-		(gnus-message 5 mesg)
-		(gnus-active-to-gnus-format method gnus-active-hashtb nil t)
-		;; We mark this active file as read.
-		(push method gnus-have-read-active-file)
-		(gnus-message 5 "%sdone" mesg))))))
-	(setq methods (cdr methods))))))
-(defun gnus-ignored-newsgroups-has-to-p ()
-"Non-nil iff gnus-ignored-newsgroups includes \"^to\\\\.\" as an element."
-;; note this regexp is the same as:
-;; (concat (regexp-quote "^to\\.") "\\($\\|" (regexp-quote "\\|") "\\)")
-(string-match "\\^to\\\\\\.\\($\\|\\\\|\\)" gnus-ignored-newsgroups))
 ;; 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)
 (unless method
 				(gnus-make-hashtable
 				 (count-lines (point-min) (point-max)))
 			      (gnus-make-hashtable 4096)))))))
 ;; Delete unnecessary lines.
 (goto-char (point-min))
-(cond ((gnus-ignored-newsgroups-has-to-p)
+(cond
-	   (delete-matching-lines gnus-ignored-newsgroups))
+((string= gnus-ignored-newsgroups "")
-	  ((string= gnus-ignored-newsgroups "")
+(delete-matching-lines "^to\\."))
-	   (delete-matching-lines "^to\\."))
+(t
-	  (t
+(delete-matching-lines (concat "^to\\.\\|" gnus-ignored-newsgroups))))
-	   (delete-matching-lines (concat "^to\\.\\|"
-					  gnus-ignored-newsgroups))))
+(goto-char (point-min))
+(unless (re-search-forward "[\\\"]" nil t)
 ;; Make the group names readable as a lisp expression even if they
 ;; contain special characters.
 (goto-char (point-max))
 (while (re-search-backward "[][';?()#]" nil t)
-(insert ?\\))
+	(insert ?\\)))
 ;; Let the Gnus agent save the active file.
-(when (and gnus-agent real-active)
+(when (and gnus-agent real-active gnus-plugged)
 (gnus-agent-save-active method))
 ;; If these are groups from a foreign select method, we insert the
 ;; group prefix in front of the group names.
 (when (not (gnus-server-equal
 		(gnus-server-get-method nil method)
 		(gnus-server-get-method nil gnus-select-method)))
 (let ((prefix (gnus-group-prefixed-name "" method)))
 	(goto-char (point-min))
 	(while (and (not (eobp))
-		    (progn (insert prefix)
+		    (progn
-			   (zerop (forward-line 1)))))))
+		      (when (= (following-char) ?\")
+			(forward-char 1))
+		      (insert prefix)
+		      (zerop (forward-line 1)))))))
 ;; Store the active file in a hash table.
 (goto-char (point-min))
 (let (group max min)
 (while (not (eobp))
-	(condition-case ()
+	(condition-case err
 	    (progn
 	      (narrow-to-region (point) (gnus-point-at-eol))
 	      ;; group gets set to a symbol interned in the hash table
 	      ;; (what a hack!!) - jwz
 	      (setq group (let ((obarray hashtb)) (read cur)))
+	      ;; ### The extended group name scheme makes
+	      ;; the previous optimization strategy sort of pointless...
+	      (when (stringp group)
+		(setq group (intern group hashtb)))
 	      (if (and (numberp (setq max (read cur)))
 		       (numberp (setq min (read cur)))
 		       (progn
 			 (skip-chars-forward " \t")
 			 (not
-			  (or (= (following-char) ?=)
+			  (or (eq (char-after) ?=)
-			      (= (following-char) ?x)
+			      (eq (char-after) ?x)
-			      (= (following-char) ?j)))))
+			      (eq (char-after) ?j)))))
 		  (progn
 		    (set group (cons min max))
 		    ;; if group is moderated, stick in moderation table
-		    (when (= (following-char) ?m)
+		    (when (eq (char-after) ?m)
 		      (unless gnus-moderated-hashtb
 			(setq gnus-moderated-hashtb (gnus-make-hashtable)))
 		      (gnus-sethash (symbol-name group) t
 				    gnus-moderated-hashtb)))
 		(set group nil)))
 	  (error
 	   (and group
 		(symbolp group)
 		(set group nil))
 	   (unless ignore-errors
-	     (gnus-message 3 "Warning - illegal active: %s"
+	     (gnus-message 3 "Warning - invalid active: %s"
 			   (buffer-substring
 			    (gnus-point-at-bol) (gnus-point-at-eol))))))
 	(widen)
 	(forward-line 1)))))
 			   (gnus-server-get-method nil method)
 			   (gnus-server-get-method nil gnus-select-method)))
 		     (gnus-group-prefixed-name "" method))))
 ;; Let the Gnus agent save the active file.
-(when (and gnus-agent real-active)
+(if (and gnus-agent
-(gnus-agent-save-groups method))
+	     real-active
+	     gnus-plugged
-(goto-char (point-min))
+	     (gnus-agent-method-p method))
-;; We split this into to separate loops, one with the prefix
+	(progn
-;; and one without to speed the reading up somewhat.
+	  (gnus-agent-save-groups method)
-(if prefix
+	  (gnus-active-to-gnus-format method hashtb nil real-active))
-	(let (min max opoint group)
+(goto-char (point-min))
+;; We split this into to separate loops, one with the prefix
+;; and one without to speed the reading up somewhat.
+(if prefix
+	  (let (min max opoint group)
+	    (while (not (eobp))
+	      (condition-case ()
+		  (progn
+		    (read cur) (read cur)
+		    (setq min (read cur)
+			  max (read cur)
+			  opoint (point))
+		    (skip-chars-forward " \t")
+		    (insert prefix)
+		    (goto-char opoint)
+		    (set (let ((obarray hashtb)) (read cur))
+			 (cons min max)))
+		(error (and group (symbolp group) (set group nil))))
+	      (forward-line 1)))
+	(let (min max group)
 	  (while (not (eobp))
 	    (condition-case ()
-		(progn
+		(when (eq (char-after) ?2)
 		  (read cur) (read cur)
 		  (setq min (read cur)
-			max (read cur)
+			max (read cur))
-			opoint (point))
+		  (set (setq group (let ((obarray hashtb)) (read cur)))
-		  (skip-chars-forward " \t")
-		  (insert prefix)
-		  (goto-char opoint)
-		  (set (let ((obarray hashtb)) (read cur))
 		       (cons min max)))
 	      (error (and group (symbolp group) (set group nil))))
-	    (forward-line 1)))
+	    (forward-line 1)))))))
-(let (min max group)
-	(while (not (eobp))
-	  (condition-case ()
-	      (when (= (following-char) ?2)
-		(read cur) (read cur)
-		(setq min (read cur)
-		      max (read cur))
-		(set (setq group (let ((obarray hashtb)) (read cur)))
-		     (cons min max)))
-	    (error (and group (symbolp group) (set group nil))))
-	  (forward-line 1))))))
 (defun gnus-read-newsrc-file (&optional force)
 "Read startup file.
 If FORCE is non-nil, the .newsrc file is read."
 ;; Reset variables that might be defined in the .newsrc.eld file.
 ;; We always load the .newsrc.eld file.  If always contains
 ;; much information that can not be gotten from the .newsrc
 ;; file (ticked articles, killed groups, foreign methods, etc.)
 (gnus-read-newsrc-el-file quick-file)
-(when (and (file-exists-p gnus-current-startup-file)
+(when (and gnus-read-newsrc-file
+		 (file-exists-p gnus-current-startup-file)
 		 (or force
 		     (and (file-newer-than-file-p newsrc-file quick-file)
 			  (file-newer-than-file-p newsrc-file
 						  (concat quick-file "d")))
 		     (not gnus-newsrc-alist)))
 	;; i. e., reading the .newsrc file will not trash the data
 	;; already read (except for read articles).
 	(save-excursion
 	  (gnus-message 5 "Reading %s..." newsrc-file)
 	  (set-buffer (nnheader-find-file-noselect newsrc-file))
-	  (buffer-disable-undo (current-buffer))
+	  (buffer-disable-undo)
 	  (gnus-newsrc-to-gnus-format)
 	  (kill-buffer (current-buffer))
 	  (gnus-message 5 "Reading %s...done" newsrc-file)))
 ;; Convert old to new.
 	(when (numberp symbol)
 	  (setq symbol (intern (int-to-string symbol) gnus-active-hashtb)))
 	(unless (boundp symbol)
 	  (set symbol nil))
 	;; It was a group name.
-	(setq subscribed (= (following-char) ?:)
+	(setq subscribed (eq (char-after) ?:)
 	      group (symbol-name symbol)
 	      reads nil)
 	(if (eolp)
 	    ;; If the line ends here, this is clearly a buggy line, so
 	    ;; we put point a the beginning of line and let the cond
 	      (setq num1 (progn
 			   (narrow-to-region (match-beginning 0) (match-end 0))
 			   (read buf)))
 	      (widen)
 	      ;; If the next character is a dash, then this is a range.
-	      (if (= (following-char) ?-)
+	      (if (eq (char-after) ?-)
 		  (progn
 		    ;; We read the upper bound of the range.
 		    (forward-char 1)
 		    (if (not (looking-at "[0-9]+"))
 			;; This is a buggy line, by we pretend that
 		;; It was just a simple number, so we add it to the
 		;; list of ranges.
 		(push num1 reads))
 	      ;; If the next char in ?\n, then we have reached the end
 	      ;; of the line and return nil.
-	      (/= (following-char) ?\n))
+	      (not (eq (char-after) ?\n)))
-	     ((= (following-char) ?\n)
+	     ((eq (char-after) ?\n)
 	      ;; End of line, so we end.
 	      nil)
 	     (t
 	      ;; Not numbers and not eol, so this might be a buggy
 	      ;; line...
 		(setq group nil)
 		(gnus-error 3.1 "Mangled line: %s"
 			    (buffer-substring (gnus-point-at-bol)
 					      (gnus-point-at-eol))))
 	      nil))
-	  ;; Skip past ", ".  Spaces are illegal in these ranges, but
+	  ;; Skip past ", ".  Spaces are invalid in these ranges, but
 	  ;; we allow them, because it's a common mistake to put a
 	  ;; space after the comma.
 	  (skip-chars-forward ", "))
 	;; We have already read .newsrc.eld, so we gently update the
 		    (and (re-search-forward "[ \t]-n" (gnus-point-at-eol) t)
 			 (- (point) 2)))
 		  (gnus-point-at-eol)))
 	;; Search for all "words"...
 	(while (re-search-forward "[^ \t,\n]+" eol t)
-	  (if (= (char-after (match-beginning 0)) ?!)
+	  (if (eq (char-after (match-beginning 0)) ?!)
 	      ;; If the word begins with a bang (!), this is a "not"
 	      ;; spec.  We put this spec (minus the bang) and the
 	      ;; symbol `ignore' into the list.
 	      (push (cons (concat
 			   "^" (buffer-substring
 	  (make-local-variable 'version-control)
 	  (setq version-control 'never)
 	  (setq buffer-file-name
 		(concat gnus-current-startup-file ".eld"))
 	  (setq default-directory (file-name-directory buffer-file-name))
-	  (buffer-disable-undo (current-buffer))
+	  (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))
 (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 "\
 ;; Never delete this file -- if you want to force Gnus to read the
 ;; .newsrc file (if you have one), touch .newsrc instead.\n")
 (let ((newsrc (cdr gnus-newsrc-alist))
 	  (standard-output (current-buffer))
 	  info ranges range method)
 (setq buffer-file-name gnus-current-startup-file)
 (setq default-directory (file-name-directory buffer-file-name))
-(buffer-disable-undo (current-buffer))
+(buffer-disable-undo)
 (erase-buffer)
 ;; Write options.
 (when gnus-newsrc-options
 	(insert gnus-newsrc-options))
 ;; Write subscribed and unsubscribed.
 (defun gnus-slave-save-newsrc ()
 (save-excursion
 (set-buffer gnus-dribble-buffer)
 (let ((slave-name
-	   (make-temp-file (concat gnus-current-startup-file "-slave-")))
+	   (make-temp-name (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))
 (when modes
-	(set-file-modes slave-name modes))
+	(set-file-modes slave-name modes)))))
-(gnus-write-buffer slave-name))))
 (defun gnus-master-read-slave-newsrc ()
 (let ((slave-files
 	 (directory-files
 	  (file-name-directory gnus-current-startup-file)
 (if (not slave-files)
 	()				; There are no slave files to read.
 (gnus-message 7 "Reading slave newsrcs...")
 (save-excursion
 	(set-buffer (gnus-get-buffer-create " *gnus slave*"))
-	(buffer-disable-undo (current-buffer))
 	(setq slave-files
 	      (sort (mapcar (lambda (file)
 			      (list (nth 5 (file-attributes file)) file))
 			    slave-files)
 		    (lambda (f1 f2)
 		      (or (< (caar f1) (caar f2))
 			  (< (nth 1 (car f1)) (nth 1 (car f2)))))))
 	(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))
 		      t)
 		  (error
 (gnus-sethash (gnus-group-prefixed-name "" method) "Has read"
 		  gnus-description-hashtb)
 (gnus-message 5 "Reading descriptions file via %s..." (car method))
 (cond
+((null (gnus-get-function method 'request-list-newsgroups t))
+t)
 ((not (gnus-check-server method))
 (gnus-message 1 "Couldn't open server")
 nil)
 ((not (gnus-request-list-newsgroups method))
 (gnus-message 1 "Couldn't read newsgroups descriptions")
 	    ;; ...  which leads to this line being effectively ignored.
 	    (when (symbolp group)
 	      (let ((str (buffer-substring
 			  (point) (progn (end-of-line) (point))))
 		    (coding
-		     (and (boundp 'enable-multibyte-characters)
+		     (and (or gnus-xemacs
-			  enable-multibyte-characters
+			      (and (boundp 'enable-multibyte-characters)
+				   enable-multibyte-characters))
 			  (fboundp 'gnus-mule-get-coding-system)
 			  (gnus-mule-get-coding-system (symbol-name group)))))
-		(if coding
+		(when coding
-		    (setq str (gnus-decode-coding-string str (car coding))))
+		  (setq str (mm-decode-coding-string str (car coding))))
 		(set group str)))
 	    (forward-line 1))))
 (gnus-message 5 "Reading descriptions file...done")
 t))))
 ;;;###autoload
 (defun gnus-declare-backend (name &rest abilities)
 "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'.
 If this variable is nil, don't do anything."
 (setq default-directory

Mercurial > emacs

comparison lisp/gnus/gnus-start.el @ 31716:9968f55ad26e