X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Facap.el;h=4948740caa089a8bef06530051c2112f00d454a4;hb=08fe50f15e7aed9643f87a7cbb552690c6908318;hp=54a87badf56b2e2390580d51a4a2922126f944ce;hpb=035f323239fb659aad17e7c111217fa4dd9314cb;p=elisp%2Fwanderlust.git diff --git a/elmo/acap.el b/elmo/acap.el index 54a87ba..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. @@ -122,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) @@ -131,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))) @@ -160,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 @@ -169,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) @@ -206,7 +214,7 @@ 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))) @@ -278,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)) @@ -368,7 +377,7 @@ ENTRIES is a store-entry list." (replace-match "\\\\\\\\")) (goto-char beg) (while (re-search-forward "\"" nil t) - (replace-match "\\\\\"")) + (replace-match "\\\\\"")) (goto-char beg) (insert "\"") (goto-char (point-max)) @@ -441,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)) @@ -532,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)) @@ -795,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) - ) + ((BYE Bye bye) + (cons 'bye (acap-parse-resp-body))) (CHANGE (cons 'change (list (acap-parse-quoted) (progn