Merge branch 'master' of git://factorforge.org/git/william42

extra/backtrack/backtrack.factor

@@ -1,20 +1,68 @@
 ! Copyright (C) 2008 William Schlieper
 ! See http://factorcode.org/license.txt for BSD license.
 
-USING: kernel continuations sequences namespaces fry ;
+USING: kernel continuations combinators sequences quotations arrays namespaces
+       fry summary assocs math math.order macros ;
 
 IN: backtrack
 
 SYMBOL: failure
 
-: amb ( seq -- elt )
+ERROR: amb-failure ;
-    failure get
+
-    '[ , _ '[ , '[ failure set , , continue-with ] callcc0 ] each
+M: amb-failure summary drop "Backtracking failure" ;
-       , continue ] callcc1 ;
 
 : fail ( -- )
-    f amb drop ;
+    failure get [ continue ]
+    [ amb-failure ] if* ;
 
 : require ( ? -- )
     [ fail ] unless ;
 
+MACRO: checkpoint ( quot -- quot' )
+    '[ failure get ,
+       '[ '[ failure set , continue ] callcc0
+          , failure set @ ] callcc0 ] ;
+
+: number-from ( from -- from+n )
+    [ 1 + number-from ] checkpoint ;
+
+<PRIVATE
+
+: unsafe-number-from-to ( to from -- to from+n )
+    2dup = [ [ 1 + unsafe-number-from-to ] checkpoint ] unless ;
+
+: number-from-to ( to from -- to from+n )
+    2dup < [ fail ] when unsafe-number-from-to ;
+
+: amb-integer ( seq -- int )
+    length 1 - 0 number-from-to nip ;
+
+MACRO: unsafe-amb ( seq -- quot )
+    dup length 1 =
+    [ first 1quotation ]
+    [ [ first ] [ rest ] bi
+      '[ , [ drop , unsafe-amb ] checkpoint ] ] if ;
+
+PRIVATE> 
+
+: amb-lazy ( seq -- elt )
+    [ amb-integer ] [ nth ] bi ;
+
+: amb ( seq -- elt )
+    dup empty?
+    [ drop fail f ]
+    [ unsafe-amb ] if ; inline
+
+MACRO: amb-execute ( seq -- quot )
+    [ length 1 - ] [ <enum> [ 1quotation ] assoc-map ] bi
+    '[ , 0 unsafe-number-from-to nip , case ] ;
+
+: if-amb ( true false -- )
+    [
+        [ { t f } amb ]
+        [ '[ @ require t ] ]
+        [ '[ @ f ] ]
+        tri* if
+    ] with-scope ; inline
+

extra/benchmark/backtrack/backtrack.factor

@@ -12,18 +12,6 @@ IN: benchmark.backtrack
 
 : nop ;
 
-MACRO: amb-execute ( seq -- quot )
-    [ length ] [ <enum> [ 1quotation ] assoc-map ] bi
-    '[ , amb , case ] ;
-
-: if-amb ( true false -- )
-    [
-        [ { t f } amb ]
-        [ '[ @ require t ] ]
-        [ '[ @ f ] ]
-        tri* if
-    ] with-scope ; inline
-
 : do-something ( a b -- c )
     { + - * } amb-execute ;
 

extra/irc/client/client-tests.factor

@@ -1,7 +1,7 @@
 USING: kernel tools.test accessors arrays sequences qualified
        io.streams.string io.streams.duplex namespaces threads
        calendar irc.client.private irc.client irc.messages.private
-       concurrency.mailboxes classes ;
+       concurrency.mailboxes classes assocs ;
 EXCLUDE: irc.messages => join ;
 RENAME: join irc.messages => join_
 IN: irc.client.tests
@@ -20,28 +20,6 @@ IN: irc.client.tests
 : with-dummy-client ( quot -- )
      rot with-variable ; inline
 
-! Parsing tests
-irc-message new
-    ":someuser!n=user@some.where PRIVMSG #factortest :hi" >>line
-    "someuser!n=user@some.where" >>prefix
-                       "PRIVMSG" >>command
-               { "#factortest" } >>parameters
-                            "hi" >>trailing
-1array
-[ ":someuser!n=user@some.where PRIVMSG #factortest :hi"
-  string>irc-message f >>timestamp ] unit-test
-
-privmsg new
-    ":someuser!n=user@some.where PRIVMSG #factortest :hi" >>line
-    "someuser!n=user@some.where" >>prefix
-                       "PRIVMSG" >>command
-               { "#factortest" } >>parameters
-                            "hi" >>trailing
-                   "#factortest" >>name
-1array
-[ ":someuser!n=user@some.where PRIVMSG #factortest :hi"
-  parse-irc-line f >>timestamp ] unit-test
-
 { "" } make-client dup "factorbot" set-nick current-irc-client [
     { t } [ irc> profile>> nickname>> me? ] unit-test
 
@@ -64,21 +42,29 @@ privmsg new
                     ":some.where 001 factorbot :Welcome factorbot"
                   } make-client
                   [ connect-irc ] keep 1 seconds sleep
-                    profile>> nickname>> ] unit-test
+                  profile>> nickname>> ] unit-test
 
 { join_ "#factortest" } [
-             { ":factorbot!n=factorbo@some.where JOIN :#factortest"
+           { ":factorbot!n=factorbo@some.where JOIN :#factortest"
              ":ircserver.net MODE #factortest +ns"
              ":ircserver.net 353 factorbot @ #factortest :@factorbot "
              ":ircserver.net 366 factorbot #factortest :End of /NAMES list."
              ":ircserver.net 477 factorbot #factortest :[ircserver-info] blah blah"
              } make-client dup "factorbot" set-nick
              [ connect-irc ] keep 1 seconds sleep
-             join-messages>> 5 seconds mailbox-get-timeout
+             join-messages>> 1 seconds mailbox-get-timeout
              [ class ] [ trailing>> ] bi ] unit-test
-! TODO: user join
+
-! ":somedude!n=user@isp.net JOIN :#factortest"
+{ +join+ "somebody" } [
+           { ":somebody!n=somebody@some.where JOIN :#factortest"
+             } make-client dup "factorbot" set-nick
+             [ listeners>> [ "#factortest" [ <irc-channel-listener> ] keep ] dip set-at ]
+             [ connect-irc ]
+             [ listeners>> [ "#factortest" ] dip at
+               [ read-message drop ] [ read-message drop ] [ read-message ] tri ] tri
+             [ action>> ] [ nick>> ] bi
+             ] unit-test
 ! TODO: channel message
-! ":somedude!n=user@isp.net PRIVMSG #factortest :hello"
+! ":somebody!n=somebody@some.where PRIVMSG #factortest :hello"
 ! TODO: direct private message
 ! ":somedude!n=user@isp.net PRIVMSG factorbot2 :hello"

extra/irc/client/client.factor

@@ -31,6 +31,20 @@ TUPLE: irc-channel-listener < irc-listener name password timeout participants ;
 TUPLE: irc-nick-listener < irc-listener name ;
 SYMBOL: +server-listener+
 
+! participant modes
+SYMBOL: +operator+
+SYMBOL: +voice+
+SYMBOL: +normal+
+
+: participant-mode ( n -- mode )
+    H{ { 64 +operator+ } { 43 +voice+ } { 0 +normal+ } } at ;
+
+! participant changed actions
+SYMBOL: +join+
+SYMBOL: +part+
+SYMBOL: +mode+
+
+! listener objects
 : <irc-listener> ( -- irc-listener ) <mailbox> <mailbox> irc-listener boa ;
 
 : <irc-server-listener> ( -- irc-server-listener )
@@ -46,6 +60,9 @@ SYMBOL: +server-listener+
 ! Message objects
 ! ======================================
 
+TUPLE: participant-changed nick action ;
+C: <participant-changed> participant-changed
+
 SINGLETON: irc-end          ! sent when the client isn't running anymore
 SINGLETON: irc-disconnected ! sent when connection is lost
 SINGLETON: irc-connected    ! sent when connection is established
@@ -70,19 +87,27 @@ UNION: irc-broadcasted-message irc-end irc-disconnected irc-connected ;
 : listener> ( name -- listener/f ) irc> listeners>> at ;
 : unregister-listener ( name -- ) irc> listeners>> delete-at ;
 
-: to-listener ( message name -- )
+GENERIC: to-listener ( message obj -- )
+
+M: string to-listener ( message string -- )
     listener> [ +server-listener+ listener> ] unless*
-    [ in-messages>> mailbox-put ] [ drop ] if* ;
+    [ to-listener ] [ drop ] if* ;
+
+M: irc-listener to-listener ( message irc-listener -- )
+    in-messages>> mailbox-put ;
 
 : remove-participant ( nick channel -- )
     listener> [ participants>> delete-at ] [ drop ] if* ;
 
-: remove-participant-from-all ( nick -- )
+: listeners-with-participant ( nick -- seq )
-    irc> listeners>>
+    irc> listeners>> values
-    [ irc-channel-listener? [ swap remove-participant ] [ 2drop ] if ] with
+    [ dup irc-channel-listener? [ participants>> key? ] [ 2drop f ] if ]
-    assoc-each ;
+    with filter ;
 
-: add-participant ( nick mode channel -- )
+: remove-participant-from-all ( nick -- )
+    dup listeners-with-participant [ delete-at ] with each ;
+
+: add-participant ( mode nick channel -- )
     listener> [ participants>> set-at ] [ 2drop ] if* ;
 
 DEFER: me?
@@ -142,12 +167,31 @@ DEFER: me?
     dup name>> me? [ prefix>> parse-name ] [ name>> ] if ;
 
 : broadcast-message-to-listeners ( message -- )
-    irc> listeners>> values [ in-messages>> mailbox-put ] with each ;
+    irc> listeners>> values [ to-listener ] with each ;
+
+GENERIC: handle-participant-change ( irc-message -- )
+
+M: join handle-participant-change ( join -- )
+    [ prefix>> parse-name +join+ <participant-changed> ]
+    [ trailing>> ] bi to-listener ;
+
+M: part handle-participant-change ( part -- )
+    [ prefix>> parse-name +part+ <participant-changed> ]
+    [ channel>> ] bi to-listener ;
+
+M: kick handle-participant-change ( kick -- )
+    [ who>> +part+ <participant-changed> ]
+    [ channel>> ] bi to-listener ;
+
+M: quit handle-participant-change ( quit -- )
+    prefix>> parse-name
+    [ +part+ <participant-changed> ] [ listeners-with-participant ] bi
+    [ to-listener ] with each ;
 
 GENERIC: handle-incoming-irc ( irc-message -- )
 
 M: irc-message handle-incoming-irc ( irc-message -- )
-    +server-listener+ listener> [ in-messages>> mailbox-put ] [ drop ] if* ;
+    +server-listener+ listener> [ to-listener ] [ drop ] if* ;
 
 M: logged-in handle-incoming-irc ( logged-in -- )
     name>> irc> profile>> (>>nickname) ;
@@ -162,34 +206,43 @@ M: privmsg handle-incoming-irc ( privmsg -- )
     dup irc-message-origin to-listener ;
 
 M: join handle-incoming-irc ( join -- )
-    [ maybe-forward-join ]
+    { [ maybe-forward-join ] ! keep
-    [ dup trailing>> to-listener ]
+      [ dup trailing>> to-listener ]
-    [ [ drop f ] [ prefix>> parse-name ] [ trailing>> ] tri add-participant ]
+      [ [ drop f ] [ prefix>> parse-name ] [ trailing>> ] tri add-participant ]
-    tri ;
+      [ handle-participant-change ]
+    } cleave ;
 
 M: part handle-incoming-irc ( part -- )
-    [ dup channel>> to-listener ] keep
+    [ dup channel>> to-listener ]
-    [ prefix>> parse-name ] [ channel>> ] bi remove-participant ;
+    [ [ prefix>> parse-name ] [ channel>> ] bi remove-participant ]
-
+    [ handle-participant-change ]
-M: kick handle-incoming-irc ( kick -- )
-    [ dup channel>>  to-listener ]
-    [ [ who>> ] [ channel>> ] bi remove-participant ] 
-    [ dup who>> me? [ unregister-listener ] [ drop ] if ]
     tri ;
 
+M: kick handle-incoming-irc ( kick -- )
+    { [ 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 -- )
-    [ prefix>> parse-name remove-participant-from-all ] keep
+    { [ dup prefix>> parse-name listeners-with-participant
-    call-next-method ;
+        [ to-listener ] with each ]
+      [ handle-participant-change ]
+      [ prefix>> parse-name remove-participant-from-all ]
+      [ ]
+    } cleave call-next-method ;
 
 : >nick/mode ( string -- nick mode )
-    dup first "+@" member? [ unclip ] [ f ] if ;
+    dup first "+@" member? [ unclip ] [ 0 ] if participant-mode ;
 
 : names-reply>participants ( names-reply -- participants )
     trailing>> [ blank? ] trim " " split
     [ >nick/mode 2array ] map >hashtable ;
 
 M: names-reply handle-incoming-irc ( names-reply -- )
-    [ names-reply>participants ] [ channel>> listener> ] bi (>>participants) ;
+    [ names-reply>participants ] [ channel>> listener> ] bi
+    [ (>>participants) ] [ drop ] if* ;
 
 M: irc-broadcasted-message handle-incoming-irc ( irc-broadcasted-message -- )
     broadcast-message-to-listeners ;
@@ -200,8 +253,8 @@ M: irc-broadcasted-message handle-incoming-irc ( irc-broadcasted-message -- )
 
 GENERIC: handle-outgoing-irc ( obj -- )
 
-! M: irc-message handle-outgoing-irc ( irc-message -- )
+M: irc-message handle-outgoing-irc ( irc-message -- )
-!    irc-message>string irc-print ;
+    irc-message>client-line irc-print ;
 
 M: privmsg handle-outgoing-irc ( privmsg -- )
     [ name>> ] [ trailing>> ] bi /PRIVMSG ;
@@ -213,11 +266,6 @@ M: part handle-outgoing-irc ( part -- )
 ! Reader/Writer
 ! ======================================
 
-: irc-mailbox-get ( mailbox quot -- )
-    [ 5 seconds ] dip
-    '[ , , ,  [ mailbox-get-timeout ] dip call ]
-    [ drop ] recover ; inline
-
 : handle-reader-message ( irc-message -- )
     irc> in-messages>> mailbox-put ;
 
@@ -225,7 +273,7 @@ DEFER: (connect-irc)
 
 : (handle-disconnect) ( -- )
     irc>
-        [ [ irc-disconnected ] dip in-messages>> mailbox-put ]
+        [ [ irc-disconnected ] dip to-listener ]
         [ dup reconnect-time>> sleep (connect-irc) ]
         [ profile>> nickname>> /LOGIN ]
     tri ;
@@ -247,14 +295,14 @@ DEFER: (connect-irc)
     [ (reader-loop) ] [ handle-disconnect ] recover ;
 
 : writer-loop ( -- )
-    irc> out-messages>> [ handle-outgoing-irc ] irc-mailbox-get ;
+    irc> out-messages>> mailbox-get handle-outgoing-irc ;
 
 ! ======================================
 ! Processing loops
 ! ======================================
 
 : in-multiplexer-loop ( -- )
-    irc> in-messages>> [ handle-incoming-irc ] irc-mailbox-get ;
+    irc> in-messages>> mailbox-get handle-incoming-irc ;
 
 : strings>privmsg ( name string -- privmsg )
     privmsg new [ (>>trailing) ] keep [ (>>name) ] keep ;
@@ -267,9 +315,8 @@ DEFER: (connect-irc)
     } cond ;
 
 : listener-loop ( name listener -- )
-    out-messages>> swap
+    out-messages>> mailbox-get maybe-annotate-with-name
-    '[ , swap maybe-annotate-with-name irc> out-messages>> mailbox-put ]
+    irc> out-messages>> mailbox-put ;
-    irc-mailbox-get ;
 
 : spawn-irc-loop ( quot name -- )
     [ '[ irc> is-running>> [ @ ] when irc> is-running>> ] ] dip

extra/irc/messages/messages-tests.factor

@@ -0,0 +1,37 @@
+USING: kernel tools.test accessors arrays qualified
+       irc.messages irc.messages.private ;
+EXCLUDE: sequences => join ;
+IN: irc.messages.tests
+
+! Parsing tests
+irc-message new
+    ":someuser!n=user@some.where PRIVMSG #factortest :hi" >>line
+    "someuser!n=user@some.where" >>prefix
+                       "PRIVMSG" >>command
+               { "#factortest" } >>parameters
+                            "hi" >>trailing
+1array
+[ ":someuser!n=user@some.where PRIVMSG #factortest :hi"
+  string>irc-message f >>timestamp ] unit-test
+
+privmsg new
+    ":someuser!n=user@some.where PRIVMSG #factortest :hi" >>line
+    "someuser!n=user@some.where" >>prefix
+                       "PRIVMSG" >>command
+               { "#factortest" } >>parameters
+                            "hi" >>trailing
+                   "#factortest" >>name
+1array
+[ ":someuser!n=user@some.where PRIVMSG #factortest :hi"
+  parse-irc-line f >>timestamp ] unit-test
+
+join new
+    ":someuser!n=user@some.where JOIN :#factortest" >>line
+    "someuser!n=user@some.where" >>prefix
+                          "JOIN" >>command
+                             { } >>parameters
+                   "#factortest" >>trailing
+1array
+[ ":someuser!n=user@some.where JOIN :#factortest"
+  parse-irc-line f >>timestamp ] unit-test
+

extra/irc/messages/messages.factor

@@ -21,6 +21,10 @@ TUPLE: mode < irc-message name channel mode ;
 TUPLE: names-reply < irc-message who = channel ;
 TUPLE: unhandled < irc-message ;
 
+: <irc-client-message> ( command parameters trailing -- irc-message )
+    irc-message new now >>timestamp
+    [ [ (>>trailing) ] [ (>>parameters) ] [ (>>command) ] tri ] keep ;
+
 GENERIC: irc-message>client-line ( irc-message -- string )
 
 M: irc-message irc-message>client-line ( irc-message -- string )
@@ -30,6 +34,7 @@ M: irc-message irc-message>client-line ( irc-message -- string )
     tri 3array " " sjoin ;
 
 GENERIC: irc-message>server-line ( irc-message -- string )
+
 M: irc-message irc-message>server-line ( irc-message -- string )
    drop "not implemented yet" ;
 
@@ -58,6 +63,8 @@ M: irc-message irc-message>server-line ( irc-message -- string )
 : split-trailing ( string -- string string/f )
     ":" split1 ;
 
+PRIVATE>
+
 : string>irc-message ( string -- object )
     dup split-prefix split-trailing
     [ [ blank? ] trim " " split unclip swap ] dip
@@ -82,4 +89,3 @@ M: irc-message irc-message>server-line ( irc-message -- string )
     [ [ tuple-slots ] [ parameters>> ] bi append ] dip
     [ all-slots over [ length ] bi@ min head ] keep slots>tuple ;
 
-PRIVATE>

extra/irc/ui/load/load.factor

@@ -5,7 +5,7 @@ USING: kernel io.files parser editors sequences ;
 
 IN: irc.ui.load
 
-: file-or ( path path -- path ) over exists? ? ;
+: file-or ( path path -- path ) [ [ exists? ] keep ] dip ? ;
 
 : personal-ui-rc ( -- path ) home ".ircui-rc" append-path ;
 

extra/irc/ui/ui.factor

@@ -5,8 +5,8 @@ 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.tabs ui.gadgets.grids ui.gadgets.lists ui.gadgets.labels
-       io io.styles namespaces calendar calendar.format
+       io io.styles namespaces calendar calendar.format models
        irc.client irc.client.private irc.messages irc.messages.private
        irc.ui.commandparser irc.ui.load ;
 
@@ -18,11 +18,18 @@ SYMBOL: client
 
 TUPLE: ui-window client tabs ;
 
+TUPLE: irc-tab < frame listener client listmodel ;
+
 : write-color ( str color -- )
     foreground associate format ;
 : red { 0.5 0 0 1 } ;
 : green { 0 0.5 0 1 } ;
 : blue { 0 0 1 1 } ;
+: black { 0 0 0 1 } ;
+
+: colors H{ { +operator+ { 0 0.5 0 1 } }
+            { +voice+ { 0 0 1 1 } }
+            { +normal+ { 0 0 0 1 } } } ;
 
 : dot-or-parens ( string -- string )
     dup empty? [ drop "." ]
@@ -64,6 +71,14 @@ M: quit write-irc
     " has left IRC" red write-color
     trailing>> dot-or-parens red write-color ;
 
+M: mode write-irc
+    "* " blue write-color
+    [ name>> write ] keep
+    " has applied mode " blue write-color
+    [ mode>> write ] keep
+    " to " blue write-color
+    channel>> write ;
+
 M: irc-end write-irc
     drop "* You have left IRC" red write-color ;
 
@@ -84,20 +99,39 @@ M: irc-message write-irc
     [ print-irc ]
     [ listener get write-message ] bi ;
 
-: display ( stream listener -- )
+GENERIC: handle-inbox ( tab message -- )
+
+: filter-participants ( assoc val -- alist )
+    [ >alist ] dip
+   '[ second , = ] filter ;
+
+: update-participants ( tab -- )
+    [ listmodel>> ] [ listener>> participants>> ] bi
+    [ +operator+ filter-participants ]
+    [ +voice+ filter-participants ]
+    [ +normal+ filter-participants ] tri
+    append append swap set-model ;
+
+M: participant-changed handle-inbox
+    drop update-participants ;
+
+M: object handle-inbox
+    nip print-irc ;
+
+: display ( stream tab -- )
     '[ , [ [ t ]
-           [ , read-message print-irc ]
+           [ , dup listener>> read-message handle-inbox ]
            [  ] while ] with-output-stream ] "ircv" spawn drop ;
 
-: <irc-pane> ( listener -- pane )
+: <irc-pane> ( tab -- tab pane )
     <scrolling-pane>
-    [ <pane-stream> swap display ] keep ;
+    [ <pane-stream> swap display ] 2keep ;
 
 TUPLE: irc-editor < editor outstream listener client ;
 
-: <irc-editor> ( page pane listener -- client editor )
+: <irc-editor> ( tab pane -- tab editor )
-    irc-editor new-editor
+    over irc-editor new-editor
-    swap >>listener swap <pane-stream> >>outstream
+    swap listener>> >>listener swap <pane-stream> >>outstream
     over client>> >>client ;
 
 : editor-send ( irc-editor -- )
@@ -113,25 +147,36 @@ irc-editor "general" f {
     { T{ key-down f f "ENTER" } editor-send }
 } define-command-map
 
-TUPLE: irc-page < frame listener client ;
+: <irc-list> ( -- gadget model )
+    [ drop ]
+    [ first2 [ <label> ] dip >>color ]
+    { } <model> [ <list> ] keep ;
 
-: <irc-page> ( listener client -- irc-page )
+: <irc-tab> ( listener client -- irc-tab )
-    irc-page new-frame
+    irc-tab new-frame
-    swap client>> >>client swap [ >>listener ] keep
+    swap client>> >>client swap >>listener
-    [ <irc-pane> [ <scroller> @center grid-add* ] keep ]
+    <irc-pane> [ <scroller> @center grid-add* ] keep
-    [ <irc-editor> <scroller> @bottom grid-add* ] bi ;
+    <irc-editor> <scroller> @bottom grid-add* ;
 
-M: irc-page graft*
+: <irc-channel-tab> ( listener client -- irc-tab )
+    <irc-tab>
+    <irc-list> [ <scroller> @right grid-add* ] dip >>listmodel
+    [ update-participants ] keep ;
+
+: <irc-server-tab> ( listener client -- irc-tab )
+    <irc-tab> ;
+
+M: irc-tab graft*
     [ listener>> ] [ client>> ] bi
     add-listener ;
 
-M: irc-page ungraft*
+M: irc-tab ungraft*
     [ listener>> ] [ client>> ] bi
     remove-listener ;
 
 : join-channel ( name ui-window -- )
     [ dup <irc-channel-listener> ] dip
-    [ <irc-page> swap ] keep
+    [ <irc-channel-tab> swap ] keep
     tabs>> add-page ;
 
 : irc-window ( ui-window -- )
@@ -142,12 +187,12 @@ M: irc-page ungraft*
 : ui-connect ( profile -- ui-window )
     <irc-client> ui-window new over >>client swap
     [ connect-irc ]
-    [ listeners>> +server-listener+ swap at <irc-pane> <scroller>
+    [ listeners>> +server-listener+ swap at over <irc-tab>
       "Server" associate <tabbed> >>tabs ] bi ;
 
 : server-open ( server port nick password channels -- )
     [ <irc-profile> ui-connect [ irc-window ] keep ] dip
-    [ over join-channel ] each ;
+    [ over join-channel ] each drop ;
 
 : main-run ( -- ) run-ircui ;