X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Facap.el;h=4948740caa089a8bef06530051c2112f00d454a4;hb=4e796a3f149bcb0aa9824d1cd26285503c35339d;hp=55a02cbc65302793b2c1a9799219b3375a6997a0;hpb=b808793cd3f99d95aca01e9783d593c7a0a3319d;p=elisp%2Fwanderlust.git

diff --git a/elmo/acap.el b/elmo/acap.el
index 55a02cb..4948740 100644
--- 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.
 
@@ -50,6 +50,9 @@
 ;;
 ;; (acap-close proc)
 ;; => t
+;;
+;; Todo:
+;;  * Send literal data for STORE.
 
 ;;; History:
 ;;
@@ -119,6 +122,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)
@@ -128,6 +134,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)))
@@ -157,6 +164,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
@@ -166,7 +176,8 @@ Valid states are `closed', `initial', `auth'.")
 	(if (functionp 'read-passwd)
 	    (read-passwd prompt)
 	  (if (load "passwd" t)
-	      (read-passwd prompt))))))
+	      (read-passwd prompt)
+	    (ange-ftp-read-passwd prompt))))))
 
 ;;; Debug.
 (defvar acap-debug t)
@@ -203,17 +214,17 @@ 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)))
 	 process passphrase mechanism tag)
     (with-current-buffer buffer
+      (erase-buffer)
       (if acap-process
 	  (delete-process acap-process))
       (setq process (acap-network-stream-open buffer server port type)
 	    acap-process process)
-      (erase-buffer)
       (set-buffer-multibyte nil)
       (buffer-disable-undo)
       (setq acap-state 'initial)
@@ -275,6 +286,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))
@@ -347,7 +359,42 @@ Examples:
 (defun acap-store (process entries)
   "Execute STORE command on PROCESS.
 ENTRIES is a store-entry list."
-  (acap-send-command-wait process (concat "STORE " (prin1-to-string entries))))
+  (with-temp-buffer
+    ;; As far as I know, current implementation of ACAP server
+    ;; (cyrus-smlacapd 0.5) does not accept literal argument for STORE.
+    ;; If literal argument is available, command arguments can be sent using
+    ;; function `acap-send-command-wait'.
+    (set-buffer-multibyte nil)
+    (insert "STORE (")
+    (let (beg tag)
+      (while entries
+	(cond
+	 ((stringp (car entries))
+	  (setq beg (point))
+	  (insert (car entries))
+	  (goto-char beg)
+	  (while (re-search-forward "\\\\" nil t)
+	    (replace-match "\\\\\\\\"))
+	  (goto-char beg)
+	  (while (re-search-forward "\"" nil t)
+	    (replace-match "\\\\\""))
+	  (goto-char beg)
+	  (insert "\"")
+	  (goto-char (point-max))
+	  (insert "\""))
+	 ((symbolp (car entries))
+	  (insert (prin1-to-string (car entries)))))
+	(if (cdr entries)(insert " "))
+	(setq entries (cdr entries)))
+      (insert ")")
+      (goto-char (point-min))
+      (insert (with-current-buffer (process-buffer process)
+		(number-to-string (setq tag (setq acap-tag (1+ acap-tag)))))
+	      " ")
+      (process-send-region process (point-min) (point-max))
+      (acap-debug (concat (buffer-string) acap-client-eol))
+      (process-send-string process acap-client-eol)
+      (acap-wait-for-response process tag))))
 
 (defun acap-deletedsince (process name time)
   "Execute DELETEDSINCE command on PROCESS."
@@ -403,6 +450,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))
 
@@ -494,13 +547,18 @@ 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 (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))
 
@@ -658,9 +716,9 @@ ENTRIES is a store-entry list."
     rlist))
 
 (defun acap-parse-return-metadata-or-return-metalist ()
-  (or (acap-parse-nil)
-      (acap-parse-string)
-      (acap-parse-value-or-return-metalist)))
+  (or (acap-parse-string)
+      (acap-parse-value-or-return-metalist)
+      (and (acap-parse-nil) nil)))
 
 (defun acap-parse-value-or-return-metalist ()
   (when (eq (char-after (point)) ?\()
@@ -687,9 +745,9 @@ ENTRIES is a store-entry list."
 
 ;;   return-metadata    = nil / string / value-list / acl
 (defun acap-parse-return-metadata ()
-  (or (acap-parse-nil)
-      (acap-parse-string)
+  (or (acap-parse-string)
       (acap-parse-value-list)
+      (and (acap-parse-nil) nil)
       ;; (acap-parse-acl) acl is same as value-list.
       ))
 
@@ -757,10 +815,8 @@ ENTRIES is a store-entry list."
 			       (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)
-	   (delete-process acap-process))
+	  ((BYE Bye bye)  
+	   (cons 'bye (acap-parse-resp-body)))
 	  (CHANGE (cons 'change
 			(list (acap-parse-quoted)
 			      (progn