steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

irc.ui: Userlists are now sorted

db4
William Schlieper 2008-08-03 13:21:32 -04:00
parent 710bc04b6f
commit 64bed4e44e
1 changed files with 16 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
extra/irc/ui/ui.factor
View File

@ -3,12 +3,13 @@
USING: accessors kernel threads combinators concurrency.mailboxes USING: accessors kernel threads combinators concurrency.mailboxes
sequences strings hashtables splitting fry assocs hashtables colors sequences strings hashtables splitting fry assocs hashtables colors
sorting qualified unicode.case math.order
ui ui.gadgets ui.gadgets.panes ui.gadgets.editors ui ui.gadgets ui.gadgets.panes ui.gadgets.editors
ui.gadgets.scrollers ui.commands ui.gadgets.frames ui.gestures ui.gadgets.scrollers ui.commands ui.gadgets.frames ui.gestures
ui.gadgets.tabs ui.gadgets.grids ui.gadgets.packs ui.gadgets.labels ui.gadgets.tabs ui.gadgets.grids ui.gadgets.packs ui.gadgets.labels
io io.styles namespaces calendar calendar.format models continuations io io.styles namespaces calendar calendar.format models continuations
irc.client irc.client.private irc.messages irc.messages.private irc.client irc.client.private irc.messages irc.messages.private
irc.ui.commandparser irc.ui.load qualified ; irc.ui.commandparser irc.ui.load ;
RENAME: join sequences => sjoin RENAME: join sequences => sjoin
@ -86,6 +87,12 @@ M: mode write-irc
" to " blue write-color " to " blue write-color
channel>> write ; channel>> write ;
M: nick write-irc
"* " blue write-color
[ prefix>> parse-name write ] keep
" is now known as " blue write-color
trailing>> write ;
M: unhandled write-irc M: unhandled write-irc
"UNHANDLED: " write "UNHANDLED: " write
line>> blue write-color ; line>> blue write-color ;
@ -118,15 +125,18 @@ M: irc-message write-irc
GENERIC: handle-inbox ( tab message -- ) GENERIC: handle-inbox ( tab message -- )
: filter-participants ( pack alist val color -- pack ) : value-labels ( assoc val -- seq )
'[ , = [ <label> , >>color add-gadget ] [ drop ] if ] assoc-each ; '[ nip , = ] assoc-filter keys [ >lower <=> ] sort [ <label> ] map ;
: add-gadget-color ( pack seq color -- pack )
'[ , >>color add-gadget ] each ;
: update-participants ( tab -- ) : update-participants ( tab -- )
[ userlist>> [ clear-gadget ] keep ] [ userlist>> [ clear-gadget ] keep ]
[ listener>> participants>> ] bi [ listener>> participants>> ] bi
[ +operator+ dark-green filter-participants ] [ +operator+ value-labels dark-green add-gadget-color ]
[ +voice+ blue filter-participants ] [ +voice+ value-labels blue add-gadget-color ]
[ +normal+ black filter-participants ] tri drop ; [ +normal+ value-labels black add-gadget-color ] tri drop ;
M: participant-changed handle-inbox M: participant-changed handle-inbox
drop update-participants ; drop update-participants ;