HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
(defgroup reftex): Update home page url-link.
[bpt/emacs.git] / lisp / gnus / gnus-agent.el
CommitLineData
df80b09f 1;;; gnus-agent.el --- unplugged support for Gnus
e84b4b86
TTN		 2
3;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
88e6695f 4;; 2005, 2006 Free Software Foundation, Inc.
df80b09f
LMI		 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
3a35cf56
LK		 21;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
22;; Boston, MA 02110-1301, USA.
df80b09f
LMI		 23
24;;; Commentary:
25
26;;; Code:
27
28(require 'gnus)
29(require 'gnus-cache)
23f87bed 30(require 'nnmail)
df80b09f
LMI		 31(require 'nnvirtual)
32(require 'gnus-sum)
03f20b47 33(require 'gnus-score)
23f87bed
MB		 34(require 'gnus-srvr)
35(require 'gnus-util)
16409b0b 36(eval-when-compile
03f20b47
DL		 37 (if (featurep 'xemacs)
38 (require 'itimer)
39 (require 'timer))
40 (require 'cl))
df80b09f 41
23f87bed
MB		 42(eval-and-compile
43 (autoload 'gnus-server-update-server "gnus-srvr")
44 (autoload 'gnus-agent-customize-category "gnus-cus")
45)
46
df80b09f
LMI		 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
23f87bed
MB		 62(defcustom gnus-agent-fetched-hook nil
63 "Hook run when finished fetching articles."
bf247b6e 64 :version "22.1"
23f87bed
MB		 65 :group 'gnus-agent
66 :type 'hook)
67
df80b09f
LMI		 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
23f87bed
MB		 74 "Read articles older than this will be expired.
75If you wish to disable Agent expiring, see `gnus-agent-enable-expiration'."
df80b09f 76 :group 'gnus-agent
23f87bed 77 :type '(number :tag "days"))
df80b09f
LMI		 78
79(defcustom gnus-agent-expire-all nil
80 "If non-nil, also expire unread, ticked and dormant articles.
81If 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
23f87bed
MB		 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
df80b09f
LMI		 94(defcustom gnus-agent-summary-mode-hook nil
95 "Hook run in Agent summary minor modes."
96 :group 'gnus-agent
97 :type 'hook)
98
23f87bed
MB		 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
df80b09f
LMI		 103(defcustom gnus-agent-server-mode-hook nil
104 "Hook run in Agent summary minor modes."
105 :group 'gnus-agent
106 :type 'hook)
107
23f87bed
MB		 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
16409b0b
GM		 112(defcustom gnus-agent-confirmation-function 'y-or-n-p
113 "Function to confirm when error happens."
850846fd 114 :version "21.1"
16409b0b
GM		 115 :group 'gnus-agent
116 :type 'function)
df80b09f 117
a8f6d239 118(defcustom gnus-agent-synchronize-flags t
03f20b47
DL		 119 "Indicate if flags are synchronized when you plug in.
120If this is `ask' the hook will query the user."
5fae1cae
MB		 121 ;; If the default switches to something else than nil, then the function
122 ;; should be fixed not be exceedingly slow. See 2005-09-20 ChangeLog entry.
850846fd 123 :version "21.1"
03f20b47
DL		 124 :type '(choice (const :tag "Always" t)
125 (const :tag "Never" nil)
126 (const :tag "Ask" ask))
127 :group 'gnus-agent)
128
23f87bed
MB		 129(defcustom gnus-agent-go-online 'ask
130 "Indicate if offline servers go online when you plug in.
131If this is `ask' the hook will query the user."
a08b59c9 132 :version "21.3"
23f87bed
MB		 133 :type '(choice (const :tag "Always" t)
134 (const :tag "Never" nil)
135 (const :tag "Ask" ask))
136 :group 'gnus-agent)
137
138(defcustom gnus-agent-mark-unread-after-downloaded t
139 "Indicate whether to mark articles unread after downloaded."
140 :version "21.1"
141 :type 'boolean
142 :group 'gnus-agent)
143
144(defcustom gnus-agent-download-marks '(download)
145 "Marks for downloading."
146 :version "21.1"
147 :type '(repeat (symbol :tag "Mark"))
148 :group 'gnus-agent)
149
150(defcustom gnus-agent-consider-all-articles nil
151 "When non-nil, the agent will let the agent predicate decide
152whether articles need to be downloaded or not, for all articles. When
153nil, the default, the agent will only let the predicate decide
154whether unread articles are downloaded or not. If you enable this,
155groups with large active ranges may open slower and you may also want
156to look into the agent expiry settings to block the expiration of
157read articles as they would just be downloaded again."
bf247b6e 158 :version "22.1"
23f87bed
MB		 159 :type 'boolean
160 :group 'gnus-agent)
161
162(defcustom gnus-agent-max-fetch-size 10000000 ;; 10 Mb
163 "Chunk size for `gnus-agent-fetch-session'.
164The function will split its article fetches into chunks smaller than
165this limit."
bf247b6e 166 :version "22.1"
23f87bed
MB		 167 :group 'gnus-agent
168 :type 'integer)
169
170(defcustom gnus-agent-enable-expiration 'ENABLE
171 "The default expiration state for each group.
172When set to ENABLE, the default, `gnus-agent-expire' will expire old
173contents from a group's local storage. This value may be overridden
174to disable expiration in specific categories, topics, and groups. Of
175course, you could change gnus-agent-enable-expiration to DISABLE then
176enable expiration per categories, topics, and groups."
bf247b6e 177 :version "22.1"
23f87bed
MB		 178 :group 'gnus-agent
179 :type '(radio (const :format "Enable " ENABLE)
180 (const :format "Disable " DISABLE)))
181
182(defcustom gnus-agent-expire-unagentized-dirs t
183 "*Whether expiration should expire in unagentized directories.
184Have gnus-agent-expire scan the directories under
185\(gnus-agent-directory) for groups that are no longer agentized.
186When found, offer to remove them."
bf247b6e 187 :version "22.1"
23f87bed
MB		 188 :type 'boolean
189 :group 'gnus-agent)
190
191(defcustom gnus-agent-auto-agentize-methods '(nntp nnimap)
192 "Initially, all servers from these methods are agentized.
193The user may remove or add servers using the Server buffer.
194See Info node `(gnus)Server Buffer'."
bf247b6e 195 :version "22.1"
23f87bed
MB		 196 :type '(repeat symbol)
197 :group 'gnus-agent)
198
199(defcustom gnus-agent-queue-mail t
200 "Whether and when outgoing mail should be queued by the agent.
201When `always', always queue outgoing mail. When nil, never
202queue. Otherwise, queue if and only if unplugged."
bf247b6e 203 :version "22.1"
23f87bed
MB		 204 :group 'gnus-agent
205 :type '(radio (const :format "Always" always)
206 (const :format "Never" nil)
f5e92214 207 (const :format "When unplugged" t)))
23f87bed
MB		 208
209(defcustom gnus-agent-prompt-send-queue nil
210 "If non-nil, `gnus-group-send-queue' will prompt if called when
211unplugged."
bf247b6e 212 :version "22.1"
23f87bed
MB		 213 :group 'gnus-agent
214 :type 'boolean)
215
58090a8d 216(defcustom gnus-agent-article-alist-save-format 1
3031d8b0
MB		 217 "Indicates whether to use compression(2), versus no
218compression(1), when writing agentview files. The compressed
219files do save space but load times are 6-7 times higher. A group
220must be opened then closed for the agentview to be updated using
221the new format."
222 ;; Wouldn't symbols instead numbers be nicer? --rsteib
58090a8d
MB		 223 :version "22.1"
224 :group 'gnus-agent
225 :type '(radio (const :format "Compressed" 2)
226 (const :format "Uncompressed" 1)))
227
16409b0b 228;;; Internal variables
df80b09f
LMI		 229
230(defvar gnus-agent-history-buffers nil)
231(defvar gnus-agent-buffer-alist nil)
23f87bed 232(defvar gnus-agent-article-alist nil
bf247b6e 233 "An assoc list identifying the articles whose headers have been fetched.
23f87bed
MB		 234If successfully fetched, these headers will be stored in the group's overview
235file. The key of each assoc pair is the article ID, the value of each assoc
236pair is a flag indicating whether the identified article has been downloaded
237\(gnus-agent-fetch-articles sets the value to the day of the download).
238NOTES:
bf247b6e 2391) The last element of this list can not be expired as some
23f87bed
MB		 240 routines (for example, get-agent-fetch-headers) use the last
241 value to track which articles have had their headers retrieved.
2422) The function `gnus-agent-regenerate' may destructively modify the value.")
df80b09f 243(defvar gnus-agent-group-alist nil)
df80b09f
LMI		 244(defvar gnus-category-alist nil)
245(defvar gnus-agent-current-history nil)
246(defvar gnus-agent-overview-buffer nil)
247(defvar gnus-category-predicate-cache nil)
248(defvar gnus-category-group-cache nil)
249(defvar gnus-agent-spam-hashtb nil)
250(defvar gnus-agent-file-name nil)
251(defvar gnus-agent-send-mail-function nil)
16409b0b 252(defvar gnus-agent-file-coding-system 'raw-text)
23f87bed 253(defvar gnus-agent-file-loading-cache nil)
16409b0b 254
df80b09f
LMI		 255;; Dynamic variables
256(defvar gnus-headers)
257(defvar gnus-score)
258
259;;;
260;;; Setup
261;;;
262
263(defun gnus-open-agent ()
264 (setq gnus-agent t)
265 (gnus-agent-read-servers)
266 (gnus-category-read)
16409b0b 267 (gnus-agent-create-buffer)
df80b09f
LMI		 268 (add-hook 'gnus-group-mode-hook 'gnus-agent-mode)
269 (add-hook 'gnus-summary-mode-hook 'gnus-agent-mode)
270 (add-hook 'gnus-server-mode-hook 'gnus-agent-mode))
271
16409b0b
GM		 272(defun gnus-agent-create-buffer ()
273 (if (gnus-buffer-live-p gnus-agent-overview-buffer)
274 t
275 (setq gnus-agent-overview-buffer
276 (gnus-get-buffer-create " *Gnus agent overview*"))
277 (with-current-buffer gnus-agent-overview-buffer
278 (mm-enable-multibyte))
279 nil))
280
df80b09f
LMI		 281(gnus-add-shutdown 'gnus-close-agent 'gnus)
282
283(defun gnus-close-agent ()
23f87bed 284 (setq gnus-category-predicate-cache nil
df80b09f
LMI		 285 gnus-category-group-cache nil
286 gnus-agent-spam-hashtb nil)
287 (gnus-kill-buffer gnus-agent-overview-buffer))
288
289;;;
290;;; Utility functions
291;;;
292
293(defun gnus-agent-read-file (file)
294 "Load FILE and do a `read' there."
16409b0b 295 (with-temp-buffer
df80b09f
LMI		 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 ()
35ef97a5 308 "The name of the Gnus agent directory."
df80b09f
LMI		 309 (nnheader-concat gnus-agent-directory
310 (nnheader-translate-file-chars (gnus-agent-method)) "/"))
311
312(defun gnus-agent-lib-file (file)
35ef97a5 313 "The full name of the Gnus agent library FILE."
850846fd
DL		 314 (expand-file-name file
315 (file-name-as-directory
316 (expand-file-name "agent.lib" (gnus-agent-directory)))))
df80b09f 317
23f87bed
MB		 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)).
336Given the call (gnus-agent-cat-defaccessor func PROPERTY1), the list may be
337manipulated 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
58090a8d 372 gnus-agent-cat-length-when-long agent-long-article)
23f87bed 373(gnus-agent-cat-defaccessor
58090a8d 374 gnus-agent-cat-length-when-short agent-short-article)
23f87bed
MB		 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
58090a8d 380 gnus-agent-cat-score-file agent-score)
23f87bed 381(gnus-agent-cat-defaccessor
58090a8d 382 gnus-agent-cat-enable-undownloaded-faces agent-enable-undownloaded-faces)
23f87bed 383
54506618
MB		 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
23f87bed 389(eval-and-compile
54506618
MB		 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 )
23f87bed
MB		 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
df80b09f
LMI		 438;;; Fetching setup functions.
439
440(defun gnus-agent-start-fetch ()
441 "Initialize data structures for efficient fetching."
16409b0b 442 (gnus-agent-create-buffer))
df80b09f
LMI		 443
444(defun gnus-agent-stop-fetch ()
445 "Save all data structures and clean up."
df80b09f
LMI		 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
03f20b47 454 (let ((gnus-agent-fetching t))
df80b09f
LMI		 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
23f87bed
MB		 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
df80b09f
LMI		 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)
23f87bed
MB		 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)))
df80b09f
LMI		 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
03f20b47 514 "JY" gnus-agent-synchronize-flags
23f87bed 515 "JS" gnus-group-send-queue
16409b0b 516 "Ja" gnus-agent-add-group
23f87bed
MB		 517 "Jr" gnus-agent-remove-group
518 "Jo" gnus-agent-toggle-group-plugged)
df80b09f
LMI		 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]
23f87bed 526 ["Toggle group plugged" gnus-agent-toggle-group-plugged t]
df80b09f 527 ["List categories" gnus-enter-category-buffer t]
23f87bed
MB		 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]
df80b09f
LMI		 531 ("Fetch"
532 ["All" gnus-agent-fetch-session gnus-plugged]
23f87bed
MB		 533 ["Group" gnus-agent-fetch-group gnus-plugged])
534 ["Synchronize flags" gnus-agent-synchronize-flags t]
535 ))))
df80b09f
LMI		 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
23f87bed
MB		 540 "Ju" gnus-agent-summary-fetch-group
541 "JS" gnus-agent-fetch-group
542 "Js" gnus-agent-summary-fetch-series
df80b09f
LMI		 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]
23f87bed 557 ["Fetch downloadable" gnus-agent-summary-fetch-group t]
df80b09f
LMI		 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
23f87bed
MB		 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
27a0c0bc
LT		 579 (make-mode-line-mouse-map mouse-button mouse-func)
580 'mouse-face 'mode-line-highlight)
23f87bed
MB		 581 string))
582
583(defun gnus-agent-toggle-plugged (set-to)
df80b09f
LMI		 584 "Toggle whether Gnus is unplugged or not."
585 (interactive (list (not gnus-plugged)))
23f87bed
MB		 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))))
df80b09f
LMI		 605 (set-buffer-modified-p t))
606
23f87bed
MB		 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
df80b09f
LMI		 617(defun gnus-agent-close-connections ()
618 "Close all methods covered by the Gnus agent."
23f87bed 619 (let ((methods (gnus-agent-covered-methods)))
df80b09f
LMI		 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
23f87bed
MB		 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
df80b09f
LMI		 644;;;###autoload
645(defun gnus-agentize ()
646 "Allow Gnus to be an offline newsreader.
df80b09f 647
23f87bed
MB		 648The gnus-agentize function is now called internally by gnus when
649gnus-agent is set. If you wish to avoid calling gnus-agentize,
650customize gnus-agent to nil.
df80b09f 651
23f87bed
MB		 652This will modify the `gnus-setup-news-hook', and
653`message-send-mail-real-function' variables, and install the Gnus agent
654minor mode in all Gnus buffers."
df80b09f
LMI		 655 (interactive)
656 (gnus-open-agent)
657 (add-hook 'gnus-setup-news-hook 'gnus-agent-queue-setup)
658 (unless gnus-agent-send-mail-function
23f87bed
MB		 659 (setq gnus-agent-send-mail-function
660 (or message-send-mail-real-function
54506618 661 (function (lambda () (funcall message-send-mail-function))))
23f87bed
MB		 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.
682Optional 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 ""))
df80b09f 686 (let ((gnus-level-default-subscribed 1))
23f87bed
MB		 687 (gnus-subscribe-group (format "nndraft:%s" (or group-name "queue"))
688 nil '(nndraft "")))
df80b09f 689 (gnus-group-set-parameter
23f87bed
MB		 690 (format "nndraft:%s" (or group-name "queue"))
691 'gnus-dummy '((gnus-draft-mode)))))
df80b09f
LMI		 692
693(defun gnus-agent-send-mail ()
23f87bed
MB		 694 (if (or (not gnus-agent-queue-mail)
695 (and gnus-plugged (not (eq gnus-agent-queue-mail 'always))))
df80b09f
LMI		 696 (funcall gnus-agent-send-mail-function)
697 (goto-char (point-min))
698 (re-search-forward
699 (concat "^" (regexp-quote mail-header-separator) "\n"))
700 (replace-match "\n")
701 (gnus-agent-insert-meta-information 'mail)
16409b0b 702 (gnus-request-accept-article "nndraft:queue" nil t t)))
df80b09f
LMI		 703
704(defun gnus-agent-insert-meta-information (type &optional method)
705 "Insert meta-information into the message that says how it's to be posted.
23f87bed 706TYPE can be either `mail' or `news'. If the latter, then METHOD can
df80b09f
LMI		 707be a select method."
708 (save-excursion
709 (message-remove-header gnus-agent-meta-information-header)
710 (goto-char (point-min))
711 (insert gnus-agent-meta-information-header ": "
712 (symbol-name type) " " (format "%S" method)
713 "\n")
714 (forward-char -1)
715 (while (search-backward "\n" nil t)
716 (replace-match "\\n" t t))))
717
03f20b47
DL		 718(defun gnus-agent-restore-gcc ()
719 "Restore GCC field from saved header."
720 (save-excursion
721 (goto-char (point-min))
23f87bed
MB		 722 (while (re-search-forward
723 (concat "^" (regexp-quote gnus-agent-gcc-header) ":") nil t)
03f20b47
DL		 724 (replace-match "Gcc:" 'fixedcase))))
725
726(defun gnus-agent-any-covered-gcc ()
727 (save-restriction
728 (message-narrow-to-headers)
729 (let* ((gcc (mail-fetch-field "gcc" nil t))
a1506d29 730 (methods (and gcc
03f20b47
DL		 731 (mapcar 'gnus-inews-group-method
732 (message-unquote-tokens
a1506d29 733 (message-tokenize-header
03f20b47
DL		 734 gcc " ,")))))
735 covered)
736 (while (and (not covered) methods)
23f87bed 737 (setq covered (gnus-agent-method-p (car methods))
03f20b47
DL		 738 methods (cdr methods)))
739 covered)))
740
23f87bed 741;;;###autoload
03f20b47
DL		 742(defun gnus-agent-possibly-save-gcc ()
743 "Save GCC if Gnus is unplugged."
744 (when (and (not gnus-plugged) (gnus-agent-any-covered-gcc))
745 (save-excursion
746 (goto-char (point-min))
747 (let ((case-fold-search t))
748 (while (re-search-forward "^gcc:" nil t)
749 (replace-match (concat gnus-agent-gcc-header ":") 'fixedcase))))))
750
751(defun gnus-agent-possibly-do-gcc ()
752 "Do GCC if Gnus is plugged."
753 (when (or gnus-plugged (not (gnus-agent-any-covered-gcc)))
754 (gnus-inews-do-gcc)))
755
df80b09f
LMI		 756;;;
757;;; Group mode commands
758;;;
759
760(defun gnus-agent-fetch-groups (n)
761 "Put all new articles in the current groups into the Agent."
762 (interactive "P")
16409b0b
GM		 763 (unless gnus-plugged
764 (error "Groups can't be fetched when Gnus is unplugged"))
df80b09f
LMI		 765 (gnus-group-iterate n 'gnus-agent-fetch-group))
766
23f87bed 767(defun gnus-agent-fetch-group (&optional group)
df80b09f
LMI		 768 "Put all new articles in GROUP into the Agent."
769 (interactive (list (gnus-group-group-name)))
23f87bed 770 (setq group (or group gnus-newsgroup-name))
df80b09f
LMI		 771 (unless group
772 (error "No group on the current line"))
23f87bed
MB		 773
774 (gnus-agent-while-plugged
775 (let ((gnus-command-method (gnus-find-method-for-group group)))
776 (gnus-agent-with-fetch
777 (gnus-agent-fetch-group-1 group gnus-command-method)
778 (gnus-message 5 "Fetching %s...done" group)))))
df80b09f
LMI		 779
780(defun gnus-agent-add-group (category arg)
781 "Add the current group to an agent category."
782 (interactive
783 (list
784 (intern
785 (completing-read
786 "Add to category: "
787 (mapcar (lambda (cat) (list (symbol-name (car cat))))
788 gnus-category-alist)
789 nil t))
790 current-prefix-arg))
791 (let ((cat (assq category gnus-category-alist))
792 c groups)
793 (gnus-group-iterate arg
794 (lambda (group)
23f87bed
MB		 795 (when (gnus-agent-cat-groups (setq c (gnus-group-category group)))
796 (setf (gnus-agent-cat-groups c)
797 (delete group (gnus-agent-cat-groups c))))
df80b09f 798 (push group groups)))
23f87bed
MB		 799 (setf (gnus-agent-cat-groups cat)
800 (nconc (gnus-agent-cat-groups cat) groups))
df80b09f
LMI		 801 (gnus-category-write)))
802
16409b0b
GM		 803(defun gnus-agent-remove-group (arg)
804 "Remove the current group from its agent category, if any."
805 (interactive "P")
806 (let (c)
807 (gnus-group-iterate arg
808 (lambda (group)
23f87bed
MB		 809 (when (gnus-agent-cat-groups (setq c (gnus-group-category group)))
810 (setf (gnus-agent-cat-groups c)
811 (delete group (gnus-agent-cat-groups c))))))
16409b0b
GM		 812 (gnus-category-write)))
813
03f20b47
DL		 814(defun gnus-agent-synchronize-flags ()
815 "Synchronize unplugged flags with servers."
816 (interactive)
817 (save-excursion
23f87bed 818 (dolist (gnus-command-method (gnus-agent-covered-methods))
03f20b47
DL		 819 (when (file-exists-p (gnus-agent-lib-file "flags"))
820 (gnus-agent-synchronize-flags-server gnus-command-method)))))
821
822(defun gnus-agent-possibly-synchronize-flags ()
823 "Synchronize flags according to `gnus-agent-synchronize-flags'."
16409b0b
GM		 824 (interactive)
825 (save-excursion
23f87bed 826 (dolist (gnus-command-method (gnus-agent-covered-methods))
54506618 827 (when (and (file-exists-p (gnus-agent-lib-file "flags"))
26c9afc3 828 (eq (gnus-server-status gnus-command-method) 'ok))
03f20b47
DL		 829 (gnus-agent-possibly-synchronize-flags-server gnus-command-method)))))
830
831(defun gnus-agent-synchronize-flags-server (method)
832 "Synchronize flags set when unplugged for server."
54506618
MB		 833 (let ((gnus-command-method method)
834 (gnus-agent nil))
03f20b47
DL		 835 (when (file-exists-p (gnus-agent-lib-file "flags"))
836 (set-buffer (get-buffer-create " *Gnus Agent flag synchronize*"))
837 (erase-buffer)
838 (nnheader-insert-file-contents (gnus-agent-lib-file "flags"))
54506618 839 (cond ((null gnus-plugged)
bf247b6e
KS		 840 (gnus-message
841 1 "You must be plugged to synchronize flags with server %s"
54506618
MB		 842 (nth 1 gnus-command-method)))
843 ((null (gnus-check-server gnus-command-method))
bf247b6e 844 (gnus-message
54506618
MB		 845 1 "Couldn't open server %s" (nth 1 gnus-command-method)))
846 (t
847 (condition-case err
848 (while t
849 (let ((bgn (point)))
850 (eval (read (current-buffer)))
851 (delete-region bgn (point))))
852 (end-of-file
853 (delete-file (gnus-agent-lib-file "flags")))
854 (error
855 (let ((file (gnus-agent-lib-file "flags")))
856 (write-region (point-min) (point-max)
857 (gnus-agent-lib-file "flags") nil 'silent)
858 (error "Couldn't set flags from file %s due to %s"
859 file (error-message-string err)))))))
03f20b47
DL		 860 (kill-buffer nil))))
861
862(defun gnus-agent-possibly-synchronize-flags-server (method)
863 "Synchronize flags for server according to `gnus-agent-synchronize-flags'."
864 (when (or (and gnus-agent-synchronize-flags
865 (not (eq gnus-agent-synchronize-flags 'ask)))
866 (and (eq gnus-agent-synchronize-flags 'ask)
a1506d29 867 (gnus-y-or-n-p (format "Synchronize flags on server `%s'? "
03f20b47
DL		 868 (cadr method)))))
869 (gnus-agent-synchronize-flags-server method)))
16409b0b 870
54506618
MB		 871;;;###autoload
872(defun gnus-agent-rename-group (old-group new-group)
58090a8d
MB		 873 "Rename fully-qualified OLD-GROUP as NEW-GROUP.
874Always updates the agent, even when disabled, as the old agent
875files would corrupt gnus when the agent was next enabled.
876Depends upon the caller to determine whether group renaming is
877supported."
54506618
MB		 878 (let* ((old-command-method (gnus-find-method-for-group old-group))
879 (old-path (directory-file-name
880 (let (gnus-command-method old-command-method)
881 (gnus-agent-group-pathname old-group))))
882 (new-command-method (gnus-find-method-for-group new-group))
883 (new-path (directory-file-name
884 (let (gnus-command-method new-command-method)
885 (gnus-agent-group-pathname new-group)))))
886 (gnus-rename-file old-path new-path t)
887
888 (let* ((old-real-group (gnus-group-real-name old-group))
889 (new-real-group (gnus-group-real-name new-group))
890 (old-active (gnus-agent-get-group-info old-command-method old-real-group)))
891 (gnus-agent-save-group-info old-command-method old-real-group nil)
892 (gnus-agent-save-group-info new-command-method new-real-group old-active)
893
bf247b6e 894 (let ((old-local (gnus-agent-get-local old-group
54506618
MB		 895 old-real-group old-command-method)))
896 (gnus-agent-set-local old-group
897 nil nil
898 old-real-group old-command-method)
899 (gnus-agent-set-local new-group
900 (car old-local) (cdr old-local)
901 new-real-group new-command-method)))))
902
903;;;###autoload
904(defun gnus-agent-delete-group (group)
58090a8d
MB		 905 "Delete fully-qualified GROUP.
906Always updates the agent, even when disabled, as the old agent
907files would corrupt gnus when the agent was next enabled.
908Depends upon the caller to determine whether group deletion is
909supported."
54506618
MB		 910 (let* ((command-method (gnus-find-method-for-group group))
911 (path (directory-file-name
912 (let (gnus-command-method command-method)
913 (gnus-agent-group-pathname group)))))
aa0a8561 914 (gnus-delete-directory path)
54506618
MB		 915
916 (let* ((real-group (gnus-group-real-name group)))
917 (gnus-agent-save-group-info command-method real-group nil)
918
bf247b6e 919 (let ((local (gnus-agent-get-local group
54506618
MB		 920 real-group command-method)))
921 (gnus-agent-set-local group
922 nil nil
923 real-group command-method)))))
924
df80b09f
LMI		 925;;;
926;;; Server mode commands
927;;;
928
23f87bed 929(defun gnus-agent-add-server ()
df80b09f 930 "Enroll SERVER in the agent program."
23f87bed
MB		 931 (interactive)
932 (let* ((server (gnus-server-server-name))
933 (named-server (gnus-server-named-server))
934 (method (and server
935 (gnus-server-get-method nil server))))
936 (unless server
937 (error "No server on the current line"))
938
939 (when (gnus-agent-method-p method)
df80b09f 940 (error "Server already in the agent program"))
23f87bed
MB		 941
942 (push named-server gnus-agent-covered-methods)
943
944 (setq gnus-agent-method-p-cache nil)
945 (gnus-server-update-server server)
df80b09f 946 (gnus-agent-write-servers)
23f87bed 947 (gnus-message 1 "Entered %s into the Agent" server)))
df80b09f 948
23f87bed 949(defun gnus-agent-remove-server ()
df80b09f 950 "Remove SERVER from the agent program."
23f87bed
MB		 951 (interactive)
952 (let* ((server (gnus-server-server-name))
953 (named-server (gnus-server-named-server)))
954 (unless server
955 (error "No server on the current line"))
956
957 (unless (member named-server gnus-agent-covered-methods)
df80b09f 958 (error "Server not in the agent program"))
23f87bed 959
bf247b6e 960 (setq gnus-agent-covered-methods
23f87bed
MB		 961 (delete named-server gnus-agent-covered-methods)
962 gnus-agent-method-p-cache nil)
963
964 (gnus-server-update-server server)
df80b09f 965 (gnus-agent-write-servers)
23f87bed 966 (gnus-message 1 "Removed %s from the agent" server)))
df80b09f
LMI		 967
968(defun gnus-agent-read-servers ()
969 "Read the alist of covered servers."
bf247b6e 970 (setq gnus-agent-covered-methods
23f87bed
MB		 971 (gnus-agent-read-file
972 (nnheader-concat gnus-agent-directory "lib/servers"))
973 gnus-agent-method-p-cache nil)
974
975 ;; I am called so early in start-up that I can not validate server
976 ;; names. When that is the case, I skip the validation. That is
977 ;; alright as the gnus startup code calls the validate methods
978 ;; directly.
979 (if gnus-server-alist
980 (gnus-agent-read-servers-validate)))
981
982(defun gnus-agent-read-servers-validate ()
983 (mapcar (lambda (server-or-method)
984 (let* ((server (if (stringp server-or-method)
985 server-or-method
986 (gnus-method-to-server server-or-method)))
987 (method (gnus-server-to-method server)))
988 (if method
989 (unless (member server gnus-agent-covered-methods)
990 (push server gnus-agent-covered-methods)
991 (setq gnus-agent-method-p-cache nil))
992 (gnus-message 1 "Ignoring disappeared server `%s'" server))))
993 (prog1 gnus-agent-covered-methods
994 (setq gnus-agent-covered-methods nil))))
995
996(defun gnus-agent-read-servers-validate-native (native-method)
df80b09f 997 (setq gnus-agent-covered-methods
23f87bed
MB		 998 (mapcar (lambda (method)
999 (if (or (not method)
1000 (equal method native-method))
1001 "native"
1002 method)) gnus-agent-covered-methods)))
df80b09f
LMI		 1003
1004(defun gnus-agent-write-servers ()
1005 "Write the alist of covered servers."
16409b0b
GM		 1006 (gnus-make-directory (nnheader-concat gnus-agent-directory "lib"))
1007 (let ((coding-system-for-write nnheader-file-coding-system)
1008 (file-name-coding-system nnmail-pathname-coding-system))
1009 (with-temp-file (nnheader-concat gnus-agent-directory "lib/servers")
23f87bed
MB		 1010 (prin1 gnus-agent-covered-methods
1011 (current-buffer)))))
df80b09f
LMI		 1012
1013;;;
1014;;; Summary commands
1015;;;
1016
1017(defun gnus-agent-mark-article (n &optional unmark)
1018 "Mark the next N articles as downloadable.
1019If N is negative, mark backward instead. If UNMARK is non-nil, remove
1020the mark instead. The difference between N and the actual number of
1021articles marked is returned."
1022 (interactive "p")
1023 (let ((backward (< n 0))
1024 (n (abs n)))
1025 (while (and
1026 (> n 0)
1027 (progn
1028 (gnus-summary-set-agent-mark
1029 (gnus-summary-article-number) unmark)
1030 (zerop (gnus-summary-next-subject (if backward -1 1) nil t))))
1031 (setq n (1- n)))
1032 (when (/= 0 n)
1033 (gnus-message 7 "No more articles"))
1034 (gnus-summary-recenter)
1035 (gnus-summary-position-point)
1036 n))
1037
1038(defun gnus-agent-unmark-article (n)
1039 "Remove the downloadable mark from the next N articles.
1040If N is negative, unmark backward instead. The difference between N and
1041the actual number of articles unmarked is returned."
1042 (interactive "p")
1043 (gnus-agent-mark-article n t))
1044
1045(defun gnus-agent-toggle-mark (n)
1046 "Toggle the downloadable mark from the next N articles.
1047If N is negative, toggle backward instead. The difference between N and
1048the actual number of articles toggled is returned."
1049 (interactive "p")
1050 (gnus-agent-mark-article n 'toggle))
1051
1052(defun gnus-summary-set-agent-mark (article &optional unmark)
23f87bed
MB		 1053 "Mark ARTICLE as downloadable. If UNMARK is nil, article is marked.
1054When UNMARK is t, the article is unmarked. For any other value, the
1055article's mark is toggled."
1056 (let ((unmark (cond ((eq nil unmark)
1057 nil)
1058 ((eq t unmark)
1059 t)
1060 (t
1061 (memq article gnus-newsgroup-downloadable)))))
1062 (when (gnus-summary-goto-subject article nil t)
1063 (gnus-summary-update-mark
1064 (if unmark
1065 (progn
1066 (setq gnus-newsgroup-downloadable
1067 (delq article gnus-newsgroup-downloadable))
1068 (gnus-article-mark article))
1069 (setq gnus-newsgroup-downloadable
1070 (gnus-add-to-sorted-list gnus-newsgroup-downloadable article))
1071 gnus-downloadable-mark)
1072 'unread))))
df80b09f 1073
54506618 1074;;;###autoload
df80b09f 1075(defun gnus-agent-get-undownloaded-list ()
23f87bed 1076 "Construct list of articles that have not been downloaded."
df80b09f 1077 (let ((gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name)))
23f87bed
MB		 1078 (when (set (make-local-variable 'gnus-newsgroup-agentized)
1079 (gnus-agent-method-p gnus-command-method))
1080 (let* ((alist (gnus-agent-load-alist gnus-newsgroup-name))
1081 (headers (sort (mapcar (lambda (h)
1082 (mail-header-number h))
1083 gnus-newsgroup-headers) '<))
1084 (cached (and gnus-use-cache gnus-newsgroup-cached))
1085 (undownloaded (list nil))
1086 (tail-undownloaded undownloaded)
1087 (unfetched (list nil))
1088 (tail-unfetched unfetched))
1089 (while (and alist headers)
1090 (let ((a (caar alist))
1091 (h (car headers)))
1092 (cond ((< a h)
1093 ;; Ignore IDs in the alist that are not being
1094 ;; displayed in the summary.
1095 (setq alist (cdr alist)))
1096 ((> a h)
1097 ;; Headers that are not in the alist should be
1098 ;; fictious (see nnagent-retrieve-headers); they
1099 ;; imply that this article isn't in the agent.
1100 (gnus-agent-append-to-list tail-undownloaded h)
1101 (gnus-agent-append-to-list tail-unfetched h)
bf247b6e 1102 (setq headers (cdr headers)))
23f87bed
MB		 1103 ((cdar alist)
1104 (setq alist (cdr alist))
1105 (setq headers (cdr headers))
1106 nil ; ignore already downloaded
1107 )
1108 (t
1109 (setq alist (cdr alist))
1110 (setq headers (cdr headers))
bf247b6e 1111
23f87bed
MB		 1112 ;; This article isn't in the agent. Check to see
1113 ;; if it is in the cache. If it is, it's been
1114 ;; downloaded.
1115 (while (and cached (< (car cached) a))
1116 (setq cached (cdr cached)))
1117 (unless (equal a (car cached))
1118 (gnus-agent-append-to-list tail-undownloaded a))))))
1119
1120 (while headers
1121 (let ((num (pop headers)))
1122 (gnus-agent-append-to-list tail-undownloaded num)
1123 (gnus-agent-append-to-list tail-unfetched num)))
1124
1125 (setq gnus-newsgroup-undownloaded (cdr undownloaded)
1126 gnus-newsgroup-unfetched (cdr unfetched))))))
df80b09f
LMI		 1127
1128(defun gnus-agent-catchup ()
23f87bed
MB		 1129 "Mark as read all unhandled articles.
1130An article is unhandled if it is neither cached, nor downloaded, nor
1131downloadable."
df80b09f
LMI		 1132 (interactive)
1133 (save-excursion
23f87bed
MB		 1134 (let ((articles gnus-newsgroup-undownloaded))
1135 (when (or gnus-newsgroup-downloadable
1136 gnus-newsgroup-cached)
1137 (setq articles (gnus-sorted-ndifference
1138 (gnus-sorted-ndifference
1139 (gnus-copy-sequence articles)
1140 gnus-newsgroup-downloadable)
1141 gnus-newsgroup-cached)))
1142
1143 (while articles
1144 (gnus-summary-mark-article
1145 (pop articles) gnus-catchup-mark)))
1146 (gnus-summary-position-point)))
1147
1148(defun gnus-agent-summary-fetch-series ()
1149 (interactive)
1150 (when gnus-newsgroup-processable
1151 (setq gnus-newsgroup-downloadable
1152 (let* ((dl gnus-newsgroup-downloadable)
58090a8d
MB		 1153 (processable (sort (gnus-copy-sequence gnus-newsgroup-processable) '<))
1154 (gnus-newsgroup-downloadable processable))
1155 (gnus-agent-summary-fetch-group)
23f87bed 1156
58090a8d
MB		 1157 ;; For each article that I processed that is no longer
1158 ;; undownloaded, remove its processable mark.
1159
1160 (mapc #'gnus-summary-remove-process-mark
1161 (gnus-sorted-ndifference gnus-newsgroup-processable gnus-newsgroup-undownloaded))
1162
1163 ;; The preceeding call to (gnus-agent-summary-fetch-group)
1164 ;; updated the temporary gnus-newsgroup-downloadable to
1165 ;; remove each article successfully fetched. Now, I
1166 ;; update the real gnus-newsgroup-downloadable to only
1167 ;; include undownloaded articles.
1168 (gnus-sorted-ndifference dl (gnus-sorted-ndifference processable gnus-newsgroup-undownloaded))))))
23f87bed
MB		 1169
1170(defun gnus-agent-summary-fetch-group (&optional all)
1171 "Fetch the downloadable articles in the group.
1172Optional arg ALL, if non-nil, means to fetch all articles."
1173 (interactive "P")
1174 (let ((articles
1175 (if all gnus-newsgroup-articles
1176 gnus-newsgroup-downloadable))
1177 (gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name))
1178 fetched-articles)
1179 (gnus-agent-while-plugged
1180 (unless articles
1181 (error "No articles to download"))
1182 (gnus-agent-with-fetch
1183 (setq gnus-newsgroup-undownloaded
1184 (gnus-sorted-ndifference
1185 gnus-newsgroup-undownloaded
1186 (setq fetched-articles
1187 (gnus-agent-fetch-articles
1188 gnus-newsgroup-name articles)))))
1189 (save-excursion
1190 (dolist (article articles)
bf247b6e 1191 (let ((was-marked-downloadable
23f87bed
MB		 1192 (memq article gnus-newsgroup-downloadable)))
1193 (cond (gnus-agent-mark-unread-after-downloaded
1194 (setq gnus-newsgroup-downloadable
1195 (delq article gnus-newsgroup-downloadable))
1196
1197 (gnus-summary-mark-article article gnus-unread-mark))
1198 (was-marked-downloadable
1199 (gnus-summary-set-agent-mark article t)))
1200 (when (gnus-summary-goto-subject article nil t)
1201 (gnus-summary-update-download-mark article))))))
1202 fetched-articles))
1203
1204(defun gnus-agent-fetch-selected-article ()
1205 "Fetch the current article as it is selected.
1206This can be added to `gnus-select-article-hook' or
1207`gnus-mark-article-hook'."
1208 (let ((gnus-command-method gnus-current-select-method))
1209 (when (and gnus-plugged (gnus-agent-method-p gnus-command-method))
1210 (when (gnus-agent-fetch-articles
1211 gnus-newsgroup-name
1212 (list gnus-current-article))
1213 (setq gnus-newsgroup-undownloaded
1214 (delq gnus-current-article gnus-newsgroup-undownloaded))
1215 (gnus-summary-update-download-mark gnus-current-article)))))
df80b09f
LMI		 1216
1217;;;
1218;;; Internal functions
1219;;;
1220
54506618
MB		 1221(defun gnus-agent-synchronize-group-flags (group actions server)
1222"Update a plugged group by performing the indicated actions."
1223 (let* ((gnus-command-method (gnus-server-to-method server))
1224 (info
1225 ;; This initializer is required as gnus-request-set-mark
1226 ;; calls gnus-group-real-name to strip off the host name
1227 ;; before calling the backend. Now that the backend is
1228 ;; trying to call gnus-request-set-mark, I have to
1229 ;; reconstruct the original group name.
1230 (or (gnus-get-info group)
bf247b6e
KS		 1231 (gnus-get-info
1232 (setq group (gnus-group-full-name
54506618
MB		 1233 group gnus-command-method))))))
1234 (gnus-request-set-mark group actions)
1235
1236 (when info
1237 (dolist (action actions)
1238 (let ((range (nth 0 action))
1239 (what (nth 1 action))
1240 (marks (nth 2 action)))
1241 (dolist (mark marks)
1242 (cond ((eq mark 'read)
bf247b6e 1243 (gnus-info-set-read
54506618
MB		 1244 info
1245 (funcall (if (eq what 'add)
1246 'gnus-range-add
1247 'gnus-remove-from-range)
1248 (gnus-info-read info)
1249 range))
bf247b6e 1250 (gnus-get-unread-articles-in-group
54506618
MB		 1251 info
1252 (gnus-active (gnus-info-group info))))
1253 ((memq mark '(tick))
1254 (let ((info-marks (assoc mark (gnus-info-marks info))))
1255 (unless info-marks
1256 (gnus-info-set-marks info (cons (setq info-marks (list mark)) (gnus-info-marks info))))
1257 (setcdr info-marks (funcall (if (eq what 'add)
1258 'gnus-range-add
1259 'gnus-remove-from-range)
1260 (cdr info-marks)
58090a8d
MB		 1261 range))))))))
1262
1263 ;;Marks can be synchronized at any time by simply toggling from
1264 ;;unplugged to plugged. If that is what is happening right now, make
1265 ;;sure that the group buffer is up to date.
1266 (when (gnus-buffer-live-p gnus-group-buffer)
1267 (gnus-group-update-group group t)))
54506618
MB		 1268 nil))
1269
df80b09f
LMI		 1270(defun gnus-agent-save-active (method)
1271 (when (gnus-agent-method-p method)
1272 (let* ((gnus-command-method method)
16409b0b 1273 (new (gnus-make-hashtable (count-lines (point-min) (point-max))))
df80b09f 1274 (file (gnus-agent-lib-file "active")))
23f87bed 1275 (gnus-active-to-gnus-format nil new)
16409b0b
GM		 1276 (gnus-agent-write-active file new)
1277 (erase-buffer)
1278 (nnheader-insert-file-contents file))))
1279
1280(defun gnus-agent-write-active (file new)
df80b09f 1281 (gnus-make-directory (file-name-directory file))
23f87bed
MB		 1282 (let ((nnmail-active-file-coding-system gnus-agent-file-coding-system))
1283 ;; The hashtable contains real names of groups. However, do NOT
1284 ;; add the foreign server prefix as gnus-active-to-gnus-format
1285 ;; will add it while reading the file.
1286 (gnus-write-active-file file new nil)))
1287
54506618 1288;;;###autoload
23f87bed
MB		 1289(defun gnus-agent-possibly-alter-active (group active &optional info)
1290 "Possibly expand a group's active range to include articles
1291downloaded into the agent."
1292 (let* ((gnus-command-method (or gnus-command-method
1293 (gnus-find-method-for-group group))))
1294 (when (gnus-agent-method-p gnus-command-method)
1295 (let* ((local (gnus-agent-get-local group))
1296 (active-min (or (car active) 0))
1297 (active-max (or (cdr active) 0))
1298 (agent-min (or (car local) active-min))
1299 (agent-max (or (cdr local) active-max)))
1300
1301 (when (< agent-min active-min)
1302 (setcar active agent-min))
1303
1304 (when (> agent-max active-max)
1305 (setcdr active agent-max))
1306
1307 (when (and info (< agent-max (- active-min 100)))
1308 ;; I'm expanding the active range by such a large amount
1309 ;; that there is a gap of more than 100 articles between the
1310 ;; last article known to the agent and the first article
1311 ;; currently available on the server. This gap contains
1312 ;; articles that have been lost, mark them as read so that
1313 ;; gnus doesn't waste resources trying to fetch them.
1314
1315 ;; NOTE: I don't do this for smaller gaps (< 100) as I don't
1316 ;; want to modify the local file everytime someone restarts
1317 ;; gnus. The small gap will cause a tiny performance hit
1318 ;; when gnus tries, and fails, to retrieve the articles.
1319 ;; Still that should be smaller than opening a buffer,
1320 ;; printing this list to the buffer, and then writing it to a
1321 ;; file.
1322
1323 (let ((read (gnus-info-read info)))
bf247b6e
KS		 1324 (gnus-info-set-read
1325 info
1326 (gnus-range-add
1327 read
1328 (list (cons (1+ agent-max)
23f87bed
MB		 1329 (1- active-min))))))
1330
1331 ;; Lie about the agent's local range for this group to
1332 ;; disable the set read each time this server is opened.
1333 ;; NOTE: Opening this group will restore the valid local
1334 ;; range but it will also expand the local range to
1335 ;; incompass the new active range.
1336 (gnus-agent-set-local group agent-min (1- active-min)))))))
df80b09f
LMI		 1337
1338(defun gnus-agent-save-group-info (method group active)
23f87bed 1339 "Update a single group's active range in the agent's copy of the server's active file."
df80b09f 1340 (when (gnus-agent-method-p method)
54506618 1341 (let* ((gnus-command-method (or method gnus-command-method))
16409b0b
GM		 1342 (coding-system-for-write nnheader-file-coding-system)
1343 (file-name-coding-system nnmail-pathname-coding-system)
1344 (file (gnus-agent-lib-file "active"))
23f87bed 1345 oactive-min oactive-max)
df80b09f 1346 (gnus-make-directory (file-name-directory file))
16409b0b
GM		 1347 (with-temp-file file
1348 ;; Emacs got problem to match non-ASCII group in multibyte buffer.
a1506d29 1349 (mm-disable-multibyte)
df80b09f 1350 (when (file-exists-p file)
23f87bed
MB		 1351 (nnheader-insert-file-contents file)
1352
1353 (goto-char (point-min))
1354 (when (re-search-forward
1355 (concat "^" (regexp-quote group) " ") nil t)
1356 (save-excursion
58090a8d 1357 (setq oactive-max (read (current-buffer)) ;; max
23f87bed
MB		 1358 oactive-min (read (current-buffer)))) ;; min
1359 (gnus-delete-line)))
54506618
MB		 1360 (when active
1361 (insert (format "%S %d %d y\n" (intern group)
1362 (max (or oactive-max (cdr active)) (cdr active))
1363 (min (or oactive-min (car active)) (car active))))
1364 (goto-char (point-max))
1365 (while (search-backward "\\." nil t)
1366 (delete-char 1)))))))
1367
1368(defun gnus-agent-get-group-info (method group)
1369 "Get a single group's active range in the agent's copy of the server's active file."
1370 (when (gnus-agent-method-p method)
1371 (let* ((gnus-command-method (or method gnus-command-method))
1372 (coding-system-for-write nnheader-file-coding-system)
1373 (file-name-coding-system nnmail-pathname-coding-system)
1374 (file (gnus-agent-lib-file "active"))
1375 oactive-min oactive-max)
1376 (gnus-make-directory (file-name-directory file))
1377 (with-temp-buffer
1378 ;; Emacs got problem to match non-ASCII group in multibyte buffer.
1379 (mm-disable-multibyte)
1380 (when (file-exists-p file)
1381 (nnheader-insert-file-contents file)
1382
1383 (goto-char (point-min))
1384 (when (re-search-forward
1385 (concat "^" (regexp-quote group) " ") nil t)
1386 (save-excursion
1387 (setq oactive-max (read (current-buffer)) ;; max
1388 oactive-min (read (current-buffer))) ;; min
1389 (cons oactive-min oactive-max))))))))
df80b09f
LMI		 1390
1391(defun gnus-agent-group-path (group)
35ef97a5 1392 "Translate GROUP into a file name."
23f87bed
MB		 1393
1394 ;; NOTE: This is what nnmail-group-pathname does as of Apr 2003.
1395 ;; The two methods must be kept synchronized, which is why
1396 ;; gnus-agent-group-pathname was added.
1397
1398 (setq group
1399 (nnheader-translate-file-chars
1400 (nnheader-replace-duplicate-chars-in-string
bf247b6e 1401 (nnheader-replace-chars-in-string
91472578 1402 (gnus-group-real-name (gnus-group-decoded-name group))
23f87bed
MB		 1403 ?/ ?_)
1404 ?. ?_)))
1405 (if (or nnmail-use-long-file-names
1406 (file-directory-p (expand-file-name group (gnus-agent-directory))))
1407 group
1408 (mm-encode-coding-string
1409 (nnheader-replace-chars-in-string group ?. ?/)
1410 nnmail-pathname-coding-system)))
1411
1412(defun gnus-agent-group-pathname (group)
1413 "Translate GROUP into a file name."
1414 ;; nnagent uses nnmail-group-pathname to read articles while
1415 ;; unplugged. The agent must, therefore, use the same directory
1416 ;; while plugged.
1417 (let ((gnus-command-method (or gnus-command-method
91472578
MB		 1418 (gnus-find-method-for-group group))))
1419 (nnmail-group-pathname (gnus-group-real-name
1420 (gnus-group-decoded-name group))
1421 (gnus-agent-directory))))
df80b09f
LMI		 1422
1423(defun gnus-agent-get-function (method)
23f87bed
MB		 1424 (if (gnus-online method)
1425 (car method)
1426 (require 'nnagent)
1427 'nnagent))
1428
1429(defun gnus-agent-covered-methods ()
1430 "Return the subset of methods that are covered by the agent."
1431 (delq nil (mapcar #'gnus-server-to-method gnus-agent-covered-methods)))
df80b09f
LMI		 1432
1433;;; History functions
1434
1435(defun gnus-agent-history-buffer ()
1436 (cdr (assoc (gnus-agent-method) gnus-agent-history-buffers)))
1437
1438(defun gnus-agent-open-history ()
1439 (save-excursion
1440 (push (cons (gnus-agent-method)
1441 (set-buffer (gnus-get-buffer-create
1442 (format " *Gnus agent %s history*"
1443 (gnus-agent-method)))))
1444 gnus-agent-history-buffers)
16409b0b 1445 (mm-disable-multibyte) ;; everything is binary
df80b09f
LMI		 1446 (erase-buffer)
1447 (insert "\n")
1448 (let ((file (gnus-agent-lib-file "history")))
1449 (when (file-exists-p file)
16409b0b 1450 (nnheader-insert-file-contents file))
df80b09f
LMI		 1451 (set (make-local-variable 'gnus-agent-file-name) file))))
1452
df80b09f
LMI		 1453(defun gnus-agent-close-history ()
1454 (when (gnus-buffer-live-p gnus-agent-current-history)
1455 (kill-buffer gnus-agent-current-history)
1456 (setq gnus-agent-history-buffers
1457 (delq (assoc (gnus-agent-method) gnus-agent-history-buffers)
1458 gnus-agent-history-buffers))))
1459
df80b09f
LMI		 1460;;;
1461;;; Fetching
1462;;;
1463
1464(defun gnus-agent-fetch-articles (group articles)
1465 "Fetch ARTICLES from GROUP and put them into the Agent."
1466 (when articles
23f87bed
MB		 1467 (gnus-agent-load-alist group)
1468 (let* ((alist gnus-agent-article-alist)
1469 (headers (if (< (length articles) 2) nil gnus-newsgroup-headers))
1470 (selected-sets (list nil))
1471 (current-set-size 0)
1472 article
1473 header-number)
1474 ;; Check each article
1475 (while (setq article (pop articles))
1476 ;; Skip alist entries preceeding this article
1477 (while (> article (or (caar alist) (1+ article)))
1478 (setq alist (cdr alist)))
1479
1480 ;; Prune off articles that we have already fetched.
1481 (unless (and (eq article (caar alist))
1482 (cdar alist))
1483 ;; Skip headers preceeding this article
bf247b6e 1484 (while (> article
23f87bed
MB		 1485 (setq header-number
1486 (let* ((header (car headers)))
1487 (if header
1488 (mail-header-number header)
1489 (1+ article)))))
1490 (setq headers (cdr headers)))
1491
1492 ;; Add this article to the current set
1493 (setcar selected-sets (cons article (car selected-sets)))
1494
1495 ;; Update the set size, when the set is too large start a
1496 ;; new one. I do this after adding the article as I want at
1497 ;; least one article in each set.
1498 (when (< gnus-agent-max-fetch-size
1499 (setq current-set-size
1500 (+ current-set-size
1501 (if (= header-number article)
1502 (let ((char-size (mail-header-chars
1503 (car headers))))
1504 (if (<= char-size 0)
1505 ;; The char size was missing/invalid,
1506 ;; assume a worst-case situation of
1507 ;; 65 char/line. If the line count
1508 ;; is missing, arbitrarily assume a
1509 ;; size of 1000 characters.
1510 (max (* 65 (mail-header-lines
1511 (car headers)))
1512 1000)
1513 char-size))
1514 0))))
1515 (setcar selected-sets (nreverse (car selected-sets)))
1516 (setq selected-sets (cons nil selected-sets)
1517 current-set-size 0))))
1518
1519 (when (or (cdr selected-sets) (car selected-sets))
1520 (let* ((fetched-articles (list nil))
1521 (tail-fetched-articles fetched-articles)
1522 (dir (gnus-agent-group-pathname group))
1523 (date (time-to-days (current-time)))
1524 (case-fold-search t)
1525 pos crosses id)
1526
1527 (setcar selected-sets (nreverse (car selected-sets)))
1528 (setq selected-sets (nreverse selected-sets))
1529
1530 (gnus-make-directory dir)
1531 (gnus-message 7 "Fetching articles for %s..." group)
1532
1533 (unwind-protect
1534 (while (setq articles (pop selected-sets))
1535 ;; Fetch the articles from the backend.
1536 (if (gnus-check-backend-function 'retrieve-articles group)
1537 (setq pos (gnus-retrieve-articles articles group))
1538 (with-temp-buffer
1539 (let (article)
1540 (while (setq article (pop articles))
1541 (gnus-message 10 "Fetching article %s for %s..."
1542 article group)
1543 (when (or
1544 (gnus-backlog-request-article group article
1545 nntp-server-buffer)
1546 (gnus-request-article article group))
1547 (goto-char (point-max))
1548 (push (cons article (point)) pos)
1549 (insert-buffer-substring nntp-server-buffer)))
1550 (copy-to-buffer
1551 nntp-server-buffer (point-min) (point-max))
1552 (setq pos (nreverse pos)))))
1553 ;; Then save these articles into the Agent.
1554 (save-excursion
1555 (set-buffer nntp-server-buffer)
1556 (while pos
1557 (narrow-to-region (cdar pos) (or (cdadr pos) (point-max)))
1558 (goto-char (point-min))
1559 (unless (eobp) ;; Don't save empty articles.
1560 (when (search-forward "\n\n" nil t)
1561 (when (search-backward "\nXrefs: " nil t)
1562 ;; Handle cross posting.
1563 (goto-char (match-end 0)) ; move to end of header name
1564 (skip-chars-forward "^ ") ; skip server name
1565 (skip-chars-forward " ")
1566 (setq crosses nil)
1567 (while (looking-at "\\([^: \n]+\\):\\([0-9]+\\) *")
1568 (push (cons (buffer-substring (match-beginning 1)
1569 (match-end 1))
e9bd5782 1570 (string-to-number
23f87bed
MB		 1571 (buffer-substring (match-beginning 2)
1572 (match-end 2))))
1573 crosses)
1574 (goto-char (match-end 0)))
1575 (gnus-agent-crosspost crosses (caar pos) date)))
1576 (goto-char (point-min))
1577 (if (not (re-search-forward
1578 "^Message-ID: *<\\([^>\n]+\\)>" nil t))
1579 (setq id "No-Message-ID-in-article")
1580 (setq id (buffer-substring
1581 (match-beginning 1) (match-end 1))))
1582 (let ((coding-system-for-write
1583 gnus-agent-file-coding-system))
1584 (write-region (point-min) (point-max)
1585 (concat dir (number-to-string (caar pos)))
1586 nil 'silent))
1587
1588 (gnus-agent-append-to-list
1589 tail-fetched-articles (caar pos)))
1590 (widen)
1591 (setq pos (cdr pos)))))
1592
1593 (gnus-agent-save-alist group (cdr fetched-articles) date)
1594 (gnus-message 7 ""))
1595 (cdr fetched-articles))))))
1596
54506618
MB		 1597(defun gnus-agent-unfetch-articles (group articles)
1598 "Delete ARTICLES that were fetched from GROUP into the agent."
1599 (when articles
1600 (gnus-agent-load-alist group)
1601 (let* ((alist (cons nil gnus-agent-article-alist))
1602 (articles (sort articles #'<))
1603 (next-possibility alist)
1604 (delete-this (pop articles)))
1605 (while (and (cdr next-possibility) delete-this)
1606 (let ((have-this (caar (cdr next-possibility))))
1607 (cond ((< delete-this have-this)
1608 (setq delete-this (pop articles)))
1609 ((= delete-this have-this)
1610 (let ((timestamp (cdar (cdr next-possibility))))
1611 (when timestamp
1612 (let* ((file-name (concat (gnus-agent-group-pathname group)
1613 (number-to-string have-this))))
1614 (delete-file file-name))))
1615
1616 (setcdr next-possibility (cddr next-possibility)))
1617 (t
1618 (setq next-possibility (cdr next-possibility))))))
1619 (setq gnus-agent-article-alist (cdr alist))
1620 (gnus-agent-save-alist group))))
1621
23f87bed
MB		 1622(defun gnus-agent-crosspost (crosses article &optional date)
1623 (setq date (or date t))
1624
df80b09f
LMI		 1625 (let (gnus-agent-article-alist group alist beg end)
1626 (save-excursion
1627 (set-buffer gnus-agent-overview-buffer)
1628 (when (nnheader-find-nov-line article)
1629 (forward-word 1)
1630 (setq beg (point))
1631 (setq end (progn (forward-line 1) (point)))))
1632 (while crosses
1633 (setq group (caar crosses))
1634 (unless (setq alist (assoc group gnus-agent-group-alist))
1635 (push (setq alist (list group (gnus-agent-load-alist (caar crosses))))
1636 gnus-agent-group-alist))
23f87bed 1637 (setcdr alist (cons (cons (cdar crosses) date) (cdr alist)))
df80b09f
LMI		 1638 (save-excursion
1639 (set-buffer (gnus-get-buffer-create (format " *Gnus agent overview %s*"
16409b0b 1640 group)))
df80b09f
LMI		 1641 (when (= (point-max) (point-min))
1642 (push (cons group (current-buffer)) gnus-agent-buffer-alist)
1643 (ignore-errors
1644 (nnheader-insert-file-contents
1645 (gnus-agent-article-name ".overview" group))))
1646 (nnheader-find-nov-line (string-to-number (cdar crosses)))
1647 (insert (string-to-number (cdar crosses)))
23f87bed
MB		 1648 (insert-buffer-substring gnus-agent-overview-buffer beg end)
1649 (gnus-agent-check-overview-buffer))
1650 (setq crosses (cdr crosses)))))
1651
1652(defun gnus-agent-backup-overview-buffer ()
1653 (when gnus-newsgroup-name
1654 (let ((root (gnus-agent-article-name ".overview" gnus-newsgroup-name))
1655 (cnt 0)
1656 name)
1657 (while (file-exists-p
1658 (setq name (concat root "~"
1659 (int-to-string (setq cnt (1+ cnt))) "~"))))
1660 (write-region (point-min) (point-max) name nil 'no-msg)
1661 (gnus-message 1 "Created backup copy of overview in %s." name)))
1662 t)
1663
1664(defun gnus-agent-check-overview-buffer (&optional buffer)
1665 "Check the overview file given for sanity.
1666In particular, checks that the file is sorted by article number
1667and that there are no duplicates."
1668 (let ((prev-num -1)
1669 (backed-up nil))
1670 (save-excursion
1671 (when buffer
1672 (set-buffer buffer))
1673 (save-restriction
1674 (widen)
1675 (goto-char (point-min))
1676
1677 (while (< (point) (point-max))
1678 (let ((p (point))
1679 (cur (condition-case nil
1680 (read (current-buffer))
1681 (error nil))))
1682 (cond
1683 ((or (not (integerp cur))
1684 (not (eq (char-after) ?\t)))
1685 (or backed-up
1686 (setq backed-up (gnus-agent-backup-overview-buffer)))
1687 (gnus-message 1
1688 "Overview buffer contains garbage '%s'."
1689 (buffer-substring
1690 p (gnus-point-at-eol))))
1691 ((= cur prev-num)
1692 (or backed-up
1693 (setq backed-up (gnus-agent-backup-overview-buffer)))
1694 (gnus-message 1
1695 "Duplicate overview line for %d" cur)
54506618 1696 (delete-region p (progn (forward-line 1) (point))))
23f87bed
MB		 1697 ((< cur prev-num)
1698 (or backed-up
1699 (setq backed-up (gnus-agent-backup-overview-buffer)))
1700 (gnus-message 1 "Overview buffer not sorted!")
1701 (sort-numeric-fields 1 (point-min) (point-max))
1702 (goto-char (point-min))
1703 (setq prev-num -1))
1704 (t
1705 (setq prev-num cur)))
1706 (forward-line 1)))))))
df80b09f
LMI		 1707
1708(defun gnus-agent-flush-cache ()
1709 (save-excursion
1710 (while gnus-agent-buffer-alist
1711 (set-buffer (cdar gnus-agent-buffer-alist))
1712 (let ((coding-system-for-write
1713 gnus-agent-file-coding-system))
1714 (write-region (point-min) (point-max)
1715 (gnus-agent-article-name ".overview"
1716 (caar gnus-agent-buffer-alist))
1717 nil 'silent))
23f87bed 1718 (setq gnus-agent-buffer-alist (cdr gnus-agent-buffer-alist)))
df80b09f 1719 (while gnus-agent-group-alist
23f87bed
MB		 1720 (with-temp-file (gnus-agent-article-name
1721 ".agentview" (caar gnus-agent-group-alist))
df80b09f 1722 (princ (cdar gnus-agent-group-alist))
23f87bed
MB		 1723 (insert "\n")
1724 (princ 1 (current-buffer))
df80b09f 1725 (insert "\n"))
23f87bed
MB		 1726 (setq gnus-agent-group-alist (cdr gnus-agent-group-alist)))))
1727
54506618 1728;;;###autoload
23f87bed
MB		 1729(defun gnus-agent-find-parameter (group symbol)
1730 "Search for GROUPs SYMBOL in the group's parameters, the group's
1731topic parameters, the group's category, or the customizable
1732variables. Returns the first non-nil value found."
1733 (or (gnus-group-find-parameter group symbol t)
1734 (gnus-group-parameter-value (cdr (gnus-group-category group)) symbol t)
1735 (symbol-value
1736 (cdr
1737 (assq symbol
1738 '((agent-short-article . gnus-agent-short-article)
1739 (agent-long-article . gnus-agent-long-article)
1740 (agent-low-score . gnus-agent-low-score)
1741 (agent-high-score . gnus-agent-high-score)
1742 (agent-days-until-old . gnus-agent-expire-days)
1743 (agent-enable-expiration
1744 . gnus-agent-enable-expiration)
1745 (agent-predicate . gnus-agent-predicate)))))))
16409b0b 1746
df80b09f 1747(defun gnus-agent-fetch-headers (group &optional force)
23f87bed
MB		 1748 "Fetch interesting headers into the agent. The group's overview
1749file will be updated to include the headers while a list of available
1750article numbers will be returned."
1751 (let* ((fetch-all (and gnus-agent-consider-all-articles
1752 ;; Do not fetch all headers if the predicate
1753 ;; implies that we only consider unread articles.
1754 (not (gnus-predicate-implies-unread
1755 (gnus-agent-find-parameter group
1756 'agent-predicate)))))
1757 (articles (if fetch-all
1758 (gnus-uncompress-range (gnus-active group))
1759 (gnus-list-of-unread-articles group)))
1760 (gnus-decode-encoded-word-function 'identity)
1761 (file (gnus-agent-article-name ".overview" group)))
1762
1763 (unless fetch-all
1764 ;; Add articles with marks to the list of article headers we want to
1765 ;; fetch. Don't fetch articles solely on the basis of a recent or seen
1766 ;; mark, but do fetch recent or seen articles if they have other, more
1767 ;; interesting marks. (We have to fetch articles with boring marks
1768 ;; because otherwise the agent will remove their marks.)
1769 (dolist (arts (gnus-info-marks (gnus-get-info group)))
1770 (unless (memq (car arts) '(seen recent killed cache))
1771 (setq articles (gnus-range-add articles (cdr arts)))))
1772 (setq articles (sort (gnus-uncompress-sequence articles) '<)))
1773
1774 ;; At this point, I have the list of articles to consider for
1775 ;; fetching. This is the list that I'll return to my caller. Some
1776 ;; of these articles may have already been fetched. That's OK as
1777 ;; the fetch article code will filter those out. Internally, I'll
1778 ;; filter this list to just those articles whose headers need to
1779 ;; be fetched.
1780 (let ((articles articles))
1781 ;; Remove known articles.
1782 (when (and (or gnus-agent-cache
1783 (not gnus-plugged))
1784 (gnus-agent-load-alist group))
1785 ;; Remove articles marked as downloaded.
1786 (if fetch-all
1787 ;; I want to fetch all headers in the active range.
1788 ;; Therefore, exclude only those headers that are in the
1789 ;; article alist.
1790 ;; NOTE: This is probably NOT what I want to do after
1791 ;; agent expiration in this group.
1792 (setq articles (gnus-agent-uncached-articles articles group))
1793
1794 ;; I want to only fetch those headers that have never been
1795 ;; fetched. Therefore, exclude all headers that are, or
1796 ;; WERE, in the article alist.
1797 (let ((low (1+ (caar (last gnus-agent-article-alist))))
1798 (high (cdr (gnus-active group))))
1799 ;; Low can be greater than High when the same group is
1800 ;; fetched twice in the same session {The first fetch will
1801 ;; fill the article alist such that (last
1802 ;; gnus-agent-article-alist) equals (cdr (gnus-active
1803 ;; group))}. The addition of one(the 1+ above) then
1804 ;; forces Low to be greater than High. When this happens,
1805 ;; gnus-list-range-intersection returns nil which
1806 ;; indicates that no headers need to be fetched. -- Kevin
1807 (setq articles (gnus-list-range-intersection
1808 articles (list (cons low high)))))))
1809
1810 (gnus-message
1811 10 "gnus-agent-fetch-headers: undownloaded articles are '%s'"
1812 (gnus-compress-sequence articles t))
1813
df80b09f 1814 (save-excursion
23f87bed
MB		 1815 (set-buffer nntp-server-buffer)
1816
1817 (if articles
1818 (progn
1819 (gnus-message 7 "Fetching headers for %s..." group)
1820
1821 ;; Fetch them.
1822 (gnus-make-directory (nnheader-translate-file-chars
1823 (file-name-directory file) t))
1824
1825 (unless (eq 'nov (gnus-retrieve-headers articles group))
1826 (nnvirtual-convert-headers))
1827 (gnus-agent-check-overview-buffer)
1828 ;; Move these headers to the overview buffer so that
1829 ;; gnus-agent-braid-nov can merge them with the contents
1830 ;; of FILE.
1831 (copy-to-buffer
1832 gnus-agent-overview-buffer (point-min) (point-max))
54506618
MB		 1833 ;; NOTE: Call g-a-brand-nov even when the file does not
1834 ;; exist. As a minimum, it will validate the article
1835 ;; numbers already in the buffer.
1836 (gnus-agent-braid-nov group articles file)
23f87bed
MB		 1837 (let ((coding-system-for-write
1838 gnus-agent-file-coding-system))
1839 (gnus-agent-check-overview-buffer)
1840 (write-region (point-min) (point-max) file nil 'silent))
1841 (gnus-agent-save-alist group articles nil)
1842 articles)
1843 (ignore-errors
1844 (erase-buffer)
1845 (nnheader-insert-file-contents file)))))
1846 articles))
df80b09f 1847
54506618
MB		 1848(defsubst gnus-agent-read-article-number ()
1849 "Reads the article number at point. Returns nil when a valid article number can not be read."
1850
58090a8d 1851 ;; It is unfortunate but the read function quietly overflows
54506618
MB		 1852 ;; integer. As a result, I have to use string operations to test
1853 ;; for overflow BEFORE calling read.
1854 (when (looking-at "[0-9]+\t")
1855 (let ((len (- (match-end 0) (match-beginning 0))))
1856 (cond ((< len 9)
1857 (read (current-buffer)))
1858 ((= len 9)
1859 ;; Many 9 digit base-10 numbers can be represented in a 27-bit int
1860 ;; Back convert from int to string to ensure that this is one of them.
1861 (let* ((str1 (buffer-substring (match-beginning 0) (1- (match-end 0))))
1862 (num (read (current-buffer)))
1863 (str2 (int-to-string num)))
1864 (when (equal str1 str2)
1865 num)))))))
1866
df80b09f 1867(defsubst gnus-agent-copy-nov-line (article)
54506618 1868 "Copy the indicated ARTICLE from the overview buffer to the nntp server buffer."
23f87bed 1869 (let (art b e)
df80b09f 1870 (set-buffer gnus-agent-overview-buffer)
23f87bed 1871 (while (and (not (eobp))
54506618
MB		 1872 (or (not (setq art (gnus-agent-read-article-number)))
1873 (< art article)))
23f87bed
MB		 1874 (forward-line 1))
1875 (beginning-of-line)
1876 (if (or (eobp)
1877 (not (eq article art)))
1878 (set-buffer nntp-server-buffer)
1879 (setq b (point))
1880 (setq e (progn (forward-line 1) (point)))
1881 (set-buffer nntp-server-buffer)
1882 (insert-buffer-substring gnus-agent-overview-buffer b e))))
df80b09f
LMI		 1883
1884(defun gnus-agent-braid-nov (group articles file)
23f87bed 1885 "Merge agent overview data with given file.
54506618
MB		 1886Takes unvalidated headers for ARTICLES from
1887`gnus-agent-overview-buffer' and validated headers from the given
1888FILE and places the combined valid headers into
1889`nntp-server-buffer'. This function can be used, when file
1890doesn't exist, to valid the overview buffer."
23f87bed
MB		 1891 (let (start last)
1892 (set-buffer gnus-agent-overview-buffer)
1893 (goto-char (point-min))
1894 (set-buffer nntp-server-buffer)
1895 (erase-buffer)
54506618
MB		 1896 (when (file-exists-p file)
1897 (nnheader-insert-file-contents file))
23f87bed
MB		 1898 (goto-char (point-max))
1899 (forward-line -1)
54506618 1900
23f87bed
MB		 1901 (unless (or (= (point-min) (point-max))
1902 (< (setq last (read (current-buffer))) (car articles)))
54506618 1903 ;; Old and new overlap -- We do it the hard way.
23f87bed
MB		 1904 (when (nnheader-find-nov-line (car articles))
1905 ;; Replacing existing NOV entry
1906 (delete-region (point) (progn (forward-line 1) (point))))
1907 (gnus-agent-copy-nov-line (pop articles))
1908
1909 (ignore-errors
54506618
MB		 1910 (while articles
1911 (while (let ((art (read (current-buffer))))
1912 (cond ((< art (car articles))
1913 (forward-line 1)
1914 t)
1915 ((= art (car articles))
1916 (beginning-of-line)
1917 (delete-region
1918 (point) (progn (forward-line 1) (point)))
1919 nil)
1920 (t
1921 (beginning-of-line)
1922 nil))))
1923
1924 (gnus-agent-copy-nov-line (pop articles)))))
1925
23f87bed 1926 (goto-char (point-max))
54506618
MB		 1927
1928 ;; Append the remaining lines
df80b09f 1929 (when articles
23f87bed 1930 (when last
df80b09f 1931 (set-buffer gnus-agent-overview-buffer)
23f87bed
MB		 1932 (setq start (point))
1933 (set-buffer nntp-server-buffer))
54506618
MB		 1934
1935 (let ((p (point)))
1936 (insert-buffer-substring gnus-agent-overview-buffer start)
1937 (goto-char p))
1938
1939 (setq last (or last -134217728))
58090a8d 1940 (while (catch 'problems
54506618
MB		 1941 (let (sort art)
1942 (while (not (eobp))
1943 (setq art (gnus-agent-read-article-number))
1944 (cond ((not art)
1945 ;; Bad art num - delete this line
1946 (beginning-of-line)
1947 (delete-region (point) (progn (forward-line 1) (point))))
1948 ((< art last)
1949 ;; Art num out of order - enable sort
1950 (setq sort t)
1951 (forward-line 1))
58090a8d
MB		 1952 ((= art last)
1953 ;; Bad repeat of art number - delete this line
1954 (beginning-of-line)
1955 (delete-region (point) (progn (forward-line 1) (point))))
54506618
MB		 1956 (t
1957 ;; Good art num
1958 (setq last art)
1959 (forward-line 1))))
1960 (when sort
58090a8d
MB		 1961 ;; something is seriously wrong as we simply shouldn't see out-of-order data.
1962 ;; First, we'll fix the sort.
1963 (sort-numeric-fields 1 (point-min) (point-max))
1964
1965 ;; but now we have to consider that we may have duplicate rows...
1966 ;; so reset to beginning of file
1967 (goto-char (point-min))
1968 (setq last -134217728)
1969
1970 ;; and throw a code that restarts this scan
1971 (throw 'problems t))
1972 nil))))))
df80b09f 1973
23f87bed
MB		 1974;; Keeps the compiler from warning about the free variable in
1975;; gnus-agent-read-agentview.
1976(eval-when-compile
1977 (defvar gnus-agent-read-agentview))
df80b09f 1978
23f87bed
MB		 1979(defun gnus-agent-load-alist (group)
1980 "Load the article-state alist for GROUP."
1981 ;; Bind free variable that's used in `gnus-agent-read-agentview'.
1982 (let ((gnus-agent-read-agentview group))
1983 (setq gnus-agent-article-alist
1984 (gnus-cache-file-contents
1985 (gnus-agent-article-name ".agentview" group)
1986 'gnus-agent-file-loading-cache
1987 'gnus-agent-read-agentview))))
1988
23f87bed
MB		 1989(defun gnus-agent-read-agentview (file)
1990 "Load FILE and do a `read' there."
1991 (with-temp-buffer
54506618
MB		 1992 (condition-case nil
1993 (progn
23f87bed
MB		 1994 (nnheader-insert-file-contents file)
1995 (goto-char (point-min))
1996 (let ((alist (read (current-buffer)))
1997 (version (condition-case nil (read (current-buffer))
1998 (end-of-file 0)))
1999 changed-version)
2000
2001 (cond
2002 ((= version 0)
2003 (let ((inhibit-quit t)
2004 entry)
2005 (gnus-agent-open-history)
2006 (set-buffer (gnus-agent-history-buffer))
2007 (goto-char (point-min))
2008 (while (not (eobp))
2009 (if (and (looking-at
2010 "[^\t\n]+\t\\([0-9]+\\)\t\\([^ \n]+\\) \\([0-9]+\\)")
2011 (string= (match-string 2)
2012 gnus-agent-read-agentview)
2013 (setq entry (assoc (string-to-number (match-string 3)) alist)))
2014 (setcdr entry (string-to-number (match-string 1))))
2015 (forward-line 1))
2016 (gnus-agent-close-history)
2017 (setq changed-version t)))
2018 ((= version 1)
2019 (setq changed-version (not (= 1 gnus-agent-article-alist-save-format))))
2020 ((= version 2)
2021 (let (uncomp)
2022 (mapcar
2023 (lambda (comp-list)
2024 (let ((state (car comp-list))
54506618
MB		 2025 (sequence (inline
2026 (gnus-uncompress-range
2027 (cdr comp-list)))))
23f87bed
MB		 2028 (mapcar (lambda (article-id)
2029 (setq uncomp (cons (cons article-id state) uncomp)))
2030 sequence)))
2031 alist)
58090a8d
MB		 2032 (setq alist (sort uncomp 'car-less-than-car)))
2033 (setq changed-version (not (= 2 gnus-agent-article-alist-save-format)))))
23f87bed
MB		 2034 (when changed-version
2035 (let ((gnus-agent-article-alist alist))
2036 (gnus-agent-save-alist gnus-agent-read-agentview)))
54506618
MB		 2037 alist))
2038 (file-error nil))))
23f87bed
MB		 2039
2040(defun gnus-agent-save-alist (group &optional articles state)
df80b09f 2041 "Save the article-state alist for GROUP."
23f87bed
MB		 2042 (let* ((file-name-coding-system nnmail-pathname-coding-system)
2043 (prev (cons nil gnus-agent-article-alist))
2044 (all prev)
2045 print-level print-length item article)
2046 (while (setq article (pop articles))
2047 (while (and (cdr prev)
2048 (< (caadr prev) article))
2049 (setq prev (cdr prev)))
2050 (cond
2051 ((not (cdr prev))
2052 (setcdr prev (list (cons article state))))
2053 ((> (caadr prev) article)
2054 (setcdr prev (cons (cons article state) (cdr prev))))
2055 ((= (caadr prev) article)
2056 (setcdr (cadr prev) state)))
2057 (setq prev (cdr prev)))
2058 (setq gnus-agent-article-alist (cdr all))
2059
bf247b6e
KS		 2060 (gnus-agent-set-local group
2061 (caar gnus-agent-article-alist)
23f87bed
MB		 2062 (caar (last gnus-agent-article-alist)))
2063
2064 (gnus-make-directory (gnus-agent-article-name "" group))
2065 (with-temp-file (gnus-agent-article-name ".agentview" group)
2066 (cond ((eq gnus-agent-article-alist-save-format 1)
2067 (princ gnus-agent-article-alist (current-buffer)))
2068 ((eq gnus-agent-article-alist-save-format 2)
2069 (let ((compressed nil))
2070 (mapcar (lambda (pair)
2071 (let* ((article-id (car pair))
2072 (day-of-download (cdr pair))
2073 (comp-list (assq day-of-download compressed)))
2074 (if comp-list
2075 (setcdr comp-list
2076 (cons article-id (cdr comp-list)))
2077 (setq compressed
2078 (cons (list day-of-download article-id)
2079 compressed)))
2080 nil)) gnus-agent-article-alist)
2081 (mapcar (lambda (comp-list)
2082 (setcdr comp-list
2083 (gnus-compress-sequence
2084 (nreverse (cdr comp-list)))))
2085 compressed)
2086 (princ compressed (current-buffer)))))
2087 (insert "\n")
2088 (princ gnus-agent-article-alist-save-format (current-buffer))
2089 (insert "\n"))))
2090
2091(defvar gnus-agent-article-local nil)
2092(defvar gnus-agent-file-loading-local nil)
2093
2094(defun gnus-agent-load-local (&optional method)
2095 "Load the METHOD'S local file. The local file contains min/max
2096article counts for each of the method's subscribed groups."
2097 (let ((gnus-command-method (or method gnus-command-method)))
2098 (setq gnus-agent-article-local
2099 (gnus-cache-file-contents
2100 (gnus-agent-lib-file "local")
2101 'gnus-agent-file-loading-local
2102 'gnus-agent-read-and-cache-local))))
2103
2104(defun gnus-agent-read-and-cache-local (file)
2105 "Load and read FILE then bind its contents to
2106gnus-agent-article-local. If that variable had `dirty' (also known as
2107modified) original contents, they are first saved to their own file."
2108
2109 (if (and gnus-agent-article-local
2110 (symbol-value (intern "+dirty" gnus-agent-article-local)))
2111 (gnus-agent-save-local))
2112 (gnus-agent-read-local file))
2113
2114(defun gnus-agent-read-local (file)
2115 "Load FILE and do a `read' there."
bf247b6e 2116 (let ((my-obarray (gnus-make-hashtable (count-lines (point-min)
23f87bed
MB		 2117 (point-max))))
2118 (line 1))
2119 (with-temp-buffer
2120 (condition-case nil
54506618
MB		 2121 (let ((nnheader-file-coding-system gnus-agent-file-coding-system))
2122 (nnheader-insert-file-contents file))
23f87bed
MB		 2123 (file-error))
2124
2125 (goto-char (point-min))
2126 ;; Skip any comments at the beginning of the file (the only place where they may appear)
2127 (while (= (following-char) ?\;)
2128 (forward-line 1)
2129 (setq line (1+ line)))
2130
2131 (while (not (eobp))
2132 (condition-case err
bf247b6e 2133 (let (group
23f87bed
MB		 2134 min
2135 max
26c9afc3
MB		 2136 (cur (current-buffer))
2137 (obarray my-obarray))
23f87bed
MB		 2138 (setq group (read cur)
2139 min (read cur)
2140 max (read cur))
2141
2142 (when (stringp group)
2143 (setq group (intern group my-obarray)))
2144
2145 ;; NOTE: The '+ 0' ensure that min and max are both numerics.
2146 (set group (cons (+ 0 min) (+ 0 max))))
2147 (error
58090a8d 2148 (gnus-message 3 "Warning - invalid agent local: %s on line %d: %s"
23f87bed
MB		 2149 file line (error-message-string err))))
2150 (forward-line 1)
2151 (setq line (1+ line))))
bf247b6e 2152
23f87bed
MB		 2153 (set (intern "+dirty" my-obarray) nil)
2154 (set (intern "+method" my-obarray) gnus-command-method)
2155 my-obarray))
2156
2157(defun gnus-agent-save-local (&optional force)
2158 "Save gnus-agent-article-local under it method's agent.lib directory."
2159 (let ((my-obarray gnus-agent-article-local))
2160 (when (and my-obarray
2161 (or force (symbol-value (intern "+dirty" my-obarray))))
2162 (let* ((gnus-command-method (symbol-value (intern "+method" my-obarray)))
2163 ;; NOTE: gnus-command-method is used within gnus-agent-lib-file.
2164 (dest (gnus-agent-lib-file "local")))
2165 (gnus-make-directory (gnus-agent-lib-file ""))
54506618
MB		 2166
2167 (let ((buffer-file-coding-system gnus-agent-file-coding-system))
2168 (with-temp-file dest
2169 (let ((gnus-command-method (symbol-value (intern "+method" my-obarray)))
2170 (file-name-coding-system nnmail-pathname-coding-system)
2171 print-level print-length item article
2172 (standard-output (current-buffer)))
2173 (mapatoms (lambda (symbol)
2174 (cond ((not (boundp symbol))
2175 nil)
2176 ((member (symbol-name symbol) '("+dirty" "+method"))
2177 nil)
2178 (t
54506618 2179 (let ((range (symbol-value symbol)))
58090a8d
MB		 2180 (when range
2181 (prin1 symbol)
54506618
MB		 2182 (princ " ")
2183 (princ (car range))
2184 (princ " ")
2185 (princ (cdr range))
58090a8d 2186 (princ "\n"))))))
54506618
MB		 2187 my-obarray))))))))
2188
2189(defun gnus-agent-get-local (group &optional gmane method)
2190 (let* ((gmane (or gmane (gnus-group-real-name group)))
2191 (gnus-command-method (or method (gnus-find-method-for-group group)))
23f87bed
MB		 2192 (local (gnus-agent-load-local))
2193 (symb (intern gmane local))
2194 (minmax (and (boundp symb) (symbol-value symb))))
2195 (unless minmax
2196 ;; Bind these so that gnus-agent-load-alist doesn't change the
2197 ;; current alist (i.e. gnus-agent-article-alist)
2198 (let* ((gnus-agent-article-alist gnus-agent-article-alist)
2199 (gnus-agent-file-loading-cache gnus-agent-file-loading-cache)
2200 (alist (gnus-agent-load-alist group)))
2201 (when alist
2202 (setq minmax
2203 (cons (caar alist)
2204 (caar (last alist))))
bf247b6e 2205 (gnus-agent-set-local group (car minmax) (cdr minmax)
23f87bed
MB		 2206 gmane gnus-command-method local))))
2207 minmax))
2208
2209(defun gnus-agent-set-local (group min max &optional gmane method local)
2210 (let* ((gmane (or gmane (gnus-group-real-name group)))
2211 (gnus-command-method (or method (gnus-find-method-for-group group)))
2212 (local (or local (gnus-agent-load-local)))
2213 (symb (intern gmane local))
2214 (minmax (and (boundp symb) (symbol-value symb))))
bf247b6e 2215
23f87bed
MB		 2216 (if (cond ((and minmax
2217 (or (not (eq min (car minmax)))
26c9afc3
MB		 2218 (not (eq max (cdr minmax))))
2219 min
2220 max)
23f87bed
MB		 2221 (setcar minmax min)
2222 (setcdr minmax max)
2223 t)
2224 (minmax
2225 nil)
2226 ((and min max)
2227 (set symb (cons min max))
54506618
MB		 2228 t)
2229 (t
2230 (unintern symb local)))
23f87bed 2231 (set (intern "+dirty" local) t))))
df80b09f
LMI		 2232
2233(defun gnus-agent-article-name (article group)
23f87bed 2234 (expand-file-name article
850846fd 2235 (file-name-as-directory
23f87bed 2236 (gnus-agent-group-pathname group))))
df80b09f 2237
16409b0b
GM		 2238(defun gnus-agent-batch-confirmation (msg)
2239 "Show error message and return t."
2240 (gnus-message 1 msg)
2241 t)
2242
df80b09f
LMI		 2243;;;###autoload
2244(defun gnus-agent-batch-fetch ()
2245 "Start Gnus and fetch session."
2246 (interactive)
2247 (gnus)
16409b0b
GM		 2248 (let ((gnus-agent-confirmation-function 'gnus-agent-batch-confirmation))
2249 (gnus-agent-fetch-session))
df80b09f
LMI		 2250 (gnus-group-exit))
2251
2252(defun gnus-agent-fetch-session ()
2253 "Fetch all articles and headers that are eligible for fetching."
2254 (interactive)
2255 (unless gnus-agent-covered-methods
2256 (error "No servers are covered by the Gnus agent"))
2257 (unless gnus-plugged
2258 (error "Can't fetch articles while Gnus is unplugged"))
23f87bed 2259 (let ((methods (gnus-agent-covered-methods))
df80b09f
LMI		 2260 groups group gnus-command-method)
2261 (save-excursion
2262 (while methods
23f87bed
MB		 2263 (setq gnus-command-method (car methods))
2264 (when (and (or (gnus-server-opened gnus-command-method)
2265 (gnus-open-server gnus-command-method))
2266 (gnus-online gnus-command-method))
2267 (setq groups (gnus-groups-from-server (car methods)))
2268 (gnus-agent-with-fetch
2269 (while (setq group (pop groups))
2270 (when (<= (gnus-group-level group)
2271 gnus-agent-handle-level)
2272 (if (or debug-on-error debug-on-quit)
2273 (gnus-agent-fetch-group-1
2274 group gnus-command-method)
2275 (condition-case err
2276 (gnus-agent-fetch-group-1
2277 group gnus-command-method)
2278 (error
2279 (unless (funcall gnus-agent-confirmation-function
54506618 2280 (format "Error %s while fetching session. Should gnus continue? "
23f87bed
MB		 2281 (error-message-string err)))
2282 (error "Cannot fetch articles into the Gnus agent")))
2283 (quit
54506618 2284 (gnus-agent-regenerate-group group)
23f87bed
MB		 2285 (unless (funcall gnus-agent-confirmation-function
2286 (format
54506618 2287 "%s while fetching session. Should gnus continue? "
23f87bed
MB		 2288 (error-message-string err)))
2289 (signal 'quit
2290 "Cannot fetch articles into the Gnus agent")))))))))
2291 (setq methods (cdr methods)))
2292 (gnus-run-hooks 'gnus-agent-fetched-hook)
df80b09f
LMI		 2293 (gnus-message 6 "Finished fetching articles into the Gnus agent"))))
2294
2295(defun gnus-agent-fetch-group-1 (group method)
2296 "Fetch GROUP."
2297 (let ((gnus-command-method method)
16409b0b 2298 (gnus-newsgroup-name group)
23f87bed
MB		 2299 (gnus-newsgroup-dependencies gnus-newsgroup-dependencies)
2300 (gnus-newsgroup-headers gnus-newsgroup-headers)
2301 (gnus-newsgroup-scored gnus-newsgroup-scored)
2302 (gnus-use-cache gnus-use-cache)
16409b0b
GM		 2303 (gnus-summary-expunge-below gnus-summary-expunge-below)
2304 (gnus-summary-mark-below gnus-summary-mark-below)
2305 (gnus-orphan-score gnus-orphan-score)
2306 ;; Maybe some other gnus-summary local variables should also
2307 ;; be put here.
23f87bed
MB		 2308
2309 gnus-headers
2310 gnus-score
2311 articles arts
2312 category predicate info marks score-param
16409b0b
GM		 2313 )
2314 (unless (gnus-check-group group)
2315 (error "Can't open server for %s" group))
23f87bed 2316
df80b09f 2317 ;; Fetch headers.
23f87bed
MB		 2318 (when (or gnus-newsgroup-active
2319 (gnus-active group)
2320 (gnus-activate-group group))
2321 (let ((marked-articles gnus-newsgroup-downloadable))
2322 ;; Identify the articles marked for download
2323 (unless gnus-newsgroup-active
2324 ;; The variable gnus-newsgroup-active was selected as I need
2325 ;; a gnus-summary local variable that is NOT bound to any
2326 ;; value (its global value should default to nil).
2327 (dolist (mark gnus-agent-download-marks)
2328 (let ((arts (cdr (assq mark (gnus-info-marks
2329 (setq info (gnus-get-info group)))))))
2330 (when arts
2331 (setq marked-articles (nconc (gnus-uncompress-range arts)
2332 marked-articles))
2333 ))))
2334 (setq marked-articles (sort marked-articles '<))
2335
2336 ;; Fetch any new articles from the server
2337 (setq articles (gnus-agent-fetch-headers group))
2338
2339 ;; Merge new articles with marked
2340 (setq articles (sort (append marked-articles articles) '<))
2341
2342 (when articles
2343 ;; Parse them and see which articles we want to fetch.
2344 (setq gnus-newsgroup-dependencies
2345 (or gnus-newsgroup-dependencies
2346 (make-vector (length articles) 0)))
2347 (setq gnus-newsgroup-headers
2348 (or gnus-newsgroup-headers
2349 (gnus-get-newsgroup-headers-xover articles nil nil
2350 group)))
2351 ;; `gnus-agent-overview-buffer' may be killed for
2352 ;; timeout reason. If so, recreate it.
2353 (gnus-agent-create-buffer)
2354
2355 ;; Figure out how to select articles in this group
2356 (setq category (gnus-group-category group))
2357
2358 (setq predicate
2359 (gnus-get-predicate
2360 (gnus-agent-find-parameter group 'agent-predicate)))
2361
2362 ;; If the selection predicate requires scoring, score each header
2363 (unless (memq predicate '(gnus-agent-true gnus-agent-false))
2364 (let ((score-param
2365 (gnus-agent-find-parameter group 'agent-score-file)))
2366 ;; Translate score-param into real one
2367 (cond
2368 ((not score-param))
2369 ((eq score-param 'file)
2370 (setq score-param (gnus-all-score-files group)))
2371 ((stringp (car score-param)))
2372 (t
2373 (setq score-param (list (list score-param)))))
2374 (when score-param
2375 (gnus-score-headers score-param))))
2376
2377 (unless (and (eq predicate 'gnus-agent-false)
2378 (not marked-articles))
2379 (let ((arts (list nil)))
2380 (let ((arts-tail arts)
2381 (alist (gnus-agent-load-alist group))
2382 (marked-articles marked-articles)
2383 (gnus-newsgroup-headers gnus-newsgroup-headers))
2384 (while (setq gnus-headers (pop gnus-newsgroup-headers))
2385 (let ((num (mail-header-number gnus-headers)))
2386 ;; Determine if this article is already in the cache
2387 (while (and alist
2388 (> num (caar alist)))
2389 (setq alist (cdr alist)))
2390
2391 (unless (and (eq num (caar alist))
2392 (cdar alist))
2393
2394 ;; Determine if this article was marked for download.
2395 (while (and marked-articles
2396 (> num (car marked-articles)))
2397 (setq marked-articles
2398 (cdr marked-articles)))
2399
2400 ;; When this article is marked, or selected by the
2401 ;; predicate, add it to the download list
2402 (when (or (eq num (car marked-articles))
2403 (let ((gnus-score
2404 (or (cdr
2405 (assq num gnus-newsgroup-scored))
2406 gnus-summary-default-score))
2407 (gnus-agent-long-article
2408 (gnus-agent-find-parameter
2409 group 'agent-long-article))
2410 (gnus-agent-short-article
2411 (gnus-agent-find-parameter
2412 group 'agent-short-article))
2413 (gnus-agent-low-score
2414 (gnus-agent-find-parameter
2415 group 'agent-low-score))
2416 (gnus-agent-high-score
2417 (gnus-agent-find-parameter
2418 group 'agent-high-score))
2419 (gnus-agent-expire-days
2420 (gnus-agent-find-parameter
2421 group 'agent-days-until-old)))
2422 (funcall predicate)))
2423 (gnus-agent-append-to-list arts-tail num))))))
2424
2425 (let (fetched-articles)
2426 ;; Fetch all selected articles
2427 (setq gnus-newsgroup-undownloaded
2428 (gnus-sorted-ndifference
2429 gnus-newsgroup-undownloaded
2430 (setq fetched-articles
2431 (if (cdr arts)
2432 (gnus-agent-fetch-articles group (cdr arts))
2433 nil))))
2434
2435 (let ((unfetched-articles
2436 (gnus-sorted-ndifference (cdr arts) fetched-articles)))
2437 (if gnus-newsgroup-active
2438 ;; Update the summary buffer
2439 (progn
2440 (dolist (article marked-articles)
2441 (gnus-summary-set-agent-mark article t))
2442 (dolist (article fetched-articles)
58090a8d
MB		 2443 (when gnus-agent-mark-unread-after-downloaded
2444 (setq gnus-newsgroup-downloadable
2445 (delq article gnus-newsgroup-downloadable))
23f87bed
MB		 2446 (gnus-summary-mark-article
2447 article gnus-unread-mark))
2448 (when (gnus-summary-goto-subject article nil t)
2449 (gnus-summary-update-download-mark article)))
2450 (dolist (article unfetched-articles)
2451 (gnus-summary-mark-article
2452 article gnus-canceled-mark)))
2453
2454 ;; Update the group buffer.
2455
2456 ;; When some, or all, of the marked articles came
2457 ;; from the download mark. Remove that mark. I
2458 ;; didn't do this earlier as I only want to remove
2459 ;; the marks after the fetch is completed.
2460
2461 (dolist (mark gnus-agent-download-marks)
2462 (when (eq mark 'download)
2463 (let ((marked-arts
2464 (assq mark (gnus-info-marks
2465 (setq info (gnus-get-info group))))))
2466 (when (cdr marked-arts)
2467 (setq marks
2468 (delq marked-arts (gnus-info-marks info)))
2469 (gnus-info-set-marks info marks)))))
2470 (let ((read (gnus-info-read
2471 (or info (setq info (gnus-get-info group))))))
2472 (gnus-info-set-read
2473 info (gnus-add-to-range read unfetched-articles)))
2474
2475 (gnus-group-update-group group t)
2476 (sit-for 0)
2477
2478 (gnus-dribble-enter
2479 (concat "(gnus-group-set-info '"
2480 (gnus-prin1-to-string info)
2481 ")"))))))))))))
df80b09f
LMI		 2482
2483;;;
2484;;; Agent Category Mode
2485;;;
2486
2487(defvar gnus-category-mode-hook nil
2488 "Hook run in `gnus-category-mode' buffers.")
2489
2490(defvar gnus-category-line-format " %(%20c%): %g\n"
23f87bed
MB		 2491 "Format of category lines.
2492
2493Valid specifiers include:
2494%c Topic name (string)
2495%g The number of groups in the topic (integer)
2496
2497General format specifiers can also be used. See Info node
2498`(gnus)Formatting Variables'.")
df80b09f
LMI		 2499
2500(defvar gnus-category-mode-line-format "Gnus: %%b"
2501 "The format specification for the category mode line.")
2502
23f87bed
MB		 2503(defvar gnus-agent-predicate 'false
2504 "The selection predicate used when no other source is available.")
2505
df80b09f
LMI		 2506(defvar gnus-agent-short-article 100
2507 "Articles that have fewer lines than this are short.")
2508
2509(defvar gnus-agent-long-article 200
2510 "Articles that have more lines than this are long.")
2511
2512(defvar gnus-agent-low-score 0
2513 "Articles that have a score lower than this have a low score.")
2514
2515(defvar gnus-agent-high-score 0
2516 "Articles that have a score higher than this have a high score.")
2517
2518
2519;;; Internal variables.
2520
2521(defvar gnus-category-buffer "*Agent Category*")
2522
2523(defvar gnus-category-line-format-alist
2524 `((?c gnus-tmp-name ?s)
2525 (?g gnus-tmp-groups ?d)))
2526
2527(defvar gnus-category-mode-line-format-alist
2528 `((?u user-defined ?s)))
2529
2530(defvar gnus-category-line-format-spec nil)
2531(defvar gnus-category-mode-line-format-spec nil)
2532
2533(defvar gnus-category-mode-map nil)
2534(put 'gnus-category-mode 'mode-class 'special)
2535
2536(unless gnus-category-mode-map
2537 (setq gnus-category-mode-map (make-sparse-keymap))
2538 (suppress-keymap gnus-category-mode-map)
2539
2540 (gnus-define-keys gnus-category-mode-map
2541 "q" gnus-category-exit
2542 "k" gnus-category-kill
2543 "c" gnus-category-copy
2544 "a" gnus-category-add
23f87bed 2545 "e" gnus-agent-customize-category
df80b09f
LMI		 2546 "p" gnus-category-edit-predicate
2547 "g" gnus-category-edit-groups
2548 "s" gnus-category-edit-score
2549 "l" gnus-category-list
2550
2551 "\C-c\C-i" gnus-info-find-node
2552 "\C-c\C-b" gnus-bug))
2553
2554(defvar gnus-category-menu-hook nil
2555 "*Hook run after the creation of the menu.")
2556
2557(defun gnus-category-make-menu-bar ()
2558 (gnus-turn-off-edit-menu 'category)
2559 (unless (boundp 'gnus-category-menu)
2560 (easy-menu-define
2561 gnus-category-menu gnus-category-mode-map ""
2562 '("Categories"
2563 ["Add" gnus-category-add t]
2564 ["Kill" gnus-category-kill t]
2565 ["Copy" gnus-category-copy t]
23f87bed 2566 ["Edit category" gnus-agent-customize-category t]
df80b09f
LMI		 2567 ["Edit predicate" gnus-category-edit-predicate t]
2568 ["Edit score" gnus-category-edit-score t]
2569 ["Edit groups" gnus-category-edit-groups t]
2570 ["Exit" gnus-category-exit t]))
2571
2572 (gnus-run-hooks 'gnus-category-menu-hook)))
2573
2574(defun gnus-category-mode ()
2575 "Major mode for listing and editing agent categories.
2576
2577All normal editing commands are switched off.
2578\\<gnus-category-mode-map>
2579For more in-depth information on this mode, read the manual
23f87bed 2580\(`\\[gnus-info-find-node]').
df80b09f
LMI		 2581
2582The following commands are available:
2583
2584\\{gnus-category-mode-map}"
2585 (interactive)
2586 (when (gnus-visual-p 'category-menu 'menu)
2587 (gnus-category-make-menu-bar))
2588 (kill-all-local-variables)
2589 (gnus-simplify-mode-line)
2590 (setq major-mode 'gnus-category-mode)
2591 (setq mode-name "Category")
2592 (gnus-set-default-directory)
2593 (setq mode-line-process nil)
2594 (use-local-map gnus-category-mode-map)
16409b0b 2595 (buffer-disable-undo)
df80b09f
LMI		 2596 (setq truncate-lines t)
2597 (setq buffer-read-only t)
cfcd5c91 2598 (gnus-run-mode-hooks 'gnus-category-mode-hook))
df80b09f
LMI		 2599
2600(defalias 'gnus-category-position-point 'gnus-goto-colon)
2601
2602(defun gnus-category-insert-line (category)
23f87bed
MB		 2603 (let* ((gnus-tmp-name (format "%s" (car category)))
2604 (gnus-tmp-groups (length (gnus-agent-cat-groups category))))
df80b09f
LMI		 2605 (beginning-of-line)
2606 (gnus-add-text-properties
2607 (point)
2608 (prog1 (1+ (point))
2609 ;; Insert the text.
2610 (eval gnus-category-line-format-spec))
2611 (list 'gnus-category gnus-tmp-name))))
2612
2613(defun gnus-enter-category-buffer ()
2614 "Go to the Category buffer."
2615 (interactive)
2616 (gnus-category-setup-buffer)
2617 (gnus-configure-windows 'category)
2618 (gnus-category-prepare))
2619
2620(defun gnus-category-setup-buffer ()
2621 (unless (get-buffer gnus-category-buffer)
2622 (save-excursion
2623 (set-buffer (gnus-get-buffer-create gnus-category-buffer))
2624 (gnus-category-mode))))
2625
2626(defun gnus-category-prepare ()
2627 (gnus-set-format 'category-mode)
2628 (gnus-set-format 'category t)
2629 (let ((alist gnus-category-alist)
2630 (buffer-read-only nil))
2631 (erase-buffer)
2632 (while alist
2633 (gnus-category-insert-line (pop alist)))
2634 (goto-char (point-min))
2635 (gnus-category-position-point)))
2636
2637(defun gnus-category-name ()
23f87bed 2638 (or (intern (get-text-property (gnus-point-at-bol) 'gnus-category))
df80b09f
LMI		 2639 (error "No category on the current line")))
2640
2641(defun gnus-category-read ()
2642 "Read the category alist."
2643 (setq gnus-category-alist
23f87bed
MB		 2644 (or
2645 (with-temp-buffer
2646 (ignore-errors
2647 (nnheader-insert-file-contents (nnheader-concat gnus-agent-directory "lib/categories"))
2648 (goto-char (point-min))
2649 ;; This code isn't temp, it will be needed so long as
2650 ;; anyone may be migrating from an older version.
2651
2652 ;; Once we're certain that people will not revert to an
2653 ;; earlier version, we can take out the old-list code in
2654 ;; gnus-category-write.
2655 (let* ((old-list (read (current-buffer)))
2656 (new-list (ignore-errors (read (current-buffer)))))
2657 (if new-list
2658 new-list
2659 ;; Convert from a positional list to an alist.
2660 (mapcar
2661 (lambda (c)
2662 (setcdr c
2663 (delq nil
2664 (gnus-mapcar
2665 (lambda (valu symb)
2666 (if valu
2667 (cons symb valu)))
2668 (cdr c)
2669 '(agent-predicate agent-score-file agent-groups))))
2670 c)
2671 old-list)))))
2672 (list (gnus-agent-cat-make 'default 'short)))))
df80b09f
LMI		 2673
2674(defun gnus-category-write ()
2675 "Write the category alist."
2676 (setq gnus-category-predicate-cache nil
2677 gnus-category-group-cache nil)
16409b0b
GM		 2678 (gnus-make-directory (nnheader-concat gnus-agent-directory "lib"))
2679 (with-temp-file (nnheader-concat gnus-agent-directory "lib/categories")
23f87bed
MB		 2680 ;; This prin1 is temporary. It exists so that people can revert
2681 ;; to an earlier version of gnus-agent.
2682 (prin1 (mapcar (lambda (c)
2683 (list (car c)
2684 (cdr (assoc 'agent-predicate c))
2685 (cdr (assoc 'agent-score-file c))
2686 (cdr (assoc 'agent-groups c))))
2687 gnus-category-alist)
2688 (current-buffer))
2689 (newline)
df80b09f
LMI		 2690 (prin1 gnus-category-alist (current-buffer))))
2691
2692(defun gnus-category-edit-predicate (category)
2693 "Edit the predicate for CATEGORY."
2694 (interactive (list (gnus-category-name)))
2695 (let ((info (assq category gnus-category-alist)))
2696 (gnus-edit-form
23f87bed
MB		 2697 (gnus-agent-cat-predicate info)
2698 (format "Editing the select predicate for category %s" category)
df80b09f 2699 `(lambda (predicate)
23f87bed
MB		 2700 ;; Avoid run-time execution of setf form
2701 ;; (setf (gnus-agent-cat-predicate (assq ',category gnus-category-alist))
2702 ;; predicate)
2703 ;; use its expansion instead:
2704 (gnus-agent-cat-set-property (assq ',category gnus-category-alist)
2705 'agent-predicate predicate)
2706
df80b09f
LMI		 2707 (gnus-category-write)
2708 (gnus-category-list)))))
2709
2710(defun gnus-category-edit-score (category)
2711 "Edit the score expression for CATEGORY."
2712 (interactive (list (gnus-category-name)))
2713 (let ((info (assq category gnus-category-alist)))
2714 (gnus-edit-form
23f87bed 2715 (gnus-agent-cat-score-file info)
df80b09f 2716 (format "Editing the score expression for category %s" category)
23f87bed
MB		 2717 `(lambda (score-file)
2718 ;; Avoid run-time execution of setf form
2719 ;; (setf (gnus-agent-cat-score-file (assq ',category gnus-category-alist))
2720 ;; score-file)
2721 ;; use its expansion instead:
2722 (gnus-agent-cat-set-property (assq ',category gnus-category-alist)
2723 'agent-score-file score-file)
2724
df80b09f
LMI		 2725 (gnus-category-write)
2726 (gnus-category-list)))))
2727
2728(defun gnus-category-edit-groups (category)
2729 "Edit the group list for CATEGORY."
2730 (interactive (list (gnus-category-name)))
2731 (let ((info (assq category gnus-category-alist)))
2732 (gnus-edit-form
23f87bed
MB		 2733 (gnus-agent-cat-groups info)
2734 (format "Editing the group list for category %s" category)
df80b09f 2735 `(lambda (groups)
23f87bed
MB		 2736 ;; Avoid run-time execution of setf form
2737 ;; (setf (gnus-agent-cat-groups (assq ',category gnus-category-alist))
2738 ;; groups)
2739 ;; use its expansion instead:
2740 (gnus-agent-set-cat-groups (assq ',category gnus-category-alist)
2741 groups)
2742
df80b09f
LMI		 2743 (gnus-category-write)
2744 (gnus-category-list)))))
2745
2746(defun gnus-category-kill (category)
2747 "Kill the current category."
2748 (interactive (list (gnus-category-name)))
2749 (let ((info (assq category gnus-category-alist))
2750 (buffer-read-only nil))
2751 (gnus-delete-line)
16409b0b
GM		 2752 (setq gnus-category-alist (delq info gnus-category-alist))
2753 (gnus-category-write)))
df80b09f
LMI		 2754
2755(defun gnus-category-copy (category to)
2756 "Copy the current category."
2757 (interactive (list (gnus-category-name) (intern (read-string "New name: "))))
2758 (let ((info (assq category gnus-category-alist)))
23f87bed
MB		 2759 (push (let ((newcat (gnus-copy-sequence info)))
2760 (setf (gnus-agent-cat-name newcat) to)
2761 (setf (gnus-agent-cat-groups newcat) nil)
2762 newcat)
df80b09f
LMI		 2763 gnus-category-alist)
2764 (gnus-category-write)
2765 (gnus-category-list)))
2766
2767(defun gnus-category-add (category)
2768 "Create a new category."
2769 (interactive "SCategory name: ")
2770 (when (assq category gnus-category-alist)
2771 (error "Category %s already exists" category))
23f87bed 2772 (push (gnus-agent-cat-make category)
df80b09f
LMI		 2773 gnus-category-alist)
2774 (gnus-category-write)
2775 (gnus-category-list))
2776
2777(defun gnus-category-list ()
2778 "List all categories."
2779 (interactive)
2780 (gnus-category-prepare))
2781
2782(defun gnus-category-exit ()
2783 "Return to the group buffer."
2784 (interactive)
2785 (kill-buffer (current-buffer))
2786 (gnus-configure-windows 'group t))
2787
2788;; To avoid having 8-bit characters in the source file.
2789(defvar gnus-category-not (list '! 'not (intern (format "%c" 172))))
2790
2791(defvar gnus-category-predicate-alist
2792 '((spam . gnus-agent-spam-p)
2793 (short . gnus-agent-short-p)
2794 (long . gnus-agent-long-p)
2795 (low . gnus-agent-low-scored-p)
2796 (high . gnus-agent-high-scored-p)
23f87bed 2797 (read . gnus-agent-read-p)
df80b09f
LMI		 2798 (true . gnus-agent-true)
2799 (false . gnus-agent-false))
2800 "Mapping from short score predicate symbols to predicate functions.")
2801
2802(defun gnus-agent-spam-p ()
2803 "Say whether an article is spam or not."
2804 (unless gnus-agent-spam-hashtb
2805 (setq gnus-agent-spam-hashtb (gnus-make-hashtable 1000)))
2806 (if (not (equal (mail-header-references gnus-headers) ""))
2807 nil
2808 (let ((string (gnus-simplify-subject (mail-header-subject gnus-headers))))
2809 (prog1
2810 (gnus-gethash string gnus-agent-spam-hashtb)
2811 (gnus-sethash string t gnus-agent-spam-hashtb)))))
2812
2813(defun gnus-agent-short-p ()
2814 "Say whether an article is short or not."
2815 (< (mail-header-lines gnus-headers) gnus-agent-short-article))
2816
2817(defun gnus-agent-long-p ()
2818 "Say whether an article is long or not."
2819 (> (mail-header-lines gnus-headers) gnus-agent-long-article))
2820
2821(defun gnus-agent-low-scored-p ()
2822 "Say whether an article has a low score or not."
2823 (< gnus-score gnus-agent-low-score))
2824
2825(defun gnus-agent-high-scored-p ()
2826 "Say whether an article has a high score or not."
2827 (> gnus-score gnus-agent-high-score))
2828
23f87bed
MB		 2829(defun gnus-agent-read-p ()
2830 "Say whether an article is read or not."
2831 (gnus-member-of-range (mail-header-number gnus-headers)
2832 (gnus-info-read (gnus-get-info gnus-newsgroup-name))))
2833
2834(defun gnus-category-make-function (predicate)
2835 "Make a function from PREDICATE."
2836 (let ((func (gnus-category-make-function-1 predicate)))
2837 (if (and (= (length func) 1)
2838 (symbolp (car func)))
2839 (car func)
2840 (gnus-byte-compile `(lambda () ,func)))))
df80b09f
LMI		 2841
2842(defun gnus-agent-true ()
2843 "Return t."
2844 t)
2845
2846(defun gnus-agent-false ()
2847 "Return nil."
2848 nil)
2849
23f87bed
MB		 2850(defun gnus-category-make-function-1 (predicate)
2851 "Make a function from PREDICATE."
df80b09f
LMI		 2852 (cond
2853 ;; Functions are just returned as is.
23f87bed
MB		 2854 ((or (symbolp predicate)
2855 (functionp predicate))
2856 `(,(or (cdr (assq predicate gnus-category-predicate-alist))
2857 predicate)))
2858 ;; More complex predicate.
2859 ((consp predicate)
df80b09f 2860 `(,(cond
23f87bed 2861 ((memq (car predicate) '(& and))
df80b09f 2862 'and)
23f87bed 2863 ((memq (car predicate) '(| or))
df80b09f 2864 'or)
23f87bed 2865 ((memq (car predicate) gnus-category-not)
df80b09f 2866 'not))
23f87bed 2867 ,@(mapcar 'gnus-category-make-function-1 (cdr predicate))))
df80b09f 2868 (t
23f87bed 2869 (error "Unknown predicate type: %s" predicate))))
df80b09f
LMI		 2870
2871(defun gnus-get-predicate (predicate)
23f87bed 2872 "Return the function implementing PREDICATE."
df80b09f 2873 (or (cdr (assoc predicate gnus-category-predicate-cache))
23f87bed
MB		 2874 (let ((func (gnus-category-make-function predicate)))
2875 (setq gnus-category-predicate-cache
2876 (nconc gnus-category-predicate-cache
2877 (list (cons predicate func))))
2878 func)))
2879
2880(defun gnus-predicate-implies-unread (predicate)
2881 "Say whether PREDICATE implies unread articles only.
2882It is okay to miss some cases, but there must be no false positives.
2883That is, if this predicate returns true, then indeed the predicate must
2884return only unread articles."
bf247b6e 2885 (eq t (gnus-function-implies-unread-1
23f87bed
MB		 2886 (gnus-category-make-function-1 predicate))))
2887
2888(defun gnus-function-implies-unread-1 (function)
2889 "Recursively evaluate a predicate function to determine whether it can select
2890any read articles. Returns t if the function is known to never
2891return read articles, nil when it is known to always return read
2892articles, and t_nil when the function may return both read and unread
2893articles."
2894 (let ((func (car function))
2895 (args (mapcar 'gnus-function-implies-unread-1 (cdr function))))
2896 (cond ((eq func 'and)
2897 (cond ((memq t args) ; if any argument returns only unread articles
2898 ;; then that argument constrains the result to only unread articles.
2899 t)
2900 ((memq 't_nil args) ; if any argument is indeterminate
2901 ;; then the result is indeterminate
2902 't_nil)))
2903 ((eq func 'or)
2904 (cond ((memq nil args) ; if any argument returns read articles
2905 ;; then that argument ensures that the results includes read articles.
2906 nil)
2907 ((memq 't_nil args) ; if any argument is indeterminate
2908 ;; then that argument ensures that the results are indeterminate
2909 't_nil)
2910 (t ; if all arguments return only unread articles
2911 ;; then the result returns only unread articles
2912 t)))
2913 ((eq func 'not)
2914 (cond ((eq (car args) 't_nil) ; if the argument is indeterminate
2915 ; then the result is indeterminate
2916 (car args))
2917 (t ; otherwise
2918 ; toggle the result to be the opposite of the argument
2919 (not (car args)))))
2920 ((eq func 'gnus-agent-read-p)
2921 nil) ; The read predicate NEVER returns unread articles
2922 ((eq func 'gnus-agent-false)
2923 t) ; The false predicate returns t as the empty set excludes all read articles
2924 ((eq func 'gnus-agent-true)
2925 nil) ; The true predicate ALWAYS returns read articles
2926 ((catch 'found-match
2927 (let ((alist gnus-category-predicate-alist))
2928 (while alist
2929 (if (eq func (cdar alist))
2930 (throw 'found-match t)
2931 (setq alist (cdr alist))))))
2932 't_nil) ; All other predicates return read and unread articles
2933 (t
2934 (error "Unknown predicate function: %s" function)))))
df80b09f
LMI		 2935
2936(defun gnus-group-category (group)
2937 "Return the category GROUP belongs to."
2938 (unless gnus-category-group-cache
2939 (setq gnus-category-group-cache (gnus-make-hashtable 1000))
2940 (let ((cs gnus-category-alist)
2941 groups cat)
2942 (while (setq cat (pop cs))
23f87bed 2943 (setq groups (gnus-agent-cat-groups cat))
df80b09f
LMI		 2944 (while groups
2945 (gnus-sethash (pop groups) cat gnus-category-group-cache)))))
2946 (or (gnus-gethash group gnus-category-group-cache)
2947 (assq 'default gnus-category-alist)))
2948
23f87bed
MB		 2949(defun gnus-agent-expire-group (group &optional articles force)
2950 "Expire all old articles in GROUP.
2951If you want to force expiring of certain articles, this function can
2952take ARTICLES, and FORCE parameters as well.
2953
2954The articles on which the expiration process runs are selected as follows:
2955 if ARTICLES is null, all read and unmarked articles.
2956 if ARTICLES is t, all articles.
2957 if ARTICLES is a list, just those articles.
2958FORCE is equivalent to setting the expiration predicates to true."
2959 (interactive
2960 (list (let ((def (or (gnus-group-group-name)
2961 gnus-newsgroup-name)))
2962 (let ((select (read-string (if def
2963 (concat "Group Name ("
2964 def "): ")
2965 "Group Name: "))))
2966 (if (and (equal "" select)
2967 def)
2968 def
2969 select)))))
2970
2971 (if (not group)
2972 (gnus-agent-expire articles group force)
2973 (let ( ;; Bind gnus-agent-expire-stats to enable tracking of
2974 ;; expiration statistics of this single group
2975 (gnus-agent-expire-stats (list 0 0 0.0)))
2976 (if (or (not (eq articles t))
2977 (yes-or-no-p
2978 (concat "Are you sure that you want to "
66841476 2979 "expire all articles in " group "? ")))
23f87bed
MB		 2980 (let ((gnus-command-method (gnus-find-method-for-group group))
2981 (overview (gnus-get-buffer-create " *expire overview*"))
2982 orig)
2983 (unwind-protect
2984 (let ((active-file (gnus-agent-lib-file "active")))
2985 (when (file-exists-p active-file)
2986 (with-temp-buffer
2987 (nnheader-insert-file-contents active-file)
2988 (gnus-active-to-gnus-format
2989 gnus-command-method
2990 (setq orig (gnus-make-hashtable
2991 (count-lines (point-min) (point-max))))))
2992 (save-excursion
2993 (gnus-agent-expire-group-1
2994 group overview (gnus-gethash-safe group orig)
2995 articles force))))
2996 (kill-buffer overview))))
2997 (gnus-message 4 (gnus-agent-expire-done-message)))))
2998
2999(defun gnus-agent-expire-group-1 (group overview active articles force)
3000 ;; Internal function - requires caller to have set
3001 ;; gnus-command-method, initialized overview buffer, and to have
3002 ;; provided a non-nil active
3003
3004 (let ((dir (gnus-agent-group-pathname group)))
3005 (when (boundp 'gnus-agent-expire-current-dirs)
bf247b6e
KS		 3006 (set 'gnus-agent-expire-current-dirs
3007 (cons dir
54506618 3008 (symbol-value 'gnus-agent-expire-current-dirs))))
23f87bed
MB		 3009
3010 (if (and (not force)
bf247b6e 3011 (eq 'DISABLE (gnus-agent-find-parameter group
54506618
MB		 3012 'agent-enable-expiration)))
3013 (gnus-message 5 "Expiry skipping over %s" group)
23f87bed
MB		 3014 (gnus-message 5 "Expiring articles in %s" group)
3015 (gnus-agent-load-alist group)
54506618
MB		 3016 (let* ((bytes-freed 0)
3017 (files-deleted 0)
3018 (nov-entries-deleted 0)
3019 (info (gnus-get-info group))
3020 (alist gnus-agent-article-alist)
3021 (day (- (time-to-days (current-time))
3022 (gnus-agent-find-parameter group 'agent-days-until-old)))
3023 (specials (if (and alist
3024 (not force))
3025 ;; This could be a bit of a problem. I need to
3026 ;; keep the last article to avoid refetching
3027 ;; headers when using nntp in the backend. At
3028 ;; the same time, if someone uses a backend
3029 ;; that supports article moving then I may have
3030 ;; to remove the last article to complete the
3031 ;; move. Right now, I'm going to assume that
3032 ;; FORCE overrides specials.
3033 (list (caar (last alist)))))
3034 (unreads ;; Articles that are excluded from the
3035 ;; expiration process
3036 (cond (gnus-agent-expire-all
3037 ;; All articles are marked read by global decree
3038 nil)
3039 ((eq articles t)
3040 ;; All articles are marked read by function
3041 ;; parameter
3042 nil)
3043 ((not articles)
3044 ;; Unread articles are marked protected from
3045 ;; expiration Don't call
3046 ;; gnus-list-of-unread-articles as it returns
3047 ;; articles that have not been fetched into the
3048 ;; agent.
3049 (ignore-errors
3050 (gnus-agent-unread-articles group)))
3051 (t
3052 ;; All articles EXCEPT those named by the caller
3053 ;; are protected from expiration
3054 (gnus-sorted-difference
3055 (gnus-uncompress-range
3056 (cons (caar alist)
3057 (caar (last alist))))
3058 (sort articles '<)))))
3059 (marked ;; More articles that are excluded from the
3060 ;; expiration process
3061 (cond (gnus-agent-expire-all
3062 ;; All articles are unmarked by global decree
3063 nil)
3064 ((eq articles t)
3065 ;; All articles are unmarked by function
3066 ;; parameter
3067 nil)
3068 (articles
3069 ;; All articles may as well be unmarked as the
3070 ;; unreads list already names the articles we are
3071 ;; going to keep
3072 nil)
3073 (t
3074 ;; Ticked and/or dormant articles are excluded
3075 ;; from expiration
3076 (nconc
3077 (gnus-uncompress-range
3078 (cdr (assq 'tick (gnus-info-marks info))))
3079 (gnus-uncompress-range
3080 (cdr (assq 'dormant
3081 (gnus-info-marks info))))))))
3082 (nov-file (concat dir ".overview"))
3083 (cnt 0)
3084 (completed -1)
3085 dlist
3086 type)
3087
3088 ;; The normal article alist contains elements that look like
3089 ;; (article# . fetch_date) I need to combine other
3090 ;; information with this list. For example, a flag indicating
3091 ;; that a particular article MUST BE KEPT. To do this, I'm
3092 ;; going to transform the elements to look like (article#
3093 ;; fetch_date keep_flag NOV_entry_marker) Later, I'll reverse
3094 ;; the process to generate the expired article alist.
3095
3096 ;; Convert the alist elements to (article# fetch_date nil
3097 ;; nil).
3098 (setq dlist (mapcar (lambda (e)
3099 (list (car e) (cdr e) nil nil)) alist))
3100
3101 ;; Convert the keep lists to elements that look like (article#
3102 ;; nil keep_flag nil) then append it to the expanded dlist
3103 ;; These statements are sorted by ascending precidence of the
3104 ;; keep_flag.
3105 (setq dlist (nconc dlist
3106 (mapcar (lambda (e)
3107 (list e nil 'unread nil))
3108 unreads)))
3109 (setq dlist (nconc dlist
3110 (mapcar (lambda (e)
3111 (list e nil 'marked nil))
3112 marked)))
3113 (setq dlist (nconc dlist
3114 (mapcar (lambda (e)
3115 (list e nil 'special nil))
3116 specials)))
3117
3118 (set-buffer overview)
3119 (erase-buffer)
3120 (buffer-disable-undo)
3121 (when (file-exists-p nov-file)
3122 (gnus-message 7 "gnus-agent-expire: Loading overview...")
3123 (nnheader-insert-file-contents nov-file)
3124 (goto-char (point-min))
3125
3126 (let (p)
3127 (while (< (setq p (point)) (point-max))
3128 (condition-case nil
3129 ;; If I successfully read an integer (the plus zero
3130 ;; ensures a numeric type), prepend a marker entry
3131 ;; to the list
3132 (push (list (+ 0 (read (current-buffer))) nil nil
3133 (set-marker (make-marker) p))
3134 dlist)
3135 (error
3136 (gnus-message 1 "gnus-agent-expire: read error \
23f87bed
MB		 3137occurred when reading expression at %s in %s. Skipping to next \
3138line." (point) nov-file)))
54506618
MB		 3139 ;; Whether I succeeded, or failed, it doesn't matter.
3140 ;; Move to the next line then try again.
3141 (forward-line 1)))
3142
3143 (gnus-message
3144 7 "gnus-agent-expire: Loading overview... Done"))
3145 (set-buffer-modified-p nil)
3146
3147 ;; At this point, all of the information is in dlist. The
3148 ;; only problem is that much of it is spread across multiple
3149 ;; entries. Sort then MERGE!!
3150 (gnus-message 7 "gnus-agent-expire: Sorting entries... ")
3151 ;; If two entries have the same article-number then sort by
3152 ;; ascending keep_flag.
3153 (let ((special 0)
3154 (marked 1)
3155 (unread 2))
3156 (setq dlist
3157 (sort dlist
3158 (lambda (a b)
3159 (cond ((< (nth 0 a) (nth 0 b))
3160 t)
3161 ((> (nth 0 a) (nth 0 b))
3162 nil)
3163 (t
3164 (let ((a (or (symbol-value (nth 2 a))
3165 3))
3166 (b (or (symbol-value (nth 2 b))
3167 3)))
3168 (<= a b))))))))
3169 (gnus-message 7 "gnus-agent-expire: Sorting entries... Done")
3170 (gnus-message 7 "gnus-agent-expire: Merging entries... ")
3171 (let ((dlist dlist))
3172 (while (cdr dlist) ; I'm not at the end-of-list
3173 (if (eq (caar dlist) (caadr dlist))
3174 (let ((first (cdr (car dlist)))
3175 (secnd (cdr (cadr dlist))))
3176 (setcar first (or (car first)
3177 (car secnd))) ; fetch_date
3178 (setq first (cdr first)
3179 secnd (cdr secnd))
3180 (setcar first (or (car first)
3181 (car secnd))) ; Keep_flag
3182 (setq first (cdr first)
3183 secnd (cdr secnd))
3184 (setcar first (or (car first)
3185 (car secnd))) ; NOV_entry_marker
3186
3187 (setcdr dlist (cddr dlist)))
3188 (setq dlist (cdr dlist)))))
3189 (gnus-message 7 "gnus-agent-expire: Merging entries... Done")
3190
3191 (let* ((len (float (length dlist)))
3192 (alist (list nil))
3193 (tail-alist alist))
3194 (while dlist
3195 (let ((new-completed (truncate (* 100.0
3196 (/ (setq cnt (1+ cnt))
3197 len))))
23f87bed 3198 message-log-max)
54506618
MB		 3199 (when (> new-completed completed)
3200 (setq completed new-completed)
3201 (gnus-message 7 "%3d%% completed..." completed)))
3202 (let* ((entry (car dlist))
3203 (article-number (nth 0 entry))
3204 (fetch-date (nth 1 entry))
3205 (keep (nth 2 entry))
3206 (marker (nth 3 entry)))
3207
3208 (cond
3209 ;; Kept articles are unread, marked, or special.
3210 (keep
3211 (gnus-agent-message 10
3212 "gnus-agent-expire: %s:%d: Kept %s article%s."
3213 group article-number keep (if fetch-date " and file" ""))
3214 (when fetch-date
3215 (unless (file-exists-p
3216 (concat dir (number-to-string
3217 article-number)))
3218 (setf (nth 1 entry) nil)
3219 (gnus-agent-message 3 "gnus-agent-expire cleared \
23f87bed 3220download flag on %s:%d as the cached article file is missing."
54506618
MB		 3221 group (caar dlist)))
3222 (unless marker
3223 (gnus-message 1 "gnus-agent-expire detected a \
23f87bed 3224missing NOV entry. Run gnus-agent-regenerate-group to restore it.")))
54506618
MB		 3225 (gnus-agent-append-to-list
3226 tail-alist
3227 (cons article-number fetch-date)))
3228
3229 ;; The following articles are READ, UNMARKED, and
3230 ;; ORDINARY. See if they can be EXPIRED!!!
3231 ((setq type
3232 (cond
3233 ((not (integerp fetch-date))
58090a8d 3234 'read) ;; never fetched article (may expire
54506618
MB		 3235 ;; right now)
3236 ((not (file-exists-p
3237 (concat dir (number-to-string
3238 article-number))))
3239 (setf (nth 1 entry) nil)
3240 'externally-expired) ;; Can't find the cached
3241 ;; article. Handle case
3242 ;; as though this article
3243 ;; was never fetched.
3244
3245 ;; We now have the arrival day, so we see
3246 ;; whether it's old enough to be expired.
3247 ((< fetch-date day)
3248 'expired)
3249 (force
3250 'forced)))
3251
3252 ;; I found some reason to expire this entry.
3253
3254 (let ((actions nil))
3255 (when (memq type '(forced expired))
3256 (ignore-errors ; Just being paranoid.
3257 (let* ((file-name (nnheader-concat dir (number-to-string
3258 article-number)))
3259 (size (float (nth 7 (file-attributes file-name)))))
3260 (incf bytes-freed size)
3261 (incf files-deleted)
3262 (delete-file file-name))
3263 (push "expired cached article" actions))
3264 (setf (nth 1 entry) nil)
3265 )
3266
3267 (when marker
3268 (push "NOV entry removed" actions)
3269 (goto-char marker)
3270
3271 (incf nov-entries-deleted)
3272
3273 (let ((from (gnus-point-at-bol))
3274 (to (progn (forward-line 1) (point))))
3275 (incf bytes-freed (- to from))
3276 (delete-region from to)))
3277
3278 ;; If considering all articles is set, I can only
3279 ;; expire article IDs that are no longer in the
3280 ;; active range (That is, articles that preceed the
3281 ;; first article in the new alist).
3282 (if (and gnus-agent-consider-all-articles
3283 (>= article-number (car active)))
3284 ;; I have to keep this ID in the alist
3285 (gnus-agent-append-to-list
3286 tail-alist (cons article-number fetch-date))
3287 (push (format "Removed %s article number from \
23f87bed
MB		 3288article alist" type) actions))
3289
3290 (when actions
3291 (gnus-agent-message 8 "gnus-agent-expire: %s:%d: %s"
3292 group article-number
3293 (mapconcat 'identity actions ", ")))))
54506618
MB		 3294 (t
3295 (gnus-agent-message
3296 10 "gnus-agent-expire: %s:%d: Article kept as \
23f87bed 3297expiration tests failed." group article-number)
54506618
MB		 3298 (gnus-agent-append-to-list
3299 tail-alist (cons article-number fetch-date)))
3300 )
3301
3302 ;; Clean up markers as I want to recycle this buffer
3303 ;; over several groups.
3304 (when marker
3305 (set-marker marker nil))
3306
3307 (setq dlist (cdr dlist))))
3308
3309 (setq alist (cdr alist))
3310
3311 (let ((inhibit-quit t))
3312 (unless (equal alist gnus-agent-article-alist)
3313 (setq gnus-agent-article-alist alist)
3314 (gnus-agent-save-alist group))
3315
3316 (when (buffer-modified-p)
3317 (let ((coding-system-for-write
3318 gnus-agent-file-coding-system))
3319 (gnus-make-directory dir)
3320 (write-region (point-min) (point-max) nov-file nil
3321 'silent)
3322 ;; clear the modified flag as that I'm not confused by
3323 ;; its status on the next pass through this routine.
3324 (set-buffer-modified-p nil)))
3325
3326 (when (eq articles t)
3327 (gnus-summary-update-info))))
3328
3329 (when (boundp 'gnus-agent-expire-stats)
3330 (let ((stats (symbol-value 'gnus-agent-expire-stats)))
3331 (incf (nth 2 stats) bytes-freed)
3332 (incf (nth 1 stats) files-deleted)
3333 (incf (nth 0 stats) nov-entries-deleted)))
3334 ))))
23f87bed
MB		 3335
3336(defun gnus-agent-expire (&optional articles group force)
3337 "Expire all old articles.
3338If you want to force expiring of certain articles, this function can
3339take ARTICLES, GROUP and FORCE parameters as well.
3340
3341The articles on which the expiration process runs are selected as follows:
3342 if ARTICLES is null, all read and unmarked articles.
3343 if ARTICLES is t, all articles.
3344 if ARTICLES is a list, just those articles.
3345Setting GROUP will limit expiration to that group.
3346FORCE is equivalent to setting the expiration predicates to true."
df80b09f 3347 (interactive)
bf247b6e 3348
23f87bed
MB		 3349 (if group
3350 (gnus-agent-expire-group group articles force)
3351 (if (or (not (eq articles t))
3352 (yes-or-no-p "Are you sure that you want to expire all \
66841476 3353articles in every agentized group? "))
23f87bed
MB		 3354 (let ((methods (gnus-agent-covered-methods))
3355 ;; Bind gnus-agent-expire-current-dirs to enable tracking
3356 ;; of agent directories.
3357 (gnus-agent-expire-current-dirs nil)
3358 ;; Bind gnus-agent-expire-stats to enable tracking of
3359 ;; expiration statistics across all groups
3360 (gnus-agent-expire-stats (list 0 0 0.0))
3361 gnus-command-method overview orig)
3362 (setq overview (gnus-get-buffer-create " *expire overview*"))
3363 (unwind-protect
3364 (while (setq gnus-command-method (pop methods))
3365 (let ((active-file (gnus-agent-lib-file "active")))
3366 (when (file-exists-p active-file)
3367 (with-temp-buffer
3368 (nnheader-insert-file-contents active-file)
3369 (gnus-active-to-gnus-format
3370 gnus-command-method
3371 (setq orig (gnus-make-hashtable
3372 (count-lines (point-min) (point-max))))))
3373 (dolist (expiring-group (gnus-groups-from-server
3374 gnus-command-method))
3375 (let* ((active
3376 (gnus-gethash-safe expiring-group orig)))
bf247b6e 3377
23f87bed
MB		 3378 (when active
3379 (save-excursion
3380 (gnus-agent-expire-group-1
3381 expiring-group overview active articles force))))))))
3382 (kill-buffer overview))
3383 (gnus-agent-expire-unagentized-dirs)
3384 (gnus-message 4 (gnus-agent-expire-done-message))))))
3385
3386(defun gnus-agent-expire-done-message ()
3387 (if (and (> gnus-verbose 4)
3388 (boundp 'gnus-agent-expire-stats))
3389 (let* ((stats (symbol-value 'gnus-agent-expire-stats))
3390 (size (nth 2 stats))
3391 (units '(B KB MB GB)))
3392 (while (and (> size 1024.0)
3393 (cdr units))
3394 (setq size (/ size 1024.0)
3395 units (cdr units)))
3396
3397 (format "Expiry recovered %d NOV entries, deleted %d files,\
bf247b6e
KS		 3398 and freed %f %s."
3399 (nth 0 stats)
3400 (nth 1 stats)
23f87bed
MB		 3401 size (car units)))
3402 "Expiry...done"))
3403
3404(defun gnus-agent-expire-unagentized-dirs ()
3405 (when (and gnus-agent-expire-unagentized-dirs
3406 (boundp 'gnus-agent-expire-current-dirs))
3407 (let* ((keep (gnus-make-hashtable))
3408 ;; Formally bind gnus-agent-expire-current-dirs so that the
3409 ;; compiler will not complain about free references.
3410 (gnus-agent-expire-current-dirs
3411 (symbol-value 'gnus-agent-expire-current-dirs))
3412 dir)
3413
3414 (gnus-sethash gnus-agent-directory t keep)
3415 (while gnus-agent-expire-current-dirs
3416 (setq dir (pop gnus-agent-expire-current-dirs))
3417 (when (and (stringp dir)
3418 (file-directory-p dir))
3419 (while (not (gnus-gethash dir keep))
3420 (gnus-sethash dir t keep)
3421 (setq dir (file-name-directory (directory-file-name dir))))))
3422
3423 (let* (to-remove
3424 checker
3425 (checker
3426 (function
3427 (lambda (d)
bf247b6e
KS		 3428 "Given a directory, check it and its subdirectories for
3429 membership in the keep hash. If it isn't found, add
3430 it to to-remove."
23f87bed
MB		 3431 (let ((files (directory-files d))
3432 file)
3433 (while (setq file (pop files))
3434 (cond ((equal file ".") ; Ignore self
3435 nil)
3436 ((equal file "..") ; Ignore parent
3437 nil)
bf247b6e 3438 ((equal file ".overview")
23f87bed
MB		 3439 ;; Directory must contain .overview to be
3440 ;; agent's cache of a group.
3441 (let ((d (file-name-as-directory d))
3442 r)
3443 ;; Search ancestor's for last directory NOT
3444 ;; found in keep hash.
3445 (while (not (gnus-gethash
3446 (setq d (file-name-directory d)) keep))
3447 (setq r d
3448 d (directory-file-name d)))
3449 ;; if ANY ancestor was NOT in keep hash and
3450 ;; it it's already in to-remove, add it to
bf247b6e 3451 ;; to-remove.
23f87bed
MB		 3452 (if (and r
3453 (not (member r to-remove)))
3454 (push r to-remove))))
3455 ((file-directory-p (setq file (nnheader-concat d file)))
3456 (funcall checker file)))))))))
3457 (funcall checker (expand-file-name gnus-agent-directory))
3458
3459 (when (and to-remove
3460 (or gnus-expert-user
3461 (gnus-y-or-n-p
3462 "gnus-agent-expire has identified local directories that are\
3463 not currently required by any agentized group. Do you wish to consider\
3464 deleting them?")))
3465 (while to-remove
3466 (let ((dir (pop to-remove)))
3467 (if (gnus-y-or-n-p (format "Delete %s? " dir))
3468 (let* (delete-recursive
3469 (delete-recursive
3470 (function
3471 (lambda (f-or-d)
3472 (ignore-errors
3473 (if (file-directory-p f-or-d)
3474 (condition-case nil
3475 (delete-directory f-or-d)
3476 (file-error
3477 (mapcar (lambda (f)
3478 (or (member f '("." ".."))
3479 (funcall delete-recursive
3480 (nnheader-concat
3481 f-or-d f))))
3482 (directory-files f-or-d))
3483 (delete-directory f-or-d)))
3484 (delete-file f-or-d)))))))
3485 (funcall delete-recursive dir))))))))))
df80b09f
LMI		 3486
3487;;;###autoload
3488(defun gnus-agent-batch ()
23f87bed 3489 "Start Gnus, send queue and fetch session."
df80b09f
LMI		 3490 (interactive)
3491 (let ((init-file-user "")
3492 (gnus-always-read-dribble-file t))
3493 (gnus))
23f87bed
MB		 3494 (let ((gnus-agent-confirmation-function 'gnus-agent-batch-confirmation))
3495 (gnus-group-send-queue)
3496 (gnus-agent-fetch-session)))
3497
3498(defun gnus-agent-unread-articles (group)
3499 (let* ((read (gnus-info-read (gnus-get-info group)))
3500 (known (gnus-agent-load-alist group))
3501 (unread (list nil))
3502 (tail-unread unread))
3503 (while (and known read)
3504 (let ((candidate (car (pop known))))
3505 (while (let* ((range (car read))
3506 (min (if (numberp range) range (car range)))
3507 (max (if (numberp range) range (cdr range))))
3508 (cond ((or (not min)
3509 (< candidate min))
3510 (gnus-agent-append-to-list tail-unread candidate)
3511 nil)
3512 ((> candidate max)
3513 (setq read (cdr read))
3514 ;; return t so that I always loop one more
3515 ;; time. If I just iterated off the end of
3516 ;; read, min will become nil and the current
3517 ;; candidate will be added to the unread list.
3518 t))))))
3519 (while known
3520 (gnus-agent-append-to-list tail-unread (car (pop known))))
3521 (cdr unread)))
3522
3523(defun gnus-agent-uncached-articles (articles group &optional cached-header)
3524 "Restrict ARTICLES to numbers already fetched.
54506618 3525Returns a sublist of ARTICLES that excludes those article ids in GROUP
23f87bed
MB		 3526that have already been fetched.
3527If CACHED-HEADER is nil, articles are only excluded if the article itself
3528has been fetched."
3529
3530 ;; Logically equivalent to: (gnus-sorted-difference articles (mapcar
3531 ;; 'car gnus-agent-article-alist))
3532
3533 ;; Functionally, I don't need to construct a temp list using mapcar.
3534
3535 (if (and (or gnus-agent-cache (not gnus-plugged))
3536 (gnus-agent-load-alist group))
3537 (let* ((ref gnus-agent-article-alist)
3538 (arts articles)
3539 (uncached (list nil))
3540 (tail-uncached uncached))
3541 (while (and ref arts)
3542 (let ((v1 (car arts))
3543 (v2 (caar ref)))
3544 (cond ((< v1 v2) ; v1 does not appear in the reference list
3545 (gnus-agent-append-to-list tail-uncached v1)
3546 (setq arts (cdr arts)))
3547 ((= v1 v2)
3548 (unless (or cached-header (cdar ref)) ; v1 is already cached
3549 (gnus-agent-append-to-list tail-uncached v1))
3550 (setq arts (cdr arts))
3551 (setq ref (cdr ref)))
3552 (t ; reference article (v2) preceeds the list being filtered
3553 (setq ref (cdr ref))))))
3554 (while arts
3555 (gnus-agent-append-to-list tail-uncached (pop arts)))
3556 (cdr uncached))
3557 ;; if gnus-agent-load-alist fails, no articles are cached.
3558 articles))
3559
3560(defun gnus-agent-retrieve-headers (articles group &optional fetch-old)
3561 (save-excursion
3562 (gnus-agent-create-buffer)
3563 (let ((gnus-decode-encoded-word-function 'identity)
3564 (file (gnus-agent-article-name ".overview" group))
3565 cached-articles uncached-articles)
3566 (gnus-make-directory (nnheader-translate-file-chars
3567 (file-name-directory file) t))
3568
3569 ;; Populate temp buffer with known headers
3570 (when (file-exists-p file)
3571 (with-current-buffer gnus-agent-overview-buffer
3572 (erase-buffer)
3573 (let ((nnheader-file-coding-system
3574 gnus-agent-file-coding-system))
3575 (nnheader-insert-nov-file file (car articles)))))
3576
3577 (if (setq uncached-articles (gnus-agent-uncached-articles articles group
3578 t))
3579 (progn
3580 ;; Populate nntp-server-buffer with uncached headers
3581 (set-buffer nntp-server-buffer)
3582 (erase-buffer)
3583 (cond ((not (eq 'nov (let (gnus-agent) ; Turn off agent
3584 (gnus-retrieve-headers
3585 uncached-articles group fetch-old))))
3586 (nnvirtual-convert-headers))
3587 ((eq 'nntp (car gnus-current-select-method))
3588 ;; The author of gnus-get-newsgroup-headers-xover
3589 ;; reports that the XOVER command is commonly
3590 ;; unreliable. The problem is that recently
3591 ;; posted articles may not be entered into the
3592 ;; NOV database in time to respond to my XOVER
3593 ;; query.
3594 ;;
3595 ;; I'm going to use his assumption that the NOV
3596 ;; database is updated in order of ascending
3597 ;; article ID. Therefore, a response containing
3598 ;; article ID N implies that all articles from 1
3599 ;; to N-1 are up-to-date. Therefore, missing
3600 ;; articles in that range have expired.
3601
3602 (set-buffer nntp-server-buffer)
3603 (let* ((fetched-articles (list nil))
3604 (tail-fetched-articles fetched-articles)
3605 (min (cond ((numberp fetch-old)
3606 (max 1 (- (car articles) fetch-old)))
3607 (fetch-old
3608 1)
3609 (t
3610 (car articles))))
3611 (max (car (last articles))))
3612
3613 ;; Get the list of articles that were fetched
3614 (goto-char (point-min))
54506618
MB		 3615 (let ((pm (point-max))
3616 art)
23f87bed 3617 (while (< (point) pm)
54506618
MB		 3618 (when (setq art (gnus-agent-read-article-number))
3619 (gnus-agent-append-to-list tail-fetched-articles art))
23f87bed
MB		 3620 (forward-line 1)))
3621
3622 ;; Clip this list to the headers that will
3623 ;; actually be returned
3624 (setq fetched-articles (gnus-list-range-intersection
3625 (cdr fetched-articles)
3626 (cons min max)))
3627
3628 ;; Clip the uncached articles list to exclude
3629 ;; IDs after the last FETCHED header. The
3630 ;; excluded IDs may be fetchable using HEAD.
3631 (if (car tail-fetched-articles)
3632 (setq uncached-articles
3633 (gnus-list-range-intersection
3634 uncached-articles
3635 (cons (car uncached-articles)
3636 (car tail-fetched-articles)))))
3637
3638 ;; Create the list of articles that were
3639 ;; "successfully" fetched. Success, in this
3640 ;; case, means that the ID should not be
3641 ;; fetched again. In the case of an expired
3642 ;; article, the header will not be fetched.
3643 (setq uncached-articles
3644 (gnus-sorted-nunion fetched-articles
3645 uncached-articles))
3646 )))
3647
3648 ;; Erase the temp buffer
3649 (set-buffer gnus-agent-overview-buffer)
3650 (erase-buffer)
3651
3652 ;; Copy the nntp-server-buffer to the temp buffer
3653 (set-buffer nntp-server-buffer)
3654 (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max))
3655
54506618
MB		 3656 ;; Merge the temp buffer with the known headers (found on
3657 ;; disk in FILE) into the nntp-server-buffer
3658 (when uncached-articles
23f87bed
MB		 3659 (gnus-agent-braid-nov group uncached-articles file))
3660
54506618 3661 ;; Save the new set of known headers to FILE
23f87bed
MB		 3662 (set-buffer nntp-server-buffer)
3663 (let ((coding-system-for-write
3664 gnus-agent-file-coding-system))
3665 (gnus-agent-check-overview-buffer)
3666 (write-region (point-min) (point-max) file nil 'silent))
3667
3668 ;; Update the group's article alist to include the newly
3669 ;; fetched articles.
3670 (gnus-agent-load-alist group)
3671 (gnus-agent-save-alist group uncached-articles nil)
3672 )
3673
3674 ;; Copy the temp buffer to the nntp-server-buffer
3675 (set-buffer nntp-server-buffer)
3676 (erase-buffer)
3677 (insert-buffer-substring gnus-agent-overview-buffer)))
3678
3679 (if (and fetch-old
3680 (not (numberp fetch-old)))
3681 t ; Don't remove anything.
3682 (nnheader-nov-delete-outside-range
3683 (if fetch-old (max 1 (- (car articles) fetch-old))
3684 (car articles))
3685 (car (last articles)))
3686 t)
3687
3688 'nov))
3689
3690(defun gnus-agent-request-article (article group)
3691 "Retrieve ARTICLE in GROUP from the agent cache."
3692 (when (and gnus-agent
3693 (or gnus-agent-cache
3694 (not gnus-plugged))
3695 (numberp article))
3696 (let* ((gnus-command-method (gnus-find-method-for-group group))
3697 (file (gnus-agent-article-name (number-to-string article) group))
3698 (buffer-read-only nil))
3699 (when (and (file-exists-p file)
3700 (> (nth 7 (file-attributes file)) 0))
3701 (erase-buffer)
3702 (gnus-kill-all-overlays)
3703 (let ((coding-system-for-read gnus-cache-coding-system))
3704 (insert-file-contents file))
3705 t))))
3706
3707(defun gnus-agent-regenerate-group (group &optional reread)
3708 "Regenerate GROUP.
3709If REREAD is t, all articles in the .overview are marked as unread.
3710If REREAD is a list, the specified articles will be marked as unread.
3711In addition, their NOV entries in .overview will be refreshed using
3712the articles' current headers.
3713If REREAD is not nil, downloaded articles are marked as unread."
3714 (interactive
3715 (list (let ((def (or (gnus-group-group-name)
3716 gnus-newsgroup-name)))
3717 (let ((select (read-string (if def
3718 (concat "Group Name ("
3719 def "): ")
3720 "Group Name: "))))
3721 (if (and (equal "" select)
3722 def)
3723 def
3724 select)))
3725 (catch 'mark
3726 (while (let (c
3727 (cursor-in-echo-area t)
3728 (echo-keystrokes 0))
3729 (message "Mark as unread: (n)one / (a)ll / all (d)ownloaded articles? (n) ")
3730 (setq c (read-char-exclusive))
3731
3732 (cond ((or (eq c ?\r) (eq c ?n) (eq c ?N))
3733 (throw 'mark nil))
3734 ((or (eq c ?a) (eq c ?A))
3735 (throw 'mark t))
3736 ((or (eq c ?d) (eq c ?D))
3737 (throw 'mark 'some)))
3738 (gnus-message 3 "Ignoring unexpected input")
3739 (sit-for 1)
3740 t)))))
23f87bed
MB		 3741 (when group
3742 (gnus-message 5 "Regenerating in %s" group)
3743 (let* ((gnus-command-method (or gnus-command-method
3744 (gnus-find-method-for-group group)))
3745 (file (gnus-agent-article-name ".overview" group))
3746 (dir (file-name-directory file))
3747 point
3748 (downloaded (if (file-exists-p dir)
26c9afc3
MB		 3749 (sort (delq nil (mapcar (lambda (name)
3750 (and (not (file-directory-p (nnheader-concat dir name)))
3751 (string-to-number name)))
3752 (directory-files dir nil "^[0-9]+$" t)))
23f87bed
MB		 3753 '>)
3754 (progn (gnus-make-directory dir) nil)))
3755 dl nov-arts
3756 alist header
3757 regenerated)
3758
3759 (mm-with-unibyte-buffer
3760 (if (file-exists-p file)
3761 (let ((nnheader-file-coding-system
3762 gnus-agent-file-coding-system))
3763 (nnheader-insert-file-contents file)))
3764 (set-buffer-modified-p nil)
3765
3766 ;; Load the article IDs found in the overview file. As a
3767 ;; side-effect, validate the file contents.
3768 (let ((load t))
3769 (while load
3770 (setq load nil)
3771 (goto-char (point-min))
3772 (while (< (point) (point-max))
3773 (cond ((and (looking-at "[0-9]+\t")
3774 (<= (- (match-end 0) (match-beginning 0)) 9))
3775 (push (read (current-buffer)) nov-arts)
3776 (forward-line 1)
3777 (let ((l1 (car nov-arts))
3778 (l2 (cadr nov-arts)))
3779 (cond ((and (listp reread) (memq l1 reread))
3780 (gnus-delete-line)
3781 (setq nov-arts (cdr nov-arts))
3782 (gnus-message 4 "gnus-agent-regenerate-group: NOV\
54506618 3783 entry of article %s deleted." l1))
23f87bed
MB		 3784 ((not l2)
3785 nil)
3786 ((< l1 l2)
3787 (gnus-message 3 "gnus-agent-regenerate-group: NOV\
3788 entries are NOT in ascending order.")
3789 ;; Don't sort now as I haven't verified
3790 ;; that every line begins with a number
3791 (setq load t))
3792 ((= l1 l2)
3793 (forward-line -1)
3794 (gnus-message 4 "gnus-agent-regenerate-group: NOV\
3795 entries contained duplicate of article %s. Duplicate deleted." l1)
3796 (gnus-delete-line)
3797 (setq nov-arts (cdr nov-arts))))))
3798 (t
3799 (gnus-message 1 "gnus-agent-regenerate-group: NOV\
3800 entries contained line that did not begin with an article number. Deleted\
3801 line.")
3802 (gnus-delete-line))))
3803 (when load
3804 (gnus-message 5 "gnus-agent-regenerate-group: Sorting NOV\
3805 entries into ascending order.")
3806 (sort-numeric-fields 1 (point-min) (point-max))
3807 (setq nov-arts nil))))
3808 (gnus-agent-check-overview-buffer)
3809
3810 ;; Construct a new article alist whose nodes match every header
3811 ;; in the .overview file. As a side-effect, missing headers are
3812 ;; reconstructed from the downloaded article file.
3813 (while (or downloaded nov-arts)
3814 (cond ((and downloaded
3815 (or (not nov-arts)
3816 (> (car downloaded) (car nov-arts))))
3817 ;; This entry is missing from the overview file
3818 (gnus-message 3 "Regenerating NOV %s %d..." group
3819 (car downloaded))
3820 (let ((file (concat dir (number-to-string (car downloaded)))))
3821 (mm-with-unibyte-buffer
3822 (nnheader-insert-file-contents file)
3823 (nnheader-remove-body)
3824 (setq header (nnheader-parse-naked-head)))
3825 (mail-header-set-number header (car downloaded))
3826 (if nov-arts
3827 (let ((key (concat "^" (int-to-string (car nov-arts))
3828 "\t")))
3829 (or (re-search-backward key nil t)
3830 (re-search-forward key))
3831 (forward-line 1))
3832 (goto-char (point-min)))
3833 (nnheader-insert-nov header))
3834 (setq nov-arts (cons (car downloaded) nov-arts)))
3835 ((eq (car downloaded) (car nov-arts))
3836 ;; This entry in the overview has been downloaded
3837 (push (cons (car downloaded)
3838 (time-to-days
3839 (nth 5 (file-attributes
3840 (concat dir (number-to-string
3841 (car downloaded))))))) alist)
3842 (setq downloaded (cdr downloaded))
3843 (setq nov-arts (cdr nov-arts)))
3844 (t
3845 ;; This entry in the overview has not been downloaded
3846 (push (cons (car nov-arts) nil) alist)
3847 (setq nov-arts (cdr nov-arts)))))
3848
3849 ;; When gnus-agent-consider-all-articles is set,
3850 ;; gnus-agent-regenerate-group should NOT remove article IDs from
3851 ;; the alist. Those IDs serve as markers to indicate that an
3852 ;; attempt has been made to fetch that article's header.
3853
3854 ;; When gnus-agent-consider-all-articles is NOT set,
3855 ;; gnus-agent-regenerate-group can remove the article ID of every
3856 ;; article (with the exception of the last ID in the list - it's
3857 ;; special) that no longer appears in the overview. In this
3858 ;; situtation, the last article ID in the list implies that it,
3859 ;; and every article ID preceeding it, have been fetched from the
3860 ;; server.
3861
3862 (if gnus-agent-consider-all-articles
3863 ;; Restore all article IDs that were not found in the overview file.
3864 (let* ((n (cons nil alist))
3865 (merged n)
3866 (o (gnus-agent-load-alist group)))
3867 (while o
3868 (let ((nID (caadr n))
3869 (oID (caar o)))
3870 (cond ((not nID)
3871 (setq n (setcdr n (list (list oID))))
3872 (setq o (cdr o)))
3873 ((< oID nID)
3874 (setcdr n (cons (list oID) (cdr n)))
3875 (setq o (cdr o)))
3876 ((= oID nID)
3877 (setq o (cdr o))
3878 (setq n (cdr n)))
3879 (t
3880 (setq n (cdr n))))))
3881 (setq alist (cdr merged)))
3882 ;; Restore the last article ID if it is not already in the new alist
3883 (let ((n (last alist))
3884 (o (last (gnus-agent-load-alist group))))
3885 (cond ((not o)
3886 nil)
3887 ((not n)
3888 (push (cons (caar o) nil) alist))
3889 ((< (caar n) (caar o))
3890 (setcdr n (list (car o)))))))
3891
3892 (let ((inhibit-quit t))
3893 (if (setq regenerated (buffer-modified-p))
3894 (let ((coding-system-for-write gnus-agent-file-coding-system))
3895 (write-region (point-min) (point-max) file nil 'silent)))
3896
3897 (setq regenerated (or regenerated
3898 (and reread gnus-agent-article-alist)
3899 (not (equal alist gnus-agent-article-alist))))
3900
3901 (setq gnus-agent-article-alist alist)
3902
3903 (when regenerated
3904 (gnus-agent-save-alist group)
bf247b6e 3905
23f87bed
MB		 3906 ;; I have to alter the group's active range NOW as
3907 ;; gnus-make-ascending-articles-unread will use it to
3908 ;; recalculate the number of unread articles in the group
3909
3910 (let ((group (gnus-group-real-name group))
3911 (group-active (or (gnus-active group)
3912 (gnus-activate-group group))))
3913 (gnus-agent-possibly-alter-active group group-active)))))
3914
3915 (when (and reread gnus-agent-article-alist)
58090a8d 3916 (gnus-agent-synchronize-group-flags
23f87bed 3917 group
58090a8d 3918 (list (list
23f87bed
MB		 3919 (if (listp reread)
3920 reread
3921 (delq nil (mapcar (function (lambda (c)
3922 (cond ((eq reread t)
3923 (car c))
3924 ((cdr c)
3925 (car c)))))
58090a8d
MB		 3926 gnus-agent-article-alist)))
3927 'del '(read)))
3928 gnus-command-method)
23f87bed
MB		 3929
3930 (when (gnus-buffer-live-p gnus-group-buffer)
54506618 3931 (gnus-group-update-group group t)))
23f87bed 3932
54506618 3933 (gnus-message 5 "")
23f87bed
MB		 3934 regenerated)))
3935
3936;;;###autoload
3937(defun gnus-agent-regenerate (&optional clean reread)
3938 "Regenerate all agent covered files.
3939If CLEAN, obsolete (ignore)."
3940 (interactive "P")
3941 (let (regenerated)
3942 (gnus-message 4 "Regenerating Gnus agent files...")
3943 (dolist (gnus-command-method (gnus-agent-covered-methods))
3944 (dolist (group (gnus-groups-from-server gnus-command-method))
3945 (setq regenerated (or (gnus-agent-regenerate-group group reread)
3946 regenerated))))
3947 (gnus-message 4 "Regenerating Gnus agent files...done")
3948
3949 regenerated))
3950
3951(defun gnus-agent-go-online (&optional force)
3952 "Switch servers into online status."
3953 (interactive (list t))
3954 (dolist (server gnus-opened-servers)
3955 (when (eq (nth 1 server) 'offline)
3956 (if (if (eq force 'ask)
3957 (gnus-y-or-n-p
3958 (format "Switch %s:%s into online status? "
3959 (caar server) (cadar server)))
3960 force)
3961 (setcar (nthcdr 1 server) 'close)))))
3962
3963(defun gnus-agent-toggle-group-plugged (group)
3964 "Toggle the status of the server of the current group."
3965 (interactive (list (gnus-group-group-name)))
3966 (let* ((method (gnus-find-method-for-group group))
3967 (status (cadr (assoc method gnus-opened-servers))))
3968 (if (eq status 'offline)
3969 (gnus-server-set-status method 'closed)
3970 (gnus-close-server method)
3971 (gnus-server-set-status method 'offline))
3972 (message "Turn %s:%s from %s to %s." (car method) (cadr method)
3973 (if (eq status 'offline) 'offline 'online)
3974 (if (eq status 'offline) 'online 'offline))))
3975
3976(defun gnus-agent-group-covered-p (group)
3977 (gnus-agent-method-p (gnus-group-method group)))
3978
df80b09f
LMI		 3979(provide 'gnus-agent)
3980
ab5796a9 3981;;; arch-tag: b0ba4afc-5229-4cee-ad25-9956daa4e91e
df80b09f 3982;;; gnus-agent.el ends here
Unnamed repository; edit this file 'description' to name the repository.