imap: Add some combinators, fix up some docs, add docs, fix up unit tests.
Doug Coleman
parent
29006e4a86
commit
bc89b6c7d5
|
|
@ -1,9 +1,21 @@
|
|||
USING: calendar help.markup help.syntax sequences strings ;
|
||||
USING: calendar help.markup help.syntax sequences strings
|
||||
quotations ;
|
||||
IN: imap
|
||||
|
||||
ARTICLE: "imap" "IMAP library"
|
||||
"The " { $vocab-link "imap" } " vocab implements a large part of the IMAP4rev1 client protocol."
|
||||
$nl
|
||||
"IMAP is primarily used for retrieving and managing email and folders on an IMAP server. Note that some IMAP servers, such as " { $snippet "imap.gmail.com" } ", require application-specific passwords."
|
||||
$nl
|
||||
"Configuration:"
|
||||
{ $subsections
|
||||
imap-settings
|
||||
}
|
||||
"Combinators:"
|
||||
{ $subsections
|
||||
with-imap
|
||||
with-imap-settings
|
||||
}
|
||||
"Constructing an IMAP session:"
|
||||
{ $subsections <imap4ssl> }
|
||||
"IMAP folder management:"
|
||||
|
|
@ -23,21 +35,20 @@ $nl
|
|||
{ $examples
|
||||
{ $code
|
||||
"USING: imap ; "
|
||||
"\"imap-server\" <imap4ssl> [ \"mail@example.com\" \"password\" login drop ] with-stream"
|
||||
""""imap.gmail.com" "email_address@gmail.com" "password" [ list-folders ] with-imap"""
|
||||
}
|
||||
{ $code
|
||||
"USING: imap ; "
|
||||
"\"imap-server\" <imap4ssl> ["
|
||||
" \"mail@example.com\" \"password\" login drop"
|
||||
" \"factor\" select-folder drop "
|
||||
" \"ALL\" \"\" search-mails"
|
||||
" \"(BODY[HEADER.FIELDS (SUBJECT)])\" fetch-mails"
|
||||
"] with-stream 3 head ."
|
||||
"{"
|
||||
" \"Subject: [Factor-talk] Wiki Tutorial\\r\\n\\r\\n\""
|
||||
" \"Subject: Re: [Factor-talk] font-size in listener\\r\\n\\r\\n\""
|
||||
" \"Subject: Re: [Factor-talk] Indentation width and other style guidelines\\r\\n\\r\\n\""
|
||||
"}"
|
||||
{ $unchecked-example
|
||||
"""USING: imap namespaces ;
|
||||
\\ imap-settings get-global [
|
||||
"factor" select-folder drop
|
||||
"ALL" "" search-mails
|
||||
"(BODY[HEADER.FIELDS (SUBJECT)])" fetch-mails
|
||||
] with-imap-settings 3 head ."""
|
||||
"""{
|
||||
"Subject: [Factor-talk] Wiki Tutorial"
|
||||
"Subject: Re: [Factor-talk] font-size in listener"
|
||||
"Subject: Re: [Factor-talk] Indentation width and other style guidelines"
|
||||
}"""
|
||||
}
|
||||
} ;
|
||||
|
||||
|
|
@ -81,13 +92,12 @@ HELP: status-folder
|
|||
}
|
||||
{ $description "Requests a collection of attributes for the specified folder." }
|
||||
{ $examples
|
||||
{ $code
|
||||
"USE: imap"
|
||||
"\"imap-host\" <imap4ssl> [ "
|
||||
" \"email\" \"pwd\" login drop "
|
||||
" \"INBOX\" { \"MESSAGES\" \"UNSEEN\" } status-folder "
|
||||
"] with-stream ."
|
||||
"{ { \"MESSAGES\" 67 } { \"UNSEEN\" 18 } }"
|
||||
{ $unchecked-example
|
||||
"""USING: imap ;
|
||||
\\ imap-settings get-global [
|
||||
"INBOX" { "MESSAGES" "UNSEEN" } status-folder
|
||||
] with-imap-settings"""
|
||||
"""{ { "MESSAGES" 67 } { "UNSEEN" 18 } }"""
|
||||
}
|
||||
} ;
|
||||
|
||||
|
|
@ -135,3 +145,42 @@ HELP: store-mail
|
|||
{ "mail-flags" "Flags of mails after update" }
|
||||
}
|
||||
{ $description "Updates the attributes of a set of mails." } ;
|
||||
|
||||
HELP: imap-settings
|
||||
{ $var-description "A tuple for holding the host, email, and password for an IMAP account. Setting this information as a global variable in your .factor-rc or .factor-bootstrap-rc is recommended." }
|
||||
{ $examples
|
||||
"Run the next example and click the link to edit your boot rc:"
|
||||
{ $unchecked-example
|
||||
|
||||
"USING: imap tools.scaffold ; "
|
||||
"scaffold-factor-boot-rc"
|
||||
""
|
||||
}
|
||||
"Add the following settings to your bootstrap rc file:"
|
||||
{ $unchecked-example
|
||||
"USING: imap namespaces ;"
|
||||
""""imap.gmail.com" "foo@gmail.com" "password" <imap-settings> \\ imap-settings set-global"""
|
||||
""
|
||||
}
|
||||
"Run your boot rc again:"
|
||||
{ $unchecked-example
|
||||
"USING: command-line ;"
|
||||
"run-bootstrap-init"
|
||||
""
|
||||
}
|
||||
}
|
||||
{ $see-also with-imap-settings } ;
|
||||
|
||||
HELP: with-imap
|
||||
{ $values
|
||||
{ "host" string } { "email" string } { "password" string } { "quot" quotation }
|
||||
}
|
||||
{ $description "Logs into the IMAP server with the provided settings. The quotation should contain code to execute once authentication has aloready occurred." } ;
|
||||
|
||||
HELP: with-imap-settings
|
||||
{ $values
|
||||
{ "imap-settings" imap-settings } { "quot" quotation }
|
||||
}
|
||||
{ $description "Logs into the IMAP server with the provided settings. The quotation should contain code to execute once authentication has aloready occurred." } ;
|
||||
|
||||
{ with-imap with-imap-settings } related-words
|
||||
|
|
|
|||
|
|
@ -4,9 +4,6 @@ math math.parser math.ranges math.statistics namespaces pcre random sequences
|
|||
sets sorting strings tools.test ;
|
||||
IN: imap.tests
|
||||
|
||||
! Set these to your email account.
|
||||
SYMBOLS: email host password ;
|
||||
|
||||
: random-ascii ( n -- str )
|
||||
[ CHAR: a CHAR: z [a,b] random ] "" replicate-as ;
|
||||
|
||||
|
|
@ -27,22 +24,13 @@ SYMBOLS: email host password ;
|
|||
: sample-mail ( -- mail )
|
||||
"Fred Foobar <foobar@Blurdybloop.COM>" make-mail ;
|
||||
|
||||
! Fails unless you have set the settings.
|
||||
: imap-login ( -- imap4 )
|
||||
host get <imap4ssl> dup [
|
||||
email get password get login drop
|
||||
] with-stream* ;
|
||||
|
||||
ERROR: host-not-set ;
|
||||
ERROR: no-imap-test-host ;
|
||||
|
||||
: get-test-host ( -- host )
|
||||
host get dup [ host-not-set throw ] unless ;
|
||||
|
||||
: ensure-host ( -- ) get-test-host drop ;
|
||||
\ imap-settings get-global host>> [ no-imap-test-host ] unless* ;
|
||||
|
||||
: imap-test ( result quot -- )
|
||||
ensure-host
|
||||
'[ imap-login _ with-stream ] unit-test ; inline
|
||||
'[ \ imap-settings get-global _ with-imap-settings ] unit-test ; inline
|
||||
|
||||
[ t ] [
|
||||
get-test-host <imap4ssl> duplex-stream?
|
||||
|
|
@ -62,11 +50,7 @@ ERROR: host-not-set ;
|
|||
[ get-test-host <imap4ssl> [ f f login ] with-stream ] [ ind>> ] recover
|
||||
] unit-test
|
||||
|
||||
[ f ] [
|
||||
get-test-host <imap4ssl> [
|
||||
email get password get login
|
||||
] with-stream empty?
|
||||
] unit-test
|
||||
[ ] [ \ imap-settings get-global [ ] with-imap-settings ] unit-test
|
||||
|
||||
! Newly created and then selected folder is empty.
|
||||
[ 0 { } ] [
|
||||
|
|
|
|||
|
|
@ -168,3 +168,19 @@ PRIVATE>
|
|||
: store-mail ( uids command flags -- mail-flags )
|
||||
[ comma-list ] 2dip "UID STORE %s %s %s" sprintf "" command-response
|
||||
parse-store-mail ;
|
||||
|
||||
! High level API
|
||||
|
||||
: with-imap ( host email password quot -- )
|
||||
[ <imap4ssl> ] 3dip '[ _ _ login drop @ ] with-stream ; inline
|
||||
|
||||
TUPLE: imap-settings host email password ;
|
||||
|
||||
: <imap-settings> ( host email password -- obj )
|
||||
imap-settings new
|
||||
swap >>password
|
||||
swap >>email
|
||||
swap >>host ; inline
|
||||
|
||||
: with-imap-settings ( imap-settings quot -- )
|
||||
[ [ host>> ] [ email>> ] [ password>> ] tri ] dip with-imap ; inline
|
||||
|
|
|
|||
Loading…
Reference in New Issue