diff --git a/extra/irc/ui/commands/commands.factor b/extra/irc/ui/commands/commands.factor index 59f4526d23..ddae783f06 100755 --- a/extra/irc/ui/commands/commands.factor +++ b/extra/irc/ui/commands/commands.factor @@ -6,8 +6,15 @@ USING: accessors kernel irc.client irc.messages irc.ui namespaces ; IN: irc.ui.commands : say ( string -- ) - [ client get profile>> nickname>> print-irc ] - [ listener get write-message ] bi ; + irc-tab get + [ window>> client>> profile>> nickname>> print-irc ] + [ listener>> write-message ] 2bi ; + +: join ( string -- ) + irc-tab get window>> join-channel ; + +: query ( string -- ) + irc-tab get window>> query-nick ; : quote ( string -- ) drop ; ! THIS WILL CHANGE diff --git a/extra/irc/ui/ui.factor b/extra/irc/ui/ui.factor index a524168d54..4757e36660 100755 --- a/extra/irc/ui/ui.factor +++ b/extra/irc/ui/ui.factor @@ -19,9 +19,9 @@ SYMBOL: listener SYMBOL: client -TUPLE: ui-window client tabs ; +TUPLE: ui-window < tabbed client ; -TUPLE: irc-tab < frame listener client userlist ; +TUPLE: irc-tab < frame listener client window userlist ; : write-color ( str color -- ) foreground associate format ; @@ -161,44 +161,54 @@ M: object handle-inbox [ swap display ] 2keep ; -TUPLE: irc-editor < editor outstream listener client ; +TUPLE: irc-editor < editor outstream tab ; : ( tab pane -- tab editor ) - over irc-editor new-editor - swap listener>> >>listener swap >>outstream - over client>> >>client ; + irc-editor new-editor + swap >>outstream ; : editor-send ( irc-editor -- ) { [ outstream>> ] - [ listener>> ] - [ client>> ] + [ [ irc-tab? ] find-parent ] [ editor-string ] [ "" swap set-editor-string ] } cleave - '[ , listener set , client set , parse-message ] with-output-stream ; + '[ , irc-tab set , parse-message ] with-output-stream ; irc-editor "general" f { { T{ key-down f f "RET" } editor-send } { T{ key-down f f "ENTER" } editor-send } } define-command-map -: ( listener client -- irc-tab ) - irc-tab new-frame - swap client>> >>client swap >>listener +: new-irc-tab ( listener ui-window class -- irc-tab ) + new-frame + swap >>window + swap >>listener [ @center grid-add ] keep @bottom grid-add ; -: ( listener client -- irc-tab ) - - [ @right grid-add ] keep >>userlist ; - -: ( listener client -- irc-tab ) - ; - M: irc-tab graft* - [ listener>> ] [ client>> ] bi add-listener ; + [ listener>> ] [ window>> client>> ] bi add-listener ; M: irc-tab ungraft* - [ listener>> ] [ client>> ] bi remove-listener ; + [ listener>> ] [ window>> client>> ] bi remove-listener ; + +TUPLE: irc-channel-tab < irc-tab userlist ; + +: ( listener ui-window -- irc-tab ) + irc-tab new-irc-tab + [ @right grid-add ] keep >>userlist ; + +TUPLE: irc-server-tab < irc-tab ; + +: ( listener -- irc-tab ) + f irc-server-tab new-irc-tab ; + +M: irc-server-tab ungraft* + [ window>> client>> terminate-irc ] + [ listener>> ] [ window>> client>> ] tri remove-listener ; + +: ( listener ui-window -- irc-tab ) + irc-tab new-irc-tab ; M: irc-tab pref-dim* drop { 480 480 } ; @@ -206,19 +216,25 @@ M: irc-tab pref-dim* : join-channel ( name ui-window -- ) [ dup ] dip [ swap ] keep - tabs>> add-page ; + add-page ; + +: query-nick ( nick ui-window -- ) + [ dup ] dip + [ swap ] keep + add-page ; : irc-window ( ui-window -- ) - [ tabs>> ] + [ ] [ client>> profile>> server>> ] bi open-window ; : ui-connect ( profile -- ui-window ) - ui-window new over >>client swap - [ connect-irc ] - [ [ ] dip add-listener ] - [ listeners>> +server-listener+ swap at over - "Server" associate >>tabs ] tri ; + + { [ [ ] dip add-listener ] + [ listeners>> +server-listener+ swap at dup + "Server" associate ui-window new-tabbed [ swap (>>window) ] keep ] + [ >>client ] + [ connect-irc ] } cleave ; : server-open ( server port nick password channels -- ) [ ui-connect [ irc-window ] keep ] dip diff --git a/extra/ui/gadgets/tabs/tabs.factor b/extra/ui/gadgets/tabs/tabs.factor index 12031e5911..50e2df2e9e 100755 --- a/extra/ui/gadgets/tabs/tabs.factor +++ b/extra/ui/gadgets/tabs/tabs.factor @@ -48,8 +48,8 @@ DEFER: (del-page) : del-page ( name tabbed -- ) [ names>> index ] 2keep (del-page) ; -: ( assoc -- tabbed ) - tabbed new-frame +: new-tabbed ( assoc class -- tabbed ) + new-frame 0 >>model 1 >>fill >>toggler dup toggler>> @left grid-add @@ -59,3 +59,4 @@ DEFER: (del-page) bi dup redo-toggler ; +: ( assoc -- tabbed ) tabbed new-tabbed ;