Lines Matching +defs:gnus +defs:agent +defs:cat +defs:enable +defs:expiration
0 ;;; gnus-agent.el --- unplugged support for Gnus
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
28 (require 'gnus)
29 (require 'gnus-cache)
32 (require 'gnus-sum)
33 (require 'gnus-score)
34 (require 'gnus-srvr)
35 (require 'gnus-util)
43 (autoload 'gnus-server-update-server "gnus-srvr")
44 (autoload 'gnus-agent-customize-category "gnus-cus")
47 (defcustom gnus-agent-directory (nnheader-concat gnus-directory "agent/")
48 "Where the Gnus agent will store its files."
49 :group 'gnus-agent
52 (defcustom gnus-agent-plugged-hook nil
54 :group 'gnus-agent
57 (defcustom gnus-agent-unplugged-hook nil
59 :group 'gnus-agent
62 (defcustom gnus-agent-fetched-hook nil
65 :group 'gnus-agent
68 (defcustom gnus-agent-handle-level gnus-level-subscribed
70 :group 'gnus-agent
73 (defcustom gnus-agent-expire-days 7
75 If you wish to disable Agent expiring, see `gnus-agent-enable-expiration'."
76 :group 'gnus-agent
79 (defcustom gnus-agent-expire-all nil
82 :group 'gnus-agent
85 (defcustom gnus-agent-group-mode-hook nil
87 :group 'gnus-agent
90 ;; Extracted from gnus-xmas-redefine in order to preserve user settings
92 (add-hook 'gnus-agent-group-mode-hook 'gnus-xmas-agent-group-menu-add))
94 (defcustom gnus-agent-summary-mode-hook nil
96 :group 'gnus-agent
99 ;; Extracted from gnus-xmas-redefine in order to preserve user settings
101 (add-hook 'gnus-agent-summary-mode-hook 'gnus-xmas-agent-summary-menu-add))
103 (defcustom gnus-agent-server-mode-hook nil
105 :group 'gnus-agent
108 ;; Extracted from gnus-xmas-redefine in order to preserve user settings
110 (add-hook 'gnus-agent-server-mode-hook 'gnus-xmas-agent-server-menu-add))
112 (defcustom gnus-agent-confirmation-function 'y-or-n-p
115 :group 'gnus-agent
118 (defcustom gnus-agent-synchronize-flags t
127 :group 'gnus-agent)
129 (defcustom gnus-agent-go-online 'ask
136 :group 'gnus-agent)
138 (defcustom gnus-agent-mark-unread-after-downloaded t
142 :group 'gnus-agent)
144 (defcustom gnus-agent-download-marks '(download)
148 :group 'gnus-agent)
150 (defcustom gnus-agent-consider-all-articles nil
151 "When non-nil, the agent will let the agent predicate decide
153 nil, the default, the agent will only let the predicate decide
154 whether unread articles are downloaded or not. If you enable this,
156 to look into the agent expiry settings to block the expiration of
160 :group 'gnus-agent)
162 (defcustom gnus-agent-max-fetch-size 10000000 ;; 10 Mb
163 "Chunk size for `gnus-agent-fetch-session'.
167 :group 'gnus-agent
170 (defcustom gnus-agent-enable-expiration 'ENABLE
171 "The default expiration state for each group.
172 When set to ENABLE, the default, `gnus-agent-expire' will expire old
174 to disable expiration in specific categories, topics, and groups. Of
175 course, you could change gnus-agent-enable-expiration to DISABLE then
176 enable expiration per categories, topics, and groups."
178 :group 'gnus-agent
182 (defcustom gnus-agent-expire-unagentized-dirs t
183 "*Whether expiration should expire in unagentized directories.
184 Have gnus-agent-expire scan the directories under
185 \(gnus-agent-directory) for groups that are no longer agentized.
189 :group 'gnus-agent)
191 (defcustom gnus-agent-auto-agentize-methods '(nntp nnimap)
194 See Info node `(gnus)Server Buffer'."
197 :group 'gnus-agent)
199 (defcustom gnus-agent-queue-mail t
200 "Whether and when outgoing mail should be queued by the agent.
204 :group 'gnus-agent
209 (defcustom gnus-agent-prompt-send-queue nil
210 "If non-nil, `gnus-group-send-queue' will prompt if called when
213 :group 'gnus-agent
216 (defcustom gnus-agent-article-alist-save-format 1
224 :group 'gnus-agent
230 (defvar gnus-agent-history-buffers nil)
231 (defvar gnus-agent-buffer-alist nil)
232 (defvar gnus-agent-article-alist nil
237 \(gnus-agent-fetch-articles sets the value to the day of the download).
240 routines (for example, get-agent-fetch-headers) use the last
242 2) The function `gnus-agent-regenerate' may destructively modify the value.")
243 (defvar gnus-agent-group-alist nil)
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)
252 (defvar gnus-agent-file-coding-system 'raw-text)
253 (defvar gnus-agent-file-loading-cache nil)
256 (defvar gnus-headers)
257 (defvar gnus-score)
263 (defun gnus-open-agent ()
264 (setq gnus-agent t)
265 (gnus-agent-read-servers)
266 (gnus-category-read)
267 (gnus-agent-create-buffer)
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))
272 (defun gnus-agent-create-buffer ()
273 (if (gnus-buffer-live-p gnus-agent-overview-buffer)
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))
281 (gnus-add-shutdown 'gnus-close-agent 'gnus)
283 (defun gnus-close-agent ()
284 (setq gnus-category-predicate-cache nil
285 gnus-category-group-cache nil
286 gnus-agent-spam-hashtb nil)
287 (gnus-kill-buffer gnus-agent-overview-buffer))
293 (defun gnus-agent-read-file (file)
301 (defsubst gnus-agent-method ()
302 (concat (symbol-name (car gnus-command-method)) "/"
303 (if (equal (cadr gnus-command-method) "")
305 (cadr gnus-command-method))))
307 (defsubst gnus-agent-directory ()
308 "The name of the Gnus agent directory."
309 (nnheader-concat gnus-agent-directory
310 (nnheader-translate-file-chars (gnus-agent-method)) "/"))
312 (defun gnus-agent-lib-file (file)
313 "The full name of the Gnus agent library FILE."
316 (expand-file-name "agent.lib" (gnus-agent-directory)))))
318 (defun gnus-agent-cat-set-property (category property value)
333 (defmacro gnus-agent-cat-defaccessor (name prop-name)
336 Given the call (gnus-agent-cat-defaccessor func PROPERTY1), the list may be
352 (list (quote gnus-agent-cat-set-property)
360 (defmacro gnus-agent-cat-name (category)
363 (gnus-agent-cat-defaccessor
364 gnus-agent-cat-days-until-old agent-days-until-old)
365 (gnus-agent-cat-defaccessor
366 gnus-agent-cat-enable-expiration agent-enable-expiration)
367 (gnus-agent-cat-defaccessor
368 gnus-agent-cat-groups agent-groups)
369 (gnus-agent-cat-defaccessor
370 gnus-agent-cat-high-score agent-high-score)
371 (gnus-agent-cat-defaccessor
372 gnus-agent-cat-length-when-long agent-long-article)
373 (gnus-agent-cat-defaccessor
374 gnus-agent-cat-length-when-short agent-short-article)
375 (gnus-agent-cat-defaccessor
376 gnus-agent-cat-low-score agent-low-score)
377 (gnus-agent-cat-defaccessor
378 gnus-agent-cat-predicate agent-predicate)
379 (gnus-agent-cat-defaccessor
380 gnus-agent-cat-score-file agent-score)
381 (gnus-agent-cat-defaccessor
382 gnus-agent-cat-enable-undownloaded-faces agent-enable-undownloaded-faces)
390 (define-setf-method gnus-agent-cat-groups (category)
398 (list (quote gnus-agent-set-cat-groups) category groups))
399 (list (quote gnus-agent-cat-groups) --category--temp--))))
402 (defun gnus-agent-set-cat-groups (category groups)
405 (old-g (gnus-agent-cat-groups category)))
407 ;; gnus-agent-add-group is fiddling with the group
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)))
421 (old-category (gnus-group-category group)))
424 (setf (gnus-agent-cat-groups old-category)
425 (delete group (gnus-agent-cat-groups
428 (setq gnus-category-group-cache nil))
430 (setcdr (or (assq 'agent-groups category)
431 (let ((cell (cons 'agent-groups nil)))
435 (defsubst gnus-agent-cat-make (name &optional default-agent-predicate)
436 (list name `(agent-predicate . ,(or default-agent-predicate 'false))))
440 (defun gnus-agent-start-fetch ()
442 (gnus-agent-create-buffer))
444 (defun gnus-agent-stop-fetch ()
446 (setq gnus-agent-spam-hashtb nil)
451 (defmacro gnus-agent-with-fetch (&rest forms)
454 (let ((gnus-agent-fetching t))
455 (gnus-agent-start-fetch)
457 (gnus-agent-stop-fetch)))
459 (put 'gnus-agent-with-fetch 'lisp-indent-function 0)
460 (put 'gnus-agent-with-fetch 'edebug-form-spec '(body))
462 (defmacro gnus-agent-append-to-list (tail value)
465 (defmacro gnus-agent-message (level &rest args)
466 `(if (<= ,level gnus-verbose)
473 (defvar gnus-agent-mode-hook nil
474 "Hook run when installing agent mode.")
476 (defvar gnus-agent-mode nil)
477 (defvar gnus-agent-mode-status '(gnus-agent-mode " Plugged"))
479 (defun gnus-agent-mode ()
480 "Minor mode for providing a agent support in Gnus buffers."
481 (let* ((buffer (progn (string-match "^gnus-\\(.*\\)-mode$"
484 (mode (intern (format "gnus-agent-%s-mode" buffer))))
485 (set (make-local-variable 'gnus-agent-mode) t)
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))
494 (push (cons mode (symbol-value (intern (format "gnus-agent-%s-mode-map"
497 (when (eq major-mode 'gnus-group-mode)
498 (let ((init-plugged gnus-plugged)
499 (gnus-agent-go-online nil))
500 ;; g-a-t-p does nothing when gnus-plugged isn't changed.
503 (setq gnus-plugged :unknown)
504 (gnus-agent-toggle-plugged init-plugged)))
505 (gnus-run-hooks 'gnus-agent-mode-hook
506 (intern (format "gnus-agent-%s-mode-hook" buffer)))))
508 (defvar gnus-agent-group-mode-map (make-sparse-keymap))
509 (gnus-define-keys gnus-agent-group-mode-map
510 "Ju" gnus-agent-fetch-groups
511 "Jc" gnus-enter-category-buffer
512 "Jj" gnus-agent-toggle-plugged
513 "Js" gnus-agent-fetch-session
514 "JY" gnus-agent-synchronize-flags
515 "JS" gnus-group-send-queue
516 "Ja" gnus-agent-add-group
517 "Jr" gnus-agent-remove-group
518 "Jo" gnus-agent-toggle-group-plugged)
520 (defun gnus-agent-group-make-menu-bar ()
521 (unless (boundp 'gnus-agent-group-menu)
523 gnus-agent-group-menu gnus-agent-group-mode-map ""
525 ["Toggle plugged" gnus-agent-toggle-plugged t]
526 ["Toggle group plugged" gnus-agent-toggle-group-plugged t]
527 ["List categories" gnus-enter-category-buffer t]
528 ["Add (current) group to category" gnus-agent-add-group t]
529 ["Remove (current) group from category" gnus-agent-remove-group t]
530 ["Send queue" gnus-group-send-queue gnus-plugged]
532 ["All" gnus-agent-fetch-session gnus-plugged]
533 ["Group" gnus-agent-fetch-group gnus-plugged])
534 ["Synchronize flags" gnus-agent-synchronize-flags t]
537 (defvar gnus-agent-summary-mode-map (make-sparse-keymap))
538 (gnus-define-keys gnus-agent-summary-mode-map
539 "Jj" gnus-agent-toggle-plugged
540 "Ju" gnus-agent-summary-fetch-group
541 "JS" gnus-agent-fetch-group
542 "Js" gnus-agent-summary-fetch-series
543 "J#" gnus-agent-mark-article
544 "J\M-#" gnus-agent-unmark-article
545 "@" gnus-agent-toggle-mark
546 "Jc" gnus-agent-catchup)
548 (defun gnus-agent-summary-make-menu-bar ()
549 (unless (boundp 'gnus-agent-summary-menu)
551 gnus-agent-summary-menu gnus-agent-summary-mode-map ""
553 ["Toggle plugged" gnus-agent-toggle-plugged t]
554 ["Mark as downloadable" gnus-agent-mark-article t]
555 ["Unmark as downloadable" gnus-agent-unmark-article t]
556 ["Toggle mark" gnus-agent-toggle-mark t]
557 ["Fetch downloadable" gnus-agent-summary-fetch-group t]
558 ["Catchup undownloaded" gnus-agent-catchup t]))))
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)
566 (defun gnus-agent-server-make-menu-bar ()
567 (unless (boundp 'gnus-agent-server-menu)
569 gnus-agent-server-menu gnus-agent-server-mode-map ""
571 ["Toggle plugged" gnus-agent-toggle-plugged t]
572 ["Add" gnus-agent-add-server t]
573 ["Remove" gnus-agent-remove-server t]))))
575 (defun gnus-agent-make-mode-line-string (string mouse-button mouse-func)
593 (defun gnus-agent-toggle-plugged (set-to)
595 (interactive (list (not gnus-plugged)))
596 (cond ((eq set-to gnus-plugged)
599 (setq gnus-plugged set-to)
600 (gnus-run-hooks 'gnus-agent-plugged-hook)
601 (setcar (cdr gnus-agent-mode-status)
602 (gnus-agent-make-mode-line-string " Plugged"
604 'gnus-agent-toggle-plugged))
605 (gnus-agent-go-online gnus-agent-go-online)
606 (gnus-agent-possibly-synchronize-flags))
608 (gnus-agent-close-connections)
609 (setq gnus-plugged set-to)
610 (gnus-run-hooks 'gnus-agent-unplugged-hook)
611 (setcar (cdr gnus-agent-mode-status)
612 (gnus-agent-make-mode-line-string " Unplugged"
614 'gnus-agent-toggle-plugged))))
617 (defmacro gnus-agent-while-plugged (&rest body)
618 `(let ((original-gnus-plugged gnus-plugged))
620 (progn (gnus-agent-toggle-plugged t)
622 (gnus-agent-toggle-plugged original-gnus-plugged))))
624 (put 'gnus-agent-while-plugged 'lisp-indent-function 0)
625 (put 'gnus-agent-while-plugged 'edebug-form-spec '(body))
627 (defun gnus-agent-close-connections ()
628 "Close all methods covered by the Gnus agent."
629 (let ((methods (gnus-agent-covered-methods)))
631 (gnus-close-server (pop methods)))))
634 (defun gnus-unplugged ()
637 (setq gnus-plugged nil)
638 (gnus))
641 (defun gnus-plugged ()
644 (setq gnus-plugged t)
645 (gnus))
648 (defun gnus-slave-unplugged (&optional arg)
651 (setq gnus-plugged nil)
652 (gnus arg nil 'slave))
655 (defun gnus-agentize ()
658 The gnus-agentize function is now called internally by gnus when
659 gnus-agent is set. If you wish to avoid calling gnus-agentize,
660 customize gnus-agent to nil.
662 This will modify the `gnus-setup-news-hook', and
663 `message-send-mail-real-function' variables, and install the Gnus agent
666 (gnus-open-agent)
667 (add-hook 'gnus-setup-news-hook 'gnus-agent-queue-setup)
668 (unless gnus-agent-send-mail-function
669 (setq gnus-agent-send-mail-function
672 message-send-mail-real-function 'gnus-agent-send-mail))
677 (unless (file-exists-p (nnheader-concat gnus-agent-directory "lib/servers"))
678 (gnus-message 3 "First time agent user, agentizing remote groups...")
681 (let ((method (gnus-server-to-method server-or-method)))
683 gnus-agent-auto-agentize-methods)
684 (push (gnus-method-to-server method)
685 gnus-agent-covered-methods)
686 (setq gnus-agent-method-p-cache nil))))
687 (cons gnus-select-method gnus-secondary-select-methods))
688 (gnus-agent-write-servers)))
690 (defun gnus-agent-queue-setup (&optional group-name)
693 (unless (gnus-gethash (format "nndraft:%s" (or group-name "queue"))
694 gnus-newsrc-hashtb)
695 (gnus-request-create-group (or group-name "queue") '(nndraft ""))
696 (let ((gnus-level-default-subscribed 1))
697 (gnus-subscribe-group (format "nndraft:%s" (or group-name "queue"))
699 (gnus-group-set-parameter
701 'gnus-dummy '((gnus-draft-mode)))))
703 (defun gnus-agent-send-mail ()
704 (if (or (not gnus-agent-queue-mail)
705 (and gnus-plugged (not (eq gnus-agent-queue-mail 'always))))
706 (funcall gnus-agent-send-mail-function)
711 (gnus-agent-insert-meta-information 'mail)
712 (gnus-request-accept-article "nndraft:queue" nil t t)))
714 (defun gnus-agent-insert-meta-information (type &optional method)
719 (message-remove-header gnus-agent-meta-information-header)
721 (insert gnus-agent-meta-information-header ": "
728 (defun gnus-agent-restore-gcc ()
733 (concat "^" (regexp-quote gnus-agent-gcc-header) ":") nil t)
736 (defun gnus-agent-any-covered-gcc ()
741 (mapcar 'gnus-inews-group-method
747 (setq covered (gnus-agent-method-p (car methods))
752 (defun gnus-agent-possibly-save-gcc ()
754 (when (and (not gnus-plugged) (gnus-agent-any-covered-gcc))
759 (replace-match (concat gnus-agent-gcc-header ":") 'fixedcase))))))
761 (defun gnus-agent-possibly-do-gcc ()
763 (when (or gnus-plugged (not (gnus-agent-any-covered-gcc)))
764 (gnus-inews-do-gcc)))
770 (defun gnus-agent-fetch-groups (n)
773 (unless gnus-plugged
775 (gnus-group-iterate n 'gnus-agent-fetch-group))
777 (defun gnus-agent-fetch-group (&optional group)
779 (interactive (list (gnus-group-group-name)))
780 (setq group (or group gnus-newsgroup-name))
784 (gnus-agent-while-plugged
785 (let ((gnus-command-method (gnus-find-method-for-group group)))
786 (gnus-agent-with-fetch
787 (gnus-agent-fetch-group-1 group gnus-command-method)
788 (gnus-message 5 "Fetching %s...done" group)))))
790 (defun gnus-agent-add-group (category arg)
791 "Add the current group to an agent category."
797 (mapcar (lambda (cat) (list (symbol-name (car cat))))
798 gnus-category-alist)
801 (let ((cat (assq category gnus-category-alist))
803 (gnus-group-iterate arg
805 (when (gnus-agent-cat-groups (setq c (gnus-group-category group)))
806 (setf (gnus-agent-cat-groups c)
807 (delete group (gnus-agent-cat-groups c))))
809 (setf (gnus-agent-cat-groups cat)
810 (nconc (gnus-agent-cat-groups cat) groups))
811 (gnus-category-write)))
813 (defun gnus-agent-remove-group (arg)
814 "Remove the current group from its agent category, if any."
817 (gnus-group-iterate arg
819 (when (gnus-agent-cat-groups (setq c (gnus-group-category group)))
820 (setf (gnus-agent-cat-groups c)
821 (delete group (gnus-agent-cat-groups c))))))
822 (gnus-category-write)))
824 (defun gnus-agent-synchronize-flags ()
828 (dolist (gnus-command-method (gnus-agent-covered-methods))
829 (when (file-exists-p (gnus-agent-lib-file "flags"))
830 (gnus-agent-synchronize-flags-server gnus-command-method)))))
832 (defun gnus-agent-possibly-synchronize-flags ()
833 "Synchronize flags according to `gnus-agent-synchronize-flags'."
836 (dolist (gnus-command-method (gnus-agent-covered-methods))
837 (when (and (file-exists-p (gnus-agent-lib-file "flags"))
838 (eq (gnus-server-status gnus-command-method) 'ok))
839 (gnus-agent-possibly-synchronize-flags-server gnus-command-method)))))
841 (defun gnus-agent-synchronize-flags-server (method)
843 (let ((gnus-command-method method)
844 (gnus-agent nil))
845 (when (file-exists-p (gnus-agent-lib-file "flags"))
848 (nnheader-insert-file-contents (gnus-agent-lib-file "flags"))
849 (cond ((null gnus-plugged)
850 (gnus-message
852 (nth 1 gnus-command-method)))
853 ((null (gnus-check-server gnus-command-method))
854 (gnus-message
855 1 "Couldn't open server %s" (nth 1 gnus-command-method)))
863 (delete-file (gnus-agent-lib-file "flags")))
865 (let ((file (gnus-agent-lib-file "flags")))
867 (gnus-agent-lib-file "flags") nil 'silent)
872 (defun gnus-agent-possibly-synchronize-flags-server (method)
873 "Synchronize flags for server according to `gnus-agent-synchronize-flags'."
874 (when (or (and gnus-agent-synchronize-flags
875 (not (eq gnus-agent-synchronize-flags 'ask)))
876 (and (eq gnus-agent-synchronize-flags 'ask)
877 (gnus-y-or-n-p (format "Synchronize flags on server `%s'? "
879 (gnus-agent-synchronize-flags-server method)))
882 (defun gnus-agent-rename-group (old-group new-group)
884 Always updates the agent, even when disabled, as the old agent
885 files would corrupt gnus when the agent was next enabled.
888 (let* ((old-command-method (gnus-find-method-for-group old-group))
890 (let (gnus-command-method old-command-method)
891 (gnus-agent-group-pathname old-group))))
892 (new-command-method (gnus-find-method-for-group new-group))
894 (let (gnus-command-method new-command-method)
895 (gnus-agent-group-pathname new-group)))))
896 (gnus-rename-file old-path new-path t)
898 (let* ((old-real-group (gnus-group-real-name old-group))
899 (new-real-group (gnus-group-real-name new-group))
900 (old-active (gnus-agent-get-group-info old-command-method old-real-group)))
901 (gnus-agent-save-group-info old-command-method old-real-group nil)
902 (gnus-agent-save-group-info new-command-method new-real-group old-active)
904 (let ((old-local (gnus-agent-get-local old-group
906 (gnus-agent-set-local old-group
909 (gnus-agent-set-local new-group
914 (defun gnus-agent-delete-group (group)
916 Always updates the agent, even when disabled, as the old agent
917 files would corrupt gnus when the agent was next enabled.
920 (let* ((command-method (gnus-find-method-for-group group))
922 (let (gnus-command-method command-method)
923 (gnus-agent-group-pathname group)))))
924 (gnus-delete-directory path)
926 (let* ((real-group (gnus-group-real-name group)))
927 (gnus-agent-save-group-info command-method real-group nil)
929 (let ((local (gnus-agent-get-local group
931 (gnus-agent-set-local group
939 (defun gnus-agent-add-server ()
940 "Enroll SERVER in the agent program."
942 (let* ((server (gnus-server-server-name))
943 (named-server (gnus-server-named-server))
945 (gnus-server-get-method nil server))))
949 (when (gnus-agent-method-p method)
950 (error "Server already in the agent program"))
952 (push named-server gnus-agent-covered-methods)
954 (setq gnus-agent-method-p-cache nil)
955 (gnus-server-update-server server)
956 (gnus-agent-write-servers)
957 (gnus-message 1 "Entered %s into the Agent" server)))
959 (defun gnus-agent-remove-server ()
960 "Remove SERVER from the agent program."
962 (let* ((server (gnus-server-server-name))
963 (named-server (gnus-server-named-server)))
967 (unless (member named-server gnus-agent-covered-methods)
968 (error "Server not in the agent program"))
970 (setq gnus-agent-covered-methods
971 (delete named-server gnus-agent-covered-methods)
972 gnus-agent-method-p-cache nil)
974 (gnus-server-update-server server)
975 (gnus-agent-write-servers)
976 (gnus-message 1 "Removed %s from the agent" server)))
978 (defun gnus-agent-read-servers ()
980 (setq gnus-agent-covered-methods
981 (gnus-agent-read-file
982 (nnheader-concat gnus-agent-directory "lib/servers"))
983 gnus-agent-method-p-cache nil)
987 ;; alright as the gnus startup code calls the validate methods
989 (if gnus-server-alist
990 (gnus-agent-read-servers-validate)))
992 (defun gnus-agent-read-servers-validate ()
996 (gnus-method-to-server server-or-method)))
997 (method (gnus-server-to-method server)))
999 (unless (member server gnus-agent-covered-methods)
1000 (push server gnus-agent-covered-methods)
1001 (setq gnus-agent-method-p-cache nil))
1002 (gnus-message 1 "Ignoring disappeared server `%s'" server))))
1003 (prog1 gnus-agent-covered-methods
1004 (setq gnus-agent-covered-methods nil))))
1006 (defun gnus-agent-read-servers-validate-native (native-method)
1007 (setq gnus-agent-covered-methods
1012 method)) gnus-agent-covered-methods)))
1014 (defun gnus-agent-write-servers ()
1016 (gnus-make-directory (nnheader-concat gnus-agent-directory "lib"))
1019 (with-temp-file (nnheader-concat gnus-agent-directory "lib/servers")
1020 (prin1 gnus-agent-covered-methods
1027 (defun gnus-agent-mark-article (n &optional unmark)
1038 (gnus-summary-set-agent-mark
1039 (gnus-summary-article-number) unmark)
1040 (zerop (gnus-summary-next-subject (if backward -1 1) nil t))))
1043 (gnus-message 7 "No more articles"))
1044 (gnus-summary-recenter)
1045 (gnus-summary-position-point)
1048 (defun gnus-agent-unmark-article (n)
1053 (gnus-agent-mark-article n t))
1055 (defun gnus-agent-toggle-mark (n)
1060 (gnus-agent-mark-article n 'toggle))
1062 (defun gnus-summary-set-agent-mark (article &optional unmark)
1071 (memq article gnus-newsgroup-downloadable)))))
1072 (when (gnus-summary-goto-subject article nil t)
1073 (gnus-summary-update-mark
1076 (setq gnus-newsgroup-downloadable
1077 (delq article gnus-newsgroup-downloadable))
1078 (gnus-article-mark article))
1079 (setq gnus-newsgroup-downloadable
1080 (gnus-add-to-sorted-list gnus-newsgroup-downloadable article))
1081 gnus-downloadable-mark)
1085 (defun gnus-agent-get-undownloaded-list ()
1087 (let ((gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name)))
1088 (when (set (make-local-variable 'gnus-newsgroup-agentized)
1089 (gnus-agent-method-p gnus-command-method))
1090 (let* ((alist (gnus-agent-load-alist gnus-newsgroup-name))
1093 gnus-newsgroup-headers) '<))
1094 (cached (and gnus-use-cache gnus-newsgroup-cached))
1109 ;; imply that this article isn't in the agent.
1110 (gnus-agent-append-to-list tail-undownloaded h)
1111 (gnus-agent-append-to-list tail-unfetched h)
1122 ;; This article isn't in the agent. Check to see
1128 (gnus-agent-append-to-list tail-undownloaded a))))))
1132 (gnus-agent-append-to-list tail-undownloaded num)
1133 (gnus-agent-append-to-list tail-unfetched num)))
1135 (setq gnus-newsgroup-undownloaded (cdr undownloaded)
1136 gnus-newsgroup-unfetched (cdr unfetched))))))
1138 (defun gnus-agent-catchup ()
1144 (let ((articles gnus-newsgroup-undownloaded))
1145 (when (or gnus-newsgroup-downloadable
1146 gnus-newsgroup-cached)
1147 (setq articles (gnus-sorted-ndifference
1148 (gnus-sorted-ndifference
1149 (gnus-copy-sequence articles)
1150 gnus-newsgroup-downloadable)
1151 gnus-newsgroup-cached)))
1154 (gnus-summary-mark-article
1155 (pop articles) gnus-catchup-mark)))
1156 (gnus-summary-position-point)))
1158 (defun gnus-agent-summary-fetch-series ()
1160 (when gnus-newsgroup-processable
1161 (setq gnus-newsgroup-downloadable
1162 (let* ((dl gnus-newsgroup-downloadable)
1163 (processable (sort (gnus-copy-sequence gnus-newsgroup-processable) '<))
1164 (gnus-newsgroup-downloadable processable))
1165 (gnus-agent-summary-fetch-group)
1170 (mapc #'gnus-summary-remove-process-mark
1171 (gnus-sorted-ndifference gnus-newsgroup-processable gnus-newsgroup-undownloaded))
1173 ;; The preceeding call to (gnus-agent-summary-fetch-group)
1174 ;; updated the temporary gnus-newsgroup-downloadable to
1176 ;; update the real gnus-newsgroup-downloadable to only
1178 (gnus-sorted-ndifference dl (gnus-sorted-ndifference processable gnus-newsgroup-undownloaded))))))
1180 (defun gnus-agent-summary-fetch-group (&optional all)
1185 (if all gnus-newsgroup-articles
1186 gnus-newsgroup-downloadable))
1187 (gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name))
1189 (gnus-agent-while-plugged
1192 (gnus-agent-with-fetch
1193 (setq gnus-newsgroup-undownloaded
1194 (gnus-sorted-ndifference
1195 gnus-newsgroup-undownloaded
1197 (gnus-agent-fetch-articles
1198 gnus-newsgroup-name articles)))))
1202 (memq article gnus-newsgroup-downloadable)))
1203 (cond (gnus-agent-mark-unread-after-downloaded
1204 (setq gnus-newsgroup-downloadable
1205 (delq article gnus-newsgroup-downloadable))
1207 (gnus-summary-mark-article article gnus-unread-mark))
1209 (gnus-summary-set-agent-mark article t)))
1210 (when (gnus-summary-goto-subject article nil t)
1211 (gnus-summary-update-download-mark article))))))
1214 (defun gnus-agent-fetch-selected-article ()
1216 This can be added to `gnus-select-article-hook' or
1217 `gnus-mark-article-hook'."
1218 (let ((gnus-command-method gnus-current-select-method))
1219 (when (and gnus-plugged (gnus-agent-method-p gnus-command-method))
1220 (when (gnus-agent-fetch-articles
1221 gnus-newsgroup-name
1222 (list gnus-current-article))
1223 (setq gnus-newsgroup-undownloaded
1224 (delq gnus-current-article gnus-newsgroup-undownloaded))
1225 (gnus-summary-update-download-mark gnus-current-article)))))
1231 (defun gnus-agent-synchronize-group-flags (group actions server)
1233 (let* ((gnus-command-method (gnus-server-to-method server))
1235 ;; This initializer is required as gnus-request-set-mark
1236 ;; calls gnus-group-real-name to strip off the host name
1238 ;; trying to call gnus-request-set-mark, I have to
1240 (or (gnus-get-info group)
1241 (gnus-get-info
1242 (setq group (gnus-group-full-name
1243 group gnus-command-method))))))
1244 (gnus-request-set-mark group actions)
1253 (gnus-info-set-read
1256 'gnus-range-add
1257 'gnus-remove-from-range)
1258 (gnus-info-read info)
1260 (gnus-get-unread-articles-in-group
1262 (gnus-active (gnus-info-group info))))
1264 (let ((info-marks (assoc mark (gnus-info-marks info))))
1266 (gnus-info-set-marks info (cons (setq info-marks (list mark)) (gnus-info-marks info))))
1268 'gnus-range-add
1269 'gnus-remove-from-range)
1276 (when (gnus-buffer-live-p gnus-group-buffer)
1277 (gnus-group-update-group group t)))
1280 (defun gnus-agent-save-active (method)
1281 (when (gnus-agent-method-p method)
1282 (let* ((gnus-command-method method)
1283 (new (gnus-make-hashtable (count-lines (point-min) (point-max))))
1284 (file (gnus-agent-lib-file "active")))
1285 (gnus-active-to-gnus-format nil new)
1286 (gnus-agent-write-active file new)
1290 (defun gnus-agent-write-active (file new)
1291 (gnus-make-directory (file-name-directory file))
1292 (let ((nnmail-active-file-coding-system gnus-agent-file-coding-system))
1294 ;; add the foreign server prefix as gnus-active-to-gnus-format
1296 (gnus-write-active-file file new nil)))
1299 (defun gnus-agent-possibly-alter-active (group active &optional info)
1301 downloaded into the agent."
1302 (let* ((gnus-command-method (or gnus-command-method
1303 (gnus-find-method-for-group group))))
1304 (when (gnus-agent-method-p gnus-command-method)
1305 (let* ((local (gnus-agent-get-local group))
1308 (agent-min (or (car local) active-min))
1309 (agent-max (or (cdr local) active-max)))
1311 (when (< agent-min active-min)
1312 (setcar active agent-min))
1314 (when (> agent-max active-max)
1315 (setcdr active agent-max))
1317 (when (and info (< agent-max (- active-min 100)))
1320 ;; last article known to the agent and the first article
1323 ;; gnus doesn't waste resources trying to fetch them.
1327 ;; gnus. The small gap will cause a tiny performance hit
1328 ;; when gnus tries, and fails, to retrieve the articles.
1333 (let ((read (gnus-info-read info)))
1334 (gnus-info-set-read
1336 (gnus-range-add
1338 (list (cons (1+ agent-max)
1341 ;; Lie about the agent's local range for this group to
1346 (gnus-agent-set-local group agent-min (1- active-min)))))))
1348 (defun gnus-agent-save-group-info (method group active)
1349 "Update a single group's active range in the agent's copy of the server's active file."
1350 (when (gnus-agent-method-p method)
1351 (let* ((gnus-command-method (or method gnus-command-method))
1354 (file (gnus-agent-lib-file "active"))
1356 (gnus-make-directory (file-name-directory file))
1369 (gnus-delete-line)))
1378 (defun gnus-agent-get-group-info (method group)
1379 "Get a single group's active range in the agent's copy of the server's active file."
1380 (when (gnus-agent-method-p method)
1381 (let* ((gnus-command-method (or method gnus-command-method))
1384 (file (gnus-agent-lib-file "active"))
1386 (gnus-make-directory (file-name-directory file))
1401 (defun gnus-agent-group-path (group)
1406 ;; gnus-agent-group-pathname was added.
1412 (gnus-group-real-name (gnus-group-decoded-name group))
1416 (file-directory-p (expand-file-name group (gnus-agent-directory))))
1422 (defun gnus-agent-group-pathname (group)
1425 ;; unplugged. The agent must, therefore, use the same directory
1427 (let ((gnus-command-method (or gnus-command-method
1428 (gnus-find-method-for-group group))))
1429 (nnmail-group-pathname (gnus-group-real-name
1430 (gnus-group-decoded-name group))
1431 (gnus-agent-directory))))
1433 (defun gnus-agent-get-function (method)
1434 (if (gnus-online method)
1439 (defun gnus-agent-covered-methods ()
1440 "Return the subset of methods that are covered by the agent."
1441 (delq nil (mapcar #'gnus-server-to-method gnus-agent-covered-methods)))
1445 (defun gnus-agent-history-buffer ()
1446 (cdr (assoc (gnus-agent-method) gnus-agent-history-buffers)))
1448 (defun gnus-agent-open-history ()
1450 (push (cons (gnus-agent-method)
1451 (set-buffer (gnus-get-buffer-create
1452 (format " *Gnus agent %s history*"
1453 (gnus-agent-method)))))
1454 gnus-agent-history-buffers)
1458 (let ((file (gnus-agent-lib-file "history")))
1461 (set (make-local-variable 'gnus-agent-file-name) file))))
1463 (defun gnus-agent-close-history ()
1464 (when (gnus-buffer-live-p gnus-agent-current-history)
1465 (kill-buffer gnus-agent-current-history)
1466 (setq gnus-agent-history-buffers
1467 (delq (assoc (gnus-agent-method) gnus-agent-history-buffers)
1468 gnus-agent-history-buffers))))
1474 (defun gnus-agent-fetch-articles (group articles)
1477 (gnus-agent-load-alist group)
1478 (let* ((alist gnus-agent-article-alist)
1479 (headers (if (< (length articles) 2) nil gnus-newsgroup-headers))
1508 (when (< gnus-agent-max-fetch-size
1532 (dir (gnus-agent-group-pathname group))
1540 (gnus-make-directory dir)
1541 (gnus-message 7 "Fetching articles for %s..." group)
1546 (if (gnus-check-backend-function 'retrieve-articles group)
1547 (setq pos (gnus-retrieve-articles articles group))
1551 (gnus-message 10 "Fetching article %s for %s..."
1554 (gnus-backlog-request-article group article
1556 (gnus-request-article article group))
1585 (gnus-agent-crosspost crosses (caar pos) date)))
1593 gnus-agent-file-coding-system))
1598 (gnus-agent-append-to-list
1603 (gnus-agent-save-alist group (cdr fetched-articles) date)
1604 (gnus-message 7 ""))
1607 (defun gnus-agent-unfetch-articles (group articles)
1608 "Delete ARTICLES that were fetched from GROUP into the agent."
1610 (gnus-agent-load-alist group)
1611 (let* ((alist (cons nil gnus-agent-article-alist))
1622 (let* ((file-name (concat (gnus-agent-group-pathname group)
1629 (setq gnus-agent-article-alist (cdr alist))
1630 (gnus-agent-save-alist group))))
1632 (defun gnus-agent-crosspost (crosses article &optional date)
1635 (let (gnus-agent-article-alist group alist beg end)
1637 (set-buffer gnus-agent-overview-buffer)
1644 (unless (setq alist (assoc group gnus-agent-group-alist))
1645 (push (setq alist (list group (gnus-agent-load-alist (caar crosses))))
1646 gnus-agent-group-alist))
1649 (set-buffer (gnus-get-buffer-create (format " *Gnus agent overview %s*"
1652 (push (cons group (current-buffer)) gnus-agent-buffer-alist)
1655 (gnus-agent-article-name ".overview" group))))
1658 (insert-buffer-substring gnus-agent-overview-buffer beg end)
1659 (gnus-agent-check-overview-buffer))
1662 (defun gnus-agent-backup-overview-buffer ()
1663 (when gnus-newsgroup-name
1664 (let ((root (gnus-agent-article-name ".overview" gnus-newsgroup-name))
1671 (gnus-message 1 "Created backup copy of overview in %s." name)))
1674 (defun gnus-agent-check-overview-buffer (&optional buffer)
1696 (setq backed-up (gnus-agent-backup-overview-buffer)))
1697 (gnus-message 1
1700 p (gnus-point-at-eol))))
1703 (setq backed-up (gnus-agent-backup-overview-buffer)))
1704 (gnus-message 1
1709 (setq backed-up (gnus-agent-backup-overview-buffer)))
1710 (gnus-message 1 "Overview buffer not sorted!")
1718 (defun gnus-agent-flush-cache ()
1720 (while gnus-agent-buffer-alist
1721 (set-buffer (cdar gnus-agent-buffer-alist))
1723 gnus-agent-file-coding-system))
1725 (gnus-agent-article-name ".overview"
1726 (caar gnus-agent-buffer-alist))
1728 (setq gnus-agent-buffer-alist (cdr gnus-agent-buffer-alist)))
1729 (while gnus-agent-group-alist
1730 (with-temp-file (gnus-agent-article-name
1731 ".agentview" (caar gnus-agent-group-alist))
1732 (princ (cdar gnus-agent-group-alist))
1736 (setq gnus-agent-group-alist (cdr gnus-agent-group-alist)))))
1739 (defun gnus-agent-find-parameter (group symbol)
1743 (or (gnus-group-find-parameter group symbol t)
1744 (gnus-group-parameter-value (cdr (gnus-group-category group)) symbol t)
1748 '((agent-short-article . gnus-agent-short-article)
1749 (agent-long-article . gnus-agent-long-article)
1750 (agent-low-score . gnus-agent-low-score)
1751 (agent-high-score . gnus-agent-high-score)
1752 (agent-days-until-old . gnus-agent-expire-days)
1753 (agent-enable-expiration
1754 . gnus-agent-enable-expiration)
1755 (agent-predicate . gnus-agent-predicate)))))))
1757 (defun gnus-agent-fetch-headers (group &optional force)
1758 "Fetch interesting headers into the agent. The group's overview
1761 (let* ((fetch-all (and gnus-agent-consider-all-articles
1764 (not (gnus-predicate-implies-unread
1765 (gnus-agent-find-parameter group
1766 'agent-predicate)))))
1768 (gnus-uncompress-range (gnus-active group))
1769 (gnus-list-of-unread-articles group)))
1770 (gnus-decode-encoded-word-function 'identity)
1771 (file (gnus-agent-article-name ".overview" group)))
1778 ;; because otherwise the agent will remove their marks.)
1779 (dolist (arts (gnus-info-marks (gnus-get-info group)))
1781 (setq articles (gnus-range-add articles (cdr arts)))))
1782 (setq articles (sort (gnus-uncompress-sequence articles) '<)))
1792 (when (and (or gnus-agent-cache
1793 (not gnus-plugged))
1794 (gnus-agent-load-alist group))
1801 ;; agent expiration in this group.
1802 (setq articles (gnus-agent-uncached-articles articles group))
1807 (let ((low (1+ (caar (last gnus-agent-article-alist))))
1808 (high (cdr (gnus-active group))))
1812 ;; gnus-agent-article-alist) equals (cdr (gnus-active
1815 ;; gnus-list-range-intersection returns nil which
1817 (setq articles (gnus-list-range-intersection
1820 (gnus-message
1821 10 "gnus-agent-fetch-headers: undownloaded articles are '%s'"
1822 (gnus-compress-sequence articles t))
1829 (gnus-message 7 "Fetching headers for %s..." group)
1832 (gnus-make-directory (nnheader-translate-file-chars
1835 (unless (eq 'nov (gnus-retrieve-headers articles group))
1837 (gnus-agent-check-overview-buffer)
1839 ;; gnus-agent-braid-nov can merge them with the contents
1842 gnus-agent-overview-buffer (point-min) (point-max))
1846 (gnus-agent-braid-nov group articles file)
1848 gnus-agent-file-coding-system))
1849 (gnus-agent-check-overview-buffer)
1851 (gnus-agent-save-alist group articles nil)
1858 (defsubst gnus-agent-read-article-number ()
1877 (defsubst gnus-agent-copy-nov-line (article)
1880 (set-buffer gnus-agent-overview-buffer)
1882 (or (not (setq art (gnus-agent-read-article-number)))
1892 (insert-buffer-substring gnus-agent-overview-buffer b e))))
1894 (defun gnus-agent-braid-nov (group articles file)
1895 "Merge agent overview data with given file.
1897 `gnus-agent-overview-buffer' and validated headers from the given
1902 (set-buffer gnus-agent-overview-buffer)
1917 (gnus-agent-copy-nov-line (pop articles))
1934 (gnus-agent-copy-nov-line (pop articles)))))
1941 (set-buffer gnus-agent-overview-buffer)
1946 (insert-buffer-substring gnus-agent-overview-buffer start)
1953 (setq art (gnus-agent-read-article-number))
1959 ;; Art num out of order - enable sort
1985 ;; gnus-agent-read-agentview.
1987 (defvar gnus-agent-read-agentview))
1989 (defun gnus-agent-load-alist (group)
1991 ;; Bind free variable that's used in `gnus-agent-read-agentview'.
1992 (let ((gnus-agent-read-agentview group))
1993 (setq gnus-agent-article-alist
1994 (gnus-cache-file-contents
1995 (gnus-agent-article-name ".agentview" group)
1996 'gnus-agent-file-loading-cache
1997 'gnus-agent-read-agentview))))
1999 (defun gnus-agent-read-agentview (file)
2015 (gnus-agent-open-history)
2016 (set-buffer (gnus-agent-history-buffer))
2022 gnus-agent-read-agentview)
2026 (gnus-agent-close-history)
2029 (setq changed-version (not (= 1 gnus-agent-article-alist-save-format))))
2036 (gnus-uncompress-range
2043 (setq changed-version (not (= 2 gnus-agent-article-alist-save-format)))))
2045 (let ((gnus-agent-article-alist alist))
2046 (gnus-agent-save-alist gnus-agent-read-agentview)))
2050 (defun gnus-agent-save-alist (group &optional articles state)
2053 (prev (cons nil gnus-agent-article-alist))
2068 (setq gnus-agent-article-alist (cdr all))
2070 (gnus-agent-set-local group
2071 (caar gnus-agent-article-alist)
2072 (caar (last gnus-agent-article-alist)))
2074 (gnus-make-directory (gnus-agent-article-name "" group))
2075 (with-temp-file (gnus-agent-article-name ".agentview" group)
2076 (cond ((eq gnus-agent-article-alist-save-format 1)
2077 (princ gnus-agent-article-alist (current-buffer)))
2078 ((eq gnus-agent-article-alist-save-format 2)
2090 nil)) gnus-agent-article-alist)
2093 (gnus-compress-sequence
2098 (princ gnus-agent-article-alist-save-format (current-buffer))
2101 (defvar gnus-agent-article-local nil)
2102 (defvar gnus-agent-file-loading-local nil)
2104 (defun gnus-agent-load-local (&optional method)
2107 (let ((gnus-command-method (or method gnus-command-method)))
2108 (setq gnus-agent-article-local
2109 (gnus-cache-file-contents
2110 (gnus-agent-lib-file "local")
2111 'gnus-agent-file-loading-local
2112 'gnus-agent-read-and-cache-local))))
2114 (defun gnus-agent-read-and-cache-local (file)
2116 gnus-agent-article-local. If that variable had `dirty' (also known as
2119 (if (and gnus-agent-article-local
2120 (symbol-value (intern "+dirty" gnus-agent-article-local)))
2121 (gnus-agent-save-local))
2122 (gnus-agent-read-local file))
2124 (defun gnus-agent-read-local (file)
2126 (let ((my-obarray (gnus-make-hashtable (count-lines (point-min)
2131 (let ((nnheader-file-coding-system gnus-agent-file-coding-system))
2158 (gnus-message 3 "Warning - invalid agent local: %s on line %d: %s"
2164 (set (intern "+method" my-obarray) gnus-command-method)
2167 (defun gnus-agent-save-local (&optional force)
2168 "Save gnus-agent-article-local under it method's agent.lib directory."
2169 (let ((my-obarray gnus-agent-article-local))
2172 (let* ((gnus-command-method (symbol-value (intern "+method" my-obarray)))
2173 ;; NOTE: gnus-command-method is used within gnus-agent-lib-file.
2174 (dest (gnus-agent-lib-file "local")))
2175 (gnus-make-directory (gnus-agent-lib-file ""))
2177 (let ((buffer-file-coding-system gnus-agent-file-coding-system))
2179 (let ((gnus-command-method (symbol-value (intern "+method" my-obarray)))
2199 (defun gnus-agent-get-local (group &optional gmane method)
2200 (let* ((gmane (or gmane (gnus-group-real-name group)))
2201 (gnus-command-method (or method (gnus-find-method-for-group group)))
2202 (local (gnus-agent-load-local))
2206 ;; Bind these so that gnus-agent-load-alist doesn't change the
2207 ;; current alist (i.e. gnus-agent-article-alist)
2208 (let* ((gnus-agent-article-alist gnus-agent-article-alist)
2209 (gnus-agent-file-loading-cache gnus-agent-file-loading-cache)
2210 (alist (gnus-agent-load-alist group)))
2215 (gnus-agent-set-local group (car minmax) (cdr minmax)
2216 gmane gnus-command-method local))))
2219 (defun gnus-agent-set-local (group min max &optional gmane method local)
2220 (let* ((gmane (or gmane (gnus-group-real-name group)))
2221 (gnus-command-method (or method (gnus-find-method-for-group group)))
2222 (local (or local (gnus-agent-load-local)))
2243 (defun gnus-agent-article-name (article group)
2246 (gnus-agent-group-pathname group))))
2248 (defun gnus-agent-batch-confirmation (msg)
2250 (gnus-message 1 msg)
2254 (defun gnus-agent-batch-fetch ()
2257 (gnus)
2258 (let ((gnus-agent-confirmation-function 'gnus-agent-batch-confirmation))
2259 (gnus-agent-fetch-session))
2260 (gnus-group-exit))
2262 (defun gnus-agent-fetch-session ()
2265 (unless gnus-agent-covered-methods
2266 (error "No servers are covered by the Gnus agent"))
2267 (unless gnus-plugged
2269 (let ((methods (gnus-agent-covered-methods))
2270 groups group gnus-command-method)
2273 (setq gnus-command-method (car methods))
2274 (when (and (or (gnus-server-opened gnus-command-method)
2275 (gnus-open-server gnus-command-method))
2276 (gnus-online gnus-command-method))
2277 (setq groups (gnus-groups-from-server (car methods)))
2278 (gnus-agent-with-fetch
2280 (when (<= (gnus-group-level group)
2281 gnus-agent-handle-level)
2283 (gnus-agent-fetch-group-1
2284 group gnus-command-method)
2286 (gnus-agent-fetch-group-1
2287 group gnus-command-method)
2289 (unless (funcall gnus-agent-confirmation-function
2290 (format "Error %s while fetching session. Should gnus continue? "
2292 (error "Cannot fetch articles into the Gnus agent")))
2294 (gnus-agent-regenerate-group group)
2295 (unless (funcall gnus-agent-confirmation-function
2297 "%s while fetching session. Should gnus continue? "
2300 "Cannot fetch articles into the Gnus agent")))))))))
2302 (gnus-run-hooks 'gnus-agent-fetched-hook)
2303 (gnus-message 6 "Finished fetching articles into the Gnus agent"))))
2305 (defun gnus-agent-fetch-group-1 (group method)
2307 (let ((gnus-command-method method)
2308 (gnus-newsgroup-name group)
2309 (gnus-newsgroup-dependencies gnus-newsgroup-dependencies)
2310 (gnus-newsgroup-headers gnus-newsgroup-headers)
2311 (gnus-newsgroup-scored gnus-newsgroup-scored)
2312 (gnus-use-cache gnus-use-cache)
2313 (gnus-summary-expunge-below gnus-summary-expunge-below)
2314 (gnus-summary-mark-below gnus-summary-mark-below)
2315 (gnus-orphan-score gnus-orphan-score)
2316 ;; Maybe some other gnus-summary local variables should also
2319 gnus-headers
2320 gnus-score
2324 (unless (gnus-check-group group)
2328 (when (or gnus-newsgroup-active
2329 (gnus-active group)
2330 (gnus-activate-group group))
2331 (let ((marked-articles gnus-newsgroup-downloadable))
2333 (unless gnus-newsgroup-active
2334 ;; The variable gnus-newsgroup-active was selected as I need
2335 ;; a gnus-summary local variable that is NOT bound to any
2337 (dolist (mark gnus-agent-download-marks)
2338 (let ((arts (cdr (assq mark (gnus-info-marks
2339 (setq info (gnus-get-info group)))))))
2341 (setq marked-articles (nconc (gnus-uncompress-range arts)
2347 (setq articles (gnus-agent-fetch-headers group))
2354 (setq gnus-newsgroup-dependencies
2355 (or gnus-newsgroup-dependencies
2357 (setq gnus-newsgroup-headers
2358 (or gnus-newsgroup-headers
2359 (gnus-get-newsgroup-headers-xover articles nil nil
2361 ;; `gnus-agent-overview-buffer' may be killed for
2363 (gnus-agent-create-buffer)
2366 (setq category (gnus-group-category group))
2369 (gnus-get-predicate
2370 (gnus-agent-find-parameter group 'agent-predicate)))
2373 (unless (memq predicate '(gnus-agent-true gnus-agent-false))
2375 (gnus-agent-find-parameter group 'agent-score-file)))
2380 (setq score-param (gnus-all-score-files group)))
2385 (gnus-score-headers score-param))))
2387 (unless (and (eq predicate 'gnus-agent-false)
2391 (alist (gnus-agent-load-alist group))
2393 (gnus-newsgroup-headers gnus-newsgroup-headers))
2394 (while (setq gnus-headers (pop gnus-newsgroup-headers))
2395 (let ((num (mail-header-number gnus-headers)))
2413 (let ((gnus-score
2415 (assq num gnus-newsgroup-scored))
2416 gnus-summary-default-score))
2417 (gnus-agent-long-article
2418 (gnus-agent-find-parameter
2419 group 'agent-long-article))
2420 (gnus-agent-short-article
2421 (gnus-agent-find-parameter
2422 group 'agent-short-article))
2423 (gnus-agent-low-score
2424 (gnus-agent-find-parameter
2425 group 'agent-low-score))
2426 (gnus-agent-high-score
2427 (gnus-agent-find-parameter
2428 group 'agent-high-score))
2429 (gnus-agent-expire-days
2430 (gnus-agent-find-parameter
2431 group 'agent-days-until-old)))
2433 (gnus-agent-append-to-list arts-tail num))))))
2437 (setq gnus-newsgroup-undownloaded
2438 (gnus-sorted-ndifference
2439 gnus-newsgroup-undownloaded
2442 (gnus-agent-fetch-articles group (cdr arts))
2446 (gnus-sorted-ndifference (cdr arts) fetched-articles)))
2447 (if gnus-newsgroup-active
2451 (gnus-summary-set-agent-mark article t))
2453 (when gnus-agent-mark-unread-after-downloaded
2454 (setq gnus-newsgroup-downloadable
2455 (delq article gnus-newsgroup-downloadable))
2456 (gnus-summary-mark-article
2457 article gnus-unread-mark))
2458 (when (gnus-summary-goto-subject article nil t)
2459 (gnus-summary-update-download-mark article)))
2461 (gnus-summary-mark-article
2462 article gnus-canceled-mark)))
2471 (dolist (mark gnus-agent-download-marks)
2474 (assq mark (gnus-info-marks
2475 (setq info (gnus-get-info group))))))
2478 (delq marked-arts (gnus-info-marks info)))
2479 (gnus-info-set-marks info marks)))))
2480 (let ((read (gnus-info-read
2481 (or info (setq info (gnus-get-info group))))))
2482 (gnus-info-set-read
2483 info (gnus-add-to-range read unfetched-articles)))
2485 (gnus-group-update-group group t)
2488 (gnus-dribble-enter
2489 (concat "(gnus-group-set-info '"
2490 (gnus-prin1-to-string info)
2497 (defvar gnus-category-mode-hook nil
2498 "Hook run in `gnus-category-mode' buffers.")
2500 (defvar gnus-category-line-format " %(%20c%): %g\n"
2508 `(gnus)Formatting Variables'.")
2510 (defvar gnus-category-mode-line-format "Gnus: %%b"
2513 (defvar gnus-agent-predicate 'false
2516 (defvar gnus-agent-short-article 100
2519 (defvar gnus-agent-long-article 200
2522 (defvar gnus-agent-low-score 0
2525 (defvar gnus-agent-high-score 0
2531 (defvar gnus-category-buffer "*Agent Category*")
2533 (defvar gnus-category-line-format-alist
2534 `((?c gnus-tmp-name ?s)
2535 (?g gnus-tmp-groups ?d)))
2537 (defvar gnus-category-mode-line-format-alist
2540 (defvar gnus-category-line-format-spec nil)
2541 (defvar gnus-category-mode-line-format-spec nil)
2543 (defvar gnus-category-mode-map nil)
2544 (put 'gnus-category-mode 'mode-class 'special)
2546 (unless gnus-category-mode-map
2547 (setq gnus-category-mode-map (make-sparse-keymap))
2548 (suppress-keymap gnus-category-mode-map)
2550 (gnus-define-keys gnus-category-mode-map
2551 "q" gnus-category-exit
2552 "k" gnus-category-kill
2553 "c" gnus-category-copy
2554 "a" gnus-category-add
2555 "e" gnus-agent-customize-category
2556 "p" gnus-category-edit-predicate
2557 "g" gnus-category-edit-groups
2558 "s" gnus-category-edit-score
2559 "l" gnus-category-list
2561 "\C-c\C-i" gnus-info-find-node
2562 "\C-c\C-b" gnus-bug))
2564 (defvar gnus-category-menu-hook nil
2567 (defun gnus-category-make-menu-bar ()
2568 (gnus-turn-off-edit-menu 'category)
2569 (unless (boundp 'gnus-category-menu)
2571 gnus-category-menu gnus-category-mode-map ""
2573 ["Add" gnus-category-add t]
2574 ["Kill" gnus-category-kill t]
2575 ["Copy" gnus-category-copy t]
2576 ["Edit category" gnus-agent-customize-category t]
2577 ["Edit predicate" gnus-category-edit-predicate t]
2578 ["Edit score" gnus-category-edit-score t]
2579 ["Edit groups" gnus-category-edit-groups t]
2580 ["Exit" gnus-category-exit t]))
2582 (gnus-run-hooks 'gnus-category-menu-hook)))
2584 (defun gnus-category-mode ()
2585 "Major mode for listing and editing agent categories.
2588 \\<gnus-category-mode-map>
2590 \(`\\[gnus-info-find-node]').
2594 \\{gnus-category-mode-map}"
2596 (when (gnus-visual-p 'category-menu 'menu)
2597 (gnus-category-make-menu-bar))
2599 (gnus-simplify-mode-line)
2600 (setq major-mode 'gnus-category-mode)
2602 (gnus-set-default-directory)
2604 (use-local-map gnus-category-mode-map)
2608 (gnus-run-mode-hooks 'gnus-category-mode-hook))
2610 (defalias 'gnus-category-position-point 'gnus-goto-colon)
2612 (defun gnus-category-insert-line (category)
2613 (let* ((gnus-tmp-name (format "%s" (car category)))
2614 (gnus-tmp-groups (length (gnus-agent-cat-groups category))))
2616 (gnus-add-text-properties
2620 (eval gnus-category-line-format-spec))
2621 (list 'gnus-category gnus-tmp-name))))
2623 (defun gnus-enter-category-buffer ()
2626 (gnus-category-setup-buffer)
2627 (gnus-configure-windows 'category)
2628 (gnus-category-prepare))
2630 (defun gnus-category-setup-buffer ()
2631 (unless (get-buffer gnus-category-buffer)
2633 (set-buffer (gnus-get-buffer-create gnus-category-buffer))
2634 (gnus-category-mode))))
2636 (defun gnus-category-prepare ()
2637 (gnus-set-format 'category-mode)
2638 (gnus-set-format 'category t)
2639 (let ((alist gnus-category-alist)
2643 (gnus-category-insert-line (pop alist)))
2645 (gnus-category-position-point)))
2647 (defun gnus-category-name ()
2648 (or (intern (get-text-property (gnus-point-at-bol) 'gnus-category))
2651 (defun gnus-category-read ()
2653 (setq gnus-category-alist
2657 (nnheader-insert-file-contents (nnheader-concat gnus-agent-directory "lib/categories"))
2664 ;; gnus-category-write.
2674 (gnus-mapcar
2679 '(agent-predicate agent-score-file agent-groups))))
2682 (list (gnus-agent-cat-make 'default 'short)))))
2684 (defun gnus-category-write ()
2686 (setq gnus-category-predicate-cache nil
2687 gnus-category-group-cache nil)
2688 (gnus-make-directory (nnheader-concat gnus-agent-directory "lib"))
2689 (with-temp-file (nnheader-concat gnus-agent-directory "lib/categories")
2691 ;; to an earlier version of gnus-agent.
2694 (cdr (assoc 'agent-predicate c))
2695 (cdr (assoc 'agent-score-file c))
2696 (cdr (assoc 'agent-groups c))))
2697 gnus-category-alist)
2700 (prin1 gnus-category-alist (current-buffer))))
2702 (defun gnus-category-edit-predicate (category)
2704 (interactive (list (gnus-category-name)))
2705 (let ((info (assq category gnus-category-alist)))
2706 (gnus-edit-form
2707 (gnus-agent-cat-predicate info)
2711 ;; (setf (gnus-agent-cat-predicate (assq ',category gnus-category-alist))
2714 (gnus-agent-cat-set-property (assq ',category gnus-category-alist)
2715 'agent-predicate predicate)
2717 (gnus-category-write)
2718 (gnus-category-list)))))
2720 (defun gnus-category-edit-score (category)
2722 (interactive (list (gnus-category-name)))
2723 (let ((info (assq category gnus-category-alist)))
2724 (gnus-edit-form
2725 (gnus-agent-cat-score-file info)
2729 ;; (setf (gnus-agent-cat-score-file (assq ',category gnus-category-alist))
2732 (gnus-agent-cat-set-property (assq ',category gnus-category-alist)
2733 'agent-score-file score-file)
2735 (gnus-category-write)
2736 (gnus-category-list)))))
2738 (defun gnus-category-edit-groups (category)
2740 (interactive (list (gnus-category-name)))
2741 (let ((info (assq category gnus-category-alist)))
2742 (gnus-edit-form
2743 (gnus-agent-cat-groups info)
2747 ;; (setf (gnus-agent-cat-groups (assq ',category gnus-category-alist))
2750 (gnus-agent-set-cat-groups (assq ',category gnus-category-alist)
2753 (gnus-category-write)
2754 (gnus-category-list)))))
2756 (defun gnus-category-kill (category)
2758 (interactive (list (gnus-category-name)))
2759 (let ((info (assq category gnus-category-alist))
2761 (gnus-delete-line)
2762 (setq gnus-category-alist (delq info gnus-category-alist))
2763 (gnus-category-write)))
2765 (defun gnus-category-copy (category to)
2767 (interactive (list (gnus-category-name) (intern (read-string "New name: "))))
2768 (let ((info (assq category gnus-category-alist)))
2769 (push (let ((newcat (gnus-copy-sequence info)))
2770 (setf (gnus-agent-cat-name newcat) to)
2771 (setf (gnus-agent-cat-groups newcat) nil)
2773 gnus-category-alist)
2774 (gnus-category-write)
2775 (gnus-category-list)))
2777 (defun gnus-category-add (category)
2780 (when (assq category gnus-category-alist)
2782 (push (gnus-agent-cat-make category)
2783 gnus-category-alist)
2784 (gnus-category-write)
2785 (gnus-category-list))
2787 (defun gnus-category-list ()
2790 (gnus-category-prepare))
2792 (defun gnus-category-exit ()
2796 (gnus-configure-windows 'group t))
2799 (defvar gnus-category-not (list '! 'not (intern (format "%c" 172))))
2801 (defvar gnus-category-predicate-alist
2802 '((spam . gnus-agent-spam-p)
2803 (short . gnus-agent-short-p)
2804 (long . gnus-agent-long-p)
2805 (low . gnus-agent-low-scored-p)
2806 (high . gnus-agent-high-scored-p)
2807 (read . gnus-agent-read-p)
2808 (true . gnus-agent-true)
2809 (false . gnus-agent-false))
2812 (defun gnus-agent-spam-p ()
2814 (unless gnus-agent-spam-hashtb
2815 (setq gnus-agent-spam-hashtb (gnus-make-hashtable 1000)))
2816 (if (not (equal (mail-header-references gnus-headers) ""))
2818 (let ((string (gnus-simplify-subject (mail-header-subject gnus-headers))))
2820 (gnus-gethash string gnus-agent-spam-hashtb)
2821 (gnus-sethash string t gnus-agent-spam-hashtb)))))
2823 (defun gnus-agent-short-p ()
2825 (< (mail-header-lines gnus-headers) gnus-agent-short-article))
2827 (defun gnus-agent-long-p ()
2829 (> (mail-header-lines gnus-headers) gnus-agent-long-article))
2831 (defun gnus-agent-low-scored-p ()
2833 (< gnus-score gnus-agent-low-score))
2835 (defun gnus-agent-high-scored-p ()
2837 (> gnus-score gnus-agent-high-score))
2839 (defun gnus-agent-read-p ()
2841 (gnus-member-of-range (mail-header-number gnus-headers)
2842 (gnus-info-read (gnus-get-info gnus-newsgroup-name))))
2844 (defun gnus-category-make-function (predicate)
2846 (let ((func (gnus-category-make-function-1 predicate)))
2850 (gnus-byte-compile `(lambda () ,func)))))
2852 (defun gnus-agent-true ()
2856 (defun gnus-agent-false ()
2860 (defun gnus-category-make-function-1 (predicate)
2866 `(,(or (cdr (assq predicate gnus-category-predicate-alist))
2875 ((memq (car predicate) gnus-category-not)
2877 ,@(mapcar 'gnus-category-make-function-1 (cdr predicate))))
2881 (defun gnus-get-predicate (predicate)
2883 (or (cdr (assoc predicate gnus-category-predicate-cache))
2884 (let ((func (gnus-category-make-function predicate)))
2885 (setq gnus-category-predicate-cache
2886 (nconc gnus-category-predicate-cache
2890 (defun gnus-predicate-implies-unread (predicate)
2895 (eq t (gnus-function-implies-unread-1
2896 (gnus-category-make-function-1 predicate))))
2898 (defun gnus-function-implies-unread-1 (function)
2905 (args (mapcar 'gnus-function-implies-unread-1 (cdr function))))
2930 ((eq func 'gnus-agent-read-p)
2932 ((eq func 'gnus-agent-false)
2934 ((eq func 'gnus-agent-true)
2937 (let ((alist gnus-category-predicate-alist))
2946 (defun gnus-group-category (group)
2948 (unless gnus-category-group-cache
2949 (setq gnus-category-group-cache (gnus-make-hashtable 1000))
2950 (let ((cs gnus-category-alist)
2951 groups cat)
2952 (while (setq cat (pop cs))
2953 (setq groups (gnus-agent-cat-groups cat))
2955 (gnus-sethash (pop groups) cat gnus-category-group-cache)))))
2956 (or (gnus-gethash group gnus-category-group-cache)
2957 (assq 'default gnus-category-alist)))
2959 (defun gnus-agent-expire-group (group &optional articles force)
2964 The articles on which the expiration process runs are selected as follows:
2968 FORCE is equivalent to setting the expiration predicates to true."
2970 (list (let ((def (or (gnus-group-group-name)
2971 gnus-newsgroup-name)))
2982 (gnus-agent-expire articles group force)
2983 (let ( ;; Bind gnus-agent-expire-stats to enable tracking of
2984 ;; expiration statistics of this single group
2985 (gnus-agent-expire-stats (list 0 0 0.0)))
2990 (let ((gnus-command-method (gnus-find-method-for-group group))
2991 (overview (gnus-get-buffer-create " *expire overview*"))
2994 (let ((active-file (gnus-agent-lib-file "active")))
2998 (gnus-active-to-gnus-format
2999 gnus-command-method
3000 (setq orig (gnus-make-hashtable
3003 (gnus-agent-expire-group-1
3004 group overview (gnus-gethash-safe group orig)
3007 (gnus-message 4 (gnus-agent-expire-done-message)))))
3009 (defun gnus-agent-expire-group-1 (group overview active articles force)
3011 ;; gnus-command-method, initialized overview buffer, and to have
3014 (let ((dir (gnus-agent-group-pathname group)))
3015 (when (boundp 'gnus-agent-expire-current-dirs)
3016 (set 'gnus-agent-expire-current-dirs
3018 (symbol-value 'gnus-agent-expire-current-dirs))))
3021 (eq 'DISABLE (gnus-agent-find-parameter group
3022 'agent-enable-expiration)))
3023 (gnus-message 5 "Expiry skipping over %s" group)
3024 (gnus-message 5 "Expiring articles in %s" group)
3025 (gnus-agent-load-alist group)
3029 (info (gnus-get-info group))
3030 (alist gnus-agent-article-alist)
3032 (gnus-agent-find-parameter group 'agent-days-until-old)))
3045 ;; expiration process
3046 (cond (gnus-agent-expire-all
3055 ;; expiration Don't call
3056 ;; gnus-list-of-unread-articles as it returns
3058 ;; agent.
3060 (gnus-agent-unread-articles group)))
3063 ;; are protected from expiration
3064 (gnus-sorted-difference
3065 (gnus-uncompress-range
3070 ;; expiration process
3071 (cond (gnus-agent-expire-all
3085 ;; from expiration
3087 (gnus-uncompress-range
3088 (cdr (assq 'tick (gnus-info-marks info))))
3089 (gnus-uncompress-range
3091 (gnus-info-marks info))))))))
3132 (gnus-message 7 "gnus-agent-expire: Loading overview...")
3146 (gnus-message 1 "gnus-agent-expire: read error \
3153 (gnus-message
3154 7 "gnus-agent-expire: Loading overview... Done"))
3160 (gnus-message 7 "gnus-agent-expire: Sorting entries... ")
3179 (gnus-message 7 "gnus-agent-expire: Sorting entries... Done")
3180 (gnus-message 7 "gnus-agent-expire: Merging entries... ")
3199 (gnus-message 7 "gnus-agent-expire: Merging entries... Done")
3211 (gnus-message 7 "%3d%% completed..." completed)))
3221 (gnus-agent-message 10
3222 "gnus-agent-expire: %s:%d: Kept %s article%s."
3229 (gnus-agent-message 3 "gnus-agent-expire cleared \
3233 (gnus-message 1 "gnus-agent-expire detected a \
3234 missing NOV entry. Run gnus-agent-regenerate-group to restore it.")))
3235 (gnus-agent-append-to-list
3283 (let ((from (gnus-point-at-bol))
3292 (if (and gnus-agent-consider-all-articles
3295 (gnus-agent-append-to-list
3301 (gnus-agent-message 8 "gnus-agent-expire: %s:%d: %s"
3305 (gnus-agent-message
3306 10 "gnus-agent-expire: %s:%d: Article kept as \
3307 expiration tests failed." group article-number)
3308 (gnus-agent-append-to-list
3322 (unless (equal alist gnus-agent-article-alist)
3323 (setq gnus-agent-article-alist alist)
3324 (gnus-agent-save-alist group))
3328 gnus-agent-file-coding-system))
3329 (gnus-make-directory dir)
3337 (gnus-summary-update-info))))
3339 (when (boundp 'gnus-agent-expire-stats)
3340 (let ((stats (symbol-value 'gnus-agent-expire-stats)))
3346 (defun gnus-agent-expire (&optional articles group force)
3351 The articles on which the expiration process runs are selected as follows:
3355 Setting GROUP will limit expiration to that group.
3356 FORCE is equivalent to setting the expiration predicates to true."
3360 (gnus-agent-expire-group group articles force)
3364 (let ((methods (gnus-agent-covered-methods))
3365 ;; Bind gnus-agent-expire-current-dirs to enable tracking
3366 ;; of agent directories.
3367 (gnus-agent-expire-current-dirs nil)
3368 ;; Bind gnus-agent-expire-stats to enable tracking of
3369 ;; expiration statistics across all groups
3370 (gnus-agent-expire-stats (list 0 0 0.0))
3371 gnus-command-method overview orig)
3372 (setq overview (gnus-get-buffer-create " *expire overview*"))
3374 (while (setq gnus-command-method (pop methods))
3375 (let ((active-file (gnus-agent-lib-file "active")))
3379 (gnus-active-to-gnus-format
3380 gnus-command-method
3381 (setq orig (gnus-make-hashtable
3383 (dolist (expiring-group (gnus-groups-from-server
3384 gnus-command-method))
3386 (gnus-gethash-safe expiring-group orig)))
3390 (gnus-agent-expire-group-1
3393 (gnus-agent-expire-unagentized-dirs)
3394 (gnus-message 4 (gnus-agent-expire-done-message))))))
3396 (defun gnus-agent-expire-done-message ()
3397 (if (and (> gnus-verbose 4)
3398 (boundp 'gnus-agent-expire-stats))
3399 (let* ((stats (symbol-value 'gnus-agent-expire-stats))
3414 (defun gnus-agent-expire-unagentized-dirs ()
3415 (when (and gnus-agent-expire-unagentized-dirs
3416 (boundp 'gnus-agent-expire-current-dirs))
3417 (let* ((keep (gnus-make-hashtable))
3418 ;; Formally bind gnus-agent-expire-current-dirs so that the
3420 (gnus-agent-expire-current-dirs
3421 (symbol-value 'gnus-agent-expire-current-dirs))
3424 (gnus-sethash gnus-agent-directory t keep)
3425 (while gnus-agent-expire-current-dirs
3426 (setq dir (pop gnus-agent-expire-current-dirs))
3429 (while (not (gnus-gethash dir keep))
3430 (gnus-sethash dir t keep)
3450 ;; agent's cache of a group.
3455 (while (not (gnus-gethash
3467 (funcall checker (expand-file-name gnus-agent-directory))
3470 (or gnus-expert-user
3471 (gnus-y-or-n-p
3472 "gnus-agent-expire has identified local directories that are\
3477 (if (gnus-y-or-n-p (format "Delete %s? " dir))
3498 (defun gnus-agent-batch ()
3502 (gnus-always-read-dribble-file t))
3503 (gnus))
3504 (let ((gnus-agent-confirmation-function 'gnus-agent-batch-confirmation))
3505 (gnus-group-send-queue)
3506 (gnus-agent-fetch-session)))
3508 (defun gnus-agent-unread-articles (group)
3509 (let* ((read (gnus-info-read (gnus-get-info group)))
3510 (known (gnus-agent-load-alist group))
3520 (gnus-agent-append-to-list tail-unread candidate)
3530 (gnus-agent-append-to-list tail-unread (car (pop known))))
3533 (defun gnus-agent-uncached-articles (articles group &optional cached-header)
3540 ;; Logically equivalent to: (gnus-sorted-difference articles (mapcar
3541 ;; 'car gnus-agent-article-alist))
3545 (if (and (or gnus-agent-cache (not gnus-plugged))
3546 (gnus-agent-load-alist group))
3547 (let* ((ref gnus-agent-article-alist)
3555 (gnus-agent-append-to-list tail-uncached v1)
3559 (gnus-agent-append-to-list tail-uncached v1))
3565 (gnus-agent-append-to-list tail-uncached (pop arts)))
3567 ;; if gnus-agent-load-alist fails, no articles are cached.
3570 (defun gnus-agent-retrieve-headers (articles group &optional fetch-old)
3572 (gnus-agent-create-buffer)
3573 (let ((gnus-decode-encoded-word-function 'identity)
3574 (file (gnus-agent-article-name ".overview" group))
3576 (gnus-make-directory (nnheader-translate-file-chars
3581 (with-current-buffer gnus-agent-overview-buffer
3584 gnus-agent-file-coding-system))
3587 (if (setq uncached-articles (gnus-agent-uncached-articles articles group
3593 (cond ((not (eq 'nov (let (gnus-agent) ; Turn off agent
3594 (gnus-retrieve-headers
3597 ((eq 'nntp (car gnus-current-select-method))
3598 ;; The author of gnus-get-newsgroup-headers-xover
3628 (when (setq art (gnus-agent-read-article-number))
3629 (gnus-agent-append-to-list tail-fetched-articles art))
3634 (setq fetched-articles (gnus-list-range-intersection
3643 (gnus-list-range-intersection
3654 (gnus-sorted-nunion fetched-articles
3659 (set-buffer gnus-agent-overview-buffer)
3664 (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max))
3669 (gnus-agent-braid-nov group uncached-articles file))
3674 gnus-agent-file-coding-system))
3675 (gnus-agent-check-overview-buffer)
3680 (gnus-agent-load-alist group)
3681 (gnus-agent-save-alist group uncached-articles nil)
3687 (insert-buffer-substring gnus-agent-overview-buffer)))
3700 (defun gnus-agent-request-article (article group)
3701 "Retrieve ARTICLE in GROUP from the agent cache."
3702 (when (and gnus-agent
3703 (or gnus-agent-cache
3704 (not gnus-plugged))
3706 (let* ((gnus-command-method (gnus-find-method-for-group group))
3707 (file (gnus-agent-article-name (number-to-string article) group))
3712 (gnus-kill-all-overlays)
3713 (let ((coding-system-for-read gnus-cache-coding-system))
3717 (defun gnus-agent-regenerate-group (group &optional reread)
3725 (list (let ((def (or (gnus-group-group-name)
3726 gnus-newsgroup-name)))
3748 (gnus-message 3 "Ignoring unexpected input")
3752 (gnus-message 5 "Regenerating in %s" group)
3753 (let* ((gnus-command-method (or gnus-command-method
3754 (gnus-find-method-for-group group)))
3755 (file (gnus-agent-article-name ".overview" group))
3764 (progn (gnus-make-directory dir) nil)))
3772 gnus-agent-file-coding-system))
3790 (gnus-delete-line)
3792 (gnus-message 4 "gnus-agent-regenerate-group: NOV\
3797 (gnus-message 3 "gnus-agent-regenerate-group: NOV\
3804 (gnus-message 4 "gnus-agent-regenerate-group: NOV\
3806 (gnus-delete-line)
3809 (gnus-message 1 "gnus-agent-regenerate-group: NOV\
3812 (gnus-delete-line))))
3814 (gnus-message 5 "gnus-agent-regenerate-group: Sorting NOV\
3818 (gnus-agent-check-overview-buffer)
3828 (gnus-message 3 "Regenerating NOV %s %d..." group
3859 ;; When gnus-agent-consider-all-articles is set,
3860 ;; gnus-agent-regenerate-group should NOT remove article IDs from
3864 ;; When gnus-agent-consider-all-articles is NOT set,
3865 ;; gnus-agent-regenerate-group can remove the article ID of every
3872 (if gnus-agent-consider-all-articles
3876 (o (gnus-agent-load-alist group)))
3894 (o (last (gnus-agent-load-alist group))))
3904 (let ((coding-system-for-write gnus-agent-file-coding-system))
3908 (and reread gnus-agent-article-alist)
3909 (not (equal alist gnus-agent-article-alist))))
3911 (setq gnus-agent-article-alist alist)
3914 (gnus-agent-save-alist group)
3917 ;; gnus-make-ascending-articles-unread will use it to
3920 (let ((group (gnus-group-real-name group))
3921 (group-active (or (gnus-active group)
3922 (gnus-activate-group group))))
3923 (gnus-agent-possibly-alter-active group group-active)))))
3925 (when (and reread gnus-agent-article-alist)
3926 (gnus-agent-synchronize-group-flags
3936 gnus-agent-article-alist)))
3938 gnus-command-method)
3940 (when (gnus-buffer-live-p gnus-group-buffer)
3941 (gnus-group-update-group group t)))
3943 (gnus-message 5 "")
3947 (defun gnus-agent-regenerate (&optional clean reread)
3948 "Regenerate all agent covered files.
3952 (gnus-message 4 "Regenerating Gnus agent files...")
3953 (dolist (gnus-command-method (gnus-agent-covered-methods))
3954 (dolist (group (gnus-groups-from-server gnus-command-method))
3955 (setq regenerated (or (gnus-agent-regenerate-group group reread)
3957 (gnus-message 4 "Regenerating Gnus agent files...done")
3961 (defun gnus-agent-go-online (&optional force)
3964 (dolist (server gnus-opened-servers)
3967 (gnus-y-or-n-p
3973 (defun gnus-agent-toggle-group-plugged (group)
3975 (interactive (list (gnus-group-group-name)))
3976 (let* ((method (gnus-find-method-for-group group))
3977 (status (cadr (assoc method gnus-opened-servers))))
3979 (gnus-server-set-status method 'closed)
3980 (gnus-close-server method)
3981 (gnus-server-set-status method 'offline))
3986 (defun gnus-agent-group-covered-p (group)
3987 (gnus-agent-method-p (gnus-group-method group)))
3989 (provide 'gnus-agent)
3992 ;;; gnus-agent.el ends here