;;; gnus-int.el --- backend interface functions for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
(eval-when-compile (require 'cl))
(require 'gnus)
+(require 'message)
+(require 'gnus-range)
+
+(eval-when-compile
+ (defun gnus-agent-expire (a b c)))
(defcustom gnus-open-server-hook nil
"Hook called just before opening connection to the news server."
"The default status if the server is not able to open.
If the server is covered by Gnus agent, the possible values are
`denied', set the server denied; `offline', set the server offline;
-`nil', ask user. If the server is not covered by Gnus agent, set the
+nil, ask user. If the server is not covered by Gnus agent, set the
server denied."
:group 'gnus-start
:type '(choice (const :tag "Ask" nil)
(const :tag "Deny server" denied)
- (const :tag "Unplugg Agent" offline)))
+ (const :tag "Unplug Agent" offline)))
+
+(defvar gnus-internal-registry-spool-current-method nil
+ "The current method, for the registry.")
;;;
;;; Server Communication
nil)
;; Open the server.
(let ((result
- (condition-case ()
+ (condition-case err
(funcall (gnus-get-function gnus-command-method 'open-server)
(nth 1 gnus-command-method)
(nthcdr 2 gnus-command-method))
+ (error
+ (gnus-message 1 (format
+ "Unable to open server due to: %s"
+ (error-message-string err)))
+ nil)
(quit
- (message "Quit trying to open server")
+ (gnus-message 1 "Quit trying to open server")
nil))))
;; If this hasn't been opened before, we add it to the list.
(unless elem
(format "Unable to open %s:%s, go offline? "
(car gnus-command-method)
(cadr gnus-command-method)))
- 'offline
+ 'offline
'denied))
'denied)))
;; Return the result from the "open" call.
- (or (eq (cadr elem) 'offline)
- result)))))
+ (cond ((eq (cadr elem) 'offline)
+ ;; I'm avoiding infinite recursion by binding unopen
+ ;; status to denied (The logic of this routine
+ ;; guarantees that I can't get to this point with
+ ;; unopen status already bound to denied).
+ (unless (eq gnus-server-unopen-status 'denied)
+ (let ((gnus-server-unopen-status 'denied))
+ (gnus-open-server gnus-command-method)))
+ t)
+ (t
+ result))))))
(defun gnus-close-server (gnus-command-method)
"Close the connection to GNUS-COMMAND-METHOD."
(cond
((and gnus-use-cache (numberp (car articles)))
(gnus-cache-retrieve-headers articles group fetch-old))
- ((and gnus-agent gnus-agent-cache (gnus-online gnus-command-method)
+ ((and gnus-agent (gnus-online gnus-command-method)
(gnus-agent-method-p gnus-command-method))
(gnus-agent-retrieve-headers articles group fetch-old))
(t
(setq res (cons group article)
clean-up t))
;; Check the agent cache.
- ((and gnus-agent gnus-agent-cache gnus-plugged
- (numberp article)
- (gnus-agent-request-article article group))
+ ((gnus-agent-request-article article group)
(setq res (cons group article)
clean-up t))
;; Use `head' function.
(setq res (cons group article)
clean-up t))
;; Check the agent cache.
- ((and gnus-agent gnus-agent-cache gnus-plugged
- (numberp article)
- (gnus-agent-request-article article group))
+ ((gnus-agent-request-article article group)
(setq res (cons group article)
clean-up t))
;; Use `head' function.
(gnus-inhibit-demon t)
(mail-source-plugged gnus-plugged))
(if (or gnus-plugged (not (gnus-agent-method-p gnus-command-method)))
- (funcall (gnus-get-function gnus-command-method 'request-scan)
- (and group (gnus-group-real-name group))
- (nth 1 gnus-command-method)))))
+ (progn
+ (setq gnus-internal-registry-spool-current-method gnus-command-method)
+ (funcall (gnus-get-function gnus-command-method 'request-scan)
+ (and group (gnus-group-real-name group))
+ (nth 1 gnus-command-method))))))
(defsubst gnus-request-update-info (info gnus-command-method)
"Request that GNUS-COMMAND-METHOD update INFO."
(setq gnus-command-method (gnus-server-to-method gnus-command-method)))
(when (gnus-check-backend-function
'request-update-info (car gnus-command-method))
- (let* ((group (gnus-info-group info))
- (result (funcall (gnus-get-function gnus-command-method
- 'request-update-info)
- (gnus-group-real-name group)
- info (nth 1 gnus-command-method))))
- (when result ;; artificially add nonexistent articles to the read range
- (let* ((active (gnus-active group))
- (min (car active)))
- (when (> min 1) ;; otherwise, there are no known nonexistent articles
- (let* ((range (if (= min 2) 1 (cons 1 (1- min))))
- (read (gnus-info-read result))
- (new-read (gnus-range-add read (list range))))
- (gnus-info-set-read result new-read)))))
- result)))
+ (let ((group (gnus-info-group info)))
+ (and (funcall (gnus-get-function gnus-command-method
+ 'request-update-info)
+ (gnus-group-real-name group)
+ info (nth 1 gnus-command-method))
+ ;; If the minimum article number is greater than 1, then all
+ ;; smaller article numbers are known not to exist; we'll
+ ;; artificially add those to the 'read range.
+ (let* ((active (gnus-active group))
+ (min (car active)))
+ (when (> min 1)
+ (let* ((range (if (= min 2) 1 (cons 1 (1- min))))
+ (read (gnus-info-read info))
+ (new-read (gnus-range-add read (list range))))
+ (gnus-info-set-read info new-read)))
+ info)))))
(defun gnus-request-expire-articles (articles group &optional force)
(let* ((gnus-command-method (gnus-find-method-for-group group))
(gnus-get-function gnus-command-method 'request-expire-articles)
articles (gnus-group-real-name group) (nth 1 gnus-command-method)
force)))
- (when (and gnus-agent gnus-agent-cache
- (gnus-sorted-difference articles not-deleted))
- (gnus-agent-expire (gnus-sorted-difference articles not-deleted)
- group 'force))
+ (when (and gnus-agent
+ (gnus-agent-method-p gnus-command-method))
+ (let ((expired-articles (gnus-sorted-difference articles not-deleted)))
+ (when expired-articles
+ (gnus-agent-expire expired-articles group 'force))))
not-deleted))
-(defun gnus-request-move-article (article group server accept-function &optional last)
+(defun gnus-request-move-article (article group server accept-function
+ &optional last)
(let* ((gnus-command-method (gnus-find-method-for-group group))
- (result (funcall (gnus-get-function gnus-command-method 'request-move-article)
+ (result (funcall (gnus-get-function gnus-command-method
+ 'request-move-article)
article (gnus-group-real-name group)
(nth 1 gnus-command-method) accept-function last)))
- (when (and result gnus-agent gnus-agent-cache)
+ (when (and result gnus-agent
+ (gnus-agent-method-p gnus-command-method))
(gnus-agent-expire (list article) group 'force))
result))
projects / gnus / blobdiff