From ddf16c06708c5387ef8f49d8eeca194cd7217649 Mon Sep 17 00:00:00 2001 From: David Kastrup Date: Tue, 28 Apr 2015 18:39:57 +0200 Subject: [PATCH] Issue 4357/5: Remove Scheme listeners as they are just callbacks now. --- lily/dispatcher-scheme.cc | 13 ++++---- lily/dispatcher.cc | 17 +++++++--- lily/include/dispatcher.hh | 3 +- lily/include/scheme-engraver.hh | 2 +- lily/include/scheme-listener.hh | 41 ------------------------ lily/scheme-engraver.cc | 4 +-- lily/scheme-listener-scheme.cc | 34 -------------------- lily/scheme-listener.cc | 53 ------------------------------- scm/part-combiner.scm | 56 ++++++++++++++++----------------- scm/scheme-engravers.scm | 6 ++++ 10 files changed, 56 insertions(+), 173 deletions(-) delete mode 100644 lily/include/scheme-listener.hh delete mode 100644 lily/scheme-listener-scheme.cc delete mode 100644 lily/scheme-listener.cc diff --git a/lily/dispatcher-scheme.cc b/lily/dispatcher-scheme.cc index fdb27251a2..61674b3c75 100644 --- a/lily/dispatcher-scheme.cc +++ b/lily/dispatcher-scheme.cc @@ -42,22 +42,21 @@ LY_DEFINE (ly_connect_dispatchers, "ly:connect-dispatchers", } 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; diff --git a/lily/dispatcher.cc b/lily/dispatcher.cc index 2d18b393ad..7f6e0cb70b 100644 --- a/lily/dispatcher.cc +++ b/lily/dispatcher.cc @@ -206,11 +206,17 @@ Dispatcher::broadcast (Stream_event *ev) 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 @@ -229,11 +235,12 @@ Dispatcher::internal_add_listener (Listener l, SCM ev_class, int priority) { 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); } @@ -299,7 +306,7 @@ Dispatcher::register_as_listener (Dispatcher *disp) 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); diff --git a/lily/include/dispatcher.hh b/lily/include/dispatcher.hh index 5ce2081d97..f7efad8214 100644 --- a/lily/include/dispatcher.hh +++ b/lily/include/dispatcher.hh @@ -42,13 +42,14 @@ private: /* 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); diff --git a/lily/include/scheme-engraver.hh b/lily/include/scheme-engraver.hh index ec3d0756d9..9b9db00317 100644 --- a/lily/include/scheme-engraver.hh +++ b/lily/include/scheme-engraver.hh @@ -30,7 +30,7 @@ public: 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 (); diff --git a/lily/include/scheme-listener.hh b/lily/include/scheme-listener.hh deleted file mode 100644 index fecc95d508..0000000000 --- a/lily/include/scheme-listener.hh +++ /dev/null @@ -1,41 +0,0 @@ -/* - This file is part of LilyPond, the GNU music typesetter. - - Copyright (C) 2006--2015 Erik Sandberg - - 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 . -*/ - -#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 -{ -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 */ diff --git a/lily/scheme-engraver.cc b/lily/scheme-engraver.cc index 5ab14ce414..6762c753c9 100644 --- a/lily/scheme-engraver.cc +++ b/lily/scheme-engraver.cc @@ -105,7 +105,7 @@ Scheme_engraver::init_from_scheme (SCM definition) 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_; } @@ -173,7 +173,7 @@ Scheme_engraver::acknowledge_grob_by_hash (Grob_info info, /* 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); diff --git a/lily/scheme-listener-scheme.cc b/lily/scheme-listener-scheme.cc deleted file mode 100644 index 730c075c59..0000000000 --- a/lily/scheme-listener-scheme.cc +++ /dev/null @@ -1,34 +0,0 @@ -/* - This file is part of LilyPond, the GNU music typesetter. - - Copyright (C) 2006--2015 Erik Sandberg - - 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 . -*/ - -#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; -} diff --git a/lily/scheme-listener.cc b/lily/scheme-listener.cc deleted file mode 100644 index 32c3dd1e63..0000000000 --- a/lily/scheme-listener.cc +++ /dev/null @@ -1,53 +0,0 @@ -/* - This file is part of LilyPond, the GNU music typesetter. - - Copyright (C) 2006--2015 Erik Sandberg - - 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 . -*/ - -#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 ("#", p); - return 1; -} - -Scheme_listener::~Scheme_listener () -{ -} diff --git a/scm/part-combiner.scm b/scm/part-combiner.scm index 7278b29e3c..a2ebda492c 100644 --- a/scm/part-combiner.scm +++ b/scm/part-combiner.scm @@ -257,36 +257,34 @@ LilyPond version 2.8 and earlier." ((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) diff --git a/scm/scheme-engravers.scm b/scm/scheme-engravers.scm index ccb1fb5b0d..3311ebb7a3 100644 --- a/scm/scheme-engravers.scm +++ b/scm/scheme-engravers.scm @@ -15,6 +15,12 @@ ;;;; You should have received a copy of the GNU General Public License ;;;; along with LilyPond. If not, see . +(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 -- 2.39.5