diff --git a/extra/irc/client/client-tests.factor b/extra/irc/client/client-tests.factor index e021ff4ff4..1b338df442 100644 --- a/extra/irc/client/client-tests.factor +++ b/extra/irc/client/client-tests.factor @@ -160,7 +160,7 @@ IN: irc.client.tests } cleave ] unit-test -! Namelist notification +! Namelist change notification { T{ participant-changed f f f } } [ { ":ircserver.net 353 factorbot @ #factortest :@factorbot " ":ircserver.net 366 factorbot #factortest :End of /NAMES list." } make-client @@ -172,4 +172,19 @@ IN: irc.client.tests [ listeners>> [ "#factortest" ] dip at [ read-message drop ] [ read-message ] bi ] [ terminate-irc ] } cleave + ] unit-test + +{ T{ participant-changed f "somedude" +part+ } } [ + { ":somedude!n=user@isp.net QUIT" } make-client + { [ "factorbot" set-nick ] + [ listeners>> + [ "#factortest" [ + H{ { "somedude" +normal+ } } clone >>participants ] keep + ] dip set-at ] + [ connect-irc ] + [ drop 0.1 seconds sleep ] + [ listeners>> [ "#factortest" ] dip at + [ read-message drop ] [ read-message drop ] [ read-message ] tri ] + [ terminate-irc ] + } cleave ] unit-test \ No newline at end of file diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor index 813de0f57c..99922b1fb5 100644 --- a/extra/irc/client/client.factor +++ b/extra/irc/client/client.factor @@ -88,10 +88,11 @@ SYMBOL: current-irc-client : irc-stream> ( -- stream ) irc> stream>> ; : irc-write ( s -- ) irc-stream> stream-write ; : irc-print ( s -- ) irc-stream> [ stream-print ] keep stream-flush ; +: irc-send ( irc-message -- ) irc> out-messages>> mailbox-put ; : listener> ( name -- listener/f ) irc> listeners>> at ; : maybe-mailbox-get ( mailbox quot: ( irc-message -- ) -- ) - [ dup mailbox-empty? [ drop yield ] ] dip '[ mailbox-get @ ] if ; inline + [ dup mailbox-empty? [ drop 0.1 sleep ] ] dip '[ mailbox-get @ ] if ; inline GENERIC: to-listener ( message obj -- ) @@ -147,24 +148,6 @@ DEFER: me? "JOIN " irc-write [ [ " :" ] dip 3append ] when* irc-print ; -: /PART ( channel text -- ) - [ "PART " irc-write irc-write ] dip - " :" irc-write irc-print ; - -: /KICK ( channel who -- ) - [ "KICK " irc-write irc-write ] dip - " " irc-write irc-print ; - -: /PRIVMSG ( nick line -- ) - [ "PRIVMSG " irc-write irc-write ] dip - " :" irc-write irc-print ; - -: /ACTION ( nick line -- ) - [ 1 , "ACTION " % % 1 , ] "" make /PRIVMSG ; - -: /QUIT ( text -- ) - "QUIT :" irc-write irc-print ; - : /PONG ( text -- ) "PONG " irc-write irc-print ; @@ -240,10 +223,14 @@ M: kick handle-incoming-irc ( kick -- ) M: quit handle-incoming-irc ( quit -- ) [ dup prefix>> parse-name listeners-with-participant [ to-listener ] with each ] - [ prefix>> parse-name remove-participant-from-all ] [ handle-participant-change ] + [ prefix>> parse-name remove-participant-from-all ] tri ; +! FIXME: implement this +! M: mode handle-incoming-irc ( mode -- ) call-next-method ; +! M: nick handle-incoming-irc ( nick -- ) call-next-method ; + : >nick/mode ( string -- nick mode ) dup first "+@" member? [ unclip ] [ 0 ] if participant-mode ; diff --git a/extra/irc/ui/ui.factor b/extra/irc/ui/ui.factor index 662fca6d79..d899b75d8d 100755 --- a/extra/irc/ui/ui.factor +++ b/extra/irc/ui/ui.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors kernel threads combinators concurrency.mailboxes - sequences strings hashtables splitting fry assocs hashtables + sequences strings hashtables splitting fry assocs hashtables colors 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.packs ui.gadgets.labels @@ -24,14 +24,8 @@ TUPLE: irc-tab < frame listener client userlist ; : write-color ( str color -- ) foreground associate format ; -: red { 0.5 0 0 1 } ; -: green { 0 0.5 0 1 } ; -: blue { 0 0 1 1 } ; -: black { 0 0 0 1 } ; - -: colors H{ { +operator+ { 0 0.5 0 1 } } - { +voice+ { 0 0 1 1 } } - { +normal+ { 0 0 0 1 } } } ; +: dark-red T{ rgba f 0.5 0.0 0.0 1 } ; +: dark-green T{ rgba f 0.0 0.5 0.0 1 } ; : dot-or-parens ( string -- string ) dup empty? [ drop "." ] @@ -65,21 +59,21 @@ M: own-message write-irc message>> write ; M: join write-irc - "* " green write-color + "* " dark-green write-color prefix>> parse-name write - " has entered the channel." green write-color ; + " has entered the channel." dark-green write-color ; M: part write-irc - "* " red write-color + "* " dark-red write-color [ prefix>> parse-name write ] keep - " has left the channel" red write-color - trailing>> dot-or-parens red write-color ; + " has left the channel" dark-red write-color + trailing>> dot-or-parens dark-red write-color ; M: quit write-irc - "* " red write-color + "* " dark-red write-color [ prefix>> parse-name write ] keep - " has left IRC" red write-color - trailing>> dot-or-parens red write-color ; + " has left IRC" dark-red write-color + trailing>> dot-or-parens dark-red write-color ; : full-mode ( message -- mode ) parameters>> rest " " sjoin ; @@ -97,13 +91,13 @@ M: unhandled write-irc line>> blue write-color ; M: irc-end write-irc - drop "* You have left IRC" red write-color ; + drop "* You have left IRC" dark-red write-color ; M: irc-disconnected write-irc - drop "* Disconnected" red write-color ; + drop "* Disconnected" dark-red write-color ; M: irc-connected write-irc - drop "* Connected" green write-color ; + drop "* Connected" dark-green write-color ; M: irc-listener-end write-irc drop ; @@ -130,7 +124,7 @@ GENERIC: handle-inbox ( tab message -- ) : update-participants ( tab -- ) [ userlist>> [ clear-gadget ] keep ] [ listener>> participants>> ] bi - [ +operator+ green filter-participants ] + [ +operator+ dark-green filter-participants ] [ +voice+ blue filter-participants ] [ +normal+ black filter-participants ] tri drop ;