Lines Matching +defs:gnus +defs:article +defs:article +defs:menu
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
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
160 :group 'gnus-agent)
162 (defcustom gnus-agent-max-fetch-size 10000000 ;; 10 Mb
163 "Chunk size for `gnus-agent-fetch-session'.
164 The function will split its article fetches into chunks smaller than
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
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
235 file. The key of each assoc pair is the article ID, the value of each assoc
236 pair is a flag indicating whether the identified article has been downloaded
237 \(gnus-agent-fetch-articles sets the value to the day of the download).
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)
488 ;; Set up the menu.
489 (when (gnus-visual-p 'agent-menu 'menu)
490 (funcall (intern (format "gnus-agent-%s-make-menu-bar" buffer))))
491 (unless (assq 'gnus-agent-mode minor-mode-alist)
492 (push gnus-agent-mode-status minor-mode-alist))
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)
522 (easy-menu-define
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)
550 (easy-menu-define
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)
568 (easy-menu-define
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)
773 (unless gnus-plugged
775 (gnus-group-iterate n 'gnus-agent-fetch-group))
777 (defun gnus-agent-fetch-group (&optional group)
779 (interactive (list (gnus-group-group-name)))
780 (setq group (or group gnus-newsgroup-name))
784 (gnus-agent-while-plugged
785 (let ((gnus-command-method (gnus-find-method-for-group group)))
786 (gnus-agent-with-fetch
787 (gnus-agent-fetch-group-1 group gnus-command-method)
788 (gnus-message 5 "Fetching %s...done" group)))))
790 (defun gnus-agent-add-group (category arg)
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)
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)
1063 "Mark ARTICLE as downloadable. If UNMARK is nil, article is marked.
1064 When UNMARK is t, the article is unmarked. For any other value, the
1065 article's mark is toggled."
1071 (memq article gnus-newsgroup-downloadable)))))
1072 (when (gnus-summary-goto-subject article nil t)
1073 (gnus-summary-update-mark
1076 (setq gnus-newsgroup-downloadable
1077 (delq article gnus-newsgroup-downloadable))
1078 (gnus-article-mark article))
1079 (setq gnus-newsgroup-downloadable
1080 (gnus-add-to-sorted-list gnus-newsgroup-downloadable article))
1081 gnus-downloadable-mark)
1085 (defun gnus-agent-get-undownloaded-list ()
1087 (let ((gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name)))
1088 (when (set (make-local-variable 'gnus-newsgroup-agentized)
1089 (gnus-agent-method-p gnus-command-method))
1090 (let* ((alist (gnus-agent-load-alist gnus-newsgroup-name))
1093 gnus-newsgroup-headers) '<))
1094 (cached (and gnus-use-cache gnus-newsgroup-cached))
1109 ;; imply that this article isn't in the agent.
1110 (gnus-agent-append-to-list tail-undownloaded h)
1111 (gnus-agent-append-to-list tail-unfetched h)
1122 ;; This article isn't in the agent. Check to see
1128 (gnus-agent-append-to-list tail-undownloaded a))))))
1132 (gnus-agent-append-to-list tail-undownloaded num)
1133 (gnus-agent-append-to-list tail-unfetched num)))
1135 (setq gnus-newsgroup-undownloaded (cdr undownloaded)
1136 gnus-newsgroup-unfetched (cdr unfetched))))))
1138 (defun gnus-agent-catchup ()
1140 An article is unhandled if it is neither cached, nor downloaded, nor
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)
1167 ;; For each article that I processed that is no longer
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
1175 ;; remove each article successfully fetched. Now, I
1176 ;; update the real gnus-newsgroup-downloadable to only
1178 (gnus-sorted-ndifference dl (gnus-sorted-ndifference processable gnus-newsgroup-undownloaded))))))
1180 (defun gnus-agent-summary-fetch-group (&optional all)
1185 (if all gnus-newsgroup-articles
1186 gnus-newsgroup-downloadable))
1187 (gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name))
1189 (gnus-agent-while-plugged
1192 (gnus-agent-with-fetch
1193 (setq gnus-newsgroup-undownloaded
1194 (gnus-sorted-ndifference
1195 gnus-newsgroup-undownloaded
1197 (gnus-agent-fetch-articles
1198 gnus-newsgroup-name articles)))))
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))))))
1214 (defun gnus-agent-fetch-selected-article ()
1215 "Fetch the current article as it is selected.
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)
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))
1320 ;; last article known to the agent and the first article
1323 ;; gnus doesn't waste resources trying to fetch them.
1327 ;; gnus. The small gap will cause a tiny performance hit
1328 ;; when gnus tries, and fails, to retrieve the articles.
1333 (let ((read (gnus-info-read info)))
1334 (gnus-info-set-read
1336 (gnus-range-add
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)
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))
1482 article
1484 ;; Check each article
1485 (while (setq article (pop articles))
1486 ;; Skip alist entries preceeding this article
1487 (while (> article (or (caar alist) (1+ article)))
1491 (unless (and (eq article (caar alist))
1493 ;; Skip headers preceeding this article
1494 (while (> article
1499 (1+ article)))))
1502 ;; Add this article to the current set
1503 (setcar selected-sets (cons article (car selected-sets)))
1506 ;; new one. I do this after adding the article as I want at
1507 ;; least one article in each set.
1508 (when (< gnus-agent-max-fetch-size
1511 (if (= header-number article)
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))
1549 (let (article)
1550 (while (setq article (pop articles))
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))
1558 (push (cons article (point)) pos)
1585 (gnus-agent-crosspost crosses (caar pos) date)))
1589 (setq id "No-Message-ID-in-article")
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)
1638 (when (nnheader-find-nov-line article)
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)
1676 In particular, checks that the file is sorted by article number
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)
1760 article numbers will be returned."
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) '<)))
1787 ;; the fetch article code will filter those out. Internally, I'll
1792 (when (and (or gnus-agent-cache
1793 (not gnus-plugged))
1794 (gnus-agent-load-alist group))
1799 ;; article alist.
1802 (setq articles (gnus-agent-uncached-articles articles group))
1806 ;; WERE, in the article alist.
1807 (let ((low (1+ (caar (last gnus-agent-article-alist))))
1808 (high (cdr (gnus-active group))))
1811 ;; fill the article alist such that (last
1812 ;; gnus-agent-article-alist) equals (cdr (gnus-active
1815 ;; gnus-list-range-intersection returns nil which
1817 (setq articles (gnus-list-range-intersection
1820 (gnus-message
1821 10 "gnus-agent-fetch-headers: undownloaded articles are '%s'"
1822 (gnus-compress-sequence articles t))
1829 (gnus-message 7 "Fetching headers for %s..." group)
1832 (gnus-make-directory (nnheader-translate-file-chars
1835 (unless (eq 'nov (gnus-retrieve-headers articles group))
1837 (gnus-agent-check-overview-buffer)
1839 ;; gnus-agent-braid-nov can merge them with the contents
1842 gnus-agent-overview-buffer (point-min) (point-max))
1844 ;; exist. As a minimum, it will validate the article
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 ()
1859 "Reads the article number at point. Returns nil when a valid article number can not be read."
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)))
1883 (< art article)))
1887 (not (eq article art)))
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)
1990 "Load the article-state alist for 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
2038 (mapcar (lambda (article-id)
2039 (setq uncomp (cons (cons article-id state) uncomp)))
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)
2051 "Save the article-state alist for GROUP."
2053 (prev (cons nil gnus-agent-article-alist))
2055 print-level print-length item article)
2056 (while (setq article (pop articles))
2058 (< (caadr prev) article))
2062 (setcdr prev (list (cons article state))))
2063 ((> (caadr prev) article)
2064 (setcdr prev (cons (cons article state) (cdr prev))))
2065 ((= (caadr prev) article)
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)
2081 (let* ((article-id (car pair))
2086 (cons article-id (cdr comp-list)))
2088 (cons (list day-of-download article-id)
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)
2106 article counts for each of the method's subscribed groups."
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)))
2181 print-level print-length item article
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)
2244 (expand-file-name article
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
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)
2328 (when (or gnus-newsgroup-active
2329 (gnus-active group)
2330 (gnus-activate-group group))
2331 (let ((marked-articles gnus-newsgroup-downloadable))
2333 (unless gnus-newsgroup-active
2334 ;; The variable gnus-newsgroup-active was selected as I need
2335 ;; a gnus-summary local variable that is NOT bound to any
2337 (dolist (mark gnus-agent-download-marks)
2338 (let ((arts (cdr (assq mark (gnus-info-marks
2339 (setq info (gnus-get-info group)))))))
2341 (setq marked-articles (nconc (gnus-uncompress-range arts)
2347 (setq articles (gnus-agent-fetch-headers group))
2354 (setq gnus-newsgroup-dependencies
2355 (or gnus-newsgroup-dependencies
2357 (setq gnus-newsgroup-headers
2358 (or gnus-newsgroup-headers
2359 (gnus-get-newsgroup-headers-xover articles nil nil
2361 ;; `gnus-agent-overview-buffer' may be killed for
2363 (gnus-agent-create-buffer)
2366 (setq category (gnus-group-category group))
2369 (gnus-get-predicate
2370 (gnus-agent-find-parameter group 'agent-predicate)))
2373 (unless (memq predicate '(gnus-agent-true gnus-agent-false))
2375 (gnus-agent-find-parameter group 'agent-score-file)))
2380 (setq score-param (gnus-all-score-files group)))
2385 (gnus-score-headers score-param))))
2387 (unless (and (eq predicate 'gnus-agent-false)
2391 (alist (gnus-agent-load-alist group))
2393 (gnus-newsgroup-headers gnus-newsgroup-headers))
2394 (while (setq gnus-headers (pop gnus-newsgroup-headers))
2395 (let ((num (mail-header-number gnus-headers)))
2396 ;; Determine if this article is already in the cache
2404 ;; Determine if this article was marked for download.
2410 ;; When this article is marked, or selected by the
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
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))))))
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
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)))
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
2565 "*Hook run after the creation of the menu.")
2567 (defun gnus-category-make-menu-bar ()
2568 (gnus-turn-off-edit-menu 'category)
2569 (unless (boundp 'gnus-category-menu)
2570 (easy-menu-define
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 ()
2813 "Say whether an article is spam or not."
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 ()
2824 "Say whether an article is short or not."
2825 (< (mail-header-lines gnus-headers) gnus-agent-short-article))
2827 (defun gnus-agent-long-p ()
2828 "Say whether an article is long or not."
2829 (> (mail-header-lines gnus-headers) gnus-agent-long-article))
2831 (defun gnus-agent-low-scored-p ()
2832 "Say whether an article has a low score or not."
2833 (< gnus-score gnus-agent-low-score))
2835 (defun gnus-agent-high-scored-p ()
2836 "Say whether an article has a high score or not."
2837 (> gnus-score gnus-agent-high-score))
2839 (defun gnus-agent-read-p ()
2840 "Say whether an article is read or not."
2841 (gnus-member-of-range (mail-header-number gnus-headers)
2842 (gnus-info-read (gnus-get-info gnus-newsgroup-name))))
2844 (defun gnus-category-make-function (predicate)
2846 (let ((func (gnus-category-make-function-1 predicate)))
2850 (gnus-byte-compile `(lambda () ,func)))))
2852 (defun gnus-agent-true ()
2856 (defun gnus-agent-false ()
2860 (defun gnus-category-make-function-1 (predicate)
2866 `(,(or (cdr (assq predicate gnus-category-predicate-alist))
2875 ((memq (car predicate) gnus-category-not)
2877 ,@(mapcar 'gnus-category-make-function-1 (cdr predicate))))
2881 (defun gnus-get-predicate (predicate)
2883 (or (cdr (assoc predicate gnus-category-predicate-cache))
2884 (let ((func (gnus-category-make-function predicate)))
2885 (setq gnus-category-predicate-cache
2886 (nconc gnus-category-predicate-cache
2890 (defun gnus-predicate-implies-unread (predicate)
2895 (eq t (gnus-function-implies-unread-1
2896 (gnus-category-make-function-1 predicate))))
2898 (defun gnus-function-implies-unread-1 (function)
2905 (args (mapcar 'gnus-function-implies-unread-1 (cdr function))))
2930 ((eq func 'gnus-agent-read-p)
2932 ((eq func 'gnus-agent-false)
2934 ((eq func 'gnus-agent-true)
2937 (let ((alist gnus-category-predicate-alist))
2946 (defun gnus-group-category (group)
2948 (unless gnus-category-group-cache
2949 (setq gnus-category-group-cache (gnus-make-hashtable 1000))
2950 (let ((cs gnus-category-alist)
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)
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)))
2990 (let ((gnus-command-method (gnus-find-method-for-group group))
2991 (overview (gnus-get-buffer-create " *expire overview*"))
2994 (let ((active-file (gnus-agent-lib-file "active")))
2998 (gnus-active-to-gnus-format
2999 gnus-command-method
3000 (setq orig (gnus-make-hashtable
3003 (gnus-agent-expire-group-1
3004 group overview (gnus-gethash-safe group orig)
3007 (gnus-message 4 (gnus-agent-expire-done-message)))))
3009 (defun gnus-agent-expire-group-1 (group overview active articles force)
3011 ;; gnus-command-method, initialized overview buffer, and to have
3014 (let ((dir (gnus-agent-group-pathname group)))
3015 (when (boundp 'gnus-agent-expire-current-dirs)
3016 (set 'gnus-agent-expire-current-dirs
3018 (symbol-value 'gnus-agent-expire-current-dirs))))
3021 (eq 'DISABLE (gnus-agent-find-parameter group
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)))
3036 ;; keep the last article to avoid refetching
3039 ;; that supports article moving then I may have
3040 ;; to remove the last article to complete the
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
3087 (gnus-uncompress-range
3088 (cdr (assq 'tick (gnus-info-marks info))))
3089 (gnus-uncompress-range
3091 (gnus-info-marks info))))))))
3098 ;; The normal article alist contains elements that look like
3099 ;; (article# . fetch_date) I need to combine other
3101 ;; that a particular article MUST BE KEPT. To do this, I'm
3102 ;; going to transform the elements to look like (article#
3104 ;; the process to generate the expired article alist.
3106 ;; Convert the alist elements to (article# fetch_date nil
3111 ;; Convert the keep lists to elements that look like (article#
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... ")
3161 ;; If two entries have the same article-number then sort by
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)))
3213 (article-number (nth 0 entry))
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" ""))
3227 article-number)))
3229 (gnus-agent-message 3 "gnus-agent-expire cleared \
3230 download flag on %s:%d as the cached article file is missing."
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
3237 (cons article-number fetch-date)))
3244 'read) ;; never fetched article (may expire
3248 article-number))))
3251 ;; article. Handle case
3252 ;; as though this article
3268 article-number)))
3273 (push "expired cached article" actions))
3283 (let ((from (gnus-point-at-bol))
3289 ;; expire article IDs that are no longer in the
3291 ;; first article in the new alist).
3292 (if (and gnus-agent-consider-all-articles
3293 (>= article-number (car active)))
3295 (gnus-agent-append-to-list
3296 tail-alist (cons article-number fetch-date))
3297 (push (format "Removed %s article number from \
3298 article alist" type) actions))
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
3309 tail-alist (cons article-number fetch-date)))
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)
3360 (gnus-agent-expire-group group articles force)
3364 (let ((methods (gnus-agent-covered-methods))
3365 ;; Bind gnus-agent-expire-current-dirs to enable tracking
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
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)
3535 Returns a sublist of ARTICLES that excludes those article ids in GROUP
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)
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
3597 ((eq 'nntp (car gnus-current-select-method))
3598 ;; The author of gnus-get-newsgroup-headers-xover
3607 ;; article ID. Therefore, a response containing
3608 ;; article ID N implies that all articles from 1
3628 (when (setq art (gnus-agent-read-article-number))
3629 (gnus-agent-append-to-list tail-fetched-articles art))
3634 (setq fetched-articles (gnus-list-range-intersection
3643 (gnus-list-range-intersection
3652 ;; article, the header will not be fetched.
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))
3705 (numberp article))
3706 (let* ((gnus-command-method (gnus-find-method-for-group group))
3707 (file (gnus-agent-article-name (number-to-string article) group))
3712 (gnus-kill-all-overlays)
3713 (let ((coding-system-for-read gnus-cache-coding-system))
3717 (defun gnus-agent-regenerate-group (group &optional reread)
3725 (list (let ((def (or (gnus-group-group-name)
3726 gnus-newsgroup-name)))
3748 (gnus-message 3 "Ignoring unexpected input")
3752 (gnus-message 5 "Regenerating in %s" group)
3753 (let* ((gnus-command-method (or gnus-command-method
3754 (gnus-find-method-for-group group)))
3755 (file (gnus-agent-article-name ".overview" group))
3764 (progn (gnus-make-directory dir) nil)))
3772 gnus-agent-file-coding-system))
3776 ;; Load the article IDs found in the overview file. As a
3790 (gnus-delete-line)
3792 (gnus-message 4 "gnus-agent-regenerate-group: NOV\
3793 entry of article %s deleted." l1))
3797 (gnus-message 3 "gnus-agent-regenerate-group: NOV\
3804 (gnus-message 4 "gnus-agent-regenerate-group: NOV\
3805 entries contained duplicate of article %s. Duplicate deleted." l1)
3806 (gnus-delete-line)
3809 (gnus-message 1 "gnus-agent-regenerate-group: NOV\
3810 entries contained line that did not begin with an article number. Deleted\
3812 (gnus-delete-line))))
3814 (gnus-message 5 "gnus-agent-regenerate-group: Sorting NOV\
3818 (gnus-agent-check-overview-buffer)
3820 ;; Construct a new article alist whose nodes match every header
3822 ;; reconstructed from the downloaded article file.
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
3862 ;; attempt has been made to fetch that article's header.
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,
3869 ;; and every article ID preceeding it, have been fetched from the
3872 (if gnus-agent-consider-all-articles
3873 ;; Restore all article IDs that were not found in the overview file.
3876 (o (gnus-agent-load-alist group)))
3892 ;; Restore the last article ID if it is not already in the new alist
3894 (o (last (gnus-agent-load-alist group))))
3904 (let ((coding-system-for-write gnus-agent-file-coding-system))
3908 (and reread gnus-agent-article-alist)
3909 (not (equal alist gnus-agent-article-alist))))
3911 (setq gnus-agent-article-alist alist)
3914 (gnus-agent-save-alist group)
3917 ;; gnus-make-ascending-articles-unread will use it to
3920 (let ((group (gnus-group-real-name group))
3921 (group-active (or (gnus-active group)
3922 (gnus-activate-group group))))
3923 (gnus-agent-possibly-alter-active group group-active)))))
3925 (when (and reread gnus-agent-article-alist)
3926 (gnus-agent-synchronize-group-flags
3936 gnus-agent-article-alist)))
3938 gnus-command-method)
3940 (when (gnus-buffer-live-p gnus-group-buffer)
3941 (gnus-group-update-group group t)))
3943 (gnus-message 5 "")
3947 (defun gnus-agent-regenerate (&optional clean reread)
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