Merge branch 'master' of git://tiodante.com/git/factor

diff --git a/extra/irc/ui/ui.factor b/extra/irc/ui/ui.factor
index 9b8d1a4d11cb7c7d0a42dfc0209933ed0ce5e055..662fca6d79ed6e9ca9be73417c7953427b87c012 100755 (executable)
--- a/extra/irc/ui/ui.factor
+++ b/extra/irc/ui/ui.factor
@@ -5,10 +5,12 @@ USING: accessors kernel threads combinators concurrency.mailboxes
        sequences strings hashtables splitting fry assocs hashtables\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 ui.gadgets.lists ui.gadgets.labels\r
-       io io.styles namespaces calendar calendar.format models\r
+       ui.gadgets.tabs ui.gadgets.grids ui.gadgets.packs ui.gadgets.labels\r
+       io io.styles namespaces calendar calendar.format models continuations\r
        irc.client irc.client.private irc.messages irc.messages.private\r
-       irc.ui.commandparser irc.ui.load ;\r
+       irc.ui.commandparser irc.ui.load qualified ;\r
+\r
+RENAME: join sequences => sjoin\r
 \r
 IN: irc.ui\r
 \r
@@ -18,7 +20,7 @@ SYMBOL: client
 \r
 TUPLE: ui-window client tabs ;\r
 \r
-TUPLE: irc-tab < frame listener client listmodel ;\r
+TUPLE: irc-tab < frame listener client userlist ;\r
 \r
 : write-color ( str color -- )\r
     foreground associate format ;\r
@@ -37,12 +39,20 @@ TUPLE: irc-tab < frame listener client listmodel ;
 \r
 GENERIC: write-irc ( irc-message -- )\r
 \r
+M: ping write-irc\r
+    drop "* Ping" blue write-color ;\r
+\r
 M: privmsg write-irc\r
     "<" blue write-color\r
     [ prefix>> parse-name write ] keep\r
     "> " blue write-color\r
     trailing>> write ;\r
 \r
+M: notice write-irc\r
+    [ type>> blue write-color ] keep\r
+    ": " blue write-color\r
+    trailing>> write ;\r
+\r
 TUPLE: own-message message nick timestamp ;\r
 \r
 : <own-message> ( message nick -- own-message )\r
@@ -71,14 +81,21 @@ M: quit write-irc
     " has left IRC" red write-color\r
     trailing>> dot-or-parens red write-color ;\r
 \r
+: full-mode ( message -- mode )\r
+    parameters>> rest " " sjoin ;\r
+\r
 M: mode write-irc\r
     "* " blue write-color\r
-    [ name>> write ] keep\r
+    [ prefix>> parse-name write ] keep\r
     " has applied mode " blue write-color\r
-    [ mode>> write ] keep\r
+    [ full-mode write ] keep\r
     " to " blue write-color\r
     channel>> write ;\r
 \r
+M: unhandled write-irc\r
+    "UNHANDLED: " write\r
+    line>> blue write-color ;\r
+\r
 M: irc-end write-irc\r
     drop "* You have left IRC" red write-color ;\r
 \r
@@ -88,11 +105,17 @@ M: irc-disconnected write-irc
 M: irc-connected write-irc\r
     drop "* Connected" green write-color ;\r
 \r
+M: irc-listener-end write-irc\r
+    drop ;\r
+\r
 M: irc-message write-irc\r
     drop ; ! catch all unimplemented writes, THIS WILL CHANGE    \r
 \r
+: time-happened ( irc-message -- timestamp )\r
+    [ timestamp>> ] [ 2drop now ] recover ;\r
+\r
 : print-irc ( irc-message -- )\r
-    [ timestamp>> timestamp>hms write " " write ]\r
+    [ time-happened timestamp>hms write " " write ]\r
     [ write-irc nl ] bi ;\r
 \r
 : send-message ( message -- )\r
@@ -101,16 +124,15 @@ M: irc-message write-irc
 \r
 GENERIC: handle-inbox ( tab message -- )\r
 \r
-: filter-participants ( assoc val -- alist )\r
-    [ >alist ] dip\r
-   '[ second , = ] filter ;\r
+: filter-participants ( pack alist val color -- pack )\r
+   '[ , = [ <label> , >>color add-gadget ] [ drop ] if ] assoc-each ;\r
 \r
 : update-participants ( tab -- )\r
-    [ listmodel>> ] [ listener>> participants>> ] bi\r
-    [ +operator+ filter-participants ]\r
-    [ +voice+ filter-participants ]\r
-    [ +normal+ filter-participants ] tri\r
-    append append swap set-model ;\r
+    [ userlist>> [ clear-gadget ] keep ]\r
+    [ listener>> participants>> ] bi\r
+    [ +operator+ green filter-participants ]\r
+    [ +voice+ blue filter-participants ]\r
+    [ +normal+ black filter-participants ] tri drop ;\r
 \r
 M: participant-changed handle-inbox\r
     drop update-participants ;\r
@@ -147,11 +169,6 @@ irc-editor "general" f {
     { T{ key-down f f "ENTER" } editor-send }\r
 } define-command-map\r
 \r
-: <irc-list> ( -- gadget model )\r
-    [ drop ]\r
-    [ first2 [ <label> ] dip >>color ]\r
-    { } <model> [ <list> ] keep ;\r
-\r
 : <irc-tab> ( listener client -- irc-tab )\r
     irc-tab new-frame\r
     swap client>> >>client swap >>listener\r
@@ -160,19 +177,19 @@ irc-editor "general" f {
 \r
 : <irc-channel-tab> ( listener client -- irc-tab )\r
     <irc-tab>\r
-    <irc-list> [ <scroller> @right grid-add ] dip >>listmodel\r
-    [ update-participants ] keep ;\r
+    <pile> [ <scroller> @right grid-add ] keep >>userlist ;\r
 \r
 : <irc-server-tab> ( listener client -- irc-tab )\r
     <irc-tab> ;\r
 \r
 M: irc-tab graft*\r
-    [ listener>> ] [ client>> ] bi\r
-    add-listener ;\r
+    [ listener>> ] [ client>> ] bi add-listener ;\r
 \r
 M: irc-tab ungraft*\r
-    [ listener>> ] [ client>> ] bi\r
-    remove-listener ;\r
+    [ listener>> ] [ client>> ] bi remove-listener ;\r
+\r
+M: irc-tab pref-dim*\r
+    drop { 480 480 } ;\r
 \r
 : join-channel ( name ui-window -- )\r
     [ dup <irc-channel-listener> ] dip\r
@@ -187,8 +204,9 @@ M: irc-tab ungraft*
 : 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 ] bi ;\r
+      "Server" associate <tabbed> >>tabs ] tri ;\r
 \r
 : server-open ( server port nick password channels -- )\r
     [ <irc-profile> ui-connect [ irc-window ] keep ] dip\r