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

irc.client: Fix user quit notification

db4
Bruno Deferrari 2008-08-01 19:59:18 -03:00
parent 1e2c5c06f4
commit 9a84cfe656
2 changed files with 23 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
extra/irc/client/client-tests.factor
View File

@ -160,7 +160,7 @@ IN: irc.client.tests
} cleave } cleave
] unit-test ] unit-test
! Namelist notification ! Namelist change notification
{ T{ participant-changed f f f } } [ { T{ participant-changed f f f } } [
{ ":ircserver.net 353 factorbot @ #factortest :@factorbot " { ":ircserver.net 353 factorbot @ #factortest :@factorbot "
":ircserver.net 366 factorbot #factortest :End of /NAMES list." } make-client ":ircserver.net 366 factorbot #factortest :End of /NAMES list." } make-client
@ -173,3 +173,18 @@ IN: irc.client.tests
[ terminate-irc ] [ terminate-irc ]
} cleave } cleave
] unit-test ] unit-test
{ T{ participant-changed f "somedude" +part+ } } [
{ ":somedude!n=user@isp.net QUIT" } make-client
{ [ "factorbot" set-nick ]
[ listeners>>
[ "#factortest" [ <irc-channel-listener>
H{ { "somedude" +normal+ } } clone >>participants ] keep
] dip set-at ]
[ connect-irc ]
[ drop 0.1 seconds sleep ]
[ listeners>> [ "#factortest" ] dip at
[ read-message drop ] [ read-message drop ] [ read-message ] tri ]
[ terminate-irc ]
} cleave
] unit-test

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

@ -88,10 +88,11 @@ SYMBOL: current-irc-client
: irc-stream> ( -- stream ) irc> stream>> ; : irc-stream> ( -- stream ) irc> stream>> ;
: irc-write ( s -- ) irc-stream> stream-write ; : irc-write ( s -- ) irc-stream> stream-write ;
: irc-print ( s -- ) irc-stream> [ stream-print ] keep stream-flush ; : irc-print ( s -- ) irc-stream> [ stream-print ] keep stream-flush ;
: irc-send ( irc-message -- ) irc> out-messages>> mailbox-put ;
: listener> ( name -- listener/f ) irc> listeners>> at ; : listener> ( name -- listener/f ) irc> listeners>> at ;
: maybe-mailbox-get ( mailbox quot: ( irc-message -- ) -- ) : maybe-mailbox-get ( mailbox quot: ( irc-message -- ) -- )
[ dup mailbox-empty? [ drop yield ] ] dip '[ mailbox-get @ ] if ; inline [ dup mailbox-empty? [ drop 0.1 sleep ] ] dip '[ mailbox-get @ ] if ; inline
GENERIC: to-listener ( message obj -- ) GENERIC: to-listener ( message obj -- )
@ -147,24 +148,6 @@ DEFER: me?
"JOIN " irc-write "JOIN " irc-write
[ [ " :" ] dip 3append ] when* irc-print ; [ [ " :" ] dip 3append ] when* irc-print ;
: /PART ( channel text -- )
[ "PART " irc-write irc-write ] dip
" :" irc-write irc-print ;
: /KICK ( channel who -- )
[ "KICK " irc-write irc-write ] dip
" " irc-write irc-print ;
: /PRIVMSG ( nick line -- )
[ "PRIVMSG " irc-write irc-write ] dip
" :" irc-write irc-print ;
: /ACTION ( nick line -- )
[ 1 , "ACTION " % % 1 , ] "" make /PRIVMSG ;
: /QUIT ( text -- )
"QUIT :" irc-write irc-print ;
: /PONG ( text -- ) : /PONG ( text -- )
"PONG " irc-write irc-print ; "PONG " irc-write irc-print ;
@ -240,10 +223,14 @@ M: kick handle-incoming-irc ( kick -- )
M: quit handle-incoming-irc ( quit -- ) M: quit handle-incoming-irc ( quit -- )
[ dup prefix>> parse-name listeners-with-participant [ dup prefix>> parse-name listeners-with-participant
[ to-listener ] with each ] [ to-listener ] with each ]
[ prefix>> parse-name remove-participant-from-all ]
[ handle-participant-change ] [ handle-participant-change ]
[ prefix>> parse-name remove-participant-from-all ]
tri ; tri ;
! FIXME: implement this
! M: mode handle-incoming-irc ( mode -- ) call-next-method ;
! M: nick handle-incoming-irc ( nick -- ) call-next-method ;
: >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 ;