* wl-acap.el (wl-acap-original-msgdb-directory): Renamed from

[elisp/wanderlust.git] / wl / wl-acap.el

diff --git a/wl/wl-acap.el b/wl/wl-acap.el
index 818663e..eb4901e 100644 (file)
--- a/wl/wl-acap.el
+++ b/wl/wl-acap.el
@@ -1,4 +1,4 @@
-;;; wl-acap.el -- ACAP support for Wanderlust.
+;;; wl-acap.el --- ACAP support for Wanderlust.
 
 ;; Copyright (C) 2001 Yuuichi Teranishi <teranisi@gohome.org>
 
@@ -96,10 +96,19 @@ If nil, default acap port is used."
   :type 'symbol
   :group 'wl)
 
+(defvar wl-acap-original-msgdb-directory nil)
+
+(defun wl-acap-exit ()
+  "End ACAP session."
+  (setq elmo-msgdb-directory wl-acap-original-msgdb-directory))
+
 (defun wl-acap-init ()
   "A candidate for `wl-folder-init-function'."
+  (setq wl-acap-original-msgdb-directory nil)
+  (condition-case nil ; catch error and quit.
   (let ((service (wl-acap-find-acap-service))
        proc entries settings folder-top type)
+    (unless (car service) (error "No ACAP service found"))
     (setq proc (acap-open (car service)
                          wl-acap-user
                          (upcase (symbol-name wl-acap-authenticate-type))
@@ -147,7 +156,7 @@ If nil, default acap port is used."
                                   (if (memq sym
                                             wl-acap-base64-encode-options)
                                       (wl-acap-base64-decode-string (cadr x))
-                                     (read (concat 
+                                     (read (concat
                                             "\""
                                             (decode-coding-string
                                              (cadr x)
@@ -160,10 +169,16 @@ If nil, default acap port is used."
     (dolist (setting settings)
       (set (car setting) (cdr setting)))
     ;; Database directory becomes specific to the ACAP server.
-    (setq elmo-msgdb-dir (expand-file-name
-                         (concat "acap/" (car service) "/" wl-acap-user)
-                         elmo-msgdb-dir))
-    (acap-close proc)))
+    (setq wl-acap-original-msgdb-directory elmo-msgdb-directory)
+    (setq elmo-msgdb-directory (expand-file-name
+                               (concat "acap/" (car service) "/" wl-acap-user)
+                               elmo-msgdb-directory))
+    (acap-close proc))
+  (error (when wl-acap-original-msgdb-directory
+          (setq elmo-msgdb-directory wl-acap-original-msgdb-directory)))
+  (quit (when wl-acap-original-msgdb-directory
+         (setq elmo-msgdb-directory wl-acap-original-msgdb-directory)))))
+
 
 (defun wl-acap-create-folder-entity (string)
   (with-temp-buffer
@@ -187,13 +202,46 @@ If nil, default acap port is used."
        (message "Searching ACAP server...")
        (prog1 (let ((response (condition-case nil
                                   (slp-findsrvs "acap")
-                                (error))))
+                                (error)))
+                    selected)
                 (when response
-                  ;; Only the first service entry is used.
-                  (setq response (car (slp-response-body response)))
+                  (if (> (length (slp-response-body response)) 1)
+                      (progn
+                        (setq selected
+                              (completing-read
+                               "Select ACAP server: "
+                               (mapcar (lambda (body)
+                                         (list
+                                          (concat
+                                           (slp-response-srv-url-host
+                                            body)
+                                           (when (slp-response-srv-url-port
+                                                  body)
+                                             (concat
+                                              ":"
+                                              (slp-response-srv-url-port
+                                               body))))))
+                                       (slp-response-body response)))
+                              response
+                              (catch 'done
+                                (dolist (entry (slp-response-body response))
+                                  (when (string=
+                                         (concat
+                                          (slp-response-srv-url-host
+                                           entry)
+                                          (when
+                                              (slp-response-srv-url-port
+                                               entry)
+                                            (concat
+                                             ":"
+                                             (slp-response-srv-url-port
+                                              entry))))
+                                         selected)
+                                    (throw 'done entry))))))
+                    (setq response (car (slp-response-body response))))
                   (cons (slp-response-srv-url-host response)
                         (slp-response-srv-url-port response))))
-         (message "Searching ACAP server...done.")))
+         (message "Searching ACAP server...done")))
       (cons "localhost" nil)))
 
 (defun wl-acap-name (option)