(require 'message)
(require 'gnus-range)
-(eval-when-compile
- (defun gnus-agent-expire (a b c)))
+(autoload 'gnus-agent-expire "gnus-agent")
(defcustom gnus-open-server-hook nil
"Hook called just before opening connection to the news server."
"Open a connection to GNUS-COMMAND-METHOD."
(when (stringp gnus-command-method)
(setq gnus-command-method (gnus-server-to-method gnus-command-method)))
-
- (let ((state (or (assoc gnus-command-method gnus-opened-servers)
- (car (setq gnus-opened-servers
- (cons (list gnus-command-method nil)
- gnus-opened-servers))))))
- (cond ((eq (nth 1 state) 'denied)
- ;; If this method was previously denied, we just return nil.
-
- (gnus-message 1 "Denied server")
- nil)
- ((eq (nth 1 state) 'offline)
- ;; If this method was previously opened offline, we just return t.
- t)
- ((and (not gnus-plugged)
- (member gnus-command-method
- gnus-agent-covered-methods))
- ;; I'm opening servers while unplugged. Set the status to
- ;; either 'offline or 'denied without asking (I'm assuming
- ;; that the user wants to go 'offline on every agentized
- ;; server when opening while unplugged.)
- (setcar (cdr state) (if (and gnus-agent
- (gnus-agent-method-p gnus-command-method))
- (or gnus-server-unopen-status
- 'offline)
- 'denied))
-
- (if (eq (nth 1 state) 'offline)
- ;; Invoke the agent's backend to open the offline server.
- (funcall (gnus-get-function gnus-command-method 'open-server)
- (nth 1 gnus-command-method)
- (nthcdr 2 gnus-command-method))))
- ((condition-case err
- ;; Open the server.
- (funcall (gnus-get-function gnus-command-method 'open-server)
- (nth 1 gnus-command-method)
- (nthcdr 2 gnus-command-method))
- (error
- (gnus-message 1 (format
+ (let ((elem (assoc gnus-command-method gnus-opened-servers)))
+ ;; If this method was previously denied, we just return nil.
+ (if (eq (nth 1 elem) 'denied)
+ (progn
+ (gnus-message 1 "Denied server")
+ nil)
+ ;; Open the server.
+ (let ((result
+ (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
(gnus-message 1 "Quit trying to open server")
- nil))
- ;; I successfully opened the server.
- (setcar (cdr state) 'ok))
- (t
- ;; I couldn't open the server so decide whether to mark it
- ;; 'denied or to open it 'offline.
- (setcar (cdr state)
- (if (and gnus-agent
- (not (eq (cadr state) 'offline))
+ nil))))
+ ;; If this hasn't been opened before, we add it to the list.
+ (unless elem
+ (setq elem (list gnus-command-method nil)
+ gnus-opened-servers (cons elem gnus-opened-servers)))
+ ;; Set the status of this server.
+ (setcar (cdr elem)
+ (if result
+ (if (eq (cadr elem) 'offline)
+ 'offline
+ 'ok)
+ (if (and gnus-agent
+ (not (eq (cadr elem) 'offline))
(gnus-agent-method-p gnus-command-method))
(or gnus-server-unopen-status
(if (gnus-y-or-n-p
(cadr gnus-command-method)))
'offline
'denied))
- 'denied))
- (if (eq (nth 1 state) 'offline)
- ;; Invoke the agent's backend to open the offline server.
- (funcall (gnus-get-function gnus-command-method 'open-server)
- (nth 1 gnus-command-method)
- (nthcdr 2 gnus-command-method)))))))
+ 'denied)))
+ ;; Return the result from the "open" call.
+ (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."
(defun gnus-status-message (gnus-command-method)
"Return the status message from GNUS-COMMAND-METHOD.
-If GNUS-COMMAND-METHOD is a string, it is interpreted as a group name. The method
-this group uses will be queried."
+If GNUS-COMMAND-METHOD is a string, it is interpreted as a group
+name. The method this group uses will be queried."
(let ((gnus-command-method
(if (stringp gnus-command-method)
(gnus-find-method-for-group gnus-command-method)
(gnus-group-real-name group) article))))
(defun gnus-request-set-mark (group action)
- "Set marks on articles in the backend."
+ "Set marks on articles in the back end."
(let ((gnus-command-method (gnus-find-method-for-group group)))
(if (not (gnus-check-backend-function
'request-set-mark (car gnus-command-method)))
(nth 1 gnus-command-method)))))
(defun gnus-request-update-mark (group article mark)
- "Allow the backend to change the mark the user tries to put on an article."
+ "Allow the back end to change the mark the user tries to put on an article."
(let ((gnus-command-method (gnus-find-method-for-group group)))
(if (not (gnus-check-backend-function
'request-update-mark (car gnus-command-method)))
(defun gnus-request-expire-articles (articles group &optional force)
(let* ((gnus-command-method (gnus-find-method-for-group group))
- (not-deleted
- (funcall
+ (not-deleted
+ (funcall
(gnus-get-function gnus-command-method 'request-expire-articles)
articles (gnus-group-real-name group) (nth 1 gnus-command-method)
force)))
projects / gnus / blobdiff