-;;; wl-acap.el -- ACAP support for Wanderlust.
+;;; wl-acap.el --- ACAP support for Wanderlust.
;; Copyright (C) 2001 Yuuichi Teranishi <teranisi@gohome.org>
: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"))
(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
(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")))