diff --git a/extra/irc/client/client-tests.factor b/extra/irc/client/client-tests.factor index fe85d6c375..327bfc6292 100644 --- 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" + 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" [ %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" [ %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 ce7a6e5373..d79e8e0ee5 100755 --- 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+ f irc-server-chat boa ; : ( name -- irc-channel-chat ) - [ f ] dip f 60 seconds H{ } clone + [ f ] dip f 60 seconds H{ } clone t irc-channel-chat boa ; : ( 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 ] 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 ] 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 ] dip name>> to-chat + ] when* ; + ! ====================================== ! Client message handling ! ====================================== diff --git a/extra/irc/messages/messages.factor b/extra/irc/messages/messages.factor index 32533c102a..bea9bf37b1 100755 --- 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 ; : ( 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 4bb77e7490..147d25bea5 100755 --- a/extra/irc/ui/commands/commands.factor +++ b/extra/irc/ui/commands/commands.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2008 William Schlieper ! See http://factorcode.org/license.txt for BSD license. -USING: accessors kernel arrays irc.client irc.messages irc.ui namespaces ; +USING: accessors kernel sequences arrays irc.client + irc.messages irc.ui namespaces ; IN: irc.ui.commands @@ -10,6 +11,9 @@ IN: irc.ui.commands [ window>> client>> profile>> nickname>> print-irc ] [ chat>> speak ] 2bi ; +: me ( string -- ) ! Placeholder until I make /me look different + "ACTION " 1 prefix prepend 1 suffix say ; + : join ( string -- ) irc-tab get window>> join-channel ; diff --git a/extra/ui/gadgets/tabs/tabs.factor b/extra/ui/gadgets/tabs/tabs.factor index 7e09d086c2..0113e01ba7 100755 --- a/extra/ui/gadgets/tabs/tabs.factor +++ b/extra/ui/gadgets/tabs/tabs.factor @@ -12,9 +12,9 @@ TUPLE: tabbed < frame names toggler content ; DEFER: (del-page) -:: add-toggle ( model n name toggler -- ) +:: add-toggle ( n name model toggler -- ) - n name toggler parent>> '[ _ _ _ (del-page) ] "X" swap + n name toggler parent>> '[ drop _ _ _ (del-page) ] "X" swap @right grid-add n model name @center grid-add toggler swap add-gadget drop ; @@ -23,7 +23,7 @@ DEFER: (del-page) [ names>> ] [ model>> ] [ toggler>> ] tri [ clear-gadget ] keep [ [ length ] keep ] 2dip - '[ [ _ ] 2dip _ add-toggle ] 2each ; + '[ _ _ add-toggle ] 2each ; : refresh-book ( tabbed -- ) model>> [ ] change-model ; @@ -39,8 +39,8 @@ DEFER: (del-page) : add-page ( page name tabbed -- ) [ names>> push ] 2keep - [ [ model>> swap ] - [ names>> length 1 - swap ] + [ [ names>> length 1 - swap ] + [ model>> ] [ toggler>> ] tri add-toggle ] [ content>> swap add-gadget drop ] [ refresh-book ] tri ;