Synch to No Gnus 200510042243.

[elisp/gnus.git-] / lisp / gnus-start.el

diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el
index e940a43..f7c579d 100644 (file)
--- a/lisp/gnus-start.el
+++ b/lisp/gnus-start.el
@@ -1,6 +1,7 @@
 ;;; gnus-start.el --- startup functions for Gnus
 ;;; gnus-start.el --- startup functions for Gnus

-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
-;;        Free Software Foundation, Inc.
+
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;;   2005 Free Software Foundation, Inc.

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

@@ -19,8 +20,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the

-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.

 
 ;;; Commentary:
 
 
 ;;; Commentary:
 

@@ -60,7 +61,7 @@
   "Whether to create backup files.
 This variable takes the same values as the `version-control'
 variable."
   "Whether to create backup files.
 This variable takes the same values as the `version-control'
 variable."

-  :version "21.4"
+  :version "22.1"

   :group 'gnus-start
   :type '(choice (const :tag "Never" never)
                 (const :tag "If existing" nil)
   :group 'gnus-start
   :type '(choice (const :tag "Never" never)
                 (const :tag "If existing" nil)

@@ -71,7 +72,7 @@ variable."
 the buffer or write directly to the file.  The buffer is faster
 because all of the contents are written at once.  The direct write
 uses considerably less memory."
 the buffer or write directly to the file.  The buffer is faster
 because all of the contents are written at once.  The direct write
 uses considerably less memory."

-  :version "21.4"
+  :version "22.1"

   :group 'gnus-start
   :type '(choice (const :tag "Write via buffer" t)
                  (const :tag "Write directly to file" nil)))
   :group 'gnus-start
   :type '(choice (const :tag "Write via buffer" t)
                  (const :tag "Write directly to file" nil)))

@@ -264,7 +265,7 @@ not match this regexp will be removed before saving the list."
                               (and value (not (stringp value))))
                      :value t)
                (const nil)
                               (and value (not (stringp value))))
                      :value t)
                (const nil)

-               (regexp :format "%t: %v\n" :size 0)))
+               regexp))

 
 (defcustom gnus-ignored-newsgroups
   (mapconcat 'identity
 
 (defcustom gnus-ignored-newsgroups
   (mapconcat 'identity

@@ -305,6 +306,7 @@ claim them."
 (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."
 (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."

+  :version "22.1"

   :group 'gnus-group-new
   :type 'hook)
 
   :group 'gnus-group-new
   :type 'hook)
 

@@ -411,6 +413,7 @@ This hook is called as the first thing when Gnus is started."
 
 (defcustom gnus-get-top-new-news-hook nil
   "A hook run just before Gnus checks for new news globally."
 
 (defcustom gnus-get-top-new-news-hook nil
   "A hook run just before Gnus checks for new news globally."

+  :version "22.1"

   :group 'gnus-group-new
   :type 'hook)
 
   :group 'gnus-group-new
   :type 'hook)
 

@@ -616,7 +619,7 @@ Can be used to turn version control on or off."
   "Subscribe the new GROUP interactively.
 It is inserted in hierarchical newsgroup order if subscribed.  If not,
 it is killed."
   "Subscribe the new GROUP interactively.
 It is inserted in hierarchical newsgroup order if subscribed.  If not,
 it is killed."

-  (if (gnus-y-or-n-p (format "Subscribe new newsgroup: %s " group))
+  (if (gnus-y-or-n-p (format "Subscribe new newsgroup %s? " group))

       (gnus-subscribe-hierarchically group)
     (push group gnus-killed-list)))
 
       (gnus-subscribe-hierarchically group)
     (push group gnus-killed-list)))
 

@@ -971,16 +974,28 @@ If LEVEL is non-nil, the news will be set up at level LEVEL."
     ;; Make sure the archive server is available to all and sundry.
     (when gnus-message-archive-method
       (unless (assoc "archive" gnus-server-alist)
     ;; Make sure the archive server is available to all and sundry.
     (when gnus-message-archive-method
       (unless (assoc "archive" gnus-server-alist)

-       (push `("archive"
-               nnfolder
-               "archive"
-               (nnfolder-directory
-                ,(nnheader-concat message-directory "archive"))
-               (nnfolder-active-file
-                ,(nnheader-concat message-directory "archive/active"))
-               (nnfolder-get-new-mail nil)
-               (nnfolder-inhibit-expiry t))
-             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))))

 
     ;; 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.

@@ -1535,8 +1550,8 @@ If SCAN, request a scan of that group as well."
           ;; command may have responded with the `(0 . 0)'.  We
           ;; ignore this if we already have an active entry
           ;; for the group.
           ;; command may have responded with the `(0 . 0)'.  We
           ;; ignore this if we already have an active entry
           ;; for the group.

-          (if (and (zerop (car active))
-                   (zerop (cdr active))
+          (if (and (zerop (or (car active) 0))
+                   (zerop (or (cdr active) 0))

                    (gnus-active group))
               (gnus-active group)
 
                    (gnus-active group))
               (gnus-active group)
 

@@ -1707,8 +1722,7 @@ If SCAN, request a scan of that group as well."
       (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)

-                (when (and (<= (gnus-info-level info) foreign-level)
-                           (setq active (gnus-activate-group group 'scan)))
+                (when (setq active (gnus-activate-group group 'scan))

                   ;; Let the Gnus agent save the active file.
                   (when (and gnus-agent active (gnus-online method))
                     (gnus-agent-save-group-info
                   ;; Let the Gnus agent save the active file.
                   (when (and gnus-agent active (gnus-online method))
                     (gnus-agent-save-group-info

@@ -1930,7 +1944,7 @@ If SCAN, request a scan of that group as well."
                             (setcdr range (1- article))
                             (setq modified t)
                             ranges))))))))
                             (setcdr range (1- article))
                             (setq modified t)
                             ranges))))))))

-                  
+

     (when modified
       (when (eq modified 'remove-null)
         (setq r (delq nil r)))
     (when modified
       (when (eq modified 'remove-null)
         (setq r (delq nil r)))

@@ -2258,7 +2272,8 @@ If FORCE is non-nil, the .newsrc file is read."
 (defun gnus-convert-old-newsrc ()
   "Convert old newsrc formats into the current format, if needed."
   (let ((fcv (and gnus-newsrc-file-version
 (defun gnus-convert-old-newsrc ()
   "Convert old newsrc formats into the current format, if needed."
   (let ((fcv (and gnus-newsrc-file-version

-                 (gnus-continuum-version gnus-newsrc-file-version))))
+                 (gnus-continuum-version gnus-newsrc-file-version)))
+       (gcv (gnus-continuum-version)))

     (when fcv
       ;; A newsrc file was loaded.
       (let (prompt-displayed
     (when fcv
       ;; A newsrc file was loaded.
       (let (prompt-displayed

@@ -2276,13 +2291,13 @@ If FORCE is non-nil, the .newsrc file is read."
                       ;; doesn't change with each release) and the
                       ;; function that must be applied to convert the
                       ;; previous version into the current version.
                       ;; doesn't change with each release) and the
                       ;; function that must be applied to convert the
                       ;; previous version into the current version.

-                      '(("September Gnus v0.1" nil 
+                      '(("September Gnus v0.1" nil

                          gnus-convert-old-ticks)
                         ("Oort Gnus v0.08"     "legacy-gnus-agent"
                          gnus-agent-convert-to-compressed-agentview)
                          gnus-convert-old-ticks)
                         ("Oort Gnus v0.08"     "legacy-gnus-agent"
                          gnus-agent-convert-to-compressed-agentview)

-                        ("No Gnus v0.2"        "legacy-gnus-agent"
+                        ("Gnus v5.10.7"        "legacy-gnus-agent"

                          gnus-agent-unlist-expire-days)
                          gnus-agent-unlist-expire-days)

-                        ("No Gnus v0.2"        "legacy-gnus-agent" 
+                        ("Gnus v5.10.7"        "legacy-gnus-agent"

                          gnus-agent-unhook-expire-days)))
               #'car-less-than-car)))
         ;; Skip converters older than the file version
                          gnus-agent-unhook-expire-days)))
               #'car-less-than-car)))
         ;; Skip converters older than the file version

@@ -2291,7 +2306,8 @@ If FORCE is non-nil, the .newsrc file is read."
 
         ;; Perform converters to bring older version up to date.
        (when (and converters (< fcv (caar converters)))
 
         ;; Perform converters to bring older version up to date.
        (when (and converters (< fcv (caar converters)))

-         (while (and converters (< fcv (caar converters)))
+         (while (and converters (< fcv (caar converters))
+                     (<= (caar converters) gcv))

             (let* ((converter-spec  (pop converters))
                    (convert-to      (nth 1 converter-spec))
                    (load-from       (nth 2 converter-spec))
             (let* ((converter-spec  (pop converters))
                    (convert-to      (nth 1 converter-spec))
                    (load-from       (nth 2 converter-spec))

@@ -2299,7 +2315,6 @@ If FORCE is non-nil, the .newsrc file is read."
               (when (and load-from
                          (not (fboundp func)))
                 (load load-from t))
               (when (and load-from
                          (not (fboundp func)))
                 (load load-from t))

-              

               (or prompt-displayed
                   (not (gnus-convert-converter-needs-prompt func))
                   (while (let (c
               (or prompt-displayed
                   (not (gnus-convert-converter-needs-prompt func))
                   (while (let (c

@@ -2325,7 +2340,7 @@ If FORCE is non-nil, the .newsrc file is read."
                                   t)))))
 
               (funcall func convert-to)))
                                   t)))))
 
               (funcall func convert-to)))

-          (gnus-dribble-enter 
+          (gnus-dribble-enter

            (format ";Converted gnus from version '%s' to '%s'."
                    gnus-newsrc-file-version gnus-version)))))))
 
            (format ";Converted gnus from version '%s' to '%s'."
                    gnus-newsrc-file-version gnus-version)))))))
 

@@ -2613,7 +2628,7 @@ If FORCE is non-nil, the .newsrc file is read."
            (cond
             ((looking-at "[0-9]+")
              ;; We narrow and read a number instead of buffer-substring/
            (cond
             ((looking-at "[0-9]+")
              ;; We narrow and read a number instead of buffer-substring/

-             ;; string-to-int because it's faster.  narrow/widen is
+             ;; string-to-number because it's faster.  narrow/widen is

              ;; faster than save-restriction/narrow, and save-restriction
              ;; produces a garbage object.
              (setq num1 (progn
              ;; faster than save-restriction/narrow, and save-restriction
              ;; produces a garbage object.
              (setq num1 (progn

@@ -3264,12 +3279,10 @@ If this variable is nil, don't do anything."
            (file-name-as-directory (expand-file-name gnus-default-directory))
          default-directory)))
 
            (file-name-as-directory (expand-file-name gnus-default-directory))
          default-directory)))
 

-(eval-and-compile
-(defalias 'gnus-display-time-event-handler
-  (if (gnus-boundp 'display-time-timer)
-      'display-time-event-handler
-    (lambda () "Does nothing as `display-time-timer' is not bound.
-Would otherwise be an alias for `display-time-event-handler'." nil))))
+(defun gnus-display-time-event-handler ()
+  (if (and (fboundp 'display-time-event-handler)
+          (gnus-boundp 'display-time-timer))
+      (display-time-event-handler)))

 
 ;;;###autoload
 (defun gnus-fixup-nnimap-unread-after-getting-new-news ()
 
 ;;;###autoload
 (defun gnus-fixup-nnimap-unread-after-getting-new-news ()

@@ -3287,21 +3300,39 @@ Would otherwise be an alias for `display-time-event-handler'." nil))))
 
 (defun gnus-check-reasonable-setup ()
   ;; Check whether nnml and nnfolder share a directory.
 
 (defun gnus-check-reasonable-setup ()
   ;; Check whether nnml and nnfolder share a directory.

-  (let ((actives nil))
+  (let ((display-warn
+        (if (fboundp 'display-warning)
+            'display-warning
+          (lambda (type message)
+            (if noninteractive
+                (message "Warning (%s): %s" type message)
+              (let (window)
+                (with-current-buffer (get-buffer-create "*Warnings*")
+                  (goto-char (point-max))
+                  (unless (bolp)
+                    (insert "\n"))
+                  (insert (format "Warning (%s): %s\n" type message))
+                  (setq window (display-buffer (current-buffer)))
+                  (set-window-start
+                   window
+                   (prog2
+                       (forward-line (- 1 (window-height window)))
+                       (point)
+                     (goto-char (point-max))))))))))
+       method active actives match)

     (dolist (server gnus-server-alist)
     (dolist (server gnus-server-alist)

-      (let* ((method (gnus-server-to-method server))
-            (active (intern (format "%s-active-file" (car method))))
-            match)
-       (when (and (member (car method) '(nnml nnfolder))
-                  (gnus-server-opened method)
-                  (boundp active))
-         (when (setq match (assoc (symbol-value active) actives))
-           (display-warning
-            :warning (format "%s and %s share the same active file %s"
-                             (car method)
-                             (cadr match)
-                             (car match))))
-         (push (list (symbol-value active) method) actives))))))
+      (setq method (gnus-server-to-method server)
+           active (intern (format "%s-active-file" (car method))))
+      (when (and (member (car method) '(nnml nnfolder))
+                (gnus-server-opened method)
+                (boundp active))
+       (when (setq match (assoc (symbol-value active) actives))
+         (funcall display-warn 'gnus-server
+                  (format "%s and %s share the same active file %s"
+                          (car method)
+                          (cadr match)
+                          (car match))))
+       (push (list (symbol-value active) method) actives)))))

 
 (provide 'gnus-start)
 
 
 (provide 'gnus-start)