From 9a84cfe6568f41d03d70d4dbe3eff1f78c1787eb Mon Sep 17 00:00:00 2001
From: Bruno Deferrari <utizoc@gmail.com>
Date: Fri, 1 Aug 2008 19:59:18 -0300
Subject: [PATCH 1/2] irc.client: Fix user quit notification
---
extra/irc/client/client-tests.factor | 17 ++++++++++++++++-
extra/irc/client/client.factor | 27 +++++++--------------------
2 files changed, 23 insertions(+), 21 deletions(-)
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" [ <irc-channel-listener>
+ 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 ;
From 710bc04b6ff9040887f0c5b7ec757da0e29d9cf5 Mon Sep 17 00:00:00 2001
From: William Schlieper <schlieper@unc.edu>
Date: Sat, 2 Aug 2008 15:54:02 -0400
Subject: [PATCH 2/2] irc.ui: Fixed color bugs
---
extra/irc/ui/ui.factor | 36 +++++++++++++++---------------------
1 file changed, 15 insertions(+), 21 deletions(-)
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 ;