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

Merge branch 'master' of git://tiodante.com/git/factor

db4
Slava Pestov 2008-06-27 18:00:08 -05:00
parent f0ccba8645 69266e3c4d
commit 86765c8399
3 changed files with 33 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
extra/irc/client/authors.txt
View File

@ -1,2 +1,3 @@
Bruno Deferrari
Doug Coleman
Slava Pestov

20
extra/irc/client/client-tests.factor
View File

@ -1,7 +1,8 @@
USING: kernel tools.test accessors arrays sequences qualified
io.streams.string io.streams.duplex namespaces threads
calendar irc.client.private ;
calendar irc.client.private concurrency.mailboxes classes ;
EXCLUDE: irc.client => join ;
RENAME: join irc.client => join_
IN: irc.client.tests
! Utilities
@ -64,13 +65,16 @@ privmsg new
[ connect-irc ] keep 1 seconds sleep
nick>> name>> ] unit-test
! TODO: Channel join messages
! { ":factorbot!n=factorbo@some.where JOIN :#factortest"
! ":ircserver.net MODE #factortest +ns"
! ":ircserver.net 353 factorbot @ #factortest :@factorbot "
! ":ircserver.net 366 factorbot #factortest :End of /NAMES list."
! ":ircserver.net 477 factorbot #factortest :[ircserver-info] blah blah"
! } make-client dup "factorbot" set-nick
{ join_ "#factortest" } [
{ ":factorbot!n=factorbo@some.where JOIN :#factortest"
":ircserver.net MODE #factortest +ns"
":ircserver.net 353 factorbot @ #factortest :@factorbot "
":ircserver.net 366 factorbot #factortest :End of /NAMES list."
":ircserver.net 477 factorbot #factortest :[ircserver-info] blah blah"
} make-client dup "factorbot" set-nick
[ connect-irc ] keep 1 seconds sleep
join-messages>> 5 seconds mailbox-get-timeout
[ class ] [ trailing>> ] bi ] unit-test
! TODO: user join
! ":somedude!n=user@isp.net JOIN :#factortest"
! TODO: channel message

33
extra/irc/client/client.factor
View File

@ -1,8 +1,8 @@
! Copyright (C) 2007 Doug Coleman, Slava Pestov.
! Copyright (C) 2008 Bruno Deferrari, Doug Coleman, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays combinators concurrency.mailboxes fry io strings
USING: combinators concurrency.mailboxes fry io strings
io.encodings.8-bit io.sockets kernel namespaces sequences
sequences.lib splitting threads calendar classes.tuple
splitting threads calendar classes.tuple
classes ascii assocs accessors destructors continuations ;
IN: irc.client
@ -33,7 +33,6 @@ TUPLE: irc-listener in-messages out-messages ;
TUPLE: irc-server-listener < irc-listener ;
TUPLE: irc-channel-listener < irc-listener name password timeout ;
TUPLE: irc-nick-listener < irc-listener name ;
UNION: irc-named-listener irc-nick-listener irc-channel-listener ;
: <irc-listener> ( -- irc-listener ) <mailbox> <mailbox> irc-listener boa ;
@ -78,13 +77,19 @@ TUPLE: unhandled < irc-message ;
<PRIVATE
! ======================================
! Shortcuts
! Utils
! ======================================
: irc> ( -- irc-client ) current-irc-client get ;
: irc-stream> ( -- stream ) irc> stream>> ;
: irc-write ( s -- ) irc-stream> stream-write ;
: irc-print ( s -- ) irc-stream> [ stream-print ] keep stream-flush ;
: listener> ( name -- listener/f ) irc> listeners>> at ;
: unregister-listener ( name -- ) irc> listeners>> delete-at ;
: to-listener ( message name -- )
listener> [ f listener> ] unless*
[ in-messages>> mailbox-put ] [ drop ] if* ;
! ======================================
! IRC client messages
@ -188,8 +193,7 @@ TUPLE: unhandled < irc-message ;
GENERIC: handle-incoming-irc ( irc-message -- )
M: irc-message handle-incoming-irc ( irc-message -- )
f irc> listeners>> at
[ in-messages>> mailbox-put ] [ drop ] if* ;
f listener> [ in-messages>> mailbox-put ] [ drop ] if* ;
M: logged-in handle-incoming-irc ( logged-in -- )
name>> irc> nick>> (>>name) ;
@ -201,11 +205,15 @@ M: nick-in-use handle-incoming-irc ( nick-in-use -- )
name>> "_" append /NICK ;
M: privmsg handle-incoming-irc ( privmsg -- )
dup irc-message-origin irc> listeners>> [ at ] keep
'[ f , at ] unless* [ in-messages>> mailbox-put ] [ drop ] if* ;
dup irc-message-origin to-listener ;
M: join handle-incoming-irc ( join -- )
irc> join-messages>> mailbox-put ;
dup trailing>> listener>
[ irc> join-messages>> ] unless* mailbox-put ;
M: kick handle-incoming-irc ( kick -- )
[ ] [ channel>> ] [ who>> ] tri me? [ dup unregister-listener ] when
to-listener ;
M: irc-broadcasted-message handle-incoming-irc ( irc-broadcasted-message -- )
broadcast-message-to-listeners ;
@ -326,6 +334,5 @@ PRIVATE>
spawn-irc
] with-variable ;
GENERIC: add-listener ( irc-client irc-listener -- )
M: irc-listener add-listener ( irc-client irc-listener -- )
current-irc-client swap '[ , (add-listener) ] with-variable ;
: add-listener ( irc-listener irc-client -- )
current-irc-client rot '[ , (add-listener) ] with-variable ;