Importing pgnus-0.79
[elisp/gnus.git-] / lisp / gnus-start.el
index 005d2d0..646c756 100644 (file)
@@ -1,5 +1,5 @@
 ;;; gnus-start.el --- startup functions for Gnus
-;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
+;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
@@ -47,11 +47,10 @@ If a file with the `.el' or `.elc' suffixes exists, it will be read instead."
   :type 'file)
 
 (defcustom gnus-site-init-file
-  (condition-case nil
-      (concat (file-name-directory
-              (directory-file-name installation-directory))
-             "site-lisp/gnus-init")
-    (error nil))
+  (ignore-errors
+    (concat (file-name-directory
+            (directory-file-name installation-directory))
+           "site-lisp/gnus-init"))
   "*The site-wide Gnus Emacs-Lisp startup file name, or nil if none.
 If a file with the `.el' or `.elc' suffixes exists, it will be read instead."
   :group 'gnus-start
@@ -785,7 +784,7 @@ prompt the user for the name of an NNTP server to use."
       (erase-buffer)
       (setq buffer-file-name dribble-file)
       (auto-save-mode t)
-      (buffer-disable-undo (current-buffer))
+      (buffer-disable-undo)
       (bury-buffer (current-buffer))
       (set-buffer-modified-p nil)
       (let ((auto (make-auto-save-file-name))
@@ -855,7 +854,11 @@ prompt the user for the name of an NNTP server to use."
   "Setup news information.
 If RAWFILE is non-nil, the .newsrc file will also be read.
 If LEVEL is non-nil, the news will be set up at level LEVEL."
-  (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile)))))
+  (require 'nnmail)
+  (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile))))
+       ;; Binding this variable will inhibit multiple fetchings
+       ;; of the same mail source.
+       (nnmail-fetched-sources (list t)))
 
     (when init
       ;; Clear some variables to re-initialize news information.
@@ -1103,11 +1106,16 @@ for new groups, and subscribe the new groups as zombies."
     got-new))
 
 (defun gnus-check-first-time-used ()
-  (if (or (> (length gnus-newsrc-alist) 1)
-         (file-exists-p gnus-startup-file)
-         (file-exists-p (concat gnus-startup-file ".el"))
-         (file-exists-p (concat gnus-startup-file ".eld")))
-      nil
+  (catch 'ended
+    (let ((files (list gnus-current-startup-file
+                      (concat gnus-current-startup-file ".el")
+                      (concat gnus-current-startup-file ".eld")
+                      gnus-startup-file
+                      (concat gnus-startup-file ".el")
+                      (concat gnus-startup-file ".eld"))))
+      (while files
+       (when (file-exists-p (pop files))
+         (throw 'ended nil))))
     (gnus-message 6 "First time user; subscribing you to default groups")
     (unless (gnus-read-active-file-p)
       (let ((gnus-read-active-file t))
@@ -1243,14 +1251,14 @@ for new groups, and subscribe the new groups as zombies."
            (setq active (gnus-active group))
            (setq num
                  (if active (- (1+ (cdr active)) (car active)) t))
-           ;; Check whether the group is foreign.  If so, the
-           ;; foreign select method has to be entered into the
-           ;; info.
-           (let ((method (or gnus-override-subscribe-method
-                             (gnus-group-method group))))
-             (if (eq method gnus-select-method)
-                 (setq info (list group level nil))
-               (setq info (list group level nil nil method)))))
+           ;; Shorten the select method if possible, if we need to
+           ;; store it at all (native groups).
+           (let ((method (gnus-method-simplify
+                          (or gnus-override-subscribe-method
+                              (gnus-group-method group)))))
+             (if method
+                 (setq info (list group level nil nil method))
+               (setq info (list group level nil)))))
          (unless previous
            (setq previous
                  (let ((p gnus-newsrc-alist))
@@ -1440,7 +1448,7 @@ newsgroup."
        ;; Then we want to peel off any elements that are higher
        ;; than the upper active limit.
        (let ((srange range))
-         ;; Go past all legal elements.
+         ;; Go past all valid elements.
          (while (and (cdr srange)
                      (<= (or (and (atom (cadr srange))
                                   (cadr srange))
@@ -1448,7 +1456,7 @@ newsgroup."
                          (cdr active)))
            (setq srange (cdr srange)))
          (when (cdr srange)
-           ;; Nuke all remaining illegal elements.
+           ;; Nuke all remaining invalid elements.
            (setcdr srange nil))
 
          ;; Adjust the final element.
@@ -1513,18 +1521,27 @@ newsgroup."
                                           "-request-update-info")))
              (inline (gnus-request-update-info info method))))
        ;; These groups are native or secondary.
-       (when (and (<= (gnus-info-level info) level)
-                  (not gnus-read-active-file))
+       (cond
+        ;; We don't want these groups.
+        ((> (gnus-info-level info) level)
+         (setq active 'ignore))
+        ;; Activate groups.
+        ((not gnus-read-active-file)
          (setq active (gnus-activate-group group 'scan))
-         (inline (gnus-close-group group))))
+         (inline (gnus-close-group group)))))
 
       ;; Get the number of unread articles in the group.
-      (if active
-         (inline (gnus-get-unread-articles-in-group info active t))
+      (cond
+       ((eq active 'ignore)
+       ;; Don't do anything.
+       )
+       (active
+       (inline (gnus-get-unread-articles-in-group info active t)))
+       (t
        ;; The group couldn't be reached, so we nix out the number of
        ;; unread articles and stuff.
        (gnus-set-active group nil)
-       (setcar (gnus-gethash group gnus-newsrc-hashtb) t)))
+       (setcar (gnus-gethash group gnus-newsrc-hashtb) t))))
 
     (gnus-message 5 "Checking new news...done")))
 
@@ -1632,30 +1649,30 @@ newsgroup."
 (defun gnus-read-active-file (&optional force not-native)
   (gnus-group-set-mode-line)
   (let ((methods
-        (append
-         (if (and (not not-native)
-                  (gnus-check-server gnus-select-method))
-             ;; The native server is available.
-             (cons gnus-select-method gnus-secondary-select-methods)
-           ;; The native server is down, so we just do the
-           ;; secondary ones.
-           gnus-secondary-select-methods)
-         ;; Also read from the archive server.
-         (when (gnus-archive-server-wanted-p)
-           (list "archive"))))
-       list-type)
+        (mapcar
+         (lambda (m) (if (stringp m) (gnus-server-get-method nil m) m))
+         (append
+          (if (and (not not-native)
+                   (gnus-check-server gnus-select-method))
+              ;; The native server is available.
+              (cons gnus-select-method gnus-secondary-select-methods)
+            ;; The native server is down, so we just do the
+            ;; secondary ones.
+            gnus-secondary-select-methods)
+          ;; Also read from the archive server.
+          (when (gnus-archive-server-wanted-p)
+            (list "archive")))))
+       method where mesg list-type)
     (setq gnus-have-read-active-file nil)
     (save-excursion
       (set-buffer nntp-server-buffer)
-      (while methods
-       (let* ((method (if (stringp (car methods))
-                          (gnus-server-get-method nil (car methods))
-                        (car methods)))
-              (where (nth 1 method))
-              (mesg (format "Reading active file%s via %s..."
+      (while (setq method (pop methods))
+       (unless (member method methods)
+         (setq where (nth 1 method)
+               mesg (format "Reading active file%s via %s..."
                             (if (and where (not (zerop (length where))))
                                 (concat " from " where) "")
-                            (car method))))
+                            (car method)))
          (gnus-message 5 mesg)
          (when (gnus-check-server method)
            ;; Request that the backend scan its incoming messages.
@@ -1702,15 +1719,7 @@ newsgroup."
                (gnus-active-to-gnus-format method gnus-active-hashtb nil t)
                ;; We mark this active file as read.
                (push method gnus-have-read-active-file)
-               (gnus-message 5 "%sdone" mesg))))))
-       (setq methods (cdr methods))))))
-
-
-(defun gnus-ignored-newsgroups-has-to-p ()
-  "Non-nil iff gnus-ignored-newsgroups includes \"^to\\\\.\" as an element."
-  ;; note this regexp is the same as:
-  ;; (concat (regexp-quote "^to\\.") "\\($\\|" (regexp-quote "\\|") "\\)")
-  (string-match "\\^to\\\\\\.\\($\\|\\\\|\\)" gnus-ignored-newsgroups))
+               (gnus-message 5 "%sdone" mesg))))))))))
 
 ;; Read an active file and place the results in `gnus-active-hashtb'.
 (defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors
@@ -1729,13 +1738,11 @@ newsgroup."
                              (gnus-make-hashtable 4096)))))))
     ;; Delete unnecessary lines.
     (goto-char (point-min))
-    (cond ((gnus-ignored-newsgroups-has-to-p)
-          (delete-matching-lines gnus-ignored-newsgroups))
-         ((string= gnus-ignored-newsgroups "")
-          (delete-matching-lines "^to\\."))
-         (t
-          (delete-matching-lines (concat "^to\\.\\|"
-                                         gnus-ignored-newsgroups))))
+    (cond
+     ((string= gnus-ignored-newsgroups "")
+      (delete-matching-lines "^to\\."))
+     (t
+      (delete-matching-lines (concat "^to\\.\\|" gnus-ignored-newsgroups))))
 
     ;; Make the group names readable as a lisp expression even if they
     ;; contain special characters.
@@ -1772,13 +1779,13 @@ newsgroup."
                       (progn
                         (skip-chars-forward " \t")
                         (not
-                         (or (= (following-char) ?=)
-                             (= (following-char) ?x)
-                             (= (following-char) ?j)))))
+                         (or (eq (char-after) ?=)
+                             (eq (char-after) ?x)
+                             (eq (char-after) ?j)))))
                  (progn
                    (set group (cons min max))
                    ;; if group is moderated, stick in moderation table
-                   (when (= (following-char) ?m)
+                   (when (eq (char-after) ?m)
                      (unless gnus-moderated-hashtb
                        (setq gnus-moderated-hashtb (gnus-make-hashtable)))
                      (gnus-sethash (symbol-name group) t
@@ -1789,7 +1796,7 @@ newsgroup."
                (symbolp group)
                (set group nil))
           (unless ignore-errors
-            (gnus-message 3 "Warning - illegal active: %s"
+            (gnus-message 3 "Warning - invalid active: %s"
                           (buffer-substring
                            (gnus-point-at-bol) (gnus-point-at-eol))))))
        (widen)
@@ -1813,7 +1820,7 @@ newsgroup."
     ;; Let the Gnus agent save the active file.
     (when (and gnus-agent real-active)
       (gnus-agent-save-groups method))
-    
+
     (goto-char (point-min))
     ;; We split this into to separate loops, one with the prefix
     ;; and one without to speed the reading up somewhat.
@@ -1836,7 +1843,7 @@ newsgroup."
       (let (min max group)
        (while (not (eobp))
          (condition-case ()
-             (when (= (following-char) ?2)
+             (when (eq (char-after) ?2)
                (read cur) (read cur)
                (setq min (read cur)
                      max (read cur))
@@ -1877,7 +1884,7 @@ If FORCE is non-nil, the .newsrc file is read."
        (save-excursion
          (gnus-message 5 "Reading %s..." newsrc-file)
          (set-buffer (nnheader-find-file-noselect newsrc-file))
-         (buffer-disable-undo (current-buffer))
+         (buffer-disable-undo)
          (gnus-newsrc-to-gnus-format)
          (kill-buffer (current-buffer))
          (gnus-message 5 "Reading %s...done" newsrc-file)))
@@ -2053,7 +2060,7 @@ If FORCE is non-nil, the .newsrc file is read."
        (unless (boundp symbol)
          (set symbol nil))
        ;; It was a group name.
-       (setq subscribed (= (following-char) ?:)
+       (setq subscribed (eq (char-after) ?:)
              group (symbol-name symbol)
              reads nil)
        (if (eolp)
@@ -2077,7 +2084,7 @@ If FORCE is non-nil, the .newsrc file is read."
                           (read buf)))
              (widen)
              ;; If the next character is a dash, then this is a range.
-             (if (= (following-char) ?-)
+             (if (eq (char-after) ?-)
                  (progn
                    ;; We read the upper bound of the range.
                    (forward-char 1)
@@ -2099,8 +2106,8 @@ If FORCE is non-nil, the .newsrc file is read."
                (push num1 reads))
              ;; If the next char in ?\n, then we have reached the end
              ;; of the line and return nil.
-             (/= (following-char) ?\n))
-            ((= (following-char) ?\n)
+             (not (eq (char-after) ?\n)))
+            ((eq (char-after) ?\n)
              ;; End of line, so we end.
              nil)
             (t
@@ -2114,7 +2121,7 @@ If FORCE is non-nil, the .newsrc file is read."
                            (buffer-substring (gnus-point-at-bol)
                                              (gnus-point-at-eol))))
              nil))
-         ;; Skip past ", ".  Spaces are illegal in these ranges, but
+         ;; Skip past ", ".  Spaces are invalid in these ranges, but
          ;; we allow them, because it's a common mistake to put a
          ;; space after the comma.
          (skip-chars-forward ", "))
@@ -2226,7 +2233,7 @@ If FORCE is non-nil, the .newsrc file is read."
                  (gnus-point-at-eol)))
        ;; Search for all "words"...
        (while (re-search-forward "[^ \t,\n]+" eol t)
-         (if (= (char-after (match-beginning 0)) ?!)
+         (if (eq (char-after (match-beginning 0)) ?!)
              ;; If the word begins with a bang (!), this is a "not"
              ;; spec.  We put this spec (minus the bang) and the
              ;; symbol `ignore' into the list.
@@ -2274,7 +2281,7 @@ If FORCE is non-nil, the .newsrc file is read."
          (setq buffer-file-name
                (concat gnus-current-startup-file ".eld"))
          (setq default-directory (file-name-directory buffer-file-name))
-         (buffer-disable-undo (current-buffer))
+         (buffer-disable-undo)
          (erase-buffer)
          (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file)
          (gnus-gnus-to-quick-newsrc-format)
@@ -2338,7 +2345,7 @@ If FORCE is non-nil, the .newsrc file is read."
          info ranges range method)
       (setq buffer-file-name gnus-current-startup-file)
       (setq default-directory (file-name-directory buffer-file-name))
-      (buffer-disable-undo (current-buffer))
+      (buffer-disable-undo)
       (erase-buffer)
       ;; Write options.
       (when gnus-newsrc-options
@@ -2424,7 +2431,6 @@ If FORCE is non-nil, the .newsrc file is read."
       (gnus-message 7 "Reading slave newsrcs...")
       (save-excursion
        (set-buffer (gnus-get-buffer-create " *gnus slave*"))
-       (buffer-disable-undo (current-buffer))
        (setq slave-files
              (sort (mapcar (lambda (file)
                              (list (nth 5 (file-attributes file)) file))
@@ -2531,7 +2537,7 @@ If FORCE is non-nil, the .newsrc file is read."
                          (fboundp 'gnus-mule-get-coding-system)
                          (gnus-mule-get-coding-system (symbol-name group)))))
                (when coding
-                 (setq str (nnheader-decode-coding-string str (car coding))))
+                 (setq str (mm-decode-coding-string str (car coding))))
                (set group str)))
            (forward-line 1))))
       (gnus-message 5 "Reading descriptions file...done")