Merge branch 'master' of git://tiodante.com/git/factor

extra/irc/client/authors.txt

@@ -1,2 +1,3 @@
+Bruno Deferrari
 Doug Coleman
 Slava Pestov

extra/irc/client/client-tests.factor

@@ -1,7 +1,8 @@
 USING: kernel tools.test accessors arrays sequences qualified
        io.streams.string io.streams.duplex namespaces threads
-       calendar irc.client.private ;
+       calendar irc.client.private concurrency.mailboxes classes ;
 EXCLUDE: irc.client => join ;
+RENAME: join irc.client => join_
 IN: irc.client.tests
 
 ! Utilities
@@ -64,13 +65,16 @@ privmsg new
                   [ connect-irc ] keep 1 seconds sleep
                     nick>> name>> ] unit-test
 
-! TODO: Channel join messages
+{ join_ "#factortest" } [
-! { ":factorbot!n=factorbo@some.where JOIN :#factortest"
+             { ":factorbot!n=factorbo@some.where JOIN :#factortest"
-!   ":ircserver.net MODE #factortest +ns"
+             ":ircserver.net MODE #factortest +ns"
-!   ":ircserver.net 353 factorbot @ #factortest :@factorbot "
+             ":ircserver.net 353 factorbot @ #factortest :@factorbot "
-!   ":ircserver.net 366 factorbot #factortest :End of /NAMES list."
+             ":ircserver.net 366 factorbot #factortest :End of /NAMES list."
-!   ":ircserver.net 477 factorbot #factortest :[ircserver-info] blah blah"
+             ":ircserver.net 477 factorbot #factortest :[ircserver-info] blah blah"
-! } make-client dup "factorbot" set-nick
+             } make-client dup "factorbot" set-nick
+             [ connect-irc ] keep 1 seconds sleep
+             join-messages>> 5 seconds mailbox-get-timeout
+             [ class ] [ trailing>> ] bi ] unit-test
 ! TODO: user join
 ! ":somedude!n=user@isp.net JOIN :#factortest"
 ! TODO: channel message

extra/irc/client/client.factor

@@ -1,8 +1,8 @@
-! Copyright (C) 2007 Doug Coleman, Slava Pestov.
+! Copyright (C) 2008 Bruno Deferrari, Doug Coleman, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays combinators concurrency.mailboxes fry io strings
+USING: combinators concurrency.mailboxes fry io strings
        io.encodings.8-bit io.sockets kernel namespaces sequences
-       sequences.lib splitting threads calendar classes.tuple
+       splitting threads calendar classes.tuple
        classes ascii assocs accessors destructors continuations ;
 IN: irc.client
 
@@ -33,7 +33,6 @@ TUPLE: irc-listener in-messages out-messages ;
 TUPLE: irc-server-listener < irc-listener ;
 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 ;
 
@@ -78,13 +77,19 @@ TUPLE: unhandled < irc-message ;
 <PRIVATE
 
 ! ======================================
-! Shortcuts
+! Utils
 ! ======================================
 
 : irc> ( -- irc-client ) current-irc-client get ;
 : irc-stream> ( -- stream ) irc> stream>> ;
 : irc-write ( s -- ) irc-stream> stream-write ;
 : irc-print ( s -- ) irc-stream> [ stream-print ] keep stream-flush ;
+: listener> ( name -- listener/f ) irc> listeners>> at ;
+: unregister-listener ( name -- ) irc> listeners>> delete-at ;
+
+: to-listener ( message name -- )
+    listener> [ f listener> ] unless*
+    [ in-messages>> mailbox-put ] [ drop ] if* ;
 
 ! ======================================
 ! IRC client messages
@@ -188,8 +193,7 @@ TUPLE: unhandled < irc-message ;
 GENERIC: handle-incoming-irc ( irc-message -- )
 
 M: irc-message handle-incoming-irc ( irc-message -- )
-    f irc> listeners>> at
+    f listener> [ in-messages>> mailbox-put ] [ drop ] if* ;
-    [ in-messages>> mailbox-put ] [ drop ] if* ;
 
 M: logged-in handle-incoming-irc ( logged-in -- )
     name>> irc> nick>> (>>name) ;
@@ -201,11 +205,15 @@ M: nick-in-use handle-incoming-irc ( nick-in-use -- )
     name>> "_" append /NICK ;
 
 M: privmsg handle-incoming-irc ( privmsg -- )
-    dup irc-message-origin irc> listeners>> [ at ] keep
+    dup irc-message-origin to-listener ;
-    '[ f , at ] unless* [ in-messages>> mailbox-put ] [ drop ] if* ;
 
 M: join handle-incoming-irc ( join -- )
-    irc> join-messages>> mailbox-put ;
+    dup trailing>> listener>
+    [ irc> join-messages>> ] unless* mailbox-put ;
+
+M: kick handle-incoming-irc ( kick -- )
+    [ ] [ channel>> ] [ who>> ] tri me? [ dup unregister-listener ] when
+    to-listener ;
 
 M: irc-broadcasted-message handle-incoming-irc ( irc-broadcasted-message -- )
     broadcast-message-to-listeners ;
@@ -326,6 +334,5 @@ PRIVATE>
         spawn-irc
     ] with-variable ;
 
-GENERIC: add-listener ( irc-client irc-listener -- )
+: add-listener ( irc-listener irc-client -- )
-M: irc-listener add-listener ( irc-client irc-listener -- )
+    current-irc-client rot '[ , (add-listener) ] with-variable ;
-    current-irc-client swap '[ , (add-listener) ] with-variable ;