Added /commands

diff --git a/extra/irc/ui/commandparser/commandparser.factor b/extra/irc/ui/commandparser/commandparser.factor
new file mode 100755 (executable)
index 0000000..7a048c1
--- /dev/null
+++ b/extra/irc/ui/commandparser/commandparser.factor
@@ -0,0 +1,16 @@
+! Copyright (C) 2008 William Schlieper\r
+! See http://factorcode.org/license.txt for BSD license.\r
+\r
+USING: kernel vocabs.loader sequences strings irc.messages ;\r
+\r
+IN: irc.ui.commandparser\r
+\r
+"irc.ui.commands" require\r
+\r
+: command ( string -- command )\r
+    dup empty? [ drop "say" ] when\r
+    dup "irc.ui.commands" lookup\r
+    [ "quote" "irc.ui.commands" lookup ] unless* ;\r
+\r
+: parse-message ( string -- )\r
+    "/" head? [ " " split1 swap command execute ] when ;\r

diff --git a/extra/irc/ui/commands/commands.factor b/extra/irc/ui/commands/commands.factor
new file mode 100755 (executable)
index 0000000..9f062f7
--- /dev/null
+++ b/extra/irc/ui/commands/commands.factor
@@ -0,0 +1,13 @@
+! Copyright (C) 2008 William Schlieper\r
+! See http://factorcode.org/license.txt for BSD license.\r
+\r
+USING: kernel irc.client irc.messages irc.ui\r
+\r
+IN: irc.ui.commands\r
+\r
+: say ( string -- )\r
+    [ client get profile>> nickname>> <own-message> print-irc ]\r
+    [ listener get write-message ] bi ;\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 54a177f61371dcaf2787b00a630979399ebe6e1e..dba3f2255cc4e4854be9b6ff7324b9d505ac8ee5 100755 (executable)
--- a/extra/irc/ui/ui.factor
+++ b/extra/irc/ui/ui.factor
@@ -3,13 +3,17 @@
 \r
 USING: accessors kernel threads combinators concurrency.mailboxes\r
        sequences strings hashtables splitting fry assocs hashtables\r
-       ui ui.gadgets.panes ui.gadgets.editors ui.gadgets.scrollers\r
-       ui.commands ui.gadgets.frames ui.gestures ui.gadgets.tabs\r
-       io io.styles namespaces irc.client irc.messages calendar\r
-       calendar.format ;\r
+       ui ui.gadgets ui.gadgets.panes ui.gadgets.editors\r
+       ui.gadgets.scrollers ui.commands ui.gadgets.frames ui.gestures\r
+       ui.gadgets.tabs ui.gadgets.grids\r
+       io io.styles namespaces irc.client irc.client.private\r
+       irc.messages irc.messages.private irc.ui.commandparser\r
+       calendar calendar.format ;\r
 \r
 IN: irc.ui\r
 \r
+SYMBOL: listener\r
+\r
 SYMBOL: client\r
 \r
 TUPLE: ui-window client tabs ;\r
@@ -20,14 +24,15 @@ TUPLE: ui-window client tabs ;
 : green { 0 0.5 0 1 } ;\r
 : blue { 0 0 1 1 } ;\r
 \r
-: prefix>nick ( prefix -- nick )\r
-    "!" split first ;\r
+: dot-or-parens ( string -- string )\r
+    dup empty? [ drop "." ]\r
+    [ "(" prepend ")" append ] if ;\r
 \r
 GENERIC: write-irc ( irc-message -- )\r
 \r
 M: privmsg write-irc\r
     "<" blue write-color\r
-    [ prefix>> prefix>nick write ] keep\r
+    [ prefix>> parse-name write ] keep\r
     "> " blue write-color\r
     trailing>> write ;\r
 \r
@@ -44,22 +49,20 @@ M: own-message write-irc
 \r
 M: join write-irc\r
     "* " green write-color\r
-    prefix>> prefix>nick write\r
+    prefix>> parse-name write\r
     " has entered the channel." green write-color ;\r
 \r
 M: part write-irc\r
     "* " red write-color\r
-    [ prefix>> prefix>nick write ] keep\r
-    " has left the channel(" red write-color\r
-    trailing>> write\r
-    ")" red write-color ;\r
+    [ prefix>> parse-name write ] keep\r
+    " has left the channel" red write-color\r
+    trailing>> dot-or-parens red write-color ;\r
 \r
 M: quit write-irc\r
     "* " red write-color\r
-    [ prefix>> prefix>nick write ] keep\r
-    " has left IRC(" red write-color\r
-    trailing>> write\r
-    ")" red write-color ;\r
+    [ prefix>> parse-name write ] keep\r
+    " has left IRC" red write-color\r
+    trailing>> dot-or-parens red write-color ;\r
 \r
 M: irc-end write-irc\r
     drop "* You have left IRC" red write-color ;\r
@@ -77,9 +80,9 @@ M: irc-message write-irc
     [ timestamp>> timestamp>hms write " " write ]\r
     [ write-irc nl ] bi ;\r
 \r
-: send-message ( message listener client -- )\r
-    [ nip profile>> nickname>> <own-message> print-irc ]\r
-    [ drop write-message ] 3bi ;\r
+: send-message ( message -- )\r
+    [ print-irc ]\r
+    [ listener get write-message ] bi ;\r
 \r
 : display ( stream listener -- )\r
     '[ , [ [ t ]\r
@@ -95,32 +98,42 @@ TUPLE: irc-editor < editor outstream listener client ;
 : <irc-editor> ( pane listener client -- editor )\r
     [ irc-editor new-editor\r
     swap >>listener swap <pane-stream> >>outstream\r
-    ] dip client>> >>client ;\r
+    ] dip >>client ;\r
 \r
 : editor-send ( irc-editor -- )\r
     { [ outstream>> ]\r
-      [ editor-string ]\r
       [ listener>> ]\r
       [ client>> ]\r
+      [ editor-string ]\r
       [ "" swap set-editor-string ] } cleave\r
-    '[ , , , send-message ] with-output-stream ;\r
+     '[ , listener set , client 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-page ( name pane editor tabbed -- )\r
-    [ [ <scroller> @bottom frame, ! editor\r
-        <scroller> @center frame, ! pane\r
-      ] make-frame swap ] dip add-page ;\r
+TUPLE: irc-page < frame listener client ;\r
+\r
+: <irc-page> ( listener client -- irc-page )\r
+    irc-page new-frame\r
+    [ g swap client>> >>client swap [ swap (>>listener) ] keep\r
+      [ <irc-pane> [ <scroller> g @center grid-add ] keep ]\r
+      [ g client>> <irc-editor> <scroller> g @bottom grid-add ] bi\r
+      g ] with-gadget ;\r
+\r
+M: irc-page graft*\r
+    [ listener>> ] [ client>> ] bi\r
+    add-listener ;\r
+\r
+M: irc-page ungraft*\r
+    [ listener>> ] [ client>> ] bi\r
+    remove-listener ;\r
 \r
 : join-channel ( name ui-window -- )\r
     [ dup <irc-channel-listener> ] dip\r
-    [ client>> add-listener ]\r
-    [ drop <irc-pane> dup ]\r
-    [ [ <irc-editor> ] keep ] 2tri\r
-    tabs>> irc-page ;\r
+    [ <irc-page> swap ] keep\r
+    tabs>> add-page ;\r
 \r
 : irc-window ( ui-window -- )\r
     [ tabs>> ]\r