}
LY_DEFINE (ly_add_listener, "ly:add-listener",
- 2, 0, 1, (SCM list, SCM disp, SCM cl),
- "Add the listener @var{list} to the dispatcher @var{disp}."
- " Whenever @var{disp} hears an event of class @var{cl},"
- " it is forwarded to @var{list}.")
+ 2, 0, 1, (SCM callback, SCM disp, SCM cl),
+ "Add the single-argument procedure @var{callback} as listener"
+ " to the dispatcher @var{disp}. Whenever @var{disp} hears"
+ " an event of class @var{cl}, it calls @var{callback} with it.")
{
- Listener *l = Listener::unsmob (list);
Dispatcher *d = Dispatcher::unsmob (disp);
- LY_ASSERT_SMOB (Listener, list, 1);
+ LY_ASSERT_TYPE (ly_is_procedure, callback, 1);
LY_ASSERT_SMOB (Dispatcher, disp, 2);
for (int arg = SCM_ARG3; scm_is_pair (cl); cl = scm_cdr (cl), arg++)
{
SCM sym = scm_car (cl);
SCM_ASSERT_TYPE (scm_is_symbol (sym), sym, arg, __FUNCTION__, "symbol");
- d->add_listener (*l, sym);
+ d->add_listener (callback, sym);
}
return SCM_UNSPECIFIED;
void
Dispatcher::add_listener (Listener l, SCM ev_class)
{
- internal_add_listener (l, ev_class, ++priority_count_);
+ add_listener (l.smobbed_copy (), ev_class);
+}
+
+void
+Dispatcher::add_listener (SCM callback, SCM ev_class)
+{
+ internal_add_listener (callback, ev_class, ++priority_count_);
}
inline void
-Dispatcher::internal_add_listener (Listener l, SCM ev_class, int priority)
+Dispatcher::internal_add_listener (SCM callback, SCM ev_class, int priority)
{
SCM list = scm_hashq_ref (listeners_, ev_class, SCM_EOL);
// if ev_class is not yet listened to, we go through our list of
{
int priority = scm_to_int (scm_cdar (disp));
Dispatcher *d = Dispatcher::unsmob (scm_caar (disp));
- d->internal_add_listener (GET_LISTENER (Dispatcher, dispatch), ev_class, priority);
+ d->internal_add_listener (GET_LISTENER (Dispatcher, dispatch).smobbed_copy (),
+ ev_class, priority);
}
listen_classes_ = scm_cons (ev_class, listen_classes_);
}
- SCM entry = scm_cons (scm_from_int (priority), l.smobbed_copy ());
+ SCM entry = scm_cons (scm_from_int (priority), callback);
list = scm_merge (list, scm_list_1 (entry), ly_lily_module_constant ("car<"));
scm_hashq_set_x (listeners_, ev_class, list);
}
dispatchers_ = scm_acons (disp->self_scm (), scm_from_int (priority), dispatchers_);
- Listener list = GET_LISTENER (Dispatcher, dispatch);
+ SCM list = GET_LISTENER (Dispatcher, dispatch).smobbed_copy ();
for (SCM cl = listen_classes_; scm_is_pair (cl); cl = scm_cdr (cl))
{
disp->internal_add_listener (list, scm_car (cl), priority);
/* priority counter. Listeners with low priority receive events
first. */
int priority_count_;
- void internal_add_listener (Listener, SCM event_class, int priority);
+ void internal_add_listener (SCM callback, SCM event_class, int priority);
public:
Dispatcher ();
void broadcast (Stream_event *ev);
bool is_listened_class (SCM);
SCM listened_types ();
void add_listener (Listener, SCM event_class);
+ void add_listener (SCM callback, SCM event_class);
void remove_listener (Listener, SCM event_class);
void register_as_listener (Dispatcher *dist);
void unregister_as_listener (Dispatcher *dist);
void init_from_scheme (SCM definition);
TRANSLATOR_DECLARATIONS_NO_LISTENER (Scheme_engraver);
- static Listener get_listener (void *generic_arg, SCM event);
+ static Listener tlr_get_listener (void *generic_arg, SCM event);
protected:
~Scheme_engraver ();
+++ /dev/null
-/*
- This file is part of LilyPond, the GNU music typesetter.
-
- Copyright (C) 2006--2015 Erik Sandberg <mandolaerik@gmail.com>
-
- LilyPond is free software: you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
-
- LilyPond is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
-*/
-
-#ifndef SCHEME_LISTENER_HH
-#define SCHEME_LISTENER_HH
-
-#include "listener.hh"
-
-/*
- Scheme_listener is only used internally by scheme-listener-scheme.cc
-*/
-
-class Scheme_listener : public Smob<Scheme_listener>
-{
-public:
- int print_smob (SCM, scm_print_state *);
- SCM mark_smob ();
- virtual ~Scheme_listener ();
- Scheme_listener (SCM callback);
- void call (SCM);
-private:
- SCM callback_;
-};
-
-#endif /* SCHEME_LISTENER_HH */
translator_listener_record *rec = new translator_listener_record;
*tail = rec;
rec->event_class_ = event_class;
- rec->get_listener_ = &Scheme_engraver::get_listener;
+ rec->get_listener_ = &Scheme_engraver::tlr_get_listener;
tail = &rec->next_;
}
/* static */
Listener
-Scheme_engraver::get_listener (void *arg, SCM name)
+Scheme_engraver::tlr_get_listener (void *arg, SCM name)
{
Scheme_engraver *me = (Scheme_engraver *) arg;
SCM func = ly_assoc_get (name, me->listeners_alist_, SCM_BOOL_F);
+++ /dev/null
-/*
- This file is part of LilyPond, the GNU music typesetter.
-
- Copyright (C) 2006--2015 Erik Sandberg <mandolaerik@gmail.com>
-
- LilyPond is free software: you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
-
- LilyPond is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
-*/
-
-#include "scheme-listener.hh"
-
-LY_DEFINE (ly_make_listener, "ly:make-listener",
- 1, 0, 0, (SCM callback),
- "Create a listener. Any time the listener hears an object,"
- " it will call @var{callback} with that object.\n"
- "\n"
- "@var{callback} should take exactly one argument.")
-{
- LY_ASSERT_TYPE (ly_is_procedure, callback, 1);
- Scheme_listener *l = new Scheme_listener (callback);
- SCM listener = l->GET_LISTENER (Scheme_listener, call).smobbed_copy ();
- l->unprotect ();
- return listener;
-}
+++ /dev/null
-/*
- This file is part of LilyPond, the GNU music typesetter.
-
- Copyright (C) 2006--2015 Erik Sandberg <mandolaerik@gmail.com>
-
- LilyPond is free software: you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
-
- LilyPond is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
-*/
-
-#include "scheme-listener.hh"
-
-void
-Scheme_listener::call (SCM ev)
-{
- scm_call_1 (callback_, ev);
-}
-
-
-Scheme_listener::Scheme_listener (SCM c)
-{
- callback_ = SCM_EOL;
- smobify_self ();
- callback_ = c;
-}
-
-SCM
-Scheme_listener::mark_smob ()
-{
- return callback_;
-}
-
-int
-Scheme_listener::print_smob (SCM p, scm_print_state *)
-{
- scm_puts ("#<Scheme_listener ", p);
- scm_write (callback_, p);
- scm_puts (">", p);
- return 1;
-}
-
-Scheme_listener::~Scheme_listener ()
-{
-}
((context-list '())
(now-mom (ly:make-moment 0 0))
(global (ly:make-global-context odef))
- (mom-listener (ly:make-listener
- (lambda (tev) (set! now-mom (ly:event-property tev 'moment)))))
+ (mom-listener (lambda (tev) (set! now-mom (ly:event-property tev 'moment))))
(new-context-listener
- (ly:make-listener
- (lambda (sev)
- (let*
- ((child (ly:event-property sev 'context))
- (this-moment-list (cons (ly:context-id child) '()))
- (dummy (set! context-list (cons this-moment-list context-list)))
- (acc '())
- (accumulate-event-listener
- (ly:make-listener (lambda (ev)
- (set! acc (cons (cons ev #t) acc)))))
- (save-acc-listener
- (ly:make-listener (lambda (tev)
- (if (pair? acc)
- (let ((this-moment
- (cons (cons now-mom
- (ly:context-property child 'instrumentTransposition))
- ;; The accumulate-event-listener above creates
- ;; the list of events in reverse order, so we
- ;; have to revert it to the original order again
- (reverse acc))))
- (set-cdr! this-moment-list
- (cons this-moment (cdr this-moment-list)))
- (set! acc '())))))))
- (ly:add-listener accumulate-event-listener
- (ly:context-event-source child) 'StreamEvent)
- (ly:add-listener save-acc-listener
- (ly:context-event-source global) 'OneTimeStep))))))
+ (lambda (sev)
+ (let*
+ ((child (ly:event-property sev 'context))
+ (this-moment-list (cons (ly:context-id child) '()))
+ (dummy (set! context-list (cons this-moment-list context-list)))
+ (acc '())
+ (accumulate-event-listener
+ (lambda (ev)
+ (set! acc (cons (cons ev #t) acc))))
+ (save-acc-listener
+ (lambda (tev)
+ (if (pair? acc)
+ (let ((this-moment
+ (cons (cons now-mom
+ (ly:context-property child 'instrumentTransposition))
+ ;; The accumulate-event-listener above creates
+ ;; the list of events in reverse order, so we
+ ;; have to revert it to the original order again
+ (reverse acc))))
+ (set-cdr! this-moment-list
+ (cons this-moment (cdr this-moment-list)))
+ (set! acc '()))))))
+ (ly:add-listener accumulate-event-listener
+ (ly:context-event-source child) 'StreamEvent)
+ (ly:add-listener save-acc-listener
+ (ly:context-event-source global) 'OneTimeStep)))))
(ly:add-listener new-context-listener
(ly:context-events-below global) 'AnnounceNewContext)
(ly:add-listener mom-listener (ly:context-event-source global) 'Prepare)
;;;; You should have received a copy of the GNU General Public License
;;;; along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
+(define-public (ly:make-listener callback)
+ "This is a compatibility wrapper for creating a \"listener\" for use
+with @code{ly:add-listener} from a @var{callback} taking a single
+argument. Since listeners are equivalent to callbacks, this is no
+longer needed."
+ callback)
(define-public (Measure_counter_engraver context)
"This engraver numbers ranges of measures, which is useful in parts as an
projects / lilypond.git / commitdiff