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

   1 ;;; gnus-agent.el --- unplugged support for Gnus
   2
   3 ;; Copyright (C) 1997-2012  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 3 of the License, or
  11 ;; (at your option) 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.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 ;;; Commentary:
  22
  23 ;;; Code:
  24
  25 (require 'gnus)
  26 (require 'gnus-cache)
  27 (require 'nnmail)
  28 (require 'nnvirtual)
  29 (require 'gnus-sum)
  30 (require 'gnus-score)
  31 (require 'gnus-srvr)
  32 (require 'gnus-util)
  33 (eval-when-compile
  34   (if (featurep 'xemacs)
  35       (require 'itimer)
  36     (require 'timer))
  37   (require 'cl))
  38
  39 (autoload 'gnus-server-update-server "gnus-srvr")
  40 (autoload 'gnus-agent-customize-category "gnus-cus")
  41
  42 (defcustom gnus-agent-directory (nnheader-concat gnus-directory "agent/")
  43   "Where the Gnus agent will store its files."
  44   :group 'gnus-agent
  45   :type 'directory)
  46
  47 (defcustom gnus-agent-plugged-hook nil
  48   "Hook run when plugging into the network."
  49   :group 'gnus-agent
  50   :type 'hook)
  51
  52 (defcustom gnus-agent-unplugged-hook nil
  53   "Hook run when unplugging from the network."
  54   :group 'gnus-agent
  55   :type 'hook)
  56
  57 (defcustom gnus-agent-fetched-hook nil
  58   "Hook run when finished fetching articles."
  59   :version "22.1"
  60   :group 'gnus-agent
  61   :type 'hook)
  62
  63 (defcustom gnus-agent-handle-level gnus-level-subscribed
  64   "Groups on levels higher than this variable will be ignored by the Agent."
  65   :group 'gnus-agent
  66   :type 'integer)
  67
  68 (defcustom gnus-agent-expire-days 7
  69   "Read articles older than this will be expired.
  70 If you wish to disable Agent expiring, see `gnus-agent-enable-expiration'."
  71   :group 'gnus-agent
  72   :type '(number :tag "days"))
  73
  74 (defcustom gnus-agent-expire-all nil
  75   "If non-nil, also expire unread, ticked and dormant articles.
  76 If nil, only read articles will be expired."
  77   :group 'gnus-agent
  78   :type 'boolean)
  79
  80 (defcustom gnus-agent-group-mode-hook nil
  81   "Hook run in Agent group minor modes."
  82   :group 'gnus-agent
  83   :type 'hook)
  84
  85 ;; Extracted from gnus-xmas-redefine in order to preserve user settings
  86 (when (featurep 'xemacs)
  87   (add-hook 'gnus-agent-group-mode-hook 'gnus-xmas-agent-group-menu-add))
  88
  89 (defcustom gnus-agent-summary-mode-hook nil
  90   "Hook run in Agent summary minor modes."
  91   :group 'gnus-agent
  92   :type 'hook)
  93
  94 ;; Extracted from gnus-xmas-redefine in order to preserve user settings
  95 (when (featurep 'xemacs)
  96   (add-hook 'gnus-agent-summary-mode-hook 'gnus-xmas-agent-summary-menu-add))
  97
  98 (defcustom gnus-agent-server-mode-hook nil
  99   "Hook run in Agent summary minor modes."
 100   :group 'gnus-agent
 101   :type 'hook)
 102
 103 ;; Extracted from gnus-xmas-redefine in order to preserve user settings
 104 (when (featurep 'xemacs)
 105   (add-hook 'gnus-agent-server-mode-hook 'gnus-xmas-agent-server-menu-add))
 106
 107 (defcustom gnus-agent-confirmation-function 'y-or-n-p
 108   "Function to confirm when error happens."
 109   :version "21.1"
 110   :group 'gnus-agent
 111   :type 'function)
 112
 113 (defcustom gnus-agent-synchronize-flags nil
 114   "Indicate if flags are synchronized when you plug in.
 115 If this is `ask' the hook will query the user."
 116   ;; If the default switches to something else than nil, then the function
 117   ;; should be fixed not be exceedingly slow.  See 2005-09-20 ChangeLog entry.
 118   :version "21.1"
 119   :type '(choice (const :tag "Always" t)
 120                  (const :tag "Never" nil)
 121                  (const :tag "Ask" ask))
 122   :group 'gnus-agent)
 123
 124 (defcustom gnus-agent-go-online 'ask
 125   "Indicate if offline servers go online when you plug in.
 126 If this is `ask' the hook will query the user."
 127   :version "21.3"
 128   :type '(choice (const :tag "Always" t)
 129                  (const :tag "Never" nil)
 130                  (const :tag "Ask" ask))
 131   :group 'gnus-agent)
 132
 133 (defcustom gnus-agent-mark-unread-after-downloaded t
 134   "Indicate whether to mark articles unread after downloaded."
 135   :version "21.1"
 136   :type 'boolean
 137   :group 'gnus-agent)
 138
 139 (defcustom gnus-agent-download-marks '(download)
 140   "Marks for downloading."
 141   :version "21.1"
 142   :type '(repeat (symbol :tag "Mark"))
 143   :group 'gnus-agent)
 144
 145 (defcustom gnus-agent-consider-all-articles nil
 146   "When non-nil, the agent will let the agent predicate decide
 147 whether articles need to be downloaded or not, for all articles.  When
 148 nil, the default, the agent will only let the predicate decide
 149 whether unread articles are downloaded or not.  If you enable this,
 150 groups with large active ranges may open slower and you may also want
 151 to look into the agent expiry settings to block the expiration of
 152 read articles as they would just be downloaded again."
 153   :version "22.1"
 154   :type 'boolean
 155   :group 'gnus-agent)
 156
 157 (defcustom gnus-agent-max-fetch-size 10000000 ;; 10 Mb
 158   "Chunk size for `gnus-agent-fetch-session'.
 159 The function will split its article fetches into chunks smaller than
 160 this limit."
 161   :version "22.1"
 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   :version "22.1"
 173   :group 'gnus-agent
 174   :type '(radio (const :format "Enable " ENABLE)
 175                 (const :format "Disable " DISABLE)))
 176
 177 (defcustom gnus-agent-expire-unagentized-dirs t
 178   "*Whether expiration should expire in unagentized directories.
 179 Have gnus-agent-expire scan the directories under
 180 \(gnus-agent-directory) for groups that are no longer agentized.
 181 When found, offer to remove them."
 182   :version "22.1"
 183   :type 'boolean
 184   :group 'gnus-agent)
 185
 186 (defcustom gnus-agent-auto-agentize-methods nil
 187   "Initially, all servers from these methods are agentized.
 188 The user may remove or add servers using the Server buffer.
 189 See Info nodes `(gnus)Server Buffer', `(gnus)Agent Variables'."
 190   :version "22.1"
 191   :type '(repeat symbol)
 192   :group 'gnus-agent)
 193
 194 (defcustom gnus-agent-queue-mail t
 195   "Whether and when outgoing mail should be queued by the agent.
 196 When `always', always queue outgoing mail.  When nil, never
 197 queue.  Otherwise, queue if and only if unplugged."
 198   :version "22.1"
 199   :group 'gnus-agent
 200   :type '(radio (const :format "Always" always)
 201                 (const :format "Never" nil)
 202                 (const :format "When unplugged" t)))
 203
 204 (defcustom gnus-agent-prompt-send-queue nil
 205   "If non-nil, `gnus-group-send-queue' will prompt if called when unplugged."
 206   :version "22.1"
 207   :group 'gnus-agent
 208   :type 'boolean)
 209
 210 (defcustom gnus-agent-article-alist-save-format 1
 211   "Indicates whether to use compression(2), versus no
 212 compression(1), when writing agentview files.  The compressed
 213 files do save space but load times are 6-7 times higher.  A group
 214 must be opened then closed for the agentview to be updated using
 215 the new format."
 216   ;; Wouldn't symbols instead numbers be nicer?  --rsteib
 217   :version "22.1"
 218   :group 'gnus-agent
 219   :type '(radio (const :format "Compressed" 2)
 220                 (const :format "Uncompressed" 1)))
 221
 222 ;;; Internal variables
 223
 224 (defvar gnus-agent-history-buffers nil)
 225 (defvar gnus-agent-buffer-alist nil)
 226 (defvar gnus-agent-article-alist nil
 227   "An assoc list identifying the articles whose headers have been fetched.
 228 If successfully fetched, these headers will be stored in the group's overview
 229 file.  The key of each assoc pair is the article ID, the value of each assoc
 230 pair is a flag indicating whether the identified article has been downloaded
 231 \(gnus-agent-fetch-articles sets the value to the day of the download).
 232 NOTES:
 233 1) The last element of this list can not be expired as some
 234    routines (for example, get-agent-fetch-headers) use the last
 235    value to track which articles have had their headers retrieved.
 236 2) The function `gnus-agent-regenerate' may destructively modify the value.")
 237 (defvar gnus-agent-group-alist nil)
 238 (defvar gnus-category-alist nil)
 239 (defvar gnus-agent-current-history nil)
 240 (defvar gnus-agent-overview-buffer nil)
 241 (defvar gnus-category-predicate-cache nil)
 242 (defvar gnus-category-group-cache nil)
 243 (defvar gnus-agent-spam-hashtb nil)
 244 (defvar gnus-agent-file-name nil)
 245 (defvar gnus-agent-file-coding-system 'raw-text)
 246 (defvar gnus-agent-file-loading-cache nil)
 247 (defvar gnus-agent-total-fetched-hashtb nil)
 248 (defvar gnus-agent-inhibit-update-total-fetched-for nil)
 249 (defvar gnus-agent-need-update-total-fetched-for nil)
 250
 251 ;; Dynamic variables
 252 (defvar gnus-headers)
 253 (defvar gnus-score)
 254
 255 ;; Added to support XEmacs
 256 (eval-and-compile
 257   (unless (fboundp 'directory-files-and-attributes)
 258     (defun directory-files-and-attributes (directory
 259                                            &optional full match nosort)
 260       (let (result)
 261         (dolist (file (directory-files directory full match nosort))
 262           (push (cons file (file-attributes file)) result))
 263         (nreverse result)))))
 264
 265 ;;;
 266 ;;; Setup
 267 ;;;
 268
 269 (defun gnus-open-agent ()
 270   (setq gnus-agent t)
 271   (gnus-agent-read-servers)
 272   (gnus-category-read)
 273   (gnus-agent-create-buffer)
 274   (add-hook 'gnus-group-mode-hook 'gnus-agent-mode)
 275   (add-hook 'gnus-summary-mode-hook 'gnus-agent-mode)
 276   (add-hook 'gnus-server-mode-hook 'gnus-agent-mode))
 277
 278 (defun gnus-agent-create-buffer ()
 279   (if (gnus-buffer-live-p gnus-agent-overview-buffer)
 280       t
 281     (setq gnus-agent-overview-buffer
 282           (gnus-get-buffer-create " *Gnus agent overview*"))
 283     (with-current-buffer gnus-agent-overview-buffer
 284       (mm-enable-multibyte))
 285     nil))
 286
 287 (gnus-add-shutdown 'gnus-close-agent 'gnus)
 288
 289 (defun gnus-close-agent ()
 290   (setq gnus-category-predicate-cache nil
 291         gnus-category-group-cache nil
 292         gnus-agent-spam-hashtb nil)
 293   (gnus-kill-buffer gnus-agent-overview-buffer))
 294
 295 ;;;
 296 ;;; Utility functions
 297 ;;;
 298
 299 (defmacro gnus-agent-with-refreshed-group (group &rest body)
 300   "Performs the body then updates the group's line in the group
 301 buffer.  Automatically blocks multiple updates due to recursion."
 302 `(prog1 (let ((gnus-agent-inhibit-update-total-fetched-for t)) ,@body)
 303      (when (and gnus-agent-need-update-total-fetched-for
 304                 (not gnus-agent-inhibit-update-total-fetched-for))
 305         (with-current-buffer gnus-group-buffer
 306           (setq gnus-agent-need-update-total-fetched-for nil)
 307           (gnus-group-update-group ,group t)))))
 308
 309 (defun gnus-agent-read-file (file)
 310   "Load FILE and do a `read' there."
 311   (with-temp-buffer
 312     (ignore-errors
 313       (nnheader-insert-file-contents file)
 314       (goto-char (point-min))
 315       (read (current-buffer)))))
 316
 317 (defsubst gnus-agent-method ()
 318   (concat (symbol-name (car gnus-command-method)) "/"
 319           (if (equal (cadr gnus-command-method) "")
 320               "unnamed"
 321             (cadr gnus-command-method))))
 322
 323 (defsubst gnus-agent-directory ()
 324   "The name of the Gnus agent directory."
 325   (nnheader-concat gnus-agent-directory
 326                    (nnheader-translate-file-chars (gnus-agent-method)) "/"))
 327
 328 (defun gnus-agent-lib-file (file)
 329   "The full name of the Gnus agent library FILE."
 330   (expand-file-name file
 331                     (file-name-as-directory
 332                      (expand-file-name "agent.lib" (gnus-agent-directory)))))
 333
 334 (defun gnus-agent-cat-set-property (category property value)
 335   (if value
 336       (setcdr (or (assq property category)
 337               (let ((cell (cons property nil)))
 338                     (setcdr category (cons cell (cdr category)))
 339                     cell)) value)
 340     (let ((category category))
 341       (while (cond ((eq property (caadr category))
 342                     (setcdr category (cddr category))
 343                     nil)
 344                    (t
 345                     (setq category (cdr category)))))))
 346   category)
 347
 348 (eval-when-compile
 349   (defmacro gnus-agent-cat-defaccessor (name prop-name)
 350     "Define accessor and setter methods for manipulating a list of the form
 351 \(NAME (PROPERTY1 VALUE1) ... (PROPERTY_N VALUE_N)).
 352 Given the call (gnus-agent-cat-defaccessor func PROPERTY1), the list may be
 353 manipulated as follows:
 354   (func LIST): Returns VALUE1
 355   (setf (func LIST) NEW_VALUE1): Replaces VALUE1 with NEW_VALUE1."
 356     `(progn (defmacro ,name (category)
 357               (list (quote cdr) (list (quote assq)
 358                                       (quote (quote ,prop-name)) category)))
 359
 360             (define-setf-method ,name (category)
 361               (let* ((--category--temp-- (make-symbol "--category--"))
 362                      (--value--temp-- (make-symbol "--value--")))
 363                 (list (list --category--temp--) ; temporary-variables
 364                       (list category)           ; value-forms
 365                       (list --value--temp--)    ; store-variables
 366                       (let* ((category --category--temp--) ; store-form
 367                              (value --value--temp--))
 368                         (list (quote gnus-agent-cat-set-property)
 369                               category
 370                               (quote (quote ,prop-name))
 371                               value))
 372                       (list (quote ,name) --category--temp--) ; access-form
 373                       )))))
 374   )
 375
 376 (defmacro gnus-agent-cat-name (category)
 377   `(car ,category))
 378
 379 (gnus-agent-cat-defaccessor
 380  gnus-agent-cat-days-until-old             agent-days-until-old)
 381 (gnus-agent-cat-defaccessor
 382  gnus-agent-cat-enable-expiration          agent-enable-expiration)
 383 (gnus-agent-cat-defaccessor
 384  gnus-agent-cat-groups                     agent-groups)
 385 (gnus-agent-cat-defaccessor
 386  gnus-agent-cat-high-score                 agent-high-score)
 387 (gnus-agent-cat-defaccessor
 388  gnus-agent-cat-length-when-long           agent-long-article)
 389 (gnus-agent-cat-defaccessor
 390  gnus-agent-cat-length-when-short          agent-short-article)
 391 (gnus-agent-cat-defaccessor
 392  gnus-agent-cat-low-score                  agent-low-score)
 393 (gnus-agent-cat-defaccessor
 394  gnus-agent-cat-predicate                  agent-predicate)
 395 (gnus-agent-cat-defaccessor
 396  gnus-agent-cat-score-file                 agent-score)
 397 (gnus-agent-cat-defaccessor
 398  gnus-agent-cat-enable-undownloaded-faces  agent-enable-undownloaded-faces)
 399
 400
 401 ;; This form is equivalent to defsetf except that it calls make-symbol
 402 ;; whereas defsetf calls gensym (Using gensym creates a run-time
 403 ;; dependency on the CL library).
 404
 405 (eval-and-compile
 406   (define-setf-method gnus-agent-cat-groups (category)
 407     (let* ((--category--temp-- (make-symbol "--category--"))
 408            (--groups--temp-- (make-symbol "--groups--")))
 409       (list (list --category--temp--)
 410             (list category)
 411             (list --groups--temp--)
 412             (let* ((category --category--temp--)
 413                    (groups --groups--temp--))
 414               (list (quote gnus-agent-set-cat-groups) category groups))
 415             (list (quote gnus-agent-cat-groups) --category--temp--))))
 416   )
 417
 418 (defun gnus-agent-set-cat-groups (category groups)
 419   (unless (eq groups 'ignore)
 420     (let ((new-g groups)
 421           (old-g (gnus-agent-cat-groups category)))
 422       (cond ((eq new-g old-g)
 423              ;; gnus-agent-add-group is fiddling with the group
 424              ;; list. Still, Im done.
 425              nil
 426              )
 427             ((eq new-g (cdr old-g))
 428              ;; gnus-agent-add-group is fiddling with the group list
 429              (setcdr (or (assq 'agent-groups category)
 430                          (let ((cell (cons 'agent-groups nil)))
 431                            (setcdr category (cons cell (cdr category)))
 432                            cell)) new-g))
 433             (t
 434              (let ((groups groups))
 435                (while groups
 436                  (let* ((group        (pop groups))
 437                         (old-category (gnus-group-category group)))
 438                    (if (eq category old-category)
 439                        nil
 440                      (setf (gnus-agent-cat-groups old-category)
 441                            (delete group (gnus-agent-cat-groups
 442                                           old-category))))))
 443                ;; Purge cache as preceding loop invalidated it.
 444                (setq gnus-category-group-cache nil))
 445
 446              (setcdr (or (assq 'agent-groups category)
 447                          (let ((cell (cons 'agent-groups nil)))
 448                            (setcdr category (cons cell (cdr category)))
 449                            cell)) groups))))))
 450
 451 (defsubst gnus-agent-cat-make (name &optional default-agent-predicate)
 452   (list name `(agent-predicate . ,(or default-agent-predicate 'false))))
 453
 454 (defun gnus-agent-read-group ()
 455   "Read a group name in the minibuffer, with completion."
 456   (let ((def (or (gnus-group-group-name) gnus-newsgroup-name)))
 457     (when def
 458       (setq def (gnus-group-decoded-name def)))
 459     (gnus-group-completing-read nil nil t nil nil def)))
 460
 461 ;;; Fetching setup functions.
 462
 463 (defun gnus-agent-start-fetch ()
 464   "Initialize data structures for efficient fetching."
 465   (gnus-agent-create-buffer))
 466
 467 (defun gnus-agent-stop-fetch ()
 468   "Save all data structures and clean up."
 469   (setq gnus-agent-spam-hashtb nil)
 470   (with-current-buffer nntp-server-buffer
 471     (widen)))
 472
 473 (defmacro gnus-agent-with-fetch (&rest forms)
 474   "Do FORMS safely."
 475   `(unwind-protect
 476        (let ((gnus-agent-fetching t))
 477          (gnus-agent-start-fetch)
 478          ,@forms)
 479      (gnus-agent-stop-fetch)))
 480
 481 (put 'gnus-agent-with-fetch 'lisp-indent-function 0)
 482 (put 'gnus-agent-with-fetch 'edebug-form-spec '(body))
 483
 484 (defmacro gnus-agent-append-to-list (tail value)
 485   `(setq ,tail (setcdr ,tail (cons ,value nil))))
 486
 487 (defmacro gnus-agent-message (level &rest args)
 488   `(if (<= ,level gnus-verbose)
 489        (message ,@args)))
 490
 491 ;;;
 492 ;;; Mode infestation
 493 ;;;
 494
 495 (defvar gnus-agent-mode-hook nil
 496   "Hook run when installing agent mode.")
 497
 498 (defvar gnus-agent-mode nil)
 499 (defvar gnus-agent-mode-status '(gnus-agent-mode " Plugged"))
 500
 501 (defun gnus-agent-mode ()
 502   "Minor mode for providing a agent support in Gnus buffers."
 503   (let* ((buffer (progn (string-match "^gnus-\\(.*\\)-mode$"
 504                                       (symbol-name major-mode))
 505                         (match-string 1 (symbol-name major-mode))))
 506          (mode (intern (format "gnus-agent-%s-mode" buffer))))
 507     (set (make-local-variable 'gnus-agent-mode) t)
 508     (set mode nil)
 509     (set (make-local-variable mode) t)
 510     ;; Set up the menu.
 511     (when (gnus-visual-p 'agent-menu 'menu)
 512       (funcall (intern (format "gnus-agent-%s-make-menu-bar" buffer))))
 513     (unless (assq mode minor-mode-alist)
 514       (push (cons mode (cdr gnus-agent-mode-status)) minor-mode-alist))
 515     (unless (assq mode minor-mode-map-alist)
 516       (push (cons mode (symbol-value (intern (format "gnus-agent-%s-mode-map"
 517                                                      buffer))))
 518             minor-mode-map-alist))
 519     (when (eq major-mode 'gnus-group-mode)
 520       (let ((init-plugged gnus-plugged)
 521             (gnus-agent-go-online nil))
 522         ;; g-a-t-p does nothing when gnus-plugged isn't changed.
 523         ;; Therefore, make certain that the current value does not
 524         ;; match the desired initial value.
 525         (setq gnus-plugged :unknown)
 526         (gnus-agent-toggle-plugged init-plugged)))
 527     (gnus-run-hooks 'gnus-agent-mode-hook
 528                     (intern (format "gnus-agent-%s-mode-hook" buffer)))))
 529
 530 (defvar gnus-agent-group-mode-map (make-sparse-keymap))
 531 (gnus-define-keys gnus-agent-group-mode-map
 532   "Ju" gnus-agent-fetch-groups
 533   "Jc" gnus-enter-category-buffer
 534   "Jj" gnus-agent-toggle-plugged
 535   "Js" gnus-agent-fetch-session
 536   "JY" gnus-agent-synchronize-flags
 537   "JS" gnus-group-send-queue
 538   "Ja" gnus-agent-add-group
 539   "Jr" gnus-agent-remove-group
 540   "Jo" gnus-agent-toggle-group-plugged)
 541
 542 (defun gnus-agent-group-make-menu-bar ()
 543   (unless (boundp 'gnus-agent-group-menu)
 544     (easy-menu-define
 545      gnus-agent-group-menu gnus-agent-group-mode-map ""
 546      '("Agent"
 547        ["Toggle plugged" gnus-agent-toggle-plugged t]
 548        ["Toggle group plugged" gnus-agent-toggle-group-plugged t]
 549        ["List categories" gnus-enter-category-buffer t]
 550        ["Add (current) group to category" gnus-agent-add-group t]
 551        ["Remove (current) group from category" gnus-agent-remove-group t]
 552        ["Send queue" gnus-group-send-queue gnus-plugged]
 553        ("Fetch"
 554         ["All" gnus-agent-fetch-session gnus-plugged]
 555         ["Group" gnus-agent-fetch-group gnus-plugged])
 556        ["Synchronize flags" gnus-agent-synchronize-flags t]
 557        ))))
 558
 559 (defvar gnus-agent-summary-mode-map (make-sparse-keymap))
 560 (gnus-define-keys gnus-agent-summary-mode-map
 561   "Jj" gnus-agent-toggle-plugged
 562   "Ju" gnus-agent-summary-fetch-group
 563   "JS" gnus-agent-fetch-group
 564   "Js" gnus-agent-summary-fetch-series
 565   "J#" gnus-agent-mark-article
 566   "J\M-#" gnus-agent-unmark-article
 567   "@" gnus-agent-toggle-mark
 568   "Jc" gnus-agent-catchup)
 569
 570 (defun gnus-agent-summary-make-menu-bar ()
 571   (unless (boundp 'gnus-agent-summary-menu)
 572     (easy-menu-define
 573      gnus-agent-summary-menu gnus-agent-summary-mode-map ""
 574      '("Agent"
 575        ["Toggle plugged" gnus-agent-toggle-plugged t]
 576        ["Mark as downloadable" gnus-agent-mark-article t]
 577        ["Unmark as downloadable" gnus-agent-unmark-article t]
 578        ["Toggle mark" gnus-agent-toggle-mark t]
 579        ["Fetch downloadable" gnus-agent-summary-fetch-group t]
 580        ["Catchup undownloaded" gnus-agent-catchup t]))))
 581
 582 (defvar gnus-agent-server-mode-map (make-sparse-keymap))
 583 (gnus-define-keys gnus-agent-server-mode-map
 584   "Jj" gnus-agent-toggle-plugged
 585   "Ja" gnus-agent-add-server
 586   "Jr" gnus-agent-remove-server)
 587
 588 (defun gnus-agent-server-make-menu-bar ()
 589   (unless (boundp 'gnus-agent-server-menu)
 590     (easy-menu-define
 591      gnus-agent-server-menu gnus-agent-server-mode-map ""
 592      '("Agent"
 593        ["Toggle plugged" gnus-agent-toggle-plugged t]
 594        ["Add" gnus-agent-add-server t]
 595        ["Remove" gnus-agent-remove-server t]))))
 596
 597 (defun gnus-agent-make-mode-line-string (string mouse-button mouse-func)
 598   (if (and (fboundp 'propertize)
 599            (fboundp 'make-mode-line-mouse-map))
 600       (propertize string 'local-map
 601                   (make-mode-line-mouse-map mouse-button mouse-func)
 602                   'mouse-face
 603                   (if (and (featurep 'xemacs)
 604                            ;; XEmacs' `facep' only checks for a face
 605                            ;; object, not for a face name, so it's useless
 606                            ;; to check with `facep'.
 607                            (find-face 'modeline))
 608                       'modeline
 609                     'mode-line-highlight))
 610     string))
 611
 612 (defun gnus-agent-toggle-plugged (set-to)
 613   "Toggle whether Gnus is unplugged or not."
 614   (interactive (list (not gnus-plugged)))
 615   (cond ((eq set-to gnus-plugged)
 616          nil)
 617         (set-to
 618          (setq gnus-plugged set-to)
 619          (gnus-run-hooks 'gnus-agent-plugged-hook)
 620          (setcar (cdr gnus-agent-mode-status)
 621                  (gnus-agent-make-mode-line-string " Plugged"
 622                                                    'mouse-2
 623                                                    'gnus-agent-toggle-plugged))
 624          (gnus-agent-go-online gnus-agent-go-online))
 625         (t
 626          (gnus-agent-close-connections)
 627          (setq gnus-plugged set-to)
 628          (gnus-run-hooks 'gnus-agent-unplugged-hook)
 629          (setcar (cdr gnus-agent-mode-status)
 630                  (gnus-agent-make-mode-line-string " Unplugged"
 631                                                    'mouse-2
 632                                                    'gnus-agent-toggle-plugged))))
 633   (set-buffer-modified-p t))
 634
 635 (defmacro gnus-agent-while-plugged (&rest body)
 636   `(let ((original-gnus-plugged gnus-plugged))
 637     (unwind-protect
 638         (progn (gnus-agent-toggle-plugged t)
 639                ,@body)
 640       (gnus-agent-toggle-plugged original-gnus-plugged))))
 641
 642 (put 'gnus-agent-while-plugged 'lisp-indent-function 0)
 643 (put 'gnus-agent-while-plugged 'edebug-form-spec '(body))
 644
 645 (defun gnus-agent-close-connections ()
 646   "Close all methods covered by the Gnus agent."
 647   (let ((methods (gnus-agent-covered-methods)))
 648     (while methods
 649       (gnus-close-server (pop methods)))))
 650
 651 ;;;###autoload
 652 (defun gnus-unplugged ()
 653   "Start Gnus unplugged."
 654   (interactive)
 655   (setq gnus-plugged nil)
 656   (gnus))
 657
 658 ;;;###autoload
 659 (defun gnus-plugged ()
 660   "Start Gnus plugged."
 661   (interactive)
 662   (setq gnus-plugged t)
 663   (gnus))
 664
 665 ;;;###autoload
 666 (defun gnus-slave-unplugged (&optional arg)
 667   "Read news as a slave unplugged."
 668   (interactive "P")
 669   (setq gnus-plugged nil)
 670   (gnus arg nil 'slave))
 671
 672 ;;;###autoload
 673 (defun gnus-agentize ()
 674   "Allow Gnus to be an offline newsreader.
 675
 676 The gnus-agentize function is now called internally by gnus when
 677 gnus-agent is set.  If you wish to avoid calling gnus-agentize,
 678 customize gnus-agent to nil.
 679
 680 This will modify the `gnus-setup-news-hook', and
 681 `message-send-mail-real-function' variables, and install the Gnus agent
 682 minor mode in all Gnus buffers."
 683   (interactive)
 684   (gnus-open-agent)
 685   (setq message-send-mail-real-function 'gnus-agent-send-mail)
 686
 687   ;; If the servers file doesn't exist, auto-agentize some servers and
 688   ;; save the servers file so this auto-agentizing isn't invoked
 689   ;; again.
 690   (when (and (not (file-exists-p (nnheader-concat
 691                                   gnus-agent-directory "lib/servers")))
 692              gnus-agent-auto-agentize-methods)
 693     (gnus-message 3 "First time agent user, agentizing remote groups...")
 694     (mapc
 695      (lambda (server-or-method)
 696        (let ((method (gnus-server-to-method server-or-method)))
 697          (when (memq (car method)
 698                      gnus-agent-auto-agentize-methods)
 699            (push (gnus-method-to-server method)
 700                  gnus-agent-covered-methods)
 701            (setq gnus-agent-method-p-cache nil))))
 702      (cons gnus-select-method gnus-secondary-select-methods))
 703     (gnus-agent-write-servers)))
 704
 705 (defun gnus-agent-queue-setup (&optional group-name)
 706   "Make sure the queue group exists.
 707 Optional arg GROUP-NAME allows to specify another group."
 708   (unless (gnus-gethash (format "nndraft:%s" (or group-name "queue"))
 709                         gnus-newsrc-hashtb)
 710     (gnus-request-create-group (or group-name "queue") '(nndraft ""))
 711     (let ((gnus-level-default-subscribed 1))
 712       (gnus-subscribe-group (format "nndraft:%s" (or group-name "queue"))
 713                             nil '(nndraft "")))
 714     (gnus-group-set-parameter
 715      (format "nndraft:%s" (or group-name "queue"))
 716      'gnus-dummy '((gnus-draft-mode)))))
 717
 718 (defun gnus-agent-send-mail ()
 719   (if (or (not gnus-agent-queue-mail)
 720           (and gnus-plugged (not (eq gnus-agent-queue-mail 'always))))
 721       (message-multi-smtp-send-mail)
 722     (goto-char (point-min))
 723     (re-search-forward
 724      (concat "^" (regexp-quote mail-header-separator) "\n"))
 725     (replace-match "\n")
 726     (gnus-agent-insert-meta-information 'mail)
 727     (gnus-request-accept-article "nndraft:queue" nil t t)
 728     (gnus-group-refresh-group "nndraft:queue")))
 729
 730 (defun gnus-agent-insert-meta-information (type &optional method)
 731   "Insert meta-information into the message that says how it's to be posted.
 732 TYPE can be either `mail' or `news'.  If the latter, then METHOD can
 733 be a select method."
 734   (save-excursion
 735     (message-remove-header gnus-agent-meta-information-header)
 736     (goto-char (point-min))
 737     (insert gnus-agent-meta-information-header ": "
 738             (symbol-name type) " " (format "%S" method)
 739             "\n")
 740     (forward-char -1)
 741     (while (search-backward "\n" nil t)
 742       (replace-match "\\n" t t))))
 743
 744 (defun gnus-agent-restore-gcc ()
 745   "Restore GCC field from saved header."
 746   (save-excursion
 747     (goto-char (point-min))
 748     (while (re-search-forward
 749             (concat "^" (regexp-quote gnus-agent-gcc-header) ":") nil t)
 750       (replace-match "Gcc:" 'fixedcase))))
 751
 752 (defun gnus-agent-any-covered-gcc ()
 753   (save-restriction
 754     (message-narrow-to-headers)
 755     (let* ((gcc (mail-fetch-field "gcc" nil t))
 756            (methods (and gcc
 757                          (mapcar 'gnus-inews-group-method
 758                                  (message-unquote-tokens
 759                                   (message-tokenize-header
 760                                    gcc " ,")))))
 761            covered)
 762       (while (and (not covered) methods)
 763         (setq covered (gnus-agent-method-p (car methods))
 764               methods (cdr methods)))
 765       covered)))
 766
 767 ;;;###autoload
 768 (defun gnus-agent-possibly-save-gcc ()
 769   "Save GCC if Gnus is unplugged."
 770   (when (and (not gnus-plugged) (gnus-agent-any-covered-gcc))
 771     (save-excursion
 772       (goto-char (point-min))
 773       (let ((case-fold-search t))
 774         (while (re-search-forward "^gcc:" nil t)
 775           (replace-match (concat gnus-agent-gcc-header ":") 'fixedcase))))))
 776
 777 (defun gnus-agent-possibly-do-gcc ()
 778   "Do GCC if Gnus is plugged."
 779   (when (or gnus-plugged (not (gnus-agent-any-covered-gcc)))
 780     (gnus-inews-do-gcc)))
 781
 782 ;;;
 783 ;;; Group mode commands
 784 ;;;
 785
 786 (defun gnus-agent-fetch-groups (n)
 787   "Put all new articles in the current groups into the Agent."
 788   (interactive "P")
 789   (unless gnus-plugged
 790     (error "Groups can't be fetched when Gnus is unplugged"))
 791   (gnus-group-iterate n 'gnus-agent-fetch-group))
 792
 793 (defun gnus-agent-fetch-group (&optional group)
 794   "Put all new articles in GROUP into the Agent."
 795   (interactive (list (gnus-group-group-name)))
 796   (setq group (or group gnus-newsgroup-name))
 797   (unless group
 798     (error "No group on the current line"))
 799   (if (not (gnus-agent-group-covered-p group))
 800       (message "%s isn't covered by the agent" group)
 801     (gnus-agent-while-plugged
 802       (let ((gnus-command-method (gnus-find-method-for-group group)))
 803         (gnus-agent-with-fetch
 804           (gnus-agent-fetch-group-1 group gnus-command-method)
 805           (gnus-message 5 "Fetching %s...done" group))))))
 806
 807 (defun gnus-agent-add-group (category arg)
 808   "Add the current group to an agent category."
 809   (interactive
 810    (list
 811     (intern
 812      (gnus-completing-read
 813       "Add to category"
 814       (mapcar (lambda (cat) (symbol-name (car cat)))
 815               gnus-category-alist)
 816       t))
 817     current-prefix-arg))
 818   (let ((cat (assq category gnus-category-alist))
 819         c groups)
 820     (gnus-group-iterate arg
 821       (lambda (group)
 822         (when (gnus-agent-cat-groups (setq c (gnus-group-category group)))
 823           (setf (gnus-agent-cat-groups c)
 824                 (delete group (gnus-agent-cat-groups c))))
 825         (push group groups)))
 826     (setf (gnus-agent-cat-groups cat)
 827           (nconc (gnus-agent-cat-groups cat) groups))
 828     (gnus-category-write)))
 829
 830 (defun gnus-agent-remove-group (arg)
 831   "Remove the current group from its agent category, if any."
 832   (interactive "P")
 833   (let (c)
 834     (gnus-group-iterate arg
 835       (lambda (group)
 836         (when (gnus-agent-cat-groups (setq c (gnus-group-category group)))
 837           (setf (gnus-agent-cat-groups c)
 838                 (delete group (gnus-agent-cat-groups c))))))
 839     (gnus-category-write)))
 840
 841 (defun gnus-agent-synchronize-flags ()
 842   "Synchronize unplugged flags with servers."
 843   (interactive)
 844   (save-excursion
 845     (dolist (gnus-command-method (gnus-agent-covered-methods))
 846       (when (file-exists-p (gnus-agent-lib-file "flags"))
 847         (gnus-agent-synchronize-flags-server gnus-command-method)))))
 848
 849 (defun gnus-agent-possibly-synchronize-flags ()
 850   "Synchronize flags according to `gnus-agent-synchronize-flags'."
 851   (interactive)
 852   (save-excursion
 853     (dolist (gnus-command-method (gnus-agent-covered-methods))
 854       (when (eq (gnus-server-status gnus-command-method) 'ok)
 855         (gnus-agent-possibly-synchronize-flags-server gnus-command-method)))))
 856
 857 (defun gnus-agent-synchronize-flags-server (method)
 858   "Synchronize flags set when unplugged for server."
 859   (let ((gnus-command-method method)
 860         (gnus-agent nil))
 861     (when (file-exists-p (gnus-agent-lib-file "flags"))
 862       (set-buffer (get-buffer-create " *Gnus Agent flag synchronize*"))
 863       (erase-buffer)
 864       (nnheader-insert-file-contents (gnus-agent-lib-file "flags"))
 865       (cond ((null gnus-plugged)
 866              (gnus-message
 867               1 "You must be plugged to synchronize flags with server %s"
 868               (nth 1 gnus-command-method)))
 869             ((null (gnus-check-server gnus-command-method))
 870              (gnus-message
 871               1 "Couldn't open server %s" (nth 1 gnus-command-method)))
 872             (t
 873              (condition-case err
 874                  (while t
 875                    (let ((bgn (point)))
 876                      (eval (read (current-buffer)))
 877                      (delete-region bgn (point))))
 878                (end-of-file
 879                 (delete-file (gnus-agent-lib-file "flags")))
 880                (error
 881                 (let ((file (gnus-agent-lib-file "flags")))
 882                   (write-region (point-min) (point-max)
 883                                 (gnus-agent-lib-file "flags") nil 'silent)
 884                   (error "Couldn't set flags from file %s due to %s"
 885                          file (error-message-string err)))))))
 886       (kill-buffer nil))))
 887
 888 (defun gnus-agent-possibly-synchronize-flags-server (method)
 889   "Synchronize flags for server according to `gnus-agent-synchronize-flags'."
 890   (when (and (file-exists-p (gnus-agent-lib-file "flags"))
 891              (or (and gnus-agent-synchronize-flags
 892                       (not (eq gnus-agent-synchronize-flags 'ask)))
 893                  (and (eq gnus-agent-synchronize-flags 'ask)
 894                       (gnus-y-or-n-p
 895                        (format "Synchronize flags on server `%s'? "
 896                                (cadr method))))))
 897     (gnus-agent-synchronize-flags-server method)))
 898
 899 ;;;###autoload
 900 (defun gnus-agent-rename-group (old-group new-group)
 901   "Rename fully-qualified OLD-GROUP as NEW-GROUP.
 902 Always updates the agent, even when disabled, as the old agent
 903 files would corrupt gnus when the agent was next enabled.
 904 Depends upon the caller to determine whether group renaming is
 905 supported."
 906   (let* ((old-command-method (gnus-find-method-for-group old-group))
 907          (old-path           (directory-file-name
 908                               (let (gnus-command-method old-command-method)
 909                                 (gnus-agent-group-pathname old-group))))
 910          (new-command-method (gnus-find-method-for-group new-group))
 911          (new-path           (directory-file-name
 912                               (let (gnus-command-method new-command-method)
 913                                 (gnus-agent-group-pathname new-group))))
 914          (file-name-coding-system nnmail-pathname-coding-system))
 915     (gnus-rename-file old-path new-path t)
 916
 917     (let* ((old-real-group (gnus-group-real-name old-group))
 918            (new-real-group (gnus-group-real-name new-group))
 919            (old-active (gnus-agent-get-group-info old-command-method old-real-group)))
 920       (gnus-agent-save-group-info old-command-method old-real-group nil)
 921       (gnus-agent-save-group-info new-command-method new-real-group old-active)
 922
 923       (let ((old-local (gnus-agent-get-local old-group
 924                                              old-real-group old-command-method)))
 925         (gnus-agent-set-local old-group
 926                               nil nil
 927                               old-real-group old-command-method)
 928         (gnus-agent-set-local new-group
 929                               (car old-local) (cdr old-local)
 930                               new-real-group new-command-method)))))
 931
 932 ;;;###autoload
 933 (defun gnus-agent-delete-group (group)
 934   "Delete fully-qualified GROUP.
 935 Always updates the agent, even when disabled, as the old agent
 936 files would corrupt gnus when the agent was next enabled.
 937 Depends upon the caller to determine whether group deletion is
 938 supported."
 939   (let* ((command-method (gnus-find-method-for-group group))
 940          (path           (directory-file-name
 941                           (let (gnus-command-method command-method)
 942                             (gnus-agent-group-pathname group))))
 943          (file-name-coding-system nnmail-pathname-coding-system))
 944     (gnus-delete-directory path)
 945
 946     (let* ((real-group (gnus-group-real-name group)))
 947       (gnus-agent-save-group-info command-method real-group nil)
 948
 949       (let ((local (gnus-agent-get-local group
 950                                          real-group command-method)))
 951         (gnus-agent-set-local group
 952                               nil nil
 953                               real-group command-method)))))
 954
 955 ;;;
 956 ;;; Server mode commands
 957 ;;;
 958
 959 (defun gnus-agent-add-server ()
 960   "Enroll SERVER in the agent program."
 961   (interactive)
 962   (let* ((server       (gnus-server-server-name))
 963          (named-server (gnus-server-named-server))
 964          (method       (and server
 965                             (gnus-server-get-method nil server))))
 966     (unless server
 967       (error "No server on the current line"))
 968
 969     (when (gnus-agent-method-p method)
 970       (error "Server already in the agent program"))
 971
 972     (push named-server gnus-agent-covered-methods)
 973
 974     (setq gnus-agent-method-p-cache nil)
 975     (gnus-server-update-server server)
 976     (gnus-agent-write-servers)
 977     (gnus-message 1 "Entered %s into the Agent" server)))
 978
 979 (defun gnus-agent-remove-server ()
 980   "Remove SERVER from the agent program."
 981   (interactive)
 982   (let* ((server       (gnus-server-server-name))
 983          (named-server (gnus-server-named-server)))
 984     (unless server
 985       (error "No server on the current line"))
 986
 987     (unless (member named-server gnus-agent-covered-methods)
 988       (error "Server not in the agent program"))
 989
 990     (setq gnus-agent-covered-methods
 991           (delete named-server gnus-agent-covered-methods)
 992           gnus-agent-method-p-cache nil)
 993
 994     (gnus-server-update-server server)
 995     (gnus-agent-write-servers)
 996     (gnus-message 1 "Removed %s from the agent" server)))
 997
 998 (defun gnus-agent-read-servers ()
 999   "Read the alist of covered servers."
1000   (setq gnus-agent-covered-methods
1001         (gnus-agent-read-file
1002          (nnheader-concat gnus-agent-directory "lib/servers"))
1003         gnus-agent-method-p-cache nil)
1004
1005   ;; I am called so early in start-up that I can not validate server
1006   ;; names.  When that is the case, I skip the validation.  That is
1007   ;; alright as the gnus startup code calls the validate methods
1008   ;; directly.
1009   (if gnus-server-alist
1010       (gnus-agent-read-servers-validate)))
1011
1012 (defun gnus-agent-read-servers-validate ()
1013   (mapcar (lambda (server-or-method)
1014             (let* ((server (if (stringp server-or-method)
1015                                server-or-method
1016                              (gnus-method-to-server server-or-method)))
1017                    (method (gnus-server-to-method server)))
1018               (if method
1019                   (unless (member server gnus-agent-covered-methods)
1020                     (push server gnus-agent-covered-methods)
1021                     (setq gnus-agent-method-p-cache nil))
1022                 (gnus-message 8 "Ignoring disappeared server `%s'" server))))
1023           (prog1 gnus-agent-covered-methods
1024             (setq gnus-agent-covered-methods nil))))
1025
1026 (defun gnus-agent-read-servers-validate-native (native-method)
1027   (setq gnus-agent-covered-methods
1028         (mapcar (lambda (method)
1029                   (if (or (not method)
1030                           (equal method native-method))
1031                       "native"
1032                     method)) gnus-agent-covered-methods)))
1033
1034 (defun gnus-agent-write-servers ()
1035   "Write the alist of covered servers."
1036   (gnus-make-directory (nnheader-concat gnus-agent-directory "lib"))
1037   (let ((coding-system-for-write nnheader-file-coding-system)
1038         (file-name-coding-system nnmail-pathname-coding-system))
1039     (with-temp-file (nnheader-concat gnus-agent-directory "lib/servers")
1040       (prin1 gnus-agent-covered-methods
1041              (current-buffer)))))
1042
1043 ;;;
1044 ;;; Summary commands
1045 ;;;
1046
1047 (defun gnus-agent-mark-article (n &optional unmark)
1048   "Mark the next N articles as downloadable.
1049 If N is negative, mark backward instead.  If UNMARK is non-nil, remove
1050 the mark instead.  The difference between N and the actual number of
1051 articles marked is returned."
1052   (interactive "p")
1053   (let ((backward (< n 0))
1054         (n (abs n)))
1055     (while (and
1056             (> n 0)
1057             (progn
1058               (gnus-summary-set-agent-mark
1059                (gnus-summary-article-number) unmark)
1060               (zerop (gnus-summary-next-subject (if backward -1 1) nil t))))
1061       (setq n (1- n)))
1062     (when (/= 0 n)
1063       (gnus-message 7 "No more articles"))
1064     (gnus-summary-recenter)
1065     (gnus-summary-position-point)
1066     n))
1067
1068 (defun gnus-agent-unmark-article (n)
1069   "Remove the downloadable mark from the next N articles.
1070 If N is negative, unmark backward instead.  The difference between N and
1071 the actual number of articles unmarked is returned."
1072   (interactive "p")
1073   (gnus-agent-mark-article n t))
1074
1075 (defun gnus-agent-toggle-mark (n)
1076   "Toggle the downloadable mark from the next N articles.
1077 If N is negative, toggle backward instead.  The difference between N and
1078 the actual number of articles toggled is returned."
1079   (interactive "p")
1080   (gnus-agent-mark-article n 'toggle))
1081
1082 (defun gnus-summary-set-agent-mark (article &optional unmark)
1083   "Mark ARTICLE as downloadable.  If UNMARK is nil, article is marked.
1084 When UNMARK is t, the article is unmarked.  For any other value, the
1085 article's mark is toggled."
1086   (let ((unmark (cond ((eq nil unmark)
1087                        nil)
1088                       ((eq t unmark)
1089                        t)
1090                       (t
1091                        (memq article gnus-newsgroup-downloadable)))))
1092     (when (gnus-summary-goto-subject article nil t)
1093       (gnus-summary-update-mark
1094        (if unmark
1095            (progn
1096              (setq gnus-newsgroup-downloadable
1097                    (delq article gnus-newsgroup-downloadable))
1098              (gnus-article-mark article))
1099          (setq gnus-newsgroup-downloadable
1100                (gnus-add-to-sorted-list gnus-newsgroup-downloadable article))
1101          gnus-downloadable-mark)
1102        'unread))))
1103
1104 ;;;###autoload
1105 (defun gnus-agent-get-undownloaded-list ()
1106   "Construct list of articles that have not been downloaded."
1107   (let ((gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name)))
1108     (when (set (make-local-variable 'gnus-newsgroup-agentized)
1109                (gnus-agent-method-p gnus-command-method))
1110       (let* ((alist (gnus-agent-load-alist gnus-newsgroup-name))
1111              (headers (sort (mapcar (lambda (h)
1112                                       (mail-header-number h))
1113                                     gnus-newsgroup-headers) '<))
1114              (cached (and gnus-use-cache gnus-newsgroup-cached))
1115              (undownloaded (list nil))
1116              (tail-undownloaded undownloaded)
1117              (unfetched (list nil))
1118              (tail-unfetched unfetched))
1119         (while (and alist headers)
1120           (let ((a (caar alist))
1121                 (h (car headers)))
1122             (cond ((< a h)
1123                    ;; Ignore IDs in the alist that are not being
1124                    ;; displayed in the summary.
1125                    (setq alist (cdr alist)))
1126                   ((> a h)
1127                    ;; Headers that are not in the alist should be
1128                    ;; fictitious (see nnagent-retrieve-headers); they
1129                    ;; imply that this article isn't in the agent.
1130                    (gnus-agent-append-to-list tail-undownloaded h)
1131                    (gnus-agent-append-to-list tail-unfetched    h)
1132                    (setq headers (cdr headers)))
1133                   ((cdar alist)
1134                    (setq alist (cdr alist))
1135                    (setq headers (cdr headers))
1136                    nil                  ; ignore already downloaded
1137                    )
1138                   (t
1139                    (setq alist (cdr alist))
1140                    (setq headers (cdr headers))
1141
1142                    ;; This article isn't in the agent.  Check to see
1143                    ;; if it is in the cache.  If it is, it's been
1144                    ;; downloaded.
1145                    (while (and cached (< (car cached) a))
1146                      (setq cached (cdr cached)))
1147                    (unless (equal a (car cached))
1148                      (gnus-agent-append-to-list tail-undownloaded a))))))
1149
1150         (while headers
1151           (let ((num (pop headers)))
1152             (gnus-agent-append-to-list tail-undownloaded num)
1153             (gnus-agent-append-to-list tail-unfetched    num)))
1154
1155         (setq gnus-newsgroup-undownloaded (cdr undownloaded)
1156               gnus-newsgroup-unfetched    (cdr unfetched))))))
1157
1158 (defun gnus-agent-catchup ()
1159   "Mark as read all unhandled articles.
1160 An article is unhandled if it is neither cached, nor downloaded, nor
1161 downloadable."
1162   (interactive)
1163   (save-excursion
1164     (let ((articles gnus-newsgroup-undownloaded))
1165       (when (or gnus-newsgroup-downloadable
1166                 gnus-newsgroup-cached)
1167         (setq articles (gnus-sorted-ndifference
1168                         (gnus-sorted-ndifference
1169                          (gnus-copy-sequence articles)
1170                          gnus-newsgroup-downloadable)
1171                         gnus-newsgroup-cached)))
1172
1173       (while articles
1174         (gnus-summary-mark-article
1175          (pop articles) gnus-catchup-mark)))
1176     (gnus-summary-position-point)))
1177
1178 (defun gnus-agent-summary-fetch-series ()
1179   "Fetch the process-marked articles into the Agent."
1180   (interactive)
1181   (when gnus-newsgroup-processable
1182     (setq gnus-newsgroup-downloadable
1183           (let* ((dl gnus-newsgroup-downloadable)
1184                  (processable (sort (gnus-copy-sequence gnus-newsgroup-processable) '<))
1185                  (gnus-newsgroup-downloadable processable))
1186             (gnus-agent-summary-fetch-group)
1187
1188             ;; For each article that I processed that is no longer
1189             ;; undownloaded, remove its processable mark.
1190
1191             (mapc #'gnus-summary-remove-process-mark
1192                   (gnus-sorted-ndifference gnus-newsgroup-processable gnus-newsgroup-undownloaded))
1193
1194             ;; The preceding call to (gnus-agent-summary-fetch-group)
1195             ;; updated the temporary gnus-newsgroup-downloadable to
1196             ;; remove each article successfully fetched.  Now, I
1197             ;; update the real gnus-newsgroup-downloadable to only
1198             ;; include undownloaded articles.
1199             (gnus-sorted-ndifference dl (gnus-sorted-ndifference processable gnus-newsgroup-undownloaded))))))
1200
1201 (defun gnus-agent-summary-fetch-group (&optional all)
1202   "Fetch the downloadable articles in the group.
1203 Optional arg ALL, if non-nil, means to fetch all articles."
1204   (interactive "P")
1205   (let ((articles
1206          (if all gnus-newsgroup-articles
1207            gnus-newsgroup-downloadable))
1208         (gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name))
1209         fetched-articles)
1210     (gnus-agent-while-plugged
1211       (unless articles
1212         (error "No articles to download"))
1213       (gnus-agent-with-fetch
1214         (setq gnus-newsgroup-undownloaded
1215               (gnus-sorted-ndifference
1216                gnus-newsgroup-undownloaded
1217                (setq fetched-articles
1218                      (gnus-agent-fetch-articles
1219                       gnus-newsgroup-name articles)))))
1220       (save-excursion
1221         (dolist (article articles)
1222           (let ((was-marked-downloadable
1223                  (memq article gnus-newsgroup-downloadable)))
1224             (cond (gnus-agent-mark-unread-after-downloaded
1225                    (setq gnus-newsgroup-downloadable
1226                          (delq article gnus-newsgroup-downloadable))
1227                    (when (and (not (member article gnus-newsgroup-dormant))
1228                               (not (member article gnus-newsgroup-marked)))
1229                      (gnus-summary-mark-article article gnus-unread-mark)))
1230                   (was-marked-downloadable
1231                    (gnus-summary-set-agent-mark article t)))
1232             (when (gnus-summary-goto-subject article nil t)
1233               (gnus-summary-update-download-mark article))))))
1234     fetched-articles))
1235
1236 (defun gnus-agent-fetch-selected-article ()
1237   "Fetch the current article as it is selected.
1238 This can be added to `gnus-select-article-hook' or
1239 `gnus-mark-article-hook'."
1240   (let ((gnus-command-method gnus-current-select-method))
1241     (when (and gnus-plugged (gnus-agent-method-p gnus-command-method))
1242       (when (gnus-agent-fetch-articles
1243              gnus-newsgroup-name
1244              (list gnus-current-article))
1245         (setq gnus-newsgroup-undownloaded
1246               (delq gnus-current-article gnus-newsgroup-undownloaded))