HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Update refcard section.
[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
MB		 827 (when (and (file-exists-p (gnus-agent-lib-file "flags"))
828 (not (eq (gnus-server-status gnus-command-method) 'offline)))
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
2136 (cur (current-buffer)))
2137 (setq group (read cur)
2138 min (read cur)
2139 max (read cur))
2140
2141 (when (stringp group)
2142 (setq group (intern group my-obarray)))
2143
2144 ;; NOTE: The '+ 0' ensure that min and max are both numerics.
2145 (set group (cons (+ 0 min) (+ 0 max))))
2146 (error
58090a8d 2147 (gnus-message 3 "Warning - invalid agent local: %s on line %d: %s"
23f87bed
MB		 2148 file line (error-message-string err))))
2149 (forward-line 1)
2150 (setq line (1+ line))))
bf247b6e 2151
23f87bed
MB		 2152 (set (intern "+dirty" my-obarray) nil)
2153 (set (intern "+method" my-obarray) gnus-command-method)
2154 my-obarray))
2155
2156(defun gnus-agent-save-local (&optional force)
2157 "Save gnus-agent-article-local under it method's agent.lib directory."
2158 (let ((my-obarray gnus-agent-article-local))
2159 (when (and my-obarray
2160 (or force (symbol-value (intern "+dirty" my-obarray))))
2161 (let* ((gnus-command-method (symbol-value (intern "+method" my-obarray)))
2162 ;; NOTE: gnus-command-method is used within gnus-agent-lib-file.
2163 (dest (gnus-agent-lib-file "local")))
2164 (gnus-make-directory (gnus-agent-lib-file ""))
54506618
MB		 2165
2166 (let ((buffer-file-coding-system gnus-agent-file-coding-system))
2167 (with-temp-file dest
2168 (let ((gnus-command-method (symbol-value (intern "+method" my-obarray)))
2169 (file-name-coding-system nnmail-pathname-coding-system)
2170 print-level print-length item article
2171 (standard-output (current-buffer)))
2172 (mapatoms (lambda (symbol)
2173 (cond ((not (boundp symbol))
2174 nil)
2175 ((member (symbol-name symbol) '("+dirty" "+method"))
2176 nil)
2177 (t
54506618 2178 (let ((range (symbol-value symbol)))
58090a8d
MB		 2179 (when range
2180 (prin1 symbol)
54506618
MB		 2181 (princ " ")
2182 (princ (car range))
2183 (princ " ")
2184 (princ (cdr range))
58090a8d 2185 (princ "\n"))))))
54506618
MB		 2186 my-obarray))))))))
2187
2188(defun gnus-agent-get-local (group &optional gmane method)
2189 (let* ((gmane (or gmane (gnus-group-real-name group)))
2190 (gnus-command-method (or method (gnus-find-method-for-group group)))
23f87bed
MB		 2191 (local (gnus-agent-load-local))
2192 (symb (intern gmane local))
2193 (minmax (and (boundp symb) (symbol-value symb))))
2194 (unless minmax
2195 ;; Bind these so that gnus-agent-load-alist doesn't change the
2196 ;; current alist (i.e. gnus-agent-article-alist)
2197 (let* ((gnus-agent-article-alist gnus-agent-article-alist)
2198 (gnus-agent-file-loading-cache gnus-agent-file-loading-cache)
2199 (alist (gnus-agent-load-alist group)))
2200 (when alist
2201 (setq minmax
2202 (cons (caar alist)
2203 (caar (last alist))))
bf247b6e 2204 (gnus-agent-set-local group (car minmax) (cdr minmax)
23f87bed
MB		 2205 gmane gnus-command-method local))))
2206 minmax))
2207
2208(defun gnus-agent-set-local (group min max &optional gmane method local)
2209 (let* ((gmane (or gmane (gnus-group-real-name group)))
2210 (gnus-command-method (or method (gnus-find-method-for-group group)))
2211 (local (or local (gnus-agent-load-local)))
2212 (symb (intern gmane local))
2213 (minmax (and (boundp symb) (symbol-value symb))))
bf247b6e 2214
23f87bed
MB		 2215 (if (cond ((and minmax
2216 (or (not (eq min (car minmax)))
2217 (not (eq max (cdr minmax)))))
2218 (setcar minmax min)
2219 (setcdr minmax max)
2220 t)
2221 (minmax
2222 nil)
2223 ((and min max)
2224 (set symb (cons min max))
54506618
MB		 2225 t)
2226 (t
2227 (unintern symb local)))
23f87bed 2228 (set (intern "+dirty" local) t))))
df80b09f
LMI		 2229
2230(defun gnus-agent-article-name (article group)
23f87bed 2231 (expand-file-name article
850846fd 2232 (file-name-as-directory
23f87bed 2233 (gnus-agent-group-pathname group))))
df80b09f 2234
16409b0b
GM		 2235(defun gnus-agent-batch-confirmation (msg)
2236 "Show error message and return t."
2237 (gnus-message 1 msg)
2238 t)
2239
df80b09f
LMI		 2240;;;###autoload
2241(defun gnus-agent-batch-fetch ()
2242 "Start Gnus and fetch session."
2243 (interactive)
2244 (gnus)
16409b0b
GM		 2245 (let ((gnus-agent-confirmation-function 'gnus-agent-batch-confirmation))
2246 (gnus-agent-fetch-session))
df80b09f
LMI		 2247 (gnus-group-exit))
2248
2249(defun gnus-agent-fetch-session ()
2250 "Fetch all articles and headers that are eligible for fetching."
2251 (interactive)
2252 (unless gnus-agent-covered-methods
2253 (error "No servers are covered by the Gnus agent"))
2254 (unless gnus-plugged
2255 (error "Can't fetch articles while Gnus is unplugged"))
23f87bed 2256 (let ((methods (gnus-agent-covered-methods))
df80b09f
LMI		 2257 groups group gnus-command-method)
2258 (save-excursion
2259 (while methods
23f87bed
MB		 2260 (setq gnus-command-method (car methods))
2261 (when (and (or (gnus-server-opened gnus-command-method)
2262 (gnus-open-server gnus-command-method))
2263 (gnus-online gnus-command-method))
2264 (setq groups (gnus-groups-from-server (car methods)))
2265 (gnus-agent-with-fetch
2266 (while (setq group (pop groups))
2267 (when (<= (gnus-group-level group)
2268 gnus-agent-handle-level)
2269 (if (or debug-on-error debug-on-quit)
2270 (gnus-agent-fetch-group-1
2271 group gnus-command-method)
2272 (condition-case err
2273 (gnus-agent-fetch-group-1
2274 group gnus-command-method)
2275 (error
2276 (unless (funcall gnus-agent-confirmation-function
54506618 2277 (format "Error %s while fetching session. Should gnus continue? "
23f87bed
MB		 2278 (error-message-string err)))
2279 (error "Cannot fetch articles into the Gnus agent")))
2280 (quit
54506618 2281 (gnus-agent-regenerate-group group)
23f87bed
MB		 2282 (unless (funcall gnus-agent-confirmation-function
2283 (format
54506618 2284 "%s while fetching session. Should gnus continue? "
23f87bed
MB		 2285 (error-message-string err)))
2286 (signal 'quit
2287 "Cannot fetch articles into the Gnus agent")))))))))
2288 (setq methods (cdr methods)))
2289 (gnus-run-hooks 'gnus-agent-fetched-hook)
df80b09f
LMI		 2290 (gnus-message 6 "Finished fetching articles into the Gnus agent"))))
2291
2292(defun gnus-agent-fetch-group-1 (group method)
2293 "Fetch GROUP."
2294 (let ((gnus-command-method method)
16409b0b 2295 (gnus-newsgroup-name group)
23f87bed
MB		 2296 (gnus-newsgroup-dependencies gnus-newsgroup-dependencies)
2297 (gnus-newsgroup-headers gnus-newsgroup-headers)
2298 (gnus-newsgroup-scored gnus-newsgroup-scored)
2299 (gnus-use-cache gnus-use-cache)
16409b0b
GM		 2300 (gnus-summary-expunge-below gnus-summary-expunge-below)
2301 (gnus-summary-mark-below gnus-summary-mark-below)
2302 (gnus-orphan-score gnus-orphan-score)
2303 ;; Maybe some other gnus-summary local variables should also
2304 ;; be put here.
23f87bed
MB		 2305
2306 gnus-headers
2307 gnus-score
2308 articles arts
2309 category predicate info marks score-param
16409b0b
GM		 2310 )
2311 (unless (gnus-check-group group)
2312 (error "Can't open server for %s" group))
23f87bed 2313
df80b09f 2314 ;; Fetch headers.
23f87bed
MB		 2315 (when (or gnus-newsgroup-active
2316 (gnus-active group)
2317 (gnus-activate-group group))
2318 (let ((marked-articles gnus-newsgroup-downloadable))
2319 ;; Identify the articles marked for download
2320 (unless gnus-newsgroup-active
2321 ;; The variable gnus-newsgroup-active was selected as I need
2322 ;; a gnus-summary local variable that is NOT bound to any
2323 ;; value (its global value should default to nil).
2324 (dolist (mark gnus-agent-download-marks)
2325 (let ((arts (cdr (assq mark (gnus-info-marks
2326 (setq info (gnus-get-info group)))))))
2327 (when arts
2328 (setq marked-articles (nconc (gnus-uncompress-range arts)
2329 marked-articles))
2330 ))))
2331 (setq marked-articles (sort marked-articles '<))
2332
2333 ;; Fetch any new articles from the server
2334 (setq articles (gnus-agent-fetch-headers group))
2335
2336 ;; Merge new articles with marked
2337 (setq articles (sort (append marked-articles articles) '<))
2338
2339 (when articles
2340 ;; Parse them and see which articles we want to fetch.
2341 (setq gnus-newsgroup-dependencies
2342 (or gnus-newsgroup-dependencies
2343 (make-vector (length articles) 0)))
2344 (setq gnus-newsgroup-headers
2345 (or gnus-newsgroup-headers
2346 (gnus-get-newsgroup-headers-xover articles nil nil
2347 group)))
2348 ;; `gnus-agent-overview-buffer' may be killed for
2349 ;; timeout reason. If so, recreate it.
2350 (gnus-agent-create-buffer)
2351
2352 ;; Figure out how to select articles in this group
2353 (setq category (gnus-group-category group))
2354
2355 (setq predicate
2356 (gnus-get-predicate
2357 (gnus-agent-find-parameter group 'agent-predicate)))
2358
2359 ;; If the selection predicate requires scoring, score each header
2360 (unless (memq predicate '(gnus-agent-true gnus-agent-false))
2361 (let ((score-param
2362 (gnus-agent-find-parameter group 'agent-score-file)))
2363 ;; Translate score-param into real one
2364 (cond
2365 ((not score-param))
2366 ((eq score-param 'file)
2367 (setq score-param (gnus-all-score-files group)))
2368 ((stringp (car score-param)))
2369 (t
2370 (setq score-param (list (list score-param)))))
2371 (when score-param
2372 (gnus-score-headers score-param))))
2373
2374 (unless (and (eq predicate 'gnus-agent-false)
2375 (not marked-articles))
2376 (let ((arts (list nil)))
2377 (let ((arts-tail arts)
2378 (alist (gnus-agent-load-alist group))
2379 (marked-articles marked-articles)
2380 (gnus-newsgroup-headers gnus-newsgroup-headers))
2381 (while (setq gnus-headers (pop gnus-newsgroup-headers))
2382 (let ((num (mail-header-number gnus-headers)))
2383 ;; Determine if this article is already in the cache
2384 (while (and alist
2385 (> num (caar alist)))
2386 (setq alist (cdr alist)))
2387
2388 (unless (and (eq num (caar alist))
2389 (cdar alist))
2390
2391 ;; Determine if this article was marked for download.
2392 (while (and marked-articles
2393 (> num (car marked-articles)))
2394 (setq marked-articles
2395 (cdr marked-articles)))
2396
2397 ;; When this article is marked, or selected by the
2398 ;; predicate, add it to the download list
2399 (when (or (eq num (car marked-articles))
2400 (let ((gnus-score
2401 (or (cdr
2402 (assq num gnus-newsgroup-scored))
2403 gnus-summary-default-score))
2404 (gnus-agent-long-article
2405 (gnus-agent-find-parameter
2406 group 'agent-long-article))
2407 (gnus-agent-short-article
2408 (gnus-agent-find-parameter
2409 group 'agent-short-article))
2410 (gnus-agent-low-score
2411 (gnus-agent-find-parameter
2412 group 'agent-low-score))
2413 (gnus-agent-high-score
2414 (gnus-agent-find-parameter
2415 group 'agent-high-score))
2416 (gnus-agent-expire-days
2417 (gnus-agent-find-parameter
2418 group 'agent-days-until-old)))
2419 (funcall predicate)))
2420 (gnus-agent-append-to-list arts-tail num))))))
2421
2422 (let (fetched-articles)
2423 ;; Fetch all selected articles
2424 (setq gnus-newsgroup-undownloaded
2425 (gnus-sorted-ndifference
2426 gnus-newsgroup-undownloaded
2427 (setq fetched-articles
2428 (if (cdr arts)
2429 (gnus-agent-fetch-articles group (cdr arts))
2430 nil))))
2431
2432 (let ((unfetched-articles
2433 (gnus-sorted-ndifference (cdr arts) fetched-articles)))
2434 (if gnus-newsgroup-active
2435 ;; Update the summary buffer
2436 (progn
2437 (dolist (article marked-articles)
2438 (gnus-summary-set-agent-mark article t))
2439 (dolist (article fetched-articles)
58090a8d
MB		 2440 (when gnus-agent-mark-unread-after-downloaded
2441 (setq gnus-newsgroup-downloadable
2442 (delq article gnus-newsgroup-downloadable))
23f87bed
MB		 2443 (gnus-summary-mark-article
2444 article gnus-unread-mark))
2445 (when (gnus-summary-goto-subject article nil t)
2446 (gnus-summary-update-download-mark article)))
2447 (dolist (article unfetched-articles)
2448 (gnus-summary-mark-article
2449 article gnus-canceled-mark)))
2450
2451 ;; Update the group buffer.
2452
2453 ;; When some, or all, of the marked articles came
2454 ;; from the download mark. Remove that mark. I
2455 ;; didn't do this earlier as I only want to remove
2456 ;; the marks after the fetch is completed.
2457
2458 (dolist (mark gnus-agent-download-marks)
2459 (when (eq mark 'download)
2460 (let ((marked-arts
2461 (assq mark (gnus-info-marks
2462 (setq info (gnus-get-info group))))))
2463 (when (cdr marked-arts)
2464 (setq marks
2465 (delq marked-arts (gnus-info-marks info)))
2466 (gnus-info-set-marks info marks)))))
2467 (let ((read (gnus-info-read
2468 (or info (setq info (gnus-get-info group))))))
2469 (gnus-info-set-read
2470 info (gnus-add-to-range read unfetched-articles)))
2471
2472 (gnus-group-update-group group t)
2473 (sit-for 0)
2474
2475 (gnus-dribble-enter
2476 (concat "(gnus-group-set-info '"
2477 (gnus-prin1-to-string info)
2478 ")"))))))))))))
df80b09f
LMI		 2479
2480;;;
2481;;; Agent Category Mode
2482;;;
2483
2484(defvar gnus-category-mode-hook nil
2485 "Hook run in `gnus-category-mode' buffers.")
2486
2487(defvar gnus-category-line-format " %(%20c%): %g\n"
23f87bed
MB		 2488 "Format of category lines.
2489
2490Valid specifiers include:
2491%c Topic name (string)
2492%g The number of groups in the topic (integer)
2493
2494General format specifiers can also be used. See Info node
2495`(gnus)Formatting Variables'.")
df80b09f
LMI		 2496
2497(defvar gnus-category-mode-line-format "Gnus: %%b"
2498 "The format specification for the category mode line.")
2499
23f87bed
MB		 2500(defvar gnus-agent-predicate 'false
2501 "The selection predicate used when no other source is available.")
2502
df80b09f
LMI		 2503(defvar gnus-agent-short-article 100
2504 "Articles that have fewer lines than this are short.")
2505
2506(defvar gnus-agent-long-article 200
2507 "Articles that have more lines than this are long.")
2508
2509(defvar gnus-agent-low-score 0
2510 "Articles that have a score lower than this have a low score.")
2511
2512(defvar gnus-agent-high-score 0
2513 "Articles that have a score higher than this have a high score.")
2514
2515
2516;;; Internal variables.
2517
2518(defvar gnus-category-buffer "*Agent Category*")
2519
2520(defvar gnus-category-line-format-alist
2521 `((?c gnus-tmp-name ?s)
2522 (?g gnus-tmp-groups ?d)))
2523
2524(defvar gnus-category-mode-line-format-alist
2525 `((?u user-defined ?s)))
2526
2527(defvar gnus-category-line-format-spec nil)
2528(defvar gnus-category-mode-line-format-spec nil)
2529
2530(defvar gnus-category-mode-map nil)
2531(put 'gnus-category-mode 'mode-class 'special)
2532
2533(unless gnus-category-mode-map
2534 (setq gnus-category-mode-map (make-sparse-keymap))
2535 (suppress-keymap gnus-category-mode-map)
2536
2537 (gnus-define-keys gnus-category-mode-map
2538 "q" gnus-category-exit
2539 "k" gnus-category-kill
2540 "c" gnus-category-copy
2541 "a" gnus-category-add
23f87bed 2542 "e" gnus-agent-customize-category
df80b09f
LMI		 2543 "p" gnus-category-edit-predicate
2544 "g" gnus-category-edit-groups
2545 "s" gnus-category-edit-score
2546 "l" gnus-category-list
2547
2548 "\C-c\C-i" gnus-info-find-node
2549 "\C-c\C-b" gnus-bug))
2550
2551(defvar gnus-category-menu-hook nil
2552 "*Hook run after the creation of the menu.")
2553
2554(defun gnus-category-make-menu-bar ()
2555 (gnus-turn-off-edit-menu 'category)
2556 (unless (boundp 'gnus-category-menu)
2557 (easy-menu-define
2558 gnus-category-menu gnus-category-mode-map ""
2559 '("Categories"
2560 ["Add" gnus-category-add t]
2561 ["Kill" gnus-category-kill t]
2562 ["Copy" gnus-category-copy t]
23f87bed 2563 ["Edit category" gnus-agent-customize-category t]
df80b09f
LMI		 2564 ["Edit predicate" gnus-category-edit-predicate t]
2565 ["Edit score" gnus-category-edit-score t]
2566 ["Edit groups" gnus-category-edit-groups t]
2567 ["Exit" gnus-category-exit t]))
2568
2569 (gnus-run-hooks 'gnus-category-menu-hook)))
2570
2571(defun gnus-category-mode ()
2572 "Major mode for listing and editing agent categories.
2573
2574All normal editing commands are switched off.
2575\\<gnus-category-mode-map>
2576For more in-depth information on this mode, read the manual
23f87bed 2577\(`\\[gnus-info-find-node]').
df80b09f
LMI		 2578
2579The following commands are available:
2580
2581\\{gnus-category-mode-map}"
2582 (interactive)
2583 (when (gnus-visual-p 'category-menu 'menu)
2584 (gnus-category-make-menu-bar))
2585 (kill-all-local-variables)
2586 (gnus-simplify-mode-line)
2587 (setq major-mode 'gnus-category-mode)
2588 (setq mode-name "Category")
2589 (gnus-set-default-directory)
2590 (setq mode-line-process nil)
2591 (use-local-map gnus-category-mode-map)
16409b0b 2592 (buffer-disable-undo)
df80b09f
LMI		 2593 (setq truncate-lines t)
2594 (setq buffer-read-only t)
cfcd5c91 2595 (gnus-run-mode-hooks 'gnus-category-mode-hook))
df80b09f
LMI		 2596
2597(defalias 'gnus-category-position-point 'gnus-goto-colon)
2598
2599(defun gnus-category-insert-line (category)
23f87bed
MB		 2600 (let* ((gnus-tmp-name (format "%s" (car category)))
2601 (gnus-tmp-groups (length (gnus-agent-cat-groups category))))
df80b09f
LMI		 2602 (beginning-of-line)
2603 (gnus-add-text-properties
2604 (point)
2605 (prog1 (1+ (point))
2606 ;; Insert the text.
2607 (eval gnus-category-line-format-spec))
2608 (list 'gnus-category gnus-tmp-name))))
2609
2610(defun gnus-enter-category-buffer ()
2611 "Go to the Category buffer."
2612 (interactive)
2613 (gnus-category-setup-buffer)
2614 (gnus-configure-windows 'category)
2615 (gnus-category-prepare))
2616
2617(defun gnus-category-setup-buffer ()
2618 (unless (get-buffer gnus-category-buffer)
2619 (save-excursion
2620 (set-buffer (gnus-get-buffer-create gnus-category-buffer))
2621 (gnus-category-mode))))
2622
2623(defun gnus-category-prepare ()
2624 (gnus-set-format 'category-mode)
2625 (gnus-set-format 'category t)
2626 (let ((alist gnus-category-alist)
2627 (buffer-read-only nil))
2628 (erase-buffer)
2629 (while alist
2630 (gnus-category-insert-line (pop alist)))
2631 (goto-char (point-min))
2632 (gnus-category-position-point)))
2633
2634(defun gnus-category-name ()
23f87bed 2635 (or (intern (get-text-property (gnus-point-at-bol) 'gnus-category))
df80b09f
LMI		 2636 (error "No category on the current line")))
2637
2638(defun gnus-category-read ()
2639 "Read the category alist."
2640 (setq gnus-category-alist
23f87bed
MB		 2641 (or
2642 (with-temp-buffer
2643 (ignore-errors
2644 (nnheader-insert-file-contents (nnheader-concat gnus-agent-directory "lib/categories"))
2645 (goto-char (point-min))
2646 ;; This code isn't temp, it will be needed so long as
2647 ;; anyone may be migrating from an older version.
2648
2649 ;; Once we're certain that people will not revert to an
2650 ;; earlier version, we can take out the old-list code in
2651 ;; gnus-category-write.
2652 (let* ((old-list (read (current-buffer)))
2653 (new-list (ignore-errors (read (current-buffer)))))
2654 (if new-list
2655 new-list
2656 ;; Convert from a positional list to an alist.
2657 (mapcar
2658 (lambda (c)
2659 (setcdr c
2660 (delq nil
2661 (gnus-mapcar
2662 (lambda (valu symb)
2663 (if valu
2664 (cons symb valu)))
2665 (cdr c)
2666 '(agent-predicate agent-score-file agent-groups))))
2667 c)
2668 old-list)))))
2669 (list (gnus-agent-cat-make 'default 'short)))))
df80b09f
LMI		 2670
2671(defun gnus-category-write ()
2672 "Write the category alist."
2673 (setq gnus-category-predicate-cache nil
2674 gnus-category-group-cache nil)
16409b0b
GM		 2675 (gnus-make-directory (nnheader-concat gnus-agent-directory "lib"))
2676 (with-temp-file (nnheader-concat gnus-agent-directory "lib/categories")
23f87bed
MB		 2677 ;; This prin1 is temporary. It exists so that people can revert
2678 ;; to an earlier version of gnus-agent.
2679 (prin1 (mapcar (lambda (c)
2680 (list (car c)
2681 (cdr (assoc 'agent-predicate c))
2682 (cdr (assoc 'agent-score-file c))
2683 (cdr (assoc 'agent-groups c))))
2684 gnus-category-alist)
2685 (current-buffer))
2686 (newline)
df80b09f
LMI		 2687 (prin1 gnus-category-alist (current-buffer))))
2688
2689(defun gnus-category-edit-predicate (category)
2690 "Edit the predicate for CATEGORY."
2691 (interactive (list (gnus-category-name)))
2692 (let ((info (assq category gnus-category-alist)))
2693 (gnus-edit-form
23f87bed
MB		 2694 (gnus-agent-cat-predicate info)
2695 (format "Editing the select predicate for category %s" category)
df80b09f 2696 `(lambda (predicate)
23f87bed
MB		 2697 ;; Avoid run-time execution of setf form
2698 ;; (setf (gnus-agent-cat-predicate (assq ',category gnus-category-alist))
2699 ;; predicate)
2700 ;; use its expansion instead:
2701 (gnus-agent-cat-set-property (assq ',category gnus-category-alist)
2702 'agent-predicate predicate)
2703
df80b09f
LMI		 2704 (gnus-category-write)
2705 (gnus-category-list)))))
2706
2707(defun gnus-category-edit-score (category)
2708 "Edit the score expression for CATEGORY."
2709 (interactive (list (gnus-category-name)))
2710 (let ((info (assq category gnus-category-alist)))
2711 (gnus-edit-form
23f87bed 2712 (gnus-agent-cat-score-file info)
df80b09f 2713 (format "Editing the score expression for category %s" category)
23f87bed
MB		 2714 `(lambda (score-file)
2715 ;; Avoid run-time execution of setf form
2716 ;; (setf (gnus-agent-cat-score-file (assq ',category gnus-category-alist))
2717 ;; score-file)
2718 ;; use its expansion instead:
2719 (gnus-agent-cat-set-property (assq ',category gnus-category-alist)
2720 'agent-score-file score-file)
2721
df80b09f
LMI		 2722 (gnus-category-write)
2723 (gnus-category-list)))))
2724
2725(defun gnus-category-edit-groups (category)
2726 "Edit the group list for CATEGORY."
2727 (interactive (list (gnus-category-name)))
2728 (let ((info (assq category gnus-category-alist)))
2729 (gnus-edit-form
23f87bed
MB		 2730 (gnus-agent-cat-groups info)
2731 (format "Editing the group list for category %s" category)
df80b09f 2732 `(lambda (groups)
23f87bed
MB		 2733 ;; Avoid run-time execution of setf form
2734 ;; (setf (gnus-agent-cat-groups (assq ',category gnus-category-alist))
2735 ;; groups)
2736 ;; use its expansion instead:
2737 (gnus-agent-set-cat-groups (assq ',category gnus-category-alist)
2738 groups)
2739
df80b09f
LMI		 2740 (gnus-category-write)
2741 (gnus-category-list)))))
2742
2743(defun gnus-category-kill (category)
2744 "Kill the current category."
2745 (interactive (list (gnus-category-name)))
2746 (let ((info (assq category gnus-category-alist))
2747 (buffer-read-only nil))
2748 (gnus-delete-line)
16409b0b
GM		 2749 (setq gnus-category-alist (delq info gnus-category-alist))
2750 (gnus-category-write)))
df80b09f
LMI		 2751
2752(defun gnus-category-copy (category to)
2753 "Copy the current category."
2754 (interactive (list (gnus-category-name) (intern (read-string "New name: "))))
2755 (let ((info (assq category gnus-category-alist)))
23f87bed
MB		 2756 (push (let ((newcat (gnus-copy-sequence info)))
2757 (setf (gnus-agent-cat-name newcat) to)
2758 (setf (gnus-agent-cat-groups newcat) nil)
2759 newcat)
df80b09f
LMI		 2760 gnus-category-alist)
2761 (gnus-category-write)
2762 (gnus-category-list)))
2763
2764(defun gnus-category-add (category)
2765 "Create a new category."
2766 (interactive "SCategory name: ")
2767 (when (assq category gnus-category-alist)
2768 (error "Category %s already exists" category))
23f87bed 2769 (push (gnus-agent-cat-make category)
df80b09f
LMI		 2770 gnus-category-alist)
2771 (gnus-category-write)
2772 (gnus-category-list))
2773
2774(defun gnus-category-list ()
2775 "List all categories."
2776 (interactive)
2777 (gnus-category-prepare))
2778
2779(defun gnus-category-exit ()
2780 "Return to the group buffer."
2781 (interactive)
2782 (kill-buffer (current-buffer))
2783 (gnus-configure-windows 'group t))
2784
2785;; To avoid having 8-bit characters in the source file.
2786(defvar gnus-category-not (list '! 'not (intern (format "%c" 172))))
2787
2788(defvar gnus-category-predicate-alist
2789 '((spam . gnus-agent-spam-p)
2790 (short . gnus-agent-short-p)
2791 (long . gnus-agent-long-p)
2792 (low . gnus-agent-low-scored-p)
2793 (high . gnus-agent-high-scored-p)
23f87bed 2794 (read . gnus-agent-read-p)
df80b09f
LMI		 2795 (true . gnus-agent-true)
2796 (false . gnus-agent-false))
2797 "Mapping from short score predicate symbols to predicate functions.")
2798
2799(defun gnus-agent-spam-p ()
2800 "Say whether an article is spam or not."
2801 (unless gnus-agent-spam-hashtb
2802 (setq gnus-agent-spam-hashtb (gnus-make-hashtable 1000)))
2803 (if (not (equal (mail-header-references gnus-headers) ""))
2804 nil
2805 (let ((string (gnus-simplify-subject (mail-header-subject gnus-headers))))
2806 (prog1
2807 (gnus-gethash string gnus-agent-spam-hashtb)
2808 (gnus-sethash string t gnus-agent-spam-hashtb)))))
2809
2810(defun gnus-agent-short-p ()
2811 "Say whether an article is short or not."
2812 (< (mail-header-lines gnus-headers) gnus-agent-short-article))
2813
2814(defun gnus-agent-long-p ()
2815 "Say whether an article is long or not."
2816 (> (mail-header-lines gnus-headers) gnus-agent-long-article))
2817
2818(defun gnus-agent-low-scored-p ()
2819 "Say whether an article has a low score or not."
2820 (< gnus-score gnus-agent-low-score))
2821
2822(defun gnus-agent-high-scored-p ()
2823 "Say whether an article has a high score or not."
2824 (> gnus-score gnus-agent-high-score))
2825
23f87bed
MB		 2826(defun gnus-agent-read-p ()
2827 "Say whether an article is read or not."
2828 (gnus-member-of-range (mail-header-number gnus-headers)
2829 (gnus-info-read (gnus-get-info gnus-newsgroup-name))))
2830
2831(defun gnus-category-make-function (predicate)
2832 "Make a function from PREDICATE."
2833 (let ((func (gnus-category-make-function-1 predicate)))
2834 (if (and (= (length func) 1)
2835 (symbolp (car func)))
2836 (car func)
2837 (gnus-byte-compile `(lambda () ,func)))))
df80b09f
LMI		 2838
2839(defun gnus-agent-true ()
2840 "Return t."
2841 t)
2842
2843(defun gnus-agent-false ()
2844 "Return nil."
2845 nil)
2846
23f87bed
MB		 2847(defun gnus-category-make-function-1 (predicate)
2848 "Make a function from PREDICATE."
df80b09f
LMI		 2849 (cond
2850 ;; Functions are just returned as is.
23f87bed
MB		 2851 ((or (symbolp predicate)
2852 (functionp predicate))
2853 `(,(or (cdr (assq predicate gnus-category-predicate-alist))
2854 predicate)))
2855 ;; More complex predicate.
2856 ((consp predicate)
df80b09f 2857 `(,(cond
23f87bed 2858 ((memq (car predicate) '(& and))
df80b09f 2859 'and)
23f87bed 2860 ((memq (car predicate) '(| or))
df80b09f 2861 'or)
23f87bed 2862 ((memq (car predicate) gnus-category-not)
df80b09f 2863 'not))
23f87bed 2864 ,@(mapcar 'gnus-category-make-function-1 (cdr predicate))))
df80b09f 2865 (t
23f87bed 2866 (error "Unknown predicate type: %s" predicate))))
df80b09f
LMI		 2867
2868(defun gnus-get-predicate (predicate)
23f87bed 2869 "Return the function implementing PREDICATE."
df80b09f 2870 (or (cdr (assoc predicate gnus-category-predicate-cache))
23f87bed
MB		 2871 (let ((func (gnus-category-make-function predicate)))
2872 (setq gnus-category-predicate-cache
2873 (nconc gnus-category-predicate-cache
2874 (list (cons predicate func))))
2875 func)))
2876
2877(defun gnus-predicate-implies-unread (predicate)
2878 "Say whether PREDICATE implies unread articles only.
2879It is okay to miss some cases, but there must be no false positives.
2880That is, if this predicate returns true, then indeed the predicate must
2881return only unread articles."
bf247b6e 2882 (eq t (gnus-function-implies-unread-1
23f87bed
MB		 2883 (gnus-category-make-function-1 predicate))))
2884
2885(defun gnus-function-implies-unread-1 (function)
2886 "Recursively evaluate a predicate function to determine whether it can select
2887any read articles. Returns t if the function is known to never
2888return read articles, nil when it is known to always return read
2889articles, and t_nil when the function may return both read and unread
2890articles."
2891 (let ((func (car function))
2892 (args (mapcar 'gnus-function-implies-unread-1 (cdr function))))
2893 (cond ((eq func 'and)
2894 (cond ((memq t args) ; if any argument returns only unread articles
2895 ;; then that argument constrains the result to only unread articles.
2896 t)
2897 ((memq 't_nil args) ; if any argument is indeterminate
2898 ;; then the result is indeterminate
2899 't_nil)))
2900 ((eq func 'or)
2901 (cond ((memq nil args) ; if any argument returns read articles
2902 ;; then that argument ensures that the results includes read articles.
2903 nil)
2904 ((memq 't_nil args) ; if any argument is indeterminate
2905 ;; then that argument ensures that the results are indeterminate
2906 't_nil)
2907 (t ; if all arguments return only unread articles
2908 ;; then the result returns only unread articles
2909 t)))
2910 ((eq func 'not)
2911 (cond ((eq (car args) 't_nil) ; if the argument is indeterminate
2912 ; then the result is indeterminate
2913 (car args))
2914 (t ; otherwise
2915 ; toggle the result to be the opposite of the argument
2916 (not (car args)))))
2917 ((eq func 'gnus-agent-read-p)
2918 nil) ; The read predicate NEVER returns unread articles
2919 ((eq func 'gnus-agent-false)
2920 t) ; The false predicate returns t as the empty set excludes all read articles
2921 ((eq func 'gnus-agent-true)
2922 nil) ; The true predicate ALWAYS returns read articles
2923 ((catch 'found-match
2924 (let ((alist gnus-category-predicate-alist))
2925 (while alist
2926 (if (eq func (cdar alist))
2927 (throw 'found-match t)
2928 (setq alist (cdr alist))))))
2929 't_nil) ; All other predicates return read and unread articles
2930 (t
2931 (error "Unknown predicate function: %s" function)))))
df80b09f
LMI		 2932
2933(defun gnus-group-category (group)
2934 "Return the category GROUP belongs to."
2935 (unless gnus-category-group-cache
2936 (setq gnus-category-group-cache (gnus-make-hashtable 1000))
2937 (let ((cs gnus-category-alist)
2938 groups cat)
2939 (while (setq cat (pop cs))
23f87bed 2940 (setq groups (gnus-agent-cat-groups cat))
df80b09f
LMI		 2941 (while groups
2942 (gnus-sethash (pop groups) cat gnus-category-group-cache)))))
2943 (or (gnus-gethash group gnus-category-group-cache)
2944 (assq 'default gnus-category-alist)))
2945
23f87bed
MB		 2946(defun gnus-agent-expire-group (group &optional articles force)
2947 "Expire all old articles in GROUP.
2948If you want to force expiring of certain articles, this function can
2949take ARTICLES, and FORCE parameters as well.
2950
2951The articles on which the expiration process runs are selected as follows:
2952 if ARTICLES is null, all read and unmarked articles.
2953 if ARTICLES is t, all articles.
2954 if ARTICLES is a list, just those articles.
2955FORCE is equivalent to setting the expiration predicates to true."
2956 (interactive
2957 (list (let ((def (or (gnus-group-group-name)
2958 gnus-newsgroup-name)))
2959 (let ((select (read-string (if def
2960 (concat "Group Name ("
2961 def "): ")
2962 "Group Name: "))))
2963 (if (and (equal "" select)
2964 def)
2965 def
2966 select)))))
2967
2968 (if (not group)
2969 (gnus-agent-expire articles group force)
2970 (let ( ;; Bind gnus-agent-expire-stats to enable tracking of
2971 ;; expiration statistics of this single group
2972 (gnus-agent-expire-stats (list 0 0 0.0)))
2973 (if (or (not (eq articles t))
2974 (yes-or-no-p
2975 (concat "Are you sure that you want to "
66841476 2976 "expire all articles in " group "? ")))
23f87bed
MB		 2977 (let ((gnus-command-method (gnus-find-method-for-group group))
2978 (overview (gnus-get-buffer-create " *expire overview*"))
2979 orig)
2980 (unwind-protect
2981 (let ((active-file (gnus-agent-lib-file "active")))
2982 (when (file-exists-p active-file)
2983 (with-temp-buffer
2984 (nnheader-insert-file-contents active-file)
2985 (gnus-active-to-gnus-format
2986 gnus-command-method
2987 (setq orig (gnus-make-hashtable
2988 (count-lines (point-min) (point-max))))))
2989 (save-excursion
2990 (gnus-agent-expire-group-1
2991 group overview (gnus-gethash-safe group orig)
2992 articles force))))
2993 (kill-buffer overview))))
2994 (gnus-message 4 (gnus-agent-expire-done-message)))))
2995
2996(defun gnus-agent-expire-group-1 (group overview active articles force)
2997 ;; Internal function - requires caller to have set
2998 ;; gnus-command-method, initialized overview buffer, and to have
2999 ;; provided a non-nil active
3000
3001 (let ((dir (gnus-agent-group-pathname group)))
3002 (when (boundp 'gnus-agent-expire-current-dirs)
bf247b6e
KS		 3003 (set 'gnus-agent-expire-current-dirs
3004 (cons dir
54506618 3005 (symbol-value 'gnus-agent-expire-current-dirs))))
23f87bed
MB		 3006
3007 (if (and (not force)
bf247b6e 3008 (eq 'DISABLE (gnus-agent-find-parameter group
54506618
MB		 3009 'agent-enable-expiration)))
3010 (gnus-message 5 "Expiry skipping over %s" group)
23f87bed
MB		 3011 (gnus-message 5 "Expiring articles in %s" group)
3012 (gnus-agent-load-alist group)
54506618
MB		 3013 (let* ((bytes-freed 0)
3014 (files-deleted 0)
3015 (nov-entries-deleted 0)
3016 (info (gnus-get-info group))
3017 (alist gnus-agent-article-alist)
3018 (day (- (time-to-days (current-time))
3019 (gnus-agent-find-parameter group 'agent-days-until-old)))
3020 (specials (if (and alist
3021 (not force))
3022 ;; This could be a bit of a problem. I need to
3023 ;; keep the last article to avoid refetching
3024 ;; headers when using nntp in the backend. At
3025 ;; the same time, if someone uses a backend
3026 ;; that supports article moving then I may have
3027 ;; to remove the last article to complete the
3028 ;; move. Right now, I'm going to assume that
3029 ;; FORCE overrides specials.
3030 (list (caar (last alist)))))
3031 (unreads ;; Articles that are excluded from the
3032 ;; expiration process
3033 (cond (gnus-agent-expire-all
3034 ;; All articles are marked read by global decree
3035 nil)
3036 ((eq articles t)
3037 ;; All articles are marked read by function
3038 ;; parameter
3039 nil)
3040 ((not articles)
3041 ;; Unread articles are marked protected from
3042 ;; expiration Don't call
3043 ;; gnus-list-of-unread-articles as it returns
3044 ;; articles that have not been fetched into the
3045 ;; agent.
3046 (ignore-errors
3047 (gnus-agent-unread-articles group)))
3048 (t
3049 ;; All articles EXCEPT those named by the caller
3050 ;; are protected from expiration
3051 (gnus-sorted-difference
3052 (gnus-uncompress-range
3053 (cons (caar alist)
3054 (caar (last alist))))
3055 (sort articles '<)))))
3056 (marked ;; More articles that are excluded from the
3057 ;; expiration process
3058 (cond (gnus-agent-expire-all
3059 ;; All articles are unmarked by global decree
3060 nil)
3061 ((eq articles t)
3062 ;; All articles are unmarked by function
3063 ;; parameter
3064 nil)
3065 (articles
3066 ;; All articles may as well be unmarked as the
3067 ;; unreads list already names the articles we are
3068 ;; going to keep
3069 nil)
3070 (t
3071 ;; Ticked and/or dormant articles are excluded
3072 ;; from expiration
3073 (nconc
3074 (gnus-uncompress-range
3075 (cdr (assq 'tick (gnus-info-marks info))))
3076 (gnus-uncompress-range
3077 (cdr (assq 'dormant
3078 (gnus-info-marks info))))))))
3079 (nov-file (concat dir ".overview"))
3080 (cnt 0)
3081 (completed -1)
3082 dlist
3083 type)
3084
3085 ;; The normal article alist contains elements that look like
3086 ;; (article# . fetch_date) I need to combine other
3087 ;; information with this list. For example, a flag indicating
3088 ;; that a particular article MUST BE KEPT. To do this, I'm
3089 ;; going to transform the elements to look like (article#
3090 ;; fetch_date keep_flag NOV_entry_marker) Later, I'll reverse
3091 ;; the process to generate the expired article alist.
3092
3093 ;; Convert the alist elements to (article# fetch_date nil
3094 ;; nil).
3095 (setq dlist (mapcar (lambda (e)
3096 (list (car e) (cdr e) nil nil)) alist))
3097
3098 ;; Convert the keep lists to elements that look like (article#
3099 ;; nil keep_flag nil) then append it to the expanded dlist
3100 ;; These statements are sorted by ascending precidence of the
3101 ;; keep_flag.
3102 (setq dlist (nconc dlist
3103 (mapcar (lambda (e)
3104 (list e nil 'unread nil))
3105 unreads)))
3106 (setq dlist (nconc dlist
3107 (mapcar (lambda (e)
3108 (list e nil 'marked nil))
3109 marked)))
3110 (setq dlist (nconc dlist
3111 (mapcar (lambda (e)
3112 (list e nil 'special nil))
3113 specials)))
3114
3115 (set-buffer overview)
3116 (erase-buffer)
3117 (buffer-disable-undo)
3118 (when (file-exists-p nov-file)
3119 (gnus-message 7 "gnus-agent-expire: Loading overview...")
3120 (nnheader-insert-file-contents nov-file)
3121 (goto-char (point-min))
3122
3123 (let (p)
3124 (while (< (setq p (point)) (point-max))
3125 (condition-case nil
3126 ;; If I successfully read an integer (the plus zero
3127 ;; ensures a numeric type), prepend a marker entry
3128 ;; to the list
3129 (push (list (+ 0 (read (current-buffer))) nil nil
3130 (set-marker (make-marker) p))
3131 dlist)
3132 (error
3133 (gnus-message 1 "gnus-agent-expire: read error \
23f87bed
MB		 3134occurred when reading expression at %s in %s. Skipping to next \
3135line." (point) nov-file)))
54506618
MB		 3136 ;; Whether I succeeded, or failed, it doesn't matter.
3137 ;; Move to the next line then try again.
3138 (forward-line 1)))
3139
3140 (gnus-message
3141 7 "gnus-agent-expire: Loading overview... Done"))
3142 (set-buffer-modified-p nil)
3143
3144 ;; At this point, all of the information is in dlist. The
3145 ;; only problem is that much of it is spread across multiple
3146 ;; entries. Sort then MERGE!!
3147 (gnus-message 7 "gnus-agent-expire: Sorting entries... ")
3148 ;; If two entries have the same article-number then sort by
3149 ;; ascending keep_flag.
3150 (let ((special 0)
3151 (marked 1)
3152 (unread 2))
3153 (setq dlist
3154 (sort dlist
3155 (lambda (a b)
3156 (cond ((< (nth 0 a) (nth 0 b))
3157 t)
3158 ((> (nth 0 a) (nth 0 b))
3159 nil)
3160 (t
3161 (let ((a (or (symbol-value (nth 2 a))
3162 3))
3163 (b (or (symbol-value (nth 2 b))
3164 3)))
3165 (<= a b))))))))
3166 (gnus-message 7 "gnus-agent-expire: Sorting entries... Done")
3167 (gnus-message 7 "gnus-agent-expire: Merging entries... ")
3168 (let ((dlist dlist))
3169 (while (cdr dlist) ; I'm not at the end-of-list
3170 (if (eq (caar dlist) (caadr dlist))
3171 (let ((first (cdr (car dlist)))
3172 (secnd (cdr (cadr dlist))))
3173 (setcar first (or (car first)
3174 (car secnd))) ; fetch_date
3175 (setq first (cdr first)
3176 secnd (cdr secnd))
3177 (setcar first (or (car first)
3178 (car secnd))) ; Keep_flag
3179 (setq first (cdr first)
3180 secnd (cdr secnd))
3181 (setcar first (or (car first)
3182 (car secnd))) ; NOV_entry_marker
3183
3184 (setcdr dlist (cddr dlist)))
3185 (setq dlist (cdr dlist)))))
3186 (gnus-message 7 "gnus-agent-expire: Merging entries... Done")
3187
3188 (let* ((len (float (length dlist)))
3189 (alist (list nil))
3190 (tail-alist alist))
3191 (while dlist
3192 (let ((new-completed (truncate (* 100.0
3193 (/ (setq cnt (1+ cnt))
3194 len))))
23f87bed 3195 message-log-max)
54506618
MB		 3196 (when (> new-completed completed)
3197 (setq completed new-completed)
3198 (gnus-message 7 "%3d%% completed..." completed)))
3199 (let* ((entry (car dlist))
3200 (article-number (nth 0 entry))
3201 (fetch-date (nth 1 entry))
3202 (keep (nth 2 entry))
3203 (marker (nth 3 entry)))
3204
3205 (cond
3206 ;; Kept articles are unread, marked, or special.
3207 (keep
3208 (gnus-agent-message 10
3209 "gnus-agent-expire: %s:%d: Kept %s article%s."
3210 group article-number keep (if fetch-date " and file" ""))
3211 (when fetch-date
3212 (unless (file-exists-p
3213 (concat dir (number-to-string
3214 article-number)))
3215 (setf (nth 1 entry) nil)
3216 (gnus-agent-message 3 "gnus-agent-expire cleared \
23f87bed 3217download flag on %s:%d as the cached article file is missing."
54506618
MB		 3218 group (caar dlist)))
3219 (unless marker
3220 (gnus-message 1 "gnus-agent-expire detected a \
23f87bed 3221missing NOV entry. Run gnus-agent-regenerate-group to restore it.")))
54506618
MB		 3222 (gnus-agent-append-to-list
3223 tail-alist
3224 (cons article-number fetch-date)))
3225
3226 ;; The following articles are READ, UNMARKED, and
3227 ;; ORDINARY. See if they can be EXPIRED!!!
3228 ((setq type
3229 (cond
3230 ((not (integerp fetch-date))
58090a8d 3231 'read) ;; never fetched article (may expire
54506618
MB		 3232 ;; right now)
3233 ((not (file-exists-p
3234 (concat dir (number-to-string
3235 article-number))))
3236 (setf (nth 1 entry) nil)
3237 'externally-expired) ;; Can't find the cached
3238 ;; article. Handle case
3239 ;; as though this article
3240 ;; was never fetched.
3241
3242 ;; We now have the arrival day, so we see
3243 ;; whether it's old enough to be expired.
3244 ((< fetch-date day)
3245 'expired)
3246 (force
3247 'forced)))
3248
3249 ;; I found some reason to expire this entry.
3250
3251 (let ((actions nil))
3252 (when (memq type '(forced expired))
3253 (ignore-errors ; Just being paranoid.
3254 (let* ((file-name (nnheader-concat dir (number-to-string
3255 article-number)))
3256 (size (float (nth 7 (file-attributes file-name)))))
3257 (incf bytes-freed size)
3258 (incf files-deleted)
3259 (delete-file file-name))
3260 (push "expired cached article" actions))
3261 (setf (nth 1 entry) nil)
3262 )
3263
3264 (when marker
3265 (push "NOV entry removed" actions)
3266 (goto-char marker)
3267
3268 (incf nov-entries-deleted)
3269
3270 (let ((from (gnus-point-at-bol))
3271 (to (progn (forward-line 1) (point))))
3272 (incf bytes-freed (- to from))
3273 (delete-region from to)))
3274
3275 ;; If considering all articles is set, I can only
3276 ;; expire article IDs that are no longer in the
3277 ;; active range (That is, articles that preceed the
3278 ;; first article in the new alist).
3279 (if (and gnus-agent-consider-all-articles
3280 (>= article-number (car active)))
3281 ;; I have to keep this ID in the alist
3282 (gnus-agent-append-to-list
3283 tail-alist (cons article-number fetch-date))
3284 (push (format "Removed %s article number from \
23f87bed
MB		 3285article alist" type) actions))
3286
3287 (when actions
3288 (gnus-agent-message 8 "gnus-agent-expire: %s:%d: %s"
3289 group article-number
3290 (mapconcat 'identity actions ", ")))))
54506618
MB		 3291 (t
3292 (gnus-agent-message
3293 10 "gnus-agent-expire: %s:%d: Article kept as \
23f87bed 3294expiration tests failed." group article-number)
54506618
MB		 3295 (gnus-agent-append-to-list
3296 tail-alist (cons article-number fetch-date)))
3297 )
3298
3299 ;; Clean up markers as I want to recycle this buffer
3300 ;; over several groups.
3301 (when marker
3302 (set-marker marker nil))
3303
3304 (setq dlist (cdr dlist))))
3305
3306 (setq alist (cdr alist))
3307
3308 (let ((inhibit-quit t))
3309 (unless (equal alist gnus-agent-article-alist)
3310 (setq gnus-agent-article-alist alist)
3311 (gnus-agent-save-alist group))
3312
3313 (when (buffer-modified-p)
3314 (let ((coding-system-for-write
3315 gnus-agent-file-coding-system))
3316 (gnus-make-directory dir)
3317 (write-region (point-min) (point-max) nov-file nil
3318 'silent)
3319 ;; clear the modified flag as that I'm not confused by
3320 ;; its status on the next pass through this routine.
3321 (set-buffer-modified-p nil)))
3322
3323 (when (eq articles t)
3324 (gnus-summary-update-info))))
3325
3326 (when (boundp 'gnus-agent-expire-stats)
3327 (let ((stats (symbol-value 'gnus-agent-expire-stats)))
3328 (incf (nth 2 stats) bytes-freed)
3329 (incf (nth 1 stats) files-deleted)
3330 (incf (nth 0 stats) nov-entries-deleted)))
3331 ))))
23f87bed
MB		 3332
3333(defun gnus-agent-expire (&optional articles group force)
3334 "Expire all old articles.
3335If you want to force expiring of certain articles, this function can
3336take ARTICLES, GROUP and FORCE parameters as well.
3337
3338The articles on which the expiration process runs are selected as follows:
3339 if ARTICLES is null, all read and unmarked articles.
3340 if ARTICLES is t, all articles.
3341 if ARTICLES is a list, just those articles.
3342Setting GROUP will limit expiration to that group.
3343FORCE is equivalent to setting the expiration predicates to true."
df80b09f 3344 (interactive)
bf247b6e 3345
23f87bed
MB		 3346 (if group
3347 (gnus-agent-expire-group group articles force)
3348 (if (or (not (eq articles t))
3349 (yes-or-no-p "Are you sure that you want to expire all \
66841476 3350articles in every agentized group? "))
23f87bed
MB		 3351 (let ((methods (gnus-agent-covered-methods))
3352 ;; Bind gnus-agent-expire-current-dirs to enable tracking
3353 ;; of agent directories.
3354 (gnus-agent-expire-current-dirs nil)
3355 ;; Bind gnus-agent-expire-stats to enable tracking of
3356 ;; expiration statistics across all groups
3357 (gnus-agent-expire-stats (list 0 0 0.0))
3358 gnus-command-method overview orig)
3359 (setq overview (gnus-get-buffer-create " *expire overview*"))
3360 (unwind-protect
3361 (while (setq gnus-command-method (pop methods))
3362 (let ((active-file (gnus-agent-lib-file "active")))
3363 (when (file-exists-p active-file)
3364 (with-temp-buffer
3365 (nnheader-insert-file-contents active-file)
3366 (gnus-active-to-gnus-format
3367 gnus-command-method
3368 (setq orig (gnus-make-hashtable
3369 (count-lines (point-min) (point-max))))))
3370 (dolist (expiring-group (gnus-groups-from-server
3371 gnus-command-method))
3372 (let* ((active
3373 (gnus-gethash-safe expiring-group orig)))
bf247b6e 3374
23f87bed
MB		 3375 (when active
3376 (save-excursion
3377 (gnus-agent-expire-group-1
3378 expiring-group overview active articles force))))))))
3379 (kill-buffer overview))
3380 (gnus-agent-expire-unagentized-dirs)
3381 (gnus-message 4 (gnus-agent-expire-done-message))))))
3382
3383(defun gnus-agent-expire-done-message ()
3384 (if (and (> gnus-verbose 4)
3385 (boundp 'gnus-agent-expire-stats))
3386 (let* ((stats (symbol-value 'gnus-agent-expire-stats))
3387 (size (nth 2 stats))
3388 (units '(B KB MB GB)))
3389 (while (and (> size 1024.0)
3390 (cdr units))
3391 (setq size (/ size 1024.0)
3392 units (cdr units)))
3393
3394 (format "Expiry recovered %d NOV entries, deleted %d files,\
bf247b6e
KS		 3395 and freed %f %s."
3396 (nth 0 stats)
3397 (nth 1 stats)
23f87bed
MB		 3398 size (car units)))
3399 "Expiry...done"))
3400
3401(defun gnus-agent-expire-unagentized-dirs ()
3402 (when (and gnus-agent-expire-unagentized-dirs
3403 (boundp 'gnus-agent-expire-current-dirs))
3404 (let* ((keep (gnus-make-hashtable))
3405 ;; Formally bind gnus-agent-expire-current-dirs so that the
3406 ;; compiler will not complain about free references.
3407 (gnus-agent-expire-current-dirs
3408 (symbol-value 'gnus-agent-expire-current-dirs))
3409 dir)
3410
3411 (gnus-sethash gnus-agent-directory t keep)
3412 (while gnus-agent-expire-current-dirs
3413 (setq dir (pop gnus-agent-expire-current-dirs))
3414 (when (and (stringp dir)
3415 (file-directory-p dir))
3416 (while (not (gnus-gethash dir keep))
3417 (gnus-sethash dir t keep)
3418 (setq dir (file-name-directory (directory-file-name dir))))))
3419
3420 (let* (to-remove
3421 checker
3422 (checker
3423 (function
3424 (lambda (d)
bf247b6e
KS		 3425 "Given a directory, check it and its subdirectories for
3426 membership in the keep hash. If it isn't found, add
3427 it to to-remove."
23f87bed
MB		 3428 (let ((files (directory-files d))
3429 file)
3430 (while (setq file (pop files))
3431 (cond ((equal file ".") ; Ignore self
3432 nil)
3433 ((equal file "..") ; Ignore parent
3434 nil)
bf247b6e 3435 ((equal file ".overview")
23f87bed
MB		 3436 ;; Directory must contain .overview to be
3437 ;; agent's cache of a group.
3438 (let ((d (file-name-as-directory d))
3439 r)
3440 ;; Search ancestor's for last directory NOT
3441 ;; found in keep hash.
3442 (while (not (gnus-gethash
3443 (setq d (file-name-directory d)) keep))
3444 (setq r d
3445 d (directory-file-name d)))
3446 ;; if ANY ancestor was NOT in keep hash and
3447 ;; it it's already in to-remove, add it to
bf247b6e 3448 ;; to-remove.
23f87bed
MB		 3449 (if (and r
3450 (not (member r to-remove)))
3451 (push r to-remove))))
3452 ((file-directory-p (setq file (nnheader-concat d file)))
3453 (funcall checker file)))))))))
3454 (funcall checker (expand-file-name gnus-agent-directory))
3455
3456 (when (and to-remove
3457 (or gnus-expert-user
3458 (gnus-y-or-n-p
3459 "gnus-agent-expire has identified local directories that are\
3460 not currently required by any agentized group. Do you wish to consider\
3461 deleting them?")))
3462 (while to-remove
3463 (let ((dir (pop to-remove)))
3464 (if (gnus-y-or-n-p (format "Delete %s? " dir))
3465 (let* (delete-recursive
3466 (delete-recursive
3467 (function
3468 (lambda (f-or-d)
3469 (ignore-errors
3470 (if (file-directory-p f-or-d)
3471 (condition-case nil
3472 (delete-directory f-or-d)
3473 (file-error
3474 (mapcar (lambda (f)
3475 (or (member f '("." ".."))
3476 (funcall delete-recursive
3477 (nnheader-concat
3478 f-or-d f))))
3479 (directory-files f-or-d))
3480 (delete-directory f-or-d)))
3481 (delete-file f-or-d)))))))
3482 (funcall delete-recursive dir))))))))))
df80b09f
LMI		 3483
3484;;;###autoload
3485(defun gnus-agent-batch ()
23f87bed 3486 "Start Gnus, send queue and fetch session."
df80b09f
LMI		 3487 (interactive)
3488 (let ((init-file-user "")
3489 (gnus-always-read-dribble-file t))
3490 (gnus))
23f87bed
MB		 3491 (let ((gnus-agent-confirmation-function 'gnus-agent-batch-confirmation))
3492 (gnus-group-send-queue)
3493 (gnus-agent-fetch-session)))
3494
3495(defun gnus-agent-unread-articles (group)
3496 (let* ((read (gnus-info-read (gnus-get-info group)))
3497 (known (gnus-agent-load-alist group))
3498 (unread (list nil))
3499 (tail-unread unread))
3500 (while (and known read)
3501 (let ((candidate (car (pop known))))
3502 (while (let* ((range (car read))
3503 (min (if (numberp range) range (car range)))
3504 (max (if (numberp range) range (cdr range))))
3505 (cond ((or (not min)
3506 (< candidate min))
3507 (gnus-agent-append-to-list tail-unread candidate)
3508 nil)
3509 ((> candidate max)
3510 (setq read (cdr read))
3511 ;; return t so that I always loop one more
3512 ;; time. If I just iterated off the end of
3513 ;; read, min will become nil and the current
3514 ;; candidate will be added to the unread list.
3515 t))))))
3516 (while known
3517 (gnus-agent-append-to-list tail-unread (car (pop known))))
3518 (cdr unread)))
3519
3520(defun gnus-agent-uncached-articles (articles group &optional cached-header)
3521 "Restrict ARTICLES to numbers already fetched.
54506618 3522Returns a sublist of ARTICLES that excludes those article ids in GROUP
23f87bed
MB		 3523that have already been fetched.
3524If CACHED-HEADER is nil, articles are only excluded if the article itself
3525has been fetched."
3526
3527 ;; Logically equivalent to: (gnus-sorted-difference articles (mapcar
3528 ;; 'car gnus-agent-article-alist))
3529
3530 ;; Functionally, I don't need to construct a temp list using mapcar.
3531
3532 (if (and (or gnus-agent-cache (not gnus-plugged))
3533 (gnus-agent-load-alist group))
3534 (let* ((ref gnus-agent-article-alist)
3535 (arts articles)
3536 (uncached (list nil))
3537 (tail-uncached uncached))
3538 (while (and ref arts)
3539 (let ((v1 (car arts))
3540 (v2 (caar ref)))
3541 (cond ((< v1 v2) ; v1 does not appear in the reference list
3542 (gnus-agent-append-to-list tail-uncached v1)
3543 (setq arts (cdr arts)))
3544 ((= v1 v2)
3545 (unless (or cached-header (cdar ref)) ; v1 is already cached
3546 (gnus-agent-append-to-list tail-uncached v1))
3547 (setq arts (cdr arts))
3548 (setq ref (cdr ref)))
3549 (t ; reference article (v2) preceeds the list being filtered
3550 (setq ref (cdr ref))))))
3551 (while arts
3552 (gnus-agent-append-to-list tail-uncached (pop arts)))
3553 (cdr uncached))
3554 ;; if gnus-agent-load-alist fails, no articles are cached.
3555 articles))
3556
3557(defun gnus-agent-retrieve-headers (articles group &optional fetch-old)
3558 (save-excursion
3559 (gnus-agent-create-buffer)
3560 (let ((gnus-decode-encoded-word-function 'identity)
3561 (file (gnus-agent-article-name ".overview" group))
3562 cached-articles uncached-articles)
3563 (gnus-make-directory (nnheader-translate-file-chars
3564 (file-name-directory file) t))
3565
3566 ;; Populate temp buffer with known headers
3567 (when (file-exists-p file)
3568 (with-current-buffer gnus-agent-overview-buffer
3569 (erase-buffer)
3570 (let ((nnheader-file-coding-system
3571 gnus-agent-file-coding-system))
3572 (nnheader-insert-nov-file file (car articles)))))
3573
3574 (if (setq uncached-articles (gnus-agent-uncached-articles articles group
3575 t))
3576 (progn
3577 ;; Populate nntp-server-buffer with uncached headers
3578 (set-buffer nntp-server-buffer)
3579 (erase-buffer)
3580 (cond ((not (eq 'nov (let (gnus-agent) ; Turn off agent
3581 (gnus-retrieve-headers
3582 uncached-articles group fetch-old))))
3583 (nnvirtual-convert-headers))
3584 ((eq 'nntp (car gnus-current-select-method))
3585 ;; The author of gnus-get-newsgroup-headers-xover
3586 ;; reports that the XOVER command is commonly
3587 ;; unreliable. The problem is that recently
3588 ;; posted articles may not be entered into the
3589 ;; NOV database in time to respond to my XOVER
3590 ;; query.
3591 ;;
3592 ;; I'm going to use his assumption that the NOV
3593 ;; database is updated in order of ascending
3594 ;; article ID. Therefore, a response containing
3595 ;; article ID N implies that all articles from 1
3596 ;; to N-1 are up-to-date. Therefore, missing
3597 ;; articles in that range have expired.
3598
3599 (set-buffer nntp-server-buffer)
3600 (let* ((fetched-articles (list nil))
3601 (tail-fetched-articles fetched-articles)
3602 (min (cond ((numberp fetch-old)
3603 (max 1 (- (car articles) fetch-old)))
3604 (fetch-old
3605 1)
3606 (t
3607 (car articles))))
3608 (max (car (last articles))))
3609
3610 ;; Get the list of articles that were fetched
3611 (goto-char (point-min))
54506618
MB		 3612 (let ((pm (point-max))
3613 art)
23f87bed 3614 (while (< (point) pm)
54506618
MB		 3615 (when (setq art (gnus-agent-read-article-number))
3616 (gnus-agent-append-to-list tail-fetched-articles art))
23f87bed
MB		 3617 (forward-line 1)))
3618
3619 ;; Clip this list to the headers that will
3620 ;; actually be returned
3621 (setq fetched-articles (gnus-list-range-intersection
3622 (cdr fetched-articles)
3623 (cons min max)))
3624
3625 ;; Clip the uncached articles list to exclude
3626 ;; IDs after the last FETCHED header. The
3627 ;; excluded IDs may be fetchable using HEAD.
3628 (if (car tail-fetched-articles)
3629 (setq uncached-articles
3630 (gnus-list-range-intersection
3631 uncached-articles
3632 (cons (car uncached-articles)
3633 (car tail-fetched-articles)))))
3634
3635 ;; Create the list of articles that were
3636 ;; "successfully" fetched. Success, in this
3637 ;; case, means that the ID should not be
3638 ;; fetched again. In the case of an expired
3639 ;; article, the header will not be fetched.
3640 (setq uncached-articles
3641 (gnus-sorted-nunion fetched-articles
3642 uncached-articles))
3643 )))
3644
3645 ;; Erase the temp buffer
3646 (set-buffer gnus-agent-overview-buffer)
3647 (erase-buffer)
3648
3649 ;; Copy the nntp-server-buffer to the temp buffer
3650 (set-buffer nntp-server-buffer)
3651 (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max))
3652
54506618
MB		 3653 ;; Merge the temp buffer with the known headers (found on
3654 ;; disk in FILE) into the nntp-server-buffer
3655 (when uncached-articles
23f87bed
MB		 3656 (gnus-agent-braid-nov group uncached-articles file))
3657
54506618 3658 ;; Save the new set of known headers to FILE
23f87bed
MB		 3659 (set-buffer nntp-server-buffer)
3660 (let ((coding-system-for-write
3661 gnus-agent-file-coding-system))
3662 (gnus-agent-check-overview-buffer)
3663 (write-region (point-min) (point-max) file nil 'silent))
3664
3665 ;; Update the group's article alist to include the newly
3666 ;; fetched articles.
3667 (gnus-agent-load-alist group)
3668 (gnus-agent-save-alist group uncached-articles nil)
3669 )
3670
3671 ;; Copy the temp buffer to the nntp-server-buffer
3672 (set-buffer nntp-server-buffer)
3673 (erase-buffer)
3674 (insert-buffer-substring gnus-agent-overview-buffer)))
3675
3676 (if (and fetch-old
3677 (not (numberp fetch-old)))
3678 t ; Don't remove anything.
3679 (nnheader-nov-delete-outside-range
3680 (if fetch-old (max 1 (- (car articles) fetch-old))
3681 (car articles))
3682 (car (last articles)))
3683 t)
3684
3685 'nov))
3686
3687(defun gnus-agent-request-article (article group)
3688 "Retrieve ARTICLE in GROUP from the agent cache."
3689 (when (and gnus-agent
3690 (or gnus-agent-cache
3691 (not gnus-plugged))
3692 (numberp article))
3693 (let* ((gnus-command-method (gnus-find-method-for-group group))
3694 (file (gnus-agent-article-name (number-to-string article) group))
3695 (buffer-read-only nil))
3696 (when (and (file-exists-p file)
3697 (> (nth 7 (file-attributes file)) 0))
3698 (erase-buffer)
3699 (gnus-kill-all-overlays)
3700 (let ((coding-system-for-read gnus-cache-coding-system))
3701 (insert-file-contents file))
3702 t))))
3703
3704(defun gnus-agent-regenerate-group (group &optional reread)
3705 "Regenerate GROUP.
3706If REREAD is t, all articles in the .overview are marked as unread.
3707If REREAD is a list, the specified articles will be marked as unread.
3708In addition, their NOV entries in .overview will be refreshed using
3709the articles' current headers.
3710If REREAD is not nil, downloaded articles are marked as unread."
3711 (interactive
3712 (list (let ((def (or (gnus-group-group-name)
3713 gnus-newsgroup-name)))
3714 (let ((select (read-string (if def
3715 (concat "Group Name ("
3716 def "): ")
3717 "Group Name: "))))
3718 (if (and (equal "" select)
3719 def)
3720 def
3721 select)))
3722 (catch 'mark
3723 (while (let (c
3724 (cursor-in-echo-area t)
3725 (echo-keystrokes 0))
3726 (message "Mark as unread: (n)one / (a)ll / all (d)ownloaded articles? (n) ")
3727 (setq c (read-char-exclusive))
3728
3729 (cond ((or (eq c ?\r) (eq c ?n) (eq c ?N))
3730 (throw 'mark nil))
3731 ((or (eq c ?a) (eq c ?A))
3732 (throw 'mark t))
3733 ((or (eq c ?d) (eq c ?D))
3734 (throw 'mark 'some)))
3735 (gnus-message 3 "Ignoring unexpected input")
3736 (sit-for 1)
3737 t)))))
23f87bed
MB		 3738 (when group
3739 (gnus-message 5 "Regenerating in %s" group)
3740 (let* ((gnus-command-method (or gnus-command-method
3741 (gnus-find-method-for-group group)))
3742 (file (gnus-agent-article-name ".overview" group))
3743 (dir (file-name-directory file))
3744 point
3745 (downloaded (if (file-exists-p dir)
e9bd5782 3746 (sort (mapcar (lambda (name) (string-to-number name))
23f87bed
MB		 3747 (directory-files dir nil "^[0-9]+$" t))
3748 '>)
3749 (progn (gnus-make-directory dir) nil)))
3750 dl nov-arts
3751 alist header
3752 regenerated)
3753
3754 (mm-with-unibyte-buffer
3755 (if (file-exists-p file)
3756 (let ((nnheader-file-coding-system
3757 gnus-agent-file-coding-system))
3758 (nnheader-insert-file-contents file)))
3759 (set-buffer-modified-p nil)
3760
3761 ;; Load the article IDs found in the overview file. As a
3762 ;; side-effect, validate the file contents.
3763 (let ((load t))
3764 (while load
3765 (setq load nil)
3766 (goto-char (point-min))
3767 (while (< (point) (point-max))
3768 (cond ((and (looking-at "[0-9]+\t")
3769 (<= (- (match-end 0) (match-beginning 0)) 9))
3770 (push (read (current-buffer)) nov-arts)
3771 (forward-line 1)
3772 (let ((l1 (car nov-arts))
3773 (l2 (cadr nov-arts)))
3774 (cond ((and (listp reread) (memq l1 reread))
3775 (gnus-delete-line)
3776 (setq nov-arts (cdr nov-arts))
3777 (gnus-message 4 "gnus-agent-regenerate-group: NOV\
54506618 3778 entry of article %s deleted." l1))
23f87bed
MB		 3779 ((not l2)
3780 nil)
3781 ((< l1 l2)
3782 (gnus-message 3 "gnus-agent-regenerate-group: NOV\
3783 entries are NOT in ascending order.")
3784 ;; Don't sort now as I haven't verified
3785 ;; that every line begins with a number
3786 (setq load t))
3787 ((= l1 l2)
3788 (forward-line -1)
3789 (gnus-message 4 "gnus-agent-regenerate-group: NOV\
3790 entries contained duplicate of article %s. Duplicate deleted." l1)
3791 (gnus-delete-line)
3792 (setq nov-arts (cdr nov-arts))))))
3793 (t
3794 (gnus-message 1 "gnus-agent-regenerate-group: NOV\
3795 entries contained line that did not begin with an article number. Deleted\
3796 line.")
3797 (gnus-delete-line))))
3798 (when load
3799 (gnus-message 5 "gnus-agent-regenerate-group: Sorting NOV\
3800 entries into ascending order.")
3801 (sort-numeric-fields 1 (point-min) (point-max))
3802 (setq nov-arts nil))))
3803 (gnus-agent-check-overview-buffer)
3804
3805 ;; Construct a new article alist whose nodes match every header
3806 ;; in the .overview file. As a side-effect, missing headers are
3807 ;; reconstructed from the downloaded article file.
3808 (while (or downloaded nov-arts)
3809 (cond ((and downloaded
3810 (or (not nov-arts)
3811 (> (car downloaded) (car nov-arts))))
3812 ;; This entry is missing from the overview file
3813 (gnus-message 3 "Regenerating NOV %s %d..." group
3814 (car downloaded))
3815 (let ((file (concat dir (number-to-string (car downloaded)))))
3816 (mm-with-unibyte-buffer
3817 (nnheader-insert-file-contents file)
3818 (nnheader-remove-body)
3819 (setq header (nnheader-parse-naked-head)))
3820 (mail-header-set-number header (car downloaded))
3821 (if nov-arts
3822 (let ((key (concat "^" (int-to-string (car nov-arts))
3823 "\t")))
3824 (or (re-search-backward key nil t)
3825 (re-search-forward key))
3826 (forward-line 1))
3827 (goto-char (point-min)))
3828 (nnheader-insert-nov header))
3829 (setq nov-arts (cons (car downloaded) nov-arts)))
3830 ((eq (car downloaded) (car nov-arts))
3831 ;; This entry in the overview has been downloaded
3832 (push (cons (car downloaded)
3833 (time-to-days
3834 (nth 5 (file-attributes
3835 (concat dir (number-to-string
3836 (car downloaded))))))) alist)
3837 (setq downloaded (cdr downloaded))
3838 (setq nov-arts (cdr nov-arts)))
3839 (t
3840 ;; This entry in the overview has not been downloaded
3841 (push (cons (car nov-arts) nil) alist)
3842 (setq nov-arts (cdr nov-arts)))))
3843
3844 ;; When gnus-agent-consider-all-articles is set,
3845 ;; gnus-agent-regenerate-group should NOT remove article IDs from
3846 ;; the alist. Those IDs serve as markers to indicate that an
3847 ;; attempt has been made to fetch that article's header.
3848
3849 ;; When gnus-agent-consider-all-articles is NOT set,
3850 ;; gnus-agent-regenerate-group can remove the article ID of every
3851 ;; article (with the exception of the last ID in the list - it's
3852 ;; special) that no longer appears in the overview. In this
3853 ;; situtation, the last article ID in the list implies that it,
3854 ;; and every article ID preceeding it, have been fetched from the
3855 ;; server.
3856
3857 (if gnus-agent-consider-all-articles
3858 ;; Restore all article IDs that were not found in the overview file.
3859 (let* ((n (cons nil alist))
3860 (merged n)
3861 (o (gnus-agent-load-alist group)))
3862 (while o
3863 (let ((nID (caadr n))
3864 (oID (caar o)))
3865 (cond ((not nID)
3866 (setq n (setcdr n (list (list oID))))
3867 (setq o (cdr o)))
3868 ((< oID nID)
3869 (setcdr n (cons (list oID) (cdr n)))
3870 (setq o (cdr o)))
3871 ((= oID nID)
3872 (setq o (cdr o))
3873 (setq n (cdr n)))
3874 (t
3875 (setq n (cdr n))))))
3876 (setq alist (cdr merged)))
3877 ;; Restore the last article ID if it is not already in the new alist
3878 (let ((n (last alist))
3879 (o (last (gnus-agent-load-alist group))))
3880 (cond ((not o)
3881 nil)
3882 ((not n)
3883 (push (cons (caar o) nil) alist))
3884 ((< (caar n) (caar o))
3885 (setcdr n (list (car o)))))))
3886
3887 (let ((inhibit-quit t))
3888 (if (setq regenerated (buffer-modified-p))
3889 (let ((coding-system-for-write gnus-agent-file-coding-system))
3890 (write-region (point-min) (point-max) file nil 'silent)))
3891
3892 (setq regenerated (or regenerated
3893 (and reread gnus-agent-article-alist)
3894 (not (equal alist gnus-agent-article-alist))))
3895
3896 (setq gnus-agent-article-alist alist)
3897
3898 (when regenerated
3899 (gnus-agent-save-alist group)
bf247b6e 3900
23f87bed
MB		 3901 ;; I have to alter the group's active range NOW as
3902 ;; gnus-make-ascending-articles-unread will use it to
3903 ;; recalculate the number of unread articles in the group
3904
3905 (let ((group (gnus-group-real-name group))
3906 (group-active (or (gnus-active group)
3907 (gnus-activate-group group))))
3908 (gnus-agent-possibly-alter-active group group-active)))))
3909
3910 (when (and reread gnus-agent-article-alist)
58090a8d 3911 (gnus-agent-synchronize-group-flags
23f87bed 3912 group
58090a8d 3913 (list (list
23f87bed
MB		 3914 (if (listp reread)
3915 reread
3916 (delq nil (mapcar (function (lambda (c)
3917 (cond ((eq reread t)
3918 (car c))
3919 ((cdr c)
3920 (car c)))))
58090a8d
MB		 3921 gnus-agent-article-alist)))
3922 'del '(read)))
3923 gnus-command-method)
23f87bed
MB		 3924
3925 (when (gnus-buffer-live-p gnus-group-buffer)
54506618 3926 (gnus-group-update-group group t)))
23f87bed 3927
54506618 3928 (gnus-message 5 "")
23f87bed
MB		 3929 regenerated)))
3930
3931;;;###autoload
3932(defun gnus-agent-regenerate (&optional clean reread)
3933 "Regenerate all agent covered files.
3934If CLEAN, obsolete (ignore)."
3935 (interactive "P")
3936 (let (regenerated)
3937 (gnus-message 4 "Regenerating Gnus agent files...")
3938 (dolist (gnus-command-method (gnus-agent-covered-methods))
3939 (dolist (group (gnus-groups-from-server gnus-command-method))
3940 (setq regenerated (or (gnus-agent-regenerate-group group reread)
3941 regenerated))))
3942 (gnus-message 4 "Regenerating Gnus agent files...done")
3943
3944 regenerated))
3945
3946(defun gnus-agent-go-online (&optional force)
3947 "Switch servers into online status."
3948 (interactive (list t))
3949 (dolist (server gnus-opened-servers)
3950 (when (eq (nth 1 server) 'offline)
3951 (if (if (eq force 'ask)
3952 (gnus-y-or-n-p
3953 (format "Switch %s:%s into online status? "
3954 (caar server) (cadar server)))
3955 force)
3956 (setcar (nthcdr 1 server) 'close)))))
3957
3958(defun gnus-agent-toggle-group-plugged (group)
3959 "Toggle the status of the server of the current group."
3960 (interactive (list (gnus-group-group-name)))
3961 (let* ((method (gnus-find-method-for-group group))
3962 (status (cadr (assoc method gnus-opened-servers))))
3963 (if (eq status 'offline)
3964 (gnus-server-set-status method 'closed)
3965 (gnus-close-server method)
3966 (gnus-server-set-status method 'offline))
3967 (message "Turn %s:%s from %s to %s." (car method) (cadr method)
3968 (if (eq status 'offline) 'offline 'online)
3969 (if (eq status 'offline) 'online 'offline))))
3970
3971(defun gnus-agent-group-covered-p (group)
3972 (gnus-agent-method-p (gnus-group-method group)))
3973
df80b09f
LMI		 3974(provide 'gnus-agent)
3975
ab5796a9 3976;;; arch-tag: b0ba4afc-5229-4cee-ad25-9956daa4e91e
df80b09f 3977;;; gnus-agent.el ends here
Unnamed repository; edit this file 'description' to name the repository.