Merge branch 'master' of git://factorforge.org/git/william42
commit
6027c02fac
|
@ -169,6 +169,20 @@ M: mb-writer dispose drop ;
|
|||
] unit-test
|
||||
] with-irc
|
||||
|
||||
[ { H{ { "factorbot" +operator+ } { "ircuser" +normal+ } } } [
|
||||
"#factortest" <irc-channel-chat>
|
||||
H{ { "ircuser" +normal+ } } clone >>participants
|
||||
[ %add-named-chat ] keep
|
||||
":ircserver.net 353 factorbot @ #factortest :@factorbot " %push-line
|
||||
":ircserver.net 353 factorbot @ #factortest :ircuser2 " %push-line
|
||||
":ircserver.net 366 factorbot #factortest :End of /NAMES list." %push-line
|
||||
":ircserver.net 353 factorbot @ #factortest :@factorbot " %push-line
|
||||
":ircserver.net 353 factorbot @ #factortest :ircuser " %push-line
|
||||
":ircserver.net 366 factorbot #factortest :End of /NAMES list." %push-line
|
||||
participants>>
|
||||
] unit-test
|
||||
] with-irc
|
||||
|
||||
! Namelist change notification
|
||||
[ { T{ participant-changed f f f f } } [
|
||||
"#factortest" <irc-channel-chat> [ %add-named-chat ] keep
|
||||
|
@ -195,3 +209,11 @@ M: mb-writer dispose drop ;
|
|||
[ participant-changed? ] read-matching-message
|
||||
] unit-test
|
||||
] with-irc
|
||||
|
||||
! Mode change
|
||||
[ { T{ participant-changed f "ircuser" +mode+ "+o" } } [
|
||||
"#factortest" <irc-channel-chat> [ %add-named-chat ] keep
|
||||
":ircserver.net MODE #factortest +o ircuser" %push-line
|
||||
[ participant-changed? ] read-matching-message
|
||||
] unit-test
|
||||
] with-irc
|
||||
|
|
|
@ -32,7 +32,7 @@ TUPLE: irc-client profile stream in-messages out-messages
|
|||
|
||||
TUPLE: irc-chat in-messages client ;
|
||||
TUPLE: irc-server-chat < irc-chat ;
|
||||
TUPLE: irc-channel-chat < irc-chat name password timeout participants ;
|
||||
TUPLE: irc-channel-chat < irc-chat name password timeout participants clean-participants ;
|
||||
TUPLE: irc-nick-chat < irc-chat name ;
|
||||
SYMBOL: +server-chat+
|
||||
|
||||
|
@ -55,7 +55,7 @@ SYMBOL: +nick+
|
|||
<mailbox> f irc-server-chat boa ;
|
||||
|
||||
: <irc-channel-chat> ( name -- irc-channel-chat )
|
||||
[ <mailbox> f ] dip f 60 seconds H{ } clone
|
||||
[ <mailbox> f ] dip f 60 seconds H{ } clone t
|
||||
irc-channel-chat boa ;
|
||||
|
||||
: <irc-nick-chat> ( name -- irc-nick-chat )
|
||||
|
@ -148,7 +148,9 @@ M: irc-chat to-chat in-messages>> mailbox-put ;
|
|||
: change-participant-mode ( channel mode nick -- )
|
||||
rot chat>
|
||||
[ participants>> set-at ]
|
||||
[ [ [ +mode+ ] dip <participant-changed> ] dip to-chat ] 3bi ; ! FIXME
|
||||
[ [ participant-changed new
|
||||
[ (>>nick) ] [ (>>parameter) ] [ +mode+ >>action ] tri ] dip to-chat ]
|
||||
3bi ; ! FIXME
|
||||
|
||||
DEFER: me?
|
||||
|
||||
|
@ -208,7 +210,7 @@ M: broadcast-forward forward-message
|
|||
GENERIC: process-message ( irc-message -- )
|
||||
M: object process-message drop ;
|
||||
M: logged-in process-message
|
||||
name>> f irc> [ (>>is-ready) ] [ (>>nick) ] [ chats>> ] tri
|
||||
name>> t irc> [ (>>is-ready) ] [ (>>nick) ] [ chats>> ] tri
|
||||
values [ initialize-chat ] each ;
|
||||
M: ping process-message trailing>> /PONG ;
|
||||
M: nick-in-use process-message name>> "_" append /NICK ;
|
||||
|
@ -231,11 +233,11 @@ M: quit process-message
|
|||
M: nick process-message
|
||||
[ 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* ;
|
||||
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 ;
|
||||
|
@ -244,12 +246,24 @@ M: nick process-message
|
|||
trailing>> [ blank? ] trim " " split
|
||||
[ >nick/mode 2array ] map >hashtable ;
|
||||
|
||||
: maybe-clean-participants ( channel-chat -- )
|
||||
dup clean-participants>> [
|
||||
H{ } clone >>participants f >>clean-participants
|
||||
] when drop ;
|
||||
|
||||
M: names-reply process-message
|
||||
[ names-reply>participants ] [ channel>> chat> ] bi [
|
||||
[ (>>participants) ]
|
||||
[ [ f f f <participant-changed> ] dip name>> to-chat ] bi
|
||||
[ maybe-clean-participants ]
|
||||
[ participants>> 2array assoc-combine ]
|
||||
[ (>>participants) ] tri
|
||||
] [ drop ] if* ;
|
||||
|
||||
M: end-of-names process-message
|
||||
channel>> chat> [
|
||||
t >>clean-participants
|
||||
[ f f f <participant-changed> ] dip name>> to-chat
|
||||
] when* ;
|
||||
|
||||
! ======================================
|
||||
! Client message handling
|
||||
! ======================================
|
||||
|
|
|
@ -20,6 +20,7 @@ TUPLE: nick-in-use < irc-message name ;
|
|||
TUPLE: notice < irc-message type ;
|
||||
TUPLE: mode < irc-message name mode parameter ;
|
||||
TUPLE: names-reply < irc-message who channel ;
|
||||
TUPLE: end-of-names < irc-message who channel ;
|
||||
TUPLE: unhandled < irc-message ;
|
||||
|
||||
: <irc-client-message> ( command parameters trailing -- irc-message )
|
||||
|
@ -85,6 +86,9 @@ M: nick-in-use >>command-parameters ( nick-in-use params -- nick-in-use )
|
|||
M: names-reply >>command-parameters ( names-reply params -- names-reply )
|
||||
first3 nip [ >>who ] [ >>channel ] bi* ;
|
||||
|
||||
M: end-of-names >>command-parameters ( names-reply params -- names-reply )
|
||||
first2 [ >>who ] [ >>channel ] bi* ;
|
||||
|
||||
M: mode >>command-parameters ( mode params -- mode )
|
||||
dup length 3 = [
|
||||
first3 [ >>name ] [ >>mode ] [ >>parameter ] tri*
|
||||
|
@ -159,6 +163,7 @@ M: sender-in-prefix irc-message-sender ( sender-in-prefix -- sender )
|
|||
{ "001" [ logged-in ] }
|
||||
{ "433" [ nick-in-use ] }
|
||||
{ "353" [ names-reply ] }
|
||||
{ "366" [ end-of-names ] }
|
||||
{ "JOIN" [ join ] }
|
||||
{ "PART" [ part ] }
|
||||
{ "NICK" [ nick ] }
|
||||
|
|
|
@ -1,7 +1,8 @@
|
|||
! Copyright (C) 2008 William Schlieper
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
|
||||
USING: accessors kernel arrays irc.client irc.messages irc.ui namespaces ;
|
||||
USING: accessors kernel sequences arrays irc.client
|
||||
irc.messages irc.ui namespaces ;
|
||||
|
||||
IN: irc.ui.commands
|
||||
|
||||
|
@ -10,6 +11,9 @@ IN: irc.ui.commands
|
|||
[ window>> client>> profile>> nickname>> <own-message> print-irc ]
|
||||
[ chat>> speak ] 2bi ;
|
||||
|
||||
: me ( string -- ) ! Placeholder until I make /me look different
|
||||
"ACTION " 1 prefix prepend 1 suffix say ;
|
||||
|
||||
: join ( string -- )
|
||||
irc-tab get window>> join-channel ;
|
||||
|
||||
|
|
|
@ -12,9 +12,9 @@ TUPLE: tabbed < frame names toggler content ;
|
|||
|
||||
DEFER: (del-page)
|
||||
|
||||
:: add-toggle ( model n name toggler -- )
|
||||
:: add-toggle ( n name model toggler -- )
|
||||
<frame>
|
||||
n name toggler parent>> '[ _ _ _ (del-page) ] "X" swap <bevel-button>
|
||||
n name toggler parent>> '[ drop _ _ _ (del-page) ] "X" swap <bevel-button>
|
||||
@right grid-add
|
||||
n model name <toggle-button> @center grid-add
|
||||
toggler swap add-gadget drop ;
|
||||
|
@ -23,7 +23,7 @@ DEFER: (del-page)
|
|||
[ names>> ] [ model>> ] [ toggler>> ] tri
|
||||
[ clear-gadget ] keep
|
||||
[ [ length ] keep ] 2dip
|
||||
'[ [ _ ] 2dip _ add-toggle ] 2each ;
|
||||
'[ _ _ add-toggle ] 2each ;
|
||||
|
||||
: refresh-book ( tabbed -- )
|
||||
model>> [ ] change-model ;
|
||||
|
@ -39,8 +39,8 @@ DEFER: (del-page)
|
|||
|
||||
: add-page ( page name tabbed -- )
|
||||
[ names>> push ] 2keep
|
||||
[ [ model>> swap ]
|
||||
[ names>> length 1 - swap ]
|
||||
[ [ names>> length 1 - swap ]
|
||||
[ model>> ]
|
||||
[ toggler>> ] tri add-toggle ]
|
||||
[ content>> swap add-gadget drop ]
|
||||
[ refresh-book ] tri ;
|
||||
|
|
Loading…
Reference in New Issue