Commit | Line | Data |
---|---|---|
df80b09f | 1 | ;;; nnagent.el --- offline backend for Gnus |
23f87bed | 2 | |
ba318903 | 3 | ;; Copyright (C) 1997-2014 Free Software Foundation, Inc. |
df80b09f LMI |
4 | |
5 | ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> | |
6 | ;; Keywords: news, mail | |
7 | ||
8 | ;; This file is part of GNU Emacs. | |
9 | ||
5e809f55 | 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
df80b09f | 11 | ;; it under the terms of the GNU General Public License as published by |
5e809f55 GM |
12 | ;; the Free Software Foundation, either version 3 of the License, or |
13 | ;; (at your option) any later version. | |
df80b09f LMI |
14 | |
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. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
5e809f55 | 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
df80b09f LMI |
22 | |
23 | ;;; Commentary: | |
24 | ||
25 | ;;; Code: | |
26 | ||
27 | (require 'nnheader) | |
28 | (require 'nnoo) | |
29 | (eval-when-compile (require 'cl)) | |
30 | (require 'gnus-agent) | |
31 | (require 'nnml) | |
32 | ||
33 | (nnoo-declare nnagent | |
34 | nnml) | |
35 | ||
36 | \f | |
37 | ||
38 | (defconst nnagent-version "nnagent 1.0") | |
39 | ||
40 | (defvoo nnagent-directory nil | |
41 | "Internal variable." | |
42 | nnml-directory) | |
43 | ||
44 | (defvoo nnagent-active-file nil | |
45 | "Internal variable." | |
46 | nnml-active-file) | |
47 | ||
48 | (defvoo nnagent-newsgroups-file nil | |
49 | "Internal variable." | |
50 | nnml-newsgroups-file) | |
51 | ||
52 | (defvoo nnagent-get-new-mail nil | |
53 | "Internal variable." | |
54 | nnml-get-new-mail) | |
55 | ||
56 | ;;; Interface functions. | |
57 | ||
58 | (nnoo-define-basics nnagent) | |
59 | ||
16409b0b GM |
60 | (defun nnagent-server (server) |
61 | (and server (format "%s+%s" (car gnus-command-method) server))) | |
62 | ||
df80b09f LMI |
63 | (deffoo nnagent-open-server (server &optional defs) |
64 | (setq 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))) | |
a1506d29 | 69 | (nnoo-change-server 'nnagent |
16409b0b GM |
70 | (nnagent-server server) |
71 | defs) | |
df80b09f LMI |
72 | (let ((dir (gnus-agent-directory)) |
73 | err) | |
74 | (cond | |
75 | ((not (condition-case arg | |
76 | (file-exists-p dir) | |
77 | (ftp-error (setq err (format "%s" arg))))) | |
78 | (nnagent-close-server) | |
79 | (nnheader-report | |
80 | 'nnagent (or err | |
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)) | |
85 | (t | |
86 | (nnheader-report 'nnagent "Opened server %s using directory %s" | |
87 | server dir) | |
88 | t)))) | |
89 | ||
90 | (deffoo nnagent-retrieve-groups (groups &optional server) | |
91 | (save-excursion | |
92 | (cond | |
93 | ((file-exists-p (gnus-agent-lib-file "groups")) | |
94 | (nnmail-find-file (gnus-agent-lib-file "groups")) | |
95 | 'groups) | |
96 | ((file-exists-p (gnus-agent-lib-file "active")) | |
97 | (nnmail-find-file (gnus-agent-lib-file "active")) | |
98 | 'active) | |
99 | (t nil)))) | |
100 | ||
101 | (defun nnagent-request-type (group article) | |
102 | (unless (stringp article) | |
54506618 | 103 | (let ((gnus-agent nil)) |
df80b09f LMI |
104 | (if (not (gnus-check-backend-function |
105 | 'request-type (car gnus-command-method))) | |
106 | 'unknown | |
107 | (funcall (gnus-get-function gnus-command-method 'request-type) | |
108 | (gnus-group-real-name group) article))))) | |
109 | ||
110 | (deffoo nnagent-request-newgroups (date server) | |
111 | nil) | |
112 | ||
113 | (deffoo nnagent-request-update-info (group info &optional server) | |
114 | nil) | |
115 | ||
116 | (deffoo nnagent-request-post (&optional server) | |
117 | (gnus-agent-insert-meta-information 'news gnus-command-method) | |
16409b0b GM |
118 | (gnus-request-accept-article "nndraft:queue" nil t t)) |
119 | ||
120 | (deffoo nnagent-request-set-mark (group action server) | |
01c52d31 | 121 | (mm-with-unibyte-buffer |
54506618 | 122 | (insert "(gnus-agent-synchronize-group-flags \"" |
c9fc72fa | 123 | group |
54506618 MB |
124 | "\" '") |
125 | (gnus-pp action) | |
126 | (insert " \"" | |
127 | (gnus-method-to-server gnus-command-method) | |
128 | "\"") | |
129 | (insert ")\n") | |
01c52d31 MB |
130 | (let ((coding-system-for-write nnheader-file-coding-system)) |
131 | (write-region (point-min) (point-max) (gnus-agent-lib-file "flags") | |
132 | t 'silent))) | |
133 | ;; Also set the marks for the original back end that keeps marks in | |
134 | ;; the local system. | |
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))) | |
16409b0b GM |
141 | nil) |
142 | ||
23f87bed MB |
143 | (deffoo nnagent-retrieve-headers (articles &optional group server fetch-old) |
144 | (let ((file (gnus-agent-article-name ".overview" group)) | |
145 | arts n first) | |
146 | (save-excursion | |
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)) | |
c9fc72fa | 153 | (when first |
23f87bed MB |
154 | (while (and arts (< (car arts) first)) |
155 | (pop arts))) | |
156 | (set-buffer nntp-server-buffer) | |
157 | (erase-buffer) | |
01c52d31 MB |
158 | (let ((file-name-coding-system nnmail-pathname-coding-system)) |
159 | (nnheader-insert-nov-file file (car articles))) | |
23f87bed MB |
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)) | |
165 | (beginning-of-line)) | |
166 | (while (and arts (> n (car 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 | (when (and arts (= n (car arts))) | |
172 | (pop arts)) | |
173 | (forward-line 1))) | |
174 | (while arts | |
175 | (insert (format | |
176 | "%d\t[Undownloaded article %d]\tGnus Agent\t\t\t\n" | |
177 | (car arts) (car arts))) | |
178 | (pop arts)) | |
179 | (if (and fetch-old | |
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)) | |
184 | (car articles)) | |
185 | (car (last articles))) | |
186 | t) | |
187 | 'nov))) | |
188 | ||
189 | (deffoo nnagent-request-expire-articles (articles group &optional server force) | |
190 | articles) | |
191 | ||
286c4fc2 | 192 | (deffoo nnagent-request-group (group &optional server dont-check info) |
16409b0b | 193 | (nnoo-parent-function 'nnagent 'nnml-request-group |
286c4fc2 | 194 | (list group (nnagent-server server) dont-check info))) |
16409b0b GM |
195 | |
196 | (deffoo nnagent-close-group (group &optional server) | |
197 | (nnoo-parent-function 'nnagent 'nnml-close-group | |
23f87bed | 198 | (list group (nnagent-server server)))) |
16409b0b GM |
199 | |
200 | (deffoo nnagent-request-accept-article (group &optional server last) | |
201 | (nnoo-parent-function 'nnagent 'nnml-request-accept-article | |
23f87bed | 202 | (list group (nnagent-server server) last))) |
16409b0b GM |
203 | |
204 | (deffoo nnagent-request-article (id &optional group server buffer) | |
205 | (nnoo-parent-function 'nnagent 'nnml-request-article | |
23f87bed | 206 | (list id group (nnagent-server server) buffer))) |
16409b0b GM |
207 | |
208 | (deffoo nnagent-request-create-group (group &optional server args) | |
209 | (nnoo-parent-function 'nnagent 'nnml-request-create-group | |
23f87bed | 210 | (list group (nnagent-server server) args))) |
16409b0b GM |
211 | |
212 | (deffoo nnagent-request-delete-group (group &optional force server) | |
213 | (nnoo-parent-function 'nnagent 'nnml-request-delete-group | |
23f87bed | 214 | (list group force (nnagent-server server)))) |
16409b0b GM |
215 | |
216 | (deffoo nnagent-request-list (&optional server) | |
a1506d29 | 217 | (nnoo-parent-function 'nnagent 'nnml-request-list |
23f87bed | 218 | (list (nnagent-server server)))) |
16409b0b GM |
219 | |
220 | (deffoo nnagent-request-list-newsgroups (&optional server) | |
a1506d29 | 221 | (nnoo-parent-function 'nnagent 'nnml-request-list-newsgroups |
23f87bed | 222 | (list (nnagent-server server)))) |
16409b0b | 223 | |
a1506d29 | 224 | (deffoo nnagent-request-move-article |
01c52d31 | 225 | (article group server accept-form &optional last move-is-internal) |
a1506d29 | 226 | (nnoo-parent-function 'nnagent 'nnml-request-move-article |
23f87bed | 227 | (list article group (nnagent-server server) |
01c52d31 | 228 | accept-form last move-is-internal))) |
16409b0b GM |
229 | |
230 | (deffoo nnagent-request-rename-group (group new-name &optional server) | |
a1506d29 | 231 | (nnoo-parent-function 'nnagent 'nnml-request-rename-group |
23f87bed | 232 | (list group new-name (nnagent-server server)))) |
16409b0b GM |
233 | |
234 | (deffoo nnagent-request-scan (&optional group server) | |
a1506d29 | 235 | (nnoo-parent-function 'nnagent 'nnml-request-scan |
23f87bed | 236 | (list group (nnagent-server server)))) |
16409b0b GM |
237 | |
238 | (deffoo nnagent-set-status (article name value &optional group server) | |
a1506d29 | 239 | (nnoo-parent-function 'nnagent 'nnml-set-status |
23f87bed | 240 | (list article name value group (nnagent-server server)))) |
16409b0b GM |
241 | |
242 | (deffoo nnagent-server-opened (&optional server) | |
243 | (nnoo-parent-function 'nnagent 'nnml-server-opened | |
244 | (list (nnagent-server server)))) | |
245 | ||
246 | (deffoo nnagent-status-message (&optional server) | |
247 | (nnoo-parent-function 'nnagent 'nnml-status-message | |
248 | (list (nnagent-server server)))) | |
df80b09f | 249 | |
23f87bed MB |
250 | (deffoo nnagent-request-regenerate (server) |
251 | (nnoo-parent-function 'nnagent 'nnml-request-regenerate | |
252 | (list (nnagent-server server)))) | |
253 | ||
20a673b2 KY |
254 | (deffoo nnagent-retrieve-group-data-early (server infos) |
255 | nil) | |
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 | ||
266 | ;;; nnagent.el ends here |