suzanne.soy/compatibility
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Added imap-append function

Browse Source 
original commit: b01480fd9521f504be3f9723826f122a0653e043
This commit is contained in:
Adam Wick 2003-04-15 22:27:52 +00:00
parent 103125ae1a
commit 6f06fdc407
2 changed files with 18 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/net/imap-sig.ss
View File

@ -14,7 +14,7 @@
imap-status imap-status
imap-get-messages imap-get-messages
imap-copy imap-copy imap-append
imap-store imap-flag->symbol symbol->imap-flag imap-store imap-flag->symbol symbol->imap-flag
imap-expunge imap-expunge

19
collects/net/imap-unit.ss
View File

@ -140,7 +140,7 @@
eol-k eop-k) eol-k eop-k)
(error 'imap-read "failure reading atom: ~a" s)))])]))) (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)]) (let ([id (make-msg-id)])
(log "sending ~a~a~n" id cmd) (log "sending ~a~a~n" id cmd)
(fprintf w "~a~a~a" id cmd crlf) (fprintf w "~a~a~a" id cmd crlf)
@ -158,7 +158,11 @@
(info-handler info)) (info-handler info))
(loop)] (loop)]
[(starts-with? l "+ ") [(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 [else
(log-warning "warning: unexpected response for ~a: ~a" id l) (log-warning "warning: unexpected response for ~a: ~a" id l)
(loop)]))))) (loop)])))))
@ -328,6 +332,17 @@
(str->arg dest-mailbox)) (str->arg dest-mailbox))
void)))) 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) (define (imap-expunge imap)
(let ([r (imap-connection-r imap)] (let ([r (imap-connection-r imap)]
[w (imap-connection-w imap)]) [w (imap-connection-w imap)])