\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
" 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
\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