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

Merge branch 'master' of git://factorforge.org/git/william42

db4
Slava Pestov 2008-08-04 14:59:11 -05:00
parent 6b058d6bee e253fe06d4
commit c0b2691465
1 changed files with 10 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -3,7 +3,7 @@
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 sorting qualified unicode.collation 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
@ -76,6 +76,14 @@ M: quit write-irc
" has left IRC" dark-red write-color " has left IRC" dark-red write-color
trailing>> dot-or-parens dark-red write-color ; trailing>> dot-or-parens dark-red write-color ;
M: kick write-irc
"* " dark-red write-color
[ prefix>> parse-name write ] keep
" has kicked " dark-red write-color
[ who>> write ] keep
" from the channel" dark-red write-color
trailing>> dot-or-parens dark-red write-color ;
: full-mode ( message -- mode ) : full-mode ( message -- mode )
parameters>> rest " " sjoin ; parameters>> rest " " sjoin ;
@ -126,7 +134,7 @@ M: irc-message write-irc
GENERIC: handle-inbox ( tab message -- ) GENERIC: handle-inbox ( tab message -- )
: value-labels ( assoc val -- seq ) : value-labels ( assoc val -- seq )
'[ nip , = ] assoc-filter keys [ >lower <=> ] sort [ <label> ] map ; '[ nip , = ] assoc-filter keys sort-strings [ <label> ] map ;
: add-gadget-color ( pack seq color -- pack ) : add-gadget-color ( pack seq color -- pack )
'[ , >>color add-gadget ] each ; '[ , >>color add-gadget ] each ;