X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=lisp%2Fnnagent.el;h=21b9f97f0a1af60f58c4ecf05a95b32bcefc53e6;hb=a3dceb5435f0e48f5b39a10508e3d7d14aa9e8c2;hp=50777aceb75b97a8c28f012cef78782bc7974d33;hpb=94b881d9283348b1dec7f82142ec707620c7d45c;p=elisp%2Fgnus.git- diff --git a/lisp/nnagent.el b/lisp/nnagent.el index 50777ac..21b9f97 100644 --- a/lisp/nnagent.el +++ b/lisp/nnagent.el @@ -1,5 +1,7 @@ ;;; nnagent.el --- offline backend for Gnus -;; Copyright (C) 1997, 1998, 1999, 2000 Free Software Foundation, Inc. + +;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news, mail @@ -67,7 +69,7 @@ (nnagent-active-file ,(gnus-agent-lib-file "active")) (nnagent-newsgroups-file ,(gnus-agent-lib-file "newsgroups")) (nnagent-get-new-mail nil))) - (nnoo-change-server 'nnagent + (nnoo-change-server 'nnagent (nnagent-server server) defs) (let ((dir (gnus-agent-directory)) @@ -121,68 +123,108 @@ (deffoo nnagent-request-set-mark (group action server) (with-temp-buffer (insert (format "(%s-request-set-mark \"%s\" '%s \"%s\")\n" - (nth 0 gnus-command-method) group action - (or server (nth 1 gnus-command-method)))) + (nth 0 gnus-command-method) group action + (or server (nth 1 gnus-command-method)))) (append-to-file (point-min) (point-max) (gnus-agent-lib-file "flags"))) nil) +(deffoo nnagent-retrieve-headers (articles &optional group server fetch-old) + (let ((file (gnus-agent-article-name ".overview" group)) + arts n first) + (save-excursion + (gnus-agent-load-alist group) + (setq arts (gnus-sorted-difference + articles (mapcar 'car gnus-agent-article-alist))) + ;; Assume that articles with smaller numbers than the first one + ;; Agent knows are gone. + (setq first (caar gnus-agent-article-alist)) + (when first + (while (and arts (< (car arts) first)) + (pop arts))) + (set-buffer nntp-server-buffer) + (erase-buffer) + (nnheader-insert-nov-file file (car articles)) + (goto-char (point-min)) + (gnus-parse-without-error + (while (and arts (not (eobp))) + (setq n (read (current-buffer))) + (when (> n (car arts)) + (beginning-of-line)) + (while (and arts (> n (car arts))) + (insert (format + "%d\t[Undownloaded article %d]\tGnus Agent\t\t\t\n" + (car arts) (car arts))) + (pop arts)) + (when (and arts (= n (car arts))) + (pop arts)) + (forward-line 1))) + (while arts + (insert (format + "%d\t[Undownloaded article %d]\tGnus Agent\t\t\t\n" + (car arts) (car arts))) + (pop arts)) + (if (and fetch-old + (not (numberp fetch-old))) + t ; Don't remove anything. + (nnheader-nov-delete-outside-range + (if fetch-old (max 1 (- (car articles) fetch-old)) + (car articles)) + (car (last articles))) + t) + 'nov))) + +(deffoo nnagent-request-expire-articles (articles group &optional server force) + articles) + (deffoo nnagent-request-group (group &optional server dont-check) (nnoo-parent-function 'nnagent 'nnml-request-group - (list group (nnagent-server server) dont-check))) + (list group (nnagent-server server) dont-check))) (deffoo nnagent-close-group (group &optional server) (nnoo-parent-function 'nnagent 'nnml-close-group - (list group (nnagent-server server)))) + (list group (nnagent-server server)))) (deffoo nnagent-request-accept-article (group &optional server last) (nnoo-parent-function 'nnagent 'nnml-request-accept-article - (list group (nnagent-server server) last))) + (list group (nnagent-server server) last))) (deffoo nnagent-request-article (id &optional group server buffer) (nnoo-parent-function 'nnagent 'nnml-request-article - (list id group (nnagent-server server) buffer))) + (list id group (nnagent-server server) buffer))) (deffoo nnagent-request-create-group (group &optional server args) (nnoo-parent-function 'nnagent 'nnml-request-create-group - (list group (nnagent-server server) args))) + (list group (nnagent-server server) args))) (deffoo nnagent-request-delete-group (group &optional force server) (nnoo-parent-function 'nnagent 'nnml-request-delete-group - (list group force (nnagent-server server)))) - -(deffoo nnagent-request-expire-articles (articles group &optional server force) - (nnoo-parent-function 'nnagent 'nnml-request-expire-articles - (list articles group (nnagent-server server) force))) + (list group force (nnagent-server server)))) (deffoo nnagent-request-list (&optional server) - (nnoo-parent-function 'nnagent 'nnml-request-list - (list (nnagent-server server)))) + (nnoo-parent-function 'nnagent 'nnml-request-list + (list (nnagent-server server)))) (deffoo nnagent-request-list-newsgroups (&optional server) - (nnoo-parent-function 'nnagent 'nnml-request-list-newsgroups - (list (nnagent-server server)))) + (nnoo-parent-function 'nnagent 'nnml-request-list-newsgroups + (list (nnagent-server server)))) -(deffoo nnagent-request-move-article +(deffoo nnagent-request-move-article (article group server accept-form &optional last) - (nnoo-parent-function 'nnagent 'nnml-request-move-article - (list article group (nnagent-server server) - accept-form last))) + (nnoo-parent-function 'nnagent 'nnml-request-move-article + (list article group (nnagent-server server) + accept-form last))) (deffoo nnagent-request-rename-group (group new-name &optional server) - (nnoo-parent-function 'nnagent 'nnml-request-rename-group - (list group new-name (nnagent-server server)))) + (nnoo-parent-function 'nnagent 'nnml-request-rename-group + (list group new-name (nnagent-server server)))) (deffoo nnagent-request-scan (&optional group server) - (nnoo-parent-function 'nnagent 'nnml-request-scan - (list group (nnagent-server server)))) - -(deffoo nnagent-retrieve-headers (sequence &optional group server fetch-old) - (nnoo-parent-function 'nnagent 'nnml-retrieve-headers - (list sequence group (nnagent-server server) fetch-old))) + (nnoo-parent-function 'nnagent 'nnml-request-scan + (list group (nnagent-server server)))) (deffoo nnagent-set-status (article name value &optional group server) - (nnoo-parent-function 'nnagent 'nnml-set-status - (list article name value group (nnagent-server server)))) + (nnoo-parent-function 'nnagent 'nnml-set-status + (list article name value group (nnagent-server server)))) (deffoo nnagent-server-opened (&optional server) (nnoo-parent-function 'nnagent 'nnml-server-opened