Gnus -- minor build / warning fixes [OK For Upstream]
[gnus] / lisp / gnus-start.el
index 3bdcb05..52a53a7 100644 (file)
@@ -1,7 +1,6 @@
 ;;; 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,
-;;   2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2016 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
@@ -31,6 +30,7 @@
 (require 'gnus-spec)
 (require 'gnus-range)
 (require 'gnus-util)
 (require 'gnus-spec)
 (require 'gnus-range)
 (require 'gnus-util)
+(ignore-errors (require 'gnus-cloud))
 (autoload 'message-make-date "message")
 (autoload 'gnus-agent-read-servers-validate "gnus-agent")
 (autoload 'gnus-agent-save-local "gnus-agent")
 (autoload 'message-make-date "message")
 (autoload 'gnus-agent-read-servers-validate "gnus-agent")
 (autoload 'gnus-agent-save-local "gnus-agent")
@@ -86,14 +86,6 @@ If a file with the `.el' or `.elc' suffixes exists, it will be read instead."
   :group 'gnus-start
   :type '(choice file (const nil)))
 
   :group 'gnus-start
   :type '(choice file (const nil)))
 
-(defcustom gnus-default-subscribed-newsgroups nil
-  "List of newsgroups to subscribe, when a user runs Gnus the first time.
-The value should be a list of strings.
-If it is t, Gnus will not do anything special the first time it is
-started; it'll just use the normal newsgroups subscription methods."
-  :group 'gnus-start
-  :type '(choice (repeat string) (const :tag "Nothing special" t)))
-
 (defcustom gnus-use-dribble-file t
   "*Non-nil means that Gnus will use a dribble file to store user updates.
 If Emacs should crash without saving the .newsrc files, complete
 (defcustom gnus-use-dribble-file t
   "*Non-nil means that Gnus will use a dribble file to store user updates.
 If Emacs should crash without saving the .newsrc files, complete
@@ -119,7 +111,7 @@ ask the servers (primary, secondary, and archive servers) to list new
 groups since the last time it checked:
   1. This variable is `ask-server'.
   2. This variable is a list of select methods (see below).
 groups since the last time it checked:
   1. This variable is `ask-server'.
   2. This variable is a list of select methods (see below).
-  3. `gnus-read-active-file' is nil or `some'.
+  3. Option `gnus-read-active-file' is nil or `some'.
   4. A prefix argument is given to `gnus-find-new-newsgroups' interactively.
 
 Thus, if this variable is `ask-server' or a list of select methods or
   4. A prefix argument is given to `gnus-find-new-newsgroups' interactively.
 
 Thus, if this variable is `ask-server' or a list of select methods or
@@ -130,9 +122,9 @@ This variable can be a list of select methods which Gnus will query with
 the `ask-server' method in addition to the primary, secondary, and archive
 servers.
 
 the `ask-server' method in addition to the primary, secondary, and archive
 servers.
 
-Eg.
+E.g.:
   (setq gnus-check-new-newsgroups
   (setq gnus-check-new-newsgroups
-       '((nntp \"some.server\") (nntp \"other.server\")))
+       \\='((nntp \"some.server\") (nntp \"other.server\")))
 
 If this variable is nil, then you have to tell Gnus explicitly to
 check for new newsgroups with \\<gnus-group-mode-map>\\[gnus-find-new-newsgroups]."
 
 If this variable is nil, then you have to tell Gnus explicitly to
 check for new newsgroups with \\<gnus-group-mode-map>\\[gnus-find-new-newsgroups]."
@@ -268,7 +260,7 @@ not match this regexp will be removed before saving the list."
   (mapconcat 'identity
             '("^to\\."                 ; not "real" groups
               "^[0-9. \t]+\\( \\|$\\)" ; all digits in name
   (mapconcat 'identity
             '("^to\\."                 ; not "real" groups
               "^[0-9. \t]+\\( \\|$\\)" ; all digits in name
-              "^[\"][]\"[#'()]"        ; bogus characters
+              "^[\"][\"#'()]"  ; bogus characters
               )
             "\\|")
   "*A regexp to match uninteresting newsgroups in the active file.
               )
             "\\|")
   "*A regexp to match uninteresting newsgroups in the active file.
@@ -300,7 +292,9 @@ claim them."
                function
                (repeat function)))
 
                function
                (repeat function)))
 
-(defcustom gnus-subscribe-newsgroup-hooks nil
+(define-obsolete-variable-alias 'gnus-subscribe-newsgroup-hooks
+  'gnus-subscribe-newsgroup-functions "24.3")
+(defcustom gnus-subscribe-newsgroup-functions 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"
   "*Hooks run after you subscribe to a new group.
 The hooks will be called with new group's name as argument."
   :version "22.1"
@@ -341,8 +335,17 @@ hierarchy in its entirety."
   :group 'gnus-group-new
   :type 'boolean)
 
   :group 'gnus-group-new
   :type 'boolean)
 
+(defcustom gnus-auto-subscribed-categories '(mail post-mail)
+  "*New groups from methods of these categories will be subscribed automatically.
+Note that this variable only deals with new groups.  It has no
+effect whatsoever on old groups.  The default is to automatically
+subscribe all groups from mail-like backends."
+  :version "24.1"
+  :group 'gnus-group-new
+  :type '(repeat symbol))
+
 (defcustom gnus-auto-subscribed-groups
 (defcustom gnus-auto-subscribed-groups
-  "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl\\|^nnmaildir"
+  "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl\\|^nnmaildir\\|^nnimap"
   "*All new groups that match this regexp will be subscribed automatically.
 Note that this variable only deals with new groups.  It has no effect
 whatsoever on old groups.
   "*All new groups that match this regexp will be subscribed automatically.
 Note that this variable only deals with new groups.  It has no effect
 whatsoever on old groups.
@@ -393,7 +396,16 @@ This hook is called after Gnus is connected to the NNTP server."
 
 (defcustom gnus-before-startup-hook nil
   "A hook called before startup.
 
 (defcustom gnus-before-startup-hook nil
   "A hook called before startup.
-This hook is called as the first thing when Gnus is started."
+This hook is called as the first thing when Gnus is started.
+See also `gnus-before-resume-hook'."
+  :group 'gnus-start
+  :type 'hook)
+
+(defcustom gnus-before-resume-hook nil
+  "A hook called before resuming Gnus after suspend.
+This hook is called as the first thing when Gnus is resumed after a suspend.
+See also `gnus-before-startup-hook'."
+  :version "24.4"
   :group 'gnus-start
   :type 'hook)
 
   :group 'gnus-start
   :type 'hook)
 
@@ -402,8 +414,7 @@ This hook is called as the first thing when Gnus is started."
   :group 'gnus-start
   :type 'hook)
 
   :group 'gnus-start
   :type 'hook)
 
-(defcustom gnus-setup-news-hook
-  '(gnus-fixup-nnimap-unread-after-getting-new-news)
+(defcustom gnus-setup-news-hook nil
   "A hook after reading the .newsrc file, but before generating the buffer."
   :group 'gnus-start
   :type 'hook)
   "A hook after reading the .newsrc file, but before generating the buffer."
   :group 'gnus-start
   :type 'hook)
@@ -420,9 +431,9 @@ This hook is called as the first thing when Gnus is started."
   :type 'hook)
 
 (defcustom gnus-after-getting-new-news-hook
   :type 'hook)
 
 (defcustom gnus-after-getting-new-news-hook
-  '(gnus-display-time-event-handler
-    gnus-fixup-nnimap-unread-after-getting-new-news)
+  '(gnus-display-time-event-handler)
   "*A hook run after Gnus checks for new news when Gnus is already running."
   "*A hook run after Gnus checks for new news when Gnus is already running."
+  :version "24.1"
   :group 'gnus-group-new
   :type 'hook)
 
   :group 'gnus-group-new
   :type 'hook)
 
@@ -594,8 +605,7 @@ Can be used to turn version control on or off."
 (defun gnus-subscribe-hierarchically (newgroup)
   "Subscribe new NEWGROUP and insert it in hierarchical newsgroup order."
   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
 (defun gnus-subscribe-hierarchically (newgroup)
   "Subscribe new NEWGROUP and insert it in hierarchical newsgroup order."
   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
-  (save-excursion
-    (set-buffer (nnheader-find-file-noselect gnus-current-startup-file))
+  (with-current-buffer (nnheader-find-file-noselect gnus-current-startup-file)
     (prog1
        (let ((groupkey newgroup) before)
          (while (and (not before) groupkey)
     (prog1
        (let ((groupkey newgroup) before)
          (while (and (not before) groupkey)
@@ -639,8 +649,9 @@ the first newsgroup."
     (gnus-group-change-level
      newsgroup gnus-level-default-subscribed
      gnus-level-killed (gnus-group-entry (or next "dummy.group")))
     (gnus-group-change-level
      newsgroup gnus-level-default-subscribed
      gnus-level-killed (gnus-group-entry (or next "dummy.group")))
+    (gnus-request-update-group-status newsgroup 'subscribe)
     (gnus-message 5 "Subscribe newsgroup: %s" newsgroup)
     (gnus-message 5 "Subscribe newsgroup: %s" newsgroup)
-    (run-hook-with-args 'gnus-subscribe-newsgroup-hooks newsgroup)
+    (run-hook-with-args 'gnus-subscribe-newsgroup-functions newsgroup)
     t))
 
 (defun gnus-read-active-file-p ()
     t))
 
 (defun gnus-read-active-file-p ()
@@ -706,6 +717,7 @@ the first newsgroup."
        nnoo-state-alist nil
        gnus-current-select-method nil
        nnmail-split-history nil
        nnoo-state-alist nil
        gnus-current-select-method nil
        nnmail-split-history nil
+       gnus-extended-servers nil
        gnus-ephemeral-servers nil)
   (gnus-shutdown 'gnus)
   ;; Kill the startup file.
        gnus-ephemeral-servers nil)
   (gnus-shutdown 'gnus)
   ;; Kill the startup file.
@@ -747,6 +759,7 @@ prompt the user for the name of an NNTP server to use."
 
   (if (gnus-alive-p)
       (progn
 
   (if (gnus-alive-p)
       (progn
+       (gnus-run-hooks 'gnus-before-resume-hook)
        (switch-to-buffer gnus-group-buffer)
        (gnus-group-get-new-news
         (and (numberp arg)
        (switch-to-buffer gnus-group-buffer)
        (gnus-group-get-new-news
         (and (numberp arg)
@@ -763,20 +776,12 @@ prompt the user for the name of an NNTP server to use."
     ;; Add "native" to gnus-predefined-server-alist just to have a
     ;; name for the native select method.
     (when gnus-select-method
     ;; Add "native" to gnus-predefined-server-alist just to have a
     ;; name for the native select method.
     (when gnus-select-method
-      (push (cons "native" gnus-select-method)
-           gnus-predefined-server-alist))
+      (add-to-list 'gnus-predefined-server-alist
+                  (cons "native" gnus-select-method)))
 
     (if gnus-agent
        (gnus-agentize))
 
 
     (if gnus-agent
        (gnus-agentize))
 
-    (when gnus-simple-splash
-      (setq gnus-simple-splash nil)
-      (cond
-       ((featurep 'xemacs)
-       (gnus-xmas-splash))
-       (window-system
-       (gnus-x-splash))))
-
     (let ((level (and (numberp arg) (> arg 0) arg))
          did-connect)
       (unwind-protect
     (let ((level (and (numberp arg) (> arg 0) arg))
          did-connect)
       (unwind-protect
@@ -786,10 +791,9 @@ prompt the user for the name of an NNTP server to use."
                    (gnus-start-news-server (and arg (not level))))))
        (if (and (not dont-connect)
                 (not did-connect))
                    (gnus-start-news-server (and arg (not level))))))
        (if (and (not dont-connect)
                 (not did-connect))
+           ;; Couldn't connect to the server, so bail out.
            (gnus-group-quit)
          (gnus-run-hooks 'gnus-startup-hook)
            (gnus-group-quit)
          (gnus-run-hooks 'gnus-startup-hook)
-         ;; NNTP server is successfully open.
-
          ;; Find the current startup file name.
          (setq gnus-current-startup-file
                (gnus-make-newsrc-file gnus-startup-file))
          ;; Find the current startup file name.
          (setq gnus-current-startup-file
                (gnus-make-newsrc-file gnus-startup-file))
@@ -799,11 +803,10 @@ prompt the user for the name of an NNTP server to use."
            (gnus-dribble-read-file))
 
          ;; Do the actual startup.
            (gnus-dribble-read-file))
 
          ;; Do the actual startup.
-         (if gnus-agent
-             (gnus-request-create-group "queue" '(nndraft "")))
-         (gnus-request-create-group "drafts" '(nndraft ""))
          (gnus-setup-news nil level dont-connect)
          (gnus-run-hooks 'gnus-setup-news-hook)
          (gnus-setup-news nil level dont-connect)
          (gnus-run-hooks 'gnus-setup-news-hook)
+         (when gnus-agent
+           (gnus-request-create-group "queue" '(nndraft "")))
          (gnus-start-draft-setup)
          ;; Generate the group buffer.
          (gnus-group-list-groups level)
          (gnus-start-draft-setup)
          ;; Generate the group buffer.
          (gnus-group-list-groups level)
@@ -818,10 +821,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-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 "")))
+    (setcar (gnus-group-entry "nndraft:drafts") 0))
   (unless (equal (gnus-group-get-parameter "nndraft:drafts" 'gnus-dummy t)
                 '((gnus-draft-mode)))
   (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)))))
 
     (gnus-group-set-parameter
      "nndraft:drafts" 'gnus-dummy '((gnus-draft-mode)))))
 
@@ -842,13 +845,22 @@ prompt the user for the name of an NNTP server to use."
      gnus-current-startup-file)
    "-dribble"))
 
      gnus-current-startup-file)
    "-dribble"))
 
-(defun gnus-dribble-enter (string)
-  "Enter STRING into the dribble buffer."
+(defun gnus-dribble-enter (string &optional regexp)
+  "Enter STRING into the dribble buffer.
+If REGEXP is given, lines that match it will be deleted."
   (when (and (not gnus-dribble-ignore)
             gnus-dribble-buffer
             (buffer-name gnus-dribble-buffer))
     (let ((obuf (current-buffer)))
       (set-buffer gnus-dribble-buffer)
   (when (and (not gnus-dribble-ignore)
             gnus-dribble-buffer
             (buffer-name gnus-dribble-buffer))
     (let ((obuf (current-buffer)))
       (set-buffer gnus-dribble-buffer)
+      (when regexp
+       (goto-char (point-min))
+       (let (end)
+         (while (re-search-forward regexp nil t)
+           (unless (bolp) (forward-line 1))
+           (setq end (point))
+           (goto-char (match-beginning 0))
+           (delete-region (point-at-bol) end))))
       (goto-char (point-max))
       (insert string "\n")
       ;; This has been commented by Josh Huber <huber@alum.wpi.edu>
       (goto-char (point-max))
       (insert string "\n")
       ;; This has been commented by Josh Huber <huber@alum.wpi.edu>
@@ -857,8 +869,7 @@ prompt the user for the name of an NNTP server to use."
       ;; it's not needed).
       ;; (set-window-point (get-buffer-window (current-buffer)) (point-max))
       (bury-buffer gnus-dribble-buffer)
       ;; it's not needed).
       ;; (set-window-point (get-buffer-window (current-buffer)) (point-max))
       (bury-buffer gnus-dribble-buffer)
-      (save-excursion
-       (set-buffer gnus-group-buffer)
+      (with-current-buffer gnus-group-buffer
        (gnus-group-set-mode-line))
       (set-buffer obuf))))
 
        (gnus-group-set-mode-line))
       (set-buffer obuf))))
 
@@ -871,13 +882,18 @@ prompt the user for the name of an NNTP server to use."
   (let ((dribble-file (gnus-dribble-file-name)))
     (unless (file-exists-p (file-name-directory dribble-file))
       (make-directory (file-name-directory dribble-file) t))
   (let ((dribble-file (gnus-dribble-file-name)))
     (unless (file-exists-p (file-name-directory dribble-file))
       (make-directory (file-name-directory dribble-file) t))
-    (save-excursion
-      (set-buffer (setq gnus-dribble-buffer
-                       (gnus-get-buffer-create
-                        (file-name-nondirectory dribble-file))))
+    (with-current-buffer (setq gnus-dribble-buffer
+                              (gnus-get-buffer-create
+                               (file-name-nondirectory dribble-file)))
       (set (make-local-variable 'file-precious-flag) t)
       (set (make-local-variable 'file-precious-flag) t)
+      (setq buffer-save-without-query t)
       (erase-buffer)
       (setq buffer-file-name dribble-file)
       (erase-buffer)
       (setq buffer-file-name dribble-file)
+      ;; The buffer may be shrunk a lot when deleting old entries.
+      ;; It caused the auto-saving to stop.
+      (if (featurep 'emacs)
+         (set (make-local-variable 'auto-save-include-big-deletions) t)
+       (set (make-local-variable 'disable-auto-save-when-buffer-shrinks) nil))
       (auto-save-mode t)
       (buffer-disable-undo)
       (bury-buffer (current-buffer))
       (auto-save-mode t)
       (buffer-disable-undo)
       (bury-buffer (current-buffer))
@@ -923,8 +939,7 @@ prompt the user for the name of an NNTP server to use."
   (when (file-exists-p (gnus-dribble-file-name))
     (delete-file (gnus-dribble-file-name)))
   (when gnus-dribble-buffer
   (when (file-exists-p (gnus-dribble-file-name))
     (delete-file (gnus-dribble-file-name)))
   (when gnus-dribble-buffer
-    (save-excursion
-      (set-buffer gnus-dribble-buffer)
+    (with-current-buffer gnus-dribble-buffer
       (let ((auto (make-auto-save-file-name)))
        (when (file-exists-p auto)
          (delete-file auto))
       (let ((auto (make-auto-save-file-name)))
        (when (file-exists-p auto)
          (delete-file auto))
@@ -934,14 +949,13 @@ prompt the user for the name of an NNTP server to use."
 (defun gnus-dribble-save ()
   (when (and gnus-dribble-buffer
             (buffer-name gnus-dribble-buffer))
 (defun gnus-dribble-save ()
   (when (and gnus-dribble-buffer
             (buffer-name gnus-dribble-buffer))
-    (save-excursion
-      (set-buffer gnus-dribble-buffer)
-      (save-buffer))))
+    (with-current-buffer gnus-dribble-buffer
+      (when (> (buffer-size) 0)
+       (save-buffer)))))
 
 (defun gnus-dribble-clear ()
   (when (gnus-buffer-exists-p gnus-dribble-buffer)
 
 (defun gnus-dribble-clear ()
   (when (gnus-buffer-exists-p gnus-dribble-buffer)
-    (save-excursion
-      (set-buffer gnus-dribble-buffer)
+    (with-current-buffer gnus-dribble-buffer
       (erase-buffer)
       (set-buffer-modified-p nil)
       (setq buffer-saved-size (buffer-size)))))
       (erase-buffer)
       (set-buffer-modified-p nil)
       (setq buffer-saved-size (buffer-size)))))
@@ -1003,27 +1017,8 @@ If LEVEL is non-nil, the news will be set up at level LEVEL."
     (when (or (null gnus-read-active-file)
              (eq gnus-read-active-file 'some))
       (gnus-update-active-hashtb-from-killed))
     (when (or (null gnus-read-active-file)
              (eq gnus-read-active-file 'some))
       (gnus-update-active-hashtb-from-killed))
-
-    ;; Validate agent covered methods now that gnus-server-alist has
-    ;; been initialized.
-    ;; NOTE: This is here for one purpose only.  By validating the
-    ;; agentized server's, it converts the old 5.10.3, and earlier,
-    ;; format to the current format.  That enables the agent code
-    ;; within gnus-read-active-file to function correctly.
-    (if gnus-agent
-        (gnus-agent-read-servers-validate))
-
-    ;; Read the active file and create `gnus-active-hashtb'.
-    ;; If `gnus-read-active-file' is nil, then we just create an empty
-    ;; hash table.  The partial filling out of the hash table will be
-    ;; done in `gnus-get-unread-articles'.
-    (and gnus-read-active-file
-        (not level)
-        (gnus-read-active-file nil dont-connect))
-
     (unless gnus-active-hashtb
       (setq gnus-active-hashtb (gnus-make-hashtable 4096)))
     (unless gnus-active-hashtb
       (setq gnus-active-hashtb (gnus-make-hashtable 4096)))
-
     ;; Initialize the cache.
     (when gnus-use-cache
       (gnus-cache-open))
     ;; Initialize the cache.
     (when gnus-use-cache
       (gnus-cache-open))
@@ -1062,21 +1057,12 @@ If LEVEL is non-nil, the news will be set up at level LEVEL."
               (gnus-server-opened gnus-select-method))
       (gnus-check-bogus-newsgroups))
 
               (gnus-server-opened gnus-select-method))
       (gnus-check-bogus-newsgroups))
 
-    ;; We might read in new NoCeM messages here.
-    (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.
     (gnus-master-read-slave-newsrc)
 
     ;; Find the number of unread articles in each non-dead&nb