X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Fscheme-engraver.cc;h=ec4197641bfcba78386ee3b11c9becd6e24cf762;hb=629a98d913218597d04dfc3c41154e7ff2c76582;hp=476f6d4dea610e2efb532373884047d77917bd8e;hpb=a6bd229f7fe1dc4a03478e14ccc0c0c66b225061;p=lilypond.git diff --git a/lily/scheme-engraver.cc b/lily/scheme-engraver.cc index 476f6d4dea..ec4197641b 100644 --- a/lily/scheme-engraver.cc +++ b/lily/scheme-engraver.cc @@ -1,9 +1,9 @@ -/* +/* scheme-engraver.cc -- implement Scheme_engraver - + source file of the GNU LilyPond music typesetter - - Copyright (c) 2009--2010 Han-Wen Nienhuys + + Copyright (c) 2009--2015 Han-Wen Nienhuys LilyPond is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -16,7 +16,7 @@ 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 . + along with LilyPond. If not, see . */ #include "scheme-engraver.hh" @@ -25,7 +25,7 @@ #include "translator.icc" -Scheme_engraver::Scheme_engraver () +Scheme_engraver::Scheme_engraver (SCM definition) { stop_translation_timestep_function_ = SCM_EOL; start_translation_timestep_function_ = SCM_EOL; @@ -33,24 +33,18 @@ Scheme_engraver::Scheme_engraver () process_acknowledged_function_ = SCM_EOL; initialize_function_ = SCM_EOL; finalize_function_ = SCM_EOL; - listeners_alist_ = SCM_EOL; interface_acknowledger_hash_ = SCM_EOL; interface_end_acknowledger_hash_ = SCM_EOL; must_be_last_ = false; - per_instance_listeners_ = 0; + per_instance_listeners_ = SCM_EOL; + + init_from_scheme (definition); } Scheme_engraver::~Scheme_engraver () { - translator_listener_record *next = 0; - for (translator_listener_record *r = per_instance_listeners_; - r; r = next) - { - next = r->next_; - delete r; - } } // Extracts the value if callable, if not return #f. @@ -71,51 +65,44 @@ void Scheme_engraver::init_from_scheme (SCM definition) { start_translation_timestep_function_ = callable (ly_symbol2scm ("start-translation-timestep"), - definition); + definition); stop_translation_timestep_function_ = callable (ly_symbol2scm ("stop-translation-timestep"), - definition); + definition); process_music_function_ = callable (ly_symbol2scm ("process-music"), definition); process_acknowledged_function_ = callable (ly_symbol2scm ("process-acknowledged"), - definition); + definition); initialize_function_ = callable (ly_symbol2scm ("initialize"), definition); finalize_function_ = callable (ly_symbol2scm ("finalize"), definition); SCM listeners = ly_assoc_get (ly_symbol2scm ("listeners"), definition, SCM_EOL); - listeners_alist_ = SCM_EOL; + per_instance_listeners_ = SCM_EOL; must_be_last_ = to_boolean (ly_assoc_get (ly_symbol2scm ("must-be-last"), - definition, - SCM_BOOL_F)); - - translator_listener_record **tail = &per_instance_listeners_; + definition, + SCM_BOOL_F)); + for (SCM p = listeners; scm_is_pair (p); p = scm_cdr (p)) { SCM event_class = scm_caar (p); SCM proc = scm_cdar (p); if (!(ly_is_procedure (proc) && ly_is_symbol (event_class))) - continue; + continue; // We should check the arity of the function? - - // Record for later lookup. - listeners_alist_ = scm_acons (event_class, proc, listeners_alist_); - translator_listener_record *rec = new translator_listener_record; - *tail = rec; - rec->event_class_ = event_class; - rec->get_listener_ = &Scheme_engraver::get_listener; - tail = &rec->next_; + // Record for later lookup. + per_instance_listeners_ = scm_acons (event_class, proc, per_instance_listeners_); } - init_acknowledgers (ly_assoc_get(ly_symbol2scm ("acknowledgers"), - definition, SCM_EOL), - &interface_acknowledger_hash_); - - init_acknowledgers (ly_assoc_get(ly_symbol2scm ("end-acknowledgers"), - definition, SCM_EOL), - &interface_end_acknowledger_hash_); + init_acknowledgers (ly_assoc_get (ly_symbol2scm ("acknowledgers"), + definition, SCM_EOL), + &interface_acknowledger_hash_); + + init_acknowledgers (ly_assoc_get (ly_symbol2scm ("end-acknowledgers"), + definition, SCM_EOL), + &interface_end_acknowledger_hash_); // TODO: hook up description, props read/written, grobs created // etc. to provide automatic documentation. @@ -123,16 +110,16 @@ Scheme_engraver::init_from_scheme (SCM definition) void Scheme_engraver::init_acknowledgers (SCM alist, - SCM *hash) -{ - *hash = scm_c_make_hash_table(7); + SCM *hash) +{ + *hash = scm_c_make_hash_table (7); for (SCM p = alist; scm_is_pair (p); p = scm_cdr (p)) { SCM iface = scm_caar (p); SCM proc = scm_cdar (p); if (!(ly_is_procedure (proc) && ly_is_symbol (iface))) - continue; + continue; scm_hashq_set_x (*hash, iface, proc); } @@ -141,7 +128,7 @@ Scheme_engraver::init_acknowledgers (SCM alist, // This is the easy way to do it, at the cost of too many invocations // of Scheme_engraver::acknowledge_grob. The clever dispatching of // acknowledgers is hardwired to have 1 method per engraver per -// grob-type, which doesn't work for this case. +// grob-type, which doesn't work for this case. void Scheme_engraver::acknowledge_grob (Grob_info info) { @@ -156,72 +143,41 @@ Scheme_engraver::acknowledge_end_grob (Grob_info info) void Scheme_engraver::acknowledge_grob_by_hash (Grob_info info, - SCM iface_function_hash) + SCM iface_function_hash) { - SCM meta = info.grob ()->internal_get_property (ly_symbol2scm ("meta")); + SCM meta = info.grob ()->get_property ("meta"); SCM ifaces = scm_cdr (scm_assoc (ly_symbol2scm ("interfaces"), meta)); for (SCM s = ifaces; scm_is_pair (s); s = scm_cdr (s)) { SCM func = scm_hashq_ref (iface_function_hash, - scm_car (s), SCM_BOOL_F); + scm_car (s), SCM_BOOL_F); if (ly_is_procedure (func)) - scm_call_3 (func, self_scm (), info.grob ()->self_scm (), - info.origin_translator ()->self_scm ()); + scm_call_3 (func, self_scm (), info.grob ()->self_scm (), + info.origin_translator ()->self_scm ()); } } -static -void call_listen_closure (void *target, SCM ev) -{ - SCM cl = (SCM) target; - SCM func = scm_car (cl); - SCM engraver = scm_cdr (cl); - scm_call_2 (func, engraver, ev); -} - -static -void mark_listen_closure (void *target) -{ - scm_gc_mark ((SCM)target); -} - -Listener_function_table listen_closure = { - call_listen_closure, mark_listen_closure -}; - -/* static */ -Listener -Scheme_engraver::get_listener (void *arg, SCM name) +SCM +Scheme_engraver::get_listener_list () const { - Scheme_engraver *me = (Scheme_engraver*) arg; - SCM func = ly_assoc_get (name, me->listeners_alist_, SCM_BOOL_F); - assert (ly_is_procedure (func)); - - SCM closure = scm_cons (func, me->self_scm()); - return Listener((void*)closure, &listen_closure); -} - -translator_listener_record * -Scheme_engraver::get_listener_list () const -{ return per_instance_listeners_; } -#define DISPATCH(what) \ - void \ - Scheme_engraver::what () \ - { \ - if (what ## _function_ != SCM_BOOL_F) \ - scm_call_1 (what ## _function_, self_scm ()); \ +#define DISPATCH(what) \ + void \ + Scheme_engraver::what () \ + { \ + if (what ## _function_ != SCM_BOOL_F) \ + scm_call_1 (what ## _function_, self_scm ()); \ } -DISPATCH(start_translation_timestep); -DISPATCH(stop_translation_timestep); -DISPATCH(initialize); -DISPATCH(finalize); -DISPATCH(process_music); -DISPATCH(process_acknowledged); +DISPATCH (start_translation_timestep); +DISPATCH (stop_translation_timestep); +DISPATCH (initialize); +DISPATCH (finalize); +DISPATCH (process_music); +DISPATCH (process_acknowledged); void Scheme_engraver::derived_mark () const @@ -232,25 +188,12 @@ Scheme_engraver::derived_mark () const scm_gc_mark (finalize_function_); scm_gc_mark (process_music_function_); scm_gc_mark (process_acknowledged_function_); - scm_gc_mark (listeners_alist_); - scm_gc_mark (interface_acknowledger_hash_); - scm_gc_mark (interface_end_acknowledger_hash_); -} + scm_gc_mark (per_instance_listeners_); + scm_gc_mark (interface_acknowledger_hash_); + scm_gc_mark (interface_end_acknowledger_hash_); +} ADD_ACKNOWLEDGER (Scheme_engraver, grob); ADD_END_ACKNOWLEDGER (Scheme_engraver, grob); -ADD_TRANSLATOR (Scheme_engraver, - /* doc */ - "Implement engravers in Scheme. Interprets arguments to @code{\\consists} " - "as callbacks. ", - - /* create */ - "", - - /* read */ - "", - - /* write */ - "" - ); +ADD_TRANSLATOR_FAMILY (Scheme_engraver);