From 6f06fdc407a72f6fed53f3773183f7ed937ad3fd Mon Sep 17 00:00:00 2001
From: Adam Wick <awick@cs.utah.edu>
Date: Tue, 15 Apr 2003 22:27:52 +0000
Subject: [PATCH] Added imap-append function

original commit: b01480fd9521f504be3f9723826f122a0653e043
---
 collects/net/imap-sig.ss  |  2 +-
 collects/net/imap-unit.ss | 19 +++++++++++++++++--
 2 files changed, 18 insertions(+), 3 deletions(-)

diff --git a/collects/net/imap-sig.ss b/collects/net/imap-sig.ss
index 6d28ae3..83c8458 100644
--- a/collects/net/imap-sig.ss
+++ b/collects/net/imap-sig.ss
@@ -14,7 +14,7 @@
      imap-status
 
      imap-get-messages
-     imap-copy
+     imap-copy imap-append
      imap-store imap-flag->symbol symbol->imap-flag
      imap-expunge
      
diff --git a/collects/net/imap-unit.ss b/collects/net/imap-unit.ss
index e1a42c6..dff1295 100644
--- a/collects/net/imap-unit.ss
+++ b/collects/net/imap-unit.ss
@@ -140,7 +140,7 @@
 				eol-k eop-k)
 			  (error 'imap-read "failure reading atom: ~a" s)))])])))
 
-      (define (imap-send r w cmd info-handler)
+      (define (imap-send r w cmd info-handler . continuation-handler)
 	(let ([id (make-msg-id)])
 	  (log "sending ~a~a~n" id cmd)
 	  (fprintf w "~a~a~a" id cmd crlf)
@@ -158,7 +158,11 @@
 		  (info-handler info))
 		(loop)]
 	       [(starts-with? l "+ ")
-		(error 'imap-send "unexpected continuation request: ~a" l)]
+                (if (null? continuation-handler)
+                    (error 'imap-send "unexpected continuation request: ~a" l)
+                    (begin
+                      ((car continuation-handler) (imap-read (skip l 2) r))
+                      (loop)))]
 	       [else
 		(log-warning "warning: unexpected response for ~a: ~a" id l)
 		(loop)])))))
@@ -328,6 +332,17 @@
 			      (str->arg dest-mailbox))
 		      void))))
       
+      (define (imap-append imap dest-mailbox msg)
+        (let ([r (imap-connection-r imap)]
+              [w (imap-connection-w imap)])
+          (check-ok
+           (imap-send r w (format "APPEND ~a (\\Seen) {~a}"
+                                  dest-mailbox (string-length msg))
+                      void
+                      (lambda (contin)
+                        (fprintf w "~a~n" msg))))))
+                      
+      
       (define (imap-expunge imap)
 	(let ([r (imap-connection-r imap)]
 	      [w (imap-connection-w imap)])