Add optional message flags argument to imap-append.

Previously this was hard-coded to use the \Seen flag. Now that's the
default value when the argument is not supplied.
This commit is contained in:
Greg Hendershott 2013-04-23 13:50:28 -04:00 committed by Matthew Flatt
parent 3779cf6192
commit c6e2843557
2 changed files with 17 additions and 8 deletions

View File

@ -3,6 +3,7 @@
(require racket/contract/base
racket/tcp
openssl
racket/format
"private/rbtree.rkt")
;; define the imap struct and its predicate here, for use in the contract, below
@ -16,7 +17,12 @@
[imap-list-child-mailboxes
(->* (imap-connection? (or/c string? bytes? #f))
((or/c string? bytes?))
(listof (list/c (listof symbol?) bytes?)))])
(listof (list/c (listof symbol?) bytes?)))]
[imap-append ((imap? string? (or/c string? bytes?))
((listof
(or/c 'seen 'answered 'flagged 'deleted 'draft 'recent)))
. ->* .
void?)])
(provide
imap-connection?
@ -45,7 +51,7 @@
imap-pending-updates?
imap-get-messages
imap-copy imap-append
imap-copy
imap-store imap-flag->symbol symbol->imap-flag
imap-expunge
@ -539,13 +545,13 @@
(check-ok
(imap-send imap (list "COPY" (box (msg-set msgs)) dest-mailbox) void)))
(define (imap-append imap dest-mailbox msg)
(define (imap-append imap dest-mailbox msg [flags '(seen)])
(no-expunges 'imap-append imap)
(let ([msg (if (bytes? msg) msg (string->bytes/utf-8 msg))])
(check-ok
(imap-send imap (list "APPEND"
dest-mailbox
(box "(\\Seen)")
(box (~a (map symbol->imap-flag flags)))
(box (format "{~a}" (bytes-length msg))))
void
(lambda (loop contin)

View File

@ -416,7 +416,10 @@ Pending expunges must be handled before calling this function; see
@defproc[(imap-append [imap imap-connection?]
[mailbox string?]
[message (or/c string? bytes?)])
[message (or/c string? bytes?)]
[flags (listof (or/c 'seen 'answered 'flagged
'deleted 'draft 'recent))
'(seen)])
void?]{
Adds a new message (containing @racket[message]) to the given