irc.client: Add more words, fixes, update docs.

extra/irc/client/client-docs.factor

@@ -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 } "." } ;
 
 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:" }
@@ -42,6 +54,9 @@ ARTICLE: "irc.client" "IRC Client"
 { $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
@@ -78,11 +93,11 @@ ARTICLE: "irc.client" "IRC Client"
   "! 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"
 }
   ;
 

extra/irc/client/client.factor

@@ -169,7 +169,8 @@ TUPLE: unhandled < irc-message ;
         { "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
@@ -205,6 +206,9 @@ M: join handle-incoming-irc ( join -- )
     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 ;
@@ -221,6 +225,9 @@ GENERIC: handle-outgoing-irc ( obj -- )
 M: privmsg handle-outgoing-irc ( privmsg -- )
    [ name>> ] [ trailing>> ] bi /PRIVMSG ;
 
+M: part handle-outgoing-irc ( privmsg -- )
+   [ channel>> ] [ trailing>> "" or ] bi /PART ;
+
 ! ======================================
 ! Reader/Writer
 ! ======================================
@@ -300,6 +307,7 @@ DEFER: (connect-irc)
     2bi ;
 
 GENERIC: (add-listener) ( irc-listener -- )
+
 M: irc-channel-listener (add-listener) ( irc-channel-listener -- )
     [ [ name>> ] [ password>> ] bi /JOIN ]
     [ [ [ 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 -- )
     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 ;