-;;; gnus-int.el --- backend inteface functions for Gnus
-;; Copyright (C) 1996 Free Software Foundation, Inc.
+;;; gnus-int.el --- backend interface functions for Gnus
+;; Copyright (C) 1996,97 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
;; Keywords: news
;;; Code:
-(require 'gnus-load)
(require 'gnus)
-(defvar gnus-open-server-hook nil
- "*A hook called just before opening connection to the news server.")
+(defcustom gnus-open-server-hook nil
+ "Hook called just before opening connection to the news server."
+ :group 'gnus-start
+ :type 'hook)
;;;
;;; Server Communication
;; Stream is already opened.
nil
;; Open NNTP server.
- (if (null gnus-nntp-service) (setq gnus-nntp-server nil))
- (if confirm
- (progn
- ;; Read server name with completion.
- (setq gnus-nntp-server
- (completing-read "NNTP server: "
- (mapcar (lambda (server) (list server))
- (cons (list gnus-nntp-server)
- gnus-secondary-servers))
- nil nil gnus-nntp-server))))
-
- (if (and gnus-nntp-server
- (stringp gnus-nntp-server)
- (not (string= gnus-nntp-server "")))
- (setq gnus-select-method
- (cond ((or (string= gnus-nntp-server "")
- (string= gnus-nntp-server "::"))
- (list 'nnspool (system-name)))
- ((string-match "^:" gnus-nntp-server)
- (list 'nnmh gnus-nntp-server
- (list 'nnmh-directory
- (file-name-as-directory
- (expand-file-name
- (concat "~/" (substring
- gnus-nntp-server 1)))))
- (list 'nnmh-get-new-mail nil)))
- (t
- (list 'nntp gnus-nntp-server)))))
+ (unless gnus-nntp-service
+ (setq gnus-nntp-server nil))
+ (when confirm
+ ;; Read server name with completion.
+ (setq gnus-nntp-server
+ (completing-read "NNTP server: "
+ (mapcar (lambda (server) (list server))
+ (cons (list gnus-nntp-server)
+ gnus-secondary-servers))
+ nil nil gnus-nntp-server)))
+
+ (when (and gnus-nntp-server
+ (stringp gnus-nntp-server)
+ (not (string= gnus-nntp-server "")))
+ (setq gnus-select-method
+ (cond ((or (string= gnus-nntp-server "")
+ (string= gnus-nntp-server "::"))
+ (list 'nnspool (system-name)))
+ ((string-match "^:" gnus-nntp-server)
+ (list 'nnmh gnus-nntp-server
+ (list 'nnmh-directory
+ (file-name-as-directory
+ (expand-file-name
+ (concat "~/" (substring
+ gnus-nntp-server 1)))))
+ (list 'nnmh-get-new-mail nil)))
+ (t
+ (list 'nntp gnus-nntp-server)))))
(setq how (car gnus-select-method))
- (cond ((eq how 'nnspool)
- (require 'nnspool)
- (gnus-message 5 "Looking up local news spool..."))
- ((eq how 'nnmh)
- (require 'nnmh)
- (gnus-message 5 "Looking up mh spool..."))
- (t
- (require 'nntp)))
+ (cond
+ ((eq how 'nnspool)
+ (require 'nnspool)
+ (gnus-message 5 "Looking up local news spool..."))
+ ((eq how 'nnmh)
+ (require 'nnmh)
+ (gnus-message 5 "Looking up mh spool..."))
+ (t
+ (require 'nntp)))
(setq gnus-current-select-method gnus-select-method)
(run-hooks 'gnus-open-server-hook)
(or
"Request all new groups since DATE from METHOD."
(when (stringp method)
(setq method (gnus-server-to-method method)))
- (funcall (gnus-get-function method 'request-newgroups)
- date (nth 1 method)))
+ (let ((func (gnus-get-function method 'request-newgroups t)))
+ (when func
+ (funcall func date (nth 1 method)))))
(defun gnus-server-opened (method)
"Check whether a connection to METHOD has been opened."
method)))
(funcall (gnus-get-function method 'status-message) (nth 1 method))))
+(defun gnus-request-regenerate (method)
+ "Request a data generation from METHOD."
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
+ (funcall (gnus-get-function method 'request-regenerate) (nth 1 method)))
+
(defun gnus-request-group (group &optional dont-check method)
"Request GROUP. If DONT-CHECK, no information is required."
(let ((method (or method (gnus-find-method-for-group group))))
(defun gnus-request-head (article group)
"Request the head of ARTICLE in GROUP."
(let* ((method (gnus-find-method-for-group group))
- (head (gnus-get-function method 'request-head t)))
- (if (fboundp head)
- (funcall head article (gnus-group-real-name group) (nth 1 method))
- (let ((res (gnus-request-article article group)))
- (when res
- (save-excursion
- (set-buffer nntp-server-buffer)
- (goto-char (point-min))
- (when (search-forward "\n\n" nil t)
- (delete-region (1- (point)) (point-max)))
- (nnheader-fold-continuation-lines)))
- res))))
+ (head (gnus-get-function method 'request-head t))
+ res clean-up)
+ (cond
+ ;; Check the cache.
+ ((and gnus-use-cache
+ (numberp article)
+ (gnus-cache-request-article article group))
+ (setq res (cons group article)
+ clean-up t))
+ ;; Use `head' function.
+ ((fboundp head)
+ (setq res (funcall head article (gnus-group-real-name group)
+ (nth 1 method))))
+ ;; Use `article' function.
+ (t
+ (setq res (gnus-request-article article group)
+ clean-up t)))
+ (when clean-up
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (when (search-forward "\n\n" nil t)
+ (delete-region (1- (point)) (point-max)))
+ (nnheader-fold-continuation-lines)))
+ res))
(defun gnus-request-body (article group)
"Request the body of ARTICLE in GROUP."
(funcall (gnus-get-function method 'request-restore-buffer)
article (gnus-group-real-name group) (nth 1 method))))
-(defun gnus-request-create-group (group &optional method)
+(defun gnus-request-create-group (group &optional method args)
(when (stringp method)
(setq method (gnus-server-to-method method)))
(let ((method (or method (gnus-find-method-for-group group))))
(funcall (gnus-get-function method 'request-create-group)
- (gnus-group-real-name group) (nth 1 method))))
+ (gnus-group-real-name group) (nth 1 method) args)))
(defun gnus-request-delete-group (group &optional force)
(let ((method (gnus-find-method-for-group group)))
(defun gnus-close-backends ()
;; Send a close request to all backends that support such a request.
(let ((methods gnus-valid-select-methods)
- func)
- (while methods
- (if (fboundp (setq func (intern (concat (caar methods)
- "-request-close"))))
- (funcall func))
- (setq methods (cdr methods)))))
+ func method)
+ (while (setq method (pop methods))
+ (when (fboundp (setq func (intern
+ (concat (car method) "-request-close"))))
+ (funcall func)))))
(defun gnus-asynchronous-p (method)
(let ((func (gnus-get-function method 'asynchronous-p t)))
(when (fboundp func)
(funcall func))))
+(defun gnus-remove-denial (method)
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
+ (let* ((elem (assoc method gnus-opened-servers))
+ (status (cadr elem)))
+ ;; If this hasn't been opened before, we add it to the list.
+ (when (eq status 'denied)
+ ;; Set the status of this server.
+ (setcar (cdr elem) 'closed))))
+
(provide 'gnus-int)
;;; gnus-int.el ends here
projects / gnus / blobdiff