extra/irc/client/base/base.factor

   1 ! Copyright (C) 2009 Bruno Deferrari
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs concurrency.mailboxes io irc.client.chats
   4 irc.messages kernel namespaces sequences strings words.symbol ;
   5 IN: irc.client.base
   6
   7 SYMBOL: current-irc-client
   8
   9 : irc> ( -- irc-client ) current-irc-client get ;
  10 : stream> ( -- stream ) irc> stream>> ;
  11 : irc-print ( s -- ) stream> [ stream-print ] [ stream-flush ] bi ;
  12 : irc-send ( irc-message -- ) irc> out-messages>> mailbox-put ;
  13 : chats> ( -- seq ) irc> chats>> values ;
  14 : me? ( string -- ? ) irc> nick>> = ;
  15
  16 : with-irc ( ..a irc-client quot: ( ..a -- ..b ) -- ..b )
  17     \ current-irc-client swap with-variable ; inline
  18
  19 UNION: to-target privmsg notice ;
  20 UNION: to-channel irc.messages:join part topic kick rpl-channel-modes
  21                   topic rpl-names rpl-names-end ;
  22 UNION: to-one-chat to-target to-channel mode ;
  23 UNION: to-many-chats nick quit ;
  24 UNION: to-all-chats irc-end irc-disconnected irc-connected ;
  25 PREDICATE: to-me < to-target target>> me? ;
  26
  27 GENERIC: chat-name ( irc-message -- name )
  28 M: mode       chat-name name>> ;
  29 M: to-target  chat-name target>> ;
  30 M: to-me      chat-name sender>> ;
  31
  32 ! to-channel messages are things like JOIN
  33 ! Freenode's join looks like:
  34 ! ":flogbot2_!~flogbot2@c-50-174-221-28.hsd1.ca.comcast.net JOIN #concatenative-bots"
  35 ! The channel>> field is empty and it's in parameters instead.
  36 ! This fixes chat> for these kinds of messages.
  37 M: to-channel chat-name dup channel>> [ ] [ parameters>> ?first ] ?if ;
  38
  39 GENERIC: chat> ( obj -- chat/f )
  40 M: string      chat> irc> chats>> at ;
  41 M: symbol      chat> irc> chats>> at ;
  42 M: to-one-chat chat> chat-name +server-chat+ or chat> ;