X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Facap.el;h=df0dbe4387c3e6e47f6c60b1210128b788a9b9c6;hb=fb40159a1fc3d4fb1400f8fe3befb1056bc75b8c;hp=384f3b738d63a2916860bfbbba12051b835974c9;hpb=ae97a1d6f3c425bea23e48ddc4b319b873a7f94a;p=elisp%2Fwanderlust.git diff --git a/elmo/acap.el b/elmo/acap.el index 384f3b7..df0dbe4 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,19 @@ 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 "%s" + (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)) @@ -756,11 +815,9 @@ ENTRIES is a store-entry list." (acap-forward) (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) - ) + (message "%s" (nth 1 (acap-parse-resp-body)))) + ((BYE Bye bye) + (cons 'bye (acap-parse-resp-body))) (CHANGE (cons 'change (list (acap-parse-quoted) (progn @@ -781,7 +838,7 @@ ENTRIES is a store-entry list." (NO (cons 'stat-no (acap-parse-resp-body))) (BAD ;(cons 'stat-bad (acap-parse-resp-body)) ;; XXX cyrus-sml-acap does not return tagged bad response? - (error (nth 1 (acap-parse-resp-body)))))) + (error "%s" (nth 1 (acap-parse-resp-body)))))) ((integerp token) ;; tagged response. (setq tag token)