irc.client: Documentation and fixes

extra/irc/client/client-docs.factor

@@ -0,0 +1,89 @@
+USING: help.markup help.syntax quotations kernel ;
+IN: irc.client
+
+HELP: irc-client "IRC Client object"
+"blah" ;
+
+HELP: irc-server-listener "Listener for server messages unmanaged by other listeners"
+"blah" ;
+
+HELP: irc-channel-listener "Listener for irc channels"
+"blah" ;
+
+HELP: irc-nick-listener "Listener for irc users"
+"blah" ;
+
+HELP: irc-profile "IRC Client profile object"
+"blah" ;
+
+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 } "." } ;
+
+HELP: add-listener "Listening to irc channels/users/etc"
+{ $values { "irc-client" "an irc client object" } { "irc-listener" "an irc listener object" } }
+{ $description "Registers " { $snippet "irc-listener" } " with " { $snippet "irc-client" } " and starts listening." } ;
+
+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." } ;
+
+ARTICLE: "irc.client" "IRC Client"
+"An IRC Client library"
+{ $heading "IRC objects:" }
+{ $subsection irc-client }
+{ $heading "Listener objects:" }
+{ $subsection irc-server-listener }
+{ $subsection irc-channel-listener }
+{ $subsection irc-nick-listener }
+{ $heading "Setup objects:" }
+{ $subsection irc-profile }
+{ $heading "Words:" }
+{ $subsection connect-irc }
+{ $subsection terminate-irc }
+{ $subsection add-listener }
+{ $heading "IRC messages" }
+"Some of the RFC defined irc messages as objects:"
+{ $table
+  { { $link irc-message } "base of all irc messages" }
+  { { $link logged-in } "logged in to server" }
+  { { $link ping } "ping message" }
+  { { $link join } "channel join" }
+  { { $link part } "channel part" }
+  { { $link quit } "quit from irc" }
+  { { $link privmsg } "private message (to client or channel)" }
+  { { $link kick } "kick from channel" }
+  { { $link roomlist } "list of participants in channel" }
+  { { $link nick-in-use } "chosen nick is in use by another client" }
+  { { $link notice } "notice message" }
+  { { $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
+  { { $link irc-end } " sent when the client isn't running anymore, listeners should stop after this." }
+  { { $link irc-disconnected } " sent to notify listeners that connection was lost." }
+  { { $link irc-connected } " sent to notify listeners that a connection with the irc server was established." } }
+
+{ $heading "Example:" }
+{ $code
+  "USING: irc.client concurrency.mailboxes ;"
+  "SYMBOL: bot"
+  "SYMBOL: mychannel"
+  "! Create the profile and client objects"
+  "\"irc.freenode.org\" irc-port \"mybot123\" f <irc-profile> <irc-client> bot set"
+  "! Connect to the server"
+  "bot get connect-irc"
+  "! Create a channel listener"
+  "\"#mychannel123\" <irc-channel-listener> mychannel set"
+  "! Register and start listener (this joins the channel)"
+  "bot get mychannel get add-listener"
+  "! Send a message to the channel"
+  "\"what's up?\" mychannel get out-messages>> mailbox-put"
+  "! Read a message from the channel"
+  "mychannel get in-messages>> mailbox-get"
+}
+  ;
+
+ABOUT: "irc.client"

extra/irc/client/client.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2007 Doug Coleman, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays combinators concurrency.mailboxes fry io
+USING: arrays combinators concurrency.mailboxes fry io strings
        io.encodings.8-bit io.sockets kernel namespaces sequences
        sequences.lib splitting threads calendar classes.tuple
        classes ascii assocs accessors destructors continuations ;
@@ -18,9 +18,6 @@ SYMBOL: current-irc-client
 TUPLE: irc-profile server port nickname password ;
 C: <irc-profile> irc-profile
 
-TUPLE: irc-channel-profile name password ;
-: <irc-channel-profile> ( -- irc-channel-profile ) irc-channel-profile new ;
-
 ! "live" objects
 TUPLE: nick name channels log ;
 C: <nick> nick
@@ -55,7 +52,7 @@ UNION: irc-named-listener irc-nick-listener irc-channel-listener ;
 
 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 instantiated
+SINGLETON: irc-connected    ! sent when connection is established
 UNION: irc-broadcasted-message irc-end irc-disconnected irc-connected ;
 
 TUPLE: irc-message line prefix command parameters trailing timestamp ;
@@ -73,9 +70,9 @@ TUPLE: mode < irc-message name channel mode ;
 TUPLE: unhandled < irc-message ;
 
 : terminate-irc ( irc-client -- )
-    [ stream>> dispose ]
     [ in-messages>> irc-end swap mailbox-put ]
     [ f >>is-running drop ]
+    [ stream>> dispose ]
     tri ;
 
 <PRIVATE
@@ -227,22 +224,25 @@ M: privmsg handle-outgoing-irc ( privmsg -- )
 ! ======================================
 
 : irc-mailbox-get ( mailbox quot -- )
-    swap 5 seconds  '[ , , , mailbox-get-timeout swap call ] [ drop ] recover ;
+    swap 5 seconds
-
+    '[ , , , mailbox-get-timeout swap call ]
-: stream-readln-or-close ( stream -- str/f )
+    [ drop ] recover ; inline
-    dup stream-readln [ nip ] [ dispose f ] if* ;
 
 : handle-reader-message ( irc-message -- )
     irc> in-messages>> mailbox-put ;
 
 DEFER: (connect-irc)
-: handle-disconnect ( error -- )
+
-    drop irc>
+: (handle-disconnect) ( -- )
+    irc>
         [ in-messages>> irc-disconnected swap mailbox-put ]
-        [ reconnect-time>> sleep (connect-irc) ]
+        [ dup reconnect-time>> sleep (connect-irc) ]
         [ profile>> nickname>> /LOGIN ]
     tri ;
 
+: handle-disconnect ( error -- )
+    drop irc> is-running>> [ (handle-disconnect) ] when ;
+
 : (reader-loop) ( -- )
     irc> stream>> [
         |dispose stream-readln [
@@ -265,15 +265,22 @@ DEFER: (connect-irc)
 : in-multiplexer-loop ( -- )
     irc> in-messages>> [ handle-incoming-irc ] irc-mailbox-get ;
 
+: strings>privmsg ( name string -- privmsg )
+    privmsg new [ (>>trailing) ] keep [ (>>name) ] keep ;
+
 : maybe-annotate-with-name ( name obj -- obj )
-    dup privmsg instance? [ swap >>name ] [ nip ] if ;
+    {
+        { [ dup string? ] [ strings>privmsg ] }
+        { [ dup privmsg instance? ] [ swap >>name ] }
+    } cond ;
 
 : listener-loop ( name listener -- )
-    out-messages>> mailbox-get maybe-annotate-with-name
+    out-messages>> swap
-    irc> out-messages>> mailbox-put ;
+    '[ , swap maybe-annotate-with-name irc> out-messages>> mailbox-put ]
+    irc-mailbox-get ;
 
 : spawn-irc-loop ( quot name -- )
-    [ '[ @ irc> is-running>> ] ] dip
+    [ '[ irc> is-running>> [ @ ] when irc> is-running>> ] ] dip
     spawn-server drop ;
 
 : spawn-irc ( -- )
@@ -306,7 +313,7 @@ M: irc-server-listener (add-listener) ( irc-server-listener -- )
     f swap set+run-listener ;
 
 : (connect-irc) ( irc-client -- )
-    [ profile>> [ server>> ] keep port>> /CONNECT ] keep
+    [ profile>> [ server>> ] [ port>> ] bi /CONNECT ] keep
         swap >>stream
         t >>is-running
     in-messages>> irc-connected swap mailbox-put ;