From 739ec1a40e28611c3a38f6cff6108bb7ce2db2fe Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Sat, 3 Feb 2007 00:24:45 +0100 Subject: [PATCH] Clean up nested property settings. - Make revert work correctly. - Store property path big-to-small order. --- lily/context-property.cc | 151 ++++++++++++++++++++------------------- lily/dynamic-engraver.cc | 4 +- lily/grob-property.cc | 5 +- lily/include/context.hh | 2 + lily/parser.yy | 12 +++- 5 files changed, 90 insertions(+), 84 deletions(-) diff --git a/lily/context-property.cc b/lily/context-property.cc index bc7016babb..81bb7c5881 100644 --- a/lily/context-property.cc +++ b/lily/context-property.cc @@ -16,25 +16,6 @@ #include "spanner.hh" #include "warn.hh" -SCM -lookup_nested_property (SCM alist, - SCM grob_property_path) -{ - if (scm_is_pair (grob_property_path)) - { - SCM sym = scm_car (grob_property_path); - SCM handle = scm_assq (sym, alist); - - if (handle == SCM_BOOL_F) - return SCM_EOL; - else - return lookup_nested_property (scm_cdr (handle), - scm_cdr (grob_property_path)); - } - else - return alist; -} - /* copy ALIST leaving out SYMBOL. Copying stops at ALIST_END */ @@ -95,73 +76,93 @@ general_pushpop_property (Context *context, indicates nested alists, eg. '(beamed-stem-lengths details) */ + + void -execute_general_pushpop_property (Context *context, - SCM context_property, - SCM grob_property_path, - SCM new_value - ) +execute_override_property (Context *context, + SCM context_property, + SCM grob_property_path, + SCM new_value) { SCM current_context_val = SCM_EOL; - if (new_value != SCM_UNDEFINED) + + Context *where = context->where_defined (context_property, + ¤t_context_val); + + /* + Don't mess with MIDI. + */ + if (!where) + return; + + if (where != context) { - Context *where = context->where_defined (context_property, ¤t_context_val); + SCM base = updated_grob_properties (context, context_property); + current_context_val = scm_cons (base, base); + context->set_property (context_property, current_context_val); + } - /* - Don't mess with MIDI. - */ - if (!where) - return; + if (!scm_is_pair (current_context_val)) + { + programming_error ("Grob definition should be cons"); + return; + } - if (where != context) - { - SCM base = updated_grob_properties (context, context_property); - current_context_val = scm_cons (base, base); - context->set_property (context_property, current_context_val); - } + SCM symbol = scm_car (grob_property_path); + SCM target_alist = scm_car (current_context_val); + if (scm_is_pair (scm_cdr (grob_property_path))) + { + new_value = nested_property_alist (ly_assoc_get (symbol, target_alist, + SCM_EOL), + scm_cdr (grob_property_path), + new_value); + } - if (!scm_is_pair (current_context_val)) - { - programming_error ("Grob definition should be cons"); - return; - } + if (scm_is_pair (target_alist) + && scm_caar (target_alist) == symbol) + target_alist = scm_cdr (target_alist); - SCM prev_alist = scm_car (current_context_val); - SCM symbol = scm_car (grob_property_path); - SCM target_alist - = lookup_nested_property (prev_alist, - scm_reverse (scm_cdr (grob_property_path))); + target_alist = scm_acons (symbol, new_value, target_alist); - target_alist = scm_acons (symbol, new_value, target_alist); + bool ok = true; + if (!ly_is_procedure (new_value) + && !is_simple_closure (new_value)) + ok = type_check_assignment (symbol, new_value, + ly_symbol2scm ("backend-type?")); - bool ok = true; - if (!scm_is_pair (scm_cdr (grob_property_path))) - { - if (!ly_is_procedure (new_value) - && !is_simple_closure (new_value)) - ok = type_check_assignment (symbol, new_value, - ly_symbol2scm ("backend-type?")); - - /* - tack onto alist. We can use set_car, since - updated_grob_properties () in child contexts will check - for changes in the car. - */ - if (ok) - { - scm_set_car_x (current_context_val, target_alist); - } - } - else - { - execute_general_pushpop_property (context, - context_property, - scm_cdr (grob_property_path), - target_alist - ); - } + /* + tack onto alist. We can use set_car, since + updated_grob_properties () in child contexts will check + for changes in the car. + */ + if (ok) + { + scm_set_car_x (current_context_val, target_alist); } - else if (context->where_defined (context_property, ¤t_context_val) == context) +} + + +void +execute_general_pushpop_property (Context *context, + SCM context_property, + SCM grob_property_path, + SCM new_value + ) +{ + if (new_value != SCM_UNDEFINED) + { + execute_override_property (context, context_property, + grob_property_path, + new_value); + + return; + } + + /* + revert. + */ + SCM current_context_val = SCM_EOL; + if (context->where_defined (context_property, ¤t_context_val) == context) { SCM current_value = scm_car (current_context_val); SCM daddy = scm_cdr (current_context_val); diff --git a/lily/dynamic-engraver.cc b/lily/dynamic-engraver.cc index 7a5b576278..18ebeda943 100644 --- a/lily/dynamic-engraver.cc +++ b/lily/dynamic-engraver.cc @@ -263,9 +263,9 @@ Dynamic_engraver::process_music () if (script_) { set_nested_property (cresc_, - scm_list_3 (ly_symbol2scm ("attach-dir"), + scm_list_3 (ly_symbol2scm ("bound-details"), ly_symbol2scm ("left"), - ly_symbol2scm ("bound-details") + ly_symbol2scm ("attach-dir") ), scm_from_int (RIGHT)); } diff --git a/lily/grob-property.cc b/lily/grob-property.cc index 7bf13062a5..bebd8dfbf6 100644 --- a/lily/grob-property.cc +++ b/lily/grob-property.cc @@ -86,8 +86,6 @@ Grob::internal_set_property (SCM sym, SCM v, char const *file, int line, char co sym, v, SCM_UNDEFINED)); } #else - - void Grob::internal_set_property (SCM sym, SCM v) { @@ -304,9 +302,8 @@ nested_property_alist (SCM alist, SCM prop_path, SCM value) void -set_nested_property (Grob *me, SCM property_path, SCM value) +set_nested_property (Grob *me, SCM big_to_small, SCM value) { - SCM big_to_small = scm_reverse (property_path); SCM alist = me->get_property (scm_car (big_to_small)); alist = nested_property_alist (alist, scm_cdr (big_to_small), value); diff --git a/lily/include/context.hh b/lily/include/context.hh index 39babf7b66..d267397399 100644 --- a/lily/include/context.hh +++ b/lily/include/context.hh @@ -146,5 +146,7 @@ void set_context_property_on_children (Context *trans, SCM sym, SCM val); ctx->internal_send_stream_event (ly_symbol2scm (type), origin, props); \ } +SCM nested_property_alist (SCM alist, SCM prop_path, SCM value); + #endif /* CONTEXT_HH */ diff --git a/lily/parser.yy b/lily/parser.yy index 4bf3c9d191..eea08ee94c 100644 --- a/lily/parser.yy +++ b/lily/parser.yy @@ -410,7 +410,7 @@ If we give names, Bison complains. %type pitch_also_in_chords %type post_events %type property_operation -%type property_path +%type property_path property_path_revved %type scalar %type script_abbreviation %type simple_chord_elements @@ -1124,15 +1124,21 @@ context_change: ; -property_path: +property_path_revved: embedded_scm { $$ = scm_cons ($1, SCM_EOL); } - | property_path embedded_scm { + | property_path_revved embedded_scm { $$ = scm_cons ($2, $1); } ; +property_path: + property_path_revved { + $$ = scm_reverse_x ($1, SCM_EOL); + } + ; + property_operation: STRING '=' scalar { $$ = scm_list_3 (ly_symbol2scm ("assign"), -- 2.39.5