/[emacs]/emacs/lisp/gnus/gnus-start.el
ViewVC logotype

Diff of /emacs/lisp/gnus/gnus-start.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.21.6.2 by handa, Fri Mar 12 00:02:58 2004 UTC revision 1.21.6.3 by miles, Thu Sep 9 09:36:26 2004 UTC
# Line 1  Line 1 
1  ;;; gnus-start.el --- startup functions for Gnus  ;;; gnus-start.el --- startup functions for Gnus
2  ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002  ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
3  ;;        Free Software Foundation, Inc.  ;;        Free Software Foundation, Inc.
4    
5  ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>  ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
# Line 32  Line 32 
32  (require 'gnus-spec)  (require 'gnus-spec)
33  (require 'gnus-range)  (require 'gnus-range)
34  (require 'gnus-util)  (require 'gnus-util)
35  (require 'message)  (autoload 'message-make-date "message")
36    (autoload 'gnus-agent-read-servers-validate "gnus-agent")
37    (autoload 'gnus-agent-possibly-alter-active "gnus-agent")
38  (eval-when-compile (require 'cl))  (eval-when-compile (require 'cl))
39    
40  (defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc")  (defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc")
# Line 41  Line 43 
43    :group 'gnus-start    :group 'gnus-start
44    :type 'file)    :type 'file)
45    
46    (defcustom gnus-backup-startup-file 'never
47      "Whether to create backup files.
48    This variable takes the same values as the `version-control'
49    variable."
50      :group 'gnus-start
51      :type '(choice (const :tag "Never" never)
52                     (const :tag "If existing" nil)
53                     (other :tag "Always" t)))
54    
55    (defcustom gnus-save-startup-file-via-temp-buffer t
56      "Whether to write the startup file contents to a buffer then save
57    the buffer or write directly to the file.  The buffer is faster
58    because all of the contents are written at once.  The direct write
59    uses considerably less memory."
60      :group 'gnus-start
61      :type '(choice (const :tag "Write via buffer" t)
62                     (const :tag "Write directly to file" nil)))
63    
64  (defcustom gnus-init-file (nnheader-concat gnus-home-directory ".gnus")  (defcustom gnus-init-file (nnheader-concat gnus-home-directory ".gnus")
65    "Your Gnus Emacs-Lisp startup file name.    "Your Gnus Emacs-Lisp startup file name.
66  If a file with the `.el' or `.elc' suffixes exists, it will be read instead."  If a file with the `.el' or `.elc' suffixes exists, it will be read instead."
# Line 224  nil if you set this variable to nil. Line 244  nil if you set this variable to nil.
244  This variable can also be a regexp.  In that case, all groups that do  This variable can also be a regexp.  In that case, all groups that do
245  not match this regexp will be removed before saving the list."  not match this regexp will be removed before saving the list."
246    :group 'gnus-newsrc    :group 'gnus-newsrc
247    :type 'boolean)    :type '(radio (sexp :format "Non-nil\n"
248                          :match (lambda (widget value)
249                                   (and value (not (stringp value))))
250                          :value t)
251                    (const nil)
252                    (regexp :format "%t: %v\n" :size 0)))
253    
254  (defcustom gnus-ignored-newsgroups  (defcustom gnus-ignored-newsgroups
255    (mapconcat 'identity    (mapconcat 'identity
256               '("^to\\."                 ; not "real" groups               '("^to\\."                 ; not "real" groups
257                 "^[0-9. \t]+ "           ; all digits in name                 "^[0-9. \t]+\\( \\|$\\)" ; all digits in name
258                 "^[\"][]\"[#'()]"        ; bogus characters                 "^[\"][]\"[#'()]"        ; bogus characters
259                 )                 )
260               "\\|")               "\\|")
# Line 241  thus making them effectively non-existen Line 266  thus making them effectively non-existen
266    :type 'regexp)    :type 'regexp)
267    
268  (defcustom gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies  (defcustom gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies
269    "*Function called with a group name when new group is detected.    "*Function(s) called with a group name when new group is detected.
270  A few pre-made functions are supplied: `gnus-subscribe-randomly'  A few pre-made functions are supplied: `gnus-subscribe-randomly'
271  inserts new groups at the beginning of the list of groups;  inserts new groups at the beginning of the list of groups;
272  `gnus-subscribe-alphabetically' inserts new groups in strict  `gnus-subscribe-alphabetically' inserts new groups in strict
# Line 259  claim them." Line 284  claim them."
284                  (function-item gnus-subscribe-killed)                  (function-item gnus-subscribe-killed)
285                  (function-item gnus-subscribe-zombies)                  (function-item gnus-subscribe-zombies)
286                  (function-item gnus-subscribe-topics)                  (function-item gnus-subscribe-topics)
287                  function))                  function
288                    (repeat function)))
289    
290    (defcustom gnus-subscribe-newsgroup-hooks nil
291      "*Hooks run after you subscribe to a new group.
292    The hooks will be called with new group's name as argument."
293      :group 'gnus-group-new
294      :type 'hook)
295    
296  (defcustom gnus-subscribe-options-newsgroup-method  (defcustom gnus-subscribe-options-newsgroup-method
297    'gnus-subscribe-alphabetically    'gnus-subscribe-alphabetically
298    "*This function is called to subscribe newsgroups mentioned on \"options -n\" lines.    "*Function(s) called to subscribe newsgroups mentioned on \"options -n\" lines.
299  If, for instance, you want to subscribe to all newsgroups in the  If, for instance, you want to subscribe to all newsgroups in the
300  \"no\" and \"alt\" hierarchies, you'd put the following in your  \"no\" and \"alt\" hierarchies, you'd put the following in your
301  .newsrc file:  .newsrc file:
# Line 279  the subscription method in this variable Line 311  the subscription method in this variable
311                  (function-item gnus-subscribe-interactively)                  (function-item gnus-subscribe-interactively)
312                  (function-item gnus-subscribe-killed)                  (function-item gnus-subscribe-killed)
313                  (function-item gnus-subscribe-zombies)                  (function-item gnus-subscribe-zombies)
314                  function))                  (function-item gnus-subscribe-topics)
315                    function
316                    (repeat function)))
317    
318  (defcustom gnus-subscribe-hierarchical-interactive nil  (defcustom gnus-subscribe-hierarchical-interactive nil
319    "*If non-nil, Gnus will offer to subscribe hierarchically.    "*If non-nil, Gnus will offer to subscribe hierarchically.
# Line 294  hierarchy in its entirety." Line 328  hierarchy in its entirety."
328    :type 'boolean)    :type 'boolean)
329    
330  (defcustom gnus-auto-subscribed-groups  (defcustom gnus-auto-subscribed-groups
331    "nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl"    "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl\\|^nnmaildir"
332    "*All new groups that match this regexp will be subscribed automatically.    "*All new groups that match this regexp will be subscribed automatically.
333  Note that this variable only deals with new groups.  It has no effect  Note that this variable only deals with new groups.  It has no effect
334  whatsoever on old groups.  whatsoever on old groups.
# Line 354  This hook is called as the first thing w Line 388  This hook is called as the first thing w
388    :group 'gnus-start    :group 'gnus-start
389    :type 'hook)    :type 'hook)
390    
391  (defcustom gnus-setup-news-hook nil  (defcustom gnus-setup-news-hook
392      '(gnus-fixup-nnimap-unread-after-getting-new-news)
393    "A hook after reading the .newsrc file, but before generating the buffer."    "A hook after reading the .newsrc file, but before generating the buffer."
394    :group 'gnus-start    :group 'gnus-start
395    :type 'hook)    :type 'hook)
396    
397    (defcustom gnus-get-top-new-news-hook nil
398      "A hook run just before Gnus checks for new news globally."
399      :group 'gnus-group-new
400      :type 'hook)
401    
402  (defcustom gnus-get-new-news-hook nil  (defcustom gnus-get-new-news-hook nil
403    "A hook run just before Gnus checks for new news."    "A hook run just before Gnus checks for new news."
404    :group 'gnus-group-new    :group 'gnus-group-new
405    :type 'hook)    :type 'hook)
406    
407  (defcustom gnus-after-getting-new-news-hook  (defcustom gnus-after-getting-new-news-hook
408    (when (gnus-boundp 'display-time-timer)    '(gnus-display-time-event-handler
409      '(display-time-event-handler))      gnus-fixup-nnimap-unread-after-getting-new-news)
410    "*A hook run after Gnus checks for new news when Gnus is already running."    "*A hook run after Gnus checks for new news when Gnus is already running."
411    :group 'gnus-group-new    :group 'gnus-group-new
412    :type 'hook)    :type 'hook)
413    
414    (defcustom gnus-read-newsrc-el-hook nil
415      "A hook called after reading the newsrc.eld? file."
416      :group 'gnus-newsrc
417      :type 'hook)
418    
419  (defcustom gnus-save-newsrc-hook nil  (defcustom gnus-save-newsrc-hook nil
420    "A hook called before saving any of the newsrc files."    "A hook called before saving any of the newsrc files."
421    :group 'gnus-newsrc    :group 'gnus-newsrc
# Line 388  Can be used to turn version control on o Line 433  Can be used to turn version control on o
433    :group 'gnus-newsrc    :group 'gnus-newsrc
434    :type 'hook)    :type 'hook)
435    
436    (defcustom gnus-group-mode-hook nil
437      "Hook for Gnus group mode."
438      :group 'gnus-group-various
439      :options '(gnus-topic-mode)
440      :type 'hook)
441    
442  (defcustom gnus-always-read-dribble-file nil  (defcustom gnus-always-read-dribble-file nil
443    "Unconditionally read the dribble file."    "Unconditionally read the dribble file."
444    :group 'gnus-newsrc    :group 'gnus-newsrc
# Line 434  Can be used to turn version control on o Line 485  Can be used to turn version control on o
485              (condition-case var              (condition-case var
486                  (load file nil t)                  (load file nil t)
487                (error                (error
488                 (error "Error in %s: %s" file var)))))))))                 (error "Error in %s: %s" file (cadr var))))))))))
489    
490  ;; For subscribing new newsgroup  ;; For subscribing new newsgroup
491    
# Line 510  Can be used to turn version control on o Line 561  Can be used to turn version control on o
561    (gnus-subscribe-newsgroup newsgroup))    (gnus-subscribe-newsgroup newsgroup))
562    
563  (defun gnus-subscribe-alphabetically (newgroup)  (defun gnus-subscribe-alphabetically (newgroup)
564    "Subscribe new NEWSGROUP and insert it in alphabetical order."    "Subscribe new NEWGROUP and insert it in alphabetical order."
565    (let ((groups (cdr gnus-newsrc-alist))    (let ((groups (cdr gnus-newsrc-alist))
566          before)          before)
567      (while (and (not before) groups)      (while (and (not before) groups)
# Line 520  Can be used to turn version control on o Line 571  Can be used to turn version control on o
571      (gnus-subscribe-newsgroup newgroup before)))      (gnus-subscribe-newsgroup newgroup before)))
572    
573  (defun gnus-subscribe-hierarchically (newgroup)  (defun gnus-subscribe-hierarchically (newgroup)
574    "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order."    "Subscribe new NEWGROUP and insert it in hierarchical newsgroup order."
575    ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)    ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
576    (save-excursion    (save-excursion
577      (set-buffer (nnheader-find-file-noselect gnus-current-startup-file))      (set-buffer (nnheader-find-file-noselect gnus-current-startup-file))
578      (let ((groupkey newgroup)      (prog1
579            before)          (let ((groupkey newgroup) before)
580        (while (and (not before) groupkey)            (while (and (not before) groupkey)
581          (goto-char (point-min))              (goto-char (point-min))
582          (let ((groupkey-re              (let ((groupkey-re
583                 (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))                     (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
584            (while (and (re-search-forward groupkey-re nil t)                (while (and (re-search-forward groupkey-re nil t)
585                        (progn                            (progn
586                          (setq before (match-string 1))                              (setq before (match-string 1))
587                          (string< before newgroup)))))                              (string< before newgroup)))))
588          ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)              ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
589          (setq groupkey              (setq groupkey
590                (when (string-match "^\\(.*\\)\\.[^.]+$" groupkey)                    (when (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
591                  (substring groupkey (match-beginning 1) (match-end 1)))))                      (substring groupkey (match-beginning 1) (match-end 1)))))
592        (gnus-subscribe-newsgroup newgroup before))            (gnus-subscribe-newsgroup newgroup before))
593      (kill-buffer (current-buffer))))        (kill-buffer (current-buffer)))))
594    
595  (defun gnus-subscribe-interactively (group)  (defun gnus-subscribe-interactively (group)
596    "Subscribe the new GROUP interactively.    "Subscribe the new GROUP interactively.
# Line 568  the first newsgroup." Line 619  the first newsgroup."
619       newsgroup gnus-level-default-subscribed       newsgroup gnus-level-default-subscribed
620       gnus-level-killed (gnus-gethash (or next "dummy.group")       gnus-level-killed (gnus-gethash (or next "dummy.group")
621                                       gnus-newsrc-hashtb))                                       gnus-newsrc-hashtb))
622      (gnus-message 5 "Subscribe newsgroup: %s" newsgroup)))      (gnus-message 5 "Subscribe newsgroup: %s" newsgroup)
623        (run-hook-with-args 'gnus-subscribe-newsgroup-hooks newsgroup)
624        t))
625    
626  (defun gnus-read-active-file-p ()  (defun gnus-read-active-file-p ()
627    "Say whether the active file has been read from `gnus-select-method'."    "Say whether the active file has been read from `gnus-select-method'."
# Line 577  the first newsgroup." Line 630  the first newsgroup."
630  ;;; General various misc type functions.  ;;; General various misc type functions.
631    
632  ;; Silence byte-compiler.  ;; Silence byte-compiler.
633  (defvar gnus-current-headers)  (eval-when-compile
634  (defvar gnus-thread-indent-array)    (defvar gnus-current-headers)
635  (defvar gnus-newsgroup-name)    (defvar gnus-thread-indent-array)
636  (defvar gnus-newsgroup-headers)    (defvar gnus-newsgroup-name)
637  (defvar gnus-group-list-mode)    (defvar gnus-newsgroup-headers)
638  (defvar gnus-group-mark-positions)    (defvar gnus-group-list-mode)
639  (defvar gnus-newsgroup-data)    (defvar gnus-group-mark-positions)
640  (defvar gnus-newsgroup-unreads)    (defvar gnus-newsgroup-data)
641  (defvar nnoo-state-alist)    (defvar gnus-newsgroup-unreads)
642  (defvar gnus-current-select-method)    (defvar nnoo-state-alist)
643      (defvar gnus-current-select-method)
644      (defvar mail-sources)
645      (defvar nnmail-scan-directory-mail-source-once)
646      (defvar nnmail-split-history)
647      (defvar nnmail-spool-file))
648    
649    (defun gnus-close-all-servers ()
650      "Close all servers."
651      (interactive)
652      (dolist (server gnus-opened-servers)
653        (gnus-close-server (car server))))
654    
655  (defun gnus-clear-system ()  (defun gnus-clear-system ()
656    "Clear all variables and buffers."    "Clear all variables and buffers."
657    ;; Clear Gnus variables.    ;; Clear Gnus variables.
658    (let ((variables gnus-variable-list))    (let ((variables (remove 'gnus-format-specs gnus-variable-list)))
659      (while variables      (while variables
660        (set (car variables) nil)        (set (car variables) nil)
661        (setq variables (cdr variables))))        (setq variables (cdr variables))))
662    ;; Clear other internal variables.    ;; Clear other internal variables.
663    (setq gnus-list-of-killed-groups nil    (setq gnus-list-of-killed-groups nil
664          gnus-have-read-active-file nil          gnus-have-read-active-file nil
665            gnus-agent-covered-methods nil
666            gnus-server-method-cache nil
667          gnus-newsrc-alist nil          gnus-newsrc-alist nil
668          gnus-newsrc-hashtb nil          gnus-newsrc-hashtb nil
669          gnus-killed-list nil          gnus-killed-list nil
# Line 632  the first newsgroup." Line 698  the first newsgroup."
698      (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil))))      (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil))))
699    (gnus-kill-buffer nntp-server-buffer)    (gnus-kill-buffer nntp-server-buffer)
700    ;; Kill Gnus buffers.    ;; Kill Gnus buffers.
701    (let ((buffers (gnus-buffers)))    (dolist (buffer (gnus-buffers))
702      (when buffers      (gnus-kill-buffer buffer))
       (mapcar 'kill-buffer buffers)))  
703    ;; Remove Gnus frames.    ;; Remove Gnus frames.
704    (gnus-kill-gnus-frames))    (gnus-kill-gnus-frames))
705    
# Line 672  prompt the user for the name of an NNTP Line 737  prompt the user for the name of an NNTP
737      (nnheader-init-server-buffer)      (nnheader-init-server-buffer)
738      (setq gnus-slave slave)      (setq gnus-slave slave)
739      (gnus-read-init-file)      (gnus-read-init-file)
740        (if gnus-agent
741            (gnus-agentize))
742    
743      (when gnus-simple-splash      (when gnus-simple-splash
744        (setq gnus-simple-splash nil)        (setq gnus-simple-splash nil)
# Line 709  prompt the user for the name of an NNTP Line 776  prompt the user for the name of an NNTP
776              (add-hook 'gnus-summary-mode-hook 'gnus-grouplens-mode))              (add-hook 'gnus-summary-mode-hook 'gnus-grouplens-mode))
777    
778            ;; Do the actual startup.            ;; Do the actual startup.
779              (if gnus-agent
780                  (gnus-request-create-group "queue" '(nndraft "")))
781              (gnus-request-create-group "drafts" '(nndraft ""))
782            (gnus-setup-news nil level dont-connect)            (gnus-setup-news nil level dont-connect)
783            (gnus-run-hooks 'gnus-setup-news-hook)            (gnus-run-hooks 'gnus-setup-news-hook)
784            (gnus-start-draft-setup)            (gnus-start-draft-setup)
# Line 728  prompt the user for the name of an NNTP Line 798  prompt the user for the name of an NNTP
798      (gnus-group-set-parameter      (gnus-group-set-parameter
799       "nndraft:drafts" 'gnus-dummy '((gnus-draft-mode)))))       "nndraft:drafts" 'gnus-dummy '((gnus-draft-mode)))))
800    
 ;;;###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))))  
   
801    
802  ;;;  ;;;
803  ;;; Dribble file  ;;; Dribble file
# Line 765  cautiously -- unloading may cause troubl Line 824  cautiously -- unloading may cause troubl
824        (set-buffer gnus-dribble-buffer)        (set-buffer gnus-dribble-buffer)
825        (goto-char (point-max))        (goto-char (point-max))
826        (insert string "\n")        (insert string "\n")
827        (set-window-point (get-buffer-window (current-buffer)) (point-max))        ;; This has been commented by Josh Huber <huber@alum.wpi.edu>
828          ;; It causes problems with both XEmacs and Emacs 21, and doesn't
829          ;; seem to be of much value. (FIXME: remove this after we make sure
830          ;; it's not needed).
831          ;; (set-window-point (get-buffer-window (current-buffer)) (point-max))
832        (bury-buffer gnus-dribble-buffer)        (bury-buffer gnus-dribble-buffer)
833        (save-excursion        (save-excursion
834          (set-buffer gnus-group-buffer)          (set-buffer gnus-group-buffer)
# Line 791  cautiously -- unloading may cause troubl Line 854  cautiously -- unloading may cause troubl
854        (set-buffer-modified-p nil)        (set-buffer-modified-p nil)
855        (let ((auto (make-auto-save-file-name))        (let ((auto (make-auto-save-file-name))
856              (gnus-dribble-ignore t)              (gnus-dribble-ignore t)
857                (purpose nil)
858              modes)              modes)
859          (when (or (file-exists-p auto) (file-exists-p dribble-file))          (when (or (file-exists-p auto) (file-exists-p dribble-file))
860            ;; Load whichever file is newest -- the auto save file            ;; Load whichever file is newest -- the auto save file
# Line 806  cautiously -- unloading may cause troubl Line 870  cautiously -- unloading may cause troubl
870                       (file-exists-p dribble-file)                       (file-exists-p dribble-file)
871                       (setq modes (file-modes gnus-current-startup-file)))                       (setq modes (file-modes gnus-current-startup-file)))
872              (set-file-modes dribble-file modes))              (set-file-modes dribble-file modes))
873              (goto-char (point-min))
874              (when (search-forward "Gnus was exited on purpose" nil t)
875                (setq purpose t))
876            ;; Possibly eval the file later.            ;; Possibly eval the file later.
877            (when (or gnus-always-read-dribble-file            (when (or gnus-always-read-dribble-file
878                      (gnus-y-or-n-p                      (gnus-y-or-n-p
879                       "Gnus auto-save file exists.  Do you want to read it? "))                       (if purpose
880                             "Gnus exited on purpose without saving; read auto-save file anyway? "
881                         "Gnus auto-save file exists.  Do you want to read it? ")))
882              (setq gnus-dribble-eval-file t)))))))              (setq gnus-dribble-eval-file t)))))))
883    
884  (defun gnus-dribble-eval-file ()  (defun gnus-dribble-eval-file ()
# Line 871  If LEVEL is non-nil, the news will be se Line 940  If LEVEL is non-nil, the news will be se
940    
941      ;; Make sure the archive server is available to all and sundry.      ;; Make sure the archive server is available to all and sundry.
942      (when gnus-message-archive-method      (when gnus-message-archive-method
943        (setq gnus-server-alist (delq (assoc "archive" gnus-server-alist)        (unless (assoc "archive" gnus-server-alist)
944                                      gnus-server-alist))          (push `("archive"
945        (push (cons "archive" gnus-message-archive-method)                  nnfolder
946              gnus-server-alist))                  "archive"
947                    (nnfolder-directory
948                     ,(nnheader-concat message-directory "archive"))
949                    (nnfolder-active-file
950                     ,(nnheader-concat message-directory "archive/active"))
951                    (nnfolder-get-new-mail nil)
952                    (nnfolder-inhibit-expiry t))
953                  gnus-server-alist)))
954    
955      ;; If we don't read the complete active file, we fill in the      ;; If we don't read the complete active file, we fill in the
956      ;; hashtb here.      ;; hashtb here.
# Line 882  If LEVEL is non-nil, the news will be se Line 958  If LEVEL is non-nil, the news will be se
958                (eq gnus-read-active-file 'some))                (eq gnus-read-active-file 'some))
959        (gnus-update-active-hashtb-from-killed))        (gnus-update-active-hashtb-from-killed))
960    
961        ;; Validate agent covered methods now that gnus-server-alist has
962        ;; been initialized.
963        ;; NOTE: This is here for one purpose only.  By validating the
964        ;; agentized server's, it converts the old 5.10.3, and earlier,
965        ;; format to the current format.  That enables the agent code
966        ;; within gnus-read-active-file to function correctly.
967        (if gnus-agent
968            (gnus-agent-read-servers-validate))
969    
970      ;; Read the active file and create `gnus-active-hashtb'.      ;; Read the active file and create `gnus-active-hashtb'.
971      ;; If `gnus-read-active-file' is nil, then we just create an empty      ;; If `gnus-read-active-file' is nil, then we just create an empty
972      ;; hash table.  The partial filling out of the hash table will be      ;; hash table.  The partial filling out of the hash table will be
# Line 910  If LEVEL is non-nil, the news will be se Line 995  If LEVEL is non-nil, the news will be se
995    
996      ;; See whether we need to read the description file.      ;; See whether we need to read the description file.
997      (when (and (boundp 'gnus-group-line-format)      (when (and (boundp 'gnus-group-line-format)
998                   (stringp gnus-group-line-format)
999                 (let ((case-fold-search nil))                 (let ((case-fold-search nil))
1000                   (string-match "%[-,0-9]*D" gnus-group-line-format))                   (string-match "%[-,0-9]*D" gnus-group-line-format))
1001                 (not gnus-description-hashtb)                 (not gnus-description-hashtb)
# Line 924  If LEVEL is non-nil, the news will be se Line 1010  If LEVEL is non-nil, the news will be se
1010                 gnus-plugged)                 gnus-plugged)
1011        (gnus-find-new-newsgroups))        (gnus-find-new-newsgroups))
1012    
1013        ;; Check and remove bogus newsgroups.
1014        (when (and init gnus-check-bogus-newsgroups
1015                   gnus-read-active-file (not level)
1016                   (gnus-server-opened gnus-select-method))
1017          (gnus-check-bogus-newsgroups))
1018    
1019      ;; We might read in new NoCeM messages here.      ;; We might read in new NoCeM messages here.
1020      (when (and gnus-use-nocem      (when (and gnus-use-nocem
1021                 (not level)                 (not level)
# Line 935  If LEVEL is non-nil, the news will be se Line 1027  If LEVEL is non-nil, the news will be se
1027    
1028      ;; Find the number of unread articles in each non-dead group.      ;; Find the number of unread articles in each non-dead group.
1029      (let ((gnus-read-active-file (and (not level) gnus-read-active-file)))      (let ((gnus-read-active-file (and (not level) gnus-read-active-file)))
1030        (gnus-get-unread-articles level))        (gnus-get-unread-articles level))))
1031    
1032      (when (and init gnus-check-bogus-newsgroups  (defun gnus-call-subscribe-functions (method group)
1033                 gnus-read-active-file (not level)    "Call METHOD to subscribe GROUP.
1034                 (gnus-server-opened gnus-select-method))  If no function returns `non-nil', call `gnus-subscribe-zombies'."
1035        (gnus-check-bogus-newsgroups))))    (unless (cond
1036               ((functionp method)
1037                (funcall method group))
1038               ((listp method)
1039                (catch 'found
1040                  (dolist (func method)
1041                    (if (funcall func group)
1042                        (throw 'found t)))
1043                  nil))
1044               (t nil))
1045        (gnus-subscribe-zombies group)))
1046    
1047  (defun gnus-find-new-newsgroups (&optional arg)  (defun gnus-find-new-newsgroups (&optional arg)
1048    "Search for new newsgroups and add them.    "Search for new newsgroups and add them.
# Line 994  for new groups, and subscribe the new gr Line 1096  for new groups, and subscribe the new gr
1096                    ((eq do-sub 'subscribe)                    ((eq do-sub 'subscribe)
1097                     (setq groups (1+ groups))                     (setq groups (1+ groups))
1098                     (gnus-sethash group group gnus-killed-hashtb)                     (gnus-sethash group group gnus-killed-hashtb)
1099                     (funcall gnus-subscribe-options-newsgroup-method group))                     (gnus-call-subscribe-functions
1100                        gnus-subscribe-options-newsgroup-method group))
1101                    ((eq do-sub 'ignore)                    ((eq do-sub 'ignore)
1102                     nil)                     nil)
1103                    (t                    (t
# Line 1002  for new groups, and subscribe the new gr Line 1105  for new groups, and subscribe the new gr
1105                     (gnus-sethash group group gnus-killed-hashtb)                     (gnus-sethash group group gnus-killed-hashtb)
1106                     (if gnus-subscribe-hierarchical-interactive                     (if gnus-subscribe-hierarchical-interactive
1107                         (push group new-newsgroups)                         (push group new-newsgroups)
1108                       (funcall gnus-subscribe-newsgroup-method group)))))))                       (gnus-call-subscribe-functions
1109                          gnus-subscribe-newsgroup-method group)))))))
1110             gnus-active-hashtb)             gnus-active-hashtb)
1111            (when new-newsgroups            (when new-newsgroups
1112              (gnus-subscribe-hierarchical-interactive new-newsgroups))              (gnus-subscribe-hierarchical-interactive new-newsgroups))
# Line 1087  for new groups, and subscribe the new gr Line 1191  for new groups, and subscribe the new gr
1191                  ((eq do-sub 'subscribe)                  ((eq do-sub 'subscribe)
1192                   (incf groups)                   (incf groups)
1193                   (gnus-sethash group group gnus-killed-hashtb)                   (gnus-sethash group group gnus-killed-hashtb)
1194                   (funcall gnus-subscribe-options-newsgroup-method group))                   (gnus-call-subscribe-functions
1195                      gnus-subscribe-options-newsgroup-method group))
1196                  ((eq do-sub 'ignore)                  ((eq do-sub 'ignore)
1197                   nil)                   nil)
1198                  (t                  (t
# Line 1095  for new groups, and subscribe the new gr Line 1200  for new groups, and subscribe the new gr
1200                   (gnus-sethash group group gnus-killed-hashtb)                   (gnus-sethash group group gnus-killed-hashtb)
1201                   (if gnus-subscribe-hierarchical-interactive                   (if gnus-subscribe-hierarchical-interactive
1202                       (push group new-newsgroups)                       (push group new-newsgroups)
1203                     (funcall gnus-subscribe-newsgroup-method group)))))))                     (gnus-call-subscribe-functions
1204                        gnus-subscribe-newsgroup-method group)))))))
1205           hashtb))           hashtb))
1206        (when new-newsgroups        (when new-newsgroups
1207          (gnus-subscribe-hierarchical-interactive new-newsgroups)))          (gnus-subscribe-hierarchical-interactive new-newsgroups)))
# Line 1111  for new groups, and subscribe the new gr Line 1217  for new groups, and subscribe the new gr
1217    (catch 'ended    (catch 'ended
1218      ;; First check if any of the following files exist.  If they do,      ;; First check if any of the following files exist.  If they do,
1219      ;; it's not the first time the user has used Gnus.      ;; it's not the first time the user has used Gnus.
1220      (dolist (file (list gnus-current-startup-file      (dolist (file (list (concat gnus-current-startup-file ".el")
                         (concat gnus-current-startup-file ".el")  
1221                          (concat gnus-current-startup-file ".eld")                          (concat gnus-current-startup-file ".eld")
                         gnus-startup-file  
1222                          (concat gnus-startup-file ".el")                          (concat gnus-startup-file ".el")
1223                          (concat gnus-startup-file ".eld")))                          (concat gnus-startup-file ".eld")))
1224        (when (file-exists-p file)        (when (file-exists-p file)
# Line 1128  for new groups, and subscribe the new gr Line 1232  for new groups, and subscribe the new gr
1232      (let ((groups (or gnus-default-subscribed-newsgroups      (let ((groups (or gnus-default-subscribed-newsgroups
1233                        gnus-backup-default-subscribed-newsgroups))                        gnus-backup-default-subscribed-newsgroups))
1234            group)            group)
1235        (when (eq groups t)        (if (eq groups t)
1236          ;; If t, we subscribe (or not) all groups as if they were new.            ;; If t, we subscribe (or not) all groups as if they were new.
1237          (mapatoms            (mapatoms
1238           (lambda (sym)             (lambda (sym)
1239             (when (setq group (symbol-name sym))               (when (setq group (symbol-name sym))
1240               (let ((do-sub (gnus-matches-options-n group)))                 (let ((do-sub (gnus-matches-options-n group)))
1241                 (cond                   (cond
1242                  ((eq do-sub 'subscribe)                    ((eq do-sub 'subscribe)
1243                   (gnus-sethash group group gnus-killed-hashtb)                     (gnus-sethash group group gnus-killed-hashtb)
1244                   (funcall gnus-subscribe-options-newsgroup-method group))                     (gnus-call-subscribe-functions
1245                  ((eq do-sub 'ignore)                      gnus-subscribe-options-newsgroup-method group))
1246                   nil)                    ((eq do-sub 'ignore)
1247                  (t                     nil)
1248                   (push group gnus-killed-list))))))                    (t
1249           gnus-active-hashtb)                     (push group gnus-killed-list))))))
1250               gnus-active-hashtb)
1251          (dolist (group groups)          (dolist (group groups)
1252            ;; Only subscribe the default groups that are activated.            ;; Only subscribe the default groups that are activated.
1253            (when (gnus-active group)            (when (gnus-active group)
# Line 1150  for new groups, and subscribe the new gr Line 1255  for new groups, and subscribe the new gr
1255               group gnus-level-default-subscribed gnus-level-killed)))               group gnus-level-default-subscribed gnus-level-killed)))
1256          (save-excursion          (save-excursion
1257            (set-buffer gnus-group-buffer)            (set-buffer gnus-group-buffer)
1258            (gnus-group-make-help-group))            ;; Don't error if the group already exists. This happens when a
1259              ;; first-time user types 'F'. -- didier
1260              (gnus-group-make-help-group t))
1261          (when gnus-novice-user          (when gnus-novice-user
1262            (gnus-message 7 "`A k' to list killed groups"))))))            (gnus-message 7 "`A k' to list killed groups"))))))
1263    
1264  (defun gnus-subscribe-group (group &optional previous method)  (defun gnus-subscribe-group (group &optional previous method)
1265    "Subcribe GROUP and put it after PREVIOUS."    "Subscribe GROUP and put it after PREVIOUS."
1266    (gnus-group-change-level    (gnus-group-change-level
1267     (if method     (if method
1268         (list t group gnus-level-default-subscribed nil nil method)         (list t group gnus-level-default-subscribed nil nil method)
# Line 1215  for new groups, and subscribe the new gr Line 1322  for new groups, and subscribe the new gr
1322        ;; it from the newsrc hash table and assoc.        ;; it from the newsrc hash table and assoc.
1323        (cond        (cond
1324         ((>= oldlevel gnus-level-zombie)         ((>= oldlevel gnus-level-zombie)
1325          (if (= oldlevel gnus-level-zombie)          ;; oldlevel could be wrong.
1326              (setq gnus-zombie-list (delete group gnus-zombie-list))          (setq gnus-zombie-list (delete group gnus-zombie-list))
1327            (setq gnus-killed-list (delete group gnus-killed-list))))          (setq gnus-killed-list (delete group gnus-killed-list)))
1328         (t         (t
1329          (when (and (>= level gnus-level-zombie)          (when (and (>= level gnus-level-zombie)
1330                     entry)                     entry)
# Line 1240  for new groups, and subscribe the new gr Line 1347  for new groups, and subscribe the new gr
1347          (unless (gnus-group-foreign-p group)          (unless (gnus-group-foreign-p group)
1348            (if (= level gnus-level-zombie)            (if (= level gnus-level-zombie)
1349                (push group gnus-zombie-list)                (push group gnus-zombie-list)
1350              (push group gnus-killed-list))))              (if (= oldlevel gnus-level-killed)
1351                    ;; Remove from active hashtb.
1352                    (unintern group gnus-active-hashtb)
1353                  ;; Don't add it into killed-list if it was killed.
1354                  (push group gnus-killed-list)))))
1355         (t         (t
1356          ;; If the list is to be entered into the newsrc assoc, and          ;; If the list is to be entered into the newsrc assoc, and
1357          ;; it was killed, we have to create an entry in the newsrc          ;; it was killed, we have to create an entry in the newsrc
# Line 1308  newsgroup." Line 1419  newsgroup."
1419          (setq info (pop newsrc)          (setq info (pop newsrc)
1420                group (gnus-info-group info))                group (gnus-info-group info))
1421          (unless (or (gnus-active group) ; Active          (unless (or (gnus-active group) ; Active
1422                      (gnus-info-method info)) ; Foreign                      (and (gnus-info-method info)
1423                             (not (gnus-secondary-method-p
1424                                   (gnus-info-method info))))) ; Foreign
1425            ;; Found a bogus newsgroup.            ;; Found a bogus newsgroup.
1426            (push group bogus)))            (push group bogus)))
1427        (if confirm        (if confirm
# Line 1379  newsgroup." Line 1492  newsgroup."
1492                  (gnus-check-backend-function 'request-scan (car method))                  (gnus-check-backend-function 'request-scan (car method))
1493                  (gnus-request-scan group method))                  (gnus-request-scan group method))
1494             t)             t)
1495           (condition-case ()           (if (or debug-on-error debug-on-quit)
1496               (inline (gnus-request-group group dont-check method))               (inline (gnus-request-group group dont-check method))
1497             ;;(error nil)             (condition-case nil
1498             (quit                 (inline (gnus-request-group group dont-check method))
1499              (message "Quit activating %s" group)               ;;(error nil)
1500              nil))               (quit
1501           (setq active (gnus-parse-active))                (message "Quit activating %s" group)
1502           ;; If there are no articles in the group, the GROUP                nil)))
1503           ;; command may have responded with the `(0 . 0)'.  We           (unless dont-check
1504           ;; ignore this if we already have an active entry             (setq active (gnus-parse-active))
1505           ;; for the group.             ;; If there are no articles in the group, the GROUP
1506           (if (and (zerop (car active))             ;; command may have responded with the `(0 . 0)'.  We
1507                    (zerop (cdr active))             ;; ignore this if we already have an active entry
1508                    (gnus-active group))             ;; for the group.
1509               (gnus-active group)             (if (and (zerop (car active))
1510             (gnus-set-active group active)                      (zerop (cdr active))
1511             ;; Return the new active info.                      (gnus-active group))
1512             active))))                 (gnus-active group)
1513    
1514                 (gnus-set-active group active)
1515                 ;; Return the new active info.
1516                 active)))))
1517    
1518  (defun gnus-get-unread-articles-in-group (info active &optional update)  (defun gnus-get-unread-articles-in-group (info active &optional update)
1519    (when active    (when active
# Line 1413  newsgroup." Line 1530  newsgroup."
1530        (when (and gnus-use-cache info)        (when (and gnus-use-cache info)
1531          (inline (gnus-cache-possibly-alter-active          (inline (gnus-cache-possibly-alter-active
1532                   (gnus-info-group info) active)))                   (gnus-info-group info) active)))
1533    
1534          ;; If the agent is enabled, we may have to alter the active info.
1535          (when (and gnus-agent info)
1536            (gnus-agent-possibly-alter-active
1537             (gnus-info-group info) active))
1538    
1539        ;; Modify the list of read articles according to what articles        ;; Modify the list of read articles according to what articles
1540        ;; are available; then tally the unread articles and add the        ;; are available; then tally the unread articles and add the
1541        ;; number to the group hash table entry.        ;; number to the group hash table entry.
# Line 1479  newsgroup." Line 1602  newsgroup."
1602            (setq range (cdr range)))            (setq range (cdr range)))
1603          (setq num (max 0 (- (cdr active) num)))))          (setq num (max 0 (- (cdr active) num)))))
1604        ;; Set the number of unread articles.        ;; Set the number of unread articles.
1605        (when info        (when (and info
1606                     (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb))
1607          (setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num))          (setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num))
1608        num)))        num)))
1609    
1610  ;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb'  ;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb'
1611  ;; and compute how many unread articles there are in each group.  ;; and compute how many unread articles there are in each group.
1612  (defun gnus-get-unread-articles (&optional level)  (defun gnus-get-unread-articles (&optional level)
1613      (setq gnus-server-method-cache nil)
1614    (let* ((newsrc (cdr gnus-newsrc-alist))    (let* ((newsrc (cdr gnus-newsrc-alist))
1615           (level (or level gnus-activate-level (1+ gnus-level-subscribed)))           (level (or level gnus-activate-level (1+ gnus-level-subscribed)))
1616           (foreign-level           (foreign-level
# Line 1497  newsgroup." Line 1622  newsgroup."
1622                    gnus-activate-foreign-newsgroups)                    gnus-activate-foreign-newsgroups)
1623                   (t 0))                   (t 0))
1624             level))             level))
1625           scanned-methods info group active method retrievegroups)           (methods-cache nil)
1626      (gnus-message 5 "Checking new news...")           (type-cache nil)
1627             scanned-methods info group active method retrieve-groups cmethod
1628             method-type)
1629        (gnus-message 6 "Checking new news...")
1630    
1631      (while newsrc      (while newsrc
1632        (setq active (gnus-active (setq group (gnus-info-group        (setq active (gnus-active (setq group (gnus-info-group
# Line 1516  newsgroup." Line 1644  newsgroup."
1644        ;; nil for non-foreign groups that the user has requested not be checked        ;; nil for non-foreign groups that the user has requested not be checked
1645        ;; t for unchecked foreign groups or bogus groups, or groups that can't        ;; t for unchecked foreign groups or bogus groups, or groups that can't
1646        ;;   be checked, for one reason or other.        ;;   be checked, for one reason or other.
1647        (if (and (setq method (gnus-info-method info))        (when (setq method (gnus-info-method info))
1648                 (not (inline          (if (setq cmethod (assoc method methods-cache))
1649                        (gnus-server-equal              (setq method (cdr cmethod))
1650                         gnus-select-method            (setq cmethod (inline (gnus-server-get-method nil method)))
1651                         (setq method (gnus-server-get-method nil method)))))            (push (cons method cmethod) methods-cache)
1652                 (not (gnus-secondary-method-p method)))            (setq method cmethod)))
1653          (when (and method
1654                     (not (setq method-type (cdr (assoc method type-cache)))))
1655            (setq method-type
1656                  (cond
1657                   ((gnus-secondary-method-p method)
1658                    'secondary)
1659                   ((inline (gnus-server-equal gnus-select-method method))
1660                    'primary)
1661                   (t
1662                    'foreign)))
1663            (push (cons method method-type) type-cache))
1664          (if (and method
1665                   (eq method-type 'foreign))
1666            ;; These groups are foreign.  Check the level.            ;; These groups are foreign.  Check the level.
1667            (when (and (<= (gnus-info-level info) foreign-level)            (when (and (<= (gnus-info-level info) foreign-level)
1668                       (setq active (gnus-activate-group group 'scan)))                       (setq active (gnus-activate-group group 'scan)))
1669              ;; Let the Gnus agent save the active file.              ;; Let the Gnus agent save the active file.
1670              (when (and gnus-agent gnus-plugged active)              (when (and gnus-agent active (gnus-online method))
1671                (gnus-agent-save-group-info                (gnus-agent-save-group-info
1672                 method (gnus-group-real-name group) active))                 method (gnus-group-real-name group) active))
1673              (unless (inline (gnus-virtual-group-p group))              (unless (inline (gnus-virtual-group-p group))
# Line 1544  newsgroup." Line 1685  newsgroup."
1685            (if (gnus-check-backend-function 'retrieve-groups group)            (if (gnus-check-backend-function 'retrieve-groups group)
1686                ;; if server support gnus-retrieve-groups we push                ;; if server support gnus-retrieve-groups we push
1687                ;; the group onto retrievegroups for later checking                ;; the group onto retrievegroups for later checking
1688                (if (assoc method retrievegroups)                (if (assoc method retrieve-groups)
1689                    (setcdr (assoc method retrievegroups)                    (setcdr (assoc method retrieve-groups)
1690                            (cons group (cdr (assoc method retrievegroups))))                            (cons group (cdr (assoc method retrieve-groups))))
1691                  (push (list method group) retrievegroups))                  (push (list method group) retrieve-groups))
1692              ;; hack: `nnmail-get-new-mail' changes the mail-source depending              ;; hack: `nnmail-get-new-mail' changes the mail-source depending
1693              ;; on the group, so we must perform a scan for every group              ;; on the group, so we must perform a scan for every group
1694              ;; if the users has any directory mail sources.              ;; if the users has any directory mail sources.
# Line 1565  newsgroup." Line 1706  newsgroup."
1706                  (setq active (gnus-activate-group group))                  (setq active (gnus-activate-group group))
1707                (setq active (gnus-activate-group group 'scan))                (setq active (gnus-activate-group group 'scan))
1708                (push method scanned-methods))                (push method scanned-methods))
1709              (when active              (when active
1710                (gnus-close-group group))))))                (gnus-close-group group))))))
1711    
1712        ;; Get the number of unread articles in the group.        ;; Get the number of unread articles in the group.
1713        (cond        (cond
# Line 1580  newsgroup." Line 1721  newsgroup."
1721          ;; unread articles and stuff.          ;; unread articles and stuff.
1722          (gnus-set-active group nil)          (gnus-set-active group nil)
1723          (let ((tmp (gnus-gethash group gnus-newsrc-hashtb)))          (let ((tmp (gnus-gethash group gnus-newsrc-hashtb)))
1724            (if tmp (setcar tmp t))))))            (when tmp
1725                (setcar tmp t))))))
1726    
1727      ;; iterate through groups on methods which support gnus-retrieve-groups      ;; iterate through groups on methods which support gnus-retrieve-groups
1728      ;; and fetch a partial active file and use it to find new news.      ;; and fetch a partial active file and use it to find new news.
1729      (while retrievegroups      (dolist (rg retrieve-groups)
1730        (let* ((mg (pop retrievegroups))        (let ((method (or (car rg) gnus-select-method))
1731               (method (or (car mg) gnus-select-method))              (groups (cdr rg)))
              (groups (cdr mg)))  
1732          (when (gnus-check-server method)          (when (gnus-check-server method)
1733            ;; Request that the backend scan its incoming messages.            ;; Request that the backend scan its incoming messages.
1734            (when (gnus-check-backend-function 'request-scan (car method))            (when (gnus-check-backend-function 'request-scan (car method))
1735              (gnus-request-scan nil method))              (gnus-request-scan nil method))
1736            (gnus-read-active-file-2 (mapcar (lambda (group)            (gnus-read-active-file-2
1737                                               (gnus-group-real-name group))             (mapcar (lambda (group) (gnus-group-real-name group)) groups)
1738                                             groups) method)             method)
1739            (dolist (group groups)            (dolist (group groups)
1740              (cond              (cond
1741               ((setq active (gnus-active (gnus-info-group               ((setq active (gnus-active (gnus-info-group
1742                                           (setq info (gnus-get-info group)))))                                           (setq info (gnus-get-info group)))))
1743                (inline (gnus-get-unread-articles-in-group info active t)))                (inline (gnus-get-unread-articles-in-group info active t)))
1744               (t               (t
1745                ;; The group couldn't be reached, so we nix out the number of                ;; The group couldn't be reached, so we nix out the number of
1746                ;; unread articles and stuff.                ;; unread articles and stuff.
1747                (gnus-set-active group nil)                (gnus-set-active group nil)
1748                (setcar (gnus-gethash group gnus-newsrc-hashtb) t)))))))                (setcar (gnus-gethash group gnus-newsrc-hashtb) t)))))))
1749    
1750      (gnus-message 5 "Checking new news...done")))      (gnus-message 6 "Checking new news...done")))
1751    
1752  ;; Create a hash table out of the newsrc alist.  The `car's of the  ;; Create a hash table out of the newsrc alist.  The `car's of the
1753  ;; alist elements are used as keys.  ;; alist elements are used as keys.
# Line 1666  newsgroup." Line 1807  newsgroup."
1807               (setq article (pop articles)) ranges)               (setq article (pop articles)) ranges)
1808          (push article news)))          (push article news)))
1809      (when news      (when news
1810          ;; Enter this list into the group info.
1811        (gnus-info-set-read        (gnus-info-set-read
1812         info (gnus-remove-from-range (gnus-info-read info) (nreverse news)))         info (gnus-remove-from-range (gnus-info-read info) (nreverse news)))
1813    
1814          ;; Set the number of unread articles in gnus-newsrc-hashtb.
1815          (gnus-get-unread-articles-in-group info (gnus-active group))
1816    
1817          ;; Insert the change into the group buffer and the dribble file.
1818          (gnus-group-update-group group t))))
1819    
1820    (defun gnus-make-ascending-articles-unread (group articles)
1821      "Mark ascending ARTICLES in GROUP as unread."
1822      (let* ((entry (or (gnus-gethash group gnus-newsrc-hashtb)
1823                        (gnus-gethash (gnus-group-real-name group)
1824                                      gnus-newsrc-hashtb)))
1825             (info (nth 2 entry))
1826             (ranges (gnus-info-read info))
1827             (r ranges)
1828             modified)
1829    
1830        (while articles
1831          (let ((article (pop articles))) ; get the next article to remove from ranges
1832            (while (let ((range (car ranges))) ; note the current range
1833                     (if (atom range)       ; single value range
1834                         (cond ((not range)
1835                                ;; the articles extend past the end of the ranges
1836                                ;; OK - I'm done
1837                                (setq articles nil))
1838                               ((< range article)
1839                                ;; this range preceeds the article. Leave the range unmodified.
1840                                (pop ranges)
1841                                ranges)
1842                               ((= range article)
1843                                ;; this range exactly matches the article; REMOVE THE RANGE.
1844                                ;; NOTE: When the range being removed is the last range, the list is corrupted by inserting null at its end.
1845                                (setcar ranges (cadr ranges))
1846                                (setcdr ranges (cddr ranges))
1847                                (setq modified (if (car ranges) t 'remove-null))
1848                                nil))
1849                       (let ((min (car range))
1850                             (max (cdr range)))
1851                         ;; I have a min/max range to consider
1852                         (cond ((> min max) ; invalid range introduced by splitter
1853                                (setcar ranges (cadr ranges))
1854                                (setcdr ranges (cddr ranges))
1855                                (setq modified (if (car ranges) t 'remove-null))
1856                                ranges)
1857                               ((= min max)
1858                                ;; replace min/max range with a single-value range
1859                                (setcar ranges min)
1860                                ranges)
1861                               ((< max article)
1862                                ;; this range preceeds the article. Leave the range unmodified.
1863                                (pop ranges)
1864                                ranges)
1865                               ((< article min)
1866                                ;; this article preceeds the range.  Return null to move to the
1867                                ;; next article
1868                                nil)
1869                               (t
1870                                ;; this article splits the range into two parts
1871                                (setcdr ranges (cons (cons (1+ article) max) (cdr ranges)))
1872                                (setcdr range (1- article))
1873                                (setq modified t)
1874                                ranges))))))))
1875                      
1876        (when modified
1877          (when (eq modified 'remove-null)
1878            (setq r (delq nil r)))
1879          ;; Enter this list into the group info.
1880          (gnus-info-set-read info r)
1881    
1882          ;; Set the number of unread articles in gnus-newsrc-hashtb.
1883          (gnus-get-unread-articles-in-group info (gnus-active group))
1884    
1885          ;; Insert the change into the group buffer and the dribble file.
1886        (gnus-group-update-group group t))))        (gnus-group-update-group group t))))
1887    
1888  ;; Enter all dead groups into the hashtb.  ;; Enter all dead groups into the hashtb.
# Line 1733  newsgroup." Line 1948  newsgroup."
1948          ;; Only do each method once, in case the methods appear more          ;; Only do each method once, in case the methods appear more
1949          ;; than once in this list.          ;; than once in this list.
1950          (unless (member method methods)          (unless (member method methods)
1951            (condition-case ()            (if (or debug-on-error debug-on-quit)
1952                (gnus-read-active-file-1 method force)                (gnus-read-active-file-1 method force)
1953              ;; We catch C-g so that we can continue past servers              (condition-case ()
1954              ;; that do not respond.                  (gnus-read-active-file-1 method force)
1955              (quit                ;; We catch C-g so that we can continue past servers
1956               (message "Quit reading the active file")                ;; that do not respond.
1957               nil)))))))                (quit
1958                   (message "Quit reading the active file")
1959                   nil))))))))
1960    
1961  (defun gnus-read-active-file-1 (method force)  (defun gnus-read-active-file-1 (method force)
1962    (let (where mesg)    (let (where mesg)
# Line 1784  newsgroup." Line 2001  newsgroup."
2001            (gnus-message 5 "%sdone" mesg)))))))            (gnus-message 5 "%sdone" mesg)))))))
2002    
2003  (defun gnus-read-active-file-2 (groups method)  (defun gnus-read-active-file-2 (groups method)
2004    "Read an active file for GROUPS in METHOD using gnus-retrieve-groups."    "Read an active file for GROUPS in METHOD using `gnus-retrieve-groups'."
2005    (when groups    (when groups
2006      (save-excursion      (save-excursion
2007        (set-buffer nntp-server-buffer)        (set-buffer nntp-server-buffer)
# Line 1831  newsgroup." Line 2048  newsgroup."
2048          (insert ?\\)))          (insert ?\\)))
2049    
2050      ;; Let the Gnus agent save the active file.      ;; Let the Gnus agent save the active file.
2051      (when (and gnus-agent real-active gnus-plugged)      (when (and gnus-agent real-active (gnus-online method))
2052        (gnus-agent-save-active method))        (gnus-agent-save-active method))
2053    
2054      ;; If these are groups from a foreign select method, we insert the      ;; If these are groups from a foreign select method, we insert the
# Line 1851  newsgroup." Line 2068  newsgroup."
2068      (goto-char (point-min))      (goto-char (point-min))
2069      (let (group max min)      (let (group max min)
2070        (while (not (eobp))        (while (not (eobp))
2071          (condition-case err          (condition-case ()
2072              (progn              (progn
2073                (narrow-to-region (point) (gnus-point-at-eol))                (narrow-to-region (point) (gnus-point-at-eol))
2074                ;; group gets set to a symbol interned in the hash table                ;; group gets set to a symbol interned in the hash table
# Line 1907  newsgroup." Line 2124  newsgroup."
2124      ;; Let the Gnus agent save the active file.      ;; Let the Gnus agent save the active file.
2125      (if (and gnus-agent      (if (and gnus-agent
2126               real-active               real-active
2127               gnus-plugged               (gnus-online method)
2128               (gnus-agent-method-p method))               (gnus-agent-method-p method))
2129          (progn          (progn
2130            (gnus-agent-save-groups method)            (gnus-agent-save-groups method)
# Line 1948  newsgroup." Line 2165  newsgroup."
2165    "Read startup file.    "Read startup file.
2166  If FORCE is non-nil, the .newsrc file is read."  If FORCE is non-nil, the .newsrc file is read."
2167    ;; Reset variables that might be defined in the .newsrc.eld file.    ;; Reset variables that might be defined in the .newsrc.eld file.
2168    (let ((variables gnus-variable-list))    (let ((variables (remove 'gnus-format-specs gnus-variable-list)))
2169      (while variables      (while variables
2170        (set (car variables) nil)        (set (car variables) nil)
2171        (setq variables (cdr variables))))        (setq variables (cdr variables))))
# Line 2011  If FORCE is non-nil, the .newsrc file is Line 2228  If FORCE is non-nil, the .newsrc file is
2228              (nconc (gnus-uncompress-range dormant)              (nconc (gnus-uncompress-range dormant)
2229                     (gnus-uncompress-range ticked)))))))))                     (gnus-uncompress-range ticked)))))))))
2230    
2231    (defun gnus-load (file)
2232      "Load FILE, but in such a way that read errors can be reported."
2233      (with-temp-buffer
2234        (insert-file-contents file)
2235        (while (not (eobp))
2236          (condition-case type
2237              (let ((form (read (current-buffer))))
2238                (eval form))
2239            (error
2240             (unless (eq (car type) 'end-of-file)
2241               (let ((error (format "Error in %s line %d" file
2242                                    (count-lines (point-min) (point)))))
2243                 (ding)
2244                 (unless (gnus-yes-or-no-p (concat error "; continue? "))
2245                   (error "%s" error)))))))))
2246    
2247  (defun gnus-read-newsrc-el-file (file)  (defun gnus-read-newsrc-el-file (file)
2248    (let ((ding-file (concat file "d")))    (let ((ding-file (concat file "d")))
2249      ;; We always, always read the .eld file.      (when (file-exists-p ding-file)
2250      (gnus-message 5 "Reading %s..." ding-file)        ;; We always, always read the .eld file.
2251      (let (gnus-newsrc-assoc)        (gnus-message 5 "Reading %s..." ding-file)
2252        (condition-case nil        (let (gnus-newsrc-assoc)
2253            (load ding-file t t t)          (gnus-load ding-file)
2254          (error          ;; Older versions of `gnus-format-specs' are no longer valid
2255           (ding)          ;; in Oort Gnus 0.01.
2256           (unless (gnus-yes-or-no-p          (let ((version
2257                    (format "Error in %s; continue? " ding-file))                 (and gnus-newsrc-file-version
2258             (error "Error in %s" ding-file))))                      (gnus-continuum-version gnus-newsrc-file-version))))
2259        (when gnus-newsrc-assoc            (when (or (not version)
2260          (setq gnus-newsrc-alist gnus-newsrc-assoc)))                      (< version 5.090009))
2261                (setq gnus-format-specs gnus-default-format-specs)))
2262            (when gnus-newsrc-assoc
2263              (setq gnus-newsrc-alist gnus-newsrc-assoc))))
2264      (gnus-make-hashtable-from-newsrc-alist)      (gnus-make-hashtable-from-newsrc-alist)
2265      (when (file-newer-than-file-p file ding-file)      (when (file-newer-than-file-p file ding-file)
2266        ;; Old format quick file        ;; Old format quick file
2267        (gnus-message 5 "Reading %s..." file)        (gnus-message 5 "Reading %s..." file)
2268        ;; The .el file is newer than the .eld file, so we read that one        ;; The .el file is newer than the .eld file, so we read that one
2269        ;; as well.        ;; as well.
2270        (gnus-read-old-newsrc-el-file file))))        (gnus-read-old-newsrc-el-file file)))
2271      (gnus-run-hooks 'gnus-read-newsrc-el-hook))
2272    
2273  ;; Parse the old-style quick startup file  ;; Parse the old-style quick startup file
2274  (defun gnus-read-old-newsrc-el-file (file)  (defun gnus-read-old-newsrc-el-file (file)
# Line 2157  If FORCE is non-nil, the .newsrc file is Line 2394  If FORCE is non-nil, the .newsrc file is
2394                reads nil)                reads nil)
2395          (if (eolp)          (if (eolp)
2396              ;; If the line ends here, this is clearly a buggy line, so              ;; If the line ends here, this is clearly a buggy line, so
2397              ;; we put point at the beginning of line and let the cond              ;; we put point a the beginning of line and let the cond
2398              ;; below do the error handling.              ;; below do the error handling.
2399              (beginning-of-line)              (beginning-of-line)
2400            ;; We skip to the beginning of the ranges.            ;; We skip to the beginning of the ranges.
# Line 2343  If FORCE is non-nil, the .newsrc file is Line 2580  If FORCE is non-nil, the .newsrc file is
2580    
2581        (setq gnus-newsrc-options-n out))))        (setq gnus-newsrc-options-n out))))
2582    
2583    (eval-and-compile
2584      (defalias 'gnus-long-file-names
2585        (if (fboundp 'msdos-long-file-names)
2586          'msdos-long-file-names
2587          (lambda () t))))
2588    
2589  (defun gnus-save-newsrc-file (&optional force)  (defun gnus-save-newsrc-file (&optional force)
2590    "Save .newsrc file."    "Save .newsrc file."
2591    ;; Note: We cannot save .newsrc file if all newsgroups are removed    ;; Note: We cannot save .newsrc file if all newsgroups are removed
# Line 2369  If FORCE is non-nil, the .newsrc file is Line 2612  If FORCE is non-nil, the .newsrc file is
2612            ;; Save .newsrc.eld.            ;; Save .newsrc.eld.
2613            (set-buffer (gnus-get-buffer-create " *Gnus-newsrc*"))            (set-buffer (gnus-get-buffer-create " *Gnus-newsrc*"))
2614            (make-local-variable 'version-control)            (make-local-variable 'version-control)
2615            (setq version-control 'never)            (setq version-control gnus-backup-startup-file)
2616            (setq buffer-file-name            (setq buffer-file-name
2617                  (concat gnus-current-startup-file ".eld"))                  (concat gnus-current-startup-file ".eld"))
2618            (setq default-directory (file-name-directory buffer-file-name))            (setq default-directory (file-name-directory buffer-file-name))
2619            (buffer-disable-undo)            (buffer-disable-undo)
2620            (erase-buffer)            (erase-buffer)
2621            (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file)            (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file)
2622            (gnus-gnus-to-quick-newsrc-format)  
2623            (gnus-run-hooks 'gnus-save-quick-newsrc-hook)            (if gnus-save-startup-file-via-temp-buffer
2624            (let ((coding-system-for-write gnus-ding-file-coding-system))                (let ((coding-system-for-write gnus-ding-file-coding-system)
2625              (save-buffer))                      (standard-output (current-buffer)))
2626            (kill-buffer (current-buffer))                  (gnus-gnus-to-quick-newsrc-format)
2627                    (gnus-run-hooks 'gnus-save-quick-newsrc-hook)
2628                    (save-buffer))
2629                (let ((coding-system-for-write gnus-ding-file-coding-system)
2630                      (version-control gnus-backup-startup-file)
2631                      (startup-file (concat gnus-current-startup-file ".eld"))
2632                      (working-dir (file-name-directory gnus-current-startup-file))
2633                      working-file
2634                      (i -1))
2635                  ;; Generate the name of a non-existent file.
2636                  (while (progn (setq working-file
2637                                      (format
2638                                       (if (and (eq system-type 'ms-dos)
2639                                                (not (gnus-long-file-names)))
2640                                           "%s#%d.tm#" ; MSDOS limits files to 8+3
2641                                         (if (memq system-type '(vax-vms axp-vms))
2642                                             "%s$tmp$%d"
2643                                           "%s#tmp#%d"))
2644                                       working-dir (setq i (1+ i))))
2645                                (file-exists-p working-file)))
2646    
2647                  (unwind-protect
2648                      (progn
2649                        (gnus-with-output-to-file working-file
2650                          (gnus-gnus-to-quick-newsrc-format)
2651                          (gnus-run-hooks 'gnus-save-quick-newsrc-hook))
2652    
2653                        ;; These bindings will mislead the current buffer
2654                        ;; into thinking that it is visiting the startup
2655                        ;; file.
2656                        (let ((buffer-backed-up nil)
2657                              (buffer-file-name startup-file)
2658                              (file-precious-flag t)
2659                              (setmodes (file-modes startup-file)))
2660                          ;; Backup the current version of the startup file.
2661                          (backup-buffer)
2662    
2663                          ;; Replace the existing startup file with the temp file.
2664                          (rename-file working-file startup-file t)
2665                          (set-file-modes startup-file setmodes)))
2666                    (condition-case nil
2667                        (delete-file working-file)
2668                      (file-error nil)))))
2669    
2670              (gnus-kill-buffer (current-buffer))
2671            (gnus-message            (gnus-message
2672             5 "Saving %s.eld...done" gnus-current-startup-file))             5 "Saving %s.eld...done" gnus-current-startup-file))
2673          (gnus-dribble-delete-file)          (gnus-dribble-delete-file)
2674          (gnus-group-set-mode-line)))))          (gnus-group-set-mode-line)))))
2675    
2676  (defun gnus-gnus-to-quick-newsrc-format ()  (defun gnus-gnus-to-quick-newsrc-format (&optional minimal name &rest specific-variables)
2677    "Insert Gnus variables such as gnus-newsrc-alist in lisp format."    "Print Gnus variables such as `gnus-newsrc-alist' in Lisp format."
2678    (let ((print-quoted t)      (princ (format ";; -*- emacs-lisp; coding: %s;-*-\n"
2679          (print-escape-newlines t))                     gnus-ding-file-coding-system))
2680        (if name
2681      (insert ";; -*- emacs-lisp; coding: "          (princ (format ";; %s\n" name))
2682              (format "%s" gnus-ding-file-coding-system) ";-*-\n")        (princ ";; Gnus startup file.\n"))
2683      (insert ";; Gnus startup file.\n")  
2684      (insert "\      (unless minimal
2685          (princ "\
2686  ;; Never delete this file -- if you want to force Gnus to read the  ;; Never delete this file -- if you want to force Gnus to read the
2687  ;; .newsrc file (if you have one), touch .newsrc instead.\n")  ;; .newsrc file (if you have one), touch .newsrc instead.\n")
2688      (insert "(setq gnus-newsrc-file-version "        (princ "(setq gnus-newsrc-file-version ")
2689              (prin1-to-string gnus-version) ")\n")        (princ (gnus-prin1-to-string gnus-version))
2690      (let* ((gnus-killed-list        (princ ")\n"))
2691    
2692        (let* ((print-quoted t)
2693               (print-readably t)
2694               (print-escape-multibyte nil)
2695               (print-escape-nonascii t)
2696               (print-length nil)
2697               (print-level nil)
2698               (print-escape-newlines t)
2699               (gnus-killed-list
2700              (if (and gnus-save-killed-list              (if (and gnus-save-killed-list
2701                       (stringp gnus-save-killed-list))                       (stringp gnus-save-killed-list))
2702                  (gnus-strip-killed-list)                  (gnus-strip-killed-list)
2703                gnus-killed-list))                gnus-killed-list))
2704             (variables             (variables
2705              (if gnus-save-killed-list gnus-variable-list              (or specific-variables
2706                ;; Remove the `gnus-killed-list' from the list of variables                  (if gnus-save-killed-list gnus-variable-list
2707                ;; to be saved, if required.                    ;; Remove the `gnus-killed-list' from the list of variables
2708                (delq 'gnus-killed-list (copy-sequence gnus-variable-list))))                    ;; to be saved, if required.
2709                      (delq 'gnus-killed-list (copy-sequence gnus-variable-list)))))
2710             ;; Peel off the "dummy" group.             ;; Peel off the "dummy" group.
2711             (gnus-newsrc-alist (cdr gnus-newsrc-alist))             (gnus-newsrc-alist (cdr gnus-newsrc-alist))
2712             variable)             variable)
# Line 2416  If FORCE is non-nil, the .newsrc file is Line 2714  If FORCE is non-nil, the .newsrc file is
2714        (while variables        (while variables
2715          (when (and (boundp (setq variable (pop variables)))          (when (and (boundp (setq variable (pop variables)))
2716                     (symbol-value variable))                     (symbol-value variable))
2717            (insert "(setq " (symbol-name variable) " '")            (princ "(setq ")
2718            (gnus-prin1 (symbol-value variable))            (princ (symbol-name variable))
2719            (insert ")\n"))))))            (princ " '")
2720              (prin1 (symbol-value variable))
2721              (princ ")\n")))))
2722    
2723  (defun gnus-strip-killed-list ()  (defun gnus-strip-killed-list ()
2724    "Return the killed list minus the groups that match `gnus-save-killed-list'."    "Return the killed list minus the groups that match `gnus-save-killed-list'."
# Line 2626  If FORCE is non-nil, the .newsrc file is Line 2926  If FORCE is non-nil, the .newsrc file is
2926              (skip-chars-forward " \t")              (skip-chars-forward " \t")
2927              ;; ...  which leads to this line being effectively ignored.              ;; ...  which leads to this line being effectively ignored.
2928              (when (symbolp group)              (when (symbolp group)
2929                (let ((str (buffer-substring                (let* ((str (buffer-substring
2930                            (point) (progn (end-of-line) (point))))                             (point) (progn (end-of-line) (point))))
2931                      (coding                       (name (symbol-name group))
2932                       (and (or (featurep 'xemacs)                       (charset
2933                                (and (boundp 'enable-multibyte-characters)                        (or (gnus-group-name-charset method name)
2934                                     enable-multibyte-characters))                            (gnus-parameter-charset name)
2935                            (fboundp 'gnus-mule-get-coding-system)                            gnus-default-charset)))
2936                            (gnus-mule-get-coding-system (symbol-name group)))))                  ;; Fixme: Don't decode in unibyte mode.
2937                  (when coding                  (when (and str charset (featurep 'mule))
2938                    (setq str (mm-decode-coding-string str (car coding))))                    (setq str (mm-decode-coding-string str charset)))
2939                  (set group str)))                  (set group str)))
2940              (forward-line 1))))              (forward-line 1))))
2941        (gnus-message 5 "Reading descriptions file...done")        (gnus-message 5 "Reading descriptions file...done")
# Line 2652  If FORCE is non-nil, the .newsrc file is Line 2952  If FORCE is non-nil, the .newsrc file is
2952    
2953  ;;;###autoload  ;;;###autoload
2954  (defun gnus-declare-backend (name &rest abilities)  (defun gnus-declare-backend (name &rest abilities)
2955    "Declare backend NAME with ABILITIES as a Gnus backend."    "Declare back end NAME with ABILITIES as a Gnus back end."
2956    (setq gnus-valid-select-methods    (setq gnus-valid-select-methods
2957          (nconc gnus-valid-select-methods          (nconc gnus-valid-select-methods
2958                 (list (apply 'list name abilities))))                 (list (apply 'list name abilities))))
# Line 2667  If this variable is nil, don't do anythi Line 2967  If this variable is nil, don't do anythi
2967              (file-name-as-directory (expand-file-name gnus-default-directory))              (file-name-as-directory (expand-file-name gnus-default-directory))
2968            default-directory)))            default-directory)))
2969    
2970    (eval-and-compile
2971    (defalias 'gnus-display-time-event-handler
2972      (if (gnus-boundp 'display-time-timer)
2973          'display-time-event-handler
2974        (lambda () "Does nothing as `display-time-timer' is not bound.
2975    Would otherwise be an alias for `display-time-event-handler'." nil))))
2976    
2977    ;;;###autoload
2978    (defun gnus-fixup-nnimap-unread-after-getting-new-news ()
2979      (let (server group info)
2980        (mapatoms
2981         (lambda (sym)
2982           (when (and (setq group (symbol-name sym))
2983                      (gnus-group-entry group)
2984                      (setq info (symbol-value sym)))
2985             (gnus-sethash group (cons (nth 2 info) (cdr (gnus-group-entry group)))
2986                           gnus-newsrc-hashtb)))
2987         (if (boundp 'nnimap-mailbox-info)
2988             (symbol-value 'nnimap-mailbox-info)
2989           (make-vector 1 0)))))
2990    
2991    
2992  (provide 'gnus-start)  (provide 'gnus-start)
2993    
2994  ;;; arch-tag: f4584a22-b7b7-4853-abfc-a637329af5d2  ;;; arch-tag: f4584a22-b7b7-4853-abfc-a637329af5d2
2995  ;;; gnus-start.el ends here  ;;; gnus-start.el ends here
2996    
2997    

Legend:
Removed from v.1.21.6.2  
changed lines
  Added in v.1.21.6.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26