Revision: miles@gnu.org--gnu-2005/gnus--devo--0--patch-37
[gnus] / lisp / gnus-start.el
index d324023..ba23c7c 100644 (file)
@@ -37,7 +37,7 @@
 (autoload 'gnus-agent-save-local "gnus-agent")
 (autoload 'gnus-agent-possibly-alter-active "gnus-agent")
 
-(eval-when-compile 
+(eval-when-compile
   (require 'cl)
 
   (defvar gnus-agent-covered-methods nil)
@@ -54,6 +54,7 @@
   "Whether to create backup files.
 This variable takes the same values as the `version-control'
 variable."
+  :version "22.1"
   :group 'gnus-start
   :type '(choice (const :tag "Never" never)
                 (const :tag "If existing" nil)
@@ -64,6 +65,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."
+  :version "22.1"
   :group 'gnus-start
   :type '(choice (const :tag "Write via buffer" t)
                  (const :tag "Write directly to file" nil)))
@@ -256,7 +258,7 @@ not match this regexp will be removed before saving the list."
                               (and value (not (stringp value))))
                      :value t)
                (const nil)
-               (regexp :format "%t: %v\n" :size 0)))
+               regexp))
 
 (defcustom gnus-ignored-newsgroups
   (mapconcat 'identity
@@ -297,6 +299,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."
+  :version "22.1"
   :group 'gnus-group-new
   :type 'hook)
 
@@ -403,6 +406,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."
+  :version "22.1"
   :group 'gnus-group-new
   :type 'hook)
 
@@ -948,16 +952,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)
-       (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.
@@ -1485,8 +1501,8 @@ newsgroup."
            (setcdr active (cdr cache-active))))))))
 
 (defun gnus-activate-group (group &optional scan dont-check method)
-  ;; Check whether a group has been activated or not.
-  ;; If SCAN, request a scan of that group as well.
+  "Check whether a group has been activated or not.
+If SCAN, request a scan of that group as well."
   (let ((method (or method (inline (gnus-find-method-for-group group))))
        active)
     (and (inline (gnus-check-server method))
@@ -1684,8 +1700,7 @@ newsgroup."
       (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
@@ -1778,7 +1793,7 @@ newsgroup."
 (defun gnus-make-hashtable-from-newsrc-alist ()
   (let ((alist gnus-newsrc-alist)
        (ohashtb gnus-newsrc-hashtb)
-       prev)
+       prev info method rest methods)
     (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist)))
     (setq alist
          (setq prev (setq gnus-newsrc-alist
@@ -1787,14 +1802,26 @@ newsgroup."
                               gnus-newsrc-alist
                             (cons (list "dummy.group" 0 nil) alist)))))
     (while alist
+      (setq info (car alist))
+      ;; Make the same select-methods identical Lisp objects.
+      (when (setq method (gnus-info-method info))
+       (if (setq rest (member method methods))
+           (gnus-info-set-method info (car rest))
+         (push method methods)))
       (gnus-sethash
-       (caar alist)
+       (car info)
        ;; Preserve number of unread articles in groups.
-       (cons (and ohashtb (car (gnus-gethash (caar alist) ohashtb)))
+       (cons (and ohashtb (car (gnus-gethash (car info) ohashtb)))
             prev)
        gnus-newsrc-hashtb)
       (setq prev alist
-           alist (cdr alist)))))
+           alist (cdr alist)))
+    ;; Make the same select-methods in `gnus-server-alist' identical
+    ;; as well.
+    (while methods
+      (setq method (pop methods))
+      (when (setq rest (rassoc method gnus-server-alist))
+       (setcdr rest method)))))
 
 (defun gnus-make-hashtable-from-killed ()
   "Create a hash table from the killed and zombie lists."
@@ -1895,7 +1922,7 @@ newsgroup."
                             (setcdr range (1- article))
                             (setq modified t)
                             ranges))))))))
-                  
+
     (when modified
       (when (eq modified 'remove-null)
         (setq r (delq nil r)))
@@ -2230,7 +2257,7 @@ If FORCE is non-nil, the .newsrc file is read."
   (let ((fcv (and gnus-newsrc-file-version
                  (gnus-continuum-version gnus-newsrc-file-version))))
     (when fcv
-      ;; A .newsrc.eld file was loaded.
+      ;; A newsrc file was loaded.
       (let (prompt-displayed
             (converters
              (sort
@@ -2246,13 +2273,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.
-                      '(("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)
-                        ("No Gnus v0.2"        "legacy-gnus-agent"
+                        ("Gnus v5.10.7"        "legacy-gnus-agent"
                          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
@@ -2269,24 +2296,23 @@ If FORCE is non-nil, the .newsrc file is read."
               (when (and load-from
                          (not (fboundp func)))
                 (load load-from t))
-              
               (or prompt-displayed
                   (not (gnus-convert-converter-needs-prompt func))
                   (while (let (c
                                (cursor-in-echo-area t)
                                (echo-keystrokes 0))
-                           (message "Convert newsrc from version '%s' to '%s'? (n/y/?)"
+                           (message "Convert gnus from version '%s' to '%s'? (n/y/?)"
                                     gnus-newsrc-file-version gnus-version)
                            (setq c (read-char-exclusive))
 
                            (cond ((or (eq c ?n) (eq c ?N))
-                                  (error "Can not start gnus using old (unconverted) newsrc"))
+                                  (error "Can not start gnus without converting"))
                                  ((or (eq c ?y) (eq c ?Y))
                                   (setq prompt-displayed t)
                                   nil)
                                  ((eq c ?\?)
                                   (message "This conversion is irreversible. \
You should backup your files before proceeding.")
To be safe, you should backup your files before proceeding.")
                                   (sit-for 5)
                                   t)
                                  (t
@@ -2295,20 +2321,22 @@ If FORCE is non-nil, the .newsrc file is read."
                                   t)))))
 
               (funcall func convert-to)))
-          (gnus-dribble-enter 
-           (format ";Converted newsrc from version '%s' to '%s'? (n/y/?)"
+          (gnus-dribble-enter
+           (format ";Converted gnus from version '%s' to '%s'."
                    gnus-newsrc-file-version gnus-version)))))))
 
 (defun gnus-convert-mark-converter-prompt (converter no-prompt)
-  (setplist converter
-            (let* ((symbol 'gnus-convert-no-prompt)
-                   (value (delq symbol (symbol-plist converter))))
-            (if no-prompt
-                (cons symbol value)
-              value))))
+  "Indicate whether CONVERTER requires gnus-convert-old-newsrc to
+  display the conversion prompt.  NO-PROMPT may be nil (prompt),
+  t (no prompt), or any form that can be called as a function.
+  The form should return either t or nil."
+  (put converter 'gnus-convert-no-prompt no-prompt))
 
 (defun gnus-convert-converter-needs-prompt (converter)
-  (not (memq 'gnus-convert-no-prompt (symbol-plist converter))))
+  (let ((no-prompt (get converter 'gnus-convert-no-prompt)))
+    (not (if (memq no-prompt '(t nil))
+            no-prompt
+          (funcall no-prompt)))))
 
 (defun gnus-convert-old-ticks (converting-to)
   (let ((newsrc (cdr gnus-newsrc-alist))
@@ -3090,6 +3118,41 @@ Would otherwise be an alias for `display-time-event-handler'." nil))))
         (symbol-value 'nnimap-mailbox-info)
        (make-vector 1 0)))))
 
+(defun gnus-check-reasonable-setup ()
+  ;; Check whether nnml and nnfolder share a directory.
+  (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)
+      (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)