1 ;;; nnagent.el --- offline backend for Gnus
3 ;; Copyright (C) 1997-2015 Free Software Foundation, Inc.
5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
6 ;; Keywords: news, mail
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
29 (eval-when-compile (require 'cl))
38 (defconst nnagent-version "nnagent 1.0")
40 (defvoo nnagent-directory nil
44 (defvoo nnagent-active-file nil
48 (defvoo nnagent-newsgroups-file nil
52 (defvoo nnagent-get-new-mail nil
56 ;;; Interface functions.
58 (nnoo-define-basics nnagent)
60 (defun nnagent-server (server)
61 (and server (format "%s+%s" (car gnus-command-method) server)))
63 (deffoo nnagent-open-server (server &optional defs)
65 `((nnagent-directory ,(gnus-agent-directory))
66 (nnagent-active-file ,(gnus-agent-lib-file "active"))
67 (nnagent-newsgroups-file ,(gnus-agent-lib-file "newsgroups"))
68 (nnagent-get-new-mail nil)))
69 (nnoo-change-server 'nnagent
70 (nnagent-server server)
72 (let ((dir (gnus-agent-directory))
75 ((not (condition-case arg
77 (ftp-error (setq err (format "%s" arg)))))
78 (nnagent-close-server)
81 (format "No such file or directory: %s" dir))))
82 ((not (file-directory-p (file-truename dir)))
83 (nnagent-close-server)
84 (nnheader-report 'nnagent "Not a directory: %s" dir))
86 (nnheader-report 'nnagent "Opened server %s using directory %s"
90 (deffoo nnagent-retrieve-groups (groups &optional server)
93 ((file-exists-p (gnus-agent-lib-file "groups"))
94 (nnmail-find-file (gnus-agent-lib-file "groups"))
96 ((file-exists-p (gnus-agent-lib-file "active"))
97 (nnmail-find-file (gnus-agent-lib-file "active"))
101 (defun nnagent-request-type (group article)
102 (unless (stringp article)
103 (let ((gnus-agent nil))
104 (if (not (gnus-check-backend-function
105 'request-type (car gnus-command-method)))
107 (funcall (gnus-get-function gnus-command-method 'request-type)
108 (gnus-group-real-name group) article)))))
110 (deffoo nnagent-request-newgroups (date server)
113 (deffoo nnagent-request-update-info (group info &optional server)
116 (deffoo nnagent-request-post (&optional server)
117 (gnus-agent-insert-meta-information 'news gnus-command-method)
118 (gnus-request-accept-article "nndraft:queue" nil t t))
120 (deffoo nnagent-request-set-mark (group action server)
121 (mm-with-unibyte-buffer
122 (insert "(gnus-agent-synchronize-group-flags \""
127 (gnus-method-to-server gnus-command-method)
130 (let ((coding-system-for-write nnheader-file-coding-system))
131 (write-region (point-min) (point-max) (gnus-agent-lib-file "flags")
133 ;; Also set the marks for the original back end that keeps marks in
135 (let ((gnus-agent nil))
136 (when (and (memq (car gnus-command-method) '(nntp))
137 (gnus-check-backend-function 'request-set-mark
138 (car gnus-command-method)))
139 (funcall (gnus-get-function gnus-command-method 'request-set-mark)
140 group action server)))
143 (deffoo nnagent-retrieve-headers (articles &optional group server fetch-old)
144 (let ((file (gnus-agent-article-name ".overview" group))
147 (gnus-agent-load-alist group)
148 (setq arts (gnus-sorted-difference
149 articles (mapcar 'car gnus-agent-article-alist)))
150 ;; Assume that articles with smaller numbers than the first one
151 ;; Agent knows are gone.
152 (setq first (caar gnus-agent-article-alist))
154 (while (and arts (< (car arts) first))
156 (set-buffer nntp-server-buffer)
158 (let ((file-name-coding-system nnmail-pathname-coding-system))
159 (nnheader-insert-nov-file file (car articles)))
160 (goto-char (point-min))
161 (gnus-parse-without-error
162 (while (and arts (not (eobp)))
163 (setq n (read (current-buffer)))
164 (when (> n (car arts))
166 (while (and arts (> n (car arts)))
168 "%d\t[Undownloaded article %d]\tGnus Agent\t\t\t\n"
169 (car arts) (car arts)))
171 (when (and arts (= n (car arts)))
176 "%d\t[Undownloaded article %d]\tGnus Agent\t\t\t\n"
177 (car arts) (car arts)))
180 (not (numberp fetch-old)))
181 t ; Don't remove anything.
182 (nnheader-nov-delete-outside-range
183 (if fetch-old (max 1 (- (car articles) fetch-old))
185 (car (last articles)))
189 (deffoo nnagent-request-expire-articles (articles group &optional server force)
192 (deffoo nnagent-request-group (group &optional server dont-check info)
193 (nnoo-parent-function 'nnagent 'nnml-request-group
194 (list group (nnagent-server server) dont-check info)))
196 (deffoo nnagent-close-group (group &optional server)
197 (nnoo-parent-function 'nnagent 'nnml-close-group
198 (list group (nnagent-server server))))
200 (deffoo nnagent-request-accept-article (group &optional server last)
201 (nnoo-parent-function 'nnagent 'nnml-request-accept-article
202 (list group (nnagent-server server) last)))
204 (deffoo nnagent-request-article (id &optional group server buffer)
205 (nnoo-parent-function 'nnagent 'nnml-request-article
206 (list id group (nnagent-server server) buffer)))
208 (deffoo nnagent-request-create-group (group &optional server args)
209 (nnoo-parent-function 'nnagent 'nnml-request-create-group
210 (list group (nnagent-server server) args)))
212 (deffoo nnagent-request-delete-group (group &optional force server)
213 (nnoo-parent-function 'nnagent 'nnml-request-delete-group
214 (list group force (nnagent-server server))))
216 (deffoo nnagent-request-list (&optional server)
217 (nnoo-parent-function 'nnagent 'nnml-request-list
218 (list (nnagent-server server))))
220 (deffoo nnagent-request-list-newsgroups (&optional server)
221 (nnoo-parent-function 'nnagent 'nnml-request-list-newsgroups
222 (list (nnagent-server server))))
224 (deffoo nnagent-request-move-article
225 (article group server accept-form &optional last move-is-internal)
226 (nnoo-parent-function 'nnagent 'nnml-request-move-article
227 (list article group (nnagent-server server)
228 accept-form last move-is-internal)))
230 (deffoo nnagent-request-rename-group (group new-name &optional server)
231 (nnoo-parent-function 'nnagent 'nnml-request-rename-group
232 (list group new-name (nnagent-server server))))
234 (deffoo nnagent-request-scan (&optional group server)
235 (nnoo-parent-function 'nnagent 'nnml-request-scan
236 (list group (nnagent-server server))))
238 (deffoo nnagent-set-status (article name value &optional group server)
239 (nnoo-parent-function 'nnagent 'nnml-set-status
240 (list article name value group (nnagent-server server))))
242 (deffoo nnagent-server-opened (&optional server)
243 (nnoo-parent-function 'nnagent 'nnml-server-opened
244 (list (nnagent-server server))))
246 (deffoo nnagent-status-message (&optional server)
247 (nnoo-parent-function 'nnagent 'nnml-status-message
248 (list (nnagent-server server))))
250 (deffoo nnagent-request-regenerate (server)
251 (nnoo-parent-function 'nnagent 'nnml-request-regenerate
252 (list (nnagent-server server))))
254 (deffoo nnagent-retrieve-group-data-early (server infos)
257 ;; Use nnml functions for just about everything.
262 ;;; Internal functions.
266 ;;; nnagent.el ends here