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