X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fnnagent.el;h=7650d9e29f7e567bf8aae40f8c95d1aad94fba5f;hp=5bdc1e6a5a18f9475dd9b515b32f6a8e3e7e747b;hb=d6d90fbbda04a990e100832c709d6c746d872aa3;hpb=3aea1902b52544b9400962e997708c2daa29e460 diff --git a/lisp/nnagent.el b/lisp/nnagent.el index 5bdc1e6a5..7650d9e29 100644 --- a/lisp/nnagent.el +++ b/lisp/nnagent.el @@ -1,17 +1,16 @@ ;;; nnagent.el --- offline backend for Gnus -;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002 -;; Free Software Foundation, Inc. +;; Copyright (C) 1997-2012 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news, mail ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -19,9 +18,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -103,7 +100,7 @@ (defun nnagent-request-type (group article) (unless (stringp article) - (let ((gnus-plugged t)) + (let ((gnus-agent nil)) (if (not (gnus-check-backend-function 'request-type (car gnus-command-method))) 'unknown @@ -121,28 +118,59 @@ (gnus-request-accept-article "nndraft:queue" nil t t)) (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)))) - (append-to-file (point-min) (point-max) (gnus-agent-lib-file "flags"))) + (mm-with-unibyte-buffer + (insert "(gnus-agent-synchronize-group-flags \"" + group + "\" '") + (gnus-pp action) + (insert " \"" + (gnus-method-to-server gnus-command-method) + "\"") + (insert ")\n") + (let ((coding-system-for-write nnheader-file-coding-system)) + (write-region (point-min) (point-max) (gnus-agent-lib-file "flags") + t 'silent))) + ;; Also set the marks for the original back end that keeps marks in + ;; the local system. + (let ((gnus-agent nil)) + (when (and (memq (car gnus-command-method) '(nntp)) + (gnus-check-backend-function 'request-set-mark + (car gnus-command-method))) + (funcall (gnus-get-function gnus-command-method 'request-set-mark) + group action server))) nil) (deffoo nnagent-retrieve-headers (articles &optional group server fetch-old) (let ((file (gnus-agent-article-name ".overview" group)) - arts n) + arts n first) (save-excursion (gnus-agent-load-alist group) - (setq arts (gnus-set-difference articles - (mapcar 'car gnus-agent-article-alist))) + (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-file-contents file) + (let ((file-name-coding-system nnmail-pathname-coding-system)) + (nnheader-insert-nov-file file (car articles))) (goto-char (point-min)) - ;; This loop is just for the `condition-case' -- if reading bugs - ;; out on a line, it'll still continue on to the next line. So - ;; this look is normally just executed once. - + (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" @@ -158,9 +186,12 @@ t) 'nov))) -(deffoo nnagent-request-group (group &optional server dont-check) +(deffoo nnagent-request-expire-articles (articles group &optional server force) + articles) + +(deffoo nnagent-request-group (group &optional server dont-check info) (nnoo-parent-function 'nnagent 'nnml-request-group - (list group (nnagent-server server) dont-check))) + (list group (nnagent-server server) dont-check info))) (deffoo nnagent-close-group (group &optional server) (nnoo-parent-function 'nnagent 'nnml-close-group @@ -182,10 +213,6 @@ (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))) - (deffoo nnagent-request-list (&optional server) (nnoo-parent-function 'nnagent 'nnml-request-list (list (nnagent-server server)))) @@ -195,10 +222,10 @@ (list (nnagent-server server)))) (deffoo nnagent-request-move-article - (article group server accept-form &optional last) + (article group server accept-form &optional last move-is-internal) (nnoo-parent-function 'nnagent 'nnml-request-move-article (list article group (nnagent-server server) - accept-form last))) + accept-form last move-is-internal))) (deffoo nnagent-request-rename-group (group new-name &optional server) (nnoo-parent-function 'nnagent 'nnml-request-rename-group @@ -224,6 +251,9 @@ (nnoo-parent-function 'nnagent 'nnml-request-regenerate (list (nnagent-server server)))) +(deffoo nnagent-retrieve-group-data-early (server infos) + nil) + ;; Use nnml functions for just about everything. (nnoo-import nnagent (nnml))