From 77e6f10ac3c3079f16c24e5d8fec8ac03610149e Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Fri, 18 Jul 2008 13:09:04 -0300 Subject: [PATCH 1/6] irc.client: Improvments to thread management. --- extra/irc/client/client.factor | 39 ++++++++++++++++++++++------------ 1 file changed, 25 insertions(+), 14 deletions(-) diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor index 405d8ed9ed..bda00fcb95 100644 --- a/extra/irc/client/client.factor +++ b/extra/irc/client/client.factor @@ -63,6 +63,7 @@ SYMBOL: +mode+ TUPLE: participant-changed nick action ; C: participant-changed +SINGLETON: irc-listener-end ! send to a listener to top its execution 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 @@ -85,7 +86,9 @@ UNION: irc-broadcasted-message irc-end irc-disconnected irc-connected ; : irc-write ( s -- ) irc-stream> stream-write ; : irc-print ( s -- ) irc-stream> [ stream-print ] keep stream-flush ; : listener> ( name -- listener/f ) irc> listeners>> at ; -: unregister-listener ( name -- ) irc> listeners>> delete-at ; + +: maybe-mailbox-get ( mailbox quot -- ) + [ dup mailbox-empty? [ drop yield ] ] dip '[ mailbox-get @ ] if ; inline GENERIC: to-listener ( message obj -- ) @@ -93,6 +96,12 @@ M: string to-listener ( message string -- ) listener> [ +server-listener+ listener> ] unless* [ to-listener ] [ drop ] if* ; +: unregister-listener ( name -- ) + irc> listeners>> + [ at [ irc-listener-end ] dip to-listener ] + [ delete-at ] + 2bi ; + M: irc-listener to-listener ( message irc-listener -- ) in-messages>> mailbox-put ; @@ -291,18 +300,18 @@ DEFER: (connect-irc) ] if* ] with-destructors ; -: reader-loop ( -- ) - [ (reader-loop) ] [ handle-disconnect ] recover ; +: reader-loop ( -- ? ) + [ (reader-loop) ] [ handle-disconnect ] recover t ; -: writer-loop ( -- ) - irc> out-messages>> mailbox-get handle-outgoing-irc ; +: writer-loop ( -- ? ) + irc> out-messages>> [ handle-outgoing-irc ] maybe-mailbox-get t ; ! ====================================== ! Processing loops ! ====================================== -: in-multiplexer-loop ( -- ) - irc> in-messages>> mailbox-get handle-incoming-irc ; +: in-multiplexer-loop ( -- ? ) + irc> in-messages>> [ handle-incoming-irc ] maybe-mailbox-get t ; : strings>privmsg ( name string -- privmsg ) privmsg new [ (>>trailing) ] keep [ (>>name) ] keep ; @@ -314,12 +323,15 @@ DEFER: (connect-irc) [ nip ] } cond ; -: listener-loop ( name listener -- ) - out-messages>> mailbox-get maybe-annotate-with-name - irc> out-messages>> mailbox-put ; +: listener-loop ( name -- ? ) + dup listener> [ + out-messages>> [ maybe-annotate-with-name + irc> out-messages>> mailbox-put ] with + maybe-mailbox-get t + ] [ drop f ] if* ; : spawn-irc-loop ( quot name -- ) - [ '[ irc> is-running>> [ @ ] when irc> is-running>> ] ] dip + [ '[ irc> is-running>> [ @ ] [ f ] if ] ] dip spawn-server drop ; : spawn-irc ( -- ) @@ -332,9 +344,8 @@ DEFER: (connect-irc) ! ====================================== : set+run-listener ( name irc-listener -- ) - [ '[ , , listener-loop ] "listener" spawn-irc-loop ] - [ swap irc> listeners>> set-at ] - 2bi ; + over irc> listeners>> set-at + '[ , listener-loop ] "listener" spawn-irc-loop ; GENERIC: (add-listener) ( irc-listener -- ) From 55d7cb31689114c665bbdf8a79894004068717d2 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Fri, 18 Jul 2008 16:36:40 -0300 Subject: [PATCH 2/6] irc.client: Two more tests --- extra/irc/client/client-tests.factor | 24 ++++++++++++++++++++---- extra/irc/client/client.factor | 5 +++-- 2 files changed, 23 insertions(+), 6 deletions(-) diff --git a/extra/irc/client/client-tests.factor b/extra/irc/client/client-tests.factor index 100724ea58..641cb57562 100644 --- a/extra/irc/client/client-tests.factor +++ b/extra/irc/client/client-tests.factor @@ -64,7 +64,23 @@ IN: irc.client.tests [ read-message drop ] [ read-message drop ] [ read-message ] tri ] tri [ action>> ] [ nick>> ] bi ] unit-test -! TODO: channel message -! ":somebody!n=somebody@some.where PRIVMSG #factortest :hello" -! TODO: direct private message -! ":somedude!n=user@isp.net PRIVMSG factorbot2 :hello" \ No newline at end of file + +{ privmsg "#factortest" "hello" } [ + { ":somebody!n=somebody@some.where PRIVMSG #factortest :hello" + } make-client dup "factorbot" set-nick + [ listeners>> [ "#factortest" [ ] keep ] dip set-at ] + [ connect-irc ] + [ listeners>> [ "#factortest" ] dip at + [ read-message drop ] [ read-message ] bi ] tri + [ class ] [ name>> ] [ trailing>> ] tri + ] unit-test + +{ privmsg "factorbot" "hello" } [ + { ":somedude!n=user@isp.net PRIVMSG factorbot :hello" + } make-client dup "factorbot" set-nick + [ listeners>> [ "somedude" [ ] keep ] dip set-at ] + [ connect-irc ] + [ listeners>> [ "somedude" ] dip at + [ read-message drop ] [ read-message ] bi ] tri + [ class ] [ name>> ] [ trailing>> ] tri + ] unit-test \ No newline at end of file diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor index bda00fcb95..f4ef2a6d57 100644 --- a/extra/irc/client/client.factor +++ b/extra/irc/client/client.factor @@ -51,7 +51,8 @@ SYMBOL: +mode+ irc-server-listener boa ; : ( name -- irc-channel-listener ) - [ ] dip f 60 seconds H{ } clone irc-channel-listener boa ; + [ ] dip f 60 seconds H{ } clone + irc-channel-listener boa ; : ( name -- irc-nick-listener ) [ ] dip irc-nick-listener boa ; @@ -63,7 +64,7 @@ SYMBOL: +mode+ TUPLE: participant-changed nick action ; C: participant-changed -SINGLETON: irc-listener-end ! send to a listener to top its execution +SINGLETON: irc-listener-end ! send to a listener to stop its execution 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 From b855b098a79fb62d6dbdc0f12a8b7c153baabb29 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Sat, 26 Jul 2008 15:32:16 -0300 Subject: [PATCH 3/6] irc.client: Fixes, tests, etc --- extra/irc/client/client-tests.factor | 115 +++++++++++++---------- extra/irc/client/client.factor | 46 ++++----- extra/irc/messages/messages-tests.factor | 10 ++ extra/irc/messages/messages.factor | 68 ++++++++++---- 4 files changed, 145 insertions(+), 94 deletions(-) diff --git a/extra/irc/client/client-tests.factor b/extra/irc/client/client-tests.factor index 641cb57562..e4b7cd20ed 100644 --- a/extra/irc/client/client-tests.factor +++ b/extra/irc/client/client-tests.factor @@ -1,7 +1,7 @@ USING: kernel tools.test accessors arrays sequences qualified io.streams.string io.streams.duplex namespaces threads calendar irc.client.private irc.client irc.messages.private - concurrency.mailboxes classes assocs ; + concurrency.mailboxes classes assocs combinators ; EXCLUDE: irc.messages => join ; RENAME: join irc.messages => join_ IN: irc.client.tests @@ -11,16 +11,16 @@ IN: irc.client.tests "\n" join ; : make-client ( lines -- irc-client ) - "someserver" irc-port "factorbot" f - swap [ 2nip f ] curry >>connect ; + "someserver" irc-port "factorbot" f + swap [ 2nip f ] curry >>connect ; : set-nick ( irc-client nickname -- ) - swap profile>> (>>nickname) ; + swap profile>> (>>nickname) ; -: with-dummy-client ( quot -- ) - rot with-variable ; inline +: with-dummy-client ( irc-client quot -- ) + [ current-irc-client ] dip with-variable ; inline -{ "" } make-client dup "factorbot" set-nick current-irc-client [ +{ "" } make-client dup "factorbot" set-nick [ { t } [ irc> profile>> nickname>> me? ] unit-test { "factorbot" } [ irc> profile>> nickname>> ] unit-test @@ -32,55 +32,72 @@ IN: irc.client.tests { "someuser" } [ ":someuser!n=user@some.where PRIVMSG factorbot :hi" parse-irc-line irc-message-origin ] unit-test -] with-variable +] with-dummy-client ! Test login and nickname set -{ "factorbot" } [ { "NOTICE AUTH :*** Looking up your hostname..." - "NOTICE AUTH :*** Checking ident" - "NOTICE AUTH :*** Found your hostname" - "NOTICE AUTH :*** No identd (auth) response" - ":some.where 001 factorbot :Welcome factorbot" - } make-client - [ connect-irc ] keep 1 seconds sleep - profile>> nickname>> ] unit-test +{ "factorbot" } [ + { "NOTICE AUTH :*** Looking up your hostname..." + "NOTICE AUTH :*** Checking ident" + "NOTICE AUTH :*** Found your hostname" + "NOTICE AUTH :*** No identd (auth) response" + ":some.where 001 factorbot :Welcome factorbot" + } make-client + { [ connect-irc ] + [ drop 1 seconds sleep ] + [ profile>> nickname>> ] + [ terminate-irc ] + } cleave ] unit-test { join_ "#factortest" } [ - { ":factorbot!n=factorbo@some.where JOIN :#factortest" - ":ircserver.net MODE #factortest +ns" - ":ircserver.net 353 factorbot @ #factortest :@factorbot " - ":ircserver.net 366 factorbot #factortest :End of /NAMES list." - ":ircserver.net 477 factorbot #factortest :[ircserver-info] blah blah" - } make-client dup "factorbot" set-nick - [ connect-irc ] keep 1 seconds sleep - join-messages>> 1 seconds mailbox-get-timeout - [ class ] [ trailing>> ] bi ] unit-test + { ":factorbot!n=factorbo@some.where JOIN :#factortest" + ":ircserver.net MODE #factortest +ns" + ":ircserver.net 353 factorbot @ #factortest :@factorbot " + ":ircserver.net 366 factorbot #factortest :End of /NAMES list." + ":ircserver.net 477 factorbot #factortest :[ircserver-info] blah blah" + } make-client + { [ "factorbot" set-nick ] + [ connect-irc ] + [ drop 1 seconds sleep ] + [ join-messages>> 1 seconds mailbox-get-timeout ] + [ terminate-irc ] + } cleave + [ class ] [ trailing>> ] bi ] unit-test { +join+ "somebody" } [ - { ":somebody!n=somebody@some.where JOIN :#factortest" - } make-client dup "factorbot" set-nick - [ listeners>> [ "#factortest" [ ] keep ] dip set-at ] - [ connect-irc ] - [ listeners>> [ "#factortest" ] dip at - [ read-message drop ] [ read-message drop ] [ read-message ] tri ] tri - [ action>> ] [ nick>> ] bi - ] unit-test + { ":somebody!n=somebody@some.where JOIN :#factortest" } make-client + { [ "factorbot" set-nick ] + [ listeners>> + [ "#factortest" [ ] keep ] dip set-at ] + [ connect-irc ] + [ listeners>> [ "#factortest" ] dip at + [ read-message drop ] [ read-message drop ] [ read-message ] tri ] + [ terminate-irc ] + } cleave + [ action>> ] [ nick>> ] bi + ] unit-test { privmsg "#factortest" "hello" } [ - { ":somebody!n=somebody@some.where PRIVMSG #factortest :hello" - } make-client dup "factorbot" set-nick - [ listeners>> [ "#factortest" [ ] keep ] dip set-at ] - [ connect-irc ] - [ listeners>> [ "#factortest" ] dip at - [ read-message drop ] [ read-message ] bi ] tri - [ class ] [ name>> ] [ trailing>> ] tri - ] unit-test + { ":somebody!n=somebody@some.where PRIVMSG #factortest :hello" } make-client + { [ "factorbot" set-nick ] + [ listeners>> + [ "#factortest" [ ] keep ] dip set-at ] + [ connect-irc ] + [ listeners>> [ "#factortest" ] dip at + [ read-message drop ] [ read-message ] bi ] + [ terminate-irc ] + } cleave + [ class ] [ name>> ] [ trailing>> ] tri + ] unit-test { privmsg "factorbot" "hello" } [ - { ":somedude!n=user@isp.net PRIVMSG factorbot :hello" - } make-client dup "factorbot" set-nick - [ listeners>> [ "somedude" [ ] keep ] dip set-at ] - [ connect-irc ] - [ listeners>> [ "somedude" ] dip at - [ read-message drop ] [ read-message ] bi ] tri - [ class ] [ name>> ] [ trailing>> ] tri - ] unit-test \ No newline at end of file + { ":somedude!n=user@isp.net PRIVMSG factorbot :hello" } make-client + { [ "factorbot" set-nick ] + [ listeners>> + [ "somedude" [ ] keep ] dip set-at ] + [ connect-irc ] + [ listeners>> [ "somedude" ] dip at + [ read-message drop ] [ read-message ] bi ] + [ terminate-irc ] + } cleave + [ class ] [ name>> ] [ trailing>> ] tri + ] unit-test diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor index f4ef2a6d57..888332dc1f 100644 --- a/extra/irc/client/client.factor +++ b/extra/irc/client/client.factor @@ -12,8 +12,6 @@ IN: irc.client ! Setup and running objects ! ====================================== -SYMBOL: current-irc-client - : irc-port 6667 ; ! Default irc port TUPLE: irc-profile server port nickname password ; @@ -71,13 +69,17 @@ SINGLETON: irc-connected ! sent when connection is established UNION: irc-broadcasted-message irc-end irc-disconnected irc-connected ; : terminate-irc ( irc-client -- ) - [ [ irc-end ] dip in-messages>> mailbox-put ] - [ [ f ] dip (>>is-running) ] - [ stream>> dispose ] - tri ; + [ is-running>> ] keep and [ + [ [ irc-end ] dip in-messages>> mailbox-put ] + [ [ f ] dip (>>is-running) ] + [ stream>> dispose ] + tri + ] when* ; [ stream-print ] keep stream-flush ; : listener> ( name -- listener/f ) irc> listeners>> at ; -: maybe-mailbox-get ( mailbox quot -- ) +: maybe-mailbox-get ( mailbox quot: ( irc-message -- ) -- ) [ dup mailbox-empty? [ drop yield ] ] dip '[ mailbox-get @ ] if ; inline GENERIC: to-listener ( message obj -- ) @@ -240,8 +242,8 @@ M: quit handle-incoming-irc ( quit -- ) [ to-listener ] with each ] [ handle-participant-change ] [ prefix>> parse-name remove-participant-from-all ] - [ ] - } cleave call-next-method ; + [ call-next-method ] + } cleave ; : >nick/mode ( string -- nick mode ) dup first "+@" member? [ unclip ] [ 0 ] if participant-mode ; @@ -266,12 +268,6 @@ GENERIC: handle-outgoing-irc ( obj -- ) M: irc-message handle-outgoing-irc ( irc-message -- ) irc-message>client-line irc-print ; -M: privmsg handle-outgoing-irc ( privmsg -- ) - [ name>> ] [ trailing>> ] bi /PRIVMSG ; - -M: part handle-outgoing-irc ( part -- ) - [ channel>> ] [ trailing>> "" or ] bi /PART ; - ! ====================================== ! Reader/Writer ! ====================================== @@ -283,7 +279,7 @@ DEFER: (connect-irc) : (handle-disconnect) ( -- ) irc> - [ [ irc-disconnected ] dip to-listener ] + [ [ irc-disconnected ] dip in-messages>> mailbox-put ] [ dup reconnect-time>> sleep (connect-irc) ] [ profile>> nickname>> /LOGIN ] tri ; @@ -318,10 +314,9 @@ DEFER: (connect-irc) privmsg new [ (>>trailing) ] keep [ (>>name) ] keep ; : maybe-annotate-with-name ( name obj -- obj ) - { - { [ dup string? ] [ strings>privmsg ] } - { [ dup privmsg instance? ] [ swap >>name ] } - [ nip ] + { { [ dup string? ] [ strings>privmsg ] } + { [ dup privmsg instance? ] [ swap >>name ] } + [ nip ] } cond ; : listener-loop ( name -- ? ) @@ -331,7 +326,7 @@ DEFER: (connect-irc) maybe-mailbox-get t ] [ drop f ] if* ; -: spawn-irc-loop ( quot name -- ) +: spawn-irc-loop ( quot: ( -- ? ) name -- ) [ '[ irc> is-running>> [ @ ] [ f ] if ] ] dip spawn-server drop ; @@ -383,16 +378,15 @@ M: irc-server-listener (remove-listener) ( irc-server-listener -- ) t >>is-running in-messages>> [ irc-connected ] dip mailbox-put ; -: with-irc-client ( irc-client quot -- ) +: with-irc-client ( irc-client quot: ( -- ) -- ) [ current-irc-client ] dip with-variable ; inline PRIVATE> : connect-irc ( irc-client -- ) - dup [ - [ (connect-irc) ] [ profile>> nickname>> /LOGIN ] bi - spawn-irc - ] with-irc-client ; + [ irc> + [ (connect-irc) ] [ profile>> nickname>> /LOGIN ] bi + spawn-irc ] with-irc-client ; : add-listener ( irc-listener irc-client -- ) swap '[ , (add-listener) ] with-irc-client ; diff --git a/extra/irc/messages/messages-tests.factor b/extra/irc/messages/messages-tests.factor index 1bd6088f82..876841abb7 100644 --- a/extra/irc/messages/messages-tests.factor +++ b/extra/irc/messages/messages-tests.factor @@ -35,3 +35,13 @@ join new [ ":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 +[ ":ircserver.net MODE #factortest +ns" + 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 5813c72723..a5f82a5ae1 100644 --- 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 ; + arrays classes.tuple math.order quotations ; RENAME: join sequences => sjoin EXCLUDE: sequences => join ; IN: irc.messages @@ -17,7 +17,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 name channel mode ; +TUPLE: mode < irc-message channel mode ; TUPLE: names-reply < irc-message who = channel ; TUPLE: unhandled < irc-message ; @@ -25,12 +25,42 @@ TUPLE: unhandled < irc-message ; irc-message new now >>timestamp [ [ (>>trailing) ] [ (>>parameters) ] [ (>>command) ] tri ] keep ; +> ; +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: 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" ; + +GENERIC: irc-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 ) name>> 1array ; +M: quit irc-command-parameters ( quit -- 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 ) + [ channel>> ] [ who>> ] bi 2array ; +M: mode irc-command-parameters ( mode -- seq ) + [ name>> ] [ channel>> ] [ mode>> ] tri 3array ; + +PRIVATE> + GENERIC: irc-message>client-line ( irc-message -- string ) M: irc-message irc-message>client-line ( irc-message -- string ) - [ command>> ] - [ parameters>> " " sjoin ] - [ trailing>> dup [ CHAR: : prefix ] when ] + [ irc-command-string ] + [ irc-command-parameters " " sjoin ] + [ trailing>> [ CHAR: : prefix ] [ "" ] if* ] tri 3array " " sjoin ; GENERIC: irc-message>server-line ( irc-message -- string ) @@ -73,19 +103,19 @@ PRIVATE> : 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 ] } - { "PRIVMSG" [ \ privmsg ] } - { "QUIT" [ \ quit ] } - { "MODE" [ \ mode ] } - { "KICK" [ \ kick ] } - [ drop \ unhandled ] + { "PING" [ ping ] } + { "NOTICE" [ notice ] } + { "001" [ logged-in ] } + { "433" [ nick-in-use ] } + { "353" [ names-reply ] } + { "JOIN" [ join ] } + { "PART" [ part ] } + { "PRIVMSG" [ privmsg ] } + { "QUIT" [ quit ] } + { "MODE" [ mode ] } + { "KICK" [ kick ] } + [ drop unhandled ] } case [ [ tuple-slots ] [ parameters>> ] bi append ] dip - [ all-slots over [ length ] bi@ min head ] keep slots>tuple ; - + [ all-slots over [ length ] bi@ min head >quotation ] keep + '[ @ , boa nip ] call ; From 09c1fc390ba64b9a097f4e7ae93c88d54e45d4a5 Mon Sep 17 00:00:00 2001 From: William Schlieper Date: Sun, 27 Jul 2008 20:15:38 -0400 Subject: [PATCH 4/6] Added server listener --- extra/irc/ui/ui.factor | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/extra/irc/ui/ui.factor b/extra/irc/ui/ui.factor index 9b8d1a4d11..1520970f46 100755 --- a/extra/irc/ui/ui.factor +++ b/extra/irc/ui/ui.factor @@ -187,8 +187,9 @@ M: irc-tab ungraft* : ui-connect ( profile -- ui-window ) ui-window new over >>client swap [ connect-irc ] + [ [ ] dip add-listener ] [ listeners>> +server-listener+ swap at over - "Server" associate >>tabs ] bi ; + "Server" associate >>tabs ] tri ; : server-open ( server port nick password channels -- ) [ ui-connect [ irc-window ] keep ] dip From b30f22f125c3e4c949ad8cb4fd98b4cf8e881229 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Sun, 27 Jul 2008 21:19:28 -0300 Subject: [PATCH 5/6] irc.client: Fix removing of participant on quit --- extra/irc/client/client.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor index 888332dc1f..42682154cd 100644 --- a/extra/irc/client/client.factor +++ b/extra/irc/client/client.factor @@ -117,7 +117,7 @@ M: irc-listener to-listener ( message irc-listener -- ) with filter ; : remove-participant-from-all ( nick -- ) - dup listeners-with-participant [ delete-at ] with each ; + dup listeners-with-participant [ participants>> delete-at ] with each ; : add-participant ( mode nick channel -- ) listener> [ participants>> set-at ] [ 2drop ] if* ; From 9f60dd601bfe417b153fdb68076abf69396da5be Mon Sep 17 00:00:00 2001 From: William Schlieper Date: Mon, 28 Jul 2008 21:02:05 -0400 Subject: [PATCH 6/6] irc.ui: Fixed a few bugs --- extra/irc/ui/ui.factor | 25 ++++++++++++++++++++----- 1 file changed, 20 insertions(+), 5 deletions(-) diff --git a/extra/irc/ui/ui.factor b/extra/irc/ui/ui.factor index 1520970f46..c91d797f25 100755 --- a/extra/irc/ui/ui.factor +++ b/extra/irc/ui/ui.factor @@ -6,9 +6,11 @@ USING: accessors kernel threads combinators concurrency.mailboxes ui ui.gadgets ui.gadgets.panes ui.gadgets.editors ui.gadgets.scrollers ui.commands ui.gadgets.frames ui.gestures ui.gadgets.tabs ui.gadgets.grids ui.gadgets.lists ui.gadgets.labels - io io.styles namespaces calendar calendar.format models + io io.styles namespaces calendar calendar.format models continuations irc.client irc.client.private irc.messages irc.messages.private - irc.ui.commandparser irc.ui.load ; + irc.ui.commandparser irc.ui.load qualified ; + +RENAME: join sequences => sjoin IN: irc.ui @@ -71,14 +73,21 @@ M: quit write-irc " has left IRC" red write-color trailing>> dot-or-parens red write-color ; +: full-mode ( message -- mode ) + parameters>> rest " " sjoin ; + M: mode write-irc "* " blue write-color - [ name>> write ] keep + [ prefix>> parse-name write ] keep " has applied mode " blue write-color - [ mode>> write ] keep + [ full-mode write ] keep " to " blue write-color channel>> write ; +M: unhandled write-irc + "UNHANDLED: " write + line>> blue write-color ; + M: irc-end write-irc drop "* You have left IRC" red write-color ; @@ -88,11 +97,17 @@ M: irc-disconnected write-irc M: irc-connected write-irc drop "* Connected" green write-color ; +M: irc-listener-end write-irc + drop ; + M: irc-message write-irc drop ; ! catch all unimplemented writes, THIS WILL CHANGE +: time-happened ( irc-message -- timestamp ) + [ timestamp>> ] [ 2drop now ] recover ; + : print-irc ( irc-message -- ) - [ timestamp>> timestamp>hms write " " write ] + [ time-happened timestamp>hms write " " write ] [ write-irc nl ] bi ; : send-message ( message -- )