Merge branch 'master' of git://tiodante.com/git/factor
U-WSCHLIEP-PC\wschliep
commit
e8dfa79ab0
extra/irc
|
|
@ -1,4 +1,4 @@
|
|||
USING: help.markup help.syntax quotations kernel ;
|
||||
USING: help.markup help.syntax quotations kernel irc.messages ;
|
||||
IN: irc.client
|
||||
|
||||
HELP: irc-client "IRC Client object"
|
||||
|
|
|
|||
|
|
@ -1,9 +1,11 @@
|
|||
! Copyright (C) 2008 Bruno Deferrari, Doug Coleman, Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: combinators concurrency.mailboxes fry io strings
|
||||
io.encodings.8-bit io.sockets kernel namespaces sequences
|
||||
splitting threads calendar classes.tuple
|
||||
classes ascii assocs accessors destructors continuations ;
|
||||
USING: concurrency.mailboxes kernel io.sockets io.encodings.8-bit calendar
|
||||
accessors destructors namespaces io assocs arrays qualified fry
|
||||
continuations threads strings classes combinators
|
||||
irc.messages irc.messages.private ;
|
||||
RENAME: join sequences => sjoin
|
||||
EXCLUDE: sequences => join ;
|
||||
IN: irc.client
|
||||
|
||||
! ======================================
|
||||
|
|
@ -27,6 +29,7 @@ TUPLE: irc-listener in-messages out-messages ;
|
|||
TUPLE: irc-server-listener < irc-listener ;
|
||||
TUPLE: irc-channel-listener < irc-listener name password timeout ;
|
||||
TUPLE: irc-nick-listener < irc-listener name ;
|
||||
SYMBOL: +server-listener+
|
||||
|
||||
: <irc-listener> ( -- irc-listener ) <mailbox> <mailbox> irc-listener boa ;
|
||||
|
||||
|
|
@ -48,20 +51,6 @@ SINGLETON: irc-disconnected ! sent when connection is lost
|
|||
SINGLETON: irc-connected ! sent when connection is established
|
||||
UNION: irc-broadcasted-message irc-end irc-disconnected irc-connected ;
|
||||
|
||||
TUPLE: irc-message line prefix command parameters trailing timestamp ;
|
||||
TUPLE: logged-in < irc-message name ;
|
||||
TUPLE: ping < irc-message ;
|
||||
TUPLE: join < irc-message ;
|
||||
TUPLE: part < irc-message channel ;
|
||||
TUPLE: quit < irc-message ;
|
||||
TUPLE: privmsg < irc-message name ;
|
||||
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: unhandled < irc-message ;
|
||||
|
||||
: terminate-irc ( irc-client -- )
|
||||
[ in-messages>> irc-end swap mailbox-put ]
|
||||
[ f >>is-running drop ]
|
||||
|
|
@ -82,13 +71,21 @@ TUPLE: unhandled < irc-message ;
|
|||
: unregister-listener ( name -- ) irc> listeners>> delete-at ;
|
||||
|
||||
: to-listener ( message name -- )
|
||||
listener> [ f listener> ] unless*
|
||||
listener> [ +server-listener+ listener> ] unless*
|
||||
[ in-messages>> mailbox-put ] [ drop ] if* ;
|
||||
|
||||
! ======================================
|
||||
! IRC client messages
|
||||
! ======================================
|
||||
|
||||
GENERIC: irc-message>string ( irc-message -- string )
|
||||
|
||||
M: irc-message irc-message>string ( irc-message -- string )
|
||||
[ command>> ]
|
||||
[ parameters>> " " sjoin ]
|
||||
[ trailing>> dup [ CHAR: : prefix ] when ]
|
||||
tri 3array " " sjoin ;
|
||||
|
||||
: /NICK ( nick -- )
|
||||
"NICK " irc-write irc-print ;
|
||||
|
||||
|
|
@ -125,53 +122,6 @@ TUPLE: unhandled < irc-message ;
|
|||
: /PONG ( text -- )
|
||||
"PONG " irc-write irc-print ;
|
||||
|
||||
! ======================================
|
||||
! Message parsing
|
||||
! ======================================
|
||||
|
||||
: split-at-first ( seq separators -- before after )
|
||||
dupd '[ , member? ] find
|
||||
[ cut 1 tail ]
|
||||
[ swap ]
|
||||
if ;
|
||||
|
||||
: remove-heading-: ( seq -- seq ) dup ":" head? [ 1 tail ] when ;
|
||||
|
||||
: parse-name ( string -- string )
|
||||
remove-heading-: "!" split-at-first drop ;
|
||||
|
||||
: split-prefix ( string -- string/f string )
|
||||
dup ":" head?
|
||||
[ remove-heading-: " " split1 ]
|
||||
[ f swap ]
|
||||
if ;
|
||||
|
||||
: split-trailing ( string -- string string/f )
|
||||
":" split1 ;
|
||||
|
||||
: string>irc-message ( string -- object )
|
||||
dup split-prefix split-trailing
|
||||
[ [ blank? ] trim " " split unclip swap ] dip
|
||||
now irc-message boa ;
|
||||
|
||||
: parse-irc-line ( string -- message )
|
||||
string>irc-message
|
||||
dup command>> {
|
||||
{ "PING" [ \ ping ] }
|
||||
{ "NOTICE" [ \ notice ] }
|
||||
{ "001" [ \ logged-in ] }
|
||||
{ "433" [ \ nick-in-use ] }
|
||||
{ "JOIN" [ \ join ] }
|
||||
{ "PART" [ \ part ] }
|
||||
{ "PRIVMSG" [ \ privmsg ] }
|
||||
{ "QUIT" [ \ quit ] }
|
||||
{ "MODE" [ \ mode ] }
|
||||
{ "KICK" [ \ kick ] }
|
||||
[ drop \ unhandled ]
|
||||
} case
|
||||
[ [ tuple-slots ] [ parameters>> ] bi append ] dip
|
||||
[ all-slots length head ] keep slots>tuple ;
|
||||
|
||||
! ======================================
|
||||
! Server message handling
|
||||
! ======================================
|
||||
|
|
@ -188,7 +138,7 @@ TUPLE: unhandled < irc-message ;
|
|||
GENERIC: handle-incoming-irc ( irc-message -- )
|
||||
|
||||
M: irc-message handle-incoming-irc ( irc-message -- )
|
||||
f listener> [ in-messages>> mailbox-put ] [ drop ] if* ;
|
||||
+server-listener+ listener> [ in-messages>> mailbox-put ] [ drop ] if* ;
|
||||
|
||||
M: logged-in handle-incoming-irc ( logged-in -- )
|
||||
name>> irc> profile>> (>>nickname) ;
|
||||
|
|
@ -203,8 +153,10 @@ M: privmsg handle-incoming-irc ( privmsg -- )
|
|||
dup irc-message-origin to-listener ;
|
||||
|
||||
M: join handle-incoming-irc ( join -- )
|
||||
dup trailing>> listener>
|
||||
[ irc> join-messages>> ] unless* mailbox-put ;
|
||||
[ [ prefix>> parse-name me? ] keep and
|
||||
[ irc> join-messages>> mailbox-put ] when* ]
|
||||
[ dup channel>> to-listener ]
|
||||
bi ;
|
||||
|
||||
M: part handle-incoming-irc ( part -- )
|
||||
dup channel>> to-listener ;
|
||||
|
|
@ -222,11 +174,14 @@ M: irc-broadcasted-message handle-incoming-irc ( irc-broadcasted-message -- )
|
|||
|
||||
GENERIC: handle-outgoing-irc ( obj -- )
|
||||
|
||||
! M: irc-message handle-outgoing-irc ( irc-message -- )
|
||||
! irc-message>string irc-print ;
|
||||
|
||||
M: privmsg handle-outgoing-irc ( privmsg -- )
|
||||
[ name>> ] [ trailing>> ] bi /PRIVMSG ;
|
||||
[ name>> ] [ trailing>> ] bi /PRIVMSG ;
|
||||
|
||||
M: part handle-outgoing-irc ( privmsg -- )
|
||||
[ channel>> ] [ trailing>> "" or ] bi /PART ;
|
||||
[ channel>> ] [ trailing>> "" or ] bi /PART ;
|
||||
|
||||
! ======================================
|
||||
! Reader/Writer
|
||||
|
|
@ -320,7 +275,7 @@ M: irc-nick-listener (add-listener) ( irc-nick-listener -- )
|
|||
[ name>> ] keep set+run-listener ;
|
||||
|
||||
M: irc-server-listener (add-listener) ( irc-server-listener -- )
|
||||
f swap set+run-listener ;
|
||||
+server-listener+ swap set+run-listener ;
|
||||
|
||||
GENERIC: (remove-listener) ( irc-listener -- )
|
||||
|
||||
|
|
@ -333,7 +288,7 @@ M: irc-channel-listener (remove-listener) ( irc-channel-listener -- )
|
|||
name>> unregister-listener ;
|
||||
|
||||
M: irc-server-listener (remove-listener) ( irc-server-listener -- )
|
||||
drop f unregister-listener ;
|
||||
drop +server-listener+ unregister-listener ;
|
||||
|
||||
: (connect-irc) ( irc-client -- )
|
||||
[ profile>> [ server>> ] [ port>> ] bi /CONNECT ] keep
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Bruno Deferrari
|
||||
|
|
@ -0,0 +1,69 @@
|
|||
! Copyright (C) 2008 Bruno Deferrari
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel fry sequences splitting ascii calendar accessors combinators
|
||||
classes.tuple math.order ;
|
||||
IN: irc.messages
|
||||
|
||||
TUPLE: irc-message line prefix command parameters trailing timestamp ;
|
||||
TUPLE: logged-in < irc-message name ;
|
||||
TUPLE: ping < irc-message ;
|
||||
TUPLE: join < irc-message channel ;
|
||||
TUPLE: part < irc-message channel ;
|
||||
TUPLE: quit < irc-message ;
|
||||
TUPLE: privmsg < irc-message name ;
|
||||
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: unhandled < irc-message ;
|
||||
|
||||
<PRIVATE
|
||||
! ======================================
|
||||
! Message parsing
|
||||
! ======================================
|
||||
|
||||
: split-at-first ( seq separators -- before after )
|
||||
dupd '[ , member? ] find
|
||||
[ cut 1 tail ]
|
||||
[ swap ]
|
||||
if ;
|
||||
|
||||
: remove-heading-: ( seq -- seq ) dup ":" head? [ 1 tail ] when ;
|
||||
|
||||
: parse-name ( string -- string )
|
||||
remove-heading-: "!" split-at-first drop ;
|
||||
|
||||
: split-prefix ( string -- string/f string )
|
||||
dup ":" head?
|
||||
[ remove-heading-: " " split1 ]
|
||||
[ f swap ]
|
||||
if ;
|
||||
|
||||
: split-trailing ( string -- string string/f )
|
||||
":" split1 ;
|
||||
|
||||
: string>irc-message ( string -- object )
|
||||
dup split-prefix split-trailing
|
||||
[ [ blank? ] trim " " split unclip swap ] dip
|
||||
now irc-message boa ;
|
||||
|
||||
: parse-irc-line ( string -- message )
|
||||
string>irc-message
|
||||
dup command>> {
|
||||
{ "PING" [ \ ping ] }
|
||||
{ "NOTICE" [ \ notice ] }
|
||||
{ "001" [ \ logged-in ] }
|
||||
{ "433" [ \ nick-in-use ] }
|
||||
{ "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 ;
|
||||
|
||||
PRIVATE>
|
||||
Loading…
Reference in New Issue