Merge branch 'master' of git://tiodante.com/git/factor

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-tests.factor

@@ -14,7 +14,7 @@ IN: irc.client.tests
    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
@@ -42,9 +42,9 @@ privmsg new
   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
 
@@ -63,7 +63,7 @@ privmsg new
                     ":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"

extra/irc/client/client.factor

@@ -14,18 +14,12 @@ SYMBOL: current-irc-client
 
 : irc-port 6667 ; ! Default irc port
 
-! "setup" objects
 TUPLE: irc-profile server port nickname password ;
 C: <irc-profile> irc-profile
 
-! "live" objects
+TUPLE: irc-client profile stream in-messages out-messages join-messages
-TUPLE: nick name channels log ;
-C: <nick> nick
-
-TUPLE: irc-client profile nick 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 ;
 
@@ -175,14 +169,15 @@ 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
 ! ======================================
 
 : me? ( string -- ? )
-    irc> nick>> name>> = ;
+    irc> profile>> nickname>> = ;
 
 : irc-message-origin ( irc-message -- name )
     dup name>> me? [ prefix>> parse-name ] [ name>> ] if ;
@@ -196,7 +191,7 @@ M: irc-message handle-incoming-irc ( irc-message -- )
     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 ;
@@ -211,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 ;
@@ -227,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
 ! ======================================
@@ -306,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>> ]
@@ -320,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 ;