X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-acap.el;h=f9be6c266eef1075c8ee03ea793cda008e3e056c;hb=62bd32794da4e4f6f35be9ffb4e0d1f27f97a3d1;hp=cef98d78f78015a5296b61c704b9f06458005938;hpb=1bd16c42e347b6e5caf3664230071cff98686ec9;p=elisp%2Fwanderlust.git

diff --git a/wl/wl-acap.el b/wl/wl-acap.el
index cef98d7..f9be6c2 100644
--- 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>
 
@@ -28,21 +28,22 @@
 ;;; Code:
 ;;
 
+;;(cond
+;; ((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)
 (require 'cus-edit)
 (require 'wl-vars)
+(require 'wl)
 (require 'elmo-vars)
 (require 'acap)
 (require 'slp)
 
-(eval-and-compile
-  (cond
-   ((and (featurep 'xemacs)
-	 (module-installed-p 'xemacs-ucs))
-    (require 'xemacs-ucs))
-   ((module-installed-p 'un-define)
-    (require 'un-define))))
-
 (defconst wl-acap-dataset-class "vendor.wanderlust")
 (defconst wl-acap-entry-name "settings")
 
@@ -82,6 +83,11 @@ If nil, default acap port is used."
   :type '(repeat symbol)
   :group 'wl)
 
+(defcustom wl-acap-cache-filename "acap-cache"
+  "ACAP setting cache file."
+  :type 'string
+  :group 'wl)
+
 ;; Encoding string as BASE64 is temporal solution.
 ;; As far as I know, current implementation of ACAP server
 ;; (cyrus-smlacapd 0.5) does not accept literal argument for STORE.
@@ -95,71 +101,141 @@ 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."
+  (when wl-acap-original-msgdb-directory
+    (setq elmo-msgdb-directory wl-acap-original-msgdb-directory)))
+
 (defun wl-acap-init ()
   "A candidate for `wl-folder-init-function'."
-  (let ((service (wl-acap-find-acap-service))
-	proc entries settings folder-top type)
-    (setq proc (acap-open (car service)
-			  wl-acap-user
-			  (upcase (symbol-name wl-acap-authenticate-type))
-			  (cdr service)))
-    (setq entries (acap-response-entries
-		   (acap-search proc (concat "/"
-					     wl-acap-dataset-class
-					     "/~/")
-				'((RETURN ("*"))))))
-    (while entries
-      (when (string= (acap-response-entry-entry (car entries))
-		     wl-acap-entry-name)
-	(setq settings (car (acap-response-entry-return-data-list
-			     (car entries)))
-	      entries nil))
-      (setq entries (cdr entries)))
-    (setq settings
-	  (delq
-	   'wl-acap-ignored
-	   (mapcar (lambda (x)
-		     (let ((sym (wl-acap-symbol (car x))))
-		       (cond
-			((and sym (eq sym 'wl-folders))
-			 ;; Folders.
-			 (setq wl-folder-entity
-			       (wl-acap-create-folder-entity (cadr x)))
-			 'wl-acap-ignored)
-			((and sym (boundp sym))
-			 (setq type (custom-variable-type sym))
-			 (cons
-			  sym
-			  (when (cadr x)
-			    (cond
-			     ((or (eq (car type) 'string)
-				  (and (eq (car type) 'choice)
-				       (memq 'string type)))
-			      (if (memq sym wl-acap-base64-encode-options)
-				  (wl-acap-base64-decode-string (cadr x))
-				(cadr x)))
-			     (t
-			      (if (cadr x)
-				  (read
-				   (if (memq sym
-					     wl-acap-base64-encode-options)
-				       (wl-acap-base64-decode-string (cadr x))
-				     (read (concat "\"" (cadr x) "\""))))))))))
-			(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 nil)
+  (condition-case err			; catch error and quit.
+      (let ((service (wl-acap-find-acap-service))
+	    proc entries settings folder-top type caches msgdb-dir)
+	(if (null (car service))
+	    (if (setq caches
+		      (delq
+		       nil
+		       (mapcar
+			(lambda (dirent)
+			  (let ((dir
+				 (elmo-localdir-folder-directory-internal
+				  (elmo-make-folder dirent))))
+			    (if (file-exists-p
+				 (setq dir (expand-file-name
+					    wl-acap-cache-filename
+					    dir)))
+				dir)))
+			(elmo-folder-list-subfolders
+			 (elmo-make-folder (concat "+"
+						   (expand-file-name
+						    "acap"
+						    elmo-msgdb-directory)))))))
+		(if (y-or-n-p "No ACAP service found.  Try cache? ")
+		    (let (selected rpath alist)
+		      (setq alist
+			    (mapcar
+			     (lambda (dir)
+			       (setq rpath (nreverse (split-string dir "/")))
+			       (cons (concat (nth 1 rpath) "@" (nth 2 rpath))
+				     dir))
+			     caches)
+			    selected
+			    (cdr (assoc
+				  (completing-read
+				   "Select ACAP cache: " alist nil t)
+				  alist))
+			    msgdb-dir (file-name-directory selected)
+			    entries (elmo-object-load selected)))
+		  (error "No ACAP service found"))
+	      (error "No ACAP service found"))
+	  (setq proc (acap-open (car service)
+				wl-acap-user
+				(upcase (symbol-name
+					 wl-acap-authenticate-type))
+				(cdr service)))
+	  (setq entries (acap-response-entries
+			 (acap-search proc (concat "/"
+						   wl-acap-dataset-class
+						   "/~/")
+				      '((RETURN ("*"))))))
+	  (when entries
+	    (elmo-object-save
+	     (expand-file-name
+	      (concat "acap/" (car service) "/" wl-acap-user "/"
+		      wl-acap-cache-filename)
+	      elmo-msgdb-directory)
+	     entries)))
+	(while entries
+	  (when (string= (acap-response-entry-entry (car entries))
+			 wl-acap-entry-name)
+	    (setq settings (car (acap-response-entry-return-data-list
+				 (car entries)))
+		  entries nil))
+	  (setq entries (cdr entries)))
+	(setq settings
+	      (delq
+	       'wl-acap-ignored
+	       (mapcar (lambda (x)
+			 (let ((sym (wl-acap-symbol (car x))))
+			   (cond
+			    ((and sym (eq sym 'wl-folders))
+			     ;; Folders.
+			     (setq wl-folder-entity
+				   (wl-acap-create-folder-entity (cadr x)))
+			     'wl-acap-ignored)
+			    ((and sym (boundp sym))
+			     (setq type (custom-variable-type sym))
+			     (cons
+			      sym
+			      (when (cadr x)
+				(cond
+				 ((or (eq (car type) 'string)
+				      (and (eq (car type) 'choice)
+					   (memq 'string type)))
+				  (if (memq sym wl-acap-base64-encode-options)
+				      (wl-acap-base64-decode-string (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
+						"\""
+						(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 wl-acap-original-msgdb-directory elmo-msgdb-directory)
+	(setq elmo-msgdb-directory (or msgdb-dir
+				       (expand-file-name
+					(concat "acap/" (car service)
+						"/" wl-acap-user)
+					elmo-msgdb-directory)))
+	(when proc (acap-close proc)))
+    ((error quit)
+     (when wl-acap-original-msgdb-directory
+       (setq elmo-msgdb-directory wl-acap-original-msgdb-directory))
+     (signal (car err) (cdr err)))))
 
 (defun wl-acap-create-folder-entity (string)
   (with-temp-buffer
     (message "Initializing folder...")
-    (let (folders)
+    (let (folders entity)
       (setq string (elmo-base64-decode-string string))
       (setq string (decode-coding-string string wl-acap-coding-system))
       (insert string)
@@ -178,13 +254,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)
@@ -240,6 +349,7 @@ If nil, default acap port is used."
   "Store Wanderlust configuration to the ACAP server."
   (interactive)
   (wl-load-profile)
+  (elmo-init)
   (let ((service (wl-acap-find-acap-service))
 	proc settings type)
     (setq proc (acap-open (car service)
@@ -259,11 +369,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
@@ -275,11 +389,18 @@ If nil, default acap port is used."
 			 "/" wl-acap-dataset-class "/~/" wl-acap-entry-name))
 		       (nreverse settings)))
 	  (message "Storing folders...")
-	  (wl-acap-store-folders proc))
+	  (wl-acap-store-folders proc)
+	  ;; Does not work correctly??
+	  ;;	  (acap-setacl proc (list
+	  ;;			     (concat
+	  ;;			      "/" wl-acap-dataset-class "/~/"))
+	  ;;		       "anyone" "") ; protect.
+	  )
       (acap-close proc))
     (if (interactive-p)
 	(message "Store completed."))))
 
-(provide 'wl-acap)
+(require 'product)
+(product-provide (provide 'wl-acap) (require 'wl-version))
 
 ;;; wl-acap.el ends here