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, |
88e6695f | 4 | ;; 2005, 2006 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 | ||
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 | |
3a35cf56 LK |
23 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
24 | ;; Boston, MA 02110-1301, USA. | |
df80b09f LMI |
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 | \f | |
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 | ||
16409b0b GM |
63 | (defun nnagent-server (server) |
64 | (and server (format "%s+%s" (car gnus-command-method) server))) | |
65 | ||
df80b09f LMI |
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))) | |
a1506d29 | 72 | (nnoo-change-server 'nnagent |
16409b0b GM |
73 | (nnagent-server server) |
74 | defs) | |
df80b09f LMI |
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) | |
54506618 | 106 | (let ((gnus-agent nil)) |
df80b09f LMI |
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) | |
16409b0b GM |
121 | (gnus-request-accept-article "nndraft:queue" nil t t)) |
122 | ||
123 | (deffoo nnagent-request-set-mark (group action server) | |
124 | (with-temp-buffer | |
54506618 MB |
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") | |
16409b0b GM |
133 | (append-to-file (point-min) (point-max) (gnus-agent-lib-file "flags"))) |
134 | nil) | |
135 | ||
23f87bed MB |
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 | ||
16409b0b GM |
184 | (deffoo nnagent-request-group (group &optional server dont-check) |
185 | (nnoo-parent-function 'nnagent 'nnml-request-group | |
23f87bed | 186 | (list group (nnagent-server server) dont-check))) |
16409b0b GM |
187 | |
188 | (deffoo nnagent-close-group (group &optional server) | |
189 | (nnoo-parent-function 'nnagent 'nnml-close-group | |
23f87bed | 190 | (list group (nnagent-server server)))) |
16409b0b GM |
191 | |
192 | (deffoo nnagent-request-accept-article (group &optional server last) | |
193 | (nnoo-parent-function 'nnagent 'nnml-request-accept-article | |
23f87bed | 194 | (list group (nnagent-server server) last))) |
16409b0b GM |
195 | |
196 | (deffoo nnagent-request-article (id &optional group server buffer) | |
197 | (nnoo-parent-function 'nnagent 'nnml-request-article | |
23f87bed | 198 | (list id group (nnagent-server server) buffer))) |
16409b0b GM |
199 | |
200 | (deffoo nnagent-request-create-group (group &optional server args) | |
201 | (nnoo-parent-function 'nnagent 'nnml-request-create-group | |
23f87bed | 202 | (list group (nnagent-server server) args))) |
16409b0b GM |
203 | |
204 | (deffoo nnagent-request-delete-group (group &optional force server) | |
205 | (nnoo-parent-function 'nnagent 'nnml-request-delete-group | |
23f87bed | 206 | (list group force (nnagent-server server)))) |
16409b0b GM |
207 | |
208 | (deffoo nnagent-request-list (&optional server) | |
a1506d29 | 209 | (nnoo-parent-function 'nnagent 'nnml-request-list |
23f87bed | 210 | (list (nnagent-server server)))) |
16409b0b GM |
211 | |
212 | (deffoo nnagent-request-list-newsgroups (&optional server) | |
a1506d29 | 213 | (nnoo-parent-function 'nnagent 'nnml-request-list-newsgroups |
23f87bed | 214 | (list (nnagent-server server)))) |
16409b0b | 215 | |
a1506d29 | 216 | (deffoo nnagent-request-move-article |
16409b0b | 217 | (article group server accept-form &optional last) |
a1506d29 | 218 | (nnoo-parent-function 'nnagent 'nnml-request-move-article |
23f87bed MB |
219 | (list article group (nnagent-server server) |
220 | accept-form last))) | |
16409b0b GM |
221 | |
222 | (deffoo nnagent-request-rename-group (group new-name &optional server) | |
a1506d29 | 223 | (nnoo-parent-function 'nnagent 'nnml-request-rename-group |
23f87bed | 224 | (list group new-name (nnagent-server server)))) |
16409b0b GM |
225 | |
226 | (deffoo nnagent-request-scan (&optional group server) | |
a1506d29 | 227 | (nnoo-parent-function 'nnagent 'nnml-request-scan |
23f87bed | 228 | (list group (nnagent-server server)))) |
16409b0b GM |
229 | |
230 | (deffoo nnagent-set-status (article name value &optional group server) | |
a1506d29 | 231 | (nnoo-parent-function 'nnagent 'nnml-set-status |
23f87bed | 232 | (list article name value group (nnagent-server server)))) |
16409b0b GM |
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)))) | |
df80b09f | 241 | |
23f87bed MB |
242 | (deffoo nnagent-request-regenerate (server) |
243 | (nnoo-parent-function 'nnagent 'nnml-request-regenerate | |
244 | (list (nnagent-server server)))) | |
245 | ||
df80b09f LMI |
246 | ;; Use nnml functions for just about everything. |
247 | (nnoo-import nnagent | |
248 | (nnml)) | |
249 | ||
250 | \f | |
251 | ;;; Internal functions. | |
252 | ||
253 | (provide 'nnagent) | |
254 | ||
ab5796a9 | 255 | ;;; arch-tag: af710b77-f816-4969-af31-6fd94fb42245 |
df80b09f | 256 | ;;; nnagent.el ends here |