* gnus-art.el (gnus-use-idna): Don't directly refer to the value of
[gnus] / lisp / gnus-start.el
index c51d154..6e55062 100644 (file)
@@ -1,7 +1,7 @@
 ;;; gnus-start.el --- startup functions for Gnus
 
 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005 Free Software Foundation, Inc.
+;;   2005, 2006, 2007 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.         See the
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
@@ -80,7 +80,7 @@ If a file with the `.el' or `.elc' suffixes exists, it will be read instead."
 (defcustom gnus-site-init-file
   (condition-case nil
       (concat (file-name-directory
-              (directory-file-name installation-directory))
+              (directory-file-name (symbol-value 'installation-directory)))
              "site-lisp/gnus-init")
     (error nil))
   "The site-wide Gnus Emacs-Lisp startup file name, or nil if none.
@@ -178,8 +178,13 @@ properly with all servers."
 
 (defconst gnus-level-unsubscribed 7
   "Groups with levels less than or equal to this variable are unsubscribed.
-Groups with levels less than `gnus-level-subscribed', which should be
-less than this variable, are subscribed.")
+
+Groups with levels less than `gnus-level-subscribed', which
+should be less than this variable, are subscribed.  Groups with
+levels from `gnus-level-subscribed' (exclusive) upto this
+variable (inclusive) are unsubscribed.  See also
+`gnus-level-zombie', `gnus-level-killed' and the Info node `Group
+Levels' for details.")
 
 (defconst gnus-level-zombie 8
   "Groups with this level are zombie groups.")
@@ -313,8 +318,8 @@ If, for instance, you want to subscribe to all newsgroups in the
 
 options -n no.all alt.all
 
-Gnus will the subscribe all new newsgroups in these hierarchies with
-the subscription method in this variable."
+Gnus will then subscribe all new newsgroups in these hierarchies
+with the subscription method in this variable."
   :group 'gnus-group-new
   :type '(radio (function-item gnus-subscribe-randomly)
                (function-item gnus-subscribe-alphabetically)
@@ -352,7 +357,7 @@ be subscribed using `gnus-subscribe-options-newsgroup-method'."
 
 (defcustom gnus-options-subscribe nil
   "*All new groups matching this regexp will be subscribed unconditionally.
-Note that this variable deals only with new newsgroups.         This variable
+Note that this variable deals only with new newsgroups.  This variable
 does not affect old newsgroups.
 
 New groups that match this regexp will not be handled by
@@ -364,7 +369,7 @@ be subscribed using `gnus-subscribe-options-newsgroup-method'."
 
 (defcustom gnus-options-not-subscribe nil
   "*All new groups matching this regexp will be ignored.
-Note that this variable deals only with new newsgroups.         This variable
+Note that this variable deals only with new newsgroups.  This variable
 does not affect old (already subscribed) newsgroups."
   :group 'gnus-group-new
   :type '(choice regexp
@@ -626,7 +631,7 @@ it is killed."
 
 (defun gnus-subscribe-newsgroup (newsgroup &optional next)
   "Subscribe new NEWSGROUP.
-If NEXT is non-nil, it is inserted before NEXT.         Otherwise it is made
+If NEXT is non-nil, it is inserted before NEXT.  Otherwise it is made
 the first newsgroup."
   (save-excursion
     (goto-char (point-min))
@@ -658,8 +663,7 @@ the first newsgroup."
   (defvar gnus-current-select-method)
   (defvar mail-sources)
   (defvar nnmail-scan-directory-mail-source-once)
-  (defvar nnmail-split-history)
-  (defvar nnmail-spool-file))
+  (defvar nnmail-split-history))
 
 (defun gnus-close-all-servers ()
   "Close all servers."
@@ -722,11 +726,12 @@ the first newsgroup."
 
 (defun gnus-no-server-1 (&optional arg slave)
   "Read network news.
-If ARG is a positive number, Gnus will use that as the
-startup level. If ARG is nil, Gnus will be started at level 2.
-If ARG is non-nil and not a positive number, Gnus will
-prompt the user for the name of an NNTP server to use.
-As opposed to `gnus', this command will not connect to the local server."
+If ARG is a positive number, Gnus will use that as the startup
+level.  If ARG is nil, Gnus will be started at level 2
+\(`gnus-level-default-subscribed' minus one).  If ARG is non-nil
+and not a positive number, Gnus will prompt the user for the name
+of an NNTP server to use.  As opposed to \\[gnus], this command
+will not connect to the local server."
   (interactive "P")
   (let ((val (or arg (1- gnus-level-default-subscribed))))
     (gnus val t slave)
@@ -736,7 +741,7 @@ As opposed to `gnus', this command will not connect to the local server."
 (defun gnus-1 (&optional arg dont-connect slave)
   "Read network news.
 If ARG is non-nil and a positive number, Gnus will use that as the
-startup level. If ARG is non-nil and not a positive number, Gnus will
+startup level.  If ARG is non-nil and not a positive number, Gnus will
 prompt the user for the name of an NNTP server to use."
   (interactive "P")
 
@@ -769,8 +774,7 @@ prompt the user for the name of an NNTP server to use."
       (cond
        ((featurep 'xemacs)
        (gnus-xmas-splash))
-       ((and window-system
-            (= (frame-height) (1+ (window-height))))
+       (window-system
        (gnus-x-splash))))
 
     (let ((level (and (numberp arg) (> arg 0) arg))
@@ -813,7 +817,10 @@ prompt the user for the name of an NNTP server to use."
   (gnus-request-create-group "drafts" '(nndraft ""))
   (unless (gnus-group-entry "nndraft:drafts")
     (let ((gnus-level-default-subscribed 1))
-      (gnus-subscribe-group "nndraft:drafts" nil '(nndraft "")))
+      (gnus-subscribe-group "nndraft:drafts" nil '(nndraft ""))))
+  (unless (equal (gnus-group-get-parameter "nndraft:drafts" 'gnus-dummy t)
+                '((gnus-draft-mode)))
+    (gnus-message 3 "Setting up drafts group")
     (gnus-group-set-parameter
      "nndraft:drafts" 'gnus-dummy '((gnus-draft-mode)))))
 
@@ -959,30 +966,34 @@ If LEVEL is non-nil, the news will be set up at level LEVEL."
       (gnus-read-newsrc-file rawfile))
 
     ;; Make sure the archive server is available to all and sundry.
-    (when gnus-message-archive-method
-      (unless (assoc "archive" gnus-server-alist)
-       (let ((method (or (and (stringp gnus-message-archive-method)
-                              (gnus-server-to-method
-                               gnus-message-archive-method))
-                         gnus-message-archive-method)))
-         ;; Check whether the archive method is writable.
-         (unless (or (stringp method)
-                     (memq 'respool (assoc (format "%s" (car method))
-                                           gnus-valid-select-methods)))
-           (setq method "archive")) ;; The default.
-         (push (if (stringp method)
-                   `("archive"
-                     nnfolder
-                     ,method
-                     (nnfolder-directory
-                      ,(nnheader-concat message-directory method))
-                     (nnfolder-active-file
-                      ,(nnheader-concat message-directory
-                                        (concat method "/active")))
-                     (nnfolder-get-new-mail nil)
-                     (nnfolder-inhibit-expiry t))
-                 (cons "archive" method))
-               gnus-server-alist))))
+    (let ((method (or (and (stringp gnus-message-archive-method)
+                          (gnus-server-to-method
+                           gnus-message-archive-method))
+                     gnus-message-archive-method)))
+      ;; Check whether the archive method is writable.
+      (unless (or (not method)
+                 (stringp method)
+                 (memq 'respool (assoc (format "%s" (car method))
+                                       gnus-valid-select-methods)))
+       (setq method "archive")) ;; The default.
+      (when (stringp method)
+       (setq method `(nnfolder
+                      ,method
+                      (nnfolder-directory
+                       ,(nnheader-concat message-directory method))
+                      (nnfolder-active-file
+                       ,(nnheader-concat message-directory
+                                         (concat method "/active")))
+                      (nnfolder-get-new-mail nil)
+                      (nnfolder-inhibit-expiry t))))
+      (if (assoc "archive" gnus-server-alist)
+         (when gnus-update-message-archive-method
+           (if method
+               (setcdr (assoc "archive" gnus-server-alist) method)
+             (setq gnus-server-alist (delq (assoc "archive" gnus-server-alist)
+                                           gnus-server-alist))))
+       (when method
+         (push (cons "archive" method) gnus-server-alist))))
 
     ;; If we don't read the complete active file, we fill in the
     ;; hashtb here.
@@ -1049,9 +1060,12 @@ If LEVEL is non-nil, the news will be set up at level LEVEL."
       (gnus-check-bogus-newsgroups))
 
     ;; We might read in new NoCeM messages here.
-    (when (and gnus-use-nocem
-              (not level)
-              (not dont-connect))
+    (when (and (not dont-connect)
+              gnus-use-nocem
+              (or (and (numberp gnus-use-nocem)
+                       (numberp level)
+                       (>= level gnus-use-nocem))
+                  (not level)))
       (gnus-nocem-scan-groups))
 
     ;; Read any slave files.
@@ -1655,7 +1669,7 @@ If SCAN, request a scan of that group as well."
 (defun gnus-get-unread-articles (&optional level)
   (setq gnus-server-method-cache nil)
   (let* ((newsrc (cdr gnus-newsrc-alist))
-        (level (or level gnus-activate-level (1+ gnus-level-subscribed)))
+        (alevel (or level gnus-activate-level (1+ gnus-level-subscribed)))
         (foreign-level
          (min
           (cond ((and gnus-activate-foreign-newsgroups
@@ -1664,11 +1678,11 @@ If SCAN, request a scan of that group as well."
                 ((numberp gnus-activate-foreign-newsgroups)
                  gnus-activate-foreign-newsgroups)
                 (t 0))
-          level))
+          alevel))
         (methods-cache nil)
         (type-cache nil)
         scanned-methods info group active method retrieve-groups cmethod
-        method-type ignore)
+        method-type)
     (gnus-message 6 "Checking new news...")
 
     (while newsrc
@@ -1705,7 +1719,6 @@ If SCAN, request a scan of that group as well."
                'foreign)))
        (push (cons method method-type) type-cache))
 
-      (setq ignore nil)
       (cond ((and method (eq method-type 'foreign))
             ;; These groups are foreign.  Check the level.
             (if (<= (gnus-info-level info) foreign-level)
@@ -1719,9 +1732,17 @@ If SCAN, request a scan of that group as well."
                   (when (fboundp (intern (concat (symbol-name (car method))
                                                  "-request-update-info")))
                     (inline (gnus-request-update-info info method))))
-              (setq ignore t)))
+              (if (and level
+                       ;; If `active' is nil that means the group has
+                       ;; never been read, the group should be marked
+                       ;; as having never been checked (see below).
+                       active
+                       (> (gnus-info-level info) level))
+                  ;; Don't check groups of which levels are higher
+                  ;; than the one that a user specified.
+                  (setq active 'ignore))))
            ;; These groups are native or secondary.
-           ((> (gnus-info-level info) level)
+           ((> (gnus-info-level info) alevel)
             ;; We don't want these groups.
             (setq active 'ignore))
            ;; Activate groups.
@@ -1741,11 +1762,7 @@ If SCAN, request a scan of that group as well."
               ;; not required.
               (if (and
                    (or nnmail-scan-directory-mail-source-once
-                       (null (assq 'directory
-                                   (or mail-sources
-                                       (if (listp nnmail-spool-file)
-                                           nnmail-spool-file
-                                         (list nnmail-spool-file))))))
+                       (null (assq 'directory mail-sources)))
                    (member method scanned-methods))
                   (setq active (gnus-activate-group group))
                 (setq active (gnus-activate-group group 'scan))
@@ -1758,10 +1775,6 @@ If SCAN, request a scan of that group as well."
        ((eq active 'ignore)
        ;; Don't do anything.
        )
-       ((and active ignore)
-       ;; The level of the foreign group is higher than the specified
-       ;; value.
-       )
        (active
        (inline (gnus-get-unread-articles-in-group info active t)))
        (t
@@ -1952,7 +1965,7 @@ If SCAN, request a scan of that group as well."
     (while lists
       (setq killed (car lists))
       (while killed
-       (gnus-sethash (car killed) nil hashtb)
+       (gnus-sethash (mm-string-as-unibyte (car killed)) nil hashtb)
        (setq killed (cdr killed)))
       (setq lists (cdr lists)))))
 
@@ -2089,7 +2102,8 @@ If SCAN, request a scan of that group as well."
                            (if (equal method gnus-select-method)
                                (gnus-make-hashtable
                                 (count-lines (point-min) (point-max)))
-                             (gnus-make-hashtable 4096)))))))
+                             (gnus-make-hashtable 4096))))))
+       group max min)
     ;; Delete unnecessary lines.
     (goto-char (point-min))
     (cond
@@ -2124,8 +2138,12 @@ If SCAN, request a scan of that group as well."
                      (insert prefix)
                      (zerop (forward-line 1)))))))
     ;; Store the active file in a hash table.
-    (goto-char (point-min))
-    (let (group max min)
+    ;; Use a unibyte buffer in order to make `read' read non-ASCII
+    ;; group names (which have been encoded) as unibyte strings.
+    (mm-with-unibyte-buffer
+      (insert-buffer-substring cur)
+      (setq cur (current-buffer))
+      (goto-char (point-min))
       (while (not (eobp))
        (condition-case ()
            (progn
@@ -2398,6 +2416,8 @@ If FORCE is non-nil, the .newsrc file is read."
            (setq gnus-format-specs gnus-default-format-specs)))
        (when gnus-newsrc-assoc
          (setq gnus-newsrc-alist gnus-newsrc-assoc))))
+    (dolist (elem gnus-newsrc-alist)
+      (setcar elem (mm-string-as-unibyte (car elem))))
     (gnus-make-hashtable-from-newsrc-alist)
     (when (file-newer-than-file-p file ding-file)
       ;; Old format quick file
@@ -2836,6 +2856,7 @@ If FORCE is non-nil, the .newsrc file is read."
            (print-escape-nonascii t)
            (print-length nil)
            (print-level nil)
+          (print-circle nil)
            (print-escape-newlines t)
           (gnus-killed-list
            (if (and gnus-save-killed-list
@@ -2855,7 +2876,7 @@ If FORCE is non-nil, the .newsrc file is read."
       (while variables
        (when (and (boundp (setq variable (pop variables)))
                   (symbol-value variable))
-         (princ "(setq ")
+         (princ "\n(setq ")
           (princ (symbol-name variable))
           (princ " '")
          (prin1 (symbol-value variable))
@@ -2882,6 +2903,10 @@ If FORCE is non-nil, the .newsrc file is read."
       (setq default-directory (file-name-directory buffer-file-name))
       (buffer-disable-undo)
       (erase-buffer)
+      ;; Use a unibyte buffer since group names are unibyte strings;
+      ;; in particular, non-ASCII group names are the ones encoded by
+      ;; a certain coding system.
+      (mm-disable-multibyte)
       ;; Write options.
       (when gnus-newsrc-options
        (insert gnus-newsrc-options))
@@ -2924,7 +2949,8 @@ If FORCE is non-nil, the .newsrc file is read."
          (delete-file gnus-startup-file)
        (clear-visited-file-modtime))
       (gnus-run-hooks 'gnus-save-standard-newsrc-hook)
-      (save-buffer)
+      (let ((coding-system-for-write 'raw-text))
+       (save-buffer))
       (kill-buffer (current-buffer)))))
 
 \f