Mercurial > emacs
comparison lisp/gnus/gnus-int.el @ 24357:15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
author | Lars Magne Ingebrigtsen <larsi@gnus.org> |
---|---|
date | Sat, 20 Feb 1999 14:05:57 +0000 |
parents | 5f1ab3dd344d |
children | 9968f55ad26e |
comparison
equal
deleted
inserted
replaced
24356:a5a611ef40f6 | 24357:15fc6acbae7a |
---|---|
1 ;;; gnus-int.el --- backend interface functions for Gnus | 1 ;;; gnus-int.el --- backend interface functions for Gnus |
2 ;; Copyright (C) 1996,97 Free Software Foundation, Inc. | 2 ;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. |
3 | 3 |
4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no> | 4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
5 ;; Keywords: news | 5 ;; Keywords: news |
6 | 6 |
7 ;; This file is part of GNU Emacs. | 7 ;; This file is part of GNU Emacs. |
8 | 8 |
9 ;; GNU Emacs is free software; you can redistribute it and/or modify | 9 ;; GNU Emacs is free software; you can redistribute it and/or modify |
22 ;; Boston, MA 02111-1307, USA. | 22 ;; Boston, MA 02111-1307, USA. |
23 | 23 |
24 ;;; Commentary: | 24 ;;; Commentary: |
25 | 25 |
26 ;;; Code: | 26 ;;; Code: |
27 | |
28 (eval-when-compile (require 'cl)) | |
27 | 29 |
28 (eval-when-compile (require 'cl)) | 30 (eval-when-compile (require 'cl)) |
29 | 31 |
30 (require 'gnus) | 32 (require 'gnus) |
31 | 33 |
84 (require 'nnmh) | 86 (require 'nnmh) |
85 (gnus-message 5 "Looking up mh spool...")) | 87 (gnus-message 5 "Looking up mh spool...")) |
86 (t | 88 (t |
87 (require 'nntp))) | 89 (require 'nntp))) |
88 (setq gnus-current-select-method gnus-select-method) | 90 (setq gnus-current-select-method gnus-select-method) |
89 (run-hooks 'gnus-open-server-hook) | 91 (gnus-run-hooks 'gnus-open-server-hook) |
90 (or | 92 (or |
91 ;; gnus-open-server-hook might have opened it | 93 ;; gnus-open-server-hook might have opened it |
92 (gnus-server-opened gnus-select-method) | 94 (gnus-server-opened gnus-select-method) |
93 (gnus-open-server gnus-select-method) | 95 (gnus-open-server gnus-select-method) |
94 (gnus-y-or-n-p | 96 (gnus-y-or-n-p |
119 ;; Open the server. | 121 ;; Open the server. |
120 (unless silent | 122 (unless silent |
121 (gnus-message 5 "Opening %s server%s..." (car method) | 123 (gnus-message 5 "Opening %s server%s..." (car method) |
122 (if (equal (nth 1 method) "") "" | 124 (if (equal (nth 1 method) "") "" |
123 (format " on %s" (nth 1 method))))) | 125 (format " on %s" (nth 1 method))))) |
124 (run-hooks 'gnus-open-server-hook) | 126 (gnus-run-hooks 'gnus-open-server-hook) |
125 (prog1 | 127 (prog1 |
126 (gnus-open-server method) | 128 (gnus-open-server method) |
127 (unless silent | 129 (unless silent |
128 (message "")))))) | 130 (message "")))))) |
129 | 131 |
132 ;; Translate server names into methods. | 134 ;; Translate server names into methods. |
133 (unless method | 135 (unless method |
134 (error "Attempted use of a nil select method")) | 136 (error "Attempted use of a nil select method")) |
135 (when (stringp method) | 137 (when (stringp method) |
136 (setq method (gnus-server-to-method method))) | 138 (setq method (gnus-server-to-method method))) |
137 (let ((func (intern (format "%s-%s" (car method) function)))) | 139 ;; Check cache of constructed names. |
138 ;; If the functions isn't bound, we require the backend in | 140 (let* ((method-sym (if gnus-agent |
139 ;; question. | 141 (gnus-agent-get-function method) |
142 (car method))) | |
143 (method-fns (get method-sym 'gnus-method-functions)) | |
144 (func (let ((method-fnlist-elt (assq function method-fns))) | |
145 (unless method-fnlist-elt | |
146 (setq method-fnlist-elt | |
147 (cons function | |
148 (intern (format "%s-%s" method-sym function)))) | |
149 (put method-sym 'gnus-method-functions | |
150 (cons method-fnlist-elt method-fns))) | |
151 (cdr method-fnlist-elt)))) | |
152 ;; Maybe complain if there is no function. | |
140 (unless (fboundp func) | 153 (unless (fboundp func) |
154 (unless (car method) | |
155 (error "Trying to require a method that doesn't exist")) | |
141 (require (car method)) | 156 (require (car method)) |
142 (when (and (not (fboundp func)) | 157 (when (not (fboundp func)) |
143 (not noerror)) | 158 (if noerror |
144 ;; This backend doesn't implement this function. | 159 (setq func nil) |
145 (error "No such function: %s" func))) | 160 (error "No such function: %s" func)))) |
146 func)) | 161 func)) |
147 | 162 |
148 | 163 |
149 ;;; | 164 ;;; |
150 ;;; Interface functions to the backends. | 165 ;;; Interface functions to the backends. |
151 ;;; | 166 ;;; |
152 | 167 |
153 (defun gnus-open-server (method) | 168 (defun gnus-open-server (gnus-command-method) |
154 "Open a connection to METHOD." | 169 "Open a connection to GNUS-COMMAND-METHOD." |
155 (when (stringp method) | 170 (when (stringp gnus-command-method) |
156 (setq method (gnus-server-to-method method))) | 171 (setq gnus-command-method (gnus-server-to-method gnus-command-method))) |
157 (let ((elem (assoc method gnus-opened-servers))) | 172 (let ((elem (assoc gnus-command-method gnus-opened-servers))) |
158 ;; If this method was previously denied, we just return nil. | 173 ;; If this method was previously denied, we just return nil. |
159 (if (eq (nth 1 elem) 'denied) | 174 (if (eq (nth 1 elem) 'denied) |
160 (progn | 175 (progn |
161 (gnus-message 1 "Denied server") | 176 (gnus-message 1 "Denied server") |
162 nil) | 177 nil) |
163 ;; Open the server. | 178 ;; Open the server. |
164 (let ((result | 179 (let ((result |
165 (funcall (gnus-get-function method 'open-server) | 180 (funcall (gnus-get-function gnus-command-method 'open-server) |
166 (nth 1 method) (nthcdr 2 method)))) | 181 (nth 1 gnus-command-method) |
182 (nthcdr 2 gnus-command-method)))) | |
167 ;; If this hasn't been opened before, we add it to the list. | 183 ;; If this hasn't been opened before, we add it to the list. |
168 (unless elem | 184 (unless elem |
169 (setq elem (list method nil) | 185 (setq elem (list gnus-command-method nil) |
170 gnus-opened-servers (cons elem gnus-opened-servers))) | 186 gnus-opened-servers (cons elem gnus-opened-servers))) |
171 ;; Set the status of this server. | 187 ;; Set the status of this server. |
172 (setcar (cdr elem) (if result 'ok 'denied)) | 188 (setcar (cdr elem) (if result 'ok 'denied)) |
173 ;; Return the result from the "open" call. | 189 ;; Return the result from the "open" call. |
174 result)))) | 190 result)))) |
175 | 191 |
176 (defun gnus-close-server (method) | 192 (defun gnus-close-server (gnus-command-method) |
177 "Close the connection to METHOD." | 193 "Close the connection to GNUS-COMMAND-METHOD." |
178 (when (stringp method) | 194 (when (stringp gnus-command-method) |
179 (setq method (gnus-server-to-method method))) | 195 (setq gnus-command-method (gnus-server-to-method gnus-command-method))) |
180 (funcall (gnus-get-function method 'close-server) (nth 1 method))) | 196 (funcall (gnus-get-function gnus-command-method 'close-server) |
181 | 197 (nth 1 gnus-command-method))) |
182 (defun gnus-request-list (method) | 198 |
183 "Request the active file from METHOD." | 199 (defun gnus-request-list (gnus-command-method) |
184 (when (stringp method) | 200 "Request the active file from GNUS-COMMAND-METHOD." |
185 (setq method (gnus-server-to-method method))) | 201 (when (stringp gnus-command-method) |
186 (funcall (gnus-get-function method 'request-list) (nth 1 method))) | 202 (setq gnus-command-method (gnus-server-to-method gnus-command-method))) |
187 | 203 (funcall (gnus-get-function gnus-command-method 'request-list) |
188 (defun gnus-request-list-newsgroups (method) | 204 (nth 1 gnus-command-method))) |
189 "Request the newsgroups file from METHOD." | 205 |
190 (when (stringp method) | 206 (defun gnus-request-list-newsgroups (gnus-command-method) |
191 (setq method (gnus-server-to-method method))) | 207 "Request the newsgroups file from GNUS-COMMAND-METHOD." |
192 (funcall (gnus-get-function method 'request-list-newsgroups) (nth 1 method))) | 208 (when (stringp gnus-command-method) |
193 | 209 (setq gnus-command-method (gnus-server-to-method gnus-command-method))) |
194 (defun gnus-request-newgroups (date method) | 210 (funcall (gnus-get-function gnus-command-method 'request-list-newsgroups) |
195 "Request all new groups since DATE from METHOD." | 211 (nth 1 gnus-command-method))) |
196 (when (stringp method) | 212 |
197 (setq method (gnus-server-to-method method))) | 213 (defun gnus-request-newgroups (date gnus-command-method) |
198 (let ((func (gnus-get-function method 'request-newgroups t))) | 214 "Request all new groups since DATE from GNUS-COMMAND-METHOD." |
215 (when (stringp gnus-command-method) | |
216 (setq gnus-command-method (gnus-server-to-method gnus-command-method))) | |
217 (let ((func (gnus-get-function gnus-command-method 'request-newgroups t))) | |
199 (when func | 218 (when func |
200 (funcall func date (nth 1 method))))) | 219 (funcall func date (nth 1 gnus-command-method))))) |
201 | 220 |
202 (defun gnus-server-opened (method) | 221 (defun gnus-server-opened (gnus-command-method) |
203 "Check whether a connection to METHOD has been opened." | 222 "Check whether a connection to GNUS-COMMAND-METHOD has been opened." |
204 (when (stringp method) | 223 (when (stringp gnus-command-method) |
205 (setq method (gnus-server-to-method method))) | 224 (setq gnus-command-method (gnus-server-to-method gnus-command-method))) |
206 (funcall (inline (gnus-get-function method 'server-opened)) (nth 1 method))) | 225 (funcall (inline (gnus-get-function gnus-command-method 'server-opened)) |
207 | 226 (nth 1 gnus-command-method))) |
208 (defun gnus-status-message (method) | 227 |
209 "Return the status message from METHOD. | 228 (defun gnus-status-message (gnus-command-method) |
210 If METHOD is a string, it is interpreted as a group name. The method | 229 "Return the status message from GNUS-COMMAND-METHOD. |
230 If GNUS-COMMAND-METHOD is a string, it is interpreted as a group name. The method | |
211 this group uses will be queried." | 231 this group uses will be queried." |
212 (let ((method (if (stringp method) (gnus-find-method-for-group method) | 232 (let ((gnus-command-method |
213 method))) | 233 (if (stringp gnus-command-method) |
214 (funcall (gnus-get-function method 'status-message) (nth 1 method)))) | 234 (gnus-find-method-for-group gnus-command-method) |
215 | 235 gnus-command-method))) |
216 (defun gnus-request-regenerate (method) | 236 (funcall (gnus-get-function gnus-command-method 'status-message) |
217 "Request a data generation from METHOD." | 237 (nth 1 gnus-command-method)))) |
218 (when (stringp method) | 238 |
219 (setq method (gnus-server-to-method method))) | 239 (defun gnus-request-regenerate (gnus-command-method) |
220 (funcall (gnus-get-function method 'request-regenerate) (nth 1 method))) | 240 "Request a data generation from GNUS-COMMAND-METHOD." |
221 | 241 (when (stringp gnus-command-method) |
222 (defun gnus-request-group (group &optional dont-check method) | 242 (setq gnus-command-method (gnus-server-to-method gnus-command-method))) |
243 (funcall (gnus-get-function gnus-command-method 'request-regenerate) | |
244 (nth 1 gnus-command-method))) | |
245 | |
246 (defun gnus-request-group (group &optional dont-check gnus-command-method) | |
223 "Request GROUP. If DONT-CHECK, no information is required." | 247 "Request GROUP. If DONT-CHECK, no information is required." |
224 (let ((method (or method (inline (gnus-find-method-for-group group))))) | 248 (let ((gnus-command-method |
225 (when (stringp method) | 249 (or gnus-command-method (inline (gnus-find-method-for-group group))))) |
226 (setq method (inline (gnus-server-to-method method)))) | 250 (when (stringp gnus-command-method) |
227 (funcall (inline (gnus-get-function method 'request-group)) | 251 (setq gnus-command-method |
228 (gnus-group-real-name group) (nth 1 method) dont-check))) | 252 (inline (gnus-server-to-method gnus-command-method)))) |
253 (funcall (inline (gnus-get-function gnus-command-method 'request-group)) | |
254 (gnus-group-real-name group) (nth 1 gnus-command-method) | |
255 dont-check))) | |
229 | 256 |
230 (defun gnus-list-active-group (group) | 257 (defun gnus-list-active-group (group) |
231 "Request active information on GROUP." | 258 "Request active information on GROUP." |
232 (let ((method (gnus-find-method-for-group group)) | 259 (let ((gnus-command-method (gnus-find-method-for-group group)) |
233 (func 'list-active-group)) | 260 (func 'list-active-group)) |
234 (when (gnus-check-backend-function func group) | 261 (when (gnus-check-backend-function func group) |
235 (funcall (gnus-get-function method func) | 262 (funcall (gnus-get-function gnus-command-method func) |
236 (gnus-group-real-name group) (nth 1 method))))) | 263 (gnus-group-real-name group) (nth 1 gnus-command-method))))) |
237 | 264 |
238 (defun gnus-request-group-description (group) | 265 (defun gnus-request-group-description (group) |
239 "Request a description of GROUP." | 266 "Request a description of GROUP." |
240 (let ((method (gnus-find-method-for-group group)) | 267 (let ((gnus-command-method (gnus-find-method-for-group group)) |
241 (func 'request-group-description)) | 268 (func 'request-group-description)) |
242 (when (gnus-check-backend-function func group) | 269 (when (gnus-check-backend-function func group) |
243 (funcall (gnus-get-function method func) | 270 (funcall (gnus-get-function gnus-command-method func) |
244 (gnus-group-real-name group) (nth 1 method))))) | 271 (gnus-group-real-name group) (nth 1 gnus-command-method))))) |
245 | 272 |
246 (defun gnus-close-group (group) | 273 (defun gnus-close-group (group) |
247 "Request the GROUP be closed." | 274 "Request the GROUP be closed." |
248 (let ((method (inline (gnus-find-method-for-group group)))) | 275 (let ((gnus-command-method (inline (gnus-find-method-for-group group)))) |
249 (funcall (gnus-get-function method 'close-group) | 276 (funcall (gnus-get-function gnus-command-method 'close-group) |
250 (gnus-group-real-name group) (nth 1 method)))) | 277 (gnus-group-real-name group) (nth 1 gnus-command-method)))) |
251 | 278 |
252 (defun gnus-retrieve-headers (articles group &optional fetch-old) | 279 (defun gnus-retrieve-headers (articles group &optional fetch-old) |
253 "Request headers for ARTICLES in GROUP. | 280 "Request headers for ARTICLES in GROUP. |
254 If FETCH-OLD, retrieve all headers (or some subset thereof) in the group." | 281 If FETCH-OLD, retrieve all headers (or some subset thereof) in the group." |
255 (let ((method (gnus-find-method-for-group group))) | 282 (let ((gnus-command-method (gnus-find-method-for-group group))) |
256 (if (and gnus-use-cache (numberp (car articles))) | 283 (if (and gnus-use-cache (numberp (car articles))) |
257 (gnus-cache-retrieve-headers articles group fetch-old) | 284 (gnus-cache-retrieve-headers articles group fetch-old) |
258 (funcall (gnus-get-function method 'retrieve-headers) | 285 (funcall (gnus-get-function gnus-command-method 'retrieve-headers) |
259 articles (gnus-group-real-name group) (nth 1 method) | 286 articles (gnus-group-real-name group) |
260 fetch-old)))) | 287 (nth 1 gnus-command-method) fetch-old)))) |
261 | 288 |
262 (defun gnus-retrieve-groups (groups method) | 289 (defun gnus-retrieve-articles (articles group) |
263 "Request active information on GROUPS from METHOD." | 290 "Request ARTICLES in GROUP." |
264 (when (stringp method) | 291 (let ((gnus-command-method (gnus-find-method-for-group group))) |
265 (setq method (gnus-server-to-method method))) | 292 (funcall (gnus-get-function gnus-command-method 'retrieve-articles) |
266 (funcall (gnus-get-function method 'retrieve-groups) groups (nth 1 method))) | 293 articles (gnus-group-real-name group) |
294 (nth 1 gnus-command-method)))) | |
295 | |
296 (defun gnus-retrieve-groups (groups gnus-command-method) | |
297 "Request active information on GROUPS from GNUS-COMMAND-METHOD." | |
298 (when (stringp gnus-command-method) | |
299 (setq gnus-command-method (gnus-server-to-method gnus-command-method))) | |
300 (funcall (gnus-get-function gnus-command-method 'retrieve-groups) | |
301 groups (nth 1 gnus-command-method))) | |
267 | 302 |
268 (defun gnus-request-type (group &optional article) | 303 (defun gnus-request-type (group &optional article) |
269 "Return the type (`post' or `mail') of GROUP (and ARTICLE)." | 304 "Return the type (`post' or `mail') of GROUP (and ARTICLE)." |
270 (let ((method (gnus-find-method-for-group group))) | 305 (let ((gnus-command-method (gnus-find-method-for-group group))) |
271 (if (not (gnus-check-backend-function 'request-type (car method))) | 306 (if (not (gnus-check-backend-function |
307 'request-type (car gnus-command-method))) | |
272 'unknown | 308 'unknown |
273 (funcall (gnus-get-function method 'request-type) | 309 (funcall (gnus-get-function gnus-command-method 'request-type) |
274 (gnus-group-real-name group) article)))) | 310 (gnus-group-real-name group) article)))) |
275 | 311 |
276 (defun gnus-request-update-mark (group article mark) | 312 (defun gnus-request-update-mark (group article mark) |
277 "Return the type (`post' or `mail') of GROUP (and ARTICLE)." | 313 "Allow the backend to change the mark the user tries to put on an article." |
278 (let ((method (gnus-find-method-for-group group))) | 314 (let ((gnus-command-method (gnus-find-method-for-group group))) |
279 (if (not (gnus-check-backend-function 'request-update-mark (car method))) | 315 (if (not (gnus-check-backend-function |
316 'request-update-mark (car gnus-command-method))) | |
280 mark | 317 mark |
281 (funcall (gnus-get-function method 'request-update-mark) | 318 (funcall (gnus-get-function gnus-command-method 'request-update-mark) |
282 (gnus-group-real-name group) article mark)))) | 319 (gnus-group-real-name group) article mark)))) |
283 | 320 |
284 (defun gnus-request-article (article group &optional buffer) | 321 (defun gnus-request-article (article group &optional buffer) |
285 "Request the ARTICLE in GROUP. | 322 "Request the ARTICLE in GROUP. |
286 ARTICLE can either be an article number or an article Message-ID. | 323 ARTICLE can either be an article number or an article Message-ID. |
287 If BUFFER, insert the article in that group." | 324 If BUFFER, insert the article in that group." |
288 (let ((method (gnus-find-method-for-group group))) | 325 (let ((gnus-command-method (gnus-find-method-for-group group))) |
289 (funcall (gnus-get-function method 'request-article) | 326 (funcall (gnus-get-function gnus-command-method 'request-article) |
290 article (gnus-group-real-name group) (nth 1 method) buffer))) | 327 article (gnus-group-real-name group) |
328 (nth 1 gnus-command-method) buffer))) | |
291 | 329 |
292 (defun gnus-request-head (article group) | 330 (defun gnus-request-head (article group) |
293 "Request the head of ARTICLE in GROUP." | 331 "Request the head of ARTICLE in GROUP." |
294 (let* ((method (gnus-find-method-for-group group)) | 332 (let* ((gnus-command-method (gnus-find-method-for-group group)) |
295 (head (gnus-get-function method 'request-head t)) | 333 (head (gnus-get-function gnus-command-method 'request-head t)) |
296 res clean-up) | 334 res clean-up) |
297 (cond | 335 (cond |
298 ;; Check the cache. | 336 ;; Check the cache. |
299 ((and gnus-use-cache | 337 ((and gnus-use-cache |
300 (numberp article) | 338 (numberp article) |
302 (setq res (cons group article) | 340 (setq res (cons group article) |
303 clean-up t)) | 341 clean-up t)) |
304 ;; Use `head' function. | 342 ;; Use `head' function. |
305 ((fboundp head) | 343 ((fboundp head) |
306 (setq res (funcall head article (gnus-group-real-name group) | 344 (setq res (funcall head article (gnus-group-real-name group) |
307 (nth 1 method)))) | 345 (nth 1 gnus-command-method)))) |
308 ;; Use `article' function. | 346 ;; Use `article' function. |
309 (t | 347 (t |
310 (setq res (gnus-request-article article group) | 348 (setq res (gnus-request-article article group) |
311 clean-up t))) | 349 clean-up t))) |
312 (when clean-up | 350 (when clean-up |
318 (nnheader-fold-continuation-lines))) | 356 (nnheader-fold-continuation-lines))) |
319 res)) | 357 res)) |
320 | 358 |
321 (defun gnus-request-body (article group) | 359 (defun gnus-request-body (article group) |
322 "Request the body of ARTICLE in GROUP." | 360 "Request the body of ARTICLE in GROUP." |
323 (let ((method (gnus-find-method-for-group group))) | 361 (let* ((gnus-command-method (gnus-find-method-for-group group)) |
324 (funcall (gnus-get-function method 'request-body) | 362 (head (gnus-get-function gnus-command-method 'request-body t)) |
325 article (gnus-group-real-name group) (nth 1 method)))) | 363 res clean-up) |
326 | 364 (cond |
327 (defun gnus-request-post (method) | 365 ;; Check the cache. |
328 "Post the current buffer using METHOD." | 366 ((and gnus-use-cache |
329 (when (stringp method) | 367 (numberp article) |
330 (setq method (gnus-server-to-method method))) | 368 (gnus-cache-request-article article group)) |
331 (funcall (gnus-get-function method 'request-post) (nth 1 method))) | 369 (setq res (cons group article) |
332 | 370 clean-up t)) |
333 (defun gnus-request-scan (group method) | 371 ;; Use `head' function. |
334 "Request a SCAN being performed in GROUP from METHOD. | 372 ((fboundp head) |
335 If GROUP is nil, all groups on METHOD are scanned." | 373 (setq res (funcall head article (gnus-group-real-name group) |
336 (let ((method (if group (gnus-find-method-for-group group) method)) | 374 (nth 1 gnus-command-method)))) |
337 (gnus-inhibit-demon t)) | 375 ;; Use `article' function. |
338 (funcall (gnus-get-function method 'request-scan) | 376 (t |
339 (and group (gnus-group-real-name group)) (nth 1 method)))) | 377 (setq res (gnus-request-article article group) |
340 | 378 clean-up t))) |
341 (defsubst gnus-request-update-info (info method) | 379 (when clean-up |
342 "Request that METHOD update INFO." | 380 (save-excursion |
343 (when (stringp method) | 381 (set-buffer nntp-server-buffer) |
344 (setq method (gnus-server-to-method method))) | 382 (goto-char (point-min)) |
345 (when (gnus-check-backend-function 'request-update-info (car method)) | 383 (when (search-forward "\n\n" nil t) |
346 (funcall (gnus-get-function method 'request-update-info) | 384 (delete-region (point-min) (1- (point)))))) |
385 res)) | |
386 | |
387 (defun gnus-request-post (gnus-command-method) | |
388 "Post the current buffer using GNUS-COMMAND-METHOD." | |
389 (when (stringp gnus-command-method) | |
390 (setq gnus-command-method (gnus-server-to-method gnus-command-method))) | |
391 (funcall (gnus-get-function gnus-command-method 'request-post) | |
392 (nth 1 gnus-command-method))) | |
393 | |
394 (defun gnus-request-scan (group gnus-command-method) | |
395 "Request a SCAN being performed in GROUP from GNUS-COMMAND-METHOD. | |
396 If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." | |
397 (when gnus-plugged | |
398 (let ((gnus-command-method | |
399 (if group (gnus-find-method-for-group group) gnus-command-method)) | |
400 (gnus-inhibit-demon t)) | |
401 (funcall (gnus-get-function gnus-command-method 'request-scan) | |
402 (and group (gnus-group-real-name group)) | |
403 (nth 1 gnus-command-method))))) | |
404 | |
405 (defsubst gnus-request-update-info (info gnus-command-method) | |
406 "Request that GNUS-COMMAND-METHOD update INFO." | |
407 (when (stringp gnus-command-method) | |
408 (setq gnus-command-method (gnus-server-to-method gnus-command-method))) | |
409 (when (gnus-check-backend-function | |
410 'request-update-info (car gnus-command-method)) | |
411 (funcall (gnus-get-function gnus-command-method 'request-update-info) | |
347 (gnus-group-real-name (gnus-info-group info)) | 412 (gnus-group-real-name (gnus-info-group info)) |
348 info (nth 1 method)))) | 413 info (nth 1 gnus-command-method)))) |
349 | 414 |
350 (defun gnus-request-expire-articles (articles group &optional force) | 415 (defun gnus-request-expire-articles (articles group &optional force) |
351 (let ((method (gnus-find-method-for-group group))) | 416 (let ((gnus-command-method (gnus-find-method-for-group group))) |
352 (funcall (gnus-get-function method 'request-expire-articles) | 417 (funcall (gnus-get-function gnus-command-method 'request-expire-articles) |
353 articles (gnus-group-real-name group) (nth 1 method) | 418 articles (gnus-group-real-name group) (nth 1 gnus-command-method) |
354 force))) | 419 force))) |
355 | 420 |
356 (defun gnus-request-move-article | 421 (defun gnus-request-move-article |
357 (article group server accept-function &optional last) | 422 (article group server accept-function &optional last) |
358 (let ((method (gnus-find-method-for-group group))) | 423 (let ((gnus-command-method (gnus-find-method-for-group group))) |
359 (funcall (gnus-get-function method 'request-move-article) | 424 (funcall (gnus-get-function gnus-command-method 'request-move-article) |
360 article (gnus-group-real-name group) | 425 article (gnus-group-real-name group) |
361 (nth 1 method) accept-function last))) | 426 (nth 1 gnus-command-method) accept-function last))) |
362 | 427 |
363 (defun gnus-request-accept-article (group method &optional last) | 428 (defun gnus-request-accept-article (group &optional gnus-command-method last) |
364 ;; Make sure there's a newline at the end of the article. | 429 ;; Make sure there's a newline at the end of the article. |
365 (when (stringp method) | 430 (when (stringp gnus-command-method) |
366 (setq method (gnus-server-to-method method))) | 431 (setq gnus-command-method (gnus-server-to-method gnus-command-method))) |
367 (when (and (not method) | 432 (when (and (not gnus-command-method) |
368 (stringp group)) | 433 (stringp group)) |
369 (setq method (gnus-group-name-to-method group))) | 434 (setq gnus-command-method (gnus-group-name-to-method group))) |
370 (goto-char (point-max)) | 435 (goto-char (point-max)) |
371 (unless (bolp) | 436 (unless (bolp) |
372 (insert "\n")) | 437 (insert "\n")) |
373 (let ((func (car (or method (gnus-find-method-for-group group))))) | 438 (let ((func (car (or gnus-command-method |
439 (gnus-find-method-for-group group))))) | |
374 (funcall (intern (format "%s-request-accept-article" func)) | 440 (funcall (intern (format "%s-request-accept-article" func)) |
375 (if (stringp group) (gnus-group-real-name group) group) | 441 (if (stringp group) (gnus-group-real-name group) group) |
376 (cadr method) | 442 (cadr gnus-command-method) |
377 last))) | 443 last))) |
378 | 444 |
379 (defun gnus-request-replace-article (article group buffer) | 445 (defun gnus-request-replace-article (article group buffer) |
380 (let ((func (car (gnus-group-name-to-method group)))) | 446 (let ((func (car (gnus-group-name-to-method group)))) |
381 (funcall (intern (format "%s-request-replace-article" func)) | 447 (funcall (intern (format "%s-request-replace-article" func)) |
382 article (gnus-group-real-name group) buffer))) | 448 article (gnus-group-real-name group) buffer))) |
383 | 449 |
384 (defun gnus-request-associate-buffer (group) | 450 (defun gnus-request-associate-buffer (group) |
385 (let ((method (gnus-find-method-for-group group))) | 451 (let ((gnus-command-method (gnus-find-method-for-group group))) |
386 (funcall (gnus-get-function method 'request-associate-buffer) | 452 (funcall (gnus-get-function gnus-command-method 'request-associate-buffer) |
387 (gnus-group-real-name group)))) | 453 (gnus-group-real-name group)))) |
388 | 454 |
389 (defun gnus-request-restore-buffer (article group) | 455 (defun gnus-request-restore-buffer (article group) |
390 "Request a new buffer restored to the state of ARTICLE." | 456 "Request a new buffer restored to the state of ARTICLE." |
391 (let ((method (gnus-find-method-for-group group))) | 457 (let ((gnus-command-method (gnus-find-method-for-group group))) |
392 (funcall (gnus-get-function method 'request-restore-buffer) | 458 (funcall (gnus-get-function gnus-command-method 'request-restore-buffer) |
393 article (gnus-group-real-name group) (nth 1 method)))) | 459 article (gnus-group-real-name group) |
394 | 460 (nth 1 gnus-command-method)))) |
395 (defun gnus-request-create-group (group &optional method args) | 461 |
396 (when (stringp method) | 462 (defun gnus-request-create-group (group &optional gnus-command-method args) |
397 (setq method (gnus-server-to-method method))) | 463 (when (stringp gnus-command-method) |
398 (let ((method (or method (gnus-find-method-for-group group)))) | 464 (setq gnus-command-method (gnus-server-to-method gnus-command-method))) |
399 (funcall (gnus-get-function method 'request-create-group) | 465 (let ((gnus-command-method |
400 (gnus-group-real-name group) (nth 1 method) args))) | 466 (or gnus-command-method (gnus-find-method-for-group group)))) |
467 (funcall (gnus-get-function gnus-command-method 'request-create-group) | |
468 (gnus-group-real-name group) (nth 1 gnus-command-method) args))) | |
401 | 469 |
402 (defun gnus-request-delete-group (group &optional force) | 470 (defun gnus-request-delete-group (group &optional force) |
403 (let ((method (gnus-find-method-for-group group))) | 471 (let ((gnus-command-method (gnus-find-method-for-group group))) |
404 (funcall (gnus-get-function method 'request-delete-group) | 472 (funcall (gnus-get-function gnus-command-method 'request-delete-group) |
405 (gnus-group-real-name group) force (nth 1 method)))) | 473 (gnus-group-real-name group) force (nth 1 gnus-command-method)))) |
406 | 474 |
407 (defun gnus-request-rename-group (group new-name) | 475 (defun gnus-request-rename-group (group new-name) |
408 (let ((method (gnus-find-method-for-group group))) | 476 (let ((gnus-command-method (gnus-find-method-for-group group))) |
409 (funcall (gnus-get-function method 'request-rename-group) | 477 (funcall (gnus-get-function gnus-command-method 'request-rename-group) |
410 (gnus-group-real-name group) | 478 (gnus-group-real-name group) |
411 (gnus-group-real-name new-name) (nth 1 method)))) | 479 (gnus-group-real-name new-name) (nth 1 gnus-command-method)))) |
412 | 480 |
413 (defun gnus-close-backends () | 481 (defun gnus-close-backends () |
414 ;; Send a close request to all backends that support such a request. | 482 ;; Send a close request to all backends that support such a request. |
415 (let ((methods gnus-valid-select-methods) | 483 (let ((methods gnus-valid-select-methods) |
416 (gnus-inhibit-demon t) | 484 (gnus-inhibit-demon t) |
417 func method) | 485 func gnus-command-method) |
418 (while (setq method (pop methods)) | 486 (while (setq gnus-command-method (pop methods)) |
419 (when (fboundp (setq func (intern | 487 (when (fboundp (setq func (intern |
420 (concat (car method) "-request-close")))) | 488 (concat (car gnus-command-method) |
489 "-request-close")))) | |
421 (funcall func))))) | 490 (funcall func))))) |
422 | 491 |
423 (defun gnus-asynchronous-p (method) | 492 (defun gnus-asynchronous-p (gnus-command-method) |
424 (let ((func (gnus-get-function method 'asynchronous-p t))) | 493 (let ((func (gnus-get-function gnus-command-method 'asynchronous-p t))) |
425 (when (fboundp func) | 494 (when (fboundp func) |
426 (funcall func)))) | 495 (funcall func)))) |
427 | 496 |
428 (defun gnus-remove-denial (method) | 497 (defun gnus-remove-denial (gnus-command-method) |
429 (when (stringp method) | 498 (when (stringp gnus-command-method) |
430 (setq method (gnus-server-to-method method))) | 499 (setq gnus-command-method (gnus-server-to-method gnus-command-method))) |
431 (let* ((elem (assoc method gnus-opened-servers)) | 500 (let* ((elem (assoc gnus-command-method gnus-opened-servers)) |
432 (status (cadr elem))) | 501 (status (cadr elem))) |
433 ;; If this hasn't been opened before, we add it to the list. | 502 ;; If this hasn't been opened before, we add it to the list. |
434 (when (eq status 'denied) | 503 (when (eq status 'denied) |
435 ;; Set the status of this server. | 504 ;; Set the status of this server. |
436 (setcar (cdr elem) 'closed)))) | 505 (setcar (cdr elem) 'closed)))) |