extra/irc/client/base/base.factor

   1 ! Copyright (C) 2009 Bruno Deferrari
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs concurrency.mailboxes io kernel namespaces
   4 strings words.symbol irc.client.chats irc.messages ;
   5 EXCLUDE: sequences => join ;
   6 IN: irc.client.base
   7
   8 SYMBOL: current-irc-client
   9
  10 : irc> ( -- irc-client ) current-irc-client get ;
  11 : stream> ( -- stream ) irc> stream>> ;
  12 : irc-print ( s -- ) stream> [ stream-print ] [ stream-flush ] bi ;
  13 : irc-send ( irc-message -- ) irc> out-messages>> mailbox-put ;
  14 : chats> ( -- seq ) irc> chats>> values ;
  15 : me? ( string -- ? ) irc> nick>> = ;
  16
  17 : with-irc ( irc-client quot: ( -- ) -- )
  18     \ current-irc-client swap with-variable ; inline
  19
  20 UNION: to-target privmsg notice ;
  21 UNION: to-channel join part topic kick rpl-channel-modes
  22                   rpl-notopic rpl-topic rpl-names rpl-names-end ;
  23 UNION: to-one-chat to-target to-channel mode ;
  24 UNION: to-many-chats nick quit ;
  25 UNION: to-all-chats irc-end irc-disconnected irc-connected ;
  26 PREDICATE: to-me < to-target target>> me? ;
  27
  28 GENERIC: chat-name ( irc-message -- name )
  29 M: mode       chat-name name>> ;
  30 M: to-target  chat-name target>> ;
  31 M: to-me      chat-name sender>> ;
  32 M: to-channel chat-name channel>> ;
  33
  34 GENERIC: chat> ( obj -- chat/f )
  35 M: string      chat> irc> chats>> at ;
  36 M: symbol      chat> irc> chats>> at ;
  37 M: to-one-chat chat> chat-name +server-chat+ or chat> ;