/*
  listener-scheme.cc -- Connect listeners to Scheme through Scm_listener

  source file of the GNU LilyPond music typesetter

  (c) 2005-2006 Erik Sandberg  <address@hidden>
*/

#include "listener.hh"
#include "ly-smobs.icc"
#include "stream-event.hh"

class Scm_listener
{
public:
  Scm_listener (SCM callback);
  DECLARE_LISTENER (listener);
protected:
  DECLARE_SMOBS (Scm_listener,);
private:
  SCM callback_;
};

IMPLEMENT_LISTENER (Scm_listener, listener) (Stream_event *ev)
{
  scm_call_1 (callback_, ev->self_scm ());
}

IMPLEMENT_SMOBS (Scm_listener);
IMPLEMENT_DEFAULT_EQUAL_P (Scm_listener);

Scm_listener::Scm_listener (SCM c)
{
  callback_ = SCM_EOL;
  self_scm_ = SCM_EOL;
  smobify_self ();
  callback_ = c; 
}

SCM
Scm_listener::mark_smob (SCM obj)
{
  Scm_listener *me = (Scm_listener *) SCM_CELL_WORD_1 (obj);
  return me->callback_;
}

int
Scm_listener::print_smob (SCM obj, SCM p, scm_print_state*)
{
  Scm_listener *me = (Scm_listener *) SCM_CELL_WORD_1 (obj);
  scm_puts ("#<Scm_listener ", p);
  scm_write (me->callback_, p);
  scm_puts (">", p);
  return 1;
}

Scm_listener::~Scm_listener ()
{
}

LY_DEFINE (ly_make_listener, "ly:make-listener",
	   1, 0, 0, (SCM callback),
	   "Creates a stream-event listener. Any time the listener hears\n"
	   " a @code{stream-event} object, it will call @var{callback}\n"
	   " with that object. @var{callback} should take exactly one argument." )
{
  SCM_ASSERT_TYPE (scm_procedure_p (callback), callback, SCM_ARG1, __FUNCTION__, "procedure");
  Scm_listener *l = new Scm_listener (callback);
  SCM listener = l->listener ().smobbed_copy ();
  l->unprotect ();
  return listener;
}