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

Add optional message flags argument to imap-append.

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
collects/net/imap.rkt
View File

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

5
collects/net/scribblings/imap.scrbl
View File

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