X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Fcontext-property.cc;h=00108cf3149d8b3966b4c392a2dc523e143849c7;hb=856ae980b25d1d99c1e847985bed8b61c061e02f;hp=4d1de2403460d631be0eeb4ef752ede71f3c2feb;hpb=1c846b2c2348b4e0ca4a3c2e8fb267047ba2d203;p=lilypond.git diff --git a/lily/context-property.cc b/lily/context-property.cc index 4d1de24034..00108cf314 100644 --- a/lily/context-property.cc +++ b/lily/context-property.cc @@ -1,7 +1,7 @@ /* This file is part of LilyPond, the GNU music typesetter. - Copyright (C) 2004--2011 Han-Wen Nienhuys + Copyright (C) 2004--2012 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 @@ -24,6 +24,7 @@ #include "main.hh" #include "simple-closure.hh" #include "spanner.hh" +#include "unpure-pure-container.hh" #include "warn.hh" /* @@ -32,23 +33,22 @@ */ void general_pushpop_property (Context *context, - SCM context_property, - SCM grob_property_path, - SCM new_value) + SCM context_property, + SCM grob_property_path, + SCM new_value) { if (!scm_is_symbol (context_property) || !scm_is_symbol (scm_car (grob_property_path))) { warning (_ ("need symbol arguments for \\override and \\revert")); if (do_internal_type_checking_global) - assert (false); + assert (false); } sloppy_general_pushpop_property (context, context_property, - grob_property_path, new_value); + grob_property_path, new_value); } - /* Grob descriptions (ie. alists with layout properties) are represented as a (ALIST . BASED-ON) pair, where BASED-ON is the @@ -58,18 +58,17 @@ general_pushpop_property (Context *context, Push or pop (depending on value of VAL) a single entry from a translator property list by name of PROP. GROB_PROPERTY_PATH indicates nested alists, eg. '(beamed-stem-lengths details) - */ void execute_override_property (Context *context, - SCM context_property, - SCM grob_property_path, - SCM new_value) + SCM context_property, + SCM grob_property_path, + SCM new_value) { SCM current_context_val = SCM_EOL; Context *where = context->where_defined (context_property, - ¤t_context_val); + ¤t_context_val); /* Don't mess with MIDI. @@ -92,20 +91,13 @@ execute_override_property (Context *context, SCM target_alist = scm_car (current_context_val); - /* - If the car is a list, the property path comes from a nested override - using list syntax inside a \context block - */ - if (scm_is_pair (scm_car (grob_property_path))) - grob_property_path = scm_car (grob_property_path); - SCM symbol = scm_car (grob_property_path); 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); + SCM_EOL), + scm_cdr (grob_property_path), + new_value); } /* it's tempting to replace the head of the list if it's the same @@ -115,10 +107,16 @@ execute_override_property (Context *context, 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 pc = is_unpure_pure_container (new_value); + SCM vals[] = {pc ? unpure_pure_container_unpure_part (new_value) : new_value, + pc ? unpure_pure_container_pure_part (new_value) : SCM_BOOL_F + }; + + for (int i = 0; i < 2; i++) + if (!ly_is_procedure (vals[i]) + && !is_simple_closure (vals[i])) + ok = ok && type_check_assignment (symbol, vals[i], + ly_symbol2scm ("backend-type?")); /* tack onto alist. We can use set_car, since @@ -136,17 +134,17 @@ execute_override_property (Context *context, */ void sloppy_general_pushpop_property (Context *context, - SCM context_property, - SCM grob_property_path, - SCM new_value) + SCM context_property, + SCM grob_property_path, + SCM new_value) { if (new_value == SCM_UNDEFINED) execute_revert_property (context, context_property, - grob_property_path); + grob_property_path); else execute_override_property (context, context_property, - grob_property_path, - new_value); + grob_property_path, + new_value); } /* @@ -154,8 +152,8 @@ sloppy_general_pushpop_property (Context *context, */ void execute_revert_property (Context *context, - SCM context_property, - SCM grob_property_path) + SCM context_property, + SCM grob_property_path) { SCM current_context_val = SCM_EOL; if (context->where_defined (context_property, ¤t_context_val) @@ -165,38 +163,38 @@ execute_revert_property (Context *context, SCM daddy = scm_cdr (current_context_val); if (!scm_is_pair (grob_property_path) - || !scm_is_symbol (scm_car (grob_property_path))) - { - programming_error ("Grob property path should be list of symbols."); - return; - } + || !scm_is_symbol (scm_car (grob_property_path))) + { + programming_error ("Grob property path should be list of symbols."); + return; + } SCM symbol = scm_car (grob_property_path); if (scm_is_pair (scm_cdr (grob_property_path))) - { - SCM current_sub_alist = ly_assoc_get (symbol, current_alist, SCM_EOL); - SCM new_val - = nested_property_revert_alist (current_sub_alist, - scm_cdr (grob_property_path)); - - if (scm_is_pair (current_alist) - && scm_caar (current_alist) == symbol - && current_alist != daddy) - current_alist = scm_cdr (current_alist); - - current_alist = scm_acons (symbol, new_val, current_alist); - scm_set_car_x (current_context_val, current_alist); - } + { + SCM current_sub_alist = ly_assoc_get (symbol, current_alist, SCM_EOL); + SCM new_val + = nested_property_revert_alist (current_sub_alist, + scm_cdr (grob_property_path)); + + if (scm_is_pair (current_alist) + && scm_caar (current_alist) == symbol + && current_alist != daddy) + current_alist = scm_cdr (current_alist); + + current_alist = scm_acons (symbol, new_val, current_alist); + scm_set_car_x (current_context_val, current_alist); + } else - { - SCM new_alist = evict_from_alist (symbol, current_alist, daddy); - - if (new_alist == daddy) - context->unset_property (context_property); - else - context->set_property (context_property, - scm_cons (new_alist, daddy)); - } + { + SCM new_alist = evict_from_alist (symbol, current_alist, daddy); + + if (new_alist == daddy) + context->unset_property (context_property); + else + context->set_property (context_property, + scm_cons (new_alist, daddy)); + } } } /* @@ -205,13 +203,13 @@ execute_revert_property (Context *context, */ void execute_pushpop_property (Context *context, - SCM context_property, - SCM grob_property, - SCM new_value) + SCM context_property, + SCM grob_property, + SCM new_value) { general_pushpop_property (context, context_property, - scm_list_1 (grob_property), - new_value); + scm_list_1 (grob_property), + new_value); } /* @@ -220,29 +218,32 @@ execute_pushpop_property (Context *context, void apply_property_operations (Context *tg, SCM pre_init_ops) { - SCM correct_order = scm_reverse (pre_init_ops); - for (SCM s = correct_order; scm_is_pair (s); s = scm_cdr (s)) + for (SCM s = pre_init_ops; scm_is_pair (s); s = scm_cdr (s)) { SCM entry = scm_car (s); SCM type = scm_car (entry); entry = scm_cdr (entry); if (type == ly_symbol2scm ("push")) - { - SCM context_prop = scm_car (entry); - SCM val = scm_cadr (entry); - SCM grob_prop_path = scm_cddr (entry); - sloppy_general_pushpop_property (tg, context_prop, grob_prop_path, val); - } + { + SCM context_prop = scm_car (entry); + SCM val = scm_cadr (entry); + SCM grob_prop_path = scm_cddr (entry); + sloppy_general_pushpop_property (tg, context_prop, grob_prop_path, val); + } else if (type == ly_symbol2scm ("pop")) - { - SCM context_prop = scm_car (entry); - SCM val = SCM_UNDEFINED; - SCM grob_prop_path = scm_cdr (entry); - sloppy_general_pushpop_property (tg, context_prop, grob_prop_path, val); - } + { + SCM context_prop = scm_car (entry); + SCM val = SCM_UNDEFINED; + SCM grob_prop_path = scm_cdr (entry); + sloppy_general_pushpop_property (tg, context_prop, grob_prop_path, val); + } else if (type == ly_symbol2scm ("assign")) - tg->set_property (scm_car (entry), scm_cadr (entry)); + tg->set_property (scm_car (entry), scm_cadr (entry)); + else if (type == ly_symbol2scm ("apply")) + scm_apply_1 (scm_car (entry), tg->self_scm (), scm_cdr (entry)); + else if (type == ly_symbol2scm ("unset")) + tg->unset_property (scm_car (entry)); } } @@ -262,8 +263,8 @@ updated_grob_properties (Context *tg, SCM sym) SCM daddy_props = (tg->get_parent_context ()) - ? updated_grob_properties (tg->get_parent_context (), sym) - : SCM_EOL; + ? updated_grob_properties (tg->get_parent_context (), sym) + : SCM_EOL; if (!scm_is_pair (props)) { @@ -280,11 +281,11 @@ updated_grob_properties (Context *tg, SCM sym) SCM *tail = © SCM p = scm_car (props); while (p != based_on) - { - *tail = scm_cons (scm_car (p), daddy_props); - tail = SCM_CDRLOC (*tail); - p = scm_cdr (p); - } + { + *tail = scm_cons (scm_car (p), daddy_props); + tail = SCM_CDRLOC (*tail); + p = scm_cdr (p); + } scm_set_car_x (props, copy); scm_set_cdr_x (props, daddy_props);