* elmo-imap4.el (elmo-imap4-folder-list-flagged)

[elisp/wanderlust.git] / elmo / acap.el

diff --git a/elmo/acap.el b/elmo/acap.el
index 497ce95..c2ad7e3 100644 (file)
--- a/elmo/acap.el
+++ b/elmo/acap.el
@@ -26,8 +26,8 @@
 ;;; Commentary:
 ;;
 ;; acap.el is an elisp library providing an interface for talking to
-;; ACAP (RFC2244) servers. 
-;; 
+;; ACAP (RFC2244) servers.
+;;
 ;; This is a transcript of short interactive session for demonstration
 ;; purposes.
 
@@ -60,9 +60,7 @@
 
 ;;; Code:
 
-(eval-when-compile
-  (require 'cl)
-  (require 'static))
+(eval-when-compile (require 'cl))
 (require 'pces)
 (require 'sasl)
 
@@ -122,6 +120,9 @@ Valid states are `closed', `initial', `auth'.")
 (defvar acap-response nil
   "ACAP Response.")
 
+(defvar acap-logging-out nil
+  "Non-nil when ACAP is logging out.")
+
 (make-variable-buffer-local 'acap-state)
 (make-variable-buffer-local 'acap-auth)
 (make-variable-buffer-local 'acap-capability)
@@ -131,6 +132,7 @@ Valid states are `closed', `initial', `auth'.")
 (make-variable-buffer-local 'acap-server)
 (make-variable-buffer-local 'acap-port)
 (make-variable-buffer-local 'acap-response)
+(make-variable-buffer-local 'acap-logging-out)
 
 (defvar acap-network-stream-alist
   '((default . open-network-stream-as-binary)))
@@ -160,6 +162,9 @@ Valid states are `closed', `initial', `auth'.")
 
 (defvar acap-passphrase-alist nil)
 
+(eval-and-compile
+  (autoload 'ange-ftp-read-passwd "ange-ftp"))
+
 (defun acap-read-passphrase (prompt)
   "Prompt is not used."
   (or acap-passphrase
@@ -170,7 +175,6 @@ Valid states are `closed', `initial', `auth'.")
            (read-passwd prompt)
          (if (load "passwd" t)
              (read-passwd prompt)
-           (autoload 'ange-ftp-read-passwd "ange-ftp")
            (ange-ftp-read-passwd prompt))))))
 
 ;;; Debug.
@@ -208,7 +212,7 @@ Valid states are `closed', `initial', `auth'.")
          (delq (assoc key acap-passphrase-alist)
                acap-passphrase-alist))))
 
-;;; Open, Close 
+;;; Open, Close
 (defun acap-open (server &optional user auth port type)
   (let* ((user (or user acap-default-user))
         (buffer (get-buffer-create (concat " *acap on " user " at " server)))
@@ -280,6 +284,7 @@ Valid states are `closed', `initial', `auth'.")
 
 (defun acap-close (process)
   (with-current-buffer (process-buffer process)
+    (setq acap-logging-out t)
     (unless (acap-response-ok-p (acap-send-command-wait process "LOGOUT"))
       (message "Server %s didn't let me log out" acap-server))
     (when (memq (process-status process) '(open run))
@@ -370,7 +375,7 @@ ENTRIES is a store-entry list."
            (replace-match "\\\\\\\\"))
          (goto-char beg)
          (while (re-search-forward "\"" nil t)
-           (replace-match "\\\\\""))     
+           (replace-match "\\\\\""))
          (goto-char beg)
          (insert "\"")
          (goto-char (point-max))
@@ -443,6 +448,12 @@ ENTRIES is a store-entry list."
 (defun acap-response-ok-p (response)
   (assq 'done-ok response))
 
+(defun acap-response-bye-p (response)
+  (assq 'bye response))
+
+(defun acap-response-bye-message (response)
+  (nth 1 (cdr (assq 'bye response))))
+
 (defun acap-response-cont-p (response)
   (assq 'cont response))
 
@@ -534,13 +545,19 @@ ENTRIES is a store-entry list."
   (with-current-buffer (process-buffer process)
     (while (and (not (acap-response-cont-p acap-response))
                (< acap-reached-tag tag))
+      (when (acap-response-bye-p acap-response)
+       (if acap-logging-out
+           (setq acap-response nil)
+         (error "%s"
+                (prog1 (acap-response-bye-message acap-response)
+                  (setq acap-response nil)))))
       (or (and (not (memq (process-status process) '(open run)))
               (sit-for 1))
-         (let ((len (/ (point-max) 1024))
+         (let ((len (/ (point-max) 1024))
                message-log-max)
-           (unless (< len 10)
-             (message "acap read: %dk" len))
-           (accept-process-output process 1))))
+           (unless (< len 10)
+             (message "acap read: %dk" len))
+           (accept-process-output process 1))))
     (message "")
     acap-response))
 
@@ -795,12 +812,11 @@ ENTRIES is a store-entry list."
                             (progn
                               (acap-forward)
                               (acap-parse-return-data-list)))))
-         (ALERT ;(cons 'alert (acap-parse-resp-body))
-          (message (nth 1 (acap-parse-resp-body))))
-         (BYE   ;(cons 'bye (acap-parse-resp-body)))
-          ;;(message (nth 1  (acap-parse-resp-body)))
-          ;;(ding)
-          )
+         (ALERT
+;;;       (cons 'alert (acap-parse-resp-body))
+          (message "%s" (nth 1 (acap-parse-resp-body))))
+         ((BYE Bye bye)
+          (cons 'bye (acap-parse-resp-body)))
          (CHANGE (cons 'change
                        (list (acap-parse-quoted)
                              (progn
@@ -819,9 +835,10 @@ ENTRIES is a store-entry list."
          ;; response-stat
          (OK   (cons 'stat-ok (acap-parse-resp-body)))
          (NO   (cons 'stat-no (acap-parse-resp-body)))
-         (BAD  ;(cons 'stat-bad (acap-parse-resp-body))
+         (BAD
+;;;       (cons 'stat-bad (acap-parse-resp-body))
           ;; XXX cyrus-sml-acap does not return tagged bad response?
-          (error (nth 1 (acap-parse-resp-body))))))
+          (error "%s" (nth 1 (acap-parse-resp-body))))))
        ((integerp token)
        ;; tagged response.
        (setq tag token)