]> gitweb.factorcode.org Git - factor.git/commitdiff
irc.ui: Userlists are now sorted
authorWilliam Schlieper <schlieper@unc.edu>
Sun, 3 Aug 2008 17:21:32 +0000 (13:21 -0400)
committerWilliam Schlieper <schlieper@unc.edu>
Sun, 3 Aug 2008 17:21:32 +0000 (13:21 -0400)
extra/irc/ui/ui.factor

index d899b75d8d8116ab8776e568b75875a2105e973f..0c9fdee6e0efe18123ec864791c77e44e411a587 100755 (executable)
@@ -3,12 +3,13 @@
 \r
 USING: accessors kernel threads combinators concurrency.mailboxes\r
        sequences strings hashtables splitting fry assocs hashtables colors\r
+       sorting qualified unicode.case math.order\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.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 qualified ;\r
+       irc.ui.commandparser irc.ui.load ;\r
 \r
 RENAME: join sequences => sjoin\r
 \r
@@ -86,6 +87,12 @@ M: mode write-irc
     " to " blue write-color\r
     channel>> write ;\r
 \r
+M: nick write-irc\r
+    "* " blue write-color\r
+    [ prefix>> parse-name write ] keep\r
+    " is now known as " blue write-color\r
+    trailing>> write ;\r
+\r
 M: unhandled write-irc\r
     "UNHANDLED: " write\r
     line>> blue write-color ;\r
@@ -118,15 +125,18 @@ M: irc-message write-irc
 \r
 GENERIC: handle-inbox ( tab message -- )\r
 \r
-: filter-participants ( pack alist val color -- pack )\r
-   '[ , = [ <label> , >>color add-gadget ] [ drop ] if ] assoc-each ;\r
+: value-labels ( assoc val -- seq )\r
+    '[ nip , = ] assoc-filter keys [ >lower <=> ] sort [ <label> ] map ;\r
+\r
+: add-gadget-color ( pack seq color -- pack )\r
+    '[ , >>color add-gadget ] each ;\r
 \r
 : update-participants ( tab -- )\r
     [ userlist>> [ clear-gadget ] keep ]\r
     [ listener>> participants>> ] bi\r
-    [ +operator+ dark-green filter-participants ]\r
-    [ +voice+ blue filter-participants ]\r
-    [ +normal+ black filter-participants ] tri drop ;\r
+    [ +operator+ value-labels dark-green add-gadget-color ]\r
+    [ +voice+ value-labels blue add-gadget-color ]\r
+    [ +normal+ value-labels black add-gadget-color ] tri drop ;\r
 \r
 M: participant-changed handle-inbox\r
     drop update-participants ;\r