From: teranisi <teranisi>
Date: Tue, 28 Aug 2001 01:00:01 +0000 (+0000)
Subject: * acap.el: New file.
X-Git-Tag: wl-2_7_3~19
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=43c361c04976918c3b14b94dbe54e1a952a8093c;p=elisp%2Fwanderlust.git

* acap.el: New file.
---

diff --git a/elmo/ChangeLog b/elmo/ChangeLog
index c2812ac..220511c 100644
--- a/elmo/ChangeLog
+++ b/elmo/ChangeLog
@@ -1,3 +1,7 @@
+2001-08-28  Yuuichi Teranishi  <teranisi@gohome.org>
+
+	* acap.el: New file.
+
 2001-08-20  Tatsuya Kinoshita <tats@iris.ne.jp>
 
 	* elmo-pop3.el (elmo-pop3-parse-uidl-response): Allow multiple
diff --git a/elmo/acap.el b/elmo/acap.el
new file mode 100644
index 0000000..a52406d
--- /dev/null
+++ b/elmo/acap.el
@@ -0,0 +1,838 @@
+;;; acap.el --- An ACAP interface.
+
+;; Author: Yuuichi Teranishi <teranisi@gohome.org>
+;; Keywords: ACAP
+
+;; Copyright (C) 2001 Yuuichi Teranishi <teranisi@gohome.org>
+
+;; This file is not part of GNU Emacs
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+;;
+
+;;; Commentary:
+;;  Some codes are based on imap.el.
+
+;;; History:
+;; 
+
+;;; Code:
+
+(eval-when-compile
+  (require 'cl)
+  (require 'static))
+(require 'pces)
+(require 'sasl)
+
+;; User variables.
+(defgroup acap nil
+  "Low level ACAP issues."
+  :group 'applications)
+
+(defcustom acap-default-user (user-login-name)
+  "Default username to use."
+  :type 'string
+  :group 'acap)
+
+(defcustom acap-default-port 674
+  "Default port for ACAP."
+  :type 'integer
+  :group 'acap)
+
+(defcustom acap-stock-passphrase nil
+  "Stock passphrase on memory if t."
+  :type 'boolean
+  :group 'acap)
+
+;; Constants.
+(defconst acap-server-eol "\r\n"
+  "The EOL string sent from the server.")
+
+(defconst acap-client-eol "\r\n"
+  "The EOL string sent from the server.")
+
+;; Internal variables.
+(defvar acap-state 'closed
+  "ACAP state.
+Valid states are `closed', `initial', `auth'.")
+
+(defvar acap-capability nil
+  "Capability for server.")
+
+(defvar acap-reached-tag 0
+  "Lower limit on command tags that have been parsed.")
+
+(defvar acap-tag 0
+  "Command tag number.")
+
+(defvar acap-auth nil
+  "Authenticated mechanism name.")
+
+(defvar acap-process nil
+  "Process for the buffer.")
+
+(defvar acap-server nil
+  "Server name.")
+
+(defvar acap-port nil
+  "Port number.")
+
+(defvar acap-response nil
+  "ACAP Response.")
+
+(make-variable-buffer-local 'acap-state)
+(make-variable-buffer-local 'acap-auth)
+(make-variable-buffer-local 'acap-capability)
+(make-variable-buffer-local 'acap-reached-tag)
+(make-variable-buffer-local 'acap-failed-tag)
+(make-variable-buffer-local 'acap-tag)
+(make-variable-buffer-local 'acap-server)
+(make-variable-buffer-local 'acap-port)
+(make-variable-buffer-local 'acap-response)
+
+(defvar acap-network-stream-alist
+  '((default . open-network-stream-as-binary)))
+
+(defun acap-network-stream-open (buffer server port &optional type)
+  (let* ((port (or port acap-default-port))
+	 (process (funcall (cdr (assq (or type 'default)
+				      acap-network-stream-alist))
+			   "ACAP" buffer server port)))
+    (when process
+      (with-current-buffer buffer
+	(while (and (memq (process-status process) '(open run))
+		    (goto-char (point-min))
+		    (not (setq acap-capability (acap-parse-greeting))))
+	  (message "Waiting for response from %s..." server)
+	  (accept-process-output process 1))
+	(message "Waiting for response from %s...done" server)
+	(when (memq (process-status process) '(open run))
+	  process)))))
+
+(defvar acap-passphrase nil)
+(defvar acap-rp-user nil)
+(defvar acap-rp-server nil)
+(defvar acap-rp-auth nil)
+
+(defvar acap-passphrase-alist nil)
+
+(defun acap-read-passphrase (prompt)
+  "Prompt is not used."
+  (or acap-passphrase
+      (progn
+	(setq prompt (format "%s passphrase for %s@%s: "
+			     acap-rp-auth acap-rp-user acap-rp-server))
+	(if (functionp 'read-passwd)
+	    (read-passwd prompt)
+	  (if (load "passwd" t)
+	      (read-passwd prompt))))))
+
+;;; Debug.
+(defvar acap-debug t)
+(defvar acap-debug-buffer nil)
+(defun acap-debug (string)
+  "Insert STRING to the debug buffer."
+  (when acap-debug
+    (if (or (null acap-debug-buffer)
+	    (not (bufferp acap-debug-buffer))
+	    (not (buffer-live-p acap-debug-buffer)))
+	(setq acap-debug-buffer (get-buffer-create "*Debug acap*")))
+    (with-current-buffer acap-debug-buffer
+      (goto-char (point-max))
+      (insert string))))
+
+;;; Stock passphrase (Not implemented yet)
+(defun acap-stock-passphrase (user server auth passphrase)
+  (let ((key (format "%s/%s/%s" user server auth))
+	pair)
+    (when (setq pair (assoc key acap-passphrase-alist))
+      (setq acap-passphrase-alist (delete pair acap-passphrase-alist)))
+    (setq acap-passphrase-alist (cons
+				 (cons key passphrase)
+				 acap-passphrase-alist))))
+
+(defun acap-stocked-passphrase (user server auth)
+  (when acap-stock-passphrase
+    (let ((key (format "%s/%s/%s" user server auth)))
+      (cdr (assoc key acap-passphrase-alist)))))
+
+(defun acap-remove-stocked-passphrase (user server auth)
+  (let ((key (format "%s/%s/%s" user server auth)))
+    (setq acap-passphrase-alist
+	  (delq (assoc key acap-passphrase-alist)
+		acap-passphrase-alist))))
+
+;;; Open, Close 
+(defun acap-open (user server &optional auth port type)
+  (let* ((buffer (get-buffer-create (concat " *acap on " user " at " server)))
+	 process passphrase mechanism tag)
+    (with-current-buffer 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)
+      (set-process-filter process 'acap-arrival-filter)
+      (set-process-sentinel process 'acap-sentinel)
+      (while (and (memq (process-status process) '(open run))
+		  (not (eq acap-state 'auth)))
+	(setq acap-auth
+	      (unwind-protect
+		  (let* ((mechanism
+			  (sasl-find-mechanism
+			   (if auth
+			       (list auth)
+			     (cdr (or (assq 'Sasl acap-capability)
+				      (assq 'SASL acap-capability))))))
+			 (sclient
+			  (sasl-make-client mechanism user "acap" server))
+			 (sasl-read-passphrase 'acap-read-passphrase)
+			 (acap-rp-user user)
+			 (acap-rp-server server)
+			 (acap-rp-auth (sasl-mechanism-name mechanism))
+			 acap-passphrase step response cont-string)
+		    (unless (string= (sasl-mechanism-name mechanism)
+				     "ANONYMOUS")
+		      (setq acap-passphrase (acap-read-passphrase nil)))
+		    (setq tag (acap-send-command
+			       process
+			       (concat
+				(format "AUTHENTICATE \"%s\""
+					(sasl-mechanism-name mechanism))
+				(if (and (setq step
+					       (sasl-next-step sclient nil))
+					 (sasl-step-data step))
+				    (concat " " (prin1-to-string
+						 (sasl-step-data step)))))))
+		    (when (setq response (acap-wait-for-response process tag))
+		      (while (acap-response-cont-p response)
+			(sasl-step-set-data
+			 step (acap-response-cont-string response))
+			(acap-response-clear process)
+			(if (setq step (sasl-next-step sclient step))
+			    (with-temp-buffer
+			      (insert (or (sasl-step-data step) ""))
+			      (setq response (acap-send-data-wait
+					      process (current-buffer) tag)))
+			  (setq response nil)))
+		      (if (acap-response-ok-p response)
+			  (progn
+			    (setq acap-state 'auth)
+			    mechanism)
+			(message "Authentication failed.")
+			(sit-for 1))))
+		nil)))
+      (unless acap-auth
+	(message "acap: Connecting to %s...failed" server))
+      (setq acap-server server
+	    acap-port port)
+      process)))
+
+(defun acap-close (process)
+  (with-current-buffer (process-buffer process)
+    (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))
+      (delete-process process))
+    (erase-buffer)
+    t))
+
+;;; Commands
+
+(defun acap-noop (process)
+  "Execute NOOP command on PROCESS."
+  (acap-send-command-wait process "NOOP"))
+
+(defun acap-lang (process lang-list)
+  "Execute LANG command on PROCESS."
+  (acap-send-command-wait process
+			  (mapconcat
+			   'identity
+			   (nconc (list "LANG")
+				  (mapcar 'prin1-to-string lang-list))
+			   " ")))
+
+(defun acap-search (process target &optional modifier criteria)
+  "Execute SEARCH command on PROCESS.
+TARGET is a string which specifies what is to be searched
+\(dataset or context name\).
+MODIFIER is an alist of modifiers. Each element should be a list like
+\(MODIFIER-NAME DATA1 DATA2...\).
+CRITERIA is a search criteria string.
+If CRITERIA is not specified, \"ALL\" is assumed,
+Modifiers and search criteria are described in section 6.4.1 of RFC2244.
+
+Examples:
+\(acap-search process
+	     \"/addressbook/\"
+	     '\((DEPTH 3\)
+               \(RETURN \(\"addressbook.Alias\"
+                        \"addressbook.Email\"
+                        \"addressbook.List\"\)\)\)
+	     \"OR NOT EQUAL \\\"addressbook.Email\\\" \\\"i\;octed\\\" NIL\\
+                 NOT EQUAL \\\"addressbook.Email\\\" \\\"i\;octed\\\" NIL\"\)
+
+\(acap-search process
+	     \"/addressbook/user/fred/\"
+	     '\(\(RETURN \(\"*\"\)\)
+	     \"EQUAL \\\"entry\\\" \\\"i\;octed\\\" \\\"A0345\\\"\"\)"
+  (acap-send-command-wait process
+			  (concat "SEARCH " (prin1-to-string target)
+				  (if modifier " ")
+				  (mapconcat
+				   'prin1-to-string
+				   (acap-flatten modifier)
+				   " ")
+				  " "
+				  (or criteria "ALL"))))
+
+(defun acap-freecontext (process name)
+  "Execute FREECONTEXT command on PROCESS."
+  (acap-send-command-wait process
+			  (concat "FREECONTEXT " name)))
+
+(defun acap-updatecontext (process names)
+  "Execute UPDATECONTEXT command on PROCESS."
+  (acap-send-command-wait process
+			  (mapconcat
+			   'identity
+			   (nconc (list "FREECONTEXT") names)
+			   " ")))
+
+(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))))
+
+(defun acap-deletedsince (process name time)
+  "Execute DELETEDSINCE command on PROCESS."
+  (acap-send-command-wait process
+			  (concat "DELETEDSINCE "
+				  (prin1-to-string name)
+				  " "
+				  (prin1-to-string (acap-encode-time time)))))
+
+(defun acap-setacl (process object identifier rights)
+  "Execute SETACL command on PROCESS."
+  (acap-send-command-wait process
+			  (concat "SETACL "
+				  (prin1-to-string object)
+				  " "
+				  (prin1-to-string identifier)
+				  " "
+				  (prin1-to-string rights))))
+
+(defun acap-deleteacl (process object &optional identifier)
+  "Execute DELETEACL command on PROCESS."
+  (acap-send-command-wait process
+			  (concat
+			   "DELETEACL "
+			   (prin1-to-string object)
+			   (if identifier
+			       (concat " " (prin1-to-string identifier))))))
+
+(defun acap-myrights (process object)
+  "Execute MYRIGHTS command on PROCESS."
+  (acap-send-command-wait process
+			  (concat
+			   "MYRIGHTS "
+			   (prin1-to-string object))))
+
+(defun acap-listrights (process object identifier)
+  "Execute LISTRIGHTS command on PROCESS."
+  (acap-send-command-wait process
+			  (concat
+			   "LISTRIGHTS "
+			   (prin1-to-string object)
+			   " "
+			   (prin1-to-string identifier))))
+
+(defun acap-getquota (process dataset)
+  "Execute GETQUOTA command on PROCESS."
+  (acap-send-command-wait process
+			  (concat
+			   "GETQUOTA "
+			   (prin1-to-string dataset))))
+
+;;; response accessor.
+(defun acap-response-ok-p (response)
+  (assq 'done-ok response))
+
+(defun acap-response-cont-p (response)
+  (assq 'cont response))
+
+(defun acap-response-cont-string (response)
+  (cdr (assq 'cont response)))
+
+(defun acap-response-body (response)
+  (cdr (or (assq 'done-ok response)
+	   (assq 'done-no response)
+	   (assq 'done-bad response))))
+
+(defun acap-response-entries (response)
+  (let (entries)
+    (dolist (ent response)
+      (if (eq (car ent) 'entry)
+	  (setq entries (cons ent entries))))
+    entries))
+
+(defun acap-response-entry-entry (entry)
+  (car (cdr entry)))
+
+(defun acap-response-entry-return-data-list (entry)
+  (nth 1 (cdr entry)))
+
+(defun acap-response-return-data-list-get-value (name return-data-list)
+  (nth 1 (assoc name return-data-list)))
+
+(defun acap-response-listrights (response)
+  (cdr (assq 'listrights response)))
+
+;;; Send command, data.
+(defun acap-response-clear (process)
+  (with-current-buffer (process-buffer process)
+    (setq acap-response nil)))
+
+(defun acap-send-command-wait (process command)
+  (acap-wait-for-response process (acap-send-command process command)))
+
+(defun acap-send-data-wait (process string tag)
+  (cond ((stringp string)
+	 (acap-send-command-1 process string))
+	((bufferp string)
+	 (with-current-buffer string
+	   (acap-response-clear process)
+	   (acap-send-command-1 process (format "{%d}" (buffer-size)))
+	   (if (acap-response-cont-p (acap-wait-for-response process tag))
+	       (with-current-buffer string
+		 (acap-response-clear process)
+		 (process-send-region process (point-min)
+				      (point-max))
+		 (process-send-string process acap-client-eol)))
+	   (acap-debug (concat (buffer-string) acap-client-eol)))))
+  (acap-wait-for-response process tag))
+
+(defun acap-send-command-1 (process cmdstr)
+  (acap-debug (concat "<-" cmdstr acap-client-eol))
+  (process-send-string process (concat cmdstr acap-client-eol)))
+
+(defun acap-send-command (process command)
+  (with-current-buffer (process-buffer process)
+    (setq acap-response nil)
+    (if (not (listp command)) (setq command (list command)))
+    (let ((tag (setq acap-tag (1+ acap-tag)))
+	  cmd cmdstr response)
+      (setq cmdstr (concat (number-to-string acap-tag) " "))
+      (while (setq cmd (pop command))
+	(cond ((stringp cmd)
+	       (setq cmdstr (concat cmdstr cmd)))
+	      ((bufferp cmd)
+	       (with-current-buffer cmd
+		 (setq cmdstr (concat cmdstr (format "{%d}" (buffer-size)))))
+	       (unwind-protect
+		   (progn
+		     (acap-send-command-1 process cmdstr)
+		     (setq cmdstr nil
+			   response (acap-wait-for-response process tag))
+		     (if (not (acap-response-cont-p response))
+			 (setq command nil) ;; abort command if no cont-req
+		       (with-current-buffer cmd
+			 (process-send-region process (point-min)
+					      (point-max))
+			 (process-send-string process acap-client-eol))))))
+	      (t (error "Unknown command type"))))
+      (when cmdstr
+	(acap-send-command-1 process cmdstr))
+      tag)))
+
+(defun acap-wait-for-response (process tag)
+  (with-current-buffer (process-buffer process)
+    (while (and (not (acap-response-cont-p acap-response))
+		(< acap-reached-tag tag))
+      (or (and (not (memq (process-status process) '(open run)))
+	       (sit-for 1))
+ 	  (let ((len (/ (point-max) 1024))
+		message-log-max)
+ 	    (unless (< len 10)
+ 	      (message "acap read: %dk" len))
+ 	    (accept-process-output process 1))))
+    (message "")
+    acap-response))
+
+;;; Sentinel, Filter.
+(defun acap-sentinel (process string)
+  (delete-process process))
+
+(defun acap-find-next-line ()
+  (when (re-search-forward (concat acap-server-eol "\\|{\\([0-9+]+\\)}"
+				   acap-server-eol)
+			   nil t)
+    (if (match-string 1)
+	(if (< (point-max) (+ (point) (string-to-number (match-string 1))))
+	    nil
+	  (goto-char (+ (point) (string-to-number (match-string 1))))
+	  (acap-find-next-line))
+      (point))))
+
+(defun acap-arrival-filter (proc string)
+  "ACAP process filter."
+  (acap-debug string)
+  (with-current-buffer (process-buffer proc)
+    (goto-char (point-max))
+    (insert string)
+    (let (end)
+      (goto-char (point-min))
+      (while (setq end (acap-find-next-line))
+	(save-restriction
+	  (narrow-to-region (point-min) end)
+	  (delete-backward-char (length acap-server-eol))
+	  (goto-char (point-min))
+	  (unwind-protect
+	      (cond ((or (eq acap-state 'auth)
+			 (eq acap-state 'initial)
+			 (eq acap-state 'nonauth))
+		     (acap-parse-response))
+		    (t
+		     (message "Unknown state %s in arrival filter"
+			      acap-state)))
+	    (delete-region (point-min) (point-max))))))))
+
+;;; acap parser.
+(defsubst acap-forward ()
+  (or (eobp) (forward-char)))
+
+(defsubst acap-parse-number ()
+  (when (looking-at "[0-9]+")
+    (prog1
+	(string-to-number (match-string 0))
+      (goto-char (match-end 0)))))
+
+(defsubst acap-parse-literal ()
+  (when (looking-at "{\\([0-9]+\\)}\r\n")
+    (let ((pos (match-end 0))
+	  (len (string-to-number (match-string 1))))
+      (if (< (point-max) (+ pos len))
+	  nil
+	(goto-char (+ pos len))
+	(buffer-substring pos (+ pos len))))))
+
+(defun acap-parse-greeting ()
+  (when (looking-at "* ACAP")
+    (goto-char (match-end 0))
+    (acap-forward)
+    (let (capabilities)
+      (while (eq (char-after (point)) ?\()
+	(push (read (current-buffer)) capabilities)
+	(acap-forward))
+      (nreverse capabilities))))
+
+;; resp-body = ["(" resp-code ")" SP] quoted
+(defun acap-parse-resp-body ()
+  (let ((body (read (current-buffer))))
+    (if (listp body) ; resp-code
+	(list body (read (current-buffer)))
+      (list nil body) ; no resp-code.
+      )))
+
+;;   string          = quoted / literal
+;;
+;;   quoted          = DQUOTE *QUOTED-CHAR DQUOTE
+;;
+;;   QUOTED-CHAR     = <any TEXT-CHAR except quoted-specials> /
+;;                     "\" quoted-specials
+;;
+;;   quoted-specials = DQUOTE / "\"
+;;
+;;   TEXT-CHAR       = <any CHAR except CR and LF>
+
+(defsubst acap-parse-string ()
+  (cond ((eq (char-after) ?\")
+	 (forward-char 1)
+	 (let ((p (point)) (name ""))
+	   (skip-chars-forward "^\"\\\\")
+	   (setq name (buffer-substring p (point)))
+	   (while (eq (char-after) ?\\)
+	     (setq p (1+ (point)))
+	     (forward-char 2)
+	     (skip-chars-forward "^\"\\\\")
+	     (setq name (concat name (buffer-substring p (point)))))
+	   (forward-char 1)
+	   name))
+	((eq (char-after) ?{)
+	 (acap-parse-literal))))
+
+;;   nil             = "NIL"
+
+(defsubst acap-parse-nil ()
+  (if (looking-at "NIL")
+      (goto-char (match-end 0))))
+
+;; entry              = entry-name / entry-path
+;; entry-name         = string-utf8
+;;                        ;; entry name MUST NOT contain slash
+;;                        ;; MUST NOT begin with "."
+;; entry-path         = string-utf8
+;;                        ;; slash-separated path to entry
+;;                        ;; begins with slash
+
+(defsubst acap-parse-quoted ()
+  (if (eq (char-after) ?\")
+      (read (current-buffer))))
+
+(defun acap-parse-entry ()
+  (acap-parse-quoted))
+
+;; value              = string
+(defun acap-parse-value ()
+  (acap-parse-string))
+
+;; value-list         = "(" [value *(SP value)] ")"
+(defun acap-parse-value-list ()
+  ;; same as acl.
+  (when (eq (char-after (point)) ?\()
+    (let (values)
+      (while (not (eq (char-after (point)) ?\)))
+	(acap-forward)
+	(push (acap-parse-value) values))
+      (acap-forward)
+      (nreverse values))))
+
+;;
+;;   return-data-list   = return-data *(SP return-data)
+;;
+;;   return-data        = return-metadata / return-metalist /
+;;                        return-attr-list
+
+(defun acap-parse-return-data-list ()
+  (let (rlist r)
+    (setq rlist (list (acap-parse-return-metadata-or-return-metalist)))
+    (acap-forward)
+    (while (setq r (acap-parse-return-metadata-or-return-metalist))
+      (setq rlist (nconc rlist (list r)))
+      (acap-forward))
+    rlist))
+
+(defun acap-parse-return-metadata-or-return-metalist ()
+  (or (acap-parse-nil)
+      (acap-parse-string)
+      (acap-parse-value-or-return-metalist)))
+
+(defun acap-parse-value-or-return-metalist ()
+  (when (eq (char-after (point)) ?\()
+    (let (elems)
+      (while (not (eq (char-after (point)) ?\)))
+	(acap-forward)
+	(push (or (acap-parse-value)
+		  (acap-parse-return-metalist))
+	      elems))
+      (acap-forward)
+      (nreverse elems))))
+
+;;   return-metalist    = "(" return-metadata *(SP return-metadata) ")"
+;;                        ;; occurs when multiple metadata items requested
+;;
+(defun acap-parse-return-metalist ()
+  (when (eq (char-after (point)) ?\()
+    (let (metadatas)
+      (while (not (eq (char-after (point)) ?\)))
+	(acap-forward)
+	(push (acap-parse-return-metadata) metadatas))
+      (acap-forward)
+      (nreverse metadatas))))
+
+;;   return-metadata    = nil / string / value-list / acl
+(defun acap-parse-return-metadata ()
+  (or (acap-parse-nil)
+      (acap-parse-string)
+      (acap-parse-value-list)
+      ;; (acap-parse-acl) acl is same as value-list.
+      ))
+
+;;   return-attr-list   = "(" return-metalist *(SP return-metalist) ")"
+;;                        ;; occurs when "*" in RETURN pattern on SEARCH
+(defun acap-parse-return-attr-list ()
+  (when (eq (char-after (point)) ?\()
+    (let (metalists)
+      (while (not (eq (char-after (point)) ?\)))
+	(acap-forward)
+	(push (acap-parse-return-metalist) metalists))
+      (acap-forward)
+      (nreverse metalists))))
+
+(defun acap-parse-time ()
+  (acap-parse-quoted))
+
+;; quoted *(SP quoted)
+(defun acap-parse-quoted-list ()
+  (let (qlist q)
+    (setq qlist (list (acap-parse-quoted)))
+    (acap-forward)
+    (while (setq q (acap-parse-quoted))
+      (setq qlist (nconc qlist (list q)))
+      (acap-forward))
+    qlist))
+
+(defun acap-parse-any ()
+  (read (current-buffer)))
+
+(defun acap-parse-extension-data ()
+  (let (elist e)
+    (setq elist (list (acap-parse-any)))
+    (acap-forward)
+    (while (setq e (acap-parse-any))
+      (setq elist (nconc elist (list e)))
+      (acap-forward))
+    elist))
+
+(defun acap-parse-response ()
+  "Parse a ACAP command response."
+  (let ((token (read (current-buffer)))
+	tag)
+    (setq
+     acap-response
+     (cons
+      (cond
+       ((eq token '+)
+	(acap-forward)
+	(cons 'cont (acap-parse-string)))
+       ((eq token '*)
+	;; untagged response.
+	(case (prog1 (setq token (read (current-buffer)))
+		(acap-forward))
+	  (ADDTO (cons 'addto
+		       (list (acap-parse-quoted)
+			     (progn
+			       (acap-forward)
+			       (acap-parse-quoted))
+			     (progn
+			       (acap-forward)
+			       (acap-parse-number))
+			     (progn
+			       (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 (acap-parse-resp-body))
+	   (ding)
+	   (delete-process acap-process))
+	  (CHANGE (cons 'change
+			(list (acap-parse-quoted)
+			      (progn
+				(acap-forward)
+				(acap-parse-quoted))
+			      (progn
+				(acap-forward)
+				(acap-parse-number))
+			      (progn
+				(acap-forward)
+				(acap-parse-number))
+			      (progn
+				(acap-forward)
+				(acap-parse-return-data-list)))))
+	  (LANG (cons 'lang (list (acap-parse-quoted-list))))
+	  ;; response-stat
+	  (OK   (cons 'stat-ok (acap-parse-resp-body)))
+	  (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))))))
+       ((integerp token)
+	;; tagged response.
+	(setq tag token)
+	(case (prog1 (setq token (read (current-buffer)))
+		(acap-forward))
+	  (DELETED   (cons 'deleted (acap-parse-quoted)))
+	  ;; response-done
+	  ((OK Ok ok) (prog1 (cons 'done-ok (acap-parse-resp-body))
+			(setq acap-reached-tag tag)))
+	  ((NO No no)   (prog1 (cons 'done-no (acap-parse-resp-body))
+			  (setq acap-reached-tag tag)))
+	  ((BAD Bad bad) (prog1 (cons 'done-bad (acap-parse-resp-body))
+			   (setq acap-reached-tag tag)))
+	  (ENTRY (cons 'entry
+		       (list
+			(acap-parse-entry)
+			(progn (acap-forward)
+			       (acap-parse-return-data-list)))))
+	  (LISTRIGHTS (cons 'listrights
+			    (acap-parse-quoted-list)))
+	  (MODTIME    (cons 'modtime (acap-parse-time)))
+	  (MYRIGHTS   (cons 'myrights (acap-parse-quoted)))
+	  (QUOTA      (cons 'quota
+			    (list (acap-parse-quoted)
+				  (progn
+				    (acap-forward)
+				    (acap-parse-number))
+				  (progn
+				    (acap-forward)
+				    (acap-parse-number))
+				  (acap-parse-extension-data))))
+	  (REFER      (cons 'refer (list (acap-parse-quoted)
+					 (acap-parse-quoted))))
+	  (REMOVEFROM (cons 'removefrom
+			    (list (acap-parse-quoted)
+				  (progn
+				    (acap-forward)
+				    (acap-parse-quoted))
+				  (progn
+				    (acap-forward)
+				    (acap-parse-number)))))
+	  ;; response-extend
+	  (t ; extend-token
+	   (cons 'extend (list token (acap-parse-extension-data))))))
+       (t ; garbage
+	(list 'garbage token)))
+      acap-response))))
+
+;;; Utilities.
+(defun acap-flatten (l)
+  "Flatten list-of-list."
+  (unless (null l)
+    (append
+     (if (and (car l)
+	      (listp (car l)))
+	 (car l)
+       (list (car l)))
+     (acap-flatten (cdr l)))))
+
+(defun acap-flatten-r (l)
+  "Flatten list-of-list recursively."
+  (cond
+   ((null l) '())
+   ((listp l)
+    (append (acap-flatten (car l)) (acap-flatten (cdr l))))
+   (t (list l))))
+
+(defun acap-encode-time (time)
+  (format-time-string "%Y%m%d%H%M%S" (current-time) t)) ; Universal time.
+
+(defun acap-decode-time (acap-time)
+  (when (string-match "^\\([0-9][0-9][0-9][0-9]\\)\\([0-1][0-9]\\)\\([0-3][0-9]\\)\\([0-2][0-9]\\)\\([0-5][0-9]\\)\\([0-5][0-9]\\)" acap-time)
+    (encode-time (string-to-number (match-string 6 acap-time))
+		 (string-to-number (match-string 5 acap-time))
+		 (string-to-number (match-string 4 acap-time))
+		 (string-to-number (match-string 3 acap-time))
+		 (string-to-number (match-string 2 acap-time))
+		 (string-to-number (match-string 1 acap-time))
+		 t)))
+
+(provide 'acap)
+
+;;; acap.el ends here