1;;; nnagent.el --- offline backend for Gnus 2 3;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 4;; 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> 7;; Keywords: news, mail 8 9;; This file is part of GNU Emacs. 10 11;; GNU Emacs is free software; you can redistribute it and/or modify 12;; it under the terms of the GNU General Public License as published by 13;; the Free Software Foundation; either version 2, or (at your option) 14;; any later version. 15 16;; GNU Emacs is distributed in the hope that it will be useful, 17;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19;; GNU General Public License for more details. 20 21;; You should have received a copy of the GNU General Public License 22;; along with GNU Emacs; see the file COPYING. If not, write to the 23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 24;; Boston, MA 02110-1301, USA. 25 26;;; Commentary: 27 28;;; Code: 29 30(require 'nnheader) 31(require 'nnoo) 32(eval-when-compile (require 'cl)) 33(require 'gnus-agent) 34(require 'nnml) 35 36(nnoo-declare nnagent 37 nnml) 38 39 40 41(defconst nnagent-version "nnagent 1.0") 42 43(defvoo nnagent-directory nil 44 "Internal variable." 45 nnml-directory) 46 47(defvoo nnagent-active-file nil 48 "Internal variable." 49 nnml-active-file) 50 51(defvoo nnagent-newsgroups-file nil 52 "Internal variable." 53 nnml-newsgroups-file) 54 55(defvoo nnagent-get-new-mail nil 56 "Internal variable." 57 nnml-get-new-mail) 58 59;;; Interface functions. 60 61(nnoo-define-basics nnagent) 62 63(defun nnagent-server (server) 64 (and server (format "%s+%s" (car gnus-command-method) server))) 65 66(deffoo nnagent-open-server (server &optional defs) 67 (setq defs 68 `((nnagent-directory ,(gnus-agent-directory)) 69 (nnagent-active-file ,(gnus-agent-lib-file "active")) 70 (nnagent-newsgroups-file ,(gnus-agent-lib-file "newsgroups")) 71 (nnagent-get-new-mail nil))) 72 (nnoo-change-server 'nnagent 73 (nnagent-server server) 74 defs) 75 (let ((dir (gnus-agent-directory)) 76 err) 77 (cond 78 ((not (condition-case arg 79 (file-exists-p dir) 80 (ftp-error (setq err (format "%s" arg))))) 81 (nnagent-close-server) 82 (nnheader-report 83 'nnagent (or err 84 (format "No such file or directory: %s" dir)))) 85 ((not (file-directory-p (file-truename dir))) 86 (nnagent-close-server) 87 (nnheader-report 'nnagent "Not a directory: %s" dir)) 88 (t 89 (nnheader-report 'nnagent "Opened server %s using directory %s" 90 server dir) 91 t)))) 92 93(deffoo nnagent-retrieve-groups (groups &optional server) 94 (save-excursion 95 (cond 96 ((file-exists-p (gnus-agent-lib-file "groups")) 97 (nnmail-find-file (gnus-agent-lib-file "groups")) 98 'groups) 99 ((file-exists-p (gnus-agent-lib-file "active")) 100 (nnmail-find-file (gnus-agent-lib-file "active")) 101 'active) 102 (t nil)))) 103 104(defun nnagent-request-type (group article) 105 (unless (stringp article) 106 (let ((gnus-agent nil)) 107 (if (not (gnus-check-backend-function 108 'request-type (car gnus-command-method))) 109 'unknown 110 (funcall (gnus-get-function gnus-command-method 'request-type) 111 (gnus-group-real-name group) article))))) 112 113(deffoo nnagent-request-newgroups (date server) 114 nil) 115 116(deffoo nnagent-request-update-info (group info &optional server) 117 nil) 118 119(deffoo nnagent-request-post (&optional server) 120 (gnus-agent-insert-meta-information 'news gnus-command-method) 121 (gnus-request-accept-article "nndraft:queue" nil t t)) 122 123(deffoo nnagent-request-set-mark (group action server) 124 (with-temp-buffer 125 (insert "(gnus-agent-synchronize-group-flags \"" 126 group 127 "\" '") 128 (gnus-pp action) 129 (insert " \"" 130 (gnus-method-to-server gnus-command-method) 131 "\"") 132 (insert ")\n") 133 (append-to-file (point-min) (point-max) (gnus-agent-lib-file "flags"))) 134 nil) 135 136(deffoo nnagent-retrieve-headers (articles &optional group server fetch-old) 137 (let ((file (gnus-agent-article-name ".overview" group)) 138 arts n first) 139 (save-excursion 140 (gnus-agent-load-alist group) 141 (setq arts (gnus-sorted-difference 142 articles (mapcar 'car gnus-agent-article-alist))) 143 ;; Assume that articles with smaller numbers than the first one 144 ;; Agent knows are gone. 145 (setq first (caar gnus-agent-article-alist)) 146 (when first 147 (while (and arts (< (car arts) first)) 148 (pop arts))) 149 (set-buffer nntp-server-buffer) 150 (erase-buffer) 151 (nnheader-insert-nov-file file (car articles)) 152 (goto-char (point-min)) 153 (gnus-parse-without-error 154 (while (and arts (not (eobp))) 155 (setq n (read (current-buffer))) 156 (when (> n (car arts)) 157 (beginning-of-line)) 158 (while (and arts (> n (car arts))) 159 (insert (format 160 "%d\t[Undownloaded article %d]\tGnus Agent\t\t\t\n" 161 (car arts) (car arts))) 162 (pop arts)) 163 (when (and arts (= n (car arts))) 164 (pop arts)) 165 (forward-line 1))) 166 (while arts 167 (insert (format 168 "%d\t[Undownloaded article %d]\tGnus Agent\t\t\t\n" 169 (car arts) (car arts))) 170 (pop arts)) 171 (if (and fetch-old 172 (not (numberp fetch-old))) 173 t ; Don't remove anything. 174 (nnheader-nov-delete-outside-range 175 (if fetch-old (max 1 (- (car articles) fetch-old)) 176 (car articles)) 177 (car (last articles))) 178 t) 179 'nov))) 180 181(deffoo nnagent-request-expire-articles (articles group &optional server force) 182 articles) 183 184(deffoo nnagent-request-group (group &optional server dont-check) 185 (nnoo-parent-function 'nnagent 'nnml-request-group 186 (list group (nnagent-server server) dont-check))) 187 188(deffoo nnagent-close-group (group &optional server) 189 (nnoo-parent-function 'nnagent 'nnml-close-group 190 (list group (nnagent-server server)))) 191 192(deffoo nnagent-request-accept-article (group &optional server last) 193 (nnoo-parent-function 'nnagent 'nnml-request-accept-article 194 (list group (nnagent-server server) last))) 195 196(deffoo nnagent-request-article (id &optional group server buffer) 197 (nnoo-parent-function 'nnagent 'nnml-request-article 198 (list id group (nnagent-server server) buffer))) 199 200(deffoo nnagent-request-create-group (group &optional server args) 201 (nnoo-parent-function 'nnagent 'nnml-request-create-group 202 (list group (nnagent-server server) args))) 203 204(deffoo nnagent-request-delete-group (group &optional force server) 205 (nnoo-parent-function 'nnagent 'nnml-request-delete-group 206 (list group force (nnagent-server server)))) 207 208(deffoo nnagent-request-list (&optional server) 209 (nnoo-parent-function 'nnagent 'nnml-request-list 210 (list (nnagent-server server)))) 211 212(deffoo nnagent-request-list-newsgroups (&optional server) 213 (nnoo-parent-function 'nnagent 'nnml-request-list-newsgroups 214 (list (nnagent-server server)))) 215 216(deffoo nnagent-request-move-article 217 (article group server accept-form &optional last) 218 (nnoo-parent-function 'nnagent 'nnml-request-move-article 219 (list article group (nnagent-server server) 220 accept-form last))) 221 222(deffoo nnagent-request-rename-group (group new-name &optional server) 223 (nnoo-parent-function 'nnagent 'nnml-request-rename-group 224 (list group new-name (nnagent-server server)))) 225 226(deffoo nnagent-request-scan (&optional group server) 227 (nnoo-parent-function 'nnagent 'nnml-request-scan 228 (list group (nnagent-server server)))) 229 230(deffoo nnagent-set-status (article name value &optional group server) 231 (nnoo-parent-function 'nnagent 'nnml-set-status 232 (list article name value group (nnagent-server server)))) 233 234(deffoo nnagent-server-opened (&optional server) 235 (nnoo-parent-function 'nnagent 'nnml-server-opened 236 (list (nnagent-server server)))) 237 238(deffoo nnagent-status-message (&optional server) 239 (nnoo-parent-function 'nnagent 'nnml-status-message 240 (list (nnagent-server server)))) 241 242(deffoo nnagent-request-regenerate (server) 243 (nnoo-parent-function 'nnagent 'nnml-request-regenerate 244 (list (nnagent-server server)))) 245 246;; Use nnml functions for just about everything. 247(nnoo-import nnagent 248 (nnml)) 249 250 251;;; Internal functions. 252 253(provide 'nnagent) 254 255;;; arch-tag: af710b77-f816-4969-af31-6fd94fb42245 256;;; nnagent.el ends here 257