X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-int.el;h=0acdf8135feefd373c1408dad984390ebd396a40;hb=968c443684b6736685e8524be26fc6d8cdd1237d;hp=7c4b636a4f3f35e3e8d439e07b075b24843c9a62;hpb=027d8adb5e89ff3c087d406090ea7eaf6c4ee42c;p=gnus diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el index 7c4b636a4..0acdf8135 100644 --- a/lisp/gnus-int.el +++ b/lisp/gnus-int.el @@ -33,6 +33,7 @@ (require 'gnus-range) (autoload 'gnus-agent-expire "gnus-agent") +(autoload 'gnus-agent-read-servers-validate-native "gnus-agent") (defcustom gnus-open-server-hook nil "Hook called just before opening connection to the news server." @@ -105,6 +106,18 @@ If CONFIRM is non-nil, the user will be asked for an NNTP server." (require 'nntp))) (setq gnus-current-select-method gnus-select-method) (gnus-run-hooks 'gnus-open-server-hook) + + ;; Partially validate agent covered methods now that the + ;; gnus-select-method is known. + + (if gnus-agent + ;; NOTE: This is here for one purpose only. By validating + ;; the current select method, it converts the old 5.10.3, + ;; and earlier, format to the current format. That enables + ;; the agent code within gnus-open-server to function + ;; correctly. + (gnus-agent-read-servers-validate-native gnus-select-method)) + (or ;; gnus-open-server-hook might have opened it (gnus-server-opened gnus-select-method) @@ -200,52 +213,66 @@ If it is down, start it up (again)." (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 + (let* ((open-server-function (gnus-get-function gnus-command-method 'open-server)) + (result + (condition-case err + (funcall open-server-function + (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)))) + (quit + (gnus-message 1 "Quit trying to open server") + nil))) + open-offline) ;; 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 - (format "Unable to open %s:%s, go offline? " - (car gnus-command-method) - (cadr gnus-command-method))) - 'offline - 'denied)) - '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)))))) + (setcar (cdr elem) + (cond (result + (if (eq open-server-function #'nnagent-open-server) + ;; The agent's backend has a "special" status + 'offline + 'ok)) + ((and gnus-agent + (gnus-agent-method-p gnus-command-method)) + (cond (gnus-server-unopen-status + ;; Set the server's status to the unopen + ;; status. If that status is offline, + ;; recurse to open the agent's backend. + (setq open-offline (eq gnus-server-unopen-status 'offline)) + gnus-server-unopen-status) + ((gnus-y-or-n-p + (format "Unable to open %s:%s, go offline? " + (car gnus-command-method) + (cadr gnus-command-method))) + (setq open-offline t) + 'offline) + (t + ;; This agentized server was still denied + 'denied))) + (t + ;; This unagentized server must be denied + 'denied))) + + ;; NOTE: I MUST set the server's status to offline before this + ;; recursive call as this status will drive the + ;; gnus-get-function (called above) to return the agent's + ;; backend. + (if open-offline + ;; Recursively open this offline server to perform the + ;; open-server function of the agent's backend. + (let ((gnus-server-unopen-status 'denied)) + ;; Bind gnus-server-unopen-status to avoid recursively + ;; prompting with "go offline?". This is only a concern + ;; when the agent's backend fails to open the server. + (gnus-open-server gnus-command-method)) + result))))) (defun gnus-close-server (gnus-command-method) "Close the connection to GNUS-COMMAND-METHOD." @@ -287,8 +314,8 @@ If it is down, start it up (again)." (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) @@ -383,7 +410,7 @@ If FETCH-OLD, retrieve all headers (or some subset thereof) in the group." (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))) @@ -393,7 +420,7 @@ If FETCH-OLD, retrieve all headers (or some subset thereof) in the group." (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))) @@ -521,8 +548,8 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." (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)))