Lines Matching +defs:gnus +defs:request +defs:expire +defs:articles
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
63 "Hook run when finished fetching articles."
65 :group 'gnus-agent
68 (defcustom gnus-agent-handle-level gnus-level-subscribed
70 :group 'gnus-agent
73 (defcustom gnus-agent-expire-days 7
74 "Read articles older than this will be expired.
75 If you wish to disable Agent expiring, see `gnus-agent-enable-expiration'."
76 :group 'gnus-agent
79 (defcustom gnus-agent-expire-all nil
80 "If non-nil, also expire unread, ticked and dormant articles.
81 If nil, only read articles will be expired."
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
139 "Indicate whether to mark articles unread after downloaded."
142 :group 'gnus-agent)
144 (defcustom gnus-agent-download-marks '(download)
148 :group 'gnus-agent)
150 (defcustom gnus-agent-consider-all-articles nil
152 whether articles need to be downloaded or not, for all articles. When
154 whether unread articles are downloaded or not. If you enable this,
157 read articles as they would just be downloaded again."
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
172 When set to ENABLE, the default, `gnus-agent-expire' will expire old
175 course, you could change gnus-agent-enable-expiration to DISABLE then
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
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
233 "An assoc list identifying the articles whose headers have been fetched.
237 \(gnus-agent-fetch-articles sets the value to the day of the download).
241 value to track which articles have had their headers retrieved.
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)
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
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)
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)
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)
771 "Put all new articles in the current groups into the Agent."
773 (unless gnus-plugged
775 (gnus-group-iterate n 'gnus-agent-fetch-group))
777 (defun gnus-agent-fetch-group (&optional group)
778 "Put all new articles in GROUP into the Agent."
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)
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)
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)
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)
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 ()
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)
1028 "Mark the next N articles as downloadable.
1031 articles marked is returned."
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)
1049 "Remove the downloadable mark from the next N articles.
1051 the actual number of articles unmarked is returned."
1053 (gnus-agent-mark-article n t))
1055 (defun gnus-agent-toggle-mark (n)
1056 "Toggle the downloadable mark from the next N articles.
1058 the actual number of articles toggled is returned."
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))
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 ()
1139 "Mark as read all unhandled articles.
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)))
1153 (while articles
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
1177 ;; include undownloaded articles.
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.
1182 Optional arg ALL, if non-nil, means to fetch all articles."
1184 (let ((articles
1185 (if all gnus-newsgroup-articles
1186 gnus-newsgroup-downloadable))
1187 (gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name))
1188 fetched-articles)
1189 (gnus-agent-while-plugged
1190 (unless articles
1191 (error "No articles to download"))
1192 (gnus-agent-with-fetch
1193 (setq gnus-newsgroup-undownloaded
1194 (gnus-sorted-ndifference
1195 gnus-newsgroup-undownloaded
1196 (setq fetched-articles
1197 (gnus-agent-fetch-articles
1198 gnus-newsgroup-name articles)))))
1200 (dolist (article 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))))))
1212 fetched-articles))
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)
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))
1319 ;; that there is a gap of more than 100 articles between the
1322 ;; articles that have been lost, mark them as read so that
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
1346 (gnus-agent-set-local group agent-min (1- active-min)))))))
1348 (defun gnus-agent-save-group-info (method group active)
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)
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)
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)
1476 (when articles
1477 (gnus-agent-load-alist group)
1478 (let* ((alist gnus-agent-article-alist)
1479 (headers (if (< (length articles) 2) nil gnus-newsgroup-headers))
1485 (while (setq article (pop articles))
1490 ;; Prune off articles that we have already fetched.
1508 (when (< gnus-agent-max-fetch-size
1530 (let* ((fetched-articles (list nil))
1531 (tail-fetched-articles fetched-articles)
1532 (dir (gnus-agent-group-pathname group))
1540 (gnus-make-directory dir)
1541 (gnus-message 7 "Fetching articles for %s..." group)
1544 (while (setq articles (pop selected-sets))
1545 ;; Fetch the articles from the backend.
1546 (if (gnus-check-backend-function 'retrieve-articles group)
1547 (setq pos (gnus-retrieve-articles articles group))
1550 (while (setq article (pop articles))
1551 (gnus-message 10 "Fetching article %s for %s..."
1554 (gnus-backlog-request-article group article
1556 (gnus-request-article article group))
1563 ;; Then save these articles into the Agent.
1569 (unless (eobp) ;; Don't save empty articles.
1585 (gnus-agent-crosspost crosses (caar pos) date)))
1593 gnus-agent-file-coding-system))
1598 (gnus-agent-append-to-list
1599 tail-fetched-articles (caar pos)))
1603 (gnus-agent-save-alist group (cdr fetched-articles) date)
1604 (gnus-message 7 ""))
1605 (cdr fetched-articles))))))
1607 (defun gnus-agent-unfetch-articles (group articles)
1609 (when articles
1610 (gnus-agent-load-alist group)
1611 (let* ((alist (cons nil gnus-agent-article-alist))
1612 (articles (sort articles #'<))
1614 (delete-this (pop articles)))
1618 (setq delete-this (pop articles)))
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)
1754 . gnus-agent-enable-expiration)
1755 (agent-predicate . gnus-agent-predicate)))))))
1757 (defun gnus-agent-fetch-headers (group &optional force)
1761 (let* ((fetch-all (and gnus-agent-consider-all-articles
1763 ;; implies that we only consider unread articles.
1764 (not (gnus-predicate-implies-unread
1765 (gnus-agent-find-parameter group
1767 (articles (if fetch-all
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
1775 ;; fetch. Don't fetch articles solely on the basis of a recent or seen
1776 ;; mark, but do fetch recent or seen articles if they have other, more
1777 ;; interesting marks. (We have to fetch articles with boring 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) '<)))
1784 ;; At this point, I have the list of articles to consider for
1786 ;; of these articles may have already been fetched. That's OK as
1788 ;; filter this list to just those articles whose headers need to
1790 (let ((articles articles))
1791 ;; Remove known articles.
1792 (when (and (or gnus-agent-cache
1793 (not gnus-plugged))
1794 (gnus-agent-load-alist group))
1795 ;; Remove articles marked as downloaded.
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
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))
1827 (if articles
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)
1852 articles)
1856 articles))
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)
1912 (< (setq last (read (current-buffer))) (car articles)))
1914 (when (nnheader-find-nov-line (car articles))
1917 (gnus-agent-copy-nov-line (pop articles))
1920 (while articles
1922 (cond ((< art (car articles))
1925 ((= art (car articles))
1934 (gnus-agent-copy-nov-line (pop articles)))))
1939 (when 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))))
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))
2056 (while (setq article (pop articles))
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 ()
2263 "Fetch all articles and headers that are eligible for fetching."
2265 (unless gnus-agent-covered-methods
2267 (unless gnus-plugged
2268 (error "Can't fetch articles while Gnus is unplugged"))
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
2321 articles arts
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))
2332 ;; Identify the articles marked for download
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)
2342 marked-articles))
2344 (setq marked-articles (sort marked-articles '<))
2346 ;; Fetch any new articles from the server
2347 (setq articles (gnus-agent-fetch-headers group))
2349 ;; Merge new articles with marked
2350 (setq articles (sort (append marked-articles articles) '<))
2352 (when articles
2353 ;; Parse them and see which articles we want to fetch.
2354 (setq gnus-newsgroup-dependencies
2355 (or gnus-newsgroup-dependencies
2356 (make-vector (length articles) 0)))
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)
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)))
2385 (gnus-score-headers score-param))))
2387 (unless (and (eq predicate 'gnus-agent-false)
2388 (not marked-articles))
2391 (alist (gnus-agent-load-alist group))
2392 (marked-articles marked-articles)
2393 (gnus-newsgroup-headers gnus-newsgroup-headers))
2394 (while (setq gnus-headers (pop gnus-newsgroup-headers))
2395 (let ((num (mail-header-number gnus-headers)))
2405 (while (and marked-articles
2406 (> num (car marked-articles)))
2407 (setq marked-articles
2408 (cdr marked-articles)))
2412 (when (or (eq num (car marked-articles))
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
2420 (gnus-agent-short-article
2421 (gnus-agent-find-parameter
2423 (gnus-agent-low-score
2424 (gnus-agent-find-parameter
2426 (gnus-agent-high-score
2427 (gnus-agent-find-parameter
2429 (gnus-agent-expire-days
2430 (gnus-agent-find-parameter
2433 (gnus-agent-append-to-list arts-tail num))))))
2435 (let (fetched-articles)
2436 ;; Fetch all selected articles
2437 (setq gnus-newsgroup-undownloaded
2438 (gnus-sorted-ndifference
2439 gnus-newsgroup-undownloaded
2440 (setq fetched-articles
2442 (gnus-agent-fetch-articles group (cdr arts))
2445 (let ((unfetched-articles
2446 (gnus-sorted-ndifference (cdr arts) fetched-articles)))
2447 (if gnus-newsgroup-active
2450 (dolist (article marked-articles)
2451 (gnus-summary-set-agent-mark article t))
2452 (dolist (article fetched-articles)
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)))
2460 (dolist (article unfetched-articles)
2461 (gnus-summary-mark-article
2462 article gnus-canceled-mark)))
2466 ;; When some, or all, of the marked articles came
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"))
2664 ;; gnus-category-write.
2674 (gnus-mapcar
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.
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)
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)
2891 "Say whether PREDICATE implies unread articles only.
2894 return only unread articles."
2895 (eq t (gnus-function-implies-unread-1
2896 (gnus-category-make-function-1 predicate))))
2898 (defun gnus-function-implies-unread-1 (function)
2900 any read articles. Returns t if the function is known to never
2901 return read articles, nil when it is known to always return read
2902 articles, and t_nil when the function may return both read and unread
2903 articles."
2905 (args (mapcar 'gnus-function-implies-unread-1 (cdr function))))
2907 (cond ((memq t args) ; if any argument returns only unread articles
2908 ;; then that argument constrains the result to only unread articles.
2914 (cond ((memq nil args) ; if any argument returns read articles
2915 ;; then that argument ensures that the results includes read articles.
2920 (t ; if all arguments return only unread articles
2921 ;; then the result returns only unread articles
2930 ((eq func 'gnus-agent-read-p)
2931 nil) ; The read predicate NEVER returns unread articles
2932 ((eq func 'gnus-agent-false)
2933 t) ; The false predicate returns t as the empty set excludes all read articles
2934 ((eq func 'gnus-agent-true)
2935 nil) ; The true predicate ALWAYS returns read articles
2937 (let ((alist gnus-category-predicate-alist))
2942 't_nil) ; All other predicates return read and unread articles
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)
2960 "Expire all old articles in GROUP.
2961 If you want to force expiring of certain articles, this function can
2964 The articles on which the expiration process runs are selected as follows:
2965 if ARTICLES is null, all read and unmarked articles.
2966 if ARTICLES is t, all articles.
2967 if ARTICLES is a list, just those articles.
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
2985 (gnus-agent-expire-stats (list 0 0 0.0)))
2986 (if (or (not (eq articles t))
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")))
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)
3005 articles force))))
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
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)))
3046 (cond (gnus-agent-expire-all
3047 ;; All articles are marked read by global decree
3049 ((eq articles t)
3050 ;; All articles are marked read by function
3053 ((not articles)
3054 ;; Unread articles are marked protected from
3056 ;; gnus-list-of-unread-articles as it returns
3057 ;; articles that have not been fetched into the
3060 (gnus-agent-unread-articles group)))
3062 ;; All articles EXCEPT those named by the caller
3064 (gnus-sorted-difference
3065 (gnus-uncompress-range
3068 (sort articles '<)))))
3069 (marked ;; More articles that are excluded from the
3071 (cond (gnus-agent-expire-all
3072 ;; All articles are unmarked by global decree
3074 ((eq articles t)
3075 ;; All articles are unmarked by function
3078 (articles
3079 ;; All articles may as well be unmarked as the
3080 ;; unreads list already names the articles we are
3084 ;; Ticked and/or dormant articles are excluded
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)))
3219 ;; Kept articles are unread, marked, or special.
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
3239 ;; The following articles are READ, UNMARKED, and
3244 'read) ;; never fetched article (may expire
3262 ;; I found some reason to expire this entry.
3283 (let ((from (gnus-point-at-bol))
3288 ;; If considering all articles is set, I can only
3289 ;; expire article IDs that are no longer in the
3290 ;; active range (That is, articles that preceed the
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 \
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)
3336 (when (eq articles t)
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)
3347 "Expire all old articles.
3348 If you want to force expiring of certain articles, this function can
3351 The articles on which the expiration process runs are selected as follows:
3352 if ARTICLES is null, all read and unmarked articles.
3353 if ARTICLES is t, all articles.
3354 if ARTICLES is a list, just those articles.
3360 (gnus-agent-expire-group group articles force)
3361 (if (or (not (eq articles t))
3362 (yes-or-no-p "Are you sure that you want to expire all \
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")))
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
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)
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)
3537 If CACHED-HEADER is nil, articles are only excluded if the article itself
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)
3548 (arts articles)
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.
3568 articles))
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))
3575 cached-articles uncached-articles)
3576 (gnus-make-directory (nnheader-translate-file-chars
3581 (with-current-buffer gnus-agent-overview-buffer
3584 gnus-agent-file-coding-system))
3585 (nnheader-insert-nov-file file (car articles)))))
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
3601 ;; posted articles may not be entered into the
3608 ;; article ID N implies that all articles from 1
3610 ;; articles in that range have expired.
3613 (let* ((fetched-articles (list nil))
3614 (tail-fetched-articles fetched-articles)
3616 (max 1 (- (car articles) fetch-old)))
3620 (car articles))))
3621 (max (car (last articles))))
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))
3634 (setq fetched-articles (gnus-list-range-intersection
3635 (cdr fetched-articles)
3638 ;; Clip the uncached articles list to exclude
3641 (if (car tail-fetched-articles)
3642 (setq uncached-articles
3643 (gnus-list-range-intersection
3644 uncached-articles
3645 (cons (car uncached-articles)
3646 (car tail-fetched-articles)))))
3648 ;; Create the list of articles that were
3653 (setq uncached-articles
3654 (gnus-sorted-nunion fetched-articles
3655 uncached-articles))
3659 (set-buffer gnus-agent-overview-buffer)
3664 (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max))
3668 (when uncached-articles
3669 (gnus-agent-braid-nov group uncached-articles file))
3674 gnus-agent-file-coding-system))
3675 (gnus-agent-check-overview-buffer)
3679 ;; fetched articles.
3680 (gnus-agent-load-alist group)
3681 (gnus-agent-save-alist group uncached-articles nil)
3687 (insert-buffer-substring gnus-agent-overview-buffer)))
3693 (if fetch-old (max 1 (- (car articles) fetch-old))
3694 (car articles))
3695 (car (last articles)))
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)
3719 If REREAD is t, all articles in the .overview are marked as unread.
3720 If REREAD is a list, the specified articles will be marked as unread.
3722 the articles' current headers.
3723 If REREAD is not nil, downloaded articles are marked as unread."
3725 (list (let ((def (or (gnus-group-group-name)
3726 gnus-newsgroup-name)))
3739 (message "Mark as unread: (n)one / (a)ll / all (d)ownloaded articles? (n) ")
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
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
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)
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