--- /dev/null
+! Copyright (C) 2009 Bruno Deferrari
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs concurrency.mailboxes io kernel namespaces
+strings words.symbol irc.client.chats irc.messages ;
+EXCLUDE: sequences => join ;
+IN: irc.client.base
+
+SYMBOL: current-irc-client
+
+: irc> ( -- irc-client ) current-irc-client get ;
+: stream> ( -- stream ) irc> stream>> ;
+: irc-print ( s -- ) stream> [ stream-print ] [ stream-flush ] bi ;
+: irc-send ( irc-message -- ) irc> out-messages>> mailbox-put ;
+: chats> ( -- seq ) irc> chats>> values ;
+: me? ( string -- ? ) irc> nick>> = ;
+
+: with-irc ( irc-client quot: ( -- ) -- )
+ \ current-irc-client swap with-variable ; inline
+
+UNION: to-target privmsg notice ;
+UNION: to-channel join part topic kick rpl-channel-modes
+ rpl-notopic rpl-topic rpl-names rpl-names-end ;
+UNION: to-one-chat to-target to-channel mode ;
+UNION: to-many-chats nick quit ;
+UNION: to-all-chats irc-end irc-disconnected irc-connected ;
+PREDICATE: to-me < to-target target>> me? ;
+
+GENERIC: chat-name ( irc-message -- name )
+M: mode chat-name name>> ;
+M: to-target chat-name target>> ;
+M: to-me chat-name sender>> ;
+M: to-channel chat-name channel>> ;
+
+GENERIC: chat> ( obj -- chat/f )
+M: string chat> irc> chats>> at ;
+M: symbol chat> irc> chats>> at ;
+M: to-one-chat chat> chat-name +server-chat+ or chat> ;
--- /dev/null
+USING: help.markup help.syntax quotations kernel ;
+IN: irc.client.chats
+
+HELP: irc-client "IRC Client object" ;
+
+HELP: irc-server-chat "Chat for server messages unmanaged by other chats" ;
+
+HELP: irc-channel-chat "Chat for irc channels" ;
+
+HELP: irc-nick-chat "Chat for irc users" ;
+
+HELP: irc-profile "IRC Client profile object" ;
+
+HELP: irc-chat-end "Message sent to a chat when it has been detached from the client, the chat should stop after it receives this message." ;
+
+HELP: irc-end "Message sent when the client isn't running anymore, a chat should stop after it receives this message." ;
+
+HELP: irc-disconnected "Message sent to notify chats that connection was lost." ;
+
+HELP: irc-connected "Message sent to notify chats that a connection with the irc server was established." ;
--- /dev/null
+! Copyright (C) 2009 Bruno Deferrari
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors concurrency.mailboxes kernel calendar io.sockets io.encodings.8-bit
+destructors arrays sequences ;
+IN: irc.client.chats
+
+CONSTANT: irc-port 6667 ! Default irc port
+
+TUPLE: irc-chat in-messages client ;
+TUPLE: irc-server-chat < irc-chat ;
+TUPLE: irc-channel-chat < irc-chat name password participants clear-participants ;
+TUPLE: irc-nick-chat < irc-chat name ;
+SYMBOL: +server-chat+
+
+: <irc-server-chat> ( -- irc-server-chat )
+ irc-server-chat new
+ <mailbox> >>in-messages ;
+
+: <irc-channel-chat> ( name -- irc-channel-chat )
+ irc-channel-chat new
+ swap >>name
+ <mailbox> >>in-messages
+ f >>password
+ H{ } clone >>participants
+ t >>clear-participants ;
+
+: <irc-nick-chat> ( name -- irc-nick-chat )
+ irc-nick-chat new
+ swap >>name
+ <mailbox> >>in-messages ;
+
+TUPLE: irc-profile server port nickname password ;
+C: <irc-profile> irc-profile
+
+TUPLE: irc-client profile stream in-messages out-messages
+ chats is-running nick connect reconnect-time is-ready
+ exceptions ;
+
+: <irc-client> ( profile -- irc-client )
+ dup nickname>> irc-client new
+ swap >>nick
+ swap >>profile
+ <mailbox> >>in-messages
+ <mailbox> >>out-messages
+ H{ } clone >>chats
+ 15 seconds >>reconnect-time
+ V{ } clone >>exceptions
+ [ <inet> latin1 <client> ] >>connect ;
+
+SINGLETONS: irc-chat-end irc-end irc-disconnected irc-connected ;
-USING: help.markup help.syntax quotations kernel irc.messages irc.messages.base irc.messages.parser ;
+USING: help.markup help.syntax quotations kernel
+irc.messages irc.messages.base irc.messages.parser irc.client.chats ;
IN: irc.client
-HELP: irc-client "IRC Client object" ;
-
-HELP: irc-server-chat "Chat for server messages unmanaged by other chats" ;
-
-HELP: irc-channel-chat "Chat for irc channels" ;
-
-HELP: irc-nick-chat "Chat for irc users" ;
-
-HELP: irc-profile "IRC Client profile object" ;
-
HELP: connect-irc "Connecting to an irc server"
{ $values { "irc-client" "an irc client object" } }
{ $description "Connects and logins " { $link irc-client } " using the settings specified on its " { $link irc-profile } "." } ;
{ { $link mode } "mode change" }
{ { $link unhandled } "uninmplemented/unhandled message" }
}
+
{ $heading "Special messages" }
"Some special messages that are created by the library and not by the irc server."
{ $table
{ $heading "Example:" }
{ $code
- "USING: irc.client ;"
+ "USING: irc.client irc.client.chats ;"
"SYMBOL: bot"
"SYMBOL: mychannel"
"! Create the profile and client objects"
"! Register and start chat (this joins the channel)"
"mychannel get bot get attach-chat"
"! Send a message to the channel"
- "\"what's up?\" mychannel get speak"
+ "\"Hello World!\" mychannel get speak"
"! Read a message from the channel"
"mychannel get hear"
}
+++ /dev/null
-USING: kernel tools.test accessors arrays sequences
- io io.streams.duplex namespaces threads destructors
- calendar irc.client.private irc.client irc.messages
- concurrency.mailboxes classes assocs combinators irc.messages.parser ;
-EXCLUDE: irc.messages => join ;
-RENAME: join irc.messages => join_
-IN: irc.client.tests
-
-! Streams for testing
-TUPLE: mb-writer lines last-line disposed ;
-TUPLE: mb-reader lines disposed ;
-: <mb-writer> ( -- mb-writer ) V{ } clone V{ } clone f mb-writer boa ;
-: <mb-reader> ( -- mb-reader ) <mailbox> f mb-reader boa ;
-: push-line ( line test-reader-stream -- ) lines>> mailbox-put ;
-: <test-stream> ( -- stream ) <mb-reader> <mb-writer> <duplex-stream> ;
-M: mb-writer stream-write ( line mb-writer -- ) last-line>> push ;
-M: mb-writer stream-flush ( mb-writer -- ) drop ;
-M: mb-reader stream-readln ( mb-reader -- str/f ) lines>> mailbox-get ;
-M: mb-writer stream-nl ( mb-writer -- )
- [ [ last-line>> concat ] [ lines>> ] bi push ] keep
- V{ } clone >>last-line drop ;
-M: mb-reader dispose f swap push-line ;
-M: mb-writer dispose drop ;
-
-: spawn-client ( -- irc-client )
- "someserver" irc-port "factorbot" f <irc-profile>
- <irc-client>
- t >>is-ready
- t >>is-running
- <test-stream> >>stream
- dup [ spawn-irc yield ] with-irc-client ;
-
-! to be used inside with-irc-client quotations
-: %add-named-chat ( chat -- ) irc> attach-chat ;
-: %push-line ( line -- ) irc> stream>> in>> push-line yield ;
-: %join ( channel -- ) <irc-channel-chat> irc> attach-chat ;
-: %pop-output-line ( -- string ) irc> stream>> out>> lines>> pop ;
-
-: read-matching-message ( chat quot: ( msg -- ? ) -- irc-message )
- [ in-messages>> 0.1 seconds ] dip mailbox-get-timeout? ;
-
-: with-irc ( quot: ( -- ) -- )
- [ spawn-client ] dip [ irc> terminate-irc ] compose with-irc-client ; inline
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! TESTS
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-[ { t } [ irc> nick>> me? ] unit-test
-
- { "factorbot" } [ irc> nick>> ] unit-test
-
-! { "someuser" } [ "someuser!n=user@some.where" parse-name ] unit-test
-
- { "#factortest" } [ ":someuser!n=user@some.where PRIVMSG #factortest :hi"
- string>irc-message forward-name ] unit-test
-
- { "someuser" } [ ":someuser!n=user@some.where PRIVMSG factorbot :hi"
- string>irc-message forward-name ] unit-test
-] with-irc
-
-{ privmsg "#channel" "hello" } [
- "#channel" "hello" strings>privmsg
- [ class ] [ target>> ] [ trailing>> ] tri
-] unit-test
-
-! Test login and nickname set
-[ { "factorbot2" } [
- ":some.where 001 factorbot2 :Welcome factorbot2" %push-line
- irc> nick>>
- ] unit-test
-] with-irc
-
-! Test connect
-{ V{ "NICK factorbot" "USER factorbot hostname servername :irc.factor" } } [
- "someserver" irc-port "factorbot" f <irc-profile> <irc-client>
- [ 2drop <test-stream> t ] >>connect
- [ connect-irc ] [ stream>> out>> lines>> ] [ terminate-irc ] tri
-] unit-test
-
-! Test join
-[ { "JOIN #factortest" } [
- "#factortest" %join %pop-output-line
- ] unit-test
-] with-irc
-
-[ { join_ "#factortest" } [
- "#factortest" <irc-channel-chat> [ %add-named-chat ] keep
- { ":factorbot!n=factorbo@some.where JOIN :#factortest"
- ":ircserver.net 353 factorbot @ #factortest :@factorbot "
- ":ircserver.net 366 factorbot #factortest :End of /NAMES list."
- ":ircserver.net 477 factorbot #factortest :[ircserver-info] blah blah"
- } [ %push-line ] each
- in-messages>> 0.1 seconds mailbox-get-timeout
- [ class ] [ trailing>> ] bi
- ] unit-test
-] with-irc
-
-[ { T{ participant-changed f "somebody" +join+ } } [
- "#factortest" <irc-channel-chat> [ %add-named-chat ] keep
- ":somebody!n=somebody@some.where JOIN :#factortest" %push-line
- [ participant-changed? ] read-matching-message
- ] unit-test
-] with-irc
-
-[ { privmsg "#factortest" "hello" } [
- "#factortest" <irc-channel-chat> [ %add-named-chat ] keep
- ":somebody!n=somebody@some.where PRIVMSG #factortest :hello" %push-line
- [ privmsg? ] read-matching-message
- [ class ] [ target>> ] [ trailing>> ] tri
- ] unit-test
-] with-irc
-
-[ { privmsg "factorbot" "hello" } [
- "ircuser" <irc-nick-chat> [ %add-named-chat ] keep
- ":ircuser!n=user@isp.net PRIVMSG factorbot :hello" %push-line
- [ privmsg? ] read-matching-message
- [ class ] [ target>> ] [ trailing>> ] tri
- ] unit-test
-] with-irc
-
-[ { mode } [
- "#factortest" <irc-channel-chat> [ %add-named-chat ] keep
- ":ircserver.net MODE #factortest +ns" %push-line
- [ mode? ] read-matching-message class
- ] unit-test
-] with-irc
-
-! Participant lists tests
-[ { H{ { "ircuser" +normal+ } } } [
- "#factortest" <irc-channel-chat> [ %add-named-chat ] keep
- ":ircuser!n=user@isp.net JOIN :#factortest" %push-line
- participants>>
- ] unit-test
-] with-irc
-
-[ { H{ { "ircuser2" +normal+ } } } [
- "#factortest" <irc-channel-chat>
- H{ { "ircuser2" +normal+ }
- { "ircuser" +normal+ } } clone >>participants
- [ %add-named-chat ] keep
- ":ircuser!n=user@isp.net PART #factortest" %push-line
- participants>>
- ] unit-test
-] with-irc
-
-[ { H{ { "ircuser2" +normal+ } } } [
- "#factortest" <irc-channel-chat>
- H{ { "ircuser2" +normal+ }
- { "ircuser" +normal+ } } clone >>participants
- [ %add-named-chat ] keep
- ":ircuser!n=user@isp.net QUIT" %push-line
- participants>>
- ] unit-test
-] with-irc
-
-[ { H{ { "ircuser2" +normal+ } } } [
- "#factortest" <irc-channel-chat>
- H{ { "ircuser2" +normal+ }
- { "ircuser" +normal+ } } clone >>participants
- [ %add-named-chat ] keep
- ":ircuser2!n=user2@isp.net KICK #factortest ircuser" %push-line
- participants>>
- ] unit-test
-] with-irc
-
-[ { H{ { "ircuser2" +normal+ } } } [
- "#factortest" <irc-channel-chat>
- H{ { "ircuser" +normal+ } } clone >>participants
- [ %add-named-chat ] keep
- ":ircuser!n=user2@isp.net NICK :ircuser2" %push-line
- participants>>
- ] unit-test
-] with-irc
-
-[ { H{ { "factorbot" +operator+ } { "ircuser" +normal+ } } } [
- "#factortest" <irc-channel-chat>
- H{ { "ircuser" +normal+ } } clone >>participants
- [ %add-named-chat ] keep
- ":ircserver.net 353 factorbot @ #factortest :@factorbot " %push-line
- ":ircserver.net 353 factorbot @ #factortest :ircuser2 " %push-line
- ":ircserver.net 366 factorbot #factortest :End of /NAMES list." %push-line
- ":ircserver.net 353 factorbot @ #factortest :@factorbot " %push-line
- ":ircserver.net 353 factorbot @ #factortest :ircuser " %push-line
- ":ircserver.net 366 factorbot #factortest :End of /NAMES list." %push-line
- participants>>
- ] unit-test
-] with-irc
-
-! Namelist change notification
-[ { T{ participant-changed f f f f } } [
- "#factortest" <irc-channel-chat> [ %add-named-chat ] keep
- ":ircserver.net 353 factorbot @ #factortest :@factorbot " %push-line
- ":ircserver.net 366 factorbot #factortest :End of /NAMES list." %push-line
- [ participant-changed? ] read-matching-message
- ] unit-test
-] with-irc
-
-[ { T{ participant-changed f "ircuser" +part+ f } } [
- "#factortest" <irc-channel-chat>
- H{ { "ircuser" +normal+ } } clone >>participants
- [ %add-named-chat ] keep
- ":ircuser!n=user@isp.net QUIT" %push-line
- [ participant-changed? ] read-matching-message
- ] unit-test
-] with-irc
-
-[ { T{ participant-changed f "ircuser" +nick+ "ircuser2" } } [
- "#factortest" <irc-channel-chat>
- H{ { "ircuser" +normal+ } } clone >>participants
- [ %add-named-chat ] keep
- ":ircuser!n=user2@isp.net NICK :ircuser2" %push-line
- [ participant-changed? ] read-matching-message
- ] unit-test
-] with-irc
-
-! Mode change
-[ { T{ participant-changed f "ircuser" +mode+ "+o" } } [
- "#factortest" <irc-channel-chat> [ %add-named-chat ] keep
- ":ircserver.net MODE #factortest +o ircuser" %push-line
- [ participant-changed? ] read-matching-message
- ] unit-test
-] with-irc
-
-! Send privmsg
-[ { "PRIVMSG #factortest :hello" } [
- "#factortest" <irc-channel-chat> [ %add-named-chat ] keep
- "hello" swap speak %pop-output-line
- ] unit-test
-] with-irc
! Copyright (C) 2008 Bruno Deferrari, Doug Coleman, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: concurrency.mailboxes kernel io.sockets io.encodings.8-bit calendar
- accessors destructors namespaces io assocs arrays fry
- continuations threads strings classes combinators splitting hashtables
- ascii irc.messages irc.messages.base irc.messages.parser ;
-RENAME: join sequences => sjoin
-EXCLUDE: sequences => join ;
+USING: accessors concurrency.mailboxes destructors
+irc.client.base irc.client.chats irc.client.internals kernel
+namespaces sequences ;
IN: irc.client
-! ======================================
-! Setup and running objects
-! ======================================
-
-CONSTANT: irc-port 6667 ! Default irc port
-
-TUPLE: irc-profile server port nickname password ;
-C: <irc-profile> irc-profile
-
-TUPLE: irc-client profile stream in-messages out-messages
- chats is-running nick connect reconnect-time is-ready ;
-
-: <irc-client> ( profile -- irc-client )
- irc-client new
- swap >>profile
- <mailbox> >>in-messages
- <mailbox> >>out-messages
- H{ } clone >>chats
- dup profile>> nickname>> >>nick
- [ <inet> latin1 <client> ] >>connect
- 15 seconds >>reconnect-time ;
-
-TUPLE: irc-chat in-messages client ;
-TUPLE: irc-server-chat < irc-chat ;
-TUPLE: irc-channel-chat < irc-chat name password timeout participants clean-participants ;
-TUPLE: irc-nick-chat < irc-chat name ;
-SYMBOL: +server-chat+
-
-! participant modes
-SYMBOL: +operator+
-SYMBOL: +voice+
-SYMBOL: +normal+
-
-: participant-mode ( n -- mode )
- H{ { 64 +operator+ } { 43 +voice+ } { 0 +normal+ } } at ;
-
-! participant changed actions
-SYMBOL: +join+
-SYMBOL: +part+
-SYMBOL: +mode+
-SYMBOL: +nick+
-
-! chat objects
-: <irc-server-chat> ( -- irc-server-chat )
- <mailbox> f irc-server-chat boa ;
-
-: <irc-channel-chat> ( name -- irc-channel-chat )
- [ <mailbox> f ] dip f 60 seconds H{ } clone t
- irc-channel-chat boa ;
-
-: <irc-nick-chat> ( name -- irc-nick-chat )
- [ <mailbox> f ] dip irc-nick-chat boa ;
-
-! ======================================
-! Message objects
-! ======================================
-
-TUPLE: participant-changed nick action parameter ;
-C: <participant-changed> participant-changed
-
-SINGLETON: irc-chat-end ! sent to a chat to stop its execution
-SINGLETON: irc-end ! sent when the client isn't running anymore
-SINGLETON: irc-disconnected ! sent when connection is lost
-SINGLETON: irc-connected ! sent when connection is established
-
-: terminate-irc ( irc-client -- )
- dup is-running>> [
- f >>is-running
- [ stream>> dispose ] keep
- [ in-messages>> ] [ out-messages>> ] bi 2array
- [ irc-end swap mailbox-put ] each
- ] [ drop ] if ;
-
-<PRIVATE
-
-SYMBOL: current-irc-client
-
-! ======================================
-! Utils
-! ======================================
-
-: irc> ( -- irc-client ) current-irc-client get ;
-: irc-write ( s -- ) irc> stream>> stream-write ;
-: irc-print ( s -- ) irc> stream>> [ stream-print ] keep stream-flush ;
-: irc-send ( irc-message -- ) irc> out-messages>> mailbox-put ;
-: chat> ( name -- chat/f ) irc> chats>> at ;
-: channel-mode? ( mode -- ? ) name>> first "#&" member? ;
-: me? ( string -- ? ) irc> nick>> = ;
-
-GENERIC: to-chat ( message obj -- )
-
-M: string to-chat
- chat> [ +server-chat+ chat> ] unless*
- [ to-chat ] [ drop ] if* ;
-
-M: irc-chat to-chat in-messages>> mailbox-put ;
-M: sequence to-chat [ to-chat ] with each ;
-
-: unregister-chat ( name -- )
- irc> chats>>
- [ at [ irc-chat-end ] dip to-chat ]
- [ delete-at ]
- 2bi ;
-
-: (remove-participant) ( nick chat -- )
- [ participants>> delete-at ]
- [ [ +part+ f <participant-changed> ] dip to-chat ] 2bi ;
-
-: remove-participant ( nick channel -- )
- chat> [ (remove-participant) ] [ drop ] if* ;
-
-: chats-with-participant ( nick -- seq )
- irc> chats>> values
- [ dup irc-channel-chat? [ participants>> key? ] [ 2drop f ] if ]
- with filter ;
-
-: remove-participant-from-all ( nick -- )
- dup chats-with-participant [ (remove-participant) ] with each ;
-
-: notify-rename ( newnick oldnick chat -- )
- [ participant-changed new +nick+ >>action
- [ (>>nick) ] [ (>>parameter) ] [ ] tri ] dip to-chat ;
-
-: rename-participant ( newnick oldnick chat -- )
- [ participants>> [ delete-at* drop ] [ swapd set-at ] bi ]
- [ notify-rename ] 3bi ;
-
-: rename-participant-in-all ( oldnick newnick -- )
- swap dup chats-with-participant [ rename-participant ] with with each ;
-
-: add-participant ( mode nick channel -- )
- chat>
- [ participants>> set-at ]
- [ [ +join+ f <participant-changed> ] dip to-chat ] 2bi ;
-
-: change-participant-mode ( channel mode nick -- )
- rot chat>
- [ participants>> set-at ]
- [ [ participant-changed new
- [ (>>nick) ] [ (>>parameter) ] [ +mode+ >>action ] tri ] dip to-chat ]
- 3bi ; ! FIXME
-
-! ======================================
-! IRC client messages
-! ======================================
-
-: /NICK ( nick -- )
- "NICK " irc-write irc-print ;
-
-: /LOGIN ( nick -- )
- dup /NICK
- "USER " irc-write irc-write
- " hostname servername :irc.factor" irc-print ;
-
-: /CONNECT ( server port -- stream )
- irc> connect>> call( host port -- stream local ) drop ;
-
-: /JOIN ( channel password -- )
- "JOIN " irc-write [ " :" swap 3append ] when* irc-print ;
-
-: /PONG ( text -- )
- "PONG " irc-write irc-print ;
-
-! ======================================
-! Server message handling
-! ======================================
-
-GENERIC: initialize-chat ( chat -- )
-M: irc-chat initialize-chat drop ;
-M: irc-channel-chat initialize-chat [ name>> ] [ password>> ] bi /JOIN ;
-
-GENERIC: forward-name ( irc-message -- name )
-M: join forward-name trailing>> ;
-M: part forward-name channel>> ;
-M: kick forward-name channel>> ;
-M: mode forward-name name>> ;
-M: privmsg forward-name dup target>> me? [ sender>> ] [ target>> ] if ;
-
-UNION: single-forward join part kick mode privmsg ;
-UNION: multiple-forward nick quit ;
-UNION: broadcast-forward irc-end irc-disconnected irc-connected ;
-GENERIC: forward-message ( irc-message -- )
-
-M: irc-message forward-message
- +server-chat+ chat> [ to-chat ] [ drop ] if* ;
-
-M: single-forward forward-message dup forward-name to-chat ;
-
-M: multiple-forward forward-message
- dup sender>> chats-with-participant to-chat ;
-
-M: broadcast-forward forward-message
- irc> chats>> values [ to-chat ] with each ;
-
-GENERIC: process-message ( irc-message -- )
-M: object process-message drop ;
-M: rpl-welcome process-message
- nickname>> t irc> [ (>>is-ready) ] [ (>>nick) ] [ chats>> ] tri
- values [ initialize-chat ] each ;
-M: ping process-message trailing>> /PONG ;
-M: rpl-nickname-in-use process-message name>> "_" append /NICK ;
-
-M: join process-message
- [ drop +normal+ ] [ sender>> ] [ trailing>> ] tri
- dup chat> [ add-participant ] [ 3drop ] if ;
-
-M: part process-message
- [ sender>> ] [ channel>> ] bi remove-participant ;
-
-M: kick process-message
- [ [ user>> ] [ channel>> ] bi remove-participant ]
- [ dup user>> me? [ unregister-chat ] [ drop ] if ]
- bi ;
-
-M: quit process-message
- sender>> remove-participant-from-all ;
-
-M: nick process-message
- [ sender>> ] [ trailing>> ] bi rename-participant-in-all ;
-
-M: mode process-message ( mode -- )
- dup channel-mode? [
- [ name>> ] [ mode>> ] [ parameter>> ] tri
- [ change-participant-mode ] [ 2drop ] if*
- ] [ drop ] if ;
-
-: >nick/mode ( string -- nick mode )
- dup first "+@" member? [ unclip ] [ 0 ] if participant-mode ;
-
-: names-reply>participants ( names-reply -- participants )
- nicks>> [ blank? ] trim " " split
- [ >nick/mode 2array ] map >hashtable ;
-
-: maybe-clean-participants ( channel-chat -- )
- dup clean-participants>> [
- H{ } clone >>participants f >>clean-participants
- ] when drop ;
-
-M: rpl-names process-message
- [ names-reply>participants ] [ channel>> chat> ] bi [
- [ maybe-clean-participants ]
- [ participants>> 2array assoc-combine ]
- [ (>>participants) ] tri
- ] [ drop ] if* ;
-
-M: rpl-names-end process-message
- channel>> chat> [
- t >>clean-participants
- [ f f f <participant-changed> ] dip name>> to-chat
- ] when* ;
-
-! ======================================
-! Client message handling
-! ======================================
-
-GENERIC: handle-outgoing-irc ( irc-message -- ? )
-M: irc-end handle-outgoing-irc drop f ;
-M: irc-message handle-outgoing-irc irc-message>string irc-print t ;
-
-! ======================================
-! Reader/Writer
-! ======================================
-
-: handle-reader-message ( irc-message -- )
- irc> in-messages>> mailbox-put ;
-
-DEFER: (connect-irc)
-
-: (handle-disconnect) ( -- )
- irc>
- [ [ irc-disconnected ] dip in-messages>> mailbox-put ]
- [ dup reconnect-time>> sleep (connect-irc) ]
- [ nick>> /LOGIN ]
- tri ;
-
-! FIXME: do something with the exception, store somewhere to help debugging
-: handle-disconnect ( error -- ? )
- drop irc> is-running>> [ (handle-disconnect) t ] [ f ] if ;
-
-: (reader-loop) ( -- ? )
- irc> stream>> [
- |dispose stream-readln [
- string>irc-message handle-reader-message t
- ] [
- f handle-disconnect
- ] if*
- ] with-destructors ;
-
-: reader-loop ( -- ? )
- [ (reader-loop) ] [ handle-disconnect ] recover ;
-
-: writer-loop ( -- ? )
- irc> out-messages>> mailbox-get handle-outgoing-irc ;
-
-! ======================================
-! Processing loops
-! ======================================
-
-: in-multiplexer-loop ( -- ? )
- irc> in-messages>> mailbox-get
- [ forward-message ] [ process-message ] [ irc-end? not ] tri ;
-
-: strings>privmsg ( name string -- privmsg )
- " :" prepend append "PRIVMSG " prepend string>irc-message ;
-
-: maybe-annotate-with-name ( name obj -- obj )
- { { [ dup string? ] [ strings>privmsg ] }
- { [ dup privmsg instance? ] [ swap >>name ] }
- [ nip ]
- } cond ;
-
-GENERIC: annotate-message ( chat object -- object )
-M: object annotate-message nip ;
-M: part annotate-message swap name>> >>channel ;
-M: privmsg annotate-message swap name>> >>target ;
-M: string annotate-message [ name>> ] dip strings>privmsg ;
-
-: spawn-irc ( -- )
- [ reader-loop ] "irc-reader-loop" spawn-server
- [ writer-loop ] "irc-writer-loop" spawn-server
- [ in-multiplexer-loop ] "in-multiplexer-loop" spawn-server
- 3drop ;
-
-GENERIC: (attach-chat) ( irc-chat -- )
-
-M: irc-chat (attach-chat)
- [ [ irc> >>client ] [ name>> ] bi irc> chats>> set-at ]
- [ [ irc> is-ready>> ] dip and [ initialize-chat ] when* ]
- bi ;
-
-M: irc-server-chat (attach-chat)
- irc> >>client +server-chat+ irc> chats>> set-at ;
-
-GENERIC: (remove-chat) ( irc-chat -- )
-
-M: irc-nick-chat (remove-chat)
- name>> unregister-chat ;
-
-M: irc-channel-chat (remove-chat)
- [ part new annotate-message irc> out-messages>> mailbox-put ] keep
- name>> unregister-chat ;
-
-M: irc-server-chat (remove-chat)
- drop +server-chat+ unregister-chat ;
-
-: (connect-irc) ( irc-client -- )
- {
- [ profile>> [ server>> ] [ port>> ] bi /CONNECT ]
- [ (>>stream) ]
- [ t swap (>>is-running) ]
- [ in-messages>> [ irc-connected ] dip mailbox-put ]
- } cleave ;
-
-: with-irc-client ( irc-client quot: ( -- ) -- )
- [ \ current-irc-client ] dip with-variable ; inline
-
-PRIVATE>
-
: connect-irc ( irc-client -- )
- dup [ [ (connect-irc) ] [ nick>> /LOGIN ] bi spawn-irc ] with-irc-client ;
-
-: attach-chat ( irc-chat irc-client -- ) [ (attach-chat) ] with-irc-client ;
-
-: detach-chat ( irc-chat -- )
- [ client>> ] keep '[ _ (remove-chat) ] with-irc-client ;
-
-: speak ( message irc-chat -- )
- [ swap annotate-message ] [ client>> out-messages>> mailbox-put ] bi ;
+ [ (connect-irc) (do-login) spawn-irc ] with-irc ;
+: attach-chat ( irc-chat irc-client -- ) [ (attach-chat) ] with-irc ;
+: detach-chat ( irc-chat -- ) dup [ client>> remove-chat ] with-irc ;
+: speak ( message irc-chat -- ) dup client>> [ (speak) ] with-irc ;
: hear ( irc-chat -- message ) in-messages>> mailbox-get ;
+: terminate-irc ( irc-client -- ) [ (terminate-irc) ] with-irc ;
--- /dev/null
+! Copyright (C) 2009 Bruno Deferrari
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel tools.test accessors arrays sequences
+io io.streams.duplex namespaces threads destructors
+calendar concurrency.mailboxes classes assocs combinators
+irc.messages.parser irc.client.base irc.client.chats
+irc.client.participants irc.client.internals ;
+EXCLUDE: irc.messages => join ;
+RENAME: join irc.messages => join_
+IN: irc.client.internals.tests
+
+! Streams for testing
+TUPLE: mb-writer lines last-line disposed ;
+TUPLE: mb-reader lines disposed ;
+: <mb-writer> ( -- mb-writer ) V{ } clone V{ } clone f mb-writer boa ;
+: <mb-reader> ( -- mb-reader ) <mailbox> f mb-reader boa ;
+: push-line ( line test-reader-stream -- ) lines>> mailbox-put ;
+: <test-stream> ( -- stream ) <mb-reader> <mb-writer> <duplex-stream> ;
+M: mb-writer stream-write ( line mb-writer -- ) last-line>> push ;
+M: mb-writer stream-flush ( mb-writer -- ) drop ;
+M: mb-reader stream-readln ( mb-reader -- str/f ) lines>> mailbox-get ;
+M: mb-writer stream-nl ( mb-writer -- )
+ [ [ last-line>> concat ] [ lines>> ] bi push ] keep
+ V{ } clone >>last-line drop ;
+M: mb-reader dispose f swap push-line ;
+M: mb-writer dispose drop ;
+
+: spawn-client ( -- irc-client )
+ "someserver" irc-port "factorbot" f <irc-profile>
+ <irc-client>
+ t >>is-ready
+ t >>is-running
+ <test-stream> >>stream
+ dup [ spawn-irc yield ] with-irc ;
+
+! to be used inside with-irc quotations
+: %add-named-chat ( chat -- ) (attach-chat) ;
+: %push-line ( line -- ) irc> stream>> in>> push-line yield ;
+: %push-lines ( lines -- ) [ %push-line ] each ;
+: %join ( channel -- ) <irc-channel-chat> (attach-chat) ;
+: %pop-output-line ( -- string ) irc> stream>> out>> lines>> pop ;
+
+: read-matching-message ( chat quot: ( msg -- ? ) -- irc-message )
+ [ in-messages>> 0.1 seconds ] dip mailbox-get-timeout? ;
+
+: with-irc ( quot: ( -- ) -- )
+ [ spawn-client ] dip [ (terminate-irc) ] compose with-irc ; inline
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! TESTS
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+[ { t } [ irc> nick>> me? ] unit-test
+
+ { "factorbot" } [ irc> nick>> ] unit-test
+
+ { "#factortest" } [ ":someuser!n=user@some.where PRIVMSG #factortest :hi"
+ string>irc-message chat-name ] unit-test
+
+ { "someuser" } [ ":someuser!n=user@some.where PRIVMSG factorbot :hi"
+ string>irc-message chat-name ] unit-test
+] with-irc
+
+{ privmsg "#channel" "hello" } [
+ "#channel" "hello" strings>privmsg
+ [ class ] [ target>> ] [ trailing>> ] tri
+] unit-test
+
+! Test login and nickname set
+[ { "factorbot2" } [
+ ":some.where 001 factorbot2 :Welcome factorbot2" %push-line
+ irc> nick>>
+ ] unit-test
+] with-irc
+
+! Test connect
+{ V{ "NICK factorbot" "USER factorbot hostname servername :irc.factor" } } [
+ "someserver" irc-port "factorbot" f <irc-profile> <irc-client>
+ [ 2drop <test-stream> t ] >>connect
+ [
+ (connect-irc)
+ (do-login)
+ irc> stream>> out>> lines>>
+ (terminate-irc)
+ ] with-irc
+] unit-test
+
+! Test join
+[ { "JOIN #factortest" } [
+ "#factortest" %join %pop-output-line
+ ] unit-test
+] with-irc
+
+[ { join_ "#factortest"} [
+ "#factortest" <irc-channel-chat> [ %add-named-chat ] keep
+ { ":factorbot!n=factorbo@some.where JOIN :#factortest"
+ ":ircserver.net 353 factorbot @ #factortest :@factorbot "
+ ":ircserver.net 366 factorbot #factortest :End of /NAMES list."
+ ":ircserver.net 477 factorbot #factortest :[ircserver-info] blah blah"
+ } %push-lines
+ [ join? ] read-matching-message
+ [ class ] [ channel>> ] bi
+ ] unit-test
+] with-irc
+
+[ { privmsg "#factortest" "hello" } [
+ "#factortest" <irc-channel-chat> [ %add-named-chat ] keep
+ ":somebody!n=somebody@some.where PRIVMSG #factortest :hello" %push-line
+ [ privmsg? ] read-matching-message
+ [ class ] [ target>> ] [ trailing>> ] tri
+ ] unit-test
+] with-irc
+
+[ { privmsg "factorbot" "hello" } [
+ "ircuser" <irc-nick-chat> [ %add-named-chat ] keep
+ ":ircuser!n=user@isp.net PRIVMSG factorbot :hello" %push-line
+ [ privmsg? ] read-matching-message
+ [ class ] [ target>> ] [ trailing>> ] tri
+ ] unit-test
+] with-irc
+
+[ { mode "#factortest" "+ns" } [
+ "#factortest" <irc-channel-chat> [ %add-named-chat ] keep
+ ":ircserver.net MODE #factortest +ns" %push-line
+ [ mode? ] read-matching-message
+ [ class ] [ name>> ] [ mode>> ] tri
+ ] unit-test
+] with-irc
+
+! Participant lists tests
+[ { { "ircuser" } } [
+ "#factortest" <irc-channel-chat> [ %add-named-chat ] keep
+ ":ircuser!n=user@isp.net JOIN :#factortest" %push-line
+ participants>> keys
+ ] unit-test
+] with-irc
+
+[ { { "ircuser2" } } [
+ "#factortest" <irc-channel-chat>
+ { "ircuser2" "ircuser" } [ over join-participant ] each
+ [ %add-named-chat ] keep
+ ":ircuser!n=user@isp.net PART #factortest" %push-line
+ participants>> keys
+ ] unit-test
+] with-irc
+
+[ { { "ircuser2" } } [
+ "#factortest" <irc-channel-chat>
+ { "ircuser2" "ircuser" } [ over join-participant ] each
+ [ %add-named-chat ] keep
+ ":ircuser!n=user@isp.net QUIT" %push-line
+ participants>> keys
+ ] unit-test
+] with-irc
+
+[ { { "ircuser2" } } [
+ "#factortest" <irc-channel-chat>
+ { "ircuser2" "ircuser" } [ over join-participant ] each
+ [ %add-named-chat ] keep
+ ":ircuser2!n=user2@isp.net KICK #factortest ircuser" %push-line
+ participants>> keys
+ ] unit-test
+] with-irc
+
+[ { H{ { "ircuser2" T{ participant { nick "ircuser2" } } } } } [
+ "#factortest" <irc-channel-chat>
+ "ircuser" over join-participant
+ [ %add-named-chat ] keep
+ ":ircuser!n=user2@isp.net NICK :ircuser2" %push-line
+ participants>>
+ ] unit-test
+] with-irc
+
+[ { H{ { "factorbot" T{ participant { nick "factorbot" } { operator t } } }
+ { "ircuser" T{ participant { nick "ircuser" } } }
+ { "voiced" T{ participant { nick "voiced" } { voice t } } } } } [
+ "#factortest" <irc-channel-chat>
+ "ircuser" over join-participant
+ [ %add-named-chat ] keep
+ { ":ircserver.net 353 factorbot @ #factortest :@factorbot "
+ ":ircserver.net 353 factorbot @ #factortest :ircuser2 "
+ ":ircserver.net 366 factorbot #factortest :End of /NAMES list."
+ ":ircserver.net 353 factorbot @ #factortest :@factorbot +voiced "
+ ":ircserver.net 353 factorbot @ #factortest :ircuser "
+ ":ircserver.net 366 factorbot #factortest :End of /NAMES list."
+ } %push-lines
+ participants>>
+ ] unit-test
+] with-irc
+
+[ { mode "#factortest" "+o" "ircuser" } [
+ "#factortest" <irc-channel-chat> [ %add-named-chat ] keep
+ "ircuser" over join-participant
+ ":ircserver.net MODE #factortest +o ircuser" %push-line
+ [ mode? ] read-matching-message
+ { [ class ] [ name>> ] [ mode>> ] [ parameter>> ] } cleave
+ ] unit-test
+] with-irc
+
+[ { T{ participant { nick "ircuser" } { operator t } } } [
+ "#factortest" <irc-channel-chat> [ %add-named-chat ] keep
+ "ircuser" over join-participant
+ ":ircserver.net MODE #factortest +o ircuser" %push-line
+ participants>> "ircuser" swap at
+ ] unit-test
+] with-irc
+
+! Send privmsg
+[ { "PRIVMSG #factortest :hello" } [
+ "#factortest" <irc-channel-chat> [ %add-named-chat ] keep
+ "hello" swap (speak) %pop-output-line
+ ] unit-test
+] with-irc
--- /dev/null
+! Copyright (C) 2009 Bruno Deferrari
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs arrays concurrency.mailboxes continuations destructors
+hashtables io irc.client.base irc.client.chats irc.messages kernel namespaces
+strings words.symbol irc.messages.base irc.client.participants fry threads
+combinators irc.messages.parser ;
+EXCLUDE: sequences => join ;
+IN: irc.client.internals
+
+: /NICK ( nick -- ) "NICK " prepend irc-print ;
+: /PONG ( text -- ) "PONG " prepend irc-print ;
+
+: /LOGIN ( nick -- )
+ dup /NICK
+ "USER " prepend " hostname servername :irc.factor" append irc-print ;
+
+: /CONNECT ( server port -- stream )
+ irc> connect>> call( host port -- stream local ) drop ;
+
+: /JOIN ( channel password -- )
+ [ " :" swap 3append ] when* "JOIN " prepend irc-print ;
+
+: (connect-irc) ( -- )
+ irc> {
+ [ profile>> [ server>> ] [ port>> ] bi /CONNECT ]
+ [ (>>stream) ]
+ [ t swap (>>is-running) ]
+ [ in-messages>> [ irc-connected ] dip mailbox-put ]
+ } cleave ;
+
+: (do-login) ( -- ) irc> nick>> /LOGIN ;
+
+GENERIC: initialize-chat ( chat -- )
+M: irc-chat initialize-chat drop ;
+M: irc-channel-chat initialize-chat [ name>> ] [ password>> ] bi /JOIN ;
+
+GENERIC: chat-put ( message obj -- )
+M: irc-chat chat-put in-messages>> mailbox-put ;
+M: symbol chat-put chat> [ chat-put ] [ drop ] if* ;
+M: string chat-put chat> +server-chat+ or chat-put ;
+M: sequence chat-put [ chat-put ] with each ;
+
+: delete-chat ( name -- ) irc> chats>> delete-at ;
+: unregister-chat ( name -- ) [ irc-chat-end chat-put ] [ delete-chat ] bi ;
+
+! Server message handling
+
+GENERIC: forward-message ( irc-message -- )
+M: irc-message forward-message +server-chat+ chat-put ;
+M: to-one-chat forward-message dup chat> chat-put ;
+M: to-all-chats forward-message chats> chat-put ;
+M: to-many-chats forward-message dup sender>> participant-chats chat-put ;
+
+GENERIC: process-message ( irc-message -- )
+M: object process-message drop ;
+M: ping process-message trailing>> /PONG ;
+M: join process-message [ sender>> ] [ chat> ] bi join-participant ;
+M: part process-message [ sender>> ] [ chat> ] bi part-participant ;
+M: quit process-message sender>> quit-participant ;
+M: nick process-message [ trailing>> ] [ sender>> ] bi rename-participant* ;
+M: rpl-nickname-in-use process-message name>> "_" append /NICK ;
+
+M: rpl-welcome process-message
+ irc>
+ swap nickname>> >>nick
+ t >>is-ready
+ chats>> values [ initialize-chat ] each ;
+
+M: kick process-message
+ [ [ user>> ] [ chat> ] bi part-participant ]
+ [ dup user>> me? [ unregister-chat ] [ drop ] if ]
+ bi ;
+
+M: participant-mode process-message ( participant-mode -- )
+ [ mode>> ] [ name>> ] [ parameter>> ] tri change-participant-mode ;
+
+M: rpl-names process-message
+ [ nicks>> ] [ chat> ] bi dup ?clear-participants
+ '[ _ join-participant ] each ;
+
+M: rpl-names-end process-message chat> t >>clear-participants drop ;
+
+! Client message handling
+
+GENERIC: handle-outgoing-irc ( irc-message -- ? )
+M: irc-end handle-outgoing-irc drop f ;
+M: irc-message handle-outgoing-irc irc-message>string irc-print t ;
+
+! Reader/Writer
+
+: handle-reader-message ( irc-message -- ) irc> in-messages>> mailbox-put ;
+
+: (handle-disconnect) ( -- )
+ irc> in-messages>> irc-disconnected swap mailbox-put
+ irc> reconnect-time>> sleep
+ (connect-irc)
+ (do-login) ;
+
+: handle-disconnect ( error -- ? )
+ [ irc> exceptions>> push ] when*
+ irc> is-running>> [ (handle-disconnect) t ] [ f ] if ;
+
+GENERIC: handle-input ( line/f -- ? )
+M: string handle-input string>irc-message handle-reader-message t ;
+M: f handle-input handle-disconnect ;
+
+: (reader-loop) ( -- ? )
+ stream> [ |dispose stream-readln handle-input ] with-destructors ;
+
+: reader-loop ( -- ? ) [ (reader-loop) ] [ handle-disconnect ] recover ;
+: writer-loop ( -- ? ) irc> out-messages>> mailbox-get handle-outgoing-irc ;
+
+! Processing loops
+
+: in-multiplexer-loop ( -- ? )
+ irc> in-messages>> mailbox-get
+ [ process-message ] [ forward-message ] [ irc-end? not ] tri ;
+
+: strings>privmsg ( name string -- privmsg )
+ " :" prepend append "PRIVMSG " prepend string>irc-message ;
+
+GENERIC: annotate-message ( chat object -- object )
+M: object annotate-message nip ;
+M: to-channel annotate-message swap name>> >>channel ;
+M: to-target annotate-message swap name>> >>target ;
+M: mode annotate-message swap name>> >>name ;
+M: string annotate-message [ name>> ] dip strings>privmsg ;
+
+: spawn-irc ( -- )
+ [ reader-loop ] "irc-reader-loop" spawn-server
+ [ writer-loop ] "irc-writer-loop" spawn-server
+ [ in-multiplexer-loop ] "in-multiplexer-loop" spawn-server
+ 3drop ;
+
+GENERIC: (attach-chat) ( irc-chat -- )
+
+M: irc-chat (attach-chat)
+ irc>
+ [ [ chats>> ] [ >>client name>> swap ] 2bi set-at ]
+ [ is-ready>> [ initialize-chat ] [ drop ] if ]
+ 2bi ;
+
+M: irc-server-chat (attach-chat)
+ irc> [ (>>client) ] [ chats>> +server-chat+ set-at ] 2bi ;
+
+GENERIC: remove-chat ( irc-chat -- )
+M: irc-nick-chat remove-chat name>> unregister-chat ;
+M: irc-server-chat remove-chat drop +server-chat+ unregister-chat ;
+
+M: irc-channel-chat remove-chat
+ [ part new annotate-message irc-send ]
+ [ name>> unregister-chat ] bi ;
+
+: (terminate-irc) ( -- )
+ irc> dup is-running>> [
+ f >>is-running
+ [ stream>> dispose ] keep
+ [ in-messages>> ] [ out-messages>> ] bi 2array
+ [ irc-end swap mailbox-put ] each
+ ] [ drop ] if ;
+
+: (speak) ( message irc-chat -- ) swap annotate-message irc-send ;
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Bruno Deferrari
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs combinators fry hashtables
+irc.client.base irc.client.chats kernel sequences splitting ;
+IN: irc.client.participants
+
+TUPLE: participant nick operator voice ;
+: <participant> ( name -- participant )
+ {
+ { [ "@" ?head ] [ t f ] }
+ { [ "+" ?head ] [ f t ] }
+ [ f f ]
+ } cond participant boa ;
+
+GENERIC: has-participant? ( name irc-chat -- ? )
+M: irc-chat has-participant? 2drop f ;
+M: irc-channel-chat has-participant? participants>> key? ;
+
+: rename-X ( new old assoc quot: ( obj value -- obj ) -- )
+ '[ delete-at* drop swap @ ] [ nip set-at ] 3bi ; inline
+
+: rename-nick-chat ( new old -- ) irc> chats>> [ >>name ] rename-X ;
+: rename-participant ( new old chat -- ) participants>> [ >>nick ] rename-X ;
+: part-participant ( nick irc-chat -- ) participants>> delete-at ;
+: participant-chats ( nick -- seq ) chats> [ has-participant? ] with filter ;
+
+: quit-participant ( nick -- )
+ dup participant-chats [ part-participant ] with each ;
+
+: rename-participant* ( new old -- )
+ [ dup participant-chats [ rename-participant ] with with each ]
+ [ dup chat> [ rename-nick-chat ] [ 2drop ] if ]
+ 2bi ;
+
+: join-participant ( nick irc-channel-chat -- )
+ participants>> [ <participant> dup nick>> ] dip set-at ;
+
+: apply-mode ( ? participant mode -- )
+ {
+ { CHAR: o [ (>>operator) ] }
+ { CHAR: v [ (>>voice) ] }
+ [ 3drop ]
+ } case ;
+
+: apply-modes ( mode-line participant -- )
+ [ unclip CHAR: + = ] dip
+ '[ [ _ _ ] dip apply-mode ] each ;
+
+: change-participant-mode ( mode channel nick -- )
+ swap chat> participants>> at apply-modes ;
+
+: ?clear-participants ( channel-chat -- )
+ dup clear-participants>> [
+ f >>clear-participants participants>> clear-assoc
+ ] [ drop ] if ;
! Copyright (C) 2008 Bruno Deferrari
! See http://factorcode.org/license.txt for BSD license.
USING: kernel fry splitting ascii calendar accessors combinators
- arrays classes.tuple math.order words assocs strings
- irc.messages.base ;
+arrays classes.tuple math.order words assocs strings irc.messages.base ;
EXCLUDE: sequences => join ;
IN: irc.messages
IRC: quit "QUIT" : comment ;
IRC: squit "SQUIT" server : comment ;
! channel operations
-IRC: join "JOIN" channel ;
+IRC: join "JOIN" : channel ;
IRC: part "PART" channel : comment ;
IRC: topic "TOPIC" channel : topic ;
IRC: names "NAMES" channel ;
! error replies
IRC: rpl-nickname-in-use "433" _ name ;
IRC: rpl-nick-collision "436" nickname : comment ;
+
+M: rpl-names post-process-irc-message ( rpl-names -- )
+ [ [ blank? ] trim " " split ] change-nicks drop ;
+
+PREDICATE: channel-mode < mode name>> first "#&" member? ;
+PREDICATE: participant-mode < channel-mode parameter>> ;
projects / factor.git / commitdiff