imap: Add a word to list all folders and fix a couple issues.
- Fix a bug where the regex assumes double-quotes around a string but Outlook doesn't put them. - Fix all the \\ escapes in the regexps to look a little better. - Cleaner looping for reading emails. ! Example query to get some spams imap-settings get [ "[Gmail]/Spam" select-folder "ALL" "" search-mails 10 head "(BODY[1] BODY[HEADER.FIELDS (SUBJECT TO FROM CC BCC)])" fetch-mails ] with-imap-settingstravis-windows
parent
d82ce045ea
commit
f77d46f0c8
|
@ -1,8 +1,10 @@
|
||||||
USING: accessors arrays assocs calendar calendar.english calendar.format
|
USING: accessors arrays assocs calendar calendar.english
|
||||||
calendar.parser formatting fry grouping io io.crlf io.encodings.ascii
|
calendar.format calendar.parser formatting fry grouping io
|
||||||
io.encodings.binary io.encodings.string io.encodings.utf7 io.encodings.utf8
|
io.crlf io.encodings.ascii io.encodings.binary
|
||||||
io.sockets io.sockets.secure io.streams.duplex io.streams.string kernel math
|
io.encodings.string io.encodings.utf7 io.encodings.utf8
|
||||||
math.parser sequences splitting strings ;
|
io.sockets io.sockets.secure io.streams.duplex io.streams.string
|
||||||
|
kernel math math.parser multiline pcre sequences
|
||||||
|
sequences.extras strings ;
|
||||||
QUALIFIED: pcre
|
QUALIFIED: pcre
|
||||||
IN: imap
|
IN: imap
|
||||||
|
|
||||||
|
@ -46,9 +48,9 @@ CONSTANT: IMAP4_SSL_PORT 993
|
||||||
: read-response-chunk ( stop-expr -- item ? )
|
: read-response-chunk ( stop-expr -- item ? )
|
||||||
read-?crlf ascii decode swap dupd pcre:findall
|
read-?crlf ascii decode swap dupd pcre:findall
|
||||||
[
|
[
|
||||||
dup "^.*{(\\d+)}$" pcre:findall
|
dup [[ ^.*{(\d+)}$]] pcre:findall
|
||||||
[
|
[
|
||||||
dup "^\\* (\\d+) [A-Z-]+ (.*)$" pcre:findall
|
dup [[ ^\* (\d+) [A-Z-]+ (.*)$]] pcre:findall
|
||||||
[ ] [ nip first third second ] if-empty
|
[ ] [ nip first third second ] if-empty
|
||||||
]
|
]
|
||||||
[
|
[
|
||||||
|
@ -61,7 +63,7 @@ CONSTANT: IMAP4_SSL_PORT 993
|
||||||
|
|
||||||
: read-response ( tag -- lines )
|
: read-response ( tag -- lines )
|
||||||
"^%s (BAD|NO|OK) (.*)$" sprintf
|
"^%s (BAD|NO|OK) (.*)$" sprintf
|
||||||
'[ _ read-response-chunk [ suffix ] dip ] { } swap loop
|
'[ _ read-response-chunk ] loop>array*
|
||||||
unclip-last first2 [ check-status ] keep suffix ;
|
unclip-last first2 [ check-status ] keep suffix ;
|
||||||
|
|
||||||
: write-command ( command literal tag -- )
|
: write-command ( command literal tag -- )
|
||||||
|
@ -80,24 +82,24 @@ CONSTANT: IMAP4_SSL_PORT 993
|
||||||
first " " split 2 tail ;
|
first " " split 2 tail ;
|
||||||
|
|
||||||
: parse-list-folders ( str -- folder )
|
: parse-list-folders ( str -- folder )
|
||||||
"\\* LIST \\(([^\\)]+)\\) \"([^\"]+)\" \"([^\"]+)\"" pcre:findall
|
[[ \* LIST \(([^\)]+)\) "([^"]+)" "?([^"]+)"?]] pcre:findall
|
||||||
first rest values [ utf7imap4 decode ] map ;
|
first rest values [ utf7imap4 decode ] map ;
|
||||||
|
|
||||||
: parse-select-folder ( seq -- count )
|
: parse-select-folder ( seq -- count )
|
||||||
[ "\\* (\\d+) EXISTS" pcre:findall ] map harvest
|
[ [[ \* (\d+) EXISTS]] pcre:findall ] map harvest
|
||||||
[ f ] [ first first last last string>number ] if-empty ;
|
[ f ] [ first first last last string>number ] if-empty ;
|
||||||
|
|
||||||
! Returns uid if the server supports the UIDPLUS extension.
|
! Returns uid if the server supports the UIDPLUS extension.
|
||||||
: parse-append-mail ( seq -- uid/f )
|
: parse-append-mail ( seq -- uid/f )
|
||||||
[ "\\[APPENDUID (\\d+) \\d+\\]" pcre:findall ] map harvest
|
[ [=[ \[APPENDUID (\d+) \d+\]]=] pcre:findall ] map harvest
|
||||||
[ f ] [ first first last last string>number ] if-empty ;
|
[ f ] [ first first last last string>number ] if-empty ;
|
||||||
|
|
||||||
: parse-status ( seq -- assoc )
|
: parse-status ( seq -- assoc )
|
||||||
first "\\* STATUS \"[^\"]+\" \\(([^\\)]+)\\)" pcre:findall first last last
|
first [[ \* STATUS "[^"]+" \(([^\)]+)\)]] pcre:findall first last last
|
||||||
" " split 2 group [ string>number ] assoc-map ;
|
" " split 2 group [ string>number ] assoc-map ;
|
||||||
|
|
||||||
: parse-store-mail-line ( str -- pair/f )
|
: parse-store-mail-line ( str -- pair/f )
|
||||||
"\\(FLAGS \\(([^\\)]+)\\) UID (\\d+)\\)" pcre:findall [ f ] [
|
[[ \(FLAGS \(([^\)]+)\) UID (\d+)\)]] pcre:findall [ f ] [
|
||||||
first rest values first2 [ " " split ] dip string>number swap 2array
|
first rest values first2 [ " " split ] dip string>number swap 2array
|
||||||
] if-empty ;
|
] if-empty ;
|
||||||
|
|
||||||
|
@ -124,6 +126,8 @@ PRIVATE>
|
||||||
"LIST \"%s\" *" sprintf "" command-response
|
"LIST \"%s\" *" sprintf "" command-response
|
||||||
but-last [ parse-list-folders ] map ;
|
but-last [ parse-list-folders ] map ;
|
||||||
|
|
||||||
|
: list-all-folders ( -- folders ) "" list-folders ;
|
||||||
|
|
||||||
: select-folder ( mailbox -- count )
|
: select-folder ( mailbox -- count )
|
||||||
>utf7imap4 "SELECT \"%s\"" sprintf "" command-response
|
>utf7imap4 "SELECT \"%s\"" sprintf "" command-response
|
||||||
parse-select-folder ;
|
parse-select-folder ;
|
||||||
|
@ -168,7 +172,8 @@ PRIVATE>
|
||||||
] dip utf8 encode command-response parse-append-mail ;
|
] dip utf8 encode command-response parse-append-mail ;
|
||||||
|
|
||||||
: store-mail ( uids command flags -- mail-flags )
|
: store-mail ( uids command flags -- mail-flags )
|
||||||
[ comma-list ] 2dip "UID STORE %s %s %s" sprintf "" command-response
|
[ comma-list ] 2dip "UID STORE %s %s %s" sprintf
|
||||||
|
"" command-response
|
||||||
parse-store-mail ;
|
parse-store-mail ;
|
||||||
|
|
||||||
! High level API
|
! High level API
|
||||||
|
|
|
@ -444,12 +444,18 @@ PRIVATE>
|
||||||
: last? ( ... seq quot: ( ... elt -- ... ? ) -- ... ? ) [ last ] dip call ; inline
|
: last? ( ... seq quot: ( ... elt -- ... ? ) -- ... ? ) [ last ] dip call ; inline
|
||||||
: nth? ( ... n seq quot: ( ... elt -- ... ? ) -- ... ? ) [ nth ] dip call ; inline
|
: nth? ( ... n seq quot: ( ... elt -- ... ? ) -- ... ? ) [ nth ] dip call ; inline
|
||||||
|
|
||||||
: loop>sequence ( quot exemplar -- seq )
|
: loop>sequence ( quot: ( -- obj/f ) exemplar -- seq )
|
||||||
[ '[ [ @ [ [ , ] when* ] keep ] loop ] ] dip make ; inline
|
[ '[ [ @ [ [ , ] when* ] keep ] loop ] ] dip make ; inline
|
||||||
|
|
||||||
: loop>array ( quot -- seq )
|
: loop>array ( quot: ( -- obj/f ) -- seq )
|
||||||
{ } loop>sequence ; inline
|
{ } loop>sequence ; inline
|
||||||
|
|
||||||
|
: loop>sequence* ( quot: ( -- obj ? ) exemplar -- seq )
|
||||||
|
[ '[ [ @ [ [ , ] when* ] [ ] bi* ] loop ] ] dip make ; inline
|
||||||
|
|
||||||
|
: loop>array* ( quot: ( -- obj ? ) -- seq )
|
||||||
|
{ } loop>sequence* ; inline
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
: (reverse) ( seq -- newseq )
|
: (reverse) ( seq -- newseq )
|
||||||
|
|
Loading…
Reference in New Issue