Merge branch 'master' of git://factorcode.org/git/factor

diff --git a/extra/irc/client/client-tests.factor b/extra/irc/client/client-tests.factor
index fe85d6c375697a37cd5bcb54b0b9784a2ac716cc..327bfc629282a0dfd47cb6a12a40fc71b0440de6 100644 (file)
--- a/extra/irc/client/client-tests.factor
+++ b/extra/irc/client/client-tests.factor
@@ -169,6 +169,20 @@ M: mb-writer dispose drop ;
   ] unit-test
 ] with-irc
 
+[ { H{ { "factorbot" +operator+ } { "ircuser" +normal+ } } } [
+      "#factortest" <irc-channel-chat>
+          H{ { "ircuser" +normal+ } } clone >>participants
+      [ %add-named-chat ] keep
+      ":ircserver.net 353 factorbot @ #factortest :@factorbot " %push-line
+      ":ircserver.net 353 factorbot @ #factortest :ircuser2 " %push-line
+      ":ircserver.net 366 factorbot #factortest :End of /NAMES list." %push-line
+      ":ircserver.net 353 factorbot @ #factortest :@factorbot " %push-line
+      ":ircserver.net 353 factorbot @ #factortest :ircuser " %push-line
+      ":ircserver.net 366 factorbot #factortest :End of /NAMES list." %push-line
+      participants>>
+  ] unit-test
+] with-irc
+
 ! Namelist change notification
 [ { T{ participant-changed f f f f } } [
       "#factortest" <irc-channel-chat> [ %add-named-chat ] keep
@@ -195,3 +209,11 @@ M: mb-writer dispose drop ;
       [ participant-changed? ] read-matching-message
   ] unit-test
 ] with-irc
+
+! Mode change
+[ { T{ participant-changed f "ircuser" +mode+ "+o" } } [
+      "#factortest" <irc-channel-chat> [ %add-named-chat ] keep
+      ":ircserver.net MODE #factortest +o ircuser" %push-line
+      [ participant-changed? ] read-matching-message
+  ] unit-test
+] with-irc

diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor
index ce7a6e5373095bd38779be5b77445e76dd99b678..d79e8e0ee5a52f353d83b66ff9cbd96ae530b145 100755 (executable)
--- a/extra/irc/client/client.factor
+++ b/extra/irc/client/client.factor
@@ -32,7 +32,7 @@ TUPLE: irc-client profile stream in-messages out-messages
 
 TUPLE: irc-chat in-messages client ;
 TUPLE: irc-server-chat < irc-chat ;
-TUPLE: irc-channel-chat < irc-chat name password timeout participants ;
+TUPLE: irc-channel-chat < irc-chat name password timeout participants clean-participants ;
 TUPLE: irc-nick-chat < irc-chat name ;
 SYMBOL: +server-chat+
 
@@ -55,7 +55,7 @@ SYMBOL: +nick+
      <mailbox> f irc-server-chat boa ;
 
 : <irc-channel-chat> ( name -- irc-channel-chat )
-     [ <mailbox> f ] dip f 60 seconds H{ } clone
+     [ <mailbox> f ] dip f 60 seconds H{ } clone t
      irc-channel-chat boa ;
 
 : <irc-nick-chat> ( name -- irc-nick-chat )
@@ -148,7 +148,9 @@ M: irc-chat to-chat in-messages>> mailbox-put ;
 : change-participant-mode ( channel mode nick -- )
     rot chat>
     [ participants>> set-at ]
-    [ [ [ +mode+ ] dip <participant-changed> ] dip to-chat ] 3bi ; ! FIXME
+    [ [ participant-changed new
+        [ (>>nick) ] [ (>>parameter) ] [ +mode+ >>action ] tri ] dip to-chat ]
+    3bi ; ! FIXME
 
 DEFER: me?
 
@@ -208,7 +210,7 @@ M: broadcast-forward forward-message
 GENERIC: process-message ( irc-message -- )
 M: object      process-message drop ; 
 M: logged-in   process-message
-    name>> f irc> [ (>>is-ready) ] [ (>>nick) ] [ chats>> ] tri
+    name>> t irc> [ (>>is-ready) ] [ (>>nick) ] [ chats>> ] tri
     values [ initialize-chat ] each ;
 M: ping        process-message trailing>> /PONG ;
 M: nick-in-use process-message name>> "_" append /NICK ;
@@ -231,11 +233,11 @@ M: quit process-message
 M: nick process-message
     [ irc-message-sender ] [ trailing>> ] bi rename-participant-in-all ;
 
-! M: mode process-message ( mode -- )
-!    [ channel-mode? ] keep and [
-!        [ name>> ] [ mode>> ] [ parameter>> ] tri
-!        [ change-participant-mode ] [ 2drop ] if*
-!    ] when* ;
+M: mode process-message ( mode -- )
+    [ channel-mode? ] keep and [
+        [ name>> ] [ mode>> ] [ parameter>> ] tri
+        [ change-participant-mode ] [ 2drop ] if*
+    ] when* ;
 
 : >nick/mode ( string -- nick mode )
     dup first "+@" member? [ unclip ] [ 0 ] if participant-mode ;
@@ -244,12 +246,24 @@ M: nick process-message
     trailing>> [ blank? ] trim " " split
     [ >nick/mode 2array ] map >hashtable ;
 
+: maybe-clean-participants ( channel-chat -- )
+    dup clean-participants>> [
+        H{ } clone >>participants f >>clean-participants
+    ] when drop ;
+
 M: names-reply process-message
     [ names-reply>participants ] [ channel>> chat> ] bi [
-        [ (>>participants) ]
-        [ [ f f f <participant-changed> ] dip name>> to-chat ] bi
+        [ maybe-clean-participants ] 
+        [ participants>> 2array assoc-combine ]
+        [ (>>participants) ] tri
     ] [ drop ] if* ;
 
+M: end-of-names process-message
+    channel>> chat> [
+        t >>clean-participants
+        [ f f f <participant-changed> ] dip name>> to-chat
+    ] when* ;
+
 ! ======================================
 ! Client message handling
 ! ======================================

diff --git a/extra/irc/messages/messages.factor b/extra/irc/messages/messages.factor
index 32533c102a44312c905dbe179939841b2139edd1..bea9bf37b1527d3b9857c4a67e98da8162789734 100755 (executable)
--- a/extra/irc/messages/messages.factor
+++ b/extra/irc/messages/messages.factor
@@ -20,6 +20,7 @@ TUPLE: nick-in-use < irc-message name ;
 TUPLE: notice < irc-message type ;
 TUPLE: mode < irc-message name mode parameter ;
 TUPLE: names-reply < irc-message who channel ;
+TUPLE: end-of-names < irc-message who channel ;
 TUPLE: unhandled < irc-message ;
 
 : <irc-client-message> ( command parameters trailing -- irc-message )
@@ -85,6 +86,9 @@ M: nick-in-use >>command-parameters ( nick-in-use params -- nick-in-use )
 M: names-reply >>command-parameters ( names-reply params -- names-reply )
     first3 nip [ >>who ] [ >>channel ] bi* ;
 
+M: end-of-names >>command-parameters ( names-reply params -- names-reply )
+    first2 [ >>who ] [ >>channel ] bi* ;
+
 M: mode >>command-parameters ( mode params -- mode )
     dup length 3 = [
         first3 [ >>name ] [ >>mode ] [ >>parameter ] tri*
@@ -159,6 +163,7 @@ M: sender-in-prefix irc-message-sender ( sender-in-prefix -- sender )
             { "001"     [ logged-in ] }
             { "433"     [ nick-in-use ] }
             { "353"     [ names-reply ] }
+            { "366"     [ end-of-names ] }
             { "JOIN"    [ join ] }
             { "PART"    [ part ] }
             { "NICK"    [ nick ] }

diff --git a/extra/irc/ui/commands/commands.factor b/extra/irc/ui/commands/commands.factor
index 4bb77e7490c34b1d344ee3eba45d2947741a4adb..147d25bea5d7a26ff90f7427031036cbb9251163 100755 (executable)
--- a/extra/irc/ui/commands/commands.factor
+++ b/extra/irc/ui/commands/commands.factor
@@ -1,7 +1,8 @@
 ! Copyright (C) 2008 William Schlieper\r
 ! See http://factorcode.org/license.txt for BSD license.\r
 \r
-USING: accessors kernel arrays irc.client irc.messages irc.ui namespaces ;\r
+USING: accessors kernel sequences arrays irc.client\r
+       irc.messages irc.ui namespaces ;\r
 \r
 IN: irc.ui.commands\r
 \r
@@ -10,6 +11,9 @@ IN: irc.ui.commands
     [ window>> client>> profile>> nickname>> <own-message> print-irc ]\r
     [ chat>> speak ] 2bi ;\r
 \r
+: me ( string -- ) ! Placeholder until I make /me look different\r
+    "ACTION " 1 prefix prepend 1 suffix say ;\r
+\r
 : join ( string -- )\r
     irc-tab get window>> join-channel ;\r
 \r

diff --git a/extra/ui/gadgets/tabs/tabs.factor b/extra/ui/gadgets/tabs/tabs.factor
index 7e09d086c2154d1a27f17ffa89bc00484eacc8b4..0113e01ba73884e55f13fa851470f8ac96565f49 100755 (executable)
--- a/extra/ui/gadgets/tabs/tabs.factor
+++ b/extra/ui/gadgets/tabs/tabs.factor
@@ -12,9 +12,9 @@ TUPLE: tabbed < frame names toggler content ;
 \r
 DEFER: (del-page)\r
 \r
-:: add-toggle ( model n name toggler -- )\r
+:: add-toggle ( n name model toggler -- )\r
   <frame>\r
-    n name toggler parent>> '[ _ _ _ (del-page) ] "X" swap <bevel-button>\r
+    n name toggler parent>> '[ drop _ _ _ (del-page) ] "X" swap <bevel-button>\r
       @right grid-add\r
     n model name <toggle-button> @center grid-add\r
   toggler swap add-gadget drop ;\r
@@ -23,7 +23,7 @@ DEFER: (del-page)
      [ names>> ] [ model>> ] [ toggler>> ] tri\r
      [ clear-gadget ] keep\r
      [ [ length ] keep ] 2dip\r
-     '[ [ _ ] 2dip _ add-toggle ] 2each ;\r
+     '[ _ _ add-toggle ] 2each ;\r
 \r
 : refresh-book ( tabbed -- )\r
     model>> [ ] change-model ;\r
@@ -39,8 +39,8 @@ DEFER: (del-page)
 \r
 : add-page ( page name tabbed -- )\r
     [ names>> push ] 2keep\r
-    [ [ model>> swap ]\r
-      [ names>> length 1 - swap ]\r
+    [ [ names>> length 1 - swap ]\r
+      [ model>> ]\r
       [ toggler>> ] tri add-toggle ]\r
     [ content>> swap add-gadget drop ]\r
     [ refresh-book ] tri ;\r