Lines Matching +refs:gnus +refs:group +refs:list +refs:active
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/")
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
86 "Hook run in Agent group minor modes."
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
155 groups with large active ranges may open slower and you may also want
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
173 contents from a group's local storage. This value may be overridden
175 course, you could change gnus-agent-enable-expiration to DISABLE then
178 :group 'gnus-agent
182 (defcustom gnus-agent-expire-unagentized-dirs t
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
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
219 files do save space but load times are 6-7 times higher. A group
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
233 "An assoc list identifying the articles whose headers have been fetched.
234 If successfully fetched, these headers will be stored in the group's overview
237 \(gnus-agent-fetch-articles sets the value to the day of the download).
239 1) The last element of this list can not be expired as some
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
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 ()
309 (nnheader-concat gnus-agent-directory
310 (nnheader-translate-file-chars (gnus-agent-method)) "/"))
312 (defun gnus-agent-lib-file (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)
334 "Define accessor and setter methods for manipulating a list of the form
336 Given the call (gnus-agent-cat-defaccessor func PROPERTY1), the list may be
341 (list (quote cdr) (list (quote assq)
347 (list (list --category--temp--) ; temporary-variables
348 (list category) ; value-forms
349 (list --value--temp--) ; store-variables
352 (list (quote gnus-agent-cat-set-property)
356 (list (quote ,name) --category--temp--) ; access-form
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)
393 (list (list --category--temp--)
394 (list category)
395 (list --groups--temp--)
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
408 ;; list. Still, Im done.
412 ;; gnus-agent-add-group is fiddling with the group list
420 (let* ((group (pop groups))
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))
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
476 (defvar gnus-agent-mode nil)
477 (defvar gnus-agent-mode-status '(gnus-agent-mode " Plugged"))
479 (defun gnus-agent-mode ()
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 ()
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
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)
691 "Make sure the queue group exists.
692 Optional arg GROUP-NAME allows to specify another group."
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
700 (format "nndraft:%s" (or group-name "queue"))
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))
781 (unless group
782 (error "No group on the current line"))
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."
793 (list
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
804 (lambda (group)
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))))
808 (push group groups)))
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
818 (lambda (group)
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)
885 files would corrupt gnus when the agent was next enabled.
886 Depends upon the caller to determine whether group renaming is
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
905 old-real-group old-command-method)))
906 (gnus-agent-set-local old-group
908 old-real-group old-command-method)
909 (gnus-agent-set-local new-group
911 new-real-group new-command-method)))))
914 (defun gnus-agent-delete-group (group)
917 files would corrupt gnus when the agent was next enabled.
918 Depends upon the caller to determine whether group deletion is
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
930 real-group command-method)))
931 (gnus-agent-set-local group
933 real-group command-method)))))
939 (defun gnus-agent-add-server ()
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)
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 ()
962 (let* ((server (gnus-server-server-name))
963 (named-server (gnus-server-named-server)))
967 (unless (member named-server gnus-agent-covered-methods)
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 ()
1086 "Construct list of articles that have not been downloaded."
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))
1095 (undownloaded (list nil))
1097 (unfetched (list nil))
1110 (gnus-agent-append-to-list tail-undownloaded h)
1111 (gnus-agent-append-to-list tail-unfetched h)
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)
1181 "Fetch the downloadable articles in the group.
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)
1232 "Update a plugged group by performing the indicated actions."
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
1239 ;; reconstruct the original group name.
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)
1275 ;;sure that the group buffer is up to date.
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)
1300 "Possibly expand a group's active range to include articles
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))
1306 (active-min (or (car active) 0))
1307 (active-max (or (cdr active) 0))
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)))
1318 ;; I'm expanding the active range by such a large amount
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.
1330 ;; printing this list to the buffer, and then writing it to a
1333 (let ((read (gnus-info-read info)))
1334 (gnus-info-set-read
1336 (gnus-range-add
1338 (list (cons (1+ agent-max)
1339 (1- active-min))))))
1341 ;; Lie about the agent's local range for this group to
1343 ;; NOTE: Opening this group will restore the valid local
1345 ;; incompass the new active range.
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))
1358 ;; Emacs got problem to match non-ASCII group in multibyte buffer.
1365 (concat "^" (regexp-quote group) " ") nil t)
1369 (gnus-delete-line)))
1370 (when active
1371 (insert (format "%S %d %d y\n" (intern group)
1372 (max (or oactive-max (cdr active)) (cdr active))
1373 (min (or oactive-min (car active)) (car active))))
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))
1388 ;; Emacs got problem to match non-ASCII group in multibyte buffer.
1395 (concat "^" (regexp-quote group) " ") nil t)
1401 (defun gnus-agent-group-path (group)
1404 ;; NOTE: This is what nnmail-group-pathname does as of Apr 2003.
1406 ;; gnus-agent-group-pathname was added.
1408 (setq group
1412 (gnus-group-real-name (gnus-group-decoded-name group))
1416 (file-directory-p (expand-file-name group (gnus-agent-directory))))
1417 group
1419 (nnheader-replace-chars-in-string group ?. ?/)
1422 (defun gnus-agent-group-pathname (group)
1424 ;; nnagent uses nnmail-group-pathname to read articles while
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 ()
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
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))
1480 (selected-sets (list nil))
1508 (when (< gnus-agent-max-fetch-size
1530 (let* ((fetched-articles (list nil))
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..."
1552 article group)
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)
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)
1643 (setq group (caar crosses))
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*"
1650 group)))
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)
1740 "Search for GROUPs SYMBOL in the group's parameters, the group's
1741 topic parameters, the group's category, or the customizable
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)
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
1759 file will be updated to include the headers while a list of available
1761 (let* ((fetch-all (and gnus-agent-consider-all-articles
1764 (not (gnus-predicate-implies-unread
1765 (gnus-agent-find-parameter group
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)))
1774 ;; Add articles with marks to the list of article headers we want to
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) '<)))
1784 ;; At this point, I have the list of articles to consider for
1785 ;; fetching. This is the list that I'll return to my caller. Some
1788 ;; filter this list to just those articles whose headers need to
1792 (when (and (or gnus-agent-cache
1793 (not gnus-plugged))
1794 (gnus-agent-load-alist group))
1797 ;; I want to fetch all headers in the active range.
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))))
1809 ;; Low can be greater than High when the same group is
1812 ;; gnus-agent-article-alist) equals (cdr (gnus-active
1813 ;; group))}. The addition of one(the 1+ above) then
1815 ;; gnus-list-range-intersection returns nil which
1817 (setq articles (gnus-list-range-intersection
1818 articles (list (cons low high)))))))
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)
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))
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))))
2033 (lambda (comp-list)
2034 (let ((state (car comp-list))
2036 (gnus-uncompress-range
2037 (cdr comp-list)))))
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))
2062 (setcdr prev (list (cons article state))))
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)
2083 (comp-list (assq day-of-download compressed)))
2084 (if comp-list
2085 (setcdr comp-list
2086 (cons article-id (cdr comp-list)))
2088 (cons (list day-of-download article-id)
2090 nil)) gnus-agent-article-alist)
2091 (mapcar (lambda (comp-list)
2092 (setcdr comp-list
2093 (gnus-compress-sequence
2094 (nreverse (cdr comp-list)))))
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))
2143 (let (group
2148 (setq group (read cur)
2152 (when (stringp group)
2153 (setq group (intern group my-obarray)))
2156 (set group (cons (+ 0 min) (+ 0 max))))
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
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
2279 (while (setq group (pop groups))
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? "
2294 (gnus-agent-regenerate-group group)
2295 (unless (funcall gnus-agent-confirmation-function
2297 "%s while fetching session. Should gnus continue? "
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)
2325 (error "Can't open server for %s" 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
2360 group)))
2361 ;; `gnus-agent-overview-buffer' may be killed for
2363 (gnus-agent-create-buffer)
2365 ;; Figure out how to select articles in this group
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)))
2383 (setq score-param (list (list score-param)))))
2385 (gnus-score-headers score-param))))
2387 (unless (and (eq predicate 'gnus-agent-false)
2389 (let ((arts (list nil)))
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)))
2411 ;; predicate, add it to the download list
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)))
2464 ;; Update the group buffer.
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 ()
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"))
2663 ;; earlier version, we can take out the old-list code in
2664 ;; gnus-category-write.
2665 (let* ((old-list (read (current-buffer)))
2666 (new-list (ignore-errors (read (current-buffer)))))
2667 (if new-list
2668 new-list
2669 ;; Convert from a positional list to an alist.
2674 (gnus-mapcar
2681 old-list)))))
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.
2693 (list (car 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)
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)
2735 (gnus-category-write)
2736 (gnus-category-list)))))
2738 (defun gnus-category-edit-groups (category)
2739 "Edit the group list for 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)
2744 (format "Editing the group list for category %s" category)
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 ()
2793 "Return to the group buffer."
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
2887 (list (cons predicate func))))
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)
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)
2967 if ARTICLES is a list, just those articles.
2970 (list (let ((def (or (gnus-group-group-name)
2971 gnus-newsgroup-name)))
2981 (if (not group)
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)))
2989 "expire all articles in " group "? ")))
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")))
2995 (when (file-exists-p active-file)
2997 (nnheader-insert-file-contents active-file)
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
3012 ;; provided a non-nil active
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
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)))
3043 (list (caar (last alist)))))
3046 (cond (gnus-agent-expire-all
3056 ;; gnus-list-of-unread-articles as it returns
3060 (gnus-agent-unread-articles group)))
3064 (gnus-sorted-difference
3065 (gnus-uncompress-range
3071 (cond (gnus-agent-expire-all
3080 ;; unreads list already names the articles we are
3087 (gnus-uncompress-range
3088 (cdr (assq 'tick (gnus-info-marks info))))
3089 (gnus-uncompress-range
3091 (gnus-info-marks info))))))))
3100 ;; information with this list. For example, a flag indicating
3109 (list (car e) (cdr e) nil nil)) alist))
3117 (list e nil 'unread nil))
3121 (list e nil 'marked nil))
3125 (list e nil 'special nil))
3132 (gnus-message 7 "gnus-agent-expire: Loading overview...")
3141 ;; to the list
3142 (push (list (+ 0 (read (current-buffer))) nil nil
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... ")
3182 (while (cdr dlist) ; I'm not at the end-of-list
3199 (gnus-message 7 "gnus-agent-expire: Merging entries... Done")
3202 (alist (list nil))
3211 (gnus-message 7 "%3d%% completed..." completed)))
3221 (gnus-agent-message 10
3222 "gnus-agent-expire: %s:%d: Kept %s article%s."
3223 group article-number keep (if fetch-date " and file" ""))
3229 (gnus-agent-message 3 "gnus-agent-expire cleared \
3231 group (caar dlist)))
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))
3290 ;; active range (That is, articles that preceed the
3292 (if (and gnus-agent-consider-all-articles
3293 (>= article-number (car active)))
3295 (gnus-agent-append-to-list
3301 (gnus-agent-message 8 "gnus-agent-expire: %s:%d: %s"
3302 group article-number
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)
3354 if ARTICLES is a list, just those articles.
3355 Setting GROUP will limit expiration to that group.
3359 (if group
3360 (gnus-agent-expire-group group articles force)
3363 articles in every agentized group? "))
3364 (let ((methods (gnus-agent-covered-methods))
3365 ;; Bind gnus-agent-expire-current-dirs to enable tracking
3367 (gnus-agent-expire-current-dirs nil)
3368 ;; Bind gnus-agent-expire-stats to enable tracking of
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")))
3376 (when (file-exists-p active-file)
3378 (nnheader-insert-file-contents active-file)
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))
3385 (let* ((active
3386 (gnus-gethash-safe expiring-group orig)))
3388 (when active
3390 (gnus-agent-expire-group-1
3391 expiring-group overview active articles force))))))))
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\
3473 not currently required by any agentized group. Do you wish to consider\
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))
3511 (unread (list nil))
3520 (gnus-agent-append-to-list tail-unread candidate)
3527 ;; candidate will be added to the unread list.
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))
3543 ;; Functionally, I don't need to construct a temp list using mapcar.
3545 (if (and (or gnus-agent-cache (not gnus-plugged))
3546 (gnus-agent-load-alist group))
3547 (let* ((ref gnus-agent-article-alist)
3549 (uncached (list nil))
3554 (cond ((< v1 v2) ; v1 does not appear in the reference list
3555 (gnus-agent-append-to-list tail-uncached v1)
3559 (gnus-agent-append-to-list tail-uncached v1))
3562 (t ; reference article (v2) preceeds the list being filtered
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
3595 uncached-articles group fetch-old))))
3597 ((eq 'nntp (car gnus-current-select-method))
3598 ;; The author of gnus-get-newsgroup-headers-xover
3613 (let* ((fetched-articles (list nil))
3623 ;; Get the list of articles that were fetched
3628 (when (setq art (gnus-agent-read-article-number))
3629 (gnus-agent-append-to-list tail-fetched-articles art))
3632 ;; Clip this list to the headers that will
3634 (setq fetched-articles (gnus-list-range-intersection
3638 ;; Clip the uncached articles list to exclude
3643 (gnus-list-range-intersection
3648 ;; Create the list of articles that were
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)
3678 ;; Update the group's article alist to include the newly
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)
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)
3720 If REREAD is a list, the specified articles will be marked as unread.
3725 (list (let ((def (or (gnus-group-group-name)
3726 gnus-newsgroup-name)))
3748 (gnus-message 3 "Ignoring unexpected input")
3751 (when group
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
3866 ;; article (with the exception of the last ID in the list - it's
3868 ;; situtation, the last article ID in the list implies that it,
3872 (if gnus-agent-consider-all-articles
3876 (o (gnus-agent-load-alist group)))
3881 (setq n (setcdr n (list (list oID))))
3884 (setcdr n (cons (list oID) (cdr n)))
3894 (o (last (gnus-agent-load-alist group))))
3900 (setcdr n (list (car o)))))))
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)
3916 ;; I have to alter the group's active range NOW as
3917 ;; gnus-make-ascending-articles-unread will use it to
3918 ;; recalculate the number of unread articles in the group
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
3927 group
3928 (list (list
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)
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)
3963 (interactive (list t))
3964 (dolist (server gnus-opened-servers)
3967 (gnus-y-or-n-p
3973 (defun gnus-agent-toggle-group-plugged (group)
3974 "Toggle the status of the server of the current 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