Mercurial > emacs

comparison lisp/gnus/gnus-int.el @ 24357:15fc6acbae7a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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))))