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 e4b7cd20ed6355b17fcb4186722984e4d3070798..e021ff4ff4397683c9cdedc6d7b71242da54dd82 100644 (file)
--- 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" [ <irc-channel-listener> ] 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" [ <irc-channel-listener>
+                          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" [ <irc-channel-listener>
+                          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" [ <irc-channel-listener>
+                          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" [ <irc-channel-listener> ] 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 42682154cdd241460004d70619e9fb6b933bfd30..813de0f57c44455e18eb0d0d471ce7c38f6ee8bc 100644 (file)
--- 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 <participant-changed> ] 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 876841abb70634c4402c3c4f099ac64adc9322ee..7ee0f41ab050813ada8d72ef3a3606399660b7f2 100644 (file)
--- 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 a5f82a5ae1b6612054602f7ed119d43c83cfe134..3b9cf0af2cee79f04347339df2c958df276c4d40 100644 (file)
--- 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 c91d797f252791f67401cbdf76d46b5e8970a938..0ceeed1d35b4c469bf649687dff32ea30f619acd 100755 (executable)
--- 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\r
        ui ui.gadgets ui.gadgets.panes ui.gadgets.editors\r
        ui.gadgets.scrollers ui.commands ui.gadgets.frames ui.gestures\r
-       ui.gadgets.tabs ui.gadgets.grids ui.gadgets.lists ui.gadgets.labels\r
+       ui.gadgets.tabs ui.gadgets.grids ui.gadgets.packs ui.gadgets.labels\r
        io io.styles namespaces calendar calendar.format models continuations\r
        irc.client irc.client.private irc.messages irc.messages.private\r
        irc.ui.commandparser irc.ui.load qualified ;\r
@@ -20,7 +20,7 @@ SYMBOL: client
 \r
 TUPLE: ui-window client tabs ;\r
 \r
-TUPLE: irc-tab < frame listener client listmodel ;\r
+TUPLE: irc-tab < frame listener client userlist ;\r
 \r
 : write-color ( str color -- )\r
     foreground associate format ;\r
@@ -116,16 +116,15 @@ M: irc-message write-irc
 \r
 GENERIC: handle-inbox ( tab message -- )\r
 \r
-: filter-participants ( assoc val -- alist )\r
-    [ >alist ] dip\r
-   '[ second , = ] filter ;\r
+: filter-participants ( pack alist val color -- )\r
+   '[ , = [ <label> , >>color add-gadget ] [ drop ] if ] assoc-each ;\r
 \r
 : update-participants ( tab -- )\r
-    [ listmodel>> ] [ listener>> participants>> ] bi\r
-    [ +operator+ filter-participants ]\r
-    [ +voice+ filter-participants ]\r
-    [ +normal+ filter-participants ] tri\r
-    append append swap set-model ;\r
+    [ userlist>> [ clear-gadget ] keep ]\r
+    [ listener>> participants>> ] bi\r
+    [ +operator+ green filter-participants ]\r
+    [ +voice+ blue filter-participants ]\r
+    [ +normal+ black filter-participants ] 2tri ;\r
 \r
 M: participant-changed handle-inbox\r
     drop update-participants ;\r
@@ -162,11 +161,6 @@ irc-editor "general" f {
     { T{ key-down f f "ENTER" } editor-send }\r
 } define-command-map\r
 \r
-: <irc-list> ( -- gadget model )\r
-    [ drop ]\r
-    [ first2 [ <label> ] dip >>color ]\r
-    { } <model> [ <list> ] keep ;\r
-\r
 : <irc-tab> ( listener client -- irc-tab )\r
     irc-tab new-frame\r
     swap client>> >>client swap >>listener\r
@@ -175,19 +169,19 @@ irc-editor "general" f {
 \r
 : <irc-channel-tab> ( listener client -- irc-tab )\r
     <irc-tab>\r
-    <irc-list> [ <scroller> @right grid-add ] dip >>listmodel\r
-    [ update-participants ] keep ;\r
+    <pile> [ <scroller> @right grid-add ] keep >>userlist ;\r
 \r
 : <irc-server-tab> ( listener client -- irc-tab )\r
     <irc-tab> ;\r
 \r
 M: irc-tab graft*\r
-    [ listener>> ] [ client>> ] bi\r
-    add-listener ;\r
+    [ listener>> ] [ client>> ] bi add-listener ;\r
 \r
 M: irc-tab ungraft*\r
-    [ listener>> ] [ client>> ] bi\r
-    remove-listener ;\r
+    [ listener>> ] [ client>> ] bi remove-listener ;\r
+\r
+M: irc-tab pref-dim*\r
+    drop { 480 480 } ;\r
 \r
 : join-channel ( name ui-window -- )\r
     [ dup <irc-channel-listener> ] dip\r