From: Doug Coleman Date: Fri, 1 Aug 2008 01:54:32 +0000 (-0500) Subject: Merge branch 'master' of git://factorforge.org/git/william42 X-Git-Tag: 0.94~2691^2~9 X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=29ce373330f37316e89ea94702727a4f874b857f;hp=554247dab55673a24710988434d62cc5f740c7e0 Merge branch 'master' of git://factorforge.org/git/william42 --- diff --git a/extra/irc/client/client-tests.factor b/extra/irc/client/client-tests.factor index e4b7cd20ed..e021ff4ff4 100644 --- a/extra/irc/client/client-tests.factor +++ b/extra/irc/client/client-tests.factor @@ -43,7 +43,7 @@ IN: irc.client.tests ":some.where 001 factorbot :Welcome factorbot" } make-client { [ connect-irc ] - [ drop 1 seconds sleep ] + [ drop 0.1 seconds sleep ] [ profile>> nickname>> ] [ terminate-irc ] } cleave ] unit-test @@ -57,8 +57,8 @@ IN: irc.client.tests } make-client { [ "factorbot" set-nick ] [ connect-irc ] - [ drop 1 seconds sleep ] - [ join-messages>> 1 seconds mailbox-get-timeout ] + [ drop 0.1 seconds sleep ] + [ join-messages>> 0.1 seconds mailbox-get-timeout ] [ terminate-irc ] } cleave [ class ] [ trailing>> ] bi ] unit-test @@ -101,3 +101,75 @@ IN: irc.client.tests } cleave [ class ] [ name>> ] [ trailing>> ] tri ] unit-test + +! Participants lists tests +{ H{ { "somedude" +normal+ } } } [ + { ":somedude!n=user@isp.net JOIN :#factortest" } make-client + { [ "factorbot" set-nick ] + [ listeners>> + [ "#factortest" [ ] keep ] dip set-at ] + [ connect-irc ] + [ drop 0.1 seconds sleep ] + [ listeners>> [ "#factortest" ] dip at participants>> ] + [ terminate-irc ] + } cleave + ] unit-test + +{ H{ { "somedude2" +normal+ } } } [ + { ":somedude!n=user@isp.net PART #factortest" } make-client + { [ "factorbot" set-nick ] + [ listeners>> + [ "#factortest" [ + H{ { "somedude2" +normal+ } + { "somedude" +normal+ } } clone >>participants ] keep + ] dip set-at ] + [ connect-irc ] + [ drop 0.1 seconds sleep ] + [ listeners>> [ "#factortest" ] dip at participants>> ] + [ terminate-irc ] + } cleave + ] unit-test + +{ H{ { "somedude2" +normal+ } } } [ + { ":somedude!n=user@isp.net QUIT" } make-client + { [ "factorbot" set-nick ] + [ listeners>> + [ "#factortest" [ + H{ { "somedude2" +normal+ } + { "somedude" +normal+ } } clone >>participants ] keep + ] dip set-at ] + [ connect-irc ] + [ drop 0.1 seconds sleep ] + [ listeners>> [ "#factortest" ] dip at participants>> ] + [ terminate-irc ] + } cleave + ] unit-test + +{ H{ { "somedude2" +normal+ } } } [ + { ":somedude2!n=user2@isp.net KICK #factortest somedude" } make-client + { [ "factorbot" set-nick ] + [ listeners>> + [ "#factortest" [ + H{ { "somedude2" +normal+ } + { "somedude" +normal+ } } clone >>participants ] keep + ] dip set-at ] + [ connect-irc ] + [ drop 0.1 seconds sleep ] + [ listeners>> [ "#factortest" ] dip at participants>> ] + [ terminate-irc ] + } cleave + ] unit-test + +! Namelist notification +{ T{ participant-changed f f f } } [ + { ":ircserver.net 353 factorbot @ #factortest :@factorbot " + ":ircserver.net 366 factorbot #factortest :End of /NAMES list." } make-client + { [ "factorbot" set-nick ] + [ listeners>> + [ "#factortest" [ ] keep ] dip set-at ] + [ connect-irc ] + [ drop 0.1 seconds sleep ] + [ listeners>> [ "#factortest" ] dip at [ read-message drop ] [ read-message ] bi ] + [ terminate-irc ] + } cleave + ] unit-test \ No newline at end of file diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor index 42682154cd..813de0f57c 100644 --- a/extra/irc/client/client.factor +++ b/extra/irc/client/client.factor @@ -218,9 +218,9 @@ M: privmsg handle-incoming-irc ( privmsg -- ) dup irc-message-origin to-listener ; M: join handle-incoming-irc ( join -- ) - { [ maybe-forward-join ] ! keep + { [ maybe-forward-join ] [ dup trailing>> to-listener ] - [ [ drop f ] [ prefix>> parse-name ] [ trailing>> ] tri add-participant ] + [ [ drop +normal+ ] [ prefix>> parse-name ] [ trailing>> ] tri add-participant ] [ handle-participant-change ] } cleave ; @@ -231,19 +231,18 @@ M: part handle-incoming-irc ( part -- ) tri ; M: kick handle-incoming-irc ( kick -- ) - { [ dup channel>> to-listener ] + { [ dup channel>> to-listener ] [ [ who>> ] [ channel>> ] bi remove-participant ] [ handle-participant-change ] [ dup who>> me? [ unregister-listener ] [ drop ] if ] } cleave ; M: quit handle-incoming-irc ( quit -- ) - { [ dup prefix>> parse-name listeners-with-participant - [ to-listener ] with each ] - [ handle-participant-change ] - [ prefix>> parse-name remove-participant-from-all ] - [ call-next-method ] - } cleave ; + [ dup prefix>> parse-name listeners-with-participant + [ to-listener ] with each ] + [ prefix>> parse-name remove-participant-from-all ] + [ handle-participant-change ] + tri ; : >nick/mode ( string -- nick mode ) dup first "+@" member? [ unclip ] [ 0 ] if participant-mode ; @@ -253,8 +252,10 @@ M: quit handle-incoming-irc ( quit -- ) [ >nick/mode 2array ] map >hashtable ; M: names-reply handle-incoming-irc ( names-reply -- ) - [ names-reply>participants ] [ channel>> listener> ] bi - [ (>>participants) ] [ drop ] if* ; + [ names-reply>participants ] [ channel>> listener> ] bi [ + [ (>>participants) ] + [ [ f f ] dip name>> to-listener ] bi + ] [ drop ] if* ; M: irc-broadcasted-message handle-incoming-irc ( irc-broadcasted-message -- ) broadcast-message-to-listeners ; diff --git a/extra/irc/messages/messages-tests.factor b/extra/irc/messages/messages-tests.factor index 876841abb7..7ee0f41ab0 100644 --- a/extra/irc/messages/messages-tests.factor +++ b/extra/irc/messages/messages-tests.factor @@ -40,8 +40,18 @@ mode new "ircserver.net" >>prefix "MODE" >>command { "#factortest" "+ns" } >>parameters - "#factortest" >>channel + "#factortest" >>channel "+ns" >>mode 1array [ ":ircserver.net MODE #factortest +ns" + parse-irc-line f >>timestamp ] unit-test + +nick new + ":someuser!n=user@some.where NICK :someuser2" >>line + "someuser!n=user@some.where" >>prefix + "NICK" >>command + { } >>parameters + "someuser2" >>trailing +1array +[ ":someuser!n=user@some.where NICK :someuser2" parse-irc-line f >>timestamp ] unit-test \ No newline at end of file diff --git a/extra/irc/messages/messages.factor b/extra/irc/messages/messages.factor index a5f82a5ae1..3b9cf0af2c 100644 --- a/extra/irc/messages/messages.factor +++ b/extra/irc/messages/messages.factor @@ -12,6 +12,7 @@ TUPLE: ping < irc-message ; TUPLE: join < irc-message ; TUPLE: part < irc-message channel ; TUPLE: quit < irc-message ; +TUPLE: nick < irc-message ; TUPLE: privmsg < irc-message name ; TUPLE: kick < irc-message channel who ; TUPLE: roomlist < irc-message channel names ; @@ -34,6 +35,7 @@ M: ping irc-command-string ( ping -- string ) drop "PING" ; M: join irc-command-string ( join -- string ) drop "JOIN" ; M: part irc-command-string ( part -- string ) drop "PART" ; M: quit irc-command-string ( quit -- string ) drop "QUIT" ; +M: nick irc-command-string ( nick -- string ) drop "NICK" ; M: privmsg irc-command-string ( privmsg -- string ) drop "PRIVMSG" ; M: notice irc-command-string ( notice -- string ) drop "NOTICE" ; M: mode irc-command-string ( mode -- string ) drop "MODE" ; @@ -46,6 +48,7 @@ M: ping irc-command-parameters ( ping -- seq ) drop { } ; M: join irc-command-parameters ( join -- seq ) drop { } ; M: part irc-command-parameters ( part -- seq ) name>> 1array ; M: quit irc-command-parameters ( quit -- seq ) drop { } ; +M: nick irc-command-parameters ( nick -- seq ) drop { } ; M: privmsg irc-command-parameters ( privmsg -- seq ) name>> 1array ; M: notice irc-command-parameters ( norice -- seq ) type>> 1array ; M: kick irc-command-parameters ( kick -- seq ) @@ -110,6 +113,7 @@ PRIVATE> { "353" [ names-reply ] } { "JOIN" [ join ] } { "PART" [ part ] } + { "NICK" [ nick ] } { "PRIVMSG" [ privmsg ] } { "QUIT" [ quit ] } { "MODE" [ mode ] } diff --git a/extra/irc/ui/ui.factor b/extra/irc/ui/ui.factor index c91d797f25..0ceeed1d35 100755 --- a/extra/irc/ui/ui.factor +++ b/extra/irc/ui/ui.factor @@ -5,7 +5,7 @@ USING: accessors kernel threads combinators concurrency.mailboxes sequences strings hashtables splitting fry assocs hashtables ui ui.gadgets ui.gadgets.panes ui.gadgets.editors ui.gadgets.scrollers ui.commands ui.gadgets.frames ui.gestures - ui.gadgets.tabs ui.gadgets.grids ui.gadgets.lists ui.gadgets.labels + ui.gadgets.tabs ui.gadgets.grids ui.gadgets.packs ui.gadgets.labels io io.styles namespaces calendar calendar.format models continuations irc.client irc.client.private irc.messages irc.messages.private irc.ui.commandparser irc.ui.load qualified ; @@ -20,7 +20,7 @@ SYMBOL: client TUPLE: ui-window client tabs ; -TUPLE: irc-tab < frame listener client listmodel ; +TUPLE: irc-tab < frame listener client userlist ; : write-color ( str color -- ) foreground associate format ; @@ -116,16 +116,15 @@ M: irc-message write-irc GENERIC: handle-inbox ( tab message -- ) -: filter-participants ( assoc val -- alist ) - [ >alist ] dip - '[ second , = ] filter ; +: filter-participants ( pack alist val color -- ) + '[ , = [