irc.client: Add more words, fixes, update docs.
parent
d4aae8a183
commit
33fccfe4a4
|
@ -21,13 +21,25 @@ HELP: connect-irc "Connecting to an irc server"
|
||||||
{ $description "Connects and logins " { $link irc-client } " using the settings specified on its " { $link irc-profile } "." } ;
|
{ $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"
|
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." } ;
|
{ $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"
|
HELP: terminate-irc "Terminates an irc client"
|
||||||
{ $values { "irc-client" "an irc client object" } }
|
{ $values { "irc-client" "an irc client object" } }
|
||||||
{ $description "Terminates all activity by " { $link irc-client } " cleaning up resources and notifying listeners." } ;
|
{ $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"
|
ARTICLE: "irc.client" "IRC Client"
|
||||||
"An IRC Client library"
|
"An IRC Client library"
|
||||||
{ $heading "IRC objects:" }
|
{ $heading "IRC objects:" }
|
||||||
|
@ -42,6 +54,9 @@ ARTICLE: "irc.client" "IRC Client"
|
||||||
{ $subsection connect-irc }
|
{ $subsection connect-irc }
|
||||||
{ $subsection terminate-irc }
|
{ $subsection terminate-irc }
|
||||||
{ $subsection add-listener }
|
{ $subsection add-listener }
|
||||||
|
{ $subsection remove-listener }
|
||||||
|
{ $subsection read-message }
|
||||||
|
{ $subsection write-message }
|
||||||
{ $heading "IRC messages" }
|
{ $heading "IRC messages" }
|
||||||
"Some of the RFC defined irc messages as objects:"
|
"Some of the RFC defined irc messages as objects:"
|
||||||
{ $table
|
{ $table
|
||||||
|
@ -78,11 +93,11 @@ ARTICLE: "irc.client" "IRC Client"
|
||||||
"! Create a channel listener"
|
"! Create a channel listener"
|
||||||
"\"#mychannel123\" <irc-channel-listener> mychannel set"
|
"\"#mychannel123\" <irc-channel-listener> mychannel set"
|
||||||
"! Register and start listener (this joins the channel)"
|
"! 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"
|
"! 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"
|
"! Read a message from the channel"
|
||||||
"mychannel get in-messages>> mailbox-get"
|
"mychannel get read-message"
|
||||||
}
|
}
|
||||||
;
|
;
|
||||||
|
|
||||||
|
|
|
@ -169,7 +169,8 @@ TUPLE: unhandled < irc-message ;
|
||||||
{ "KICK" [ \ kick ] }
|
{ "KICK" [ \ kick ] }
|
||||||
[ drop \ unhandled ]
|
[ drop \ unhandled ]
|
||||||
} case
|
} 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
|
! Server message handling
|
||||||
|
@ -205,6 +206,9 @@ M: join handle-incoming-irc ( join -- )
|
||||||
dup trailing>> listener>
|
dup trailing>> listener>
|
||||||
[ irc> join-messages>> ] unless* mailbox-put ;
|
[ irc> join-messages>> ] unless* mailbox-put ;
|
||||||
|
|
||||||
|
M: part handle-incoming-irc ( part -- )
|
||||||
|
dup channel>> to-listener ;
|
||||||
|
|
||||||
M: kick handle-incoming-irc ( kick -- )
|
M: kick handle-incoming-irc ( kick -- )
|
||||||
[ ] [ channel>> ] [ who>> ] tri me? [ dup unregister-listener ] when
|
[ ] [ channel>> ] [ who>> ] tri me? [ dup unregister-listener ] when
|
||||||
to-listener ;
|
to-listener ;
|
||||||
|
@ -221,6 +225,9 @@ GENERIC: handle-outgoing-irc ( obj -- )
|
||||||
M: privmsg handle-outgoing-irc ( privmsg -- )
|
M: privmsg handle-outgoing-irc ( privmsg -- )
|
||||||
[ name>> ] [ trailing>> ] bi /PRIVMSG ;
|
[ name>> ] [ trailing>> ] bi /PRIVMSG ;
|
||||||
|
|
||||||
|
M: part handle-outgoing-irc ( privmsg -- )
|
||||||
|
[ channel>> ] [ trailing>> "" or ] bi /PART ;
|
||||||
|
|
||||||
! ======================================
|
! ======================================
|
||||||
! Reader/Writer
|
! Reader/Writer
|
||||||
! ======================================
|
! ======================================
|
||||||
|
@ -300,6 +307,7 @@ DEFER: (connect-irc)
|
||||||
2bi ;
|
2bi ;
|
||||||
|
|
||||||
GENERIC: (add-listener) ( irc-listener -- )
|
GENERIC: (add-listener) ( irc-listener -- )
|
||||||
|
|
||||||
M: irc-channel-listener (add-listener) ( irc-channel-listener -- )
|
M: irc-channel-listener (add-listener) ( irc-channel-listener -- )
|
||||||
[ [ name>> ] [ password>> ] bi /JOIN ]
|
[ [ name>> ] [ password>> ] bi /JOIN ]
|
||||||
[ [ [ drop irc> join-messages>> ]
|
[ [ [ drop irc> join-messages>> ]
|
||||||
|
@ -314,19 +322,41 @@ M: irc-nick-listener (add-listener) ( irc-nick-listener -- )
|
||||||
M: irc-server-listener (add-listener) ( irc-server-listener -- )
|
M: irc-server-listener (add-listener) ( irc-server-listener -- )
|
||||||
f swap set+run-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 -- )
|
: (connect-irc) ( irc-client -- )
|
||||||
[ profile>> [ server>> ] [ port>> ] bi /CONNECT ] keep
|
[ profile>> [ server>> ] [ port>> ] bi /CONNECT ] keep
|
||||||
swap >>stream
|
swap >>stream
|
||||||
t >>is-running
|
t >>is-running
|
||||||
in-messages>> irc-connected swap mailbox-put ;
|
in-messages>> irc-connected swap mailbox-put ;
|
||||||
|
|
||||||
|
: with-irc-client ( irc-client quot -- )
|
||||||
|
>r current-irc-client r> with-variable ; inline
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
: connect-irc ( irc-client -- )
|
: connect-irc ( irc-client -- )
|
||||||
dup current-irc-client [
|
dup [
|
||||||
[ (connect-irc) ] [ profile>> nickname>> /LOGIN ] bi
|
[ (connect-irc) ] [ profile>> nickname>> /LOGIN ] bi
|
||||||
spawn-irc
|
spawn-irc
|
||||||
] with-variable ;
|
] with-irc-client ;
|
||||||
|
|
||||||
: add-listener ( irc-listener 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 ;
|
||||||
|
|
Loading…
Reference in New Issue