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

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