imap: Add some combinators, fix up some docs, add docs, fix up unit tests.

extra/imap/imap-docs.factor

@@ -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
+  { $unchecked-example
-    "USING: imap ; "
+    """USING: imap namespaces ;
-    "\"imap-server\" <imap4ssl> ["
+    \\ imap-settings get-global [
-    "    \"mail@example.com\" \"password\" login drop"
+        "factor" select-folder drop
-    "    \"factor\" select-folder drop "
+        "ALL" "" search-mails
-    "    \"ALL\" \"\" search-mails"
+        "(BODY[HEADER.FIELDS (SUBJECT)])" fetch-mails
-    "    \"(BODY[HEADER.FIELDS (SUBJECT)])\" fetch-mails"
+    ] with-imap-settings 3 head ."""
-    "] with-stream 3 head ."
+    """{
-    "{"
+    "Subject: [Factor-talk] Wiki Tutorial"
-    "    \"Subject: [Factor-talk] Wiki Tutorial\\r\\n\\r\\n\""
+    "Subject: Re: [Factor-talk] font-size in listener"
-    "    \"Subject: Re: [Factor-talk] font-size in listener\\r\\n\\r\\n\""
+    "Subject: Re: [Factor-talk] Indentation width and other style guidelines"
-    "    \"Subject: Re: [Factor-talk] Indentation width and other style guidelines\\r\\n\\r\\n\""
+}"""
-    "}"
   }
 } ;
 
@@ -81,13 +92,12 @@ HELP: status-folder
 }
 { $description "Requests a collection of attributes for the specified folder." }
 { $examples
-  { $code
+  { $unchecked-example
-    "USE: imap"
+    """USING: imap ;
-    "\"imap-host\" <imap4ssl> [ "
+    \\ imap-settings get-global [
-    "    \"email\" \"pwd\" login drop "
+        "INBOX" { "MESSAGES" "UNSEEN" } status-folder
-    "    \"INBOX\" { \"MESSAGES\" \"UNSEEN\" } status-folder "
+    ] with-imap-settings"""
-    "] with-stream ."
+    """{ { "MESSAGES" 67 } { "UNSEEN" 18 } }"""
-    "{ { \"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

extra/imap/imap-tests.factor

@@ -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.
+ERROR: no-imap-test-host ;
-: imap-login ( -- imap4 )
-    host get <imap4ssl> dup [
-        email get password get login drop
-    ] with-stream* ;
-
-ERROR: host-not-set ;
 
 : get-test-host ( -- host )
-    host get dup [ host-not-set throw ] unless ;
+    \ imap-settings get-global host>> [ no-imap-test-host ] unless* ;
-
-: ensure-host ( -- ) get-test-host drop ;
 
 : imap-test ( result quot -- )
-    ensure-host
+    '[ \ imap-settings get-global _ with-imap-settings ] unit-test ; inline
-    '[ imap-login _ with-stream ] 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 ] [
+[ ] [ \ imap-settings get-global [ ] with-imap-settings ] unit-test
-    get-test-host <imap4ssl> [
-        email get password get login
-    ] with-stream empty?
-] unit-test
 
 ! Newly created and then selected folder is empty.
 [ 0 { } ] [

extra/imap/imap.factor

@@ -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