Importing Oort Gnus v0.01.
[elisp/gnus.git-] / lisp / gnus-start.el
index ea81a60..e10d588 100644 (file)
@@ -1,5 +1,5 @@
 ;;; gnus-start.el --- startup functions for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001
 ;;        Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -197,6 +197,7 @@ Gnus always reads its own startup file, which is called
 be readily understood by other newsreaders.  If you don't plan on
 using other newsreaders, set this variable to nil to save some time on
 entry."
+  :version "21.1"
   :group 'gnus-newsrc
   :type 'boolean)
 
@@ -240,7 +241,7 @@ thus making them effectively non-existent."
   :type 'regexp)
 
 (defcustom gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies
-  "*Function called with a group name when new group is detected.
+  "*Function(s) called with a group name when new group is detected.
 A few pre-made functions are supplied: `gnus-subscribe-randomly'
 inserts new groups at the beginning of the list of groups;
 `gnus-subscribe-alphabetically' inserts new groups in strict
@@ -258,11 +259,18 @@ claim them."
                (function-item gnus-subscribe-killed)
                (function-item gnus-subscribe-zombies)
                (function-item gnus-subscribe-topics)
-               function))
+               function
+               (repeat function)))
+
+(defcustom gnus-subscribe-newsgroup-hooks nil
+  "*Hooks run after you subscribe to a new group. The hooks will be called
+with new group's name as argument."
+  :group 'gnus-group-new
+  :type 'hook)
 
 (defcustom gnus-subscribe-options-newsgroup-method
   'gnus-subscribe-alphabetically
-  "*This function is called to subscribe newsgroups mentioned on \"options -n\" lines.
+  "*Function(s) called to subscribe newsgroups mentioned on \"options -n\" lines.
 If, for instance, you want to subscribe to all newsgroups in the
 \"no\" and \"alt\" hierarchies, you'd put the following in your
 .newsrc file:
@@ -278,7 +286,9 @@ the subscription method in this variable."
                (function-item gnus-subscribe-interactively)
                (function-item gnus-subscribe-killed)
                (function-item gnus-subscribe-zombies)
-               function))
+               (function-item gnus-subscribe-topics)
+               function
+               (repeat function)))
 
 (defcustom gnus-subscribe-hierarchical-interactive nil
   "*If non-nil, Gnus will offer to subscribe hierarchically.
@@ -364,8 +374,7 @@ This hook is called as the first thing when Gnus is started."
   :type 'hook)
 
 (defcustom gnus-after-getting-new-news-hook
-  (when (gnus-boundp 'display-time-timer)
-    '(display-time-event-handler))
+  '(gnus-display-time-event-handler)
   "*A hook run after Gnus checks for new news when Gnus is already running."
   :group 'gnus-group-new
   :type 'hook)
@@ -527,22 +536,22 @@ Can be used to turn version control on or off."
   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
   (save-excursion
     (set-buffer (nnheader-find-file-noselect gnus-current-startup-file))
-    (let ((groupkey newgroup)
-         before)
-      (while (and (not before) groupkey)
-       (goto-char (point-min))
-       (let ((groupkey-re
-              (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
-         (while (and (re-search-forward groupkey-re nil t)
-                     (progn
-                       (setq before (match-string 1))
-                       (string< before newgroup)))))
-       ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
-       (setq groupkey
-             (when (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
-               (substring groupkey (match-beginning 1) (match-end 1)))))
-      (gnus-subscribe-newsgroup newgroup before))
-    (kill-buffer (current-buffer))))
+    (prog1
+       (let ((groupkey newgroup) before)
+         (while (and (not before) groupkey)
+           (goto-char (point-min))
+           (let ((groupkey-re
+                  (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
+             (while (and (re-search-forward groupkey-re nil t)
+                         (progn
+                           (setq before (match-string 1))
+                           (string< before newgroup)))))
+           ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
+           (setq groupkey
+                 (when (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
+                   (substring groupkey (match-beginning 1) (match-end 1)))))
+         (gnus-subscribe-newsgroup newgroup before))
+      (kill-buffer (current-buffer)))))
 
 (defun gnus-subscribe-interactively (group)
   "Subscribe the new GROUP interactively.
@@ -571,7 +580,9 @@ the first newsgroup."
      newsgroup gnus-level-default-subscribed
      gnus-level-killed (gnus-gethash (or next "dummy.group")
                                     gnus-newsrc-hashtb))
-    (gnus-message 5 "Subscribe newsgroup: %s" newsgroup)))
+    (gnus-message 5 "Subscribe newsgroup: %s" newsgroup)
+    (run-hook-with-args 'gnus-subscribe-newsgroup-hooks newsgroup)
+    t))
 
 (defun gnus-read-active-file-p ()
   "Say whether the active file has been read from `gnus-select-method'."
@@ -591,6 +602,12 @@ the first newsgroup."
 (defvar nnoo-state-alist)
 (defvar gnus-current-select-method)
 
+(defun gnus-close-all-servers ()
+  "Close all servers."
+  (interactive)
+  (dolist (server gnus-opened-servers)
+    (gnus-close-server (car server))))
+
 (defun gnus-clear-system ()
   "Clear all variables and buffers."
   ;; Clear Gnus variables.
@@ -794,6 +811,7 @@ cautiously -- unloading may cause trouble."
       (set-buffer-modified-p nil)
       (let ((auto (make-auto-save-file-name))
            (gnus-dribble-ignore t)
+           (purpose nil)
            modes)
        (when (or (file-exists-p auto) (file-exists-p dribble-file))
          ;; Load whichever file is newest -- the auto save file
@@ -809,10 +827,15 @@ cautiously -- unloading may cause trouble."
                     (file-exists-p dribble-file)
                     (setq modes (file-modes gnus-current-startup-file)))
            (set-file-modes dribble-file modes))
+         (goto-char (point-min))
+         (when (search-forward "Gnus was exited on purpose" nil t)
+           (setq purpose t))
          ;; Possibly eval the file later.
          (when (or gnus-always-read-dribble-file
                    (gnus-y-or-n-p
-                    "Gnus auto-save file exists.  Do you want to read it? "))
+                    (if purpose
+                        "Gnus exited on purpose without saving; read auto-save file anyway? "
+                    "Gnus auto-save file exists.  Do you want to read it? ")))
            (setq gnus-dribble-eval-file t)))))))
 
 (defun gnus-dribble-eval-file ()
@@ -913,6 +936,7 @@ If LEVEL is non-nil, the news will be set up at level LEVEL."
 
     ;; See whether we need to read the description file.
     (when (and (boundp 'gnus-group-line-format)
+              (stringp gnus-group-line-format)
               (let ((case-fold-search nil))
                 (string-match "%[-,0-9]*D" gnus-group-line-format))
               (not gnus-description-hashtb)
@@ -945,6 +969,21 @@ If LEVEL is non-nil, the news will be set up at level LEVEL."
               (gnus-server-opened gnus-select-method))
       (gnus-check-bogus-newsgroups))))
 
+(defun gnus-call-subscribe-functions (method group)
+  "Call METHOD to subscribe GROUP.
+If no function returns `non-nil', call `gnus-subscribe-zombies'."
+  (unless (cond
+          ((gnus-functionp method)
+           (funcall method group))
+          ((listp method)
+           (catch 'found
+             (dolist (func method)
+               (if (funcall func group)
+                   (throw 'found t)))
+             nil))
+          (t nil))
+    (gnus-subscribe-zombies group)))
+
 (defun gnus-find-new-newsgroups (&optional arg)
   "Search for new newsgroups and add them.
 Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method'.
@@ -997,7 +1036,8 @@ for new groups, and subscribe the new groups as zombies."
                  ((eq do-sub 'subscribe)
                   (setq groups (1+ groups))
                   (gnus-sethash group group gnus-killed-hashtb)
-                  (funcall gnus-subscribe-options-newsgroup-method group))
+                  (gnus-call-subscribe-functions
+                   gnus-subscribe-options-newsgroup-method group))
                  ((eq do-sub 'ignore)
                   nil)
                  (t
@@ -1005,7 +1045,8 @@ for new groups, and subscribe the new groups as zombies."
                   (gnus-sethash group group gnus-killed-hashtb)
                   (if gnus-subscribe-hierarchical-interactive
                       (push group new-newsgroups)
-                    (funcall gnus-subscribe-newsgroup-method group)))))))
+                    (gnus-call-subscribe-functions
+                     gnus-subscribe-newsgroup-method group)))))))
           gnus-active-hashtb)
          (when new-newsgroups
            (gnus-subscribe-hierarchical-interactive new-newsgroups))
@@ -1090,7 +1131,8 @@ for new groups, and subscribe the new groups as zombies."
                ((eq do-sub 'subscribe)
                 (incf groups)
                 (gnus-sethash group group gnus-killed-hashtb)
-                (funcall gnus-subscribe-options-newsgroup-method group))
+                (gnus-call-subscribe-functions
+                 gnus-subscribe-options-newsgroup-method group))
                ((eq do-sub 'ignore)
                 nil)
                (t
@@ -1098,7 +1140,8 @@ for new groups, and subscribe the new groups as zombies."
                 (gnus-sethash group group gnus-killed-hashtb)
                 (if gnus-subscribe-hierarchical-interactive
                     (push group new-newsgroups)
-                  (funcall gnus-subscribe-newsgroup-method group)))))))
+                  (gnus-call-subscribe-functions
+                   gnus-subscribe-newsgroup-method group)))))))
         hashtb))
       (when new-newsgroups
        (gnus-subscribe-hierarchical-interactive new-newsgroups)))
@@ -1140,7 +1183,8 @@ for new groups, and subscribe the new groups as zombies."
               (cond
                ((eq do-sub 'subscribe)
                 (gnus-sethash group group gnus-killed-hashtb)
-                (funcall gnus-subscribe-options-newsgroup-method group))
+                (gnus-call-subscribe-functions
+                 gnus-subscribe-options-newsgroup-method group))
                ((eq do-sub 'ignore)
                 nil)
                (t
@@ -1218,9 +1262,9 @@ for new groups, and subscribe the new groups as zombies."
       ;; it from the newsrc hash table and assoc.
       (cond
        ((>= oldlevel gnus-level-zombie)
-       (if (= oldlevel gnus-level-zombie)
-           (setq gnus-zombie-list (delete group gnus-zombie-list))
-         (setq gnus-killed-list (delete group gnus-killed-list))))
+       ;; oldlevel could be wrong.
+       (setq gnus-zombie-list (delete group gnus-zombie-list))
+       (setq gnus-killed-list (delete group gnus-killed-list)))
        (t
        (when (and (>= level gnus-level-zombie)
                   entry)
@@ -1243,7 +1287,11 @@ for new groups, and subscribe the new groups as zombies."
        (unless (gnus-group-foreign-p group)
          (if (= level gnus-level-zombie)
              (push group gnus-zombie-list)
-           (push group gnus-killed-list))))
+           (if (= oldlevel gnus-level-killed)
+               ;; Remove from active hashtb.
+               (unintern group gnus-active-hashtb)
+             ;; Don't add it into killed-list if it was killed.
+             (push group gnus-killed-list)))))
        (t
        ;; If the list is to be entered into the newsrc assoc, and
        ;; it was killed, we have to create an entry in the newsrc
@@ -1500,7 +1548,7 @@ newsgroup."
                  gnus-activate-foreign-newsgroups)
                 (t 0))
           level))
-        scanned-methods info group active method retrievegroups)
+        scanned-methods info group active method retrieve-groups)
     (gnus-message 5 "Checking new news...")
 
     (while newsrc
@@ -1547,10 +1595,10 @@ newsgroup."
          (if (gnus-check-backend-function 'retrieve-groups group)
              ;; if server support gnus-retrieve-groups we push
              ;; the group onto retrievegroups for later checking
-             (if (assoc method retrievegroups)
-                 (setcdr (assoc method retrievegroups)
-                         (cons group (cdr (assoc method retrievegroups))))
-               (push (list method group) retrievegroups))
+             (if (assoc method retrieve-groups)
+                 (setcdr (assoc method retrieve-groups)
+                         (cons group (cdr (assoc method retrieve-groups))))
+               (push (list method group) retrieve-groups))
            ;; hack: `nnmail-get-new-mail' changes the mail-source depending
            ;; on the group, so we must perform a scan for every group
            ;; if the users has any directory mail sources.
@@ -1583,21 +1631,21 @@ newsgroup."
        ;; unread articles and stuff.
        (gnus-set-active group nil)
        (let ((tmp (gnus-gethash group gnus-newsrc-hashtb)))
-         (if tmp (setcar tmp t))))))
+         (when tmp
+           (setcar tmp t))))))
 
     ;; iterate through groups on methods which support gnus-retrieve-groups
     ;; and fetch a partial active file and use it to find new news.
-    (while retrievegroups
-      (let* ((mg (pop retrievegroups))
-            (method (or (car mg) gnus-select-method))
-            (groups (cdr mg)))
+    (dolist (rg retrieve-groups)
+      (let ((method (or (car rg) gnus-select-method))
+           (groups (cdr rg)))
        (when (gnus-check-server method)
           ;; Request that the backend scan its incoming messages.
           (when (gnus-check-backend-function 'request-scan (car method))
             (gnus-request-scan nil method))
-          (gnus-read-active-file-2 (mapcar (lambda (group)
-                                             (gnus-group-real-name group))
-                                           groups) method)
+          (gnus-read-active-file-2
+          (mapcar (lambda (group) (gnus-group-real-name group)) groups)
+          method)
           (dolist (group groups)
             (cond
              ((setq active (gnus-active (gnus-info-group
@@ -2027,6 +2075,12 @@ If FORCE is non-nil, the .newsrc file is read."
         (unless (gnus-yes-or-no-p
                  (format "Error in %s; continue? " ding-file))
           (error "Error in %s" ding-file))))
+      ;; Older versions of `gnus-format-specs' are no longer valid
+      ;; in Oort Gnus 0.01.
+      (let ((version (gnus-continuum-version gnus-newsrc-file-version)))
+       (when (or (not version)
+                 (< version 5.090002))
+         (setq gnus-format-specs nil)))
       (when gnus-newsrc-assoc
        (setq gnus-newsrc-alist gnus-newsrc-assoc)))
     (gnus-make-hashtable-from-newsrc-alist)
@@ -2629,16 +2683,14 @@ If FORCE is non-nil, the .newsrc file is read."
            (skip-chars-forward " \t")
            ;; ...  which leads to this line being effectively ignored.
            (when (symbolp group)
-             (let ((str (buffer-substring
-                         (point) (progn (end-of-line) (point))))
-                   (coding
-                    (and (or (featurep 'xemacs)
-                             (and (boundp 'enable-multibyte-characters)
-                                  enable-multibyte-characters))
-                         (fboundp 'gnus-mule-get-coding-system)
-                         (gnus-mule-get-coding-system (symbol-name group)))))
-               (when coding
-                 (setq str (mm-decode-coding-string str (car coding))))
+             (let* ((str (buffer-substring
+                          (point) (progn (end-of-line) (point))))
+                    (name (symbol-name group))
+                    (charset
+                     (or (gnus-group-name-charset method name)
+                         (gnus-parameter-charset name))))
+               (when (and str charset (featurep 'mule))
+                 (setq str (mm-decode-coding-string str charset)))
                (set group str)))
            (forward-line 1))))
       (gnus-message 5 "Reading descriptions file...done")
@@ -2670,6 +2722,11 @@ If this variable is nil, don't do anything."
            (file-name-as-directory (expand-file-name gnus-default-directory))
          default-directory)))
 
+(defun gnus-display-time-event-handler ()
+  "Like `display-time-event-handler', but test `display-time-timer'."
+  (when (gnus-boundp 'display-time-timer)
+    (display-time-event-handler)))
+
 (provide 'gnus-start)
 
 ;;; gnus-start.el ends here