/[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.20.2.2 by miles, Tue Oct 14 23:34:50 2003 UTC revision 1.20.2.3 by miles, Thu Sep 16 00:12:16 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 432  Can be used to turn version control on o Line 483  Can be used to turn version control on o
483              (condition-case var              (condition-case var
484                  (load file nil t)                  (load file nil t)
485                (error                (error
486                 (error "Error in %s: %s" file var)))))))))                 (error "Error in %s: %s" file (cadr var))))))))))
487    
488  ;; For subscribing new newsgroup  ;; For subscribing new newsgroup
489    
# Line 508  Can be used to turn version control on o Line 559  Can be used to turn version control on o
559    (gnus-subscribe-newsgroup newsgroup))    (gnus-subscribe-newsgroup newsgroup))
560    
561  (defun gnus-subscribe-alphabetically (newgroup)  (defun gnus-subscribe-alphabetically (newgroup)
562    "Subscribe new NEWSGROUP and insert it in alphabetical order."    "Subscribe new NEWGROUP and insert it in alphabetical order."
563    (let ((groups (cdr gnus-newsrc-alist))    (let ((groups (cdr gnus-newsrc-alist))
564          before)          before)
565      (while (and (not before) groups)      (while (and (not before) groups)
# Line 518  Can be used to turn version control on o Line 569  Can be used to turn version control on o
569      (gnus-subscribe-newsgroup newgroup before)))      (gnus-subscribe-newsgroup newgroup before)))
570    
571  (defun gnus-subscribe-hierarchically (newgroup)  (defun gnus-subscribe-hierarchically (newgroup)
572    "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order."    "Subscribe new NEWGROUP and insert it in hierarchical newsgroup order."
573    ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)    ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
574    (save-excursion    (save-excursion
575      (set-buffer (nnheader-find-file-noselect gnus-current-startup-file))      (set-buffer (nnheader-find-file-noselect gnus-current-startup-file))
576      (let ((groupkey newgroup)      (prog1
577            before)          (let ((groupkey newgroup) before)
578        (while (and (not before) groupkey)            (while (and (not before) groupkey)
579          (goto-char (point-min))              (goto-char (point-min))
580          (let ((groupkey-re              (let ((groupkey-re
581                 (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))                     (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
582            (while (and (re-search-forward groupkey-re nil t)                (while (and (re-search-forward groupkey-re nil t)
583                        (progn                            (progn
584                          (setq before (match-string 1))                              (setq before (match-string 1))
585                          (string< before newgroup)))))                              (string< before newgroup)))))
586          ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)              ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
587          (setq groupkey              (setq groupkey
588                (when (string-match "^\\(.*\\)\\.[^.]+$" groupkey)                    (when (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
589                  (substring groupkey (match-beginning 1) (match-end 1)))))                      (substring groupkey (match-beginning 1) (match-end 1)))))
590        (gnus-subscribe-newsgroup newgroup before))            (gnus-subscribe-newsgroup newgroup before))
591      (kill-buffer (current-buffer))))        (kill-buffer (current-buffer)))))
592    
593  (defun gnus-subscribe-interactively (group)  (defun gnus-subscribe-interactively (group)
594    "Subscribe the new GROUP interactively.    "Subscribe the new GROUP interactively.
# Line 566  the first newsgroup." Line 617  the first newsgroup."
617       newsgroup gnus-level-default-subscribed       newsgroup gnus-level-default-subscribed
618       gnus-level-killed (gnus-gethash (or next "dummy.group")       gnus-level-killed (gnus-gethash (or next "dummy.group")
619                                       gnus-newsrc-hashtb))                                       gnus-newsrc-hashtb))
620      (gnus-message 5 "Subscribe newsgroup: %s" newsgroup)))      (gnus-message 5 "Subscribe newsgroup: %s" newsgroup)
621        (run-hook-with-args 'gnus-subscribe-newsgroup-hooks newsgroup)
622        t))
623    
624  (defun gnus-read-active-file-p ()  (defun gnus-read-active-file-p ()
625    "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 575  the first newsgroup." Line 628  the first newsgroup."
628  ;;; General various misc type functions.  ;;; General various misc type functions.
629    
630  ;; Silence byte-compiler.  ;; Silence byte-compiler.
631  (defvar gnus-current-headers)  (eval-when-compile
632  (defvar gnus-thread-indent-array)    (defvar gnus-current-headers)
633  (defvar gnus-newsgroup-name)    (defvar gnus-thread-indent-array)
634  (defvar gnus-newsgroup-headers)    (defvar gnus-newsgroup-name)
635  (defvar gnus-group-list-mode)    (defvar gnus-newsgroup-headers)
636  (defvar gnus-group-mark-positions)    (defvar gnus-group-list-mode)
637  (defvar gnus-newsgroup-data)    (defvar gnus-group-mark-positions)
638  (defvar gnus-newsgroup-unreads)    (defvar gnus-newsgroup-data)
639  (defvar nnoo-state-alist)    (defvar gnus-newsgroup-unreads)
640  (defvar gnus-current-select-method)    (defvar nnoo-state-alist)
641      (defvar gnus-current-select-method)
642      (defvar mail-sources)
643      (defvar nnmail-scan-directory-mail-source-once)
644      (defvar nnmail-split-history)
645      (defvar nnmail-spool-file))
646    
647    (defun gnus-close-all-servers ()
648      "Close all servers."
649      (interactive)
650      (dolist (server gnus-opened-servers)
651        (gnus-close-server (car server))))
652    
653  (defun gnus-clear-system ()  (defun gnus-clear-system ()
654    "Clear all variables and buffers."    "Clear all variables and buffers."
655    ;; Clear Gnus variables.    ;; Clear Gnus variables.
656    (let ((variables gnus-variable-list))    (let ((variables (remove 'gnus-format-specs gnus-variable-list)))
657      (while variables      (while variables
658        (set (car variables) nil)        (set (car variables) nil)
659        (setq variables (cdr variables))))        (setq variables (cdr variables))))
660    ;; Clear other internal variables.    ;; Clear other internal variables.
661    (setq gnus-list-of-killed-groups nil    (setq gnus-list-of-killed-groups nil
662          gnus-have-read-active-file nil          gnus-have-read-active-file nil
663            gnus-agent-covered-methods nil
664            gnus-server-method-cache nil
665          gnus-newsrc-alist nil          gnus-newsrc-alist nil
666          gnus-newsrc-hashtb nil          gnus-newsrc-hashtb nil
667          gnus-killed-list nil          gnus-killed-list nil
# Line 630  the first newsgroup." Line 696  the first newsgroup."
696      (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil))))      (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil))))
697    (gnus-kill-buffer nntp-server-buffer)    (gnus-kill-buffer nntp-server-buffer)
698    ;; Kill Gnus buffers.    ;; Kill Gnus buffers.
699    (let ((buffers (gnus-buffers)))    (dolist (buffer (gnus-buffers))
700      (when buffers      (gnus-kill-buffer buffer))
       (mapcar 'kill-buffer buffers)))  
701    ;; Remove Gnus frames.    ;; Remove Gnus frames.
702    (gnus-kill-gnus-frames))    (gnus-kill-gnus-frames))
703    
# Line 670  prompt the user for the name of an NNTP Line 735  prompt the user for the name of an NNTP
735      (nnheader-init-server-buffer)      (nnheader-init-server-buffer)
736      (setq gnus-slave slave)      (setq gnus-slave slave)
737      (gnus-read-init-file)      (gnus-read-init-file)
738        (if gnus-agent
739            (gnus-agentize))
740    
741      (when gnus-simple-splash      (when gnus-simple-splash
742        (setq gnus-simple-splash nil)        (setq gnus-simple-splash nil)
# Line 707  prompt the user for the name of an NNTP Line 774  prompt the user for the name of an NNTP
774              (add-hook 'gnus-summary-mode-hook 'gnus-grouplens-mode))              (add-hook 'gnus-summary-mode-hook 'gnus-grouplens-mode))
775    
776            ;; Do the actual startup.            ;; Do the actual startup.
777              (if gnus-agent
778                  (gnus-request-create-group "queue" '(nndraft "")))
779              (gnus-request-create-group "drafts" '(nndraft ""))
780            (gnus-setup-news nil level dont-connect)            (gnus-setup-news nil level dont-connect)
781            (gnus-run-hooks 'gnus-setup-news-hook)            (gnus-run-hooks 'gnus-setup-news-hook)
782            (gnus-start-draft-setup)            (gnus-start-draft-setup)
# Line 726  prompt the user for the name of an NNTP Line 796  prompt the user for the name of an NNTP
796      (gnus-group-set-parameter      (gnus-group-set-parameter
797       "nndraft:drafts" 'gnus-dummy '((gnus-draft-mode)))))       "nndraft:drafts" 'gnus-dummy '((gnus-draft-mode)))))
798    
 ;;;###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))))  
   
799    
800  ;;;  ;;;
801  ;;; Dribble file  ;;; Dribble file
# Line 763  cautiously -- unloading may cause troubl Line 822  cautiously -- unloading may cause troubl
822        (set-buffer gnus-dribble-buffer)        (set-buffer gnus-dribble-buffer)
823        (goto-char (point-max))        (goto-char (point-max))
824        (insert string "\n")        (insert string "\n")
825        (set-window-point (get-buffer-window (current-buffer)) (point-max))        ;; This has been commented by Josh Huber <huber@alum.wpi.edu>
826          ;; It causes problems with both XEmacs and Emacs 21, and doesn't
827          ;; seem to be of much value. (FIXME: remove this after we make sure
828          ;; it's not needed).
829          ;; (set-window-point (get-buffer-window (current-buffer)) (point-max))
830        (bury-buffer gnus-dribble-buffer)        (bury-buffer gnus-dribble-buffer)
831        (save-excursion        (save-excursion
832          (set-buffer gnus-group-buffer)          (set-buffer gnus-group-buffer)
# Line 789  cautiously -- unloading may cause troubl Line 852  cautiously -- unloading may cause troubl
852        (set-buffer-modified-p nil)        (set-buffer-modified-p nil)
853        (let ((auto (make-auto-save-file-name))        (let ((auto (make-auto-save-file-name))
854              (gnus-dribble-ignore t)              (gnus-dribble-ignore t)
855                (purpose nil)
856              modes)              modes)
857          (when (or (file-exists-p auto) (file-exists-p dribble-file))          (when (or (file-exists-p auto) (file-exists-p dribble-file))
858            ;; Load whichever file is newest -- the auto save file            ;; Load whichever file is newest -- the auto save file
# Line 804  cautiously -- unloading may cause troubl Line 868  cautiously -- unloading may cause troubl
868                       (file-exists-p dribble-file)                       (file-exists-p dribble-file)
869                       (setq modes (file-modes gnus-current-startup-file)))                       (setq modes (file-modes gnus-current-startup-file)))
870              (set-file-modes dribble-file modes))              (set-file-modes dribble-file modes))
871              (goto-char (point-min))
872              (when (search-forward "Gnus was exited on purpose" nil t)
873                (setq purpose t))
874            ;; Possibly eval the file later.            ;; Possibly eval the file later.
875            (when (or gnus-always-read-dribble-file            (when (or gnus-always-read-dribble-file
876                      (gnus-y-or-n-p                      (gnus-y-or-n-p
877                       "Gnus auto-save file exists.  Do you want to read it? "))                       (if purpose
878                             "Gnus exited on purpose without saving; read auto-save file anyway? "
879                         "Gnus auto-save file exists.  Do you want to read it? ")))
880              (setq gnus-dribble-eval-file t)))))))              (setq gnus-dribble-eval-file t)))))))
881    
882  (defun gnus-dribble-eval-file ()  (defun gnus-dribble-eval-file ()
# Line 869  If LEVEL is non-nil, the news will be se Line 938  If LEVEL is non-nil, the news will be se
938    
939      ;; Make sure the archive server is available to all and sundry.      ;; Make sure the archive server is available to all and sundry.
940      (when gnus-message-archive-method      (when gnus-message-archive-method
941        (setq gnus-server-alist (delq (assoc "archive" gnus-server-alist)        (unless (assoc "archive" gnus-server-alist)
942                                      gnus-server-alist))          (push `("archive"
943        (push (cons "archive" gnus-message-archive-method)                  nnfolder
944              gnus-server-alist))                  "archive"
945                    (nnfolder-directory
946                     ,(nnheader-concat message-directory "archive"))
947                    (nnfolder-active-file
948                     ,(nnheader-concat message-directory "archive/active"))
949                    (nnfolder-get-new-mail nil)
950                    (nnfolder-inhibit-expiry t))
951                  gnus-server-alist)))
952    
953      ;; 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
954      ;; hashtb here.      ;; hashtb here.
# Line 880  If LEVEL is non-nil, the news will be se Line 956  If LEVEL is non-nil, the news will be se
956                (eq gnus-read-active-file 'some))                (eq gnus-read-active-file 'some))
957        (gnus-update-active-hashtb-from-killed))        (gnus-update-active-hashtb-from-killed))
958    
959        ;; Validate agent covered methods now that gnus-server-alist has
960        ;; been initialized.
961        ;; NOTE: This is here for one purpose only.  By validating the
962        ;; agentized server's, it converts the old 5.10.3, and earlier,
963        ;; format to the current format.  That enables the agent code
964        ;; within gnus-read-active-file to function correctly.
965        (if gnus-agent
966            (gnus-agent-read-servers-validate))
967    
968      ;; Read the active file and create `gnus-active-hashtb'.      ;; Read the active file and create `gnus-active-hashtb'.
969      ;; 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
970      ;; 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 908  If LEVEL is non-nil, the news will be se Line 993  If LEVEL is non-nil, the news will be se
993    
994      ;; See whether we need to read the description file.      ;; See whether we need to read the description file.
995      (when (and (boundp 'gnus-group-line-format)      (when (and (boundp 'gnus-group-line-format)
996                   (stringp gnus-group-line-format)
997                 (let ((case-fold-search nil))                 (let ((case-fold-search nil))
998                   (string-match "%[-,0-9]*D" gnus-group-line-format))                   (string-match "%[-,0-9]*D" gnus-group-line-format))
999                 (not gnus-description-hashtb)                 (not gnus-description-hashtb)
# Line 922  If LEVEL is non-nil, the news will be se Line 1008  If LEVEL is non-nil, the news will be se
1008                 gnus-plugged)                 gnus-plugged)
1009        (gnus-find-new-newsgroups))        (gnus-find-new-newsgroups))
1010    
1011        ;; Check and remove bogus newsgroups.
1012        (when (and init gnus-check-bogus-newsgroups
1013                   gnus-read-active-file (not level)
1014                   (gnus-server-opened gnus-select-method))
1015          (gnus-check-bogus-newsgroups))
1016    
1017      ;; We might read in new NoCeM messages here.      ;; We might read in new NoCeM messages here.
1018      (when (and gnus-use-nocem      (when (and gnus-use-nocem
1019                 (not level)                 (not level)
# Line 933  If LEVEL is non-nil, the news will be se Line 1025  If LEVEL is non-nil, the news will be se
1025    
1026      ;; Find the number of unread articles in each non-dead group.      ;; Find the number of unread articles in each non-dead group.
1027      (let ((gnus-read-active-file (and (not level) gnus-read-active-file)))      (let ((gnus-read-active-file (and (not level) gnus-read-active-file)))
1028        (gnus-get-unread-articles level))        (gnus-get-unread-articles level))))
1029    
1030      (when (and init gnus-check-bogus-newsgroups  (defun gnus-call-subscribe-functions (method group)
1031                 gnus-read-active-file (not level)    "Call METHOD to subscribe GROUP.
1032                 (gnus-server-opened gnus-select-method))  If no function returns `non-nil', call `gnus-subscribe-zombies'."
1033        (gnus-check-bogus-newsgroups))))    (unless (cond
1034               ((functionp method)
1035                (funcall method group))
1036               ((listp method)
1037                (catch 'found
1038                  (dolist (func method)
1039                    (if (funcall func group)
1040                        (throw 'found t)))
1041                  nil))
1042               (t nil))
1043        (gnus-subscribe-zombies group)))
1044    
1045  (defun gnus-find-new-newsgroups (&optional arg)  (defun gnus-find-new-newsgroups (&optional arg)
1046    "Search for new newsgroups and add them.    "Search for new newsgroups and add them.
# Line 992  for new groups, and subscribe the new gr Line 1094  for new groups, and subscribe the new gr
1094                    ((eq do-sub 'subscribe)                    ((eq do-sub 'subscribe)
1095                     (setq groups (1+ groups))                     (setq groups (1+ groups))
1096                     (gnus-sethash group group gnus-killed-hashtb)                     (gnus-sethash group group gnus-killed-hashtb)
1097                     (funcall gnus-subscribe-options-newsgroup-method group))                     (gnus-call-subscribe-functions
1098                        gnus-subscribe-options-newsgroup-method group))
1099                    ((eq do-sub 'ignore)                    ((eq do-sub 'ignore)
1100                     nil)                     nil)
1101                    (t                    (t
# Line 1000  for new groups, and subscribe the new gr Line 1103  for new groups, and subscribe the new gr
1103                     (gnus-sethash group group gnus-killed-hashtb)                     (gnus-sethash group group gnus-killed-hashtb)
1104                     (if gnus-subscribe-hierarchical-interactive                     (if gnus-subscribe-hierarchical-interactive
1105                         (push group new-newsgroups)                         (push group new-newsgroups)
1106                       (funcall gnus-subscribe-newsgroup-method group)))))))                       (gnus-call-subscribe-functions
1107                          gnus-subscribe-newsgroup-method group)))))))
1108             gnus-active-hashtb)             gnus-active-hashtb)
1109            (when new-newsgroups            (when new-newsgroups
1110              (gnus-subscribe-hierarchical-interactive new-newsgroups))              (gnus-subscribe-hierarchical-interactive new-newsgroups))
# Line 1085  for new groups, and subscribe the new gr Line 1189  for new groups, and subscribe the new gr
1189                  ((eq do-sub 'subscribe)                  ((eq do-sub 'subscribe)
1190                   (incf groups)                   (incf groups)
1191                   (gnus-sethash group group gnus-killed-hashtb)                   (gnus-sethash group group gnus-killed-hashtb)
1192                   (funcall gnus-subscribe-options-newsgroup-method group))                   (gnus-call-subscribe-functions
1193                      gnus-subscribe-options-newsgroup-method group))
1194                  ((eq do-sub 'ignore)                  ((eq do-sub 'ignore)
1195                   nil)                   nil)
1196                  (t                  (t
# Line 1093  for new groups, and subscribe the new gr Line 1198  for new groups, and subscribe the new gr
1198                   (gnus-sethash group group gnus-killed-hashtb)                   (gnus-sethash group group gnus-killed-hashtb)
1199                   (if gnus-subscribe-hierarchical-interactive                   (if gnus-subscribe-hierarchical-interactive
1200                       (push group new-newsgroups)                       (push group new-newsgroups)
1201                     (funcall gnus-subscribe-newsgroup-method group)))))))                     (gnus-call-subscribe-functions
1202                        gnus-subscribe-newsgroup-method group)))))))
1203           hashtb))           hashtb))
1204        (when new-newsgroups        (when new-newsgroups
1205          (gnus-subscribe-hierarchical-interactive new-newsgroups)))          (gnus-subscribe-hierarchical-interactive new-newsgroups)))
# Line 1109  for new groups, and subscribe the new gr Line 1215  for new groups, and subscribe the new gr
1215    (catch 'ended    (catch 'ended
1216      ;; First check if any of the following files exist.  If they do,      ;; First check if any of the following files exist.  If they do,
1217      ;; it's not the first time the user has used Gnus.      ;; it's not the first time the user has used Gnus.
1218      (dolist (file (list gnus-current-startup-file      (dolist (file (list (concat gnus-current-startup-file ".el")
                         (concat gnus-current-startup-file ".el")  
1219                          (concat gnus-current-startup-file ".eld")                          (concat gnus-current-startup-file ".eld")
                         gnus-startup-file  
1220                          (concat gnus-startup-file ".el")                          (concat gnus-startup-file ".el")
1221                          (concat gnus-startup-file ".eld")))                          (concat gnus-startup-file ".eld")))
1222        (when (file-exists-p file)        (when (file-exists-p file)
# Line 1126  for new groups, and subscribe the new gr Line 1230  for new groups, and subscribe the new gr
1230      (let ((groups (or gnus-default-subscribed-newsgroups      (let ((groups (or gnus-default-subscribed-newsgroups
1231                        gnus-backup-default-subscribed-newsgroups))                        gnus-backup-default-subscribed-newsgroups))
1232            group)            group)
1233        (when (eq groups t)        (if (eq groups t)
1234          ;; 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.
1235          (mapatoms            (mapatoms
1236           (lambda (sym)             (lambda (sym)
1237             (when (setq group (symbol-name sym))               (when (setq group (symbol-name sym))
1238               (let ((do-sub (gnus-matches-options-n group)))                 (let ((do-sub (gnus-matches-options-n group)))
1239                 (cond                   (cond
1240                  ((eq do-sub 'subscribe)                    ((eq do-sub 'subscribe)
1241                   (gnus-sethash group group gnus-killed-hashtb)                     (gnus-sethash group group gnus-killed-hashtb)
1242                   (funcall gnus-subscribe-options-newsgroup-method group))                     (gnus-call-subscribe-functions
1243                  ((eq do-sub 'ignore)                      gnus-subscribe-options-newsgroup-method group))
1244                   nil)                    ((eq do-sub 'ignore)
1245                  (t                     nil)
1246                   (push group gnus-killed-list))))))                    (t
1247           gnus-active-hashtb)                     (push group gnus-killed-list))))))
1248               gnus-active-hashtb)
1249          (dolist (group groups)          (dolist (group groups)
1250            ;; Only subscribe the default groups that are activated.            ;; Only subscribe the default groups that are activated.
1251            (when (gnus-active group)            (when (gnus-active group)
# Line 1148  for new groups, and subscribe the new gr Line 1253  for new groups, and subscribe the new gr
1253               group gnus-level-default-subscribed gnus-level-killed)))               group gnus-level-default-subscribed gnus-level-killed)))
1254          (save-excursion          (save-excursion
1255            (set-buffer gnus-group-buffer)            (set-buffer gnus-group-buffer)
1256            (gnus-group-make-help-group))            ;; Don't error if the group already exists. This happens when a
1257              ;; first-time user types 'F'. -- didier
1258              (gnus-group-make-help-group t))
1259          (when gnus-novice-user          (when gnus-novice-user
1260            (gnus-message 7 "`A k' to list killed groups"))))))            (gnus-message 7 "`A k' to list killed groups"))))))
1261    
1262  (defun gnus-subscribe-group (group &optional previous method)  (defun gnus-subscribe-group (group &optional previous method)
1263    "Subcribe GROUP and put it after PREVIOUS."    "Subscribe GROUP and put it after PREVIOUS."
1264    (gnus-group-change-level    (gnus-group-change-level
1265     (if method     (if method
1266         (list t group gnus-level-default-subscribed nil nil method)         (list t group gnus-level-default-subscribed nil nil method)
# Line 1213  for new groups, and subscribe the new gr Line 1320  for new groups, and subscribe the new gr
1320        ;; it from the newsrc hash table and assoc.        ;; it from the newsrc hash table and assoc.
1321        (cond        (cond
1322         ((>= oldlevel gnus-level-zombie)         ((>= oldlevel gnus-level-zombie)
1323          (if (= oldlevel gnus-level-zombie)          ;; oldlevel could be wrong.
1324              (setq gnus-zombie-list (delete group gnus-zombie-list))          (setq gnus-zombie-list (delete group gnus-zombie-list))
1325            (setq gnus-killed-list (delete group gnus-killed-list))))          (setq gnus-killed-list (delete group gnus-killed-list)))
1326         (t         (t
1327          (when (and (>= level gnus-level-zombie)          (when (and (>= level gnus-level-zombie)
1328                     entry)                     entry)
# Line 1238  for new groups, and subscribe the new gr Line 1345  for new groups, and subscribe the new gr
1345          (unless (gnus-group-foreign-p group)          (unless (gnus-group-foreign-p group)
1346            (if (= level gnus-level-zombie)            (if (= level gnus-level-zombie)
1347                (push group gnus-zombie-list)                (push group gnus-zombie-list)
1348              (push group gnus-killed-list))))              (if (= oldlevel gnus-level-killed)
1349                    ;; Remove from active hashtb.
1350                    (unintern group gnus-active-hashtb)
1351                  ;; Don't add it into killed-list if it was killed.
1352                  (push group gnus-killed-list)))))
1353         (t         (t
1354          ;; If the list is to be entered into the newsrc assoc, and          ;; If the list is to be entered into the newsrc assoc, and
1355          ;; 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 1306  newsgroup." Line 1417  newsgroup."
1417          (setq info (pop newsrc)          (setq info (pop newsrc)
1418                group (gnus-info-group info))                group (gnus-info-group info))
1419          (unless (or (gnus-active group) ; Active          (unless (or (gnus-active group) ; Active
1420                      (gnus-info-method info)) ; Foreign                      (and (gnus-info-method info)
1421                             (not (gnus-secondary-method-p
1422                                   (gnus-info-method info))))) ; Foreign
1423            ;; Found a bogus newsgroup.            ;; Found a bogus newsgroup.
1424            (push group bogus)))            (push group bogus)))
1425        (if confirm        (if confirm
# Line 1377  newsgroup." Line 1490  newsgroup."
1490                  (gnus-check-backend-function 'request-scan (car method))                  (gnus-check-backend-function 'request-scan (car method))
1491                  (gnus-request-scan group method))                  (gnus-request-scan group method))
1492             t)             t)
1493           (condition-case ()           (if (or debug-on-error debug-on-quit)
1494               (inline (gnus-request-group group dont-check method))               (inline (gnus-request-group group dont-check method))
1495             ;;(error nil)             (condition-case nil
1496             (quit                 (inline (gnus-request-group group dont-check method))
1497              (message "Quit activating %s" group)               ;;(error nil)
1498              nil))               (quit
1499           (setq active (gnus-parse-active))                (message "Quit activating %s" group)
1500           ;; If there are no articles in the group, the GROUP                nil)))
1501           ;; command may have responded with the `(0 . 0)'.  We           (unless dont-check
1502           ;; ignore this if we already have an active entry             (setq active (gnus-parse-active))
1503           ;; for the group.             ;; If there are no articles in the group, the GROUP
1504           (if (and (zerop (car active))             ;; command may have responded with the `(0 . 0)'.  We
1505                    (zerop (cdr active))             ;; ignore this if we already have an active entry
1506                    (gnus-active group))             ;; for the group.
1507               (gnus-active group)             (if (and (zerop (car active))
1508             (gnus-set-active group active)                      (zerop (cdr active))
1509             ;; Return the new active info.                      (gnus-active group))
1510             active))))                 (gnus-active group)
1511    
1512                 (gnus-set-active group active)
1513                 ;; Return the new active info.
1514                 active)))))
1515    
1516  (defun gnus-get-unread-articles-in-group (info active &optional update)  (defun gnus-get-unread-articles-in-group (info active &optional update)
1517    (when active    (when active
# Line 1411  newsgroup." Line 1528  newsgroup."
1528        (when (and gnus-use-cache info)        (when (and gnus-use-cache info)
1529          (inline (gnus-cache-possibly-alter-active          (inline (gnus-cache-possibly-alter-active
1530                   (gnus-info-group info) active)))                   (gnus-info-group info) active)))
1531    
1532          ;; If the agent is enabled, we may have to alter the active info.
1533          (when (and gnus-agent info)
1534            (gnus-agent-possibly-alter-active
1535             (gnus-info-group info) active))
1536    
1537        ;; Modify the list of read articles according to what articles        ;; Modify the list of read articles according to what articles
1538        ;; are available; then tally the unread articles and add the        ;; are available; then tally the unread articles and add the
1539        ;; number to the group hash table entry.        ;; number to the group hash table entry.
# Line 1477  newsgroup." Line 1600  newsgroup."
1600            (setq range (cdr range)))            (setq range (cdr range)))
1601          (setq num (max 0 (- (cdr active) num)))))          (setq num (max 0 (- (cdr active) num)))))
1602        ;; Set the number of unread articles.        ;; Set the number of unread articles.
1603        (when info        (when (and info
1604                     (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb))
1605          (setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num))          (setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num))
1606        num)))        num)))
1607    
1608  ;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb'  ;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb'
1609  ;; and compute how many unread articles there are in each group.  ;; and compute how many unread articles there are in each group.
1610  (defun gnus-get-unread-articles (&optional level)  (defun gnus-get-unread-articles (&optional level)
1611      (setq gnus-server-method-cache nil)
1612    (let* ((newsrc (cdr gnus-newsrc-alist))    (let* ((newsrc (cdr gnus-newsrc-alist))
1613           (level (or level gnus-activate-level (1+ gnus-level-subscribed)))           (level (or level gnus-activate-level (1+ gnus-level-subscribed)))
1614           (foreign-level           (foreign-level
# Line 1495  newsgroup." Line 1620  newsgroup."
1620                    gnus-activate-foreign-newsgroups)                    gnus-activate-foreign-newsgroups)
1621                   (t 0))                   (t 0))
1622             level))             level))
1623           scanned-methods info group active method retrievegroups)           (methods-cache nil)
1624      (gnus-message 5 "Checking new news...")           (type-cache nil)
1625             scanned-methods info group active method retrieve-groups cmethod
1626             method-type)
1627        (gnus-message 6 "Checking new news...")
1628    
1629      (while newsrc      (while newsrc
1630        (setq active (gnus-active (setq group (gnus-info-group        (setq active (gnus-active (setq group (gnus-info-group
# Line 1514  newsgroup." Line 1642  newsgroup."
1642        ;; 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
1643        ;; 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
1644        ;;   be checked, for one reason or other.        ;;   be checked, for one reason or other.
1645        (if (and (setq method (gnus-info-method info))        (when (setq method (gnus-info-method info))
1646                 (not (inline          (if (setq cmethod (assoc method methods-cache))
1647                        (gnus-server-equal              (setq method (cdr cmethod))
1648                         gnus-select-method            (setq cmethod (inline (gnus-server-get-method nil method)))
1649                         (setq method (gnus-server-get-method nil method)))))            (push (cons method cmethod) methods-cache)
1650                 (not (gnus-secondary-method-p method)))            (setq method cmethod)))
1651          (when (and method
1652                     (not (setq method-type (cdr (assoc method type-cache)))))
1653            (setq method-type
1654                  (cond
1655                   ((gnus-secondary-method-p method)
1656                    'secondary)
1657                   ((inline (gnus-server-equal gnus-select-method method))
1658                    'primary)
1659                   (t
1660                    'foreign)))
1661            (push (cons method method-type) type-cache))
1662          (if (and method
1663                   (eq method-type 'foreign))
1664            ;; These groups are foreign.  Check the level.            ;; These groups are foreign.  Check the level.
1665            (when (and (<= (gnus-info-level info) foreign-level)            (when (and (<= (gnus-info-level info) foreign-level)
1666                       (setq active (gnus-activate-group group 'scan)))                       (setq active (gnus-activate-group group 'scan)))
1667              ;; Let the Gnus agent save the active file.              ;; Let the Gnus agent save the active file.
1668              (when (and gnus-agent gnus-plugged active)              (when (and gnus-agent active (gnus-online method))
1669                (gnus-agent-save-group-info                (gnus-agent-save-group-info
1670                 method (gnus-group-real-name group) active))                 method (gnus-group-real-name group) active))
1671              (unless (inline (gnus-virtual-group-p group))              (unless (inline (gnus-virtual-group-p group))
# Line 1542  newsgroup." Line 1683  newsgroup."
1683            (if (gnus-check-backend-function 'retrieve-groups group)            (if (gnus-check-backend-function 'retrieve-groups group)
1684                ;; if server support gnus-retrieve-groups we push                ;; if server support gnus-retrieve-groups we push
1685                ;; the group onto retrievegroups for later checking                ;; the group onto retrievegroups for later checking
1686                (if (assoc method retrievegroups)                (if (assoc method retrieve-groups)
1687                    (setcdr (assoc method retrievegroups)                    (setcdr (assoc method retrieve-groups)
1688                            (cons group (cdr (assoc method retrievegroups))))                            (cons group (cdr (assoc method retrieve-groups))))
1689                  (push (list method group) retrievegroups))                  (push (list method group) retrieve-groups))
1690              ;; hack: `nnmail-get-new-mail' changes the mail-source depending              ;; hack: `nnmail-get-new-mail' changes the mail-source depending
1691              ;; on the group, so we must perform a scan for every group              ;; on the group, so we must perform a scan for every group
1692              ;; if the users has any directory mail sources.              ;; if the users has any directory mail sources.
# Line 1563  newsgroup." Line 1704  newsgroup."
1704                  (setq active (gnus-activate-group group))                  (setq active (gnus-activate-group group))
1705                (setq active (gnus-activate-group group 'scan))                (setq active (gnus-activate-group group 'scan))
1706                (push method scanned-methods))                (push method scanned-methods))
1707              (when active              (when active
1708                (gnus-close-group group))))))                (gnus-close-group group))))))
1709    
1710        ;; Get the number of unread articles in the group.        ;; Get the number of unread articles in the group.
1711        (cond        (cond
# Line 1578  newsgroup." Line 1719  newsgroup."
1719          ;; unread articles and stuff.          ;; unread articles and stuff.
1720          (gnus-set-active group nil)          (gnus-set-active group nil)
1721          (let ((tmp (gnus-gethash group gnus-newsrc-hashtb)))          (let ((tmp (gnus-gethash group gnus-newsrc-hashtb)))
1722            (if tmp (setcar tmp t))))))            (when tmp
1723                (setcar tmp t))))))
1724    
1725      ;; iterate through groups on methods which support gnus-retrieve-groups      ;; iterate through groups on methods which support gnus-retrieve-groups
1726      ;; 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.
1727      (while retrievegroups      (dolist (rg retrieve-groups)
1728        (let* ((mg (pop retrievegroups))        (let ((method (or (car rg) gnus-select-method))
1729               (method (or (car mg) gnus-select-method))              (groups (cdr rg)))
              (groups (cdr mg)))  
1730          (when (gnus-check-server method)          (when (gnus-check-server method)
1731            ;; Request that the backend scan its incoming messages.            ;; Request that the backend scan its incoming messages.
1732            (when (gnus-check-backend-function 'request-scan (car method))            (when (gnus-check-backend-function 'request-scan (car method))
1733              (gnus-request-scan nil method))              (gnus-request-scan nil method))
1734            (gnus-read-active-file-2 (mapcar (lambda (group)            (gnus-read-active-file-2
1735                                               (gnus-group-real-name group))             (mapcar (lambda (group) (gnus-group-real-name group)) groups)
1736                                             groups) method)             method)
1737            (dolist (group groups)            (dolist (group groups)
1738              (cond              (cond
1739               ((setq active (gnus-active (gnus-info-group               ((setq active (gnus-active (gnus-info-group
1740                                           (setq info (gnus-get-info group)))))                                           (setq info (gnus-get-info group)))))
1741                (inline (gnus-get-unread-articles-in-group info active t)))                (inline (gnus-get-unread-articles-in-group info active t)))
1742               (t               (t
1743                ;; 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
1744                ;; unread articles and stuff.                ;; unread articles and stuff.
1745                (gnus-set-active group nil)                (gnus-set-active group nil)
1746                (setcar (gnus-gethash group gnus-newsrc-hashtb) t)))))))                (setcar (gnus-gethash group gnus-newsrc-hashtb) t)))))))
1747    
1748      (gnus-message 5 "Checking new news...done")))      (gnus-message 6 "Checking new news...done")))
1749    
1750  ;; 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
1751  ;; alist elements are used as keys.  ;; alist elements are used as keys.
# Line 1664  newsgroup." Line 1805  newsgroup."
1805               (setq article (pop articles)) ranges)               (setq article (pop articles)) ranges)
1806          (push article news)))          (push article news)))
1807      (when news      (when news
1808          ;; Enter this list into the group info.
1809        (gnus-info-set-read        (gnus-info-set-read
1810         info (gnus-remove-from-range (gnus-info-read info) (nreverse news)))         info (gnus-remove-from-range (gnus-info-read info) (nreverse news)))
1811    
1812          ;; Set the number of unread articles in gnus-newsrc-hashtb.
1813          (gnus-get-unread-articles-in-group info (gnus-active group))
1814    
1815          ;; Insert the change into the group buffer and the dribble file.
1816          (gnus-group-update-group group t))))
1817    
1818    (defun gnus-make-ascending-articles-unread (group articles)
1819      "Mark ascending ARTICLES in GROUP as unread."
1820      (let* ((entry (or (gnus-gethash group gnus-newsrc-hashtb)
1821                        (gnus-gethash (gnus-group-real-name group)
1822                                      gnus-newsrc-hashtb)))
1823             (info (nth 2 entry))
1824             (ranges (gnus-info-read info))
1825             (r ranges)
1826             modified)
1827    
1828        (while articles
1829          (let ((article (pop articles))) ; get the next article to remove from ranges
1830            (while (let ((range (car ranges))) ; note the current range
1831                     (if (atom range)       ; single value range
1832                         (cond ((not range)
1833                                ;; the articles extend past the end of the ranges
1834                                ;; OK - I'm done
1835                                (setq articles nil))
1836                               ((< range article)
1837                                ;; this range preceeds the article. Leave the range unmodified.
1838                                (pop ranges)
1839                                ranges)
1840                               ((= range article)
1841                                ;; this range exactly matches the article; REMOVE THE RANGE.
1842                                ;; NOTE: When the range being removed is the last range, the list is corrupted by inserting null at its end.
1843                                (setcar ranges (cadr ranges))
1844                                (setcdr ranges (cddr ranges))
1845                                (setq modified (if (car ranges) t 'remove-null))
1846                                nil))
1847                       (let ((min (car range))
1848                             (max (cdr range)))
1849                         ;; I have a min/max range to consider
1850                         (cond ((> min max) ; invalid range introduced by splitter
1851                                (setcar ranges (cadr ranges))
1852                                (setcdr ranges (cddr ranges))
1853                                (setq modified (if (car ranges) t 'remove-null))
1854                                ranges)
1855                               ((= min max)
1856                                ;; replace min/max range with a single-value range
1857                                (setcar ranges min)
1858                                ranges)
1859                               ((< max article)
1860                                ;; this range preceeds the article. Leave the range unmodified.
1861                                (pop ranges)
1862                                ranges)
1863                               ((< article min)
1864                                ;; this article preceeds the range.  Return null to move to the
1865                                ;; next article
1866                                nil)
1867                               (t
1868                                ;; this article splits the range into two parts
1869                                (setcdr ranges (cons (cons (1+ article) max) (cdr ranges)))
1870                                (setcdr range (1- article))
1871                                (setq modified t)
1872                                ranges))))))))
1873                      
1874        (when modified
1875          (when (eq modified 'remove-null)
1876            (setq r (delq nil r)))
1877          ;; Enter this list into the group info.
1878          (gnus-info-set-read info r)
1879    
1880          ;; Set the number of unread articles in gnus-newsrc-hashtb.
1881          (gnus-get-unread-articles-in-group info (gnus-active group))
1882    
1883          ;; Insert the change into the group buffer and the dribble file.
1884        (gnus-group-update-group group t))))        (gnus-group-update-group group t))))
1885    
1886  ;; Enter all dead groups into the hashtb.  ;; Enter all dead groups into the hashtb.
# Line 1731  newsgroup." Line 1946  newsgroup."
1946          ;; Only do each method once, in case the methods appear more          ;; Only do each method once, in case the methods appear more
1947          ;; than once in this list.          ;; than once in this list.
1948          (unless (member method methods)          (unless (member method methods)
1949            (condition-case ()            (if (or debug-on-error debug-on-quit)
1950                (gnus-read-active-file-1 method force)                (gnus-read-active-file-1 method force)
1951              ;; We catch C-g so that we can continue past servers              (condition-case ()
1952              ;; that do not respond.                  (gnus-read-active-file-1 method force)
1953              (quit                ;; We catch C-g so that we can continue past servers
1954               (message "Quit reading the active file")                ;; that do not respond.
1955               nil)))))))                (quit
1956                   (message "Quit reading the active file")
1957                   nil))))))))
1958    
1959  (defun gnus-read-active-file-1 (method force)  (defun gnus-read-active-file-1 (method force)
1960    (let (where mesg)    (let (where mesg)
# Line 1782  newsgroup." Line 1999  newsgroup."
1999            (gnus-message 5 "%sdone" mesg)))))))            (gnus-message 5 "%sdone" mesg)))))))
2000    
2001  (defun gnus-read-active-file-2 (groups method)  (defun gnus-read-active-file-2 (groups method)
2002    "Read an active file for GROUPS in METHOD using gnus-retrieve-groups."    "Read an active file for GROUPS in METHOD using `gnus-retrieve-groups'."
2003    (when groups    (when groups
2004      (save-excursion      (save-excursion
2005        (set-buffer nntp-server-buffer)        (set-buffer nntp-server-buffer)
# Line 1829  newsgroup." Line 2046  newsgroup."
2046          (insert ?\\)))          (insert ?\\)))
2047    
2048      ;; Let the Gnus agent save the active file.      ;; Let the Gnus agent save the active file.
2049      (when (and gnus-agent real-active gnus-plugged)      (when (and gnus-agent real-active (gnus-online method))
2050        (gnus-agent-save-active method))        (gnus-agent-save-active method))
2051    
2052      ;; 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 1849  newsgroup." Line 2066  newsgroup."
2066      (goto-char (point-min))      (goto-char (point-min))
2067      (let (group max min)      (let (group max min)
2068        (while (not (eobp))        (while (not (eobp))
2069          (condition-case err          (condition-case ()
2070              (progn              (progn
2071                (narrow-to-region (point) (gnus-point-at-eol))                (narrow-to-region (point) (gnus-point-at-eol))
2072                ;; group gets set to a symbol interned in the hash table                ;; group gets set to a symbol interned in the hash table
# Line 1905  newsgroup." Line 2122  newsgroup."
2122      ;; Let the Gnus agent save the active file.      ;; Let the Gnus agent save the active file.
2123      (if (and gnus-agent      (if (and gnus-agent
2124               real-active               real-active
2125               gnus-plugged               (gnus-online method)
2126               (gnus-agent-method-p method))               (gnus-agent-method-p method))
2127          (progn          (progn
2128            (gnus-agent-save-groups method)            (gnus-agent-save-groups method)
# Line 1946  newsgroup." Line 2163  newsgroup."
2163    "Read startup file.    "Read startup file.
2164  If FORCE is non-nil, the .newsrc file is read."  If FORCE is non-nil, the .newsrc file is read."
2165    ;; Reset variables that might be defined in the .newsrc.eld file.    ;; Reset variables that might be defined in the .newsrc.eld file.
2166    (let ((variables gnus-variable-list))    (let ((variables (remove 'gnus-format-specs gnus-variable-list)))
2167      (while variables      (while variables
2168        (set (car variables) nil)        (set (car variables) nil)
2169        (setq variables (cdr variables))))        (setq variables (cdr variables))))
# Line 2009  If FORCE is non-nil, the .newsrc file is Line 2226  If FORCE is non-nil, the .newsrc file is
2226              (nconc (gnus-uncompress-range dormant)              (nconc (gnus-uncompress-range dormant)
2227                     (gnus-uncompress-range ticked)))))))))                     (gnus-uncompress-range ticked)))))))))
2228    
2229    (defun gnus-load (file)
2230      "Load FILE, but in such a way that read errors can be reported."
2231      (with-temp-buffer
2232        (insert-file-contents file)
2233        (while (not (eobp))
2234          (condition-case type
2235              (let ((form (read (current-buffer))))
2236                (eval form))
2237            (error
2238             (unless (eq (car type) 'end-of-file)
2239               (let ((error (format "Error in %s line %d" file
2240                                    (count-lines (point-min) (point)))))
2241                 (ding)
2242                 (unless (gnus-yes-or-no-p (concat error "; continue? "))
2243                   (error "%s" error)))))))))
2244    
2245  (defun gnus-read-newsrc-el-file (file)  (defun gnus-read-newsrc-el-file (file)
2246    (let ((ding-file (concat file "d")))    (let ((ding-file (concat file "d")))
2247      ;; We always, always read the .eld file.      (when (file-exists-p ding-file)
2248      (gnus-message 5 "Reading %s..." ding-file)        ;; We always, always read the .eld file.
2249      (let (gnus-newsrc-assoc)        (gnus-message 5 "Reading %s..." ding-file)
2250        (condition-case nil        (let (gnus-newsrc-assoc)
2251            (let ((coding-system-for-read gnus-ding-file-coding-system))          (let ((coding-system-for-read gnus-ding-file-coding-system))
2252              (load ding-file t t t))            (gnus-load ding-file))
2253          (error          ;; Older versions of `gnus-format-specs' are no longer valid
2254           (ding)          ;; in Oort Gnus 0.01.
2255           (unless (gnus-yes-or-no-p          (let ((version
2256                    (format "Error in %s; continue? " ding-file))                 (and gnus-newsrc-file-version
2257             (error "Error in %s" ding-file))))                      (gnus-continuum-version gnus-newsrc-file-version))))
2258        (when gnus-newsrc-assoc            (when (or (not version)
2259          (setq gnus-newsrc-alist gnus-newsrc-assoc)))                      (< version 5.090009))
2260                (setq gnus-format-specs gnus-default-format-specs)))
2261            (when gnus-newsrc-assoc
2262              (setq gnus-newsrc-alist gnus-newsrc-assoc))))
2263      (gnus-make-hashtable-from-newsrc-alist)      (gnus-make-hashtable-from-newsrc-alist)
2264      (when (file-newer-than-file-p file ding-file)      (when (file-newer-than-file-p file ding-file)
2265        ;; Old format quick file        ;; Old format quick file
2266        (gnus-message 5 "Reading %s..." file)        (gnus-message 5 "Reading %s..." file)
2267        ;; 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
2268        ;; as well.        ;; as well.
2269        (gnus-read-old-newsrc-el-file file))))        (gnus-read-old-newsrc-el-file file)))
2270      (gnus-run-hooks 'gnus-read-newsrc-el-hook))
2271    
2272  ;; Parse the old-style quick startup file  ;; Parse the old-style quick startup file
2273  (defun gnus-read-old-newsrc-el-file (file)  (defun gnus-read-old-newsrc-el-file (file)
# Line 2156  If FORCE is non-nil, the .newsrc file is Line 2393  If FORCE is non-nil, the .newsrc file is
2393                reads nil)                reads nil)
2394          (if (eolp)          (if (eolp)
2395              ;; If the line ends here, this is clearly a buggy line, so              ;; If the line ends here, this is clearly a buggy line, so
2396              ;; we put point at the beginning of line and let the cond              ;; we put point a the beginning of line and let the cond
2397              ;; below do the error handling.              ;; below do the error handling.
2398              (beginning-of-line)              (beginning-of-line)
2399            ;; We skip to the beginning of the ranges.            ;; We skip to the beginning of the ranges.
# Line 2342  If FORCE is non-nil, the .newsrc file is Line 2579  If FORCE is non-nil, the .newsrc file is
2579    
2580        (setq gnus-newsrc-options-n out))))        (setq gnus-newsrc-options-n out))))
2581    
2582    (eval-and-compile
2583      (defalias 'gnus-long-file-names
2584        (if (fboundp 'msdos-long-file-names)
2585          'msdos-long-file-names
2586          (lambda () t))))
2587    
2588  (defun gnus-save-newsrc-file (&optional force)  (defun gnus-save-newsrc-file (&optional force)
2589    "Save .newsrc file."    "Save .newsrc file."
2590    ;; Note: We cannot save .newsrc file if all newsgroups are removed    ;; Note: We cannot save .newsrc file if all newsgroups are removed
# Line 2368  If FORCE is non-nil, the .newsrc file is Line 2611  If FORCE is non-nil, the .newsrc file is
2611            ;; Save .newsrc.eld.            ;; Save .newsrc.eld.
2612            (set-buffer (gnus-get-buffer-create " *Gnus-newsrc*"))            (set-buffer (gnus-get-buffer-create " *Gnus-newsrc*"))
2613            (make-local-variable 'version-control)            (make-local-variable 'version-control)
2614            (setq version-control 'never)            (setq version-control gnus-backup-startup-file)
2615            (setq buffer-file-name            (setq buffer-file-name
2616                  (concat gnus-current-startup-file ".eld"))                  (concat gnus-current-startup-file ".eld"))
2617            (setq default-directory (file-name-directory buffer-file-name))            (setq default-directory (file-name-directory buffer-file-name))
2618            (buffer-disable-undo)            (buffer-disable-undo)
2619            (erase-buffer)            (erase-buffer)
2620            (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file)            (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file)
2621            (gnus-gnus-to-quick-newsrc-format)  
2622            (gnus-run-hooks 'gnus-save-quick-newsrc-hook)            (if gnus-save-startup-file-via-temp-buffer
2623            (let ((coding-system-for-write gnus-ding-file-coding-system))                (let ((coding-system-for-write gnus-ding-file-coding-system)
2624              (save-buffer))                      (standard-output (current-buffer)))
2625            (kill-buffer (current-buffer))                  (gnus-gnus-to-quick-newsrc-format)
2626                    (gnus-run-hooks 'gnus-save-quick-newsrc-hook)
2627                    (save-buffer))
2628                (let ((coding-system-for-write gnus-ding-file-coding-system)
2629                      (version-control gnus-backup-startup-file)
2630                      (startup-file (concat gnus-current-startup-file ".eld"))
2631                      (working-dir (file-name-directory gnus-current-startup-file))
2632                      working-file
2633                      (i -1))
2634                  ;; Generate the name of a non-existent file.
2635                  (while (progn (setq working-file
2636                                      (format
2637                                       (if (and (eq system-type 'ms-dos)
2638                                                (not (gnus-long-file-names)))
2639                                           "%s#%d.tm#" ; MSDOS limits files to 8+3
2640                                         (if (memq system-type '(vax-vms axp-vms))
2641                                             "%s$tmp$%d"
2642                                           "%s#tmp#%d"))
2643                                       working-dir (setq i (1+ i))))
2644                                (file-exists-p working-file)))
2645    
2646                  (unwind-protect
2647                      (progn
2648                        (gnus-with-output-to-file working-file
2649                          (gnus-gnus-to-quick-newsrc-format)
2650                          (gnus-run-hooks 'gnus-save-quick-newsrc-hook))
2651    
2652                        ;; These bindings will mislead the current buffer
2653                        ;; into thinking that it is visiting the startup
2654                        ;; file.
2655                        (let ((buffer-backed-up nil)
2656                              (buffer-file-name startup-file)
2657                              (file-precious-flag t)
2658                              (setmodes (file-modes startup-file)))
2659                          ;; Backup the current version of the startup file.
2660                          (backup-buffer)
2661    
2662                          ;; Replace the existing startup file with the temp file.
2663                          (rename-file working-file startup-file t)
2664                          (set-file-modes startup-file setmodes)))
2665                    (condition-case nil
2666                        (delete-file working-file)
2667                      (file-error nil)))))
2668    
2669              (gnus-kill-buffer (current-buffer))
2670            (gnus-message            (gnus-message
2671             5 "Saving %s.eld...done" gnus-current-startup-file))             5 "Saving %s.eld...done" gnus-current-startup-file))
2672          (gnus-dribble-delete-file)          (gnus-dribble-delete-file)
2673          (gnus-group-set-mode-line)))))          (gnus-group-set-mode-line)))))
2674    
2675  (defun gnus-gnus-to-quick-newsrc-format ()  (defun gnus-gnus-to-quick-newsrc-format (&optional minimal name &rest specific-variables)
2676    "Insert Gnus variables such as gnus-newsrc-alist in lisp format."    "Print Gnus variables such as `gnus-newsrc-alist' in Lisp format."
2677    (let ((print-quoted t)      (princ ";; -*- emacs-lisp -*-\n")
2678          (print-escape-newlines t))      (if name
2679            (princ (format ";; %s\n" name))
2680      (insert ";; -*- emacs-lisp -*-\n")        (princ ";; Gnus startup file.\n"))
2681      (insert ";; Gnus startup file.\n")  
2682      (insert "\      (unless minimal
2683          (princ "\
2684  ;; 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
2685  ;; .newsrc file (if you have one), touch .newsrc instead.\n")  ;; .newsrc file (if you have one), touch .newsrc instead.\n")
2686      (insert "(setq gnus-newsrc-file-version "        (princ "(setq gnus-newsrc-file-version ")
2687              (prin1-to-string gnus-version) ")\n")        (princ (gnus-prin1-to-string gnus-version))
2688      (let* ((gnus-killed-list        (princ ")\n"))
2689    
2690        (let* ((print-quoted t)
2691               (print-readably t)
2692               (print-escape-multibyte nil)
2693               (print-escape-nonascii t)
2694               (print-length nil)
2695               (print-level nil)
2696               (print-escape-newlines t)
2697               (gnus-killed-list
2698              (if (and gnus-save-killed-list              (if (and gnus-save-killed-list
2699                       (stringp gnus-save-killed-list))                       (stringp gnus-save-killed-list))
2700                  (gnus-strip-killed-list)                  (gnus-strip-killed-list)
2701                gnus-killed-list))                gnus-killed-list))
2702             (variables             (variables
2703              (if gnus-save-killed-list gnus-variable-list              (or specific-variables
2704                ;; Remove the `gnus-killed-list' from the list of variables                  (if gnus-save-killed-list gnus-variable-list
2705                ;; to be saved, if required.                    ;; Remove the `gnus-killed-list' from the list of variables
2706                (delq 'gnus-killed-list (copy-sequence gnus-variable-list))))                    ;; to be saved, if required.
2707                      (delq 'gnus-killed-list (copy-sequence gnus-variable-list)))))
2708             ;; Peel off the "dummy" group.             ;; Peel off the "dummy" group.
2709             (gnus-newsrc-alist (cdr gnus-newsrc-alist))             (gnus-newsrc-alist (cdr gnus-newsrc-alist))
2710             variable)             variable)
# Line 2414  If FORCE is non-nil, the .newsrc file is Line 2712  If FORCE is non-nil, the .newsrc file is
2712        (while variables        (while variables
2713          (when (and (boundp (setq variable (pop variables)))          (when (and (boundp (setq variable (pop variables)))
2714                     (symbol-value variable))                     (symbol-value variable))
2715            (insert "(setq " (symbol-name variable) " '")            (princ "(setq ")
2716            (gnus-prin1 (symbol-value variable))            (princ (symbol-name variable))
2717            (insert ")\n"))))))            (princ " '")
2718              (prin1 (symbol-value variable))
2719              (princ ")\n")))))
2720    
2721  (defun gnus-strip-killed-list ()  (defun gnus-strip-killed-list ()
2722    "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 2624  If FORCE is non-nil, the .newsrc file is Line 2924  If FORCE is non-nil, the .newsrc file is
2924              (skip-chars-forward " \t")              (skip-chars-forward " \t")
2925              ;; ...  which leads to this line being effectively ignored.              ;; ...  which leads to this line being effectively ignored.
2926              (when (symbolp group)              (when (symbolp group)
2927                (let ((str (buffer-substring                (let* ((str (buffer-substring
2928                            (point) (progn (end-of-line) (point))))                             (point) (progn (end-of-line) (point))))
2929                      (coding                       (name (symbol-name group))
2930                       (and (or (featurep 'xemacs)                       (charset
2931                                (and (boundp 'enable-multibyte-characters)                        (or (gnus-group-name-charset method name)
2932                                     enable-multibyte-characters))                            (gnus-parameter-charset name)
2933                            (fboundp 'gnus-mule-get-coding-system)                            gnus-default-charset)))
2934                            (gnus-mule-get-coding-system (symbol-name group)))))                  ;; Fixme: Don't decode in unibyte mode.
2935                  (when coding                  (when (and str charset (featurep 'mule))
2936                    (setq str (mm-decode-coding-string str (car coding))))                    (setq str (mm-decode-coding-string str charset)))
2937                  (set group str)))                  (set group str)))
2938              (forward-line 1))))              (forward-line 1))))
2939        (gnus-message 5 "Reading descriptions file...done")        (gnus-message 5 "Reading descriptions file...done")
# Line 2650  If FORCE is non-nil, the .newsrc file is Line 2950  If FORCE is non-nil, the .newsrc file is
2950    
2951  ;;;###autoload  ;;;###autoload
2952  (defun gnus-declare-backend (name &rest abilities)  (defun gnus-declare-backend (name &rest abilities)
2953    "Declare backend NAME with ABILITIES as a Gnus backend."    "Declare back end NAME with ABILITIES as a Gnus back end."
2954    (setq gnus-valid-select-methods    (setq gnus-valid-select-methods
2955          (nconc gnus-valid-select-methods          (nconc gnus-valid-select-methods
2956                 (list (apply 'list name abilities))))                 (list (apply 'list name abilities))))
# Line 2665  If this variable is nil, don't do anythi Line 2965  If this variable is nil, don't do anythi
2965              (file-name-as-directory (expand-file-name gnus-default-directory))              (file-name-as-directory (expand-file-name gnus-default-directory))
2966            default-directory)))            default-directory)))
2967    
2968    (eval-and-compile
2969    (defalias 'gnus-display-time-event-handler
2970      (if (gnus-boundp 'display-time-timer)
2971          'display-time-event-handler
2972        (lambda () "Does nothing as `display-time-timer' is not bound.
2973    Would otherwise be an alias for `display-time-event-handler'." nil))))
2974    
2975    ;;;###autoload
2976    (defun gnus-fixup-nnimap-unread-after-getting-new-news ()
2977      (let (server group info)
2978        (mapatoms
2979         (lambda (sym)
2980           (when (and (setq group (symbol-name sym))
2981                      (gnus-group-entry group)
2982                      (setq info (symbol-value sym)))
2983             (gnus-sethash group (cons (nth 2 info) (cdr (gnus-group-entry group)))
2984                           gnus-newsrc-hashtb)))
2985         (if (boundp 'nnimap-mailbox-info)
2986             (symbol-value 'nnimap-mailbox-info)
2987           (make-vector 1 0)))))
2988    
2989    
2990  (provide 'gnus-start)  (provide 'gnus-start)
2991    
2992  ;;; arch-tag: f4584a22-b7b7-4853-abfc-a637329af5d2  ;;; arch-tag: f4584a22-b7b7-4853-abfc-a637329af5d2
2993  ;;; gnus-start.el ends here  ;;; gnus-start.el ends here
2994    
2995    

Legend:
Removed from v.1.20.2.2  
changed lines
  Added in v.1.20.2.3

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