* 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 a85aa45..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>
 
@@ -29,9 +29,11 @@
 ;;
 
 (cond
- ((module-installed-p 'un-define)
+ ((and (not (featurep 'utf-2000))
+       (module-installed-p 'un-define))
   (require 'un-define))
  ((and (featurep 'xemacs)
+       (not (featurep 'utf-2000))
        (module-installed-p 'xemacs-ucs))
   (require 'xemacs-ucs)))
 (require 'custom)
@@ -94,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))
@@ -136,24 +147,38 @@ If nil, default acap port is used."
                                       (memq 'string type)))
                              (if (memq sym wl-acap-base64-encode-options)
                                  (wl-acap-base64-decode-string (cadr x))
-                               (cadr x)))
+                               (decode-coding-string
+                                (cadr x)
+                                wl-acap-coding-system)))
                             (t
                              (if (cadr x)
                                  (read
                                   (if (memq sym
                                             wl-acap-base64-encode-options)
                                       (wl-acap-base64-decode-string (cadr x))
-                                    (read (concat "\"" (cadr x) "\""))))))))))
+                                     (read (concat
+                                            "\""
+                                            (decode-coding-string
+                                             (cadr x)
+                                             wl-acap-coding-system)
+                                            "\""))
+                                     ))))))))
                        (t 'wl-acap-ignored))))
                   settings)))
     ;; Setup options.
     (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
@@ -177,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)
@@ -259,11 +317,15 @@ If nil, default acap port is used."
                      (if (memq option wl-acap-base64-encode-options)
                          (wl-acap-base64-encode-string
                           (symbol-value option))
-                       (symbol-value option)))
+                       (encode-coding-string
+                        (symbol-value option)
+                        wl-acap-coding-system)))
                     (t (if (memq option wl-acap-base64-encode-options)
                            (wl-acap-base64-encode-string
                             (prin1-to-string (symbol-value option)))
-                         (prin1-to-string (symbol-value option))))))
+                         (encode-coding-string
+                          (prin1-to-string (symbol-value option))
+                          wl-acap-coding-system)))))
                  settings)))
     (unwind-protect
        (progn
@@ -286,6 +348,7 @@ If nil, default acap port is used."
     (if (interactive-p)
        (message "Store completed."))))
 
-(provide 'wl-acap)
+(require 'product)
+(product-provide (provide 'wl-acap) (require 'wl-version))
 
 ;;; wl-acap.el ends here