{ $description "Connects and logins " { $link irc-client } " using the settings specified on its " { $link irc-profile } "." } ;
HELP: add-listener "Listening to irc channels/users/etc"
-{ $values { "irc-client" "an irc client object" } { "irc-listener" "an irc listener object" } }
+{ $values { "irc-listener" "an irc listener object" } { "irc-client" "an irc client object" } }
{ $description "Registers " { $snippet "irc-listener" } " with " { $snippet "irc-client" } " and starts listening." } ;
+HELP: remove-listener "Stop an unregister listener"
+{ $values { "irc-listener" "an irc listener object" } { "irc-client" "an irc client object" } }
+{ $description "Unregisters " { $snippet "irc-listener" } " from " { $snippet "irc-client" } " and stops listening. This is how you part from a channel." } ;
+
HELP: terminate-irc "Terminates an irc client"
{ $values { "irc-client" "an irc client object" } }
{ $description "Terminates all activity by " { $link irc-client } " cleaning up resources and notifying listeners." } ;
+HELP: write-message "Sends a message through a listener"
+{ $values { "message" "a string or irc message object" } { "irc-listener" "an irc listener object" } }
+{ $description "Sends " { $snippet "message" } " through " { $snippet "irc-listener" } ". Strings are automatically promoted to privmsg objects." } ;
+
+HELP: read-message "Reads a message from a listener"
+{ $values { "irc-listener" "an irc listener object" } { "message" "an irc message object" } }
+{ $description "Reads " { $snippet "message" } " from " { $snippet "irc-listener" } "." } ;
+
ARTICLE: "irc.client" "IRC Client"
"An IRC Client library"
{ $heading "IRC objects:" }
{ $subsection connect-irc }
{ $subsection terminate-irc }
{ $subsection add-listener }
+{ $subsection remove-listener }
+{ $subsection read-message }
+{ $subsection write-message }
{ $heading "IRC messages" }
"Some of the RFC defined irc messages as objects:"
{ $table
"! Create a channel listener"
"\"#mychannel123\" <irc-channel-listener> mychannel set"
"! Register and start listener (this joins the channel)"
- "bot get mychannel get add-listener"
+ "mychannel get bot get add-listener"
"! Send a message to the channel"
- "\"what's up?\" mychannel get out-messages>> mailbox-put"
+ "\"what's up?\" mychannel get write-message"
"! Read a message from the channel"
- "mychannel get in-messages>> mailbox-get"
+ "mychannel get read-message"
}
;
swap [ 2nip <test-stream> f ] curry >>connect ;
: set-nick ( irc-client nickname -- )
- [ nick>> ] dip >>name drop ;
+ swap profile>> (>>nickname) ;
: with-dummy-client ( quot -- )
rot with-variable ; inline
parse-irc-line f >>timestamp ] unit-test
{ "" } make-client dup "factorbot" set-nick current-irc-client [
- { t } [ irc> nick>> name>> me? ] unit-test
+ { t } [ irc> profile>> nickname>> me? ] unit-test
- { "factorbot" } [ irc> nick>> name>> ] unit-test
+ { "factorbot" } [ irc> profile>> nickname>> ] unit-test
{ "someuser" } [ "someuser!n=user@some.where" parse-name ] unit-test
":some.where 001 factorbot :Welcome factorbot"
} make-client
[ connect-irc ] keep 1 seconds sleep
- nick>> name>> ] unit-test
+ profile>> nickname>> ] unit-test
{ join_ "#factortest" } [
{ ":factorbot!n=factorbo@some.where JOIN :#factortest"
: irc-port 6667 ; ! Default irc port
-! "setup" objects
TUPLE: irc-profile server port nickname password ;
C: <irc-profile> irc-profile
-! "live" objects
-TUPLE: nick name channels log ;
-C: <nick> nick
-
-TUPLE: irc-client profile nick stream in-messages out-messages join-messages
+TUPLE: irc-client profile stream in-messages out-messages join-messages
listeners is-running connect reconnect-time ;
: <irc-client> ( profile -- irc-client )
- f V{ } clone V{ } clone <nick>
f <mailbox> <mailbox> <mailbox> H{ } clone f
[ <inet> latin1 <client> ] 15 seconds irc-client boa ;
{ "KICK" [ \ kick ] }
[ drop \ unhandled ]
} case
- [ [ tuple-slots ] [ parameters>> ] bi append ] dip prefix >tuple ;
+ [ [ tuple-slots ] [ parameters>> ] bi append ] dip
+ [ all-slots length head ] keep slots>tuple ;
! ======================================
! Server message handling
! ======================================
: me? ( string -- ? )
- irc> nick>> name>> = ;
+ irc> profile>> nickname>> = ;
: irc-message-origin ( irc-message -- name )
dup name>> me? [ prefix>> parse-name ] [ name>> ] if ;
f listener> [ in-messages>> mailbox-put ] [ drop ] if* ;
M: logged-in handle-incoming-irc ( logged-in -- )
- name>> irc> nick>> (>>name) ;
+ name>> irc> profile>> (>>nickname) ;
M: ping handle-incoming-irc ( ping -- )
trailing>> /PONG ;
dup trailing>> listener>
[ irc> join-messages>> ] unless* mailbox-put ;
+M: part handle-incoming-irc ( part -- )
+ dup channel>> to-listener ;
+
M: kick handle-incoming-irc ( kick -- )
[ ] [ channel>> ] [ who>> ] tri me? [ dup unregister-listener ] when
to-listener ;
M: privmsg handle-outgoing-irc ( privmsg -- )
[ name>> ] [ trailing>> ] bi /PRIVMSG ;
+M: part handle-outgoing-irc ( privmsg -- )
+ [ channel>> ] [ trailing>> "" or ] bi /PART ;
+
! ======================================
! Reader/Writer
! ======================================
2bi ;
GENERIC: (add-listener) ( irc-listener -- )
+
M: irc-channel-listener (add-listener) ( irc-channel-listener -- )
[ [ name>> ] [ password>> ] bi /JOIN ]
[ [ [ drop irc> join-messages>> ]
M: irc-server-listener (add-listener) ( irc-server-listener -- )
f swap set+run-listener ;
+GENERIC: (remove-listener) ( irc-listener -- )
+
+M: irc-nick-listener (remove-listener) ( irc-nick-listener -- )
+ name>> unregister-listener ;
+
+M: irc-channel-listener (remove-listener) ( irc-channel-listener -- )
+ [ [ out-messages>> ] [ name>> ] bi
+ \ part new swap >>channel mailbox-put ] keep
+ name>> unregister-listener ;
+
+M: irc-server-listener (remove-listener) ( irc-server-listener -- )
+ drop f unregister-listener ;
+
: (connect-irc) ( irc-client -- )
[ profile>> [ server>> ] [ port>> ] bi /CONNECT ] keep
swap >>stream
t >>is-running
in-messages>> irc-connected swap mailbox-put ;
+: with-irc-client ( irc-client quot -- )
+ >r current-irc-client r> with-variable ; inline
+
PRIVATE>
: connect-irc ( irc-client -- )
- dup current-irc-client [
+ dup [
[ (connect-irc) ] [ profile>> nickname>> /LOGIN ] bi
spawn-irc
- ] with-variable ;
+ ] with-irc-client ;
: add-listener ( irc-listener irc-client -- )
- current-irc-client rot '[ , (add-listener) ] with-variable ;
+ swap '[ , (add-listener) ] with-irc-client ;
+
+: remove-listener ( irc-listener irc-client -- )
+ swap '[ , (remove-listener) ] with-irc-client ;
+
+: write-message ( message irc-listener -- ) out-messages>> mailbox-put ;
+: read-message ( irc-listener -- message ) in-messages>> mailbox-get ;