From f190a9d8cb31c5359cc1afd7ebed331fbb988b86 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Mon, 30 Jun 2008 12:31:21 -0300 Subject: [PATCH 1/3] irc.client: Clean a bit. --- extra/irc/client/client-tests.factor | 8 ++++---- extra/irc/client/client.factor | 12 +++--------- 2 files changed, 7 insertions(+), 13 deletions(-) diff --git a/extra/irc/client/client-tests.factor b/extra/irc/client/client-tests.factor index 24a753d615..f7065664dd 100644 --- a/extra/irc/client/client-tests.factor +++ b/extra/irc/client/client-tests.factor @@ -14,7 +14,7 @@ IN: irc.client.tests swap [ 2nip 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" diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor index 5b8fbf62ee..45f2df3bdc 100644 --- a/extra/irc/client/client.factor +++ b/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 -! "live" objects -TUPLE: nick name channels log ; -C: 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 ; : ( profile -- irc-client ) - f V{ } clone V{ } clone f H{ } clone f [ latin1 ] 15 seconds irc-client boa ; @@ -182,7 +176,7 @@ TUPLE: unhandled < irc-message ; ! ====================================== : me? ( string -- ? ) - irc> nick>> name>> = ; + irc> profile>> nickname>> = ; : irc-message-origin ( irc-message -- name ) dup name>> me? [ prefix>> parse-name ] [ name>> ] if ; @@ -196,7 +190,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 ; From d4aae8a183dd11847cc1bf663065bb1c408aecde Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Mon, 30 Jun 2008 12:31:21 -0300 Subject: [PATCH 2/3] irc.client: Clean a bit. --- extra/irc/client/client-tests.factor | 8 ++++---- extra/irc/client/client.factor | 12 +++--------- 2 files changed, 7 insertions(+), 13 deletions(-) diff --git a/extra/irc/client/client-tests.factor b/extra/irc/client/client-tests.factor index 24a753d615..f7065664dd 100644 --- a/extra/irc/client/client-tests.factor +++ b/extra/irc/client/client-tests.factor @@ -14,7 +14,7 @@ IN: irc.client.tests swap [ 2nip 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" diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor index 5b8fbf62ee..45f2df3bdc 100644 --- a/extra/irc/client/client.factor +++ b/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 -! "live" objects -TUPLE: nick name channels log ; -C: 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 ; : ( profile -- irc-client ) - f V{ } clone V{ } clone f H{ } clone f [ latin1 ] 15 seconds irc-client boa ; @@ -182,7 +176,7 @@ TUPLE: unhandled < irc-message ; ! ====================================== : me? ( string -- ? ) - irc> nick>> name>> = ; + irc> profile>> nickname>> = ; : irc-message-origin ( irc-message -- name ) dup name>> me? [ prefix>> parse-name ] [ name>> ] if ; @@ -196,7 +190,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 ; From 33fccfe4a4a1ecc9f85d2bf672fe9c3b410e906a Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Tue, 8 Jul 2008 16:57:53 -0300 Subject: [PATCH 3/3] irc.client: Add more words, fixes, update docs. --- extra/irc/client/client-docs.factor | 23 ++++++++++++++--- extra/irc/client/client.factor | 38 ++++++++++++++++++++++++++--- 2 files changed, 53 insertions(+), 8 deletions(-) diff --git a/extra/irc/client/client-docs.factor b/extra/irc/client/client-docs.factor index 2a66f3a701..a675e663c3 100644 --- a/extra/irc/client/client-docs.factor +++ b/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\" 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" } ; diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor index 45f2df3bdc..0a627cca1c 100644 --- a/extra/irc/client/client.factor +++ b/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 ;