Merge branch 'master' of git://tiodante.com/git/factor
commit
8c7cca072f
|
@ -30,7 +30,7 @@ M: mb-writer stream-nl ( mb-writer -- )
|
||||||
! to be used inside with-irc-client quotations
|
! to be used inside with-irc-client quotations
|
||||||
: %add-named-listener ( listener -- ) [ name>> ] keep set+run-listener ;
|
: %add-named-listener ( listener -- ) [ name>> ] keep set+run-listener ;
|
||||||
: %join ( channel -- ) <irc-channel-listener> irc> add-listener ;
|
: %join ( channel -- ) <irc-channel-listener> irc> add-listener ;
|
||||||
: %push-line ( line -- ) irc> stream>> in>> push-line yield yield ;
|
: %push-line ( line -- ) irc> stream>> in>> push-line yield ;
|
||||||
|
|
||||||
: read-matching-message ( listener quot: ( msg -- ? ) -- irc-message )
|
: read-matching-message ( listener quot: ( msg -- ? ) -- irc-message )
|
||||||
[ in-messages>> 0.1 seconds ] dip mailbox-get-timeout? ;
|
[ in-messages>> 0.1 seconds ] dip mailbox-get-timeout? ;
|
||||||
|
@ -96,7 +96,14 @@ M: mb-writer stream-nl ( mb-writer -- )
|
||||||
] unit-test
|
] unit-test
|
||||||
] with-irc
|
] with-irc
|
||||||
|
|
||||||
! Participants lists tests
|
[ { mode } [
|
||||||
|
"#factortest" <irc-channel-listener> [ %add-named-listener ] keep
|
||||||
|
":ircserver.net MODE #factortest +ns" %push-line
|
||||||
|
[ mode? ] read-matching-message class
|
||||||
|
] unit-test
|
||||||
|
] with-irc
|
||||||
|
|
||||||
|
! Participant lists tests
|
||||||
[ { H{ { "somedude" +normal+ } } } [
|
[ { H{ { "somedude" +normal+ } } } [
|
||||||
"#factortest" <irc-channel-listener> [ %add-named-listener ] keep
|
"#factortest" <irc-channel-listener> [ %add-named-listener ] keep
|
||||||
":somedude!n=user@isp.net JOIN :#factortest" %push-line
|
":somedude!n=user@isp.net JOIN :#factortest" %push-line
|
||||||
|
@ -134,8 +141,17 @@ M: mb-writer stream-nl ( mb-writer -- )
|
||||||
] unit-test
|
] unit-test
|
||||||
] with-irc
|
] with-irc
|
||||||
|
|
||||||
|
[ { H{ { "somedude2" +normal+ } } } [
|
||||||
|
"#factortest" <irc-channel-listener>
|
||||||
|
H{ { "somedude" +normal+ } } clone >>participants
|
||||||
|
[ %add-named-listener ] keep
|
||||||
|
":somedude!n=user2@isp.net NICK :somedude2" %push-line
|
||||||
|
participants>>
|
||||||
|
] unit-test
|
||||||
|
] with-irc
|
||||||
|
|
||||||
! Namelist change notification
|
! Namelist change notification
|
||||||
[ { T{ participant-changed f f f } } [
|
[ { T{ participant-changed f f f f } } [
|
||||||
"#factortest" <irc-channel-listener> [ %add-named-listener ] keep
|
"#factortest" <irc-channel-listener> [ %add-named-listener ] keep
|
||||||
":ircserver.net 353 factorbot @ #factortest :@factorbot " %push-line
|
":ircserver.net 353 factorbot @ #factortest :@factorbot " %push-line
|
||||||
":ircserver.net 366 factorbot #factortest :End of /NAMES list." %push-line
|
":ircserver.net 366 factorbot #factortest :End of /NAMES list." %push-line
|
||||||
|
@ -143,11 +159,20 @@ M: mb-writer stream-nl ( mb-writer -- )
|
||||||
] unit-test
|
] unit-test
|
||||||
] with-irc
|
] with-irc
|
||||||
|
|
||||||
[ { T{ participant-changed f "somedude" +part+ } } [
|
[ { T{ participant-changed f "somedude" +part+ f } } [
|
||||||
"#factortest" <irc-channel-listener>
|
"#factortest" <irc-channel-listener>
|
||||||
H{ { "somedude" +normal+ } } clone >>participants
|
H{ { "somedude" +normal+ } } clone >>participants
|
||||||
[ %add-named-listener ] keep
|
[ %add-named-listener ] keep
|
||||||
":somedude!n=user@isp.net QUIT" %push-line
|
":somedude!n=user@isp.net QUIT" %push-line
|
||||||
[ participant-changed? ] read-matching-message
|
[ participant-changed? ] read-matching-message
|
||||||
] unit-test
|
] unit-test
|
||||||
] with-irc
|
] with-irc
|
||||||
|
|
||||||
|
[ { T{ participant-changed f "somedude" +nick+ "somedude2" } } [
|
||||||
|
"#factortest" <irc-channel-listener>
|
||||||
|
H{ { "somedude" +normal+ } } clone >>participants
|
||||||
|
[ %add-named-listener ] keep
|
||||||
|
":somedude!n=user2@isp.net NICK :somedude2" %push-line
|
||||||
|
[ participant-changed? ] read-matching-message
|
||||||
|
] unit-test
|
||||||
|
] with-irc
|
||||||
|
|
|
@ -41,6 +41,7 @@ SYMBOL: +normal+
|
||||||
SYMBOL: +join+
|
SYMBOL: +join+
|
||||||
SYMBOL: +part+
|
SYMBOL: +part+
|
||||||
SYMBOL: +mode+
|
SYMBOL: +mode+
|
||||||
|
SYMBOL: +nick+
|
||||||
|
|
||||||
! listener objects
|
! listener objects
|
||||||
: <irc-listener> ( -- irc-listener ) <mailbox> <mailbox> irc-listener boa ;
|
: <irc-listener> ( -- irc-listener ) <mailbox> <mailbox> irc-listener boa ;
|
||||||
|
@ -59,7 +60,7 @@ SYMBOL: +mode+
|
||||||
! Message objects
|
! Message objects
|
||||||
! ======================================
|
! ======================================
|
||||||
|
|
||||||
TUPLE: participant-changed nick action ;
|
TUPLE: participant-changed nick action parameter ;
|
||||||
C: <participant-changed> participant-changed
|
C: <participant-changed> participant-changed
|
||||||
|
|
||||||
SINGLETON: irc-listener-end ! send to a listener to stop its execution
|
SINGLETON: irc-listener-end ! send to a listener to stop its execution
|
||||||
|
@ -111,7 +112,7 @@ M: irc-listener to-listener ( message irc-listener -- )
|
||||||
|
|
||||||
: (remove-participant) ( nick listener -- )
|
: (remove-participant) ( nick listener -- )
|
||||||
[ participants>> delete-at ]
|
[ participants>> delete-at ]
|
||||||
[ [ +part+ <participant-changed> ] dip to-listener ] 2bi ;
|
[ [ +part+ f <participant-changed> ] dip to-listener ] 2bi ;
|
||||||
|
|
||||||
: remove-participant ( nick channel -- )
|
: remove-participant ( nick channel -- )
|
||||||
listener> [ (remove-participant) ] [ drop ] if* ;
|
listener> [ (remove-participant) ] [ drop ] if* ;
|
||||||
|
@ -124,10 +125,21 @@ M: irc-listener to-listener ( message irc-listener -- )
|
||||||
: remove-participant-from-all ( nick -- )
|
: remove-participant-from-all ( nick -- )
|
||||||
dup listeners-with-participant [ (remove-participant) ] with each ;
|
dup listeners-with-participant [ (remove-participant) ] with each ;
|
||||||
|
|
||||||
|
: notify-rename ( newnick oldnick listener -- )
|
||||||
|
[ participant-changed new +nick+ >>action
|
||||||
|
[ (>>nick) ] [ (>>parameter) ] [ ] tri ] dip to-listener ;
|
||||||
|
|
||||||
|
: rename-participant ( newnick oldnick listener -- )
|
||||||
|
[ participants>> [ delete-at* drop ] [ [ swap ] dip set-at ] bi ]
|
||||||
|
[ notify-rename ] 3bi ;
|
||||||
|
|
||||||
|
: rename-participant-in-all ( oldnick newnick -- )
|
||||||
|
swap dup listeners-with-participant [ rename-participant ] with with each ;
|
||||||
|
|
||||||
: add-participant ( mode nick channel -- )
|
: add-participant ( mode nick channel -- )
|
||||||
listener> [
|
listener> [
|
||||||
[ participants>> set-at ]
|
[ participants>> set-at ]
|
||||||
[ [ +join+ <participant-changed> ] dip to-listener ] 2bi
|
[ [ +join+ f <participant-changed> ] dip to-listener ] 2bi
|
||||||
] [ 2drop ] if* ;
|
] [ 2drop ] if* ;
|
||||||
|
|
||||||
DEFER: me?
|
DEFER: me?
|
||||||
|
@ -211,9 +223,14 @@ M: quit handle-incoming-irc ( quit -- )
|
||||||
[ prefix>> parse-name remove-participant-from-all ]
|
[ prefix>> parse-name remove-participant-from-all ]
|
||||||
bi ;
|
bi ;
|
||||||
|
|
||||||
! FIXME: implement this
|
M: mode handle-incoming-irc ( mode -- ) ! FIXME: modify participant list
|
||||||
! M: mode handle-incoming-irc ( mode -- ) call-next-method ;
|
dup channel>> to-listener ;
|
||||||
! M: nick handle-incoming-irc ( nick -- ) call-next-method ;
|
|
||||||
|
M: nick handle-incoming-irc ( nick -- )
|
||||||
|
[ dup prefix>> parse-name listeners-with-participant
|
||||||
|
[ to-listener ] with each ]
|
||||||
|
[ [ prefix>> parse-name ] [ trailing>> ] bi rename-participant-in-all ]
|
||||||
|
bi ;
|
||||||
|
|
||||||
: >nick/mode ( string -- nick mode )
|
: >nick/mode ( string -- nick mode )
|
||||||
dup first "+@" member? [ unclip ] [ 0 ] if participant-mode ;
|
dup first "+@" member? [ unclip ] [ 0 ] if participant-mode ;
|
||||||
|
@ -225,7 +242,7 @@ M: quit handle-incoming-irc ( quit -- )
|
||||||
M: names-reply handle-incoming-irc ( names-reply -- )
|
M: names-reply handle-incoming-irc ( names-reply -- )
|
||||||
[ names-reply>participants ] [ channel>> listener> ] bi [
|
[ names-reply>participants ] [ channel>> listener> ] bi [
|
||||||
[ (>>participants) ]
|
[ (>>participants) ]
|
||||||
[ [ f f <participant-changed> ] dip name>> to-listener ] bi
|
[ [ f f f <participant-changed> ] dip name>> to-listener ] bi
|
||||||
] [ drop ] if* ;
|
] [ drop ] if* ;
|
||||||
|
|
||||||
M: irc-broadcasted-message handle-incoming-irc ( irc-broadcasted-message -- )
|
M: irc-broadcasted-message handle-incoming-irc ( irc-broadcasted-message -- )
|
||||||
|
|
Loading…
Reference in New Issue