Merge from emacs--devo--0, emacs--rel--22

[gnus] / lisp / gnus-start.el

diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el
index 7bc9c2b..7d6b913 100644 (file)
--- a/lisp/gnus-start.el
+++ b/lisp/gnus-start.el
@@ -1,7 +1,7 @@
 ;;; gnus-start.el --- startup functions for Gnus
 
 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
 ;;; gnus-start.el --- startup functions for Gnus
 
 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,

-;;   2005, 2006 Free Software Foundation, Inc.
+;;   2005, 2006, 2007 Free Software Foundation, Inc.

 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news


@@ -10,12 +10,12 @@
 
 ;; 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
 
 ;; 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
 ;; 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
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License


@@ -39,11 +39,11 @@
 (autoload 'gnus-agent-possibly-alter-active "gnus-agent")
 
 (eval-when-compile
 (autoload 'gnus-agent-possibly-alter-active "gnus-agent")
 
 (eval-when-compile

-  (require 'cl)
+  (require 'cl))

 
 

-  (defvar gnus-agent-covered-methods nil)
-  (defvar gnus-agent-file-loading-local nil)
-  (defvar gnus-agent-file-loading-cache nil))
+(defvar gnus-agent-covered-methods)
+(defvar gnus-agent-file-loading-local)
+(defvar gnus-agent-file-loading-cache)

 
 (defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc")
   "Your `.newsrc' file.
 
 (defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc")
   "Your `.newsrc' file.


@@ -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.
 
 (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.")
 
 (defconst gnus-level-zombie 8
   "Groups with this level are zombie groups.")


@@ -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.
 
 (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
 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.
 
 (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
 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.
 
 (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))
 the first newsgroup."
   (save-excursion
     (goto-char (point-min))


@@ -645,21 +650,20 @@ the first newsgroup."
 ;;; General various misc type functions.
 
 ;; Silence byte-compiler.
 ;;; General various misc type functions.
 
 ;; Silence byte-compiler.

-(eval-when-compile
-  (defvar gnus-current-headers)
-  (defvar gnus-thread-indent-array)
-  (defvar gnus-newsgroup-name)
-  (defvar gnus-newsgroup-headers)
-  (defvar gnus-group-list-mode)
-  (defvar gnus-group-mark-positions)
-  (defvar gnus-newsgroup-data)
-  (defvar gnus-newsgroup-unreads)
-  (defvar nnoo-state-alist)
-  (defvar gnus-current-select-method)
-  (defvar mail-sources)
-  (defvar nnmail-scan-directory-mail-source-once)
-  (defvar nnmail-split-history)
-  (defvar nnmail-spool-file))
+(defvar gnus-current-headers)
+(defvar gnus-thread-indent-array)
+(defvar gnus-newsgroup-name)
+(defvar gnus-newsgroup-headers)
+(defvar gnus-group-list-mode)
+(defvar gnus-group-mark-positions)
+(defvar gnus-newsgroup-data)
+(defvar gnus-newsgroup-unreads)
+(defvar nnoo-state-alist)
+(defvar gnus-current-select-method)
+(defvar mail-sources)
+(defvar nnmail-scan-directory-mail-source-once)
+(defvar nnmail-split-history)
+(defvar nnmail-spool-file)

 
 (defun gnus-close-all-servers ()
   "Close all servers."
 
 (defun gnus-close-all-servers ()
   "Close all servers."


@@ -737,7 +741,7 @@ 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
 (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")
 
 prompt the user for the name of an NNTP server to use."
   (interactive "P")
 


@@ -770,8 +774,7 @@ prompt the user for the name of an NNTP server to use."
       (cond
        ((featurep 'xemacs)
        (gnus-xmas-splash))
       (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))
        (gnus-x-splash))))
 
     (let ((level (and (numberp arg) (> arg 0) arg))


@@ -963,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.
       (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.
 
     ;; If we don't read the complete active file, we fill in the
     ;; hashtb here.


@@ -1504,8 +1511,8 @@ newsgroup."
       (setq killed (cdr killed)))))
 
 ;; We want to inline a function from gnus-cache, so we cheat here:
       (setq killed (cdr killed)))))
 
 ;; We want to inline a function from gnus-cache, so we cheat here:

+(defvar gnus-cache-active-hashtb)

 (eval-when-compile
 (eval-when-compile

-  (defvar gnus-cache-active-hashtb)

   (defun gnus-cache-possibly-alter-active (group active)
     "Alter the ACTIVE info for GROUP to reflect the articles in the cache."
     (when gnus-cache-active-hashtb
   (defun gnus-cache-possibly-alter-active (group active)
     "Alter the ACTIVE info for GROUP to reflect the articles in the cache."
     (when gnus-cache-active-hashtb


@@ -1662,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))
 (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
         (foreign-level
          (min
           (cond ((and gnus-activate-foreign-newsgroups


@@ -1671,11 +1678,11 @@ If SCAN, request a scan of that group as well."
                 ((numberp gnus-activate-foreign-newsgroups)
                  gnus-activate-foreign-newsgroups)
                 (t 0))
                 ((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
         (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
     (gnus-message 6 "Checking new news...")
 
     (while newsrc


@@ -1712,7 +1719,6 @@ If SCAN, request a scan of that group as well."
                'foreign)))
        (push (cons method method-type) type-cache))
 
                '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)
       (cond ((and method (eq method-type 'foreign))
             ;; These groups are foreign.  Check the level.
             (if (<= (gnus-info-level info) foreign-level)


@@ -1726,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))))
                   (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.
            ;; 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.
             ;; We don't want these groups.
             (setq active 'ignore))
            ;; Activate groups.


@@ -1748,11 +1762,7 @@ If SCAN, request a scan of that group as well."
               ;; not required.
               (if (and
                    (or nnmail-scan-directory-mail-source-once
               ;; 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))
                    (member method scanned-methods))
                   (setq active (gnus-activate-group group))
                 (setq active (gnus-activate-group group 'scan))


@@ -1765,10 +1775,6 @@ If SCAN, request a scan of that group as well."
        ((eq active 'ignore)
        ;; Don't do anything.
        )
        ((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
        (active
        (inline (gnus-get-unread-articles-in-group info active t)))
        (t


@@ -1959,7 +1965,7 @@ If SCAN, request a scan of that group as well."
     (while lists
       (setq killed (car lists))
       (while killed
     (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)))))
 
        (setq killed (cdr killed)))
       (setq lists (cdr lists)))))
 


@@ -2096,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)))
                            (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
     ;; Delete unnecessary lines.
     (goto-char (point-min))
     (cond


@@ -2131,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.
                      (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
       (while (not (eobp))
        (condition-case ()
            (progn


@@ -2405,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))))
            (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
     (gnus-make-hashtable-from-newsrc-alist)
     (when (file-newer-than-file-p file ding-file)
       ;; Old format quick file


@@ -2863,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))
       (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))
           (princ (symbol-name variable))
           (princ " '")
          (prin1 (symbol-value variable))


@@ -2890,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)
       (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))
       ;; Write options.
       (when gnus-newsrc-options
        (insert gnus-newsrc-options))


@@ -2932,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)
          (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
       (kill-buffer (current-buffer)))))
 
 \f