X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Fcontext-property.cc;h=1ccfe5a970973e7ce3be409406985dcafd0e42f7;hb=32a34dcef0c0041c6d62677487a380b5c8b85712;hp=68f8f5035e3c31380d5cc93150200a5891f07466;hpb=7bd94ae712e871613a39092e275005a73c11a27c;p=lilypond.git diff --git a/lily/context-property.cc b/lily/context-property.cc index 68f8f5035e..1ccfe5a970 100644 --- a/lily/context-property.cc +++ b/lily/context-property.cc @@ -1,229 +1,262 @@ /* - context-property.cc -- implement manipulation of immutable Grob - property lists. + This file is part of LilyPond, the GNU music typesetter. - source file of the GNU LilyPond music typesetter + Copyright (C) 2004--2012 Han-Wen Nienhuys - (c) 2004--2005 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 + 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 "context.hh" #include "engraver.hh" +#include "international.hh" #include "item.hh" #include "main.hh" +#include "simple-closure.hh" #include "spanner.hh" +#include "unpure-pure-container.hh" #include "warn.hh" -#include "paper-column.hh" -#include "simple-closure.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 + like execute_general_pushpop_property(), but typecheck + grob_property_path and context_property. */ -SCM -evict_from_alist (SCM symbol, - SCM alist, - SCM alist_end) -{ - SCM new_alist = SCM_EOL; - SCM *tail = &new_alist; - - while (alist != alist_end) - { - if (ly_is_equal (scm_caar (alist), symbol)) - { - alist = scm_cdr (alist); - break; - } - - *tail = scm_cons (scm_car (alist), SCM_EOL); - tail = SCM_CDRLOC (*tail); - alist = scm_cdr (alist); - } - - *tail = alist; - return new_alist; -} - 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); } - execute_general_pushpop_property (context, context_property, - grob_property_path, new_value); + sloppy_general_pushpop_property (context, context_property, + 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 alist defined in a parent context. BASED-ON should always be a tail of ALIST. - Push or pop (depending on value of VAL) a single entry entry from a + 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_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); - - /* - Don't mess with MIDI. - */ - if (!where) - return; - - if (where != context) - { - SCM base = updated_grob_properties (context, context_property); - current_context_val = scm_cons (base, base); - context->internal_set_property (context_property, current_context_val); - } - - if (!scm_is_pair (current_context_val)) - { - programming_error ("Grob definition should be cons"); - return; - } - - 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); - - 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 - ); - } + SCM base = updated_grob_properties (context, context_property); + current_context_val = scm_cons (base, base); + context->set_property (context_property, current_context_val); + } + + if (!scm_is_pair (current_context_val)) + { + programming_error ("Grob definition should be cons"); + return; + } + + 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); + } + + /* it's tempting to replace the head of the list if it's the same + property. However, we have to keep this info around, in case we have to + \revert back to it. + */ + target_alist = scm_acons (symbol, new_value, target_alist); + + bool ok = true; + 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 + 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) +} + +/* + do a pop (indicated by new_value==SCM_UNDEFINED) or push + */ +void +sloppy_general_pushpop_property (Context *context, + SCM context_property, + SCM grob_property_path, + SCM new_value) +{ + if (new_value == SCM_UNDEFINED) + execute_revert_property (context, context_property, + grob_property_path); + else + execute_override_property (context, context_property, + grob_property_path, + new_value); +} + +/* + Revert the property given by property_path. +*/ +void +execute_revert_property (Context *context, + SCM context_property, + SCM grob_property_path) +{ + 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 current_alist = scm_car (current_context_val); 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 symbol = scm_car (grob_property_path); - SCM new_alist = evict_from_alist (symbol, current_value, daddy); + || !scm_is_symbol (scm_car (grob_property_path))) + { + programming_error ("Grob property path should be list of symbols."); + return; + } - if (new_alist == daddy) - context->unset_property (context_property); + 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); + } else - context->internal_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)); + } } } - +/* + Convenience: a push/pop grob property using a single grob_property + as argument. +*/ 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); } - + /* PRE_INIT_OPS is in the order specified, and hence must be reversed. */ 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 (!scm_is_pair (entry)) + continue; + SCM context_prop = scm_car (entry); + if (scm_is_pair (context_prop)) + { + if (tg->is_alias (scm_car (context_prop))) + context_prop = scm_cdr (context_prop); + else + continue; + } if (type == ly_symbol2scm ("push")) - { - SCM context_prop = scm_car (entry); - SCM val = scm_cadr (entry); - SCM grob_prop_path = scm_cddr (entry); - execute_general_pushpop_property (tg, context_prop, grob_prop_path, val); - } + { + 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); - execute_general_pushpop_property (tg, context_prop, grob_prop_path, val); - } + { + 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->internal_set_property (scm_car (entry), scm_cadr (entry)); + tg->set_property (context_prop, scm_cadr (entry)); + else if (type == ly_symbol2scm ("apply")) + scm_apply_1 (context_prop, tg->self_scm (), scm_cdr (entry)); } } @@ -243,8 +276,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)) { @@ -261,11 +294,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); @@ -273,51 +306,3 @@ updated_grob_properties (Context *tg, SCM sym) return copy; } } - -Grob * -make_grob_from_properties (Engraver *tr, SCM symbol, SCM cause, char const *name) -{ - Context *context = tr->context (); - - SCM props = updated_grob_properties (context, symbol); - - Object_key const *key = context->get_grob_key (name); - Grob *grob = 0; - - SCM handle = scm_sloppy_assq (ly_symbol2scm ("meta"), props); - SCM klass = scm_cdr (scm_sloppy_assq (ly_symbol2scm ("class"), scm_cdr (handle))); - - if (klass == ly_symbol2scm ("Item")) - grob = new Item (props, key); - else if (klass == ly_symbol2scm ("Spanner")) - grob = new Spanner (props, key); - else if (klass == ly_symbol2scm ("Paper_column")) - grob = new Paper_column (props, key); - - assert (grob); - dynamic_cast (tr)->announce_grob (grob, cause); - - return grob; -} - -Item * -make_item_from_properties (Engraver *tr, SCM x, SCM cause, char const *name) -{ - Item *it = dynamic_cast (make_grob_from_properties (tr, x, cause, name)); - assert (it); - return it; -} - -Paper_column * -make_paper_column_from_properties (Engraver *tr, SCM x, char const *name) -{ - return dynamic_cast (make_grob_from_properties (tr, x, SCM_EOL, name)); -} - -Spanner * -make_spanner_from_properties (Engraver *tr, SCM x, SCM cause, char const *name) -{ - Spanner *sp = dynamic_cast (make_grob_from_properties (tr, x, cause, name)); - assert (sp); - return sp; -}