cgit.sxemacs.org Git - gnus/blob - lisp/gnus-agent.el

   1 ;;; gnus-agent.el --- unplugged support for Gnus
   2
   3 ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
   4 ;;   2005 Free Software Foundation, Inc.
   5
   6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  22 ;; Boston, MA 02110-1301, USA.
  23
  24 ;;; Commentary:
  25
  26 ;;; Code:
  27
  28 (require 'gnus)
  29 (require 'gnus-cache)
  30 (require 'nnmail)
  31 (require 'nnvirtual)
  32 (require 'gnus-sum)
  33 (require 'gnus-score)
  34 (require 'gnus-srvr)
  35 (require 'gnus-util)
  36 (eval-when-compile
  37   (if (featurep 'xemacs)
  38       (require 'itimer)
  39     (require 'timer))
  40   (require 'cl))
  41
  42 (eval-and-compile
  43   (autoload 'gnus-server-update-server "gnus-srvr")
  44   (autoload 'gnus-agent-customize-category "gnus-cus")
  45 )
  46
  47 (defcustom gnus-agent-directory (nnheader-concat gnus-directory "agent/")
  48   "Where the Gnus agent will store its files."
  49   :group 'gnus-agent
  50   :type 'directory)
  51
  52 (defcustom gnus-agent-plugged-hook nil
  53   "Hook run when plugging into the network."
  54   :group 'gnus-agent
  55   :type 'hook)
  56
  57 (defcustom gnus-agent-unplugged-hook nil
  58   "Hook run when unplugging from the network."
  59   :group 'gnus-agent
  60   :type 'hook)
  61
  62 (defcustom gnus-agent-fetched-hook nil
  63   "Hook run when finished fetching articles."
  64   :version "22.1"
  65   :group 'gnus-agent
  66   :type 'hook)
  67
  68 (defcustom gnus-agent-handle-level gnus-level-subscribed
  69   "Groups on levels higher than this variable will be ignored by the Agent."
  70   :group 'gnus-agent
  71   :type 'integer)
  72
  73 (defcustom gnus-agent-expire-days 7
  74   "Read articles older than this will be expired.
  75 If you wish to disable Agent expiring, see `gnus-agent-enable-expiration'."
  76   :group 'gnus-agent
  77   :type '(number :tag "days"))
  78
  79 (defcustom gnus-agent-expire-all nil
  80   "If non-nil, also expire unread, ticked and dormant articles.
  81 If nil, only read articles will be expired."
  82   :group 'gnus-agent
  83   :type 'boolean)
  84
  85 (defcustom gnus-agent-group-mode-hook nil
  86   "Hook run in Agent group minor modes."
  87   :group 'gnus-agent
  88   :type 'hook)
  89
  90 ;; Extracted from gnus-xmas-redefine in order to preserve user settings
  91 (when (featurep 'xemacs)
  92   (add-hook 'gnus-agent-group-mode-hook 'gnus-xmas-agent-group-menu-add))
  93
  94 (defcustom gnus-agent-summary-mode-hook nil
  95   "Hook run in Agent summary minor modes."
  96   :group 'gnus-agent
  97   :type 'hook)
  98
  99 ;; Extracted from gnus-xmas-redefine in order to preserve user settings
 100 (when (featurep 'xemacs)
 101   (add-hook 'gnus-agent-summary-mode-hook 'gnus-xmas-agent-summary-menu-add))
 102
 103 (defcustom gnus-agent-server-mode-hook nil
 104   "Hook run in Agent summary minor modes."
 105   :group 'gnus-agent
 106   :type 'hook)
 107
 108 ;; Extracted from gnus-xmas-redefine in order to preserve user settings
 109 (when (featurep 'xemacs)
 110   (add-hook 'gnus-agent-server-mode-hook 'gnus-xmas-agent-server-menu-add))
 111
 112 (defcustom gnus-agent-confirmation-function 'y-or-n-p
 113   "Function to confirm when error happens."
 114   :version "21.1"
 115   :group 'gnus-agent
 116   :type 'function)
 117
 118 (defcustom gnus-agent-synchronize-flags nil
 119   "Indicate if flags are synchronized when you plug in.
 120 If this is `ask' the hook will query the user."
 121   :version "21.1"
 122   :type '(choice (const :tag "Always" t)
 123                  (const :tag "Never" nil)
 124                  (const :tag "Ask" ask))
 125   :group 'gnus-agent)
 126
 127 (defcustom gnus-agent-go-online 'ask
 128   "Indicate if offline servers go online when you plug in.
 129 If this is `ask' the hook will query the user."
 130   :version "21.3"
 131   :type '(choice (const :tag "Always" t)
 132                  (const :tag "Never" nil)
 133                  (const :tag "Ask" ask))
 134   :group 'gnus-agent)
 135
 136 (defcustom gnus-agent-mark-unread-after-downloaded t
 137   "Indicate whether to mark articles unread after downloaded."
 138   :version "21.1"
 139   :type 'boolean
 140   :group 'gnus-agent)
 141
 142 (defcustom gnus-agent-download-marks '(download)
 143   "Marks for downloading."
 144   :version "21.1"
 145   :type '(repeat (symbol :tag "Mark"))
 146   :group 'gnus-agent)
 147
 148 (defcustom gnus-agent-consider-all-articles nil
 149   "When non-nil, the agent will let the agent predicate decide
 150 whether articles need to be downloaded or not, for all articles.  When
 151 nil, the default, the agent will only let the predicate decide
 152 whether unread articles are downloaded or not.  If you enable this,
 153 groups with large active ranges may open slower and you may also want
 154 to look into the agent expiry settings to block the expiration of
 155 read articles as they would just be downloaded again."
 156   :version "22.1"
 157   :type 'boolean
 158   :group 'gnus-agent)
 159
 160 (defcustom gnus-agent-max-fetch-size 10000000 ;; 10 Mb
 161   "Chunk size for `gnus-agent-fetch-session'.
 162 The function will split its article fetches into chunks smaller than
 163 this limit."
 164   :version "22.1"
 165   :group 'gnus-agent
 166   :type 'integer)
 167
 168 (defcustom gnus-agent-enable-expiration 'ENABLE
 169   "The default expiration state for each group.
 170 When set to ENABLE, the default, `gnus-agent-expire' will expire old
 171 contents from a group's local storage.  This value may be overridden
 172 to disable expiration in specific categories, topics, and groups.  Of
 173 course, you could change gnus-agent-enable-expiration to DISABLE then
 174 enable expiration per categories, topics, and groups."
 175   :version "22.1"
 176   :group 'gnus-agent
 177   :type '(radio (const :format "Enable " ENABLE)
 178                 (const :format "Disable " DISABLE)))
 179
 180 (defcustom gnus-agent-expire-unagentized-dirs t
 181   "*Whether expiration should expire in unagentized directories.
 182 Have gnus-agent-expire scan the directories under
 183 \(gnus-agent-directory) for groups that are no longer agentized.
 184 When found, offer to remove them."
 185   :version "22.1"
 186   :type 'boolean
 187   :group 'gnus-agent)
 188
 189 (defcustom gnus-agent-auto-agentize-methods '(nntp nnimap)
 190   "Initially, all servers from these methods are agentized.
 191 The user may remove or add servers using the Server buffer.
 192 See Info node `(gnus)Server Buffer'."
 193   :version "22.1"
 194   :type '(repeat symbol)
 195   :group 'gnus-agent)
 196
 197 (defcustom gnus-agent-queue-mail t
 198   "Whether and when outgoing mail should be queued by the agent.
 199 When `always', always queue outgoing mail.  When nil, never
 200 queue.  Otherwise, queue if and only if unplugged."
 201   :version "22.1"
 202   :group 'gnus-agent
 203   :type '(radio (const :format "Always" always)
 204                 (const :format "Never" nil)
 205                 (const :format "When plugged" t)))
 206
 207 (defcustom gnus-agent-prompt-send-queue nil
 208   "If non-nil, `gnus-group-send-queue' will prompt if called when
 209 unplugged."
 210   :version "22.1"
 211   :group 'gnus-agent
 212   :type 'boolean)
 213
 214 ;;; Internal variables
 215
 216 (defvar gnus-agent-history-buffers nil)
 217 (defvar gnus-agent-buffer-alist nil)
 218 (defvar gnus-agent-article-alist nil
 219   "An assoc list identifying the articles whose headers have been fetched.
 220 If successfully fetched, these headers will be stored in the group's overview
 221 file.  The key of each assoc pair is the article ID, the value of each assoc
 222 pair is a flag indicating whether the identified article has been downloaded
 223 \(gnus-agent-fetch-articles sets the value to the day of the download).
 224 NOTES:
 225 1) The last element of this list can not be expired as some
 226    routines (for example, get-agent-fetch-headers) use the last
 227    value to track which articles have had their headers retrieved.
 228 2) The function `gnus-agent-regenerate' may destructively modify the value.")
 229 (defvar gnus-agent-group-alist nil)
 230 (defvar gnus-category-alist nil)
 231 (defvar gnus-agent-current-history nil)
 232 (defvar gnus-agent-overview-buffer nil)
 233 (defvar gnus-category-predicate-cache nil)
 234 (defvar gnus-category-group-cache nil)
 235 (defvar gnus-agent-spam-hashtb nil)
 236 (defvar gnus-agent-file-name nil)
 237 (defvar gnus-agent-send-mail-function nil)
 238 (defvar gnus-agent-file-coding-system 'raw-text)
 239 (defvar gnus-agent-file-loading-cache nil)
 240 (defvar gnus-agent-total-fetched-hashtb nil)
 241 (defvar gnus-agent-inhibit-update-total-fetched-for nil)
 242 (defvar gnus-agent-need-update-total-fetched-for nil)
 243
 244 ;; Dynamic variables
 245 (defvar gnus-headers)
 246 (defvar gnus-score)
 247
 248 ;;;
 249 ;;; Setup
 250 ;;;
 251
 252 (defun gnus-open-agent ()
 253   (setq gnus-agent t)
 254   (gnus-agent-read-servers)
 255   (gnus-category-read)
 256   (gnus-agent-create-buffer)
 257   (add-hook 'gnus-group-mode-hook 'gnus-agent-mode)
 258   (add-hook 'gnus-summary-mode-hook 'gnus-agent-mode)
 259   (add-hook 'gnus-server-mode-hook 'gnus-agent-mode))
 260
 261 (defun gnus-agent-create-buffer ()
 262   (if (gnus-buffer-live-p gnus-agent-overview-buffer)
 263       t
 264     (setq gnus-agent-overview-buffer
 265           (gnus-get-buffer-create " *Gnus agent overview*"))
 266     (with-current-buffer gnus-agent-overview-buffer
 267       (mm-enable-multibyte))
 268     nil))
 269
 270 (gnus-add-shutdown 'gnus-close-agent 'gnus)
 271
 272 (defun gnus-close-agent ()
 273   (setq gnus-category-predicate-cache nil
 274         gnus-category-group-cache nil
 275         gnus-agent-spam-hashtb nil)
 276   (gnus-kill-buffer gnus-agent-overview-buffer))
 277
 278 ;;;
 279 ;;; Utility functions
 280 ;;;
 281
 282 (defmacro gnus-agent-with-refreshed-group (group &rest body)
 283   "Performs the body then updates the group's line in the group
 284 buffer.  Automatically blocks multiple updates due to recursion."
 285 `(prog1 (let ((gnus-agent-inhibit-update-total-fetched-for t)) ,@body)
 286      (when (and gnus-agent-need-update-total-fetched-for
 287                 (not gnus-agent-inhibit-update-total-fetched-for))
 288         (save-excursion
 289           (set-buffer gnus-group-buffer)
 290           (setq gnus-agent-need-update-total-fetched-for nil)
 291           (gnus-group-update-group ,group t)))))
 292
 293 (defun gnus-agent-read-file (file)
 294   "Load FILE and do a `read' there."
 295   (with-temp-buffer
 296     (ignore-errors
 297       (nnheader-insert-file-contents file)
 298       (goto-char (point-min))
 299       (read (current-buffer)))))
 300
 301 (defsubst gnus-agent-method ()
 302   (concat (symbol-name (car gnus-command-method)) "/"
 303           (if (equal (cadr gnus-command-method) "")
 304               "unnamed"
 305             (cadr gnus-command-method))))
 306
 307 (defsubst gnus-agent-directory ()
 308   "The name of the Gnus agent directory."
 309   (nnheader-concat gnus-agent-directory
 310                    (nnheader-translate-file-chars (gnus-agent-method)) "/"))
 311
 312 (defun gnus-agent-lib-file (file)
 313   "The full name of the Gnus agent library FILE."
 314   (expand-file-name file
 315                     (file-name-as-directory
 316                      (expand-file-name "agent.lib" (gnus-agent-directory)))))
 317
 318 (defun gnus-agent-cat-set-property (category property value)
 319   (if value
 320       (setcdr (or (assq property category)
 321               (let ((cell (cons property nil)))
 322                     (setcdr category (cons cell (cdr category)))
 323                     cell)) value)
 324     (let ((category category))
 325       (while (cond ((eq property (caadr category))
 326                     (setcdr category (cddr category))
 327                     nil)
 328                    (t
 329                     (setq category (cdr category)))))))
 330   category)
 331
 332 (eval-when-compile
 333   (defmacro gnus-agent-cat-defaccessor (name prop-name)
 334     "Define accessor and setter methods for manipulating a list of the form
 335 \(NAME (PROPERTY1 VALUE1) ... (PROPERTY_N VALUE_N)).
 336 Given the call (gnus-agent-cat-defaccessor func PROPERTY1), the list may be
 337 manipulated as follows:
 338   (func LIST): Returns VALUE1
 339   (setf (func LIST) NEW_VALUE1): Replaces VALUE1 with NEW_VALUE1."
 340     `(progn (defmacro ,name (category)
 341               (list (quote cdr) (list (quote assq)
 342                                       (quote (quote ,prop-name)) category)))
 343
 344             (define-setf-method ,name (category)
 345               (let* ((--category--temp-- (make-symbol "--category--"))
 346                      (--value--temp-- (make-symbol "--value--")))
 347                 (list (list --category--temp--) ; temporary-variables
 348                       (list category)           ; value-forms
 349                       (list --value--temp--)    ; store-variables
 350                       (let* ((category --category--temp--) ; store-form
 351                              (value --value--temp--))
 352                         (list (quote gnus-agent-cat-set-property)
 353                               category
 354                               (quote (quote ,prop-name))
 355                               value))
 356                       (list (quote ,name) --category--temp--) ; access-form
 357                       )))))
 358   )
 359
 360 (defmacro gnus-agent-cat-name (category)
 361   `(car ,category))
 362
 363 (gnus-agent-cat-defaccessor
 364  gnus-agent-cat-days-until-old             agent-days-until-old)
 365 (gnus-agent-cat-defaccessor
 366  gnus-agent-cat-enable-expiration          agent-enable-expiration)
 367 (gnus-agent-cat-defaccessor
 368  gnus-agent-cat-groups                     agent-groups)
 369 (gnus-agent-cat-defaccessor
 370  gnus-agent-cat-high-score                 agent-high-score)
 371 (gnus-agent-cat-defaccessor
 372  gnus-agent-cat-length-when-long           agent-long-article)
 373 (gnus-agent-cat-defaccessor
 374  gnus-agent-cat-length-when-short          agent-short-article)
 375 (gnus-agent-cat-defaccessor
 376  gnus-agent-cat-low-score                  agent-low-score)
 377 (gnus-agent-cat-defaccessor
 378  gnus-agent-cat-predicate                  agent-predicate)
 379 (gnus-agent-cat-defaccessor
 380  gnus-agent-cat-score-file                 agent-score)
 381 (gnus-agent-cat-defaccessor
 382  gnus-agent-cat-enable-undownloaded-faces  agent-enable-undownloaded-faces)
 383
 384
 385 ;; This form is equivalent to defsetf except that it calls make-symbol
 386 ;; whereas defsetf calls gensym (Using gensym creates a run-time
 387 ;; dependency on the CL library).
 388
 389 (eval-and-compile
 390   (define-setf-method gnus-agent-cat-groups (category)
 391     (let* ((--category--temp-- (make-symbol "--category--"))
 392            (--groups--temp-- (make-symbol "--groups--")))
 393       (list (list --category--temp--)
 394             (list category)
 395             (list --groups--temp--)
 396             (let* ((category --category--temp--)
 397                    (groups --groups--temp--))
 398               (list (quote gnus-agent-set-cat-groups) category groups))
 399             (list (quote gnus-agent-cat-groups) --category--temp--))))
 400   )
 401
 402 (defun gnus-agent-set-cat-groups (category groups)
 403   (unless (eq groups 'ignore)
 404     (let ((new-g groups)
 405           (old-g (gnus-agent-cat-groups category)))
 406       (cond ((eq new-g old-g)
 407              ;; gnus-agent-add-group is fiddling with the group
 408              ;; list. Still, Im done.
 409              nil
 410              )
 411             ((eq new-g (cdr old-g))
 412              ;; gnus-agent-add-group is fiddling with the group list
 413              (setcdr (or (assq 'agent-groups category)
 414                          (let ((cell (cons 'agent-groups nil)))
 415                            (setcdr category (cons cell (cdr category)))
 416                            cell)) new-g))
 417             (t
 418              (let ((groups groups))
 419                (while groups
 420                  (let* ((group        (pop groups))
 421                         (old-category (gnus-group-category group)))
 422                    (if (eq category old-category)
 423                        nil
 424                      (setf (gnus-agent-cat-groups old-category)
 425                            (delete group (gnus-agent-cat-groups
 426                                           old-category))))))
 427                ;; Purge cache as preceeding loop invalidated it.
 428                (setq gnus-category-group-cache nil))
 429
 430              (setcdr (or (assq 'agent-groups category)
 431                          (let ((cell (cons 'agent-groups nil)))
 432                            (setcdr category (cons cell (cdr category)))
 433                            cell)) groups))))))
 434
 435 (defsubst gnus-agent-cat-make (name &optional default-agent-predicate)
 436   (list name `(agent-predicate . ,(or default-agent-predicate 'false))))
 437
 438 ;;; Fetching setup functions.
 439
 440 (defun gnus-agent-start-fetch ()
 441   "Initialize data structures for efficient fetching."
 442   (gnus-agent-create-buffer))
 443
 444 (defun gnus-agent-stop-fetch ()
 445   "Save all data structures and clean up."
 446   (setq gnus-agent-spam-hashtb nil)
 447   (save-excursion
 448     (set-buffer nntp-server-buffer)
 449     (widen)))
 450
 451 (defmacro gnus-agent-with-fetch (&rest forms)
 452   "Do FORMS safely."
 453   `(unwind-protect
 454        (let ((gnus-agent-fetching t))
 455          (gnus-agent-start-fetch)
 456          ,@forms)
 457      (gnus-agent-stop-fetch)))
 458
 459 (put 'gnus-agent-with-fetch 'lisp-indent-function 0)
 460 (put 'gnus-agent-with-fetch 'edebug-form-spec '(body))
 461
 462 (defmacro gnus-agent-append-to-list (tail value)
 463   `(setq ,tail (setcdr ,tail (cons ,value nil))))
 464
 465 (defmacro gnus-agent-message (level &rest args)
 466   `(if (<= ,level gnus-verbose)
 467        (message ,@args)))
 468
 469 ;;;
 470 ;;; Mode infestation
 471 ;;;
 472
 473 (defvar gnus-agent-mode-hook nil
 474   "Hook run when installing agent mode.")
 475
 476 (defvar gnus-agent-mode nil)
 477 (defvar gnus-agent-mode-status '(gnus-agent-mode " Plugged"))
 478
 479 (defun gnus-agent-mode ()
 480   "Minor mode for providing a agent support in Gnus buffers."
 481   (let* ((buffer (progn (string-match "^gnus-\\(.*\\)-mode$"
 482                                       (symbol-name major-mode))
 483                         (match-string 1 (symbol-name major-mode))))
 484          (mode (intern (format "gnus-agent-%s-mode" buffer))))
 485     (set (make-local-variable 'gnus-agent-mode) t)
 486     (set mode nil)
 487     (set (make-local-variable mode) t)
 488     ;; Set up the menu.
 489     (when (gnus-visual-p 'agent-menu 'menu)
 490       (funcall (intern (format "gnus-agent-%s-make-menu-bar" buffer))))
 491     (unless (assq 'gnus-agent-mode minor-mode-alist)
 492       (push gnus-agent-mode-status minor-mode-alist))
 493     (unless (assq mode minor-mode-map-alist)
 494       (push (cons mode (symbol-value (intern (format "gnus-agent-%s-mode-map"
 495                                                      buffer))))
 496             minor-mode-map-alist))
 497     (when (eq major-mode 'gnus-group-mode)
 498       (let ((init-plugged gnus-plugged)
 499             (gnus-agent-go-online nil))
 500         ;; g-a-t-p does nothing when gnus-plugged isn't changed.
 501         ;; Therefore, make certain that the current value does not
 502         ;; match the desired initial value.
 503         (setq gnus-plugged :unknown)
 504         (gnus-agent-toggle-plugged init-plugged)))
 505     (gnus-run-hooks 'gnus-agent-mode-hook
 506                     (intern (format "gnus-agent-%s-mode-hook" buffer)))))
 507
 508 (defvar gnus-agent-group-mode-map (make-sparse-keymap))
 509 (gnus-define-keys gnus-agent-group-mode-map
 510   "Ju" gnus-agent-fetch-groups
 511   "Jc" gnus-enter-category-buffer
 512   "Jj" gnus-agent-toggle-plugged
 513   "Js" gnus-agent-fetch-session
 514   "JY" gnus-agent-synchronize-flags
 515   "JS" gnus-group-send-queue
 516   "Ja" gnus-agent-add-group
 517   "Jr" gnus-agent-remove-group
 518   "Jo" gnus-agent-toggle-group-plugged)
 519
 520 (defun gnus-agent-group-make-menu-bar ()
 521   (unless (boundp 'gnus-agent-group-menu)
 522     (easy-menu-define
 523      gnus-agent-group-menu gnus-agent-group-mode-map ""
 524      '("Agent"
 525        ["Toggle plugged" gnus-agent-toggle-plugged t]
 526        ["Toggle group plugged" gnus-agent-toggle-group-plugged t]
 527        ["List categories" gnus-enter-category-buffer t]
 528        ["Add (current) group to category" gnus-agent-add-group t]
 529        ["Remove (current) group from category" gnus-agent-remove-group t]
 530        ["Send queue" gnus-group-send-queue gnus-plugged]
 531        ("Fetch"
 532         ["All" gnus-agent-fetch-session gnus-plugged]
 533         ["Group" gnus-agent-fetch-group gnus-plugged])
 534        ["Synchronize flags" gnus-agent-synchronize-flags t]
 535        ))))
 536
 537 (defvar gnus-agent-summary-mode-map (make-sparse-keymap))
 538 (gnus-define-keys gnus-agent-summary-mode-map
 539   "Jj" gnus-agent-toggle-plugged
 540   "Ju" gnus-agent-summary-fetch-group
 541   "JS" gnus-agent-fetch-group
 542   "Js" gnus-agent-summary-fetch-series
 543   "J#" gnus-agent-mark-article
 544   "J\M-#" gnus-agent-unmark-article
 545   "@" gnus-agent-toggle-mark
 546   "Jc" gnus-agent-catchup)
 547
 548 (defun gnus-agent-summary-make-menu-bar ()
 549   (unless (boundp 'gnus-agent-summary-menu)
 550     (easy-menu-define
 551      gnus-agent-summary-menu gnus-agent-summary-mode-map ""
 552      '("Agent"
 553        ["Toggle plugged" gnus-agent-toggle-plugged t]
 554        ["Mark as downloadable" gnus-agent-mark-article t]
 555        ["Unmark as downloadable" gnus-agent-unmark-article t]
 556        ["Toggle mark" gnus-agent-toggle-mark t]
 557        ["Fetch downloadable" gnus-agent-summary-fetch-group t]
 558        ["Catchup undownloaded" gnus-agent-catchup t]))))
 559
 560 (defvar gnus-agent-server-mode-map (make-sparse-keymap))
 561 (gnus-define-keys gnus-agent-server-mode-map
 562   "Jj" gnus-agent-toggle-plugged
 563   "Ja" gnus-agent-add-server
 564   "Jr" gnus-agent-remove-server)
 565
 566 (defun gnus-agent-server-make-menu-bar ()
 567   (unless (boundp 'gnus-agent-server-menu)
 568     (easy-menu-define
 569      gnus-agent-server-menu gnus-agent-server-mode-map ""
 570      '("Agent"
 571        ["Toggle plugged" gnus-agent-toggle-plugged t]
 572        ["Add" gnus-agent-add-server t]
 573        ["Remove" gnus-agent-remove-server t]))))
 574
 575 (defun gnus-agent-make-mode-line-string (string mouse-button mouse-func)
 576   (if (and (fboundp 'propertize)
 577            (fboundp 'make-mode-line-mouse-map))
 578       (propertize string 'local-map
 579                   (make-mode-line-mouse-map mouse-button mouse-func)
 580                   'mouse-face 'mode-line-highlight)
 581     string))
 582
 583 (defun gnus-agent-toggle-plugged (set-to)
 584   "Toggle whether Gnus is unplugged or not."
 585   (interactive (list (not gnus-plugged)))
 586   (cond ((eq set-to gnus-plugged)
 587          nil)
 588         (set-to
 589          (setq gnus-plugged set-to)
 590          (gnus-run-hooks 'gnus-agent-plugged-hook)
 591          (setcar (cdr gnus-agent-mode-status)
 592                  (gnus-agent-make-mode-line-string " Plugged"
 593                                                    'mouse-2
 594                                                    'gnus-agent-toggle-plugged))
 595          (gnus-agent-go-online gnus-agent-go-online)
 596          (gnus-agent-possibly-synchronize-flags))
 597         (t
 598          (gnus-agent-close-connections)
 599          (setq gnus-plugged set-to)
 600          (gnus-run-hooks 'gnus-agent-unplugged-hook)
 601          (setcar (cdr gnus-agent-mode-status)
 602                  (gnus-agent-make-mode-line-string " Unplugged"
 603                                                    'mouse-2
 604                                                    'gnus-agent-toggle-plugged))))
 605   (set-buffer-modified-p t))
 606
 607 (defmacro gnus-agent-while-plugged (&rest body)
 608   `(let ((original-gnus-plugged gnus-plugged))
 609     (unwind-protect
 610         (progn (gnus-agent-toggle-plugged t)
 611                ,@body)
 612       (gnus-agent-toggle-plugged original-gnus-plugged))))
 613
 614 (put 'gnus-agent-while-plugged 'lisp-indent-function 0)
 615 (put 'gnus-agent-while-plugged 'edebug-form-spec '(body))
 616
 617 (defun gnus-agent-close-connections ()
 618   "Close all methods covered by the Gnus agent."
 619   (let ((methods (gnus-agent-covered-methods)))
 620     (while methods
 621       (gnus-close-server (pop methods)))))
 622
 623 ;;;###autoload
 624 (defun gnus-unplugged ()
 625   "Start Gnus unplugged."
 626   (interactive)
 627   (setq gnus-plugged nil)
 628   (gnus))
 629
 630 ;;;###autoload
 631 (defun gnus-plugged ()
 632   "Start Gnus plugged."
 633   (interactive)
 634   (setq gnus-plugged t)
 635   (gnus))
 636
 637 ;;;###autoload
 638 (defun gnus-slave-unplugged (&optional arg)
 639   "Read news as a slave unplugged."
 640   (interactive "P")
 641   (setq gnus-plugged nil)
 642   (gnus arg nil 'slave))
 643
 644 ;;;###autoload
 645 (defun gnus-agentize ()
 646   "Allow Gnus to be an offline newsreader.
 647
 648 The gnus-agentize function is now called internally by gnus when
 649 gnus-agent is set.  If you wish to avoid calling gnus-agentize,
 650 customize gnus-agent to nil.
 651
 652 This will modify the `gnus-setup-news-hook', and
 653 `message-send-mail-real-function' variables, and install the Gnus agent
 654 minor mode in all Gnus buffers."
 655   (interactive)
 656   (gnus-open-agent)
 657   (add-hook 'gnus-setup-news-hook 'gnus-agent-queue-setup)
 658   (unless gnus-agent-send-mail-function
 659     (setq gnus-agent-send-mail-function
 660           (or message-send-mail-real-function
 661               (function (lambda () (funcall message-send-mail-function))))
 662           message-send-mail-real-function 'gnus-agent-send-mail))
 663
 664   ;; If the servers file doesn't exist, auto-agentize some servers and
 665   ;; save the servers file so this auto-agentizing isn't invoked
 666   ;; again.
 667   (unless (file-exists-p (nnheader-concat gnus-agent-directory "lib/servers"))
 668     (gnus-message 3 "First time agent user, agentizing remote groups...")
 669     (mapc
 670      (lambda (server-or-method)
 671        (let ((method (gnus-server-to-method server-or-method)))
 672          (when (memq (car method)
 673                      gnus-agent-auto-agentize-methods)
 674            (push (gnus-method-to-server method)
 675                  gnus-agent-covered-methods)
 676            (setq gnus-agent-method-p-cache nil))))
 677      (cons gnus-select-method gnus-secondary-select-methods))
 678     (gnus-agent-write-servers)))
 679
 680 (defun gnus-agent-queue-setup (&optional group-name)
 681   "Make sure the queue group exists.
 682 Optional arg GROUP-NAME allows to specify another group."
 683   (unless (gnus-gethash (format "nndraft:%s" (or group-name "queue"))
 684                         gnus-newsrc-hashtb)
 685     (gnus-request-create-group (or group-name "queue") '(nndraft ""))
 686     (let ((gnus-level-default-subscribed 1))
 687       (gnus-subscribe-group (format "nndraft:%s" (or group-name "queue"))
 688                             nil '(nndraft "")))
 689     (gnus-group-set-parameter
 690      (format "nndraft:%s" (or group-name "queue"))
 691      'gnus-dummy '((gnus-draft-mode)))))
 692
 693 (defun gnus-agent-send-mail ()