* imap.el (imap-logout-timeout): New variable.
authorKatsumi Yamaoka <yamaoka@jpl.org>
Fri, 17 Aug 2007 11:09:00 +0000 (11:09 +0000)
committerKatsumi Yamaoka <yamaoka@jpl.org>
Fri, 17 Aug 2007 11:09:00 +0000 (11:09 +0000)
(imap-logout, imap-logout-wait): New functions.
(imap-kerberos4-open, imap-gssapi-open, imap-close): Use them.

* nnimap.el (nnimap-logout-timeout): New server variable.
(nnimap-open-server, nnimap-close-server): Bind imap-logout-timeout to
 nnimap-logout-timeout.

lisp/ChangeLog
lisp/imap.el
lisp/nnimap.el

index 2d3a02c..ff1c1b8 100644 (file)
@@ -1,5 +1,13 @@
 2007-08-17  Katsumi Yamaoka  <yamaoka@jpl.org>
 
+       * imap.el (imap-logout-timeout): New variable.
+       (imap-logout, imap-logout-wait): New functions.
+       (imap-kerberos4-open, imap-gssapi-open, imap-close): Use them.
+
+       * nnimap.el (nnimap-logout-timeout): New server variable.
+       (nnimap-open-server, nnimap-close-server): Bind imap-logout-timeout to
+       nnimap-logout-timeout.
+
        * gnus-art.el (gnus-article-summary-command-nosave)
        (gnus-article-read-summary-keys): Don't use 3rd arg of pop-to-buffer.
 
index 1725f3e..547412f 100644 (file)
@@ -325,6 +325,13 @@ for doing the actual authentication.")
 (defvar imap-error nil
   "Error codes from the last command.")
 
+(defvar imap-logout-timeout nil
+  "Close server immediately if it can't logout in this number of seconds.
+If it is nil, never close server until logout completes.  Normally,
+the value of this variable will be bound to a certain value to which
+an application program that uses this module specifies on a per-server
+basis.")
+
 ;; Internal constants.  Change these and die.
 
 (defconst imap-default-port 143)
@@ -554,7 +561,7 @@ sure of changing the value of `foo'."
                                (not (string-match "failed" response))))
                (setq done process)
              (if (memq (process-status process) '(open run))
-                 (imap-send-command "LOGOUT"))
+                 (imap-logout))
              (delete-process process)
              nil)))))
     done))
@@ -629,7 +636,7 @@ sure of changing the value of `foo'."
                                (not (string-match "failed" response))))
                (setq done process)
              (if (memq (process-status process) '(open run))
-                 (imap-send-command "LOGOUT"))
+                 (imap-logout))
              (delete-process process)
              nil)))))
     done))
@@ -1188,7 +1195,7 @@ If BUFFER is nil, the current buffer is used."
   (with-current-buffer (or buffer (current-buffer))
     (when (imap-opened)
       (condition-case nil
-         (imap-send-command-wait "LOGOUT")
+         (imap-logout-wait)
        (quit nil)))
     (when (and imap-process
               (memq (process-status imap-process) '(open run)))
@@ -1243,6 +1250,28 @@ If BUFFER is nil, the current buffer is assumed."
 (defun imap-send-command-wait (command &optional buffer)
   (imap-wait-for-tag (imap-send-command command buffer) buffer))
 
+(defun imap-logout (&optional buffer)
+  (or buffer (setq buffer (current-buffer)))
+  (if imap-logout-timeout
+      (with-timeout (imap-logout-timeout
+                    (condition-case nil
+                        (with-current-buffer buffer
+                          (delete-process imap-process))
+                      (error)))
+       (imap-send-command "LOGOUT" buffer))
+    (imap-send-command "LOGOUT" buffer)))
+
+(defun imap-logout-wait (&optional buffer)
+  (or buffer (setq buffer (current-buffer)))
+  (if imap-logout-timeout
+      (with-timeout (imap-logout-timeout
+                    (condition-case nil
+                        (with-current-buffer buffer
+                          (delete-process imap-process))
+                      (error)))
+       (imap-send-command-wait "LOGOUT" buffer))
+    (imap-send-command-wait "LOGOUT" buffer)))
+
 \f
 ;; Mailbox functions:
 
index 06adfde..c934e73 100644 (file)
@@ -254,6 +254,11 @@ it O(n).  If p is small, then the default is probably faster."
   "Unselect mailboxes before looking for new mail in them.
 Some servers seem to need this under some circumstances.")
 
+(defvoo nnimap-logout-timeout nil
+  "Close server immediately if it can't logout in this number of seconds.
+If it is nil, never close server until logout completes.  This variable
+overrides `imap-logout-timeout' on a per-server basis.")
+
 ;; Authorization / Privacy variables
 
 (defvoo nnimap-auth-method nil
@@ -775,6 +780,8 @@ If EXAMINE is non-nil the group is selected read-only."
       'nov)))
 
 (defun nnimap-open-connection (server)
+  ;; Note: `nnimap-open-server' that calls this function binds
+  ;; `imap-logout-timeout' to `nnimap-logout-timeout'.
   (if (not (imap-open nnimap-address nnimap-server-port nnimap-stream
                      nnimap-authenticator nnimap-server-buffer))
       (nnheader-report 'nnimap "Can't open connection to server %s" server)
@@ -836,14 +843,15 @@ If EXAMINE is non-nil the group is selected read-only."
        (setq nnimap-server-buffer (cadr (assq 'nnimap-server-buffer defs))))
     (with-current-buffer (get-buffer-create nnimap-server-buffer)
       (nnoo-change-server 'nnimap server defs))
-    (or (and nnimap-server-buffer
-            (imap-opened nnimap-server-buffer)
-            (if (with-current-buffer nnimap-server-buffer
-                  (memq imap-state '(auth selected examine)))
-                t
-              (imap-close nnimap-server-buffer)
-              (nnimap-open-connection server)))
-       (nnimap-open-connection server))))
+    (let ((imap-logout-timeout nnimap-logout-timeout))
+      (or (and nnimap-server-buffer
+              (imap-opened nnimap-server-buffer)
+              (if (with-current-buffer nnimap-server-buffer
+                    (memq imap-state '(auth selected examine)))
+                  t
+                (imap-close nnimap-server-buffer)
+                (nnimap-open-connection server)))
+         (nnimap-open-connection server)))))
 
 (deffoo nnimap-server-opened (&optional server)
   "Whether SERVER is opened.
@@ -858,7 +866,8 @@ SERVER is nil, it is treated as the current server."
 (deffoo nnimap-close-server (&optional server)
   "Close connection to server and free all resources connected to it.
 Return nil if the server couldn't be closed for some reason."
-  (let ((server (or server nnimap-current-server)))
+  (let ((server (or server nnimap-current-server))
+       (imap-logout-timeout nnimap-logout-timeout))
     (when (or (nnimap-server-opened server)
              (imap-opened (nnimap-get-server-buffer server)))
       (imap-close (nnimap-get-server-buffer server))