irc.ui now has timestamps

db4
William Schlieper 2008-07-11 17:11:03 -04:00
parent 45715f52a8
commit 89cad5023c
1 changed files with 18 additions and 10 deletions

View File

@ -5,7 +5,8 @@ USING: accessors kernel threads combinators concurrency.mailboxes
sequences strings hashtables splitting fry assocs hashtables sequences strings hashtables splitting fry assocs hashtables
ui ui.gadgets.panes ui.gadgets.editors ui.gadgets.scrollers ui ui.gadgets.panes ui.gadgets.editors ui.gadgets.scrollers
ui.commands ui.gadgets.frames ui.gestures ui.gadgets.tabs ui.commands ui.gadgets.frames ui.gestures ui.gadgets.tabs
io io.styles namespaces irc.client irc.messages ; io io.styles namespaces irc.client irc.messages calendar
calendar.format ;
IN: irc.ui IN: irc.ui
@ -27,10 +28,20 @@ GENERIC: write-irc ( irc-message -- )
M: privmsg write-irc M: privmsg write-irc
"<" blue write-color "<" blue write-color
[ prefix>> prefix>nick write ] keep [ prefix>> prefix>nick write ] keep
">" blue write-color "> " blue write-color
" " write
trailing>> write ; trailing>> write ;
TUPLE: own-message message nick timestamp ;
: <own-message> ( message nick -- own-message )
now own-message boa ;
M: own-message write-irc
"<" blue write-color
[ nick>> bold font-style associate format ] keep
"> " blue write-color
message>> write ;
M: join write-irc M: join write-irc
"* " green write-color "* " green write-color
prefix>> prefix>nick write prefix>> prefix>nick write
@ -63,15 +74,12 @@ M: irc-message write-irc
drop ; ! catch all unimplemented writes, THIS WILL CHANGE drop ; ! catch all unimplemented writes, THIS WILL CHANGE
: print-irc ( irc-message -- ) : print-irc ( irc-message -- )
write-irc nl ; [ timestamp>> timestamp>hms write " " write ]
[ write-irc nl ] bi ;
: send-message ( message listener client -- ) : send-message ( message listener client -- )
"<" blue write-color [ nip profile>> nickname>> <own-message> print-irc ]
profile>> nickname>> bold font-style associate format [ drop write-message ] 3bi ;
">" blue write-color
" " write
over write nl
out-messages>> mailbox-put ;
: display ( stream listener -- ) : display ( stream listener -- )
'[ , [ [ t ] '[ , [ [ t ]