cgit.sxemacs.org Git - gnus/blob - lisp/gnus-int.el

   1 ;;; gnus-int.el --- backend interface functions for Gnus
   2 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002
   3 ;;        Free Software Foundation, Inc.
   4
   5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   6 ;; Keywords: news
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  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
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  26
  27 ;;; Code:
  28
  29 (eval-when-compile (require 'cl))
  30
  31 (require 'gnus)
  32
  33 (defcustom gnus-open-server-hook nil
  34   "Hook called just before opening connection to the news server."
  35   :group 'gnus-start
  36   :type 'hook)
  37
  38 (defvar gnus-server-unopen-status nil
  39   "The default status if the server is not able to open.
  40 If the server is covered by Gnus agent, the possible values are
  41 `denied', set the server denied; `offline', set the server offline;
  42 `nil', ask user.  If the server is not covered by Gnus agent, set the
  43 server denied.")
  44
  45 ;;;
  46 ;;; Server Communication
  47 ;;;
  48
  49 (defun gnus-start-news-server (&optional confirm)
  50   "Open a method for getting news.
  51 If CONFIRM is non-nil, the user will be asked for an NNTP server."
  52   (let (how)
  53     (if gnus-current-select-method
  54         ;; Stream is already opened.
  55         nil
  56       ;; Open NNTP server.
  57       (unless gnus-nntp-service
  58         (setq gnus-nntp-server nil))
  59       (when confirm
  60         ;; Read server name with completion.
  61         (setq gnus-nntp-server
  62               (completing-read "NNTP server: "
  63                                (mapcar (lambda (server) (list server))
  64                                        (cons (list gnus-nntp-server)
  65                                              gnus-secondary-servers))
  66                                nil nil gnus-nntp-server)))
  67
  68       (when (and gnus-nntp-server
  69                  (stringp gnus-nntp-server)
  70                  (not (string= gnus-nntp-server "")))
  71         (setq gnus-select-method
  72               (cond ((or (string= gnus-nntp-server "")
  73                          (string= gnus-nntp-server "::"))
  74                      (list 'nnspool (system-name)))
  75                     ((string-match "^:" gnus-nntp-server)
  76                      (list 'nnmh gnus-nntp-server
  77                            (list 'nnmh-directory
  78                                  (file-name-as-directory
  79                                   (expand-file-name
  80                                    (substring gnus-nntp-server 1) "~/")))
  81                            (list 'nnmh-get-new-mail nil)))
  82                     (t
  83                      (list 'nntp gnus-nntp-server)))))
  84
  85       (setq how (car gnus-select-method))
  86       (cond
  87        ((eq how 'nnspool)
  88         (require 'nnspool)
  89         (gnus-message 5 "Looking up local news spool..."))
  90        ((eq how 'nnmh)
  91         (require 'nnmh)
  92         (gnus-message 5 "Looking up mh spool..."))
  93        (t
  94         (require 'nntp)))
  95       (setq gnus-current-select-method gnus-select-method)
  96       (gnus-run-hooks 'gnus-open-server-hook)
  97       (or
  98        ;; gnus-open-server-hook might have opened it
  99        (gnus-server-opened gnus-select-method)
 100        (gnus-open-server gnus-select-method)
 101        gnus-batch-mode
 102        (gnus-y-or-n-p
 103         (format
 104          "%s (%s) open error: '%s'.  Continue? "
 105          (car gnus-select-method) (cadr gnus-select-method)
 106          (gnus-status-message gnus-select-method)))
 107        (gnus-error 1 "Couldn't open server on %s"
 108                    (nth 1 gnus-select-method))))))
 109
 110 (defun gnus-check-group (group)
 111   "Try to make sure that the server where GROUP exists is alive."
 112   (let ((method (gnus-find-method-for-group group)))
 113     (or (gnus-server-opened method)
 114         (gnus-open-server method))))
 115
 116 (defun gnus-check-server (&optional method silent)
 117   "Check whether the connection to METHOD is down.
 118 If METHOD is nil, use `gnus-select-method'.
 119 If it is down, start it up (again)."
 120   (let ((method (or method gnus-select-method))
 121         result)
 122     ;; Transform virtual server names into select methods.
 123     (when (stringp method)
 124       (setq method (gnus-server-to-method method)))
 125     (if (gnus-server-opened method)
 126         ;; The stream is already opened.
 127         t
 128       ;; Open the server.
 129       (unless silent
 130         (gnus-message 5 "Opening %s server%s..." (car method)
 131                       (if (equal (nth 1 method) "") ""
 132                         (format " on %s" (nth 1 method)))))
 133       (gnus-run-hooks 'gnus-open-server-hook)
 134       (prog1
 135           (condition-case ()
 136               (setq result (gnus-open-server method))
 137             (quit (message "Quit gnus-check-server")
 138                   nil))
 139         (unless silent
 140           (gnus-message 5 "Opening %s server%s...%s" (car method)
 141                         (if (equal (nth 1 method) "") ""
 142                           (format " on %s" (nth 1 method)))
 143                         (if result "done" "failed")))))))
 144
 145 (defun gnus-get-function (method function &optional noerror)
 146   "Return a function symbol based on METHOD and FUNCTION."
 147   ;; Translate server names into methods.
 148   (unless method
 149     (error "Attempted use of a nil select method"))
 150   (when (stringp method)
 151     (setq method (gnus-server-to-method method)))
 152   ;; Check cache of constructed names.
 153   (let* ((method-sym (if gnus-agent
 154                          (gnus-agent-get-function method)
 155                        (car method)))
 156          (method-fns (get method-sym 'gnus-method-functions))
 157          (func (let ((method-fnlist-elt (assq function method-fns)))
 158                  (unless method-fnlist-elt
 159                    (setq method-fnlist-elt
 160                          (cons function
 161                                (intern (format "%s-%s" method-sym function))))
 162                    (put method-sym 'gnus-method-functions
 163                         (cons method-fnlist-elt method-fns)))
 164                  (cdr method-fnlist-elt))))
 165     ;; Maybe complain if there is no function.
 166     (unless (fboundp func)
 167       (unless (car method)
 168         (error "Trying to require a method that doesn't exist"))
 169       (require (car method))
 170       (when (not (fboundp func))
 171         (if noerror
 172             (setq func nil)
 173           (error "No such function: %s" func))))
 174     func))
 175
 176 \f
 177 ;;;
 178 ;;; Interface functions to the backends.
 179 ;;;
 180
 181 (defun gnus-open-server (gnus-command-method)
 182   "Open a connection to GNUS-COMMAND-METHOD."
 183   (when (stringp gnus-command-method)
 184     (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
 185   (let ((elem (assoc gnus-command-method gnus-opened-servers)))
 186     ;; If this method was previously denied, we just return nil.
 187     (if (eq (nth 1 elem) 'denied)
 188         (progn
 189           (gnus-message 1 "Denied server")
 190           nil)
 191       ;; Open the server.
 192       (let ((result
 193              (condition-case ()
 194                  (funcall (gnus-get-function gnus-command-method 'open-server)
 195                           (nth 1 gnus-command-method)
 196                           (nthcdr 2 gnus-command-method))
 197                (quit
 198                 (message "Quit trying to open server")
 199                 nil))))
 200         ;; If this hasn't been opened before, we add it to the list.
 201         (unless elem
 202           (setq elem (list gnus-command-method nil)
 203                 gnus-opened-servers (cons elem gnus-opened-servers)))
 204         ;; Set the status of this server.
 205         (setcar (cdr elem)
 206                 (if result
 207                     (if (eq (cadr elem) 'offline)
 208                         'offline
 209                       'ok)
 210                   (if (and gnus-agent
 211                            (not (eq (cadr elem) 'offline))
 212                            (gnus-agent-method-p gnus-command-method))
 213                       (or gnus-server-unopen-status
 214                           (if (gnus-y-or-n-p
 215                                (format "Unable to open %s:%s, go offline? "
 216                                        (car gnus-command-method)
 217                                        (cadr gnus-command-method)))
 218                               'offline
 219                             'denied))
 220                     'denied)))
 221         ;; Return the result from the "open" call.
 222         (or (eq (cadr elem) 'offline)
 223             result)))))
 224
 225 (defun gnus-close-server (gnus-command-method)
 226   "Close the connection to GNUS-COMMAND-METHOD."
 227   (when (stringp gnus-command-method)
 228     (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
 229   (funcall (gnus-get-function gnus-command-method 'close-server)
 230            (nth 1 gnus-command-method)))
 231
 232 (defun gnus-request-list (gnus-command-method)
 233   "Request the active file from GNUS-COMMAND-METHOD."
 234   (when (stringp gnus-command-method)
 235     (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
 236   (funcall (gnus-get-function gnus-command-method 'request-list)
 237            (nth 1 gnus-command-method)))
 238
 239 (defun gnus-request-list-newsgroups (gnus-command-method)
 240   "Request the newsgroups file from GNUS-COMMAND-METHOD."
 241   (when (stringp gnus-command-method)
 242     (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
 243   (funcall (gnus-get-function gnus-command-method 'request-list-newsgroups)
 244            (nth 1 gnus-command-method)))
 245
 246 (defun gnus-request-newgroups (date gnus-command-method)
 247   "Request all new groups since DATE from GNUS-COMMAND-METHOD."
 248   (when (stringp gnus-command-method)
 249     (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
 250   (let ((func (gnus-get-function gnus-command-method 'request-newgroups t)))
 251     (when func
 252       (funcall func date (nth 1 gnus-command-method)))))
 253
 254 (defun gnus-server-opened (gnus-command-method)
 255   "Check whether a connection to GNUS-COMMAND-METHOD has been opened."
 256   (unless (eq (gnus-server-status gnus-command-method)
 257               'denied)
 258     (when (stringp gnus-command-method)
 259       (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
 260     (funcall (inline (gnus-get-function gnus-command-method 'server-opened))
 261              (nth 1 gnus-command-method))))
 262
 263 (defun gnus-status-message (gnus-command-method)
 264   "Return the status message from GNUS-COMMAND-METHOD.
 265 If GNUS-COMMAND-METHOD is a string, it is interpreted as a group name.   The method
 266 this group uses will be queried."
 267   (let ((gnus-command-method
 268          (if (stringp gnus-command-method)
 269              (gnus-find-method-for-group gnus-command-method)
 270            gnus-command-method)))
 271     (funcall (gnus-get-function gnus-command-method 'status-message)
 272              (nth 1 gnus-command-method))))
 273
 274 (defun gnus-request-regenerate (gnus-command-method)
 275   "Request a data generation from GNUS-COMMAND-METHOD."
 276   (when (stringp gnus-command-method)
 277     (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
 278   (funcall (gnus-get-function gnus-command-method 'request-regenerate)
 279            (nth 1 gnus-command-method)))
 280
 281 (defun gnus-request-group (group &optional dont-check gnus-command-method)
 282   "Request GROUP.  If DONT-CHECK, no information is required."
 283   (let ((gnus-command-method
 284          (or gnus-command-method (inline (gnus-find-method-for-group group)))))
 285     (when (stringp gnus-command-method)
 286       (setq gnus-command-method
 287             (inline (gnus-server-to-method gnus-command-method))))
 288     (funcall (inline (gnus-get-function gnus-command-method 'request-group))
 289              (gnus-group-real-name group) (nth 1 gnus-command-method)
 290              dont-check)))
 291
 292 (defun gnus-list-active-group (group)
 293   "Request active information on GROUP."
 294   (let ((gnus-command-method (gnus-find-method-for-group group))
 295         (func 'list-active-group))
 296     (when (gnus-check-backend-function func group)
 297       (funcall (gnus-get-function gnus-command-method func)
 298                (gnus-group-real-name group) (nth 1 gnus-command-method)))))
 299
 300 (defun gnus-request-group-description (group)
 301   "Request a description of GROUP."
 302   (let ((gnus-command-method (gnus-find-method-for-group group))
 303         (func 'request-group-description))
 304     (when (gnus-check-backend-function func group)
 305       (funcall (gnus-get-function gnus-command-method func)
 306                (gnus-group-real-name group) (nth 1 gnus-command-method)))))
 307
 308 (defun gnus-request-group-articles (group)
 309   "Request a list of existing articles in GROUP."
 310   (let ((gnus-command-method (gnus-find-method-for-group group))
 311         (func 'request-group-articles))
 312     (when (gnus-check-backend-function func group)
 313       (funcall (gnus-get-function gnus-command-method func)
 314                (gnus-group-real-name group) (nth 1 gnus-command-method)))))
 315
 316 (defun gnus-close-group (group)
 317   "Request the GROUP be closed."
 318   (let ((gnus-command-method (inline (gnus-find-method-for-group group))))
 319     (funcall (gnus-get-function gnus-command-method 'close-group)
 320              (gnus-group-real-name group) (nth 1 gnus-command-method))))
 321
 322 (defun gnus-retrieve-headers (articles group &optional fetch-old)
 323   "Request headers for ARTICLES in GROUP.
 324 If FETCH-OLD, retrieve all headers (or some subset thereof) in the group."
 325   (let ((gnus-command-method (gnus-find-method-for-group group)))
 326     (cond
 327      ((and gnus-use-cache (numberp (car articles)))
 328       (gnus-cache-retrieve-headers articles group fetch-old))
 329      ((and gnus-agent gnus-agent-cache (gnus-online gnus-command-method)
 330            (gnus-agent-method-p gnus-command-method))
 331       (gnus-agent-retrieve-headers articles group fetch-old))
 332      (t
 333       (funcall (gnus-get-function gnus-command-method 'retrieve-headers)
 334                articles (gnus-group-real-name group)
 335                (nth 1 gnus-command-method) fetch-old)))))
 336
 337 (defun gnus-retrieve-articles (articles group)
 338   "Request ARTICLES in GROUP."
 339   (let ((gnus-command-method (gnus-find-method-for-group group)))
 340     (funcall (gnus-get-function gnus-command-method 'retrieve-articles)
 341              articles (gnus-group-real-name group)
 342              (nth 1 gnus-command-method))))
 343
 344 (defun gnus-retrieve-groups (groups gnus-command-method)
 345   "Request active information on GROUPS from GNUS-COMMAND-METHOD."
 346   (when (stringp gnus-command-method)
 347     (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
 348   (funcall (gnus-get-function gnus-command-method 'retrieve-groups)
 349            groups (nth 1 gnus-command-method)))
 350
 351 (defun gnus-request-type (group &optional article)
 352   "Return the type (`post' or `mail') of GROUP (and ARTICLE)."
 353   (let ((gnus-command-method (gnus-find-method-for-group group)))
 354     (if (not (gnus-check-backend-function
 355               'request-type (car gnus-command-method)))
 356         'unknown
 357       (funcall (gnus-get-function gnus-command-method 'request-type)
 358                (gnus-group-real-name group) article))))
 359
 360 (defun gnus-request-set-mark (group action)
 361   "Set marks on articles in the backend."
 362   (let ((gnus-command-method (gnus-find-method-for-group group)))
 363     (if (not (gnus-check-backend-function
 364               'request-set-mark (car gnus-command-method)))
 365         action
 366       (funcall (gnus-get-function gnus-command-method 'request-set-mark)
 367                (gnus-group-real-name group) action
 368                (nth 1 gnus-command-method)))))
 369
 370 (defun gnus-request-update-mark (group article mark)
 371   "Allow the backend to change the mark the user tries to put on an article."
 372   (let ((gnus-command-method (gnus-find-method-for-group group)))
 373     (if (not (gnus-check-backend-function
 374               'request-update-mark (car gnus-command-method)))
 375         mark
 376       (funcall (gnus-get-function gnus-command-method 'request-update-mark)
 377                (gnus-group-real-name group) article mark))))
 378
 379 (defun gnus-request-article (article group &optional buffer)
 380   "Request the ARTICLE in GROUP.
 381 ARTICLE can either be an article number or an article Message-ID.
 382 If BUFFER, insert the article in that group."
 383   (let ((gnus-command-method (gnus-find-method-for-group group)))
 384     (funcall (gnus-get-function gnus-command-method 'request-article)
 385              article (gnus-group-real-name group)
 386              (nth 1 gnus-command-method) buffer)))
 387
 388 (defun gnus-request-head (article group)
 389   "Request the head of ARTICLE in GROUP."
 390   (let* ((gnus-command-method (gnus-find-method-for-group group))
 391          (head (gnus-get-function gnus-command-method 'request-head t))
 392          res clean-up)
 393     (cond
 394      ;; Check the cache.
 395      ((and gnus-use-cache
 396            (numberp article)
 397            (gnus-cache-request-article article group))
 398       (setq res (cons group article)
 399             clean-up t))
 400      ;; Check the agent cache.
 401      ((and gnus-agent gnus-agent-cache gnus-plugged
 402            (numberp article)
 403            (gnus-agent-request-article article group))
 404       (setq res (cons group article)
 405             clean-up t))
 406      ;; Use `head' function.
 407      ((fboundp head)
 408       (setq res (funcall head article (gnus-group-real-name group)
 409                          (nth 1 gnus-command-method))))
 410      ;; Use `article' function.
 411      (t
 412       (setq res (gnus-request-article article group)
 413             clean-up t)))
 414     (when clean-up
 415       (save-excursion
 416         (set-buffer nntp-server-buffer)
 417         (goto-char (point-min))
 418         (when (search-forward "\n\n" nil t)
 419           (delete-region (1- (point)) (point-max)))
 420         (nnheader-fold-continuation-lines)))
 421     res))
 422
 423 (defun gnus-request-body (article group)
 424   "Request the body of ARTICLE in GROUP."
 425   (let* ((gnus-command-method (gnus-find-method-for-group group))
 426          (head (gnus-get-function gnus-command-method 'request-body t))
 427          res clean-up)
 428     (cond
 429      ;; Check the cache.
 430      ((and gnus-use-cache
 431            (numberp article)
 432            (gnus-cache-request-article article group))
 433       (setq res (cons group article)
 434             clean-up t))
 435      ;; Check the agent cache.
 436      ((and gnus-agent gnus-agent-cache gnus-plugged
 437            (numberp article)
 438            (gnus-agent-request-article article group))
 439       (setq res (cons group article)
 440             clean-up t))
 441      ;; Use `head' function.
 442      ((fboundp head)
 443       (setq res (funcall head article (gnus-group-real-name group)
 444                          (nth 1 gnus-command-method))))
 445      ;; Use `article' function.
 446      (t
 447       (setq res (gnus-request-article article group)
 448             clean-up t)))
 449     (when clean-up
 450       (save-excursion
 451         (set-buffer nntp-server-buffer)
 452         (goto-char (point-min))
 453         (when (search-forward "\n\n" nil t)
 454           (delete-region (point-min) (1- (point))))))
 455     res))
 456
 457 (defun gnus-request-post (gnus-command-method)
 458   "Post the current buffer using GNUS-COMMAND-METHOD."
 459   (when (stringp gnus-command-method)
 460     (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
 461   (funcall (gnus-get-function gnus-command-method 'request-post)
 462            (nth 1 gnus-command-method)))
 463
 464 (defun gnus-request-scan (group gnus-command-method)
 465   "Request a SCAN being performed in GROUP from GNUS-COMMAND-METHOD.
 466 If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
 467   (let ((gnus-command-method
 468          (if group (gnus-find-method-for-group group) gnus-command-method))
 469         (gnus-inhibit-demon t)
 470         (mail-source-plugged gnus-plugged))
 471     (if (or gnus-plugged (not (gnus-agent-method-p gnus-command-method)))
 472         (funcall (gnus-get-function gnus-command-method 'request-scan)
 473                  (and group (gnus-group-real-name group))
 474                  (nth 1 gnus-command-method)))))
 475
 476 (defsubst gnus-request-update-info (info gnus-command-method)
 477   "Request that GNUS-COMMAND-METHOD update INFO."
 478   (when (stringp gnus-command-method)
 479     (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
 480   (when (gnus-check-backend-function
 481          'request-update-info (car gnus-command-method))
 482     (funcall (gnus-get-function gnus-command-method 'request-update-info)
 483              (gnus-group-real-name (gnus-info-group info))
 484              info (nth 1 gnus-command-method))))
 485
 486 (defun gnus-request-expire-articles (articles group &optional force)
 487   (let* ((gnus-command-method (gnus-find-method-for-group group))
 488          (not-deleted
 489           (funcall
 490            (gnus-get-function gnus-command-method 'request-expire-articles)
 491            articles (gnus-group-real-name group) (nth 1 gnus-command-method)
 492            force)))
 493     (when (and gnus-agent gnus-agent-cache
 494                (gnus-sorted-difference articles not-deleted))
 495       (gnus-agent-expire (gnus-sorted-difference articles not-deleted)
 496                          group 'force))
 497     not-deleted))
 498
 499 (defun gnus-request-move-article (article group server accept-function &optional last)
 500   (let* ((gnus-command-method (gnus-find-method-for-group group))
 501          (result (funcall (gnus-get-function gnus-command-method 'request-move-article)
 502                           article (gnus-group-real-name group)
 503                           (nth 1 gnus-command-method) accept-function last)))
 504     (when (and result gnus-agent gnus-agent-cache)
 505       (gnus-agent-expire article group 'force))
 506     result))
 507
 508 (defun gnus-request-accept-article (group &optional gnus-command-method last
 509                                           no-encode)
 510   ;; Make sure there's a newline at the end of the article.
 511   (when (stringp gnus-command-method)
 512     (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
 513   (when (and (not gnus-command-method)
 514              (stringp group))
 515     (setq gnus-command-method (gnus-group-name-to-method group)))
 516   (goto-char (point-max))
 517   (unless (bolp)
 518     (insert "\n"))
 519   (unless no-encode
 520     (let ((message-options message-options))
 521       (message-options-set-recipient)
 522       (save-restriction
 523         (message-narrow-to-head)
 524         (let ((mail-parse-charset message-default-charset))
 525           (mail-encode-encoded-word-buffer)))
 526       (message-encode-message-body)))
 527   (let ((gnus-command-method (or gnus-command-method
 528                                  (gnus-find-method-for-group group))))
 529     (funcall (gnus-get-function gnus-command-method 'request-accept-article)
 530              (if (stringp group) (gnus-group-real-name group) group)
 531              (cadr gnus-command-method)
 532              last)))
 533
 534 (defun gnus-request-replace-article (article group buffer &optional no-encode)
 535   (unless no-encode
 536     (let ((message-options message-options))
 537       (message-options-set-recipient)
 538       (save-restriction
 539         (message-narrow-to-head)
 540         (let ((mail-parse-charset message-default-charset))
 541           (mail-encode-encoded-word-buffer)))
 542       (message-encode-message-body)))
 543   (let ((func (car (gnus-group-name-to-method group))))
 544     (funcall (intern (format "%s-request-replace-article" func))
 545              article (gnus-group-real-name group) buffer)))
 546
 547 (defun gnus-request-associate-buffer (group)
 548   (let ((gnus-command-method (gnus-find-method-for-group group)))
 549     (funcall (gnus-get-function gnus-command-method 'request-associate-buffer)
 550              (gnus-group-real-name group))))
 551
 552 (defun gnus-request-restore-buffer (article group)
 553   "Request a new buffer restored to the state of ARTICLE."
 554   (let ((gnus-command-method (gnus-find-method-for-group group)))
 555     (funcall (gnus-get-function gnus-command-method 'request-restore-buffer)
 556              article (gnus-group-real-name group)
 557              (nth 1 gnus-command-method))))
 558
 559 (defun gnus-request-create-group (group &optional gnus-command-method args)
 560   (when (stringp gnus-command-method)
 561     (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
 562   (let ((gnus-command-method
 563          (or gnus-command-method (gnus-find-method-for-group group))))
 564     (funcall (gnus-get-function gnus-command-method 'request-create-group)
 565              (gnus-group-real-name group) (nth 1 gnus-command-method) args)))
 566
 567 (defun gnus-request-delete-group (group &optional force)
 568   (let ((gnus-command-method (gnus-find-method-for-group group)))
 569     (funcall (gnus-get-function gnus-command-method 'request-delete-group)
 570              (gnus-group-real-name group) force (nth 1 gnus-command-method))))
 571
 572 (defun gnus-request-rename-group (group new-name)
 573   (let ((gnus-command-method (gnus-find-method-for-group group)))
 574     (funcall (gnus-get-function gnus-command-method 'request-rename-group)
 575              (gnus-group-real-name group)
 576              (gnus-group-real-name new-name) (nth 1 gnus-command-method))))
 577
 578 (defun gnus-close-backends ()
 579   ;; Send a close request to all backends that support such a request.
 580   (let ((methods gnus-valid-select-methods)
 581         (gnus-inhibit-demon t)
 582         func gnus-command-method)
 583     (while (setq gnus-command-method (pop methods))
 584       (when (fboundp (setq func (intern
 585                                  (concat (car gnus-command-method)
 586                                          "-request-close"))))
 587         (funcall func)))))
 588
 589 (defun gnus-asynchronous-p (gnus-command-method)
 590   (let ((func (gnus-get-function gnus-command-method 'asynchronous-p t)))
 591     (when (fboundp func)
 592       (funcall func))))
 593
 594 (defun gnus-remove-denial (gnus-command-method)
 595   (when (stringp gnus-command-method)
 596     (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
 597   (let* ((elem (assoc gnus-command-method gnus-opened-servers))
 598          (status (cadr elem)))
 599     ;; If this hasn't been opened before, we add it to the list.
 600     (when (eq status 'denied)
 601       ;; Set the status of this server.
 602       (setcar (cdr elem) 'closed))))
 603
 604 (provide 'gnus-int)
 605
 606 ;;; gnus-int.el ends here