From f936f5f54f90cfe042c5035fa71bfe8ef28428c7 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Wed, 3 Sep 2008 23:56:58 -0300 Subject: [PATCH 01/10] irc.messages: use >tuple --- Makefile | 2 +- extra/irc/messages/messages.factor | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/Makefile b/Makefile index 769aeacb8c..8831ed9c7e 100755 --- a/Makefile +++ b/Makefile @@ -13,7 +13,7 @@ CFLAGS = -Wall ifdef DEBUG CFLAGS += -g else - CFLAGS += -O3 $(SITE_CFLAGS) + CFLAGS += -O3 -fno-forward-propagate $(SITE_CFLAGS) endif ifdef CONFIG diff --git a/extra/irc/messages/messages.factor b/extra/irc/messages/messages.factor index d3eca92f15..e68cf12d2d 100755 --- a/extra/irc/messages/messages.factor +++ b/extra/irc/messages/messages.factor @@ -127,4 +127,4 @@ M: sender-in-prefix irc-message-sender ( sender-in-prefix -- sender ) } case [ [ tuple-slots ] [ parameters>> ] bi append ] dip [ all-slots over [ length ] bi@ min head >quotation ] keep - '[ @ , boa ] call ; + prefix >tuple ; From 7f588bbb8481a51eb6629032395798c4ace45702 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Thu, 4 Sep 2008 01:28:37 -0300 Subject: [PATCH 02/10] irc.messages: oops --- extra/irc/messages/messages.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/irc/messages/messages.factor b/extra/irc/messages/messages.factor index e68cf12d2d..3a9654dd6f 100755 --- a/extra/irc/messages/messages.factor +++ b/extra/irc/messages/messages.factor @@ -126,5 +126,5 @@ M: sender-in-prefix irc-message-sender ( sender-in-prefix -- sender ) [ drop unhandled ] } case [ [ tuple-slots ] [ parameters>> ] bi append ] dip - [ all-slots over [ length ] bi@ min head >quotation ] keep + [ all-slots over [ length ] bi@ min head ] keep prefix >tuple ; From b610e0776992fe5c49193ec59ee2fdc1cacd6bf7 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Fri, 5 Sep 2008 02:16:38 -0300 Subject: [PATCH 03/10] irc.messages: Change the way messages are built when parsed --- extra/irc/messages/messages.factor | 103 +++++++++++++++++------------ 1 file changed, 62 insertions(+), 41 deletions(-) diff --git a/extra/irc/messages/messages.factor b/extra/irc/messages/messages.factor index 3a9654dd6f..981844f187 100755 --- a/extra/irc/messages/messages.factor +++ b/extra/irc/messages/messages.factor @@ -19,7 +19,7 @@ TUPLE: roomlist < irc-message channel names ; TUPLE: nick-in-use < irc-message asterisk name ; TUPLE: notice < irc-message type ; TUPLE: mode < irc-message channel mode ; -TUPLE: names-reply < irc-message who = channel ; +TUPLE: names-reply < irc-message who channel ; TUPLE: unhandled < irc-message ; : ( command parameters trailing -- irc-message ) @@ -28,41 +28,55 @@ TUPLE: unhandled < irc-message ; > ( irc-message -- string ) -M: irc-message irc-command-string ( irc-message -- string ) command>> ; -M: ping irc-command-string ( ping -- string ) drop "PING" ; -M: join irc-command-string ( join -- string ) drop "JOIN" ; -M: part irc-command-string ( part -- string ) drop "PART" ; -M: quit irc-command-string ( quit -- string ) drop "QUIT" ; -M: nick irc-command-string ( nick -- string ) drop "NICK" ; -M: privmsg irc-command-string ( privmsg -- string ) drop "PRIVMSG" ; -M: notice irc-command-string ( notice -- string ) drop "NOTICE" ; -M: mode irc-command-string ( mode -- string ) drop "MODE" ; -M: kick irc-command-string ( kick -- string ) drop "KICK" ; +M: irc-message command-string>> ( irc-message -- string ) command>> ; +M: ping command-string>> ( ping -- string ) drop "PING" ; +M: join command-string>> ( join -- string ) drop "JOIN" ; +M: part command-string>> ( part -- string ) drop "PART" ; +M: quit command-string>> ( quit -- string ) drop "QUIT" ; +M: nick command-string>> ( nick -- string ) drop "NICK" ; +M: privmsg command-string>> ( privmsg -- string ) drop "PRIVMSG" ; +M: notice command-string>> ( notice -- string ) drop "NOTICE" ; +M: mode command-string>> ( mode -- string ) drop "MODE" ; +M: kick command-string>> ( kick -- string ) drop "KICK" ; -GENERIC: irc-command-parameters ( irc-message -- seq ) +GENERIC: command-parameters>> ( irc-message -- seq ) -M: irc-message irc-command-parameters ( irc-message -- seq ) parameters>> ; -M: ping irc-command-parameters ( ping -- seq ) drop { } ; -M: join irc-command-parameters ( join -- seq ) drop { } ; -M: part irc-command-parameters ( part -- seq ) channel>> 1array ; -M: quit irc-command-parameters ( quit -- seq ) drop { } ; -M: nick irc-command-parameters ( nick -- seq ) drop { } ; -M: privmsg irc-command-parameters ( privmsg -- seq ) name>> 1array ; -M: notice irc-command-parameters ( norice -- seq ) type>> 1array ; -M: kick irc-command-parameters ( kick -- seq ) +M: irc-message command-parameters>> ( irc-message -- seq ) parameters>> ; +M: ping command-parameters>> ( ping -- seq ) drop { } ; +M: join command-parameters>> ( join -- seq ) drop { } ; +M: part command-parameters>> ( part -- seq ) channel>> 1array ; +M: quit command-parameters>> ( quit -- seq ) drop { } ; +M: nick command-parameters>> ( nick -- seq ) drop { } ; +M: privmsg command-parameters>> ( privmsg -- seq ) name>> 1array ; +M: notice command-parameters>> ( norice -- seq ) type>> 1array ; +M: kick command-parameters>> ( kick -- seq ) [ channel>> ] [ who>> ] bi 2array ; -M: mode irc-command-parameters ( mode -- seq ) +M: mode command-parameters>> ( mode -- seq ) [ name>> ] [ channel>> ] [ mode>> ] tri 3array ; +GENERIC: (>>command-parameters) ( params irc-message -- ) + +M: irc-message (>>command-parameters) ( params irc-message -- ) 2drop ; +M: logged-in (>>command-parameters) ( params part -- ) >r first r> (>>name) ; +M: part (>>command-parameters) ( params part -- ) >r first r> (>>channel) ; +M: privmsg (>>command-parameters) ( params privmsg -- ) >r first r> (>>name) ; +M: notice (>>command-parameters) ( params notice -- ) >r first r> (>>type) ; +M: kick (>>command-parameters) ( params kick -- ) + >r first2 r> [ (>>who) ] [ (>>channel) ] bi ; +M: mode (>>command-parameters) ( params mode -- ) + >r first2 r> [ (>>mode) ] [ (>>channel) ] bi ; ! FIXME +M: names-reply (>>command-parameters) ( params names-reply -- ) + [ >r first r> (>>who) ] [ >r third r> (>>channel) ] 2bi ; + PRIVATE> GENERIC: irc-message>client-line ( irc-message -- string ) M: irc-message irc-message>client-line ( irc-message -- string ) - [ irc-command-string ] - [ irc-command-parameters " " sjoin ] + [ command-string>> ] + [ command-parameters>> " " sjoin ] [ trailing>> [ CHAR: : prefix ] [ "" ] if* ] tri 3array " " sjoin ; @@ -96,6 +110,15 @@ M: irc-message irc-message>server-line ( irc-message -- string ) : split-trailing ( string -- string string/f ) ":" split1 ; +: copy-contents ( origin dest -- ) + { [ >r parameters>> r> [ (>>command-parameters) ] [ (>>parameters) ] 2bi ] + [ >r line>> r> (>>line) ] + [ >r prefix>> r> (>>prefix) ] + [ >r command>> r> (>>command) ] + [ >r trailing>> r> (>>trailing) ] + [ >r timestamp>> r> (>>timestamp) ] + } 2cleave ; + PRIVATE> UNION: sender-in-prefix privmsg join part quit kick mode nick ; @@ -111,20 +134,18 @@ M: sender-in-prefix irc-message-sender ( sender-in-prefix -- sender ) : parse-irc-line ( string -- message ) string>irc-message dup command>> { - { "PING" [ ping ] } - { "NOTICE" [ notice ] } - { "001" [ logged-in ] } - { "433" [ nick-in-use ] } - { "353" [ names-reply ] } - { "JOIN" [ join ] } - { "PART" [ part ] } - { "NICK" [ nick ] } - { "PRIVMSG" [ privmsg ] } - { "QUIT" [ quit ] } - { "MODE" [ mode ] } - { "KICK" [ kick ] } - [ drop unhandled ] + { "PING" [ ping new ] } + { "NOTICE" [ notice new ] } + { "001" [ logged-in new ] } + { "433" [ nick-in-use new ] } + { "353" [ names-reply new ] } + { "JOIN" [ join new ] } + { "PART" [ part new ] } + { "NICK" [ nick new ] } + { "PRIVMSG" [ privmsg new ] } + { "QUIT" [ quit new ] } + { "MODE" [ mode new ] } + { "KICK" [ kick new ] } + [ drop unhandled new ] } case - [ [ tuple-slots ] [ parameters>> ] bi append ] dip - [ all-slots over [ length ] bi@ min head ] keep - prefix >tuple ; + [ copy-contents ] keep ; From db1d988988a96a08bc68daff3f5d8aaf34739811 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Fri, 5 Sep 2008 02:19:30 -0300 Subject: [PATCH 04/10] Makefile: oops, revert --- Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 8831ed9c7e..769aeacb8c 100755 --- a/Makefile +++ b/Makefile @@ -13,7 +13,7 @@ CFLAGS = -Wall ifdef DEBUG CFLAGS += -g else - CFLAGS += -O3 -fno-forward-propagate $(SITE_CFLAGS) + CFLAGS += -O3 $(SITE_CFLAGS) endif ifdef CONFIG From 50e5ffa594284d9eb4402627786bea26acc0a32b Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Sat, 6 Sep 2008 18:39:00 -0300 Subject: [PATCH 05/10] irc.messages: Handle mode messages better, tests --- extra/irc/messages/messages-tests.factor | 90 ++++++++++++++---------- extra/irc/messages/messages.factor | 48 ++++++++----- 2 files changed, 82 insertions(+), 56 deletions(-) diff --git a/extra/irc/messages/messages-tests.factor b/extra/irc/messages/messages-tests.factor index 20f4f1b277..ca8a4b1f50 100644 --- a/extra/irc/messages/messages-tests.factor +++ b/extra/irc/messages/messages-tests.factor @@ -6,54 +6,70 @@ IN: irc.messages.tests { "someuser" } [ "someuser!n=user@some.where" parse-name ] unit-test -irc-message new - ":someuser!n=user@some.where PRIVMSG #factortest :hi" >>line - "someuser!n=user@some.where" >>prefix - "PRIVMSG" >>command - { "#factortest" } >>parameters - "hi" >>trailing -1array +{ T{ irc-message + { line ":someuser!n=user@some.where PRIVMSG #factortest :hi" } + { prefix "someuser!n=user@some.where" } + { command "PRIVMSG" } + { parameters { "#factortest" } } + { trailing "hi" } } } [ ":someuser!n=user@some.where PRIVMSG #factortest :hi" string>irc-message f >>timestamp ] unit-test -privmsg new - ":someuser!n=user@some.where PRIVMSG #factortest :hi" >>line - "someuser!n=user@some.where" >>prefix - "PRIVMSG" >>command - { "#factortest" } >>parameters - "hi" >>trailing - "#factortest" >>name -1array +{ T{ privmsg + { line ":someuser!n=user@some.where PRIVMSG #factortest :hi" } + { prefix "someuser!n=user@some.where" } + { command "PRIVMSG" } + { parameters { "#factortest" } } + { trailing "hi" } + { name "#factortest" } } } [ ":someuser!n=user@some.where PRIVMSG #factortest :hi" parse-irc-line f >>timestamp ] unit-test -join new - ":someuser!n=user@some.where JOIN :#factortest" >>line - "someuser!n=user@some.where" >>prefix - "JOIN" >>command - { } >>parameters - "#factortest" >>trailing -1array +{ T{ join + { line ":someuser!n=user@some.where JOIN :#factortest" } + { prefix "someuser!n=user@some.where" } + { command "JOIN" } + { parameters { } } + { trailing "#factortest" } } } [ ":someuser!n=user@some.where JOIN :#factortest" parse-irc-line f >>timestamp ] unit-test -mode new - ":ircserver.net MODE #factortest +ns" >>line - "ircserver.net" >>prefix - "MODE" >>command - { "#factortest" "+ns" } >>parameters - "#factortest" >>channel - "+ns" >>mode -1array +{ T{ mode + { line ":ircserver.net MODE #factortest +ns" } + { prefix "ircserver.net" } + { command "MODE" } + { parameters { "#factortest" "+ns" } } + { channel "#factortest" } + { mode "+ns" } } } [ ":ircserver.net MODE #factortest +ns" parse-irc-line f >>timestamp ] unit-test -nick new - ":someuser!n=user@some.where NICK :someuser2" >>line - "someuser!n=user@some.where" >>prefix - "NICK" >>command - { } >>parameters - "someuser2" >>trailing -1array +{ T{ mode + { line ":ircserver.net MODE #factortest +o someuser" } + { prefix "ircserver.net" } + { command "MODE" } + { parameters { "#factortest" "+o" "someuser" } } + { channel "#factortest" } + { mode "+o" } + { parameter "someuser" } } } +[ ":ircserver.net MODE #factortest +o someuser" + parse-irc-line f >>timestamp ] unit-test + +{ T{ mode + { line ":ircserver.net MODE someuser +i" } + { prefix "ircserver.net" } + { command "MODE" } + { parameters { "someuser" "+i" } } + { nickname "someuser" } + { mode "+i" } } } +[ ":ircserver.net MODE someuser +i" + parse-irc-line f >>timestamp ] unit-test + +{ T{ nick + { line ":someuser!n=user@some.where NICK :someuser2" } + { prefix "someuser!n=user@some.where" } + { command "NICK" } + { parameters { } } + { trailing "someuser2" } } } [ ":someuser!n=user@some.where NICK :someuser2" parse-irc-line f >>timestamp ] unit-test \ No newline at end of file diff --git a/extra/irc/messages/messages.factor b/extra/irc/messages/messages.factor index 981844f187..6159c3d97d 100755 --- a/extra/irc/messages/messages.factor +++ b/extra/irc/messages/messages.factor @@ -18,7 +18,7 @@ TUPLE: kick < irc-message channel who ; TUPLE: roomlist < irc-message channel names ; TUPLE: nick-in-use < irc-message asterisk name ; TUPLE: notice < irc-message type ; -TUPLE: mode < irc-message channel mode ; +TUPLE: mode < irc-message channel mode nickname parameter ; TUPLE: names-reply < irc-message who channel ; TUPLE: unhandled < irc-message ; @@ -28,6 +28,9 @@ TUPLE: unhandled < irc-message ; > ( irc-message -- string ) M: irc-message command-string>> ( irc-message -- string ) command>> ; @@ -65,10 +68,18 @@ M: privmsg (>>command-parameters) ( params privmsg -- ) >r first r> (>>name) ; M: notice (>>command-parameters) ( params notice -- ) >r first r> (>>type) ; M: kick (>>command-parameters) ( params kick -- ) >r first2 r> [ (>>who) ] [ (>>channel) ] bi ; -M: mode (>>command-parameters) ( params mode -- ) - >r first2 r> [ (>>mode) ] [ (>>channel) ] bi ; ! FIXME M: names-reply (>>command-parameters) ( params names-reply -- ) [ >r first r> (>>who) ] [ >r third r> (>>channel) ] 2bi ; +M: mode (>>command-parameters) ( params mode -- ) + over first channel? [ + over length 3 = [ + >r first3 r> [ (>>parameter) ] [ (>>mode) ] [ (>>channel) ] tri + ] [ + >r first2 r> [ (>>mode) ] [ (>>channel) ] bi + ] if + ] [ + >r first2 r> [ (>>mode) ] [ (>>nickname) ] bi + ] if ; PRIVATE> @@ -110,7 +121,7 @@ M: irc-message irc-message>server-line ( irc-message -- string ) : split-trailing ( string -- string string/f ) ":" split1 ; -: copy-contents ( origin dest -- ) +: copy-message-in ( origin dest -- ) { [ >r parameters>> r> [ (>>command-parameters) ] [ (>>parameters) ] 2bi ] [ >r line>> r> (>>line) ] [ >r prefix>> r> (>>prefix) ] @@ -134,18 +145,17 @@ M: sender-in-prefix irc-message-sender ( sender-in-prefix -- sender ) : parse-irc-line ( string -- message ) string>irc-message dup command>> { - { "PING" [ ping new ] } - { "NOTICE" [ notice new ] } - { "001" [ logged-in new ] } - { "433" [ nick-in-use new ] } - { "353" [ names-reply new ] } - { "JOIN" [ join new ] } - { "PART" [ part new ] } - { "NICK" [ nick new ] } - { "PRIVMSG" [ privmsg new ] } - { "QUIT" [ quit new ] } - { "MODE" [ mode new ] } - { "KICK" [ kick new ] } - [ drop unhandled new ] - } case - [ copy-contents ] keep ; + { "PING" [ ping ] } + { "NOTICE" [ notice ] } + { "001" [ logged-in ] } + { "433" [ nick-in-use ] } + { "353" [ names-reply ] } + { "JOIN" [ join ] } + { "PART" [ part ] } + { "NICK" [ nick ] } + { "PRIVMSG" [ privmsg ] } + { "QUIT" [ quit ] } + { "MODE" [ mode ] } + { "KICK" [ kick ] } + [ drop unhandled ] + } case new [ copy-message-in ] keep ; From 007c68ab6baef0c92bd77f7c65f98715c79afca7 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Sat, 6 Sep 2008 19:29:18 -0300 Subject: [PATCH 06/10] irc.messages: handle mode parameters using inverse's switch --- extra/irc/messages/messages.factor | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) diff --git a/extra/irc/messages/messages.factor b/extra/irc/messages/messages.factor index 6159c3d97d..9cae8f6159 100755 --- a/extra/irc/messages/messages.factor +++ b/extra/irc/messages/messages.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Bruno Deferrari ! See http://factorcode.org/license.txt for BSD license. USING: kernel fry splitting ascii calendar accessors combinators qualified - arrays classes.tuple math.order quotations ; + arrays classes.tuple math.order inverse ; RENAME: join sequences => sjoin EXCLUDE: sequences => join ; IN: irc.messages @@ -59,6 +59,9 @@ M: kick command-parameters>> ( kick -- seq ) M: mode command-parameters>> ( mode -- seq ) [ name>> ] [ channel>> ] [ mode>> ] tri 3array ; +: (>>channel|nickname) ( string mode -- ) + over channel? [ (>>channel) ] [ (>>nickname) ] if ; + GENERIC: (>>command-parameters) ( params irc-message -- ) M: irc-message (>>command-parameters) ( params irc-message -- ) 2drop ; @@ -71,15 +74,9 @@ M: kick (>>command-parameters) ( params kick -- ) M: names-reply (>>command-parameters) ( params names-reply -- ) [ >r first r> (>>who) ] [ >r third r> (>>channel) ] 2bi ; M: mode (>>command-parameters) ( params mode -- ) - over first channel? [ - over length 3 = [ - >r first3 r> [ (>>parameter) ] [ (>>mode) ] [ (>>channel) ] tri - ] [ - >r first2 r> [ (>>mode) ] [ (>>channel) ] bi - ] if - ] [ - >r first2 r> [ (>>mode) ] [ (>>nickname) ] bi - ] if ; + { { [ >r 2array r> ] [ [ (>>mode) ] [ (>>channel|nickname) ] bi ] } + { [ >r 3array r> ] [ [ (>>parameter) ] [ (>>mode) ] [ (>>channel) ] tri ] } + } switch ; PRIVATE> From 198e35fac2a7b4b9e9bb3a24cae1bdba7cb45283 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Sun, 7 Sep 2008 00:14:51 -0300 Subject: [PATCH 07/10] irc.messages: Remove nickname/channel distiction --- extra/irc/client/client.factor | 2 +- extra/irc/messages/messages-tests.factor | 14 ++------------ extra/irc/messages/messages.factor | 12 +++--------- 3 files changed, 6 insertions(+), 22 deletions(-) diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor index 575c26972f..7d4c4977bb 100644 --- a/extra/irc/client/client.factor +++ b/extra/irc/client/client.factor @@ -183,7 +183,7 @@ GENERIC: forward-name ( irc-message -- name ) M: join forward-name ( join -- name ) trailing>> ; M: part forward-name ( part -- name ) channel>> ; M: kick forward-name ( kick -- name ) channel>> ; -M: mode forward-name ( mode -- name ) channel>> ; +M: mode forward-name ( mode -- name ) name>> ; M: privmsg forward-name ( privmsg -- name ) dup name>> me? [ irc-message-sender ] [ name>> ] if ; diff --git a/extra/irc/messages/messages-tests.factor b/extra/irc/messages/messages-tests.factor index ca8a4b1f50..b61dd16448 100644 --- a/extra/irc/messages/messages-tests.factor +++ b/extra/irc/messages/messages-tests.factor @@ -39,7 +39,7 @@ IN: irc.messages.tests { prefix "ircserver.net" } { command "MODE" } { parameters { "#factortest" "+ns" } } - { channel "#factortest" } + { name "#factortest" } { mode "+ns" } } } [ ":ircserver.net MODE #factortest +ns" parse-irc-line f >>timestamp ] unit-test @@ -49,22 +49,12 @@ IN: irc.messages.tests { prefix "ircserver.net" } { command "MODE" } { parameters { "#factortest" "+o" "someuser" } } - { channel "#factortest" } + { name "#factortest" } { mode "+o" } { parameter "someuser" } } } [ ":ircserver.net MODE #factortest +o someuser" parse-irc-line f >>timestamp ] unit-test -{ T{ mode - { line ":ircserver.net MODE someuser +i" } - { prefix "ircserver.net" } - { command "MODE" } - { parameters { "someuser" "+i" } } - { nickname "someuser" } - { mode "+i" } } } -[ ":ircserver.net MODE someuser +i" - parse-irc-line f >>timestamp ] unit-test - { T{ nick { line ":someuser!n=user@some.where NICK :someuser2" } { prefix "someuser!n=user@some.where" } diff --git a/extra/irc/messages/messages.factor b/extra/irc/messages/messages.factor index 9cae8f6159..bb78efd680 100755 --- a/extra/irc/messages/messages.factor +++ b/extra/irc/messages/messages.factor @@ -18,7 +18,7 @@ TUPLE: kick < irc-message channel who ; TUPLE: roomlist < irc-message channel names ; TUPLE: nick-in-use < irc-message asterisk name ; TUPLE: notice < irc-message type ; -TUPLE: mode < irc-message channel mode nickname parameter ; +TUPLE: mode < irc-message name mode parameter ; TUPLE: names-reply < irc-message who channel ; TUPLE: unhandled < irc-message ; @@ -28,9 +28,6 @@ TUPLE: unhandled < irc-message ; > ( irc-message -- string ) M: irc-message command-string>> ( irc-message -- string ) command>> ; @@ -59,9 +56,6 @@ M: kick command-parameters>> ( kick -- seq ) M: mode command-parameters>> ( mode -- seq ) [ name>> ] [ channel>> ] [ mode>> ] tri 3array ; -: (>>channel|nickname) ( string mode -- ) - over channel? [ (>>channel) ] [ (>>nickname) ] if ; - GENERIC: (>>command-parameters) ( params irc-message -- ) M: irc-message (>>command-parameters) ( params irc-message -- ) 2drop ; @@ -74,8 +68,8 @@ M: kick (>>command-parameters) ( params kick -- ) M: names-reply (>>command-parameters) ( params names-reply -- ) [ >r first r> (>>who) ] [ >r third r> (>>channel) ] 2bi ; M: mode (>>command-parameters) ( params mode -- ) - { { [ >r 2array r> ] [ [ (>>mode) ] [ (>>channel|nickname) ] bi ] } - { [ >r 3array r> ] [ [ (>>parameter) ] [ (>>mode) ] [ (>>channel) ] tri ] } + { { [ >r 2array r> ] [ [ (>>mode) ] [ (>>name) ] bi ] } + { [ >r 3array r> ] [ [ (>>parameter) ] [ (>>mode) ] [ (>>name) ] tri ] } } switch ; PRIVATE> From c3380865c107824ac6a7081b9de46f124ecdb71a Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Thu, 11 Sep 2008 03:35:34 -0300 Subject: [PATCH 08/10] irc.messages: dip --- extra/irc/messages/messages.factor | 29 +++++++++++++++-------------- 1 file changed, 15 insertions(+), 14 deletions(-) diff --git a/extra/irc/messages/messages.factor b/extra/irc/messages/messages.factor index bb78efd680..db25ba86d8 100755 --- a/extra/irc/messages/messages.factor +++ b/extra/irc/messages/messages.factor @@ -59,17 +59,18 @@ M: mode command-parameters>> ( mode -- seq ) GENERIC: (>>command-parameters) ( params irc-message -- ) M: irc-message (>>command-parameters) ( params irc-message -- ) 2drop ; -M: logged-in (>>command-parameters) ( params part -- ) >r first r> (>>name) ; -M: part (>>command-parameters) ( params part -- ) >r first r> (>>channel) ; -M: privmsg (>>command-parameters) ( params privmsg -- ) >r first r> (>>name) ; -M: notice (>>command-parameters) ( params notice -- ) >r first r> (>>type) ; +M: logged-in (>>command-parameters) ( params part -- ) [ first ] dip (>>name) ; +M: privmsg (>>command-parameters) ( params privmsg -- ) [ first ] dip (>>name) ; +M: notice (>>command-parameters) ( params notice -- ) [ first ] dip (>>type) ; +M: part (>>command-parameters) ( params part -- ) + [ first ] dip (>>channel) ; M: kick (>>command-parameters) ( params kick -- ) - >r first2 r> [ (>>who) ] [ (>>channel) ] bi ; + [ first2 ] dip [ (>>who) ] [ (>>channel) ] bi ; M: names-reply (>>command-parameters) ( params names-reply -- ) - [ >r first r> (>>who) ] [ >r third r> (>>channel) ] 2bi ; + [ [ first ] dip (>>who) ] [ [ third ] dip (>>channel) ] 2bi ; M: mode (>>command-parameters) ( params mode -- ) - { { [ >r 2array r> ] [ [ (>>mode) ] [ (>>name) ] bi ] } - { [ >r 3array r> ] [ [ (>>parameter) ] [ (>>mode) ] [ (>>name) ] tri ] } + { { [ [ 2array ] dip ] [ [ (>>mode) ] [ (>>name) ] bi ] } + { [ [ 3array ] dip ] [ [ (>>parameter) ] [ (>>mode) ] [ (>>name) ] tri ] } } switch ; PRIVATE> @@ -113,12 +114,12 @@ M: irc-message irc-message>server-line ( irc-message -- string ) ":" split1 ; : copy-message-in ( origin dest -- ) - { [ >r parameters>> r> [ (>>command-parameters) ] [ (>>parameters) ] 2bi ] - [ >r line>> r> (>>line) ] - [ >r prefix>> r> (>>prefix) ] - [ >r command>> r> (>>command) ] - [ >r trailing>> r> (>>trailing) ] - [ >r timestamp>> r> (>>timestamp) ] + { [ [ parameters>> ] dip [ (>>command-parameters) ] [ (>>parameters) ] 2bi ] + [ [ line>> ] dip (>>line) ] + [ [ prefix>> ] dip (>>prefix) ] + [ [ command>> ] dip (>>command) ] + [ [ trailing>> ] dip (>>trailing) ] + [ [ timestamp>> ] dip (>>timestamp) ] } 2cleave ; PRIVATE> From d9e0060eb820d0b21997ade7d5dd917fb0f20aed Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Fri, 19 Sep 2008 22:14:00 -0300 Subject: [PATCH 09/10] irc.messages: Fix `_' word conflict between fry and inverse --- extra/irc/messages/messages.factor | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/extra/irc/messages/messages.factor b/extra/irc/messages/messages.factor index 94f80dcf0c..9201f822da 100755 --- a/extra/irc/messages/messages.factor +++ b/extra/irc/messages/messages.factor @@ -1,9 +1,10 @@ ! Copyright (C) 2008 Bruno Deferrari ! See http://factorcode.org/license.txt for BSD license. USING: kernel fry splitting ascii calendar accessors combinators qualified - arrays classes.tuple math.order inverse ; + arrays classes.tuple math.order ; RENAME: join sequences => sjoin EXCLUDE: sequences => join ; +EXCLUDE: inverse => _ ; IN: irc.messages TUPLE: irc-message line prefix command parameters trailing timestamp ; @@ -69,8 +70,8 @@ M: kick (>>command-parameters) ( params kick -- ) M: names-reply (>>command-parameters) ( params names-reply -- ) [ [ first ] dip (>>who) ] [ [ third ] dip (>>channel) ] 2bi ; M: mode (>>command-parameters) ( params mode -- ) - { { [ [ 2array ] dip ] [ [ (>>mode) ] [ (>>name) ] bi ] } - { [ [ 3array ] dip ] [ [ (>>parameter) ] [ (>>mode) ] [ (>>name) ] tri ] } + { { [ >r 2array r> ] [ [ (>>mode) ] [ (>>name) ] bi ] } + { [ >r 3array r> ] [ [ (>>parameter) ] [ (>>mode) ] [ (>>name) ] tri ] } } switch ; PRIVATE> @@ -94,10 +95,7 @@ M: irc-message irc-message>server-line ( irc-message -- string ) ! ====================================== : split-at-first ( seq separators -- before after ) - dupd '[ _ member? ] find - [ cut 1 tail ] - [ swap ] - if ; + dupd '[ _ member? ] find [ cut 1 tail ] [ swap ] if ; : remove-heading-: ( seq -- seq ) dup ":" head? [ 1 tail ] when ; From d256db22d19f99c4e433e69423a83b116eb879dd Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Sun, 21 Sep 2008 20:38:01 -0300 Subject: [PATCH 10/10] irc.client: Fixes, refactoring --- extra/irc/client/client-tests.factor | 2 +- extra/irc/client/client.factor | 84 ++++++++++++++++------------ 2 files changed, 50 insertions(+), 36 deletions(-) diff --git a/extra/irc/client/client-tests.factor b/extra/irc/client/client-tests.factor index 932bdda472..c768c1a82e 100644 --- a/extra/irc/client/client-tests.factor +++ b/extra/irc/client/client-tests.factor @@ -20,7 +20,7 @@ M: mb-writer stream-nl ( mb-writer -- ) [ [ last-line>> concat ] [ lines>> ] bi push ] keep V{ } clone >>last-line drop ; -: spawn-client ( lines listeners -- irc-client ) +: spawn-client ( -- irc-client ) "someserver" irc-port "factorbot" f t >>is-running diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor index db4fdd2a58..569f6c4bf7 100755 --- a/extra/irc/client/client.factor +++ b/extra/irc/client/client.factor @@ -68,12 +68,17 @@ 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 established +> values [ out-messages>> ] map ] + [ in-messages>> ] + [ out-messages>> ] tri 2array prepend + [ irc-end swap mailbox-put ] each ; +PRIVATE> + : terminate-irc ( irc-client -- ) [ is-running>> ] keep and [ - [ [ irc-end ] dip in-messages>> mailbox-put ] - [ [ f ] dip (>>is-running) ] - [ stream>> dispose ] - tri + [ end-loops ] [ [ f ] dip (>>is-running) ] bi ] when* ; [ stream-print ] keep stream-flush ; : irc-send ( irc-message -- ) irc> out-messages>> mailbox-put ; : listener> ( name -- listener/f ) irc> listeners>> at ; - +: channel-mode? ( mode -- ? ) name>> first "#&" member? ; +: me? ( string -- ? ) irc> profile>> nickname>> = ; GENERIC: to-listener ( message obj -- ) @@ -137,10 +143,14 @@ M: irc-listener to-listener ( message irc-listener -- ) swap dup listeners-with-participant [ rename-participant ] with with each ; : add-participant ( mode nick channel -- ) - listener> [ - [ participants>> set-at ] - [ [ +join+ f ] dip to-listener ] 2bi - ] [ 2drop ] if* ; + listener> + [ participants>> set-at ] + [ [ +join+ f ] dip to-listener ] 2bi ; + +: change-participant-mode ( channel mode nick -- ) + rot listener> + [ participants>> set-at ] + [ [ [ +mode+ ] dip ] dip to-listener ] 3bi ; ! FIXME DEFER: me? @@ -174,9 +184,6 @@ DEFER: me? ! Server message handling ! ====================================== -: me? ( string -- ? ) - irc> profile>> nickname>> = ; - GENERIC: forward-name ( irc-message -- name ) M: join forward-name ( join -- name ) trailing>> ; M: part forward-name ( part -- name ) channel>> ; @@ -220,7 +227,8 @@ M: nick-in-use process-message ( nick-in-use -- ) name>> "_" append /NICK ; M: join process-message ( join -- ) - [ drop +normal+ ] [ irc-message-sender ] [ trailing>> ] tri add-participant ; + [ drop +normal+ ] [ irc-message-sender ] [ trailing>> ] tri + dup listener> [ add-participant ] [ 3drop ] if ; M: part process-message ( part -- ) [ irc-message-sender ] [ channel>> ] bi remove-participant ; @@ -236,6 +244,12 @@ M: quit process-message ( quit -- ) M: nick process-message ( nick -- ) [ irc-message-sender ] [ trailing>> ] bi rename-participant-in-all ; +! M: mode process-message ( mode -- ) +! [ channel-mode? ] keep and [ +! [ name>> ] [ mode>> ] [ parameter>> ] tri +! [ change-participant-mode ] [ 2drop ] if* +! ] when* ; + : >nick/mode ( string -- nick mode ) dup first "+@" member? [ unclip ] [ 0 ] if participant-mode ; @@ -249,15 +263,14 @@ M: names-reply process-message ( names-reply -- ) [ [ f f f ] dip name>> to-listener ] bi ] [ drop ] if* ; -: handle-incoming-irc ( irc-message -- ) - [ forward-message ] [ process-message ] bi ; - ! ====================================== ! Client message handling ! ====================================== -: handle-outgoing-irc ( irc-message -- ) - irc-message>client-line irc-print ; +GENERIC: handle-outgoing-irc ( irc-message -- ? ) +M: irc-end handle-outgoing-irc ( irc-end -- ? ) drop f ; +M: irc-message handle-outgoing-irc ( irc-message -- ? ) + irc-message>client-line irc-print t ; ! ====================================== ! Reader/Writer @@ -279,27 +292,28 @@ DEFER: (connect-irc) : handle-disconnect ( error -- ) drop irc> is-running>> [ (handle-disconnect) ] when ; -: (reader-loop) ( -- ) +: (reader-loop) ( -- ? ) irc> stream>> [ |dispose stream-readln [ - parse-irc-line handle-reader-message + parse-irc-line handle-reader-message t ] [ - irc> terminate-irc + irc> terminate-irc f ] if* ] with-destructors ; : reader-loop ( -- ? ) - [ (reader-loop) ] [ handle-disconnect ] recover t ; + [ (reader-loop) ] [ handle-disconnect t ] recover ; : writer-loop ( -- ? ) - irc> out-messages>> mailbox-get handle-outgoing-irc t ; + irc> out-messages>> mailbox-get handle-outgoing-irc ; ! ====================================== ! Processing loops ! ====================================== : in-multiplexer-loop ( -- ? ) - irc> in-messages>> mailbox-get handle-incoming-irc t ; + irc> in-messages>> mailbox-get + [ forward-message ] [ process-message ] [ irc-end? not ] tri ; : strings>privmsg ( name string -- privmsg ) privmsg new [ (>>trailing) ] keep [ (>>name) ] keep ; @@ -310,22 +324,22 @@ DEFER: (connect-irc) [ nip ] } cond ; +GENERIC: handle-listener-out ( irc-message -- ? ) +M: irc-end handle-listener-out ( irc-end -- ? ) drop f ; +M: irc-message handle-listener-out ( irc-message -- ? ) + irc> out-messages>> mailbox-put t ; + : listener-loop ( name -- ? ) dup listener> [ out-messages>> mailbox-get - maybe-annotate-with-name - irc> out-messages>> mailbox-put - t + maybe-annotate-with-name handle-listener-out ] [ drop f ] if* ; -: spawn-irc-loop ( quot: ( -- ? ) name -- ) - [ '[ irc> is-running>> [ @ ] [ f ] if ] ] dip - spawn-server drop ; - : spawn-irc ( -- ) - [ reader-loop ] "irc-reader-loop" spawn-irc-loop - [ writer-loop ] "irc-writer-loop" spawn-irc-loop - [ in-multiplexer-loop ] "in-multiplexer-loop" spawn-irc-loop ; + [ reader-loop ] "irc-reader-loop" spawn-server + [ writer-loop ] "irc-writer-loop" spawn-server + [ in-multiplexer-loop ] "in-multiplexer-loop" spawn-server + 3drop ; ! ====================================== ! Listener join request handling @@ -333,7 +347,7 @@ DEFER: (connect-irc) : set+run-listener ( name irc-listener -- ) over irc> listeners>> set-at - '[ _ listener-loop ] "listener" spawn-irc-loop ; + '[ _ listener-loop ] "irc-listener-loop" spawn-server drop ; GENERIC: (add-listener) ( irc-listener -- )