From a0782fb5991b0348ee11b2b7c51782aa55c42013 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Tue, 29 Jul 2008 00:48:25 -0300 Subject: [PATCH 1/4] irc.client: Don't forward quit messages to the server listener, tests for participant lists --- extra/irc/client/client-tests.factor | 58 ++++++++++++++++++++++++++++ extra/irc/client/client.factor | 15 ++++--- 2 files changed, 65 insertions(+), 8 deletions(-) diff --git a/extra/irc/client/client-tests.factor b/extra/irc/client/client-tests.factor index e4b7cd20ed..166619f6cb 100644 --- a/extra/irc/client/client-tests.factor +++ b/extra/irc/client/client-tests.factor @@ -101,3 +101,61 @@ IN: irc.client.tests } cleave [ class ] [ name>> ] [ trailing>> ] tri ] unit-test + +! Participants lists tests +{ H{ { "somedude" f } } } [ + { ":somedude!n=user@isp.net JOIN :#factortest" } make-client + { [ "factorbot" set-nick ] + [ listeners>> + [ "#factortest" [ ] keep ] dip set-at ] + [ connect-irc ] + [ drop 1 seconds sleep ] + [ listeners>> [ "#factortest" ] dip at participants>> ] + [ terminate-irc ] + } cleave + ] unit-test + +{ H{ { "somedude2" f } } } [ + { ":somedude!n=user@isp.net PART #factortest" } make-client + { [ "factorbot" set-nick ] + [ listeners>> + [ "#factortest" [ + H{ { "somedude2" f } + { "somedude" f } } clone >>participants ] keep + ] dip set-at ] + [ connect-irc ] + [ drop 1 seconds sleep ] + [ listeners>> [ "#factortest" ] dip at participants>> ] + [ terminate-irc ] + } cleave + ] unit-test + +{ H{ { "somedude2" f } } } [ + { ":somedude!n=user@isp.net QUIT" } make-client + { [ "factorbot" set-nick ] + [ listeners>> + [ "#factortest" [ + H{ { "somedude2" f } + { "somedude" f } } clone >>participants ] keep + ] dip set-at ] + [ connect-irc ] + [ drop 1 seconds sleep ] + [ listeners>> [ "#factortest" ] dip at participants>> ] + [ terminate-irc ] + } cleave + ] unit-test + +{ H{ { "somedude2" f } } } [ + { ":somedude2!n=user2@isp.net KICK #factortest somedude" } make-client + { [ "factorbot" set-nick ] + [ listeners>> + [ "#factortest" [ + H{ { "somedude2" f } + { "somedude" f } } clone >>participants ] keep + ] dip set-at ] + [ connect-irc ] + [ drop 1 seconds sleep ] + [ listeners>> [ "#factortest" ] dip at participants>> ] + [ terminate-irc ] + } cleave + ] unit-test diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor index 42682154cd..89286f6303 100644 --- a/extra/irc/client/client.factor +++ b/extra/irc/client/client.factor @@ -218,7 +218,7 @@ 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 ] [ handle-participant-change ] @@ -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 ; From 5fd42c4e543ea6ffa7a42ae2be35afef9fa73854 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Tue, 29 Jul 2008 00:52:42 -0300 Subject: [PATCH 2/4] irc.client: For tests that need to wait, wait 0.1 seconds instead of 1 second. --- extra/irc/client/client-tests.factor | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/extra/irc/client/client-tests.factor b/extra/irc/client/client-tests.factor index 166619f6cb..08307a2d5c 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 @@ -109,7 +109,7 @@ IN: irc.client.tests [ listeners>> [ "#factortest" [ ] keep ] dip set-at ] [ connect-irc ] - [ drop 1 seconds sleep ] + [ drop 0.1 seconds sleep ] [ listeners>> [ "#factortest" ] dip at participants>> ] [ terminate-irc ] } cleave @@ -124,7 +124,7 @@ IN: irc.client.tests { "somedude" f } } clone >>participants ] keep ] dip set-at ] [ connect-irc ] - [ drop 1 seconds sleep ] + [ drop 0.1 seconds sleep ] [ listeners>> [ "#factortest" ] dip at participants>> ] [ terminate-irc ] } cleave @@ -139,7 +139,7 @@ IN: irc.client.tests { "somedude" f } } clone >>participants ] keep ] dip set-at ] [ connect-irc ] - [ drop 1 seconds sleep ] + [ drop 0.1 seconds sleep ] [ listeners>> [ "#factortest" ] dip at participants>> ] [ terminate-irc ] } cleave @@ -154,7 +154,7 @@ IN: irc.client.tests { "somedude" f } } clone >>participants ] keep ] dip set-at ] [ connect-irc ] - [ drop 1 seconds sleep ] + [ drop 0.1 seconds sleep ] [ listeners>> [ "#factortest" ] dip at participants>> ] [ terminate-irc ] } cleave From fcc1ee9cdd68cc37ac4df359fa4919422d0e8374 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Thu, 31 Jul 2008 21:35:09 -0300 Subject: [PATCH 3/4] irc.client: nick command parsing, namelist notification after join, tests. Make +normal+ the default state for participants, not 'f' --- extra/irc/client/client-tests.factor | 34 +++++++++++++++++------- extra/irc/client/client.factor | 8 +++--- extra/irc/messages/messages-tests.factor | 12 ++++++++- extra/irc/messages/messages.factor | 4 +++ 4 files changed, 44 insertions(+), 14 deletions(-) diff --git a/extra/irc/client/client-tests.factor b/extra/irc/client/client-tests.factor index 08307a2d5c..e021ff4ff4 100644 --- a/extra/irc/client/client-tests.factor +++ b/extra/irc/client/client-tests.factor @@ -103,7 +103,7 @@ IN: irc.client.tests ] unit-test ! Participants lists tests -{ H{ { "somedude" f } } } [ +{ H{ { "somedude" +normal+ } } } [ { ":somedude!n=user@isp.net JOIN :#factortest" } make-client { [ "factorbot" set-nick ] [ listeners>> @@ -115,13 +115,13 @@ IN: irc.client.tests } cleave ] unit-test -{ H{ { "somedude2" f } } } [ +{ H{ { "somedude2" +normal+ } } } [ { ":somedude!n=user@isp.net PART #factortest" } make-client { [ "factorbot" set-nick ] [ listeners>> [ "#factortest" [ - H{ { "somedude2" f } - { "somedude" f } } clone >>participants ] keep + H{ { "somedude2" +normal+ } + { "somedude" +normal+ } } clone >>participants ] keep ] dip set-at ] [ connect-irc ] [ drop 0.1 seconds sleep ] @@ -130,13 +130,13 @@ IN: irc.client.tests } cleave ] unit-test -{ H{ { "somedude2" f } } } [ +{ H{ { "somedude2" +normal+ } } } [ { ":somedude!n=user@isp.net QUIT" } make-client { [ "factorbot" set-nick ] [ listeners>> [ "#factortest" [ - H{ { "somedude2" f } - { "somedude" f } } clone >>participants ] keep + H{ { "somedude2" +normal+ } + { "somedude" +normal+ } } clone >>participants ] keep ] dip set-at ] [ connect-irc ] [ drop 0.1 seconds sleep ] @@ -145,13 +145,13 @@ IN: irc.client.tests } cleave ] unit-test -{ H{ { "somedude2" f } } } [ +{ H{ { "somedude2" +normal+ } } } [ { ":somedude2!n=user2@isp.net KICK #factortest somedude" } make-client { [ "factorbot" set-nick ] [ listeners>> [ "#factortest" [ - H{ { "somedude2" f } - { "somedude" f } } clone >>participants ] keep + H{ { "somedude2" +normal+ } + { "somedude" +normal+ } } clone >>participants ] keep ] dip set-at ] [ connect-irc ] [ drop 0.1 seconds sleep ] @@ -159,3 +159,17 @@ IN: irc.client.tests [ 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 89286f6303..813de0f57c 100644 --- a/extra/irc/client/client.factor +++ b/extra/irc/client/client.factor @@ -220,7 +220,7 @@ M: privmsg handle-incoming-irc ( privmsg -- ) M: join handle-incoming-irc ( join -- ) { [ 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 ; @@ -252,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 ] } From 804a76afc8be49b405402e78f90ecd5c698fdc50 Mon Sep 17 00:00:00 2001 From: William Schlieper Date: Thu, 31 Jul 2008 21:36:16 -0400 Subject: [PATCH 4/4] irc.ui: Userlists no longer use list gadgets --- extra/irc/ui/ui.factor | 36 +++++++++++++++--------------------- 1 file changed, 15 insertions(+), 21 deletions(-) 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 -- ) + '[ , = [