steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

irc.client: Some small changes, and replace listen-to by listener objects of different types.

db4
Bruno Deferrari 2008-06-07 01:15:42 -03:00
parent 9abb505d2d
commit 3480a93fd5
1 changed files with 39 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
extra/irc/client/client.factor
View File

@ -33,14 +33,30 @@ TUPLE: irc-client profile nick stream in-messages out-messages join-messages
[ <inet> latin1 <client> ] irc-client boa ; [ <inet> latin1 <client> ] irc-client boa ;
TUPLE: irc-listener in-messages out-messages ; TUPLE: irc-listener in-messages out-messages ;
: <irc-listener> ( -- irc-listener ) TUPLE: irc-server-listener < irc-listener ;
<mailbox> <mailbox> irc-listener boa ; TUPLE: irc-channel-listener < irc-listener name password timeout ;
TUPLE: irc-nick-listener < irc-listener name ;
UNION: irc-named-listener irc-nick-listener irc-channel-listener ;
: <irc-listener> ( -- irc-listener ) <mailbox> <mailbox> irc-listener boa ;
: <irc-server-listener> ( -- irc-server-listener )
<mailbox> <mailbox> irc-server-listener boa ;
: <irc-channel-listener> ( name -- irc-channel-listener )
<mailbox> <mailbox> rot f 60 seconds irc-channel-listener boa ;
: <irc-nick-listener> ( name -- irc-nick-listener )
<mailbox> <mailbox> rot irc-nick-listener boa ;
! ====================================== ! ======================================
! Message objects ! Message objects
! ====================================== ! ======================================
SINGLETON: irc-end ! Message used when the client isn't running anymore SINGLETON: irc-end ! Message sent when the client isn't running anymore
SINGLETON: irc-lost ! Message sent when connection was lost
SINGLETON: irc-restore ! Message sent when connection was restored
UNION: irc-broadcasted-message irc-end irc-lost irc-restore ;
TUPLE: irc-message line prefix command parameters trailing timestamp ; TUPLE: irc-message line prefix command parameters trailing timestamp ;
TUPLE: logged-in < irc-message name ; TUPLE: logged-in < irc-message name ;
@ -163,6 +179,9 @@ TUPLE: unhandled < irc-message ;
: irc-message-origin ( irc-message -- name ) : irc-message-origin ( irc-message -- name )
dup name>> me? [ prefix>> parse-name ] [ name>> ] if ; dup name>> me? [ prefix>> parse-name ] [ name>> ] if ;
: broadcast-message-to-listeners ( message -- )
irc-client> listeners>> values [ in-messages>> mailbox-put ] with each ;
GENERIC: handle-incoming-irc ( irc-message -- ) GENERIC: handle-incoming-irc ( irc-message -- )
M: irc-message handle-incoming-irc ( irc-message -- ) M: irc-message handle-incoming-irc ( irc-message -- )
@ -184,8 +203,8 @@ M: privmsg handle-incoming-irc ( privmsg -- )
M: join handle-incoming-irc ( join -- ) M: join handle-incoming-irc ( join -- )
irc-client> join-messages>> mailbox-put ; irc-client> join-messages>> mailbox-put ;
M: irc-end handle-incoming-irc ( irc-end -- ) M: irc-broadcasted-message handle-incoming-irc ( irc-broadcasted-message -- )
irc-client> listeners>> values [ in-messages>> mailbox-put ] with each ; broadcast-message-to-listeners ;
! ====================================== ! ======================================
! Client message handling ! Client message handling
@ -249,26 +268,22 @@ M: privmsg handle-outgoing-irc ( privmsg -- )
! Listener join request handling ! Listener join request handling
! ====================================== ! ======================================
: make-registered-listener ( name -- listener ) : set+run-listener ( name irc-listener -- )
<irc-listener>
[ [ listener-loop ] 2curry "listener" spawn-irc-loop ] [ [ listener-loop ] 2curry "listener" spawn-irc-loop ]
[ swap [ irc-client> listeners>> set-at ] curry keep ] [ swap irc-client> listeners>> set-at ]
2bi ; 2bi ;
: make-join-future ( name -- future ) GENERIC: (add-listener) ( irc-listener -- )
[ [ swap trailing>> = ] curry ! compare name with channel name M: irc-channel-listener (add-listener) ( irc-channel-listener -- )
irc-client> join-messages>> 60 seconds rot mailbox-get-timeout? [ [ name>> ] [ password>> ] bi /JOIN ]
trailing>> make-registered-listener ] [ [ [ drop irc-client> join-messages>> ]
curry future ; [ timeout>> ]
[ name>> [ swap trailing>> = ] curry ]
tri mailbox-get-timeout? trailing>> ] keep set+run-listener
] bi ;
: make-user-future ( name -- future ) M: irc-nick-listener (add-listener) ( irc-nick-listener -- )
[ make-registered-listener ] curry future ; [ name>> ] keep set+run-listener ;
: maybe-join ( name password -- ? )
over "#" head? [ /JOIN t ] [ 2drop f ] if ;
: make-listener-future ( name channel? -- future )
[ make-join-future ] [ make-user-future ] if ;
PRIVATE> PRIVATE>
@ -283,7 +298,6 @@ PRIVATE>
spawn-irc spawn-irc
] with-variable ; ] with-variable ;
: listen-to ( irc-client name -- future ) GENERIC: add-listener ( irc-client irc-listener -- )
swap current-irc-client [ M: irc-listener add-listener ( irc-client irc-listener -- )
dup f maybe-join make-listener-future current-irc-client swap [ (add-listener) ] curry with-variable ;
] with-variable ;