irc.client: Handling of lists of participants in channels, fixes.

db4
Bruno Deferrari 2008-07-11 01:16:15 -03:00
parent 2d12fe4f05
commit aec887cc14
2 changed files with 38 additions and 11 deletions

View File

@ -2,8 +2,8 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: concurrency.mailboxes kernel io.sockets io.encodings.8-bit calendar USING: concurrency.mailboxes kernel io.sockets io.encodings.8-bit calendar
accessors destructors namespaces io assocs arrays qualified fry accessors destructors namespaces io assocs arrays qualified fry
continuations threads strings classes combinators continuations threads strings classes combinators splitting hashtables
irc.messages irc.messages.private ; ascii irc.messages irc.messages.private ;
RENAME: join sequences => sjoin RENAME: join sequences => sjoin
EXCLUDE: sequences => join ; EXCLUDE: sequences => join ;
IN: irc.client IN: irc.client
@ -27,7 +27,7 @@ TUPLE: irc-client profile stream in-messages out-messages join-messages
TUPLE: irc-listener in-messages out-messages ; TUPLE: irc-listener in-messages out-messages ;
TUPLE: irc-server-listener < irc-listener ; TUPLE: irc-server-listener < irc-listener ;
TUPLE: irc-channel-listener < irc-listener name password timeout ; TUPLE: irc-channel-listener < irc-listener name password timeout participants ;
TUPLE: irc-nick-listener < irc-listener name ; TUPLE: irc-nick-listener < irc-listener name ;
SYMBOL: +server-listener+ SYMBOL: +server-listener+
@ -37,7 +37,7 @@ SYMBOL: +server-listener+
<mailbox> <mailbox> irc-server-listener boa ; <mailbox> <mailbox> irc-server-listener boa ;
: <irc-channel-listener> ( name -- irc-channel-listener ) : <irc-channel-listener> ( name -- irc-channel-listener )
<mailbox> <mailbox> rot f 60 seconds irc-channel-listener boa ; <mailbox> <mailbox> rot f 60 seconds H{ } clone irc-channel-listener boa ;
: <irc-nick-listener> ( name -- irc-nick-listener ) : <irc-nick-listener> ( name -- irc-nick-listener )
<mailbox> <mailbox> rot irc-nick-listener boa ; <mailbox> <mailbox> rot irc-nick-listener boa ;
@ -74,6 +74,18 @@ UNION: irc-broadcasted-message irc-end irc-disconnected irc-connected ;
listener> [ +server-listener+ listener> ] unless* listener> [ +server-listener+ listener> ] unless*
[ in-messages>> mailbox-put ] [ drop ] if* ; [ in-messages>> mailbox-put ] [ drop ] if* ;
: remove-participant ( nick channel -- )
listener> [ participants>> delete-at ] [ drop ] if* ;
: add-participant ( nick mode channel -- )
listener> [ participants>> set-at ] [ 2drop ] if* ;
DEFER: me?
: maybe-forward-join ( join -- )
[ prefix>> parse-name me? ] keep and
[ irc> join-messages>> mailbox-put ] when* ;
! ====================================== ! ======================================
! IRC client messages ! IRC client messages
! ====================================== ! ======================================
@ -153,17 +165,30 @@ M: privmsg handle-incoming-irc ( privmsg -- )
dup irc-message-origin to-listener ; dup irc-message-origin to-listener ;
M: join handle-incoming-irc ( join -- ) M: join handle-incoming-irc ( join -- )
[ [ prefix>> parse-name me? ] keep and [ maybe-forward-join ]
[ irc> join-messages>> mailbox-put ] when* ]
[ dup trailing>> to-listener ] [ dup trailing>> to-listener ]
bi ; [ [ drop f ] [ prefix>> parse-name ] [ trailing>> ] tri add-participant ]
tri ;
M: part handle-incoming-irc ( part -- ) M: part handle-incoming-irc ( part -- )
dup channel>> to-listener ; [ dup channel>> to-listener ] keep
[ prefix>> parse-name ] [ channel>> ] bi remove-participant ;
M: kick handle-incoming-irc ( kick -- ) M: kick handle-incoming-irc ( kick -- )
[ ] [ channel>> ] [ who>> ] tri me? [ dup unregister-listener ] when [ [ ] [ channel>> ] bi to-listener ]
to-listener ; [ [ who>> ] [ channel>> ] bi remove-participant ]
[ [ ] [ who>> ] bi me? [ unregister-listener ] [ drop ] if ]
tri ;
: >nick/mode ( string -- nick mode )
dup first "+@" member? [ unclip ] [ f ] if ;
: names-reply>participants ( names-reply -- participants )
trailing>> [ blank? ] trim " " split
[ >nick/mode 2array ] map >hashtable ;
M: names-reply handle-incoming-irc ( names-reply -- )
[ names-reply>participants ] [ channel>> listener> ] bi (>>participants) ;
M: irc-broadcasted-message handle-incoming-irc ( irc-broadcasted-message -- ) M: irc-broadcasted-message handle-incoming-irc ( irc-broadcasted-message -- )
broadcast-message-to-listeners ; broadcast-message-to-listeners ;

View File

@ -7,7 +7,7 @@ IN: irc.messages
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 ;
TUPLE: ping < irc-message ; TUPLE: ping < irc-message ;
TUPLE: join < irc-message channel ; TUPLE: join < irc-message ;
TUPLE: part < irc-message channel ; TUPLE: part < irc-message channel ;
TUPLE: quit < irc-message ; TUPLE: quit < irc-message ;
TUPLE: privmsg < irc-message name ; TUPLE: privmsg < irc-message name ;
@ -16,6 +16,7 @@ TUPLE: roomlist < irc-message channel names ;
TUPLE: nick-in-use < irc-message asterisk name ; TUPLE: nick-in-use < irc-message asterisk name ;
TUPLE: notice < irc-message type ; TUPLE: notice < irc-message type ;
TUPLE: mode < irc-message name channel mode ; TUPLE: mode < irc-message name channel mode ;
TUPLE: names-reply < irc-message who = channel ;
TUPLE: unhandled < irc-message ; TUPLE: unhandled < irc-message ;
<PRIVATE <PRIVATE
@ -55,6 +56,7 @@ TUPLE: unhandled < irc-message ;
{ "NOTICE" [ \ notice ] } { "NOTICE" [ \ notice ] }
{ "001" [ \ logged-in ] } { "001" [ \ logged-in ] }
{ "433" [ \ nick-in-use ] } { "433" [ \ nick-in-use ] }
{ "353" [ \ names-reply ] }
{ "JOIN" [ \ join ] } { "JOIN" [ \ join ] }
{ "PART" [ \ part ] } { "PART" [ \ part ] }
{ "PRIVMSG" [ \ privmsg ] } { "PRIVMSG" [ \ privmsg ] }