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, |
e3fe4da0 | 4 | ;; 2005, 2006, 2007, 2008 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 | |
5a9dffec | 13 | ;; the Free Software Foundation; either version 3, or (at your option) |
df80b09f LMI |
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) | |
01c52d31 | 124 | (mm-with-unibyte-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") | |
01c52d31 MB |
133 | (let ((coding-system-for-write nnheader-file-coding-system)) |
134 | (write-region (point-min) (point-max) (gnus-agent-lib-file "flags") | |
135 | t 'silent))) | |
136 | ;; Also set the marks for the original back end that keeps marks in | |
137 | ;; the local system. | |
138 | (let ((gnus-agent nil)) | |
139 | (when (and (memq (car gnus-command-method) '(nntp)) | |
140 | (gnus-check-backend-function 'request-set-mark | |
141 | (car gnus-command-method))) | |
142 | (funcall (gnus-get-function gnus-command-method 'request-set-mark) | |
143 | group action server))) | |
16409b0b GM |
144 | nil) |
145 | ||
23f87bed MB |
146 | (deffoo nnagent-retrieve-headers (articles &optional group server fetch-old) |
147 | (let ((file (gnus-agent-article-name ".overview" group)) | |
148 | arts n first) | |
149 | (save-excursion | |
150 | (gnus-agent-load-alist group) | |
151 | (setq arts (gnus-sorted-difference | |
152 | articles (mapcar 'car gnus-agent-article-alist))) | |
153 | ;; Assume that articles with smaller numbers than the first one | |
154 | ;; Agent knows are gone. | |
155 | (setq first (caar gnus-agent-article-alist)) | |
156 | (when first | |
157 | (while (and arts (< (car arts) first)) | |
158 | (pop arts))) | |
159 | (set-buffer nntp-server-buffer) | |
160 | (erase-buffer) | |
01c52d31 MB |
161 | (let ((file-name-coding-system nnmail-pathname-coding-system)) |
162 | (nnheader-insert-nov-file file (car articles))) | |
23f87bed MB |
163 | (goto-char (point-min)) |
164 | (gnus-parse-without-error | |
165 | (while (and arts (not (eobp))) | |
166 | (setq n (read (current-buffer))) | |
167 | (when (> n (car arts)) | |
168 | (beginning-of-line)) | |
169 | (while (and arts (> n (car arts))) | |
170 | (insert (format | |
171 | "%d\t[Undownloaded article %d]\tGnus Agent\t\t\t\n" | |
172 | (car arts) (car arts))) | |
173 | (pop arts)) | |
174 | (when (and arts (= n (car arts))) | |
175 | (pop arts)) | |
176 | (forward-line 1))) | |
177 | (while arts | |
178 | (insert (format | |
179 | "%d\t[Undownloaded article %d]\tGnus Agent\t\t\t\n" | |
180 | (car arts) (car arts))) | |
181 | (pop arts)) | |
182 | (if (and fetch-old | |
183 | (not (numberp fetch-old))) | |
184 | t ; Don't remove anything. | |
185 | (nnheader-nov-delete-outside-range | |
186 | (if fetch-old (max 1 (- (car articles) fetch-old)) | |
187 | (car articles)) | |
188 | (car (last articles))) | |
189 | t) | |
190 | 'nov))) | |
191 | ||
192 | (deffoo nnagent-request-expire-articles (articles group &optional server force) | |
193 | articles) | |
194 | ||
16409b0b GM |
195 | (deffoo nnagent-request-group (group &optional server dont-check) |
196 | (nnoo-parent-function 'nnagent 'nnml-request-group | |
23f87bed | 197 | (list group (nnagent-server server) dont-check))) |
16409b0b GM |
198 | |
199 | (deffoo nnagent-close-group (group &optional server) | |
200 | (nnoo-parent-function 'nnagent 'nnml-close-group | |
23f87bed | 201 | (list group (nnagent-server server)))) |
16409b0b GM |
202 | |
203 | (deffoo nnagent-request-accept-article (group &optional server last) | |
204 | (nnoo-parent-function 'nnagent 'nnml-request-accept-article | |
23f87bed | 205 | (list group (nnagent-server server) last))) |
16409b0b GM |
206 | |
207 | (deffoo nnagent-request-article (id &optional group server buffer) | |
208 | (nnoo-parent-function 'nnagent 'nnml-request-article | |
23f87bed | 209 | (list id group (nnagent-server server) buffer))) |
16409b0b GM |
210 | |
211 | (deffoo nnagent-request-create-group (group &optional server args) | |
212 | (nnoo-parent-function 'nnagent 'nnml-request-create-group | |
23f87bed | 213 | (list group (nnagent-server server) args))) |
16409b0b GM |
214 | |
215 | (deffoo nnagent-request-delete-group (group &optional force server) | |
216 | (nnoo-parent-function 'nnagent 'nnml-request-delete-group | |
23f87bed | 217 | (list group force (nnagent-server server)))) |
16409b0b GM |
218 | |
219 | (deffoo nnagent-request-list (&optional server) | |
a1506d29 | 220 | (nnoo-parent-function 'nnagent 'nnml-request-list |
23f87bed | 221 | (list (nnagent-server server)))) |
16409b0b GM |
222 | |
223 | (deffoo nnagent-request-list-newsgroups (&optional server) | |
a1506d29 | 224 | (nnoo-parent-function 'nnagent 'nnml-request-list-newsgroups |
23f87bed | 225 | (list (nnagent-server server)))) |
16409b0b | 226 | |
a1506d29 | 227 | (deffoo nnagent-request-move-article |
01c52d31 | 228 | (article group server accept-form &optional last move-is-internal) |
a1506d29 | 229 | (nnoo-parent-function 'nnagent 'nnml-request-move-article |
23f87bed | 230 | (list article group (nnagent-server server) |
01c52d31 | 231 | accept-form last move-is-internal))) |
16409b0b GM |
232 | |
233 | (deffoo nnagent-request-rename-group (group new-name &optional server) | |
a1506d29 | 234 | (nnoo-parent-function 'nnagent 'nnml-request-rename-group |
23f87bed | 235 | (list group new-name (nnagent-server server)))) |
16409b0b GM |
236 | |
237 | (deffoo nnagent-request-scan (&optional group server) | |
a1506d29 | 238 | (nnoo-parent-function 'nnagent 'nnml-request-scan |
23f87bed | 239 | (list group (nnagent-server server)))) |
16409b0b GM |
240 | |
241 | (deffoo nnagent-set-status (article name value &optional group server) | |
a1506d29 | 242 | (nnoo-parent-function 'nnagent 'nnml-set-status |
23f87bed | 243 | (list article name value group (nnagent-server server)))) |
16409b0b GM |
244 | |
245 | (deffoo nnagent-server-opened (&optional server) | |
246 | (nnoo-parent-function 'nnagent 'nnml-server-opened | |
247 | (list (nnagent-server server)))) | |
248 | ||
249 | (deffoo nnagent-status-message (&optional server) | |
250 | (nnoo-parent-function 'nnagent 'nnml-status-message | |
251 | (list (nnagent-server server)))) | |
df80b09f | 252 | |
23f87bed MB |
253 | (deffoo nnagent-request-regenerate (server) |
254 | (nnoo-parent-function 'nnagent 'nnml-request-regenerate | |
255 | (list (nnagent-server server)))) | |
256 | ||
df80b09f LMI |
257 | ;; Use nnml functions for just about everything. |
258 | (nnoo-import nnagent | |
259 | (nnml)) | |
260 | ||
261 | \f | |
262 | ;;; Internal functions. | |
263 | ||
264 | (provide 'nnagent) | |
265 | ||
cbee283d | 266 | ;; arch-tag: af710b77-f816-4969-af31-6fd94fb42245 |
df80b09f | 267 | ;;; nnagent.el ends here |