irc.ui: Various added features

diff --git a/extra/irc/ui/commands/commands.factor b/extra/irc/ui/commands/commands.factor
index 59f4526d23b05c712cbf81d2a86245eb0e13ca36..ddae783f06a5142ab8a41a3494aa30b78680bc30 100755 (executable)
--- 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\r
 \r
 : say ( string -- )\r
-    [ client get profile>> nickname>> <own-message> print-irc ]\r
-    [ listener get write-message ] bi ;\r
+    irc-tab get\r
+    [ window>> client>> profile>> nickname>> <own-message> print-irc ]\r
+    [ listener>> write-message ] 2bi ;\r
+\r
+: join ( string -- )\r
+    irc-tab get window>> join-channel ;\r
+\r
+: query ( string -- )\r
+    irc-tab get window>> query-nick ;\r
 \r
 : quote ( string -- )\r
     drop ; ! THIS WILL CHANGE\r

diff --git a/extra/irc/ui/ui.factor b/extra/irc/ui/ui.factor
index a524168d54111984d71dd0dc6e5f554391fbdadf..4757e366607e86f0e5bde0d9018d1036264abb4a 100755 (executable)
--- a/extra/irc/ui/ui.factor
+++ b/extra/irc/ui/ui.factor
@@ -19,9 +19,9 @@ SYMBOL: listener
 \r
 SYMBOL: client\r
 \r
-TUPLE: ui-window client tabs ;\r
+TUPLE: ui-window < tabbed client ;\r
 \r
-TUPLE: irc-tab < frame listener client userlist ;\r
+TUPLE: irc-tab < frame listener client window userlist ;\r
 \r
 : write-color ( str color -- )\r
     foreground associate format ;\r
@@ -161,44 +161,54 @@ M: object handle-inbox
     <scrolling-pane>\r
     [ <pane-stream> swap display ] 2keep ;\r
 \r
-TUPLE: irc-editor < editor outstream listener client ;\r
+TUPLE: irc-editor < editor outstream tab ;\r
 \r
 : <irc-editor> ( tab pane -- tab editor )\r
-    over irc-editor new-editor\r
-    swap listener>> >>listener swap <pane-stream> >>outstream\r
-    over client>> >>client ;\r
+    irc-editor new-editor\r
+    swap <pane-stream> >>outstream ;\r
 \r
 : editor-send ( irc-editor -- )\r
     { [ outstream>> ]\r
-      [ listener>> ]\r
-      [ client>> ]\r
+      [ [ irc-tab? ] find-parent ]\r
       [ editor-string ]\r
       [ "" swap set-editor-string ] } cleave\r
-     '[ , listener set , client set , parse-message ] with-output-stream ;\r
+     '[ , irc-tab set , parse-message ] with-output-stream ;\r
 \r
 irc-editor "general" f {\r
     { T{ key-down f f "RET" } editor-send }\r
     { T{ key-down f f "ENTER" } editor-send }\r
 } define-command-map\r
 \r
-: <irc-tab> ( listener client -- irc-tab )\r
-    irc-tab new-frame\r
-    swap client>> >>client swap >>listener\r
+: new-irc-tab ( listener ui-window class -- irc-tab )\r
+    new-frame\r
+    swap >>window\r
+    swap >>listener\r
     <irc-pane> [ <scroller> @center grid-add ] keep\r
     <irc-editor> <scroller> @bottom grid-add ;\r
 \r
-: <irc-channel-tab> ( listener client -- irc-tab )\r
-    <irc-tab>\r
+M: irc-tab graft*\r
+    [ listener>> ] [ window>> client>> ] bi add-listener ;\r
+\r
+M: irc-tab ungraft*\r
+    [ listener>> ] [ window>> client>> ] bi remove-listener ;\r
+\r
+TUPLE: irc-channel-tab < irc-tab userlist ;\r
+\r
+: <irc-channel-tab> ( listener ui-window -- irc-tab )\r
+    irc-tab new-irc-tab\r
     <pile> [ <scroller> @right grid-add ] keep >>userlist ;\r
 \r
-: <irc-server-tab> ( listener client -- irc-tab )\r
-    <irc-tab> ;\r
+TUPLE: irc-server-tab < irc-tab ;\r
 \r
-M: irc-tab graft*\r
-    [ listener>> ] [ client>> ] bi add-listener ;\r
+: <irc-server-tab> ( listener -- irc-tab )\r
+    f irc-server-tab new-irc-tab ;\r
 \r
-M: irc-tab ungraft*\r
-    [ listener>> ] [ client>> ] bi remove-listener ;\r
+M: irc-server-tab ungraft*\r
+    [ window>> client>> terminate-irc ]\r
+    [ listener>> ] [ window>> client>> ] tri remove-listener ;\r
+\r
+: <irc-nick-tab> ( listener ui-window -- irc-tab )\r
+    irc-tab new-irc-tab ;\r
 \r
 M: irc-tab pref-dim*\r
     drop { 480 480 } ;\r
@@ -206,19 +216,25 @@ M: irc-tab pref-dim*
 : join-channel ( name ui-window -- )\r
     [ dup <irc-channel-listener> ] dip\r
     [ <irc-channel-tab> swap ] keep\r
-    tabs>> add-page ;\r
+    add-page ;\r
+\r
+: query-nick ( nick ui-window -- )\r
+    [ dup <irc-nick-listener> ] dip\r
+    [ <irc-nick-tab> swap ] keep\r
+    add-page ;\r
 \r
 : irc-window ( ui-window -- )\r
-    [ tabs>> ]\r
+    [ ]\r
     [ client>> profile>> server>> ] bi\r
     open-window ;\r
 \r
 : ui-connect ( profile -- ui-window )\r
-    <irc-client> ui-window new over >>client swap\r
-    [ connect-irc ]\r
-    [ [ <irc-server-listener> ] dip add-listener ]\r
-    [ listeners>> +server-listener+ swap at over <irc-tab>\r
-      "Server" associate <tabbed> >>tabs ] tri ;\r
+    <irc-client>\r
+    { [ [ <irc-server-listener> ] dip add-listener ]\r
+      [ listeners>> +server-listener+ swap at <irc-server-tab> dup\r
+        "Server" associate ui-window new-tabbed [ swap (>>window) ] keep ]\r
+      [ >>client ]\r
+      [ connect-irc ] } cleave ;\r
 \r
 : server-open ( server port nick password channels -- )\r
     [ <irc-profile> ui-connect [ irc-window ] keep ] dip\r

diff --git a/extra/ui/gadgets/tabs/tabs.factor b/extra/ui/gadgets/tabs/tabs.factor
index 12031e5911124594b083eb3fa205d25de286fc66..50e2df2e9e3ec90696702325d026f6d672fa5af8 100755 (executable)
--- 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 -- )\r
     [ names>> index ] 2keep (del-page) ;\r
 \r
-: <tabbed> ( assoc -- tabbed )\r
-  tabbed new-frame\r
+: new-tabbed ( assoc class -- tabbed )\r
+    new-frame\r
     0 <model> >>model\r
     <pile> 1 >>fill >>toggler\r
     dup toggler>> @left grid-add\r
@@ -59,3 +59,4 @@ DEFER: (del-page)
     bi\r
     dup redo-toggler ;\r
     \r
+: <tabbed> ( assoc -- tabbed ) tabbed new-tabbed ;\r