X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Fcontext-property.cc;h=4ee9a4300214c5abce9f596753e3991225048335;hb=3a50ddfdd7fb6a85a5266ac4adf3ff9ee6d5d378;hp=ee031b4b84a8d9d1ccbd0d0a177967ab4f866cf1;hpb=e24df7c27635dc996c466295eacf2981bddccaf7;p=lilypond.git diff --git a/lily/context-property.cc b/lily/context-property.cc index ee031b4b84..4ee9a43002 100644 --- a/lily/context-property.cc +++ b/lily/context-property.cc @@ -1,10 +1,10 @@ /* - context-property.cc -- implement manipulation of immutable Grob - property lists. + context-property.cc -- implement manipulation of immutable Grob + property lists. - source file of the GNU LilyPond music typesetter + source file of the GNU LilyPond music typesetter - (c) 2004--2005 Han-Wen Nienhuys + (c) 2004--2005 Han-Wen Nienhuys */ #include "context.hh" @@ -13,113 +13,187 @@ #include "main.hh" #include "spanner.hh" #include "warn.hh" +#include "paper-column.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 +*/ +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 + ) +{ + 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); + } + + execute_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 (ELTPROP . VAL) - entry from a translator property list by name of PROP + Push or pop (depending on value of VAL) a single entry entry from a + translator property list by name of PROP. GROB_PROPERTY_PATH + indicates nested alists, eg. '(beamed-stem-lengths details) + */ - - void -execute_pushpop_property (Context * trg, - SCM prop, SCM eltprop, SCM val) +execute_general_pushpop_property (Context *context, + SCM context_property, + SCM grob_property_path, + SCM new_value + ) { - if (scm_is_symbol (prop) && scm_is_symbol (eltprop)) + SCM current_context_val = SCM_EOL; + if (new_value != SCM_UNDEFINED) { - if (val != SCM_UNDEFINED) - { - SCM prev = SCM_EOL; - Context * where = trg->where_defined (prop); + Context *where = context->where_defined (context_property, ¤t_context_val); - /* - Don't mess with MIDI. - */ - if (!where) - return ; - - if (where != trg) - { - SCM base = updated_grob_properties (trg, prop); - prev = scm_cons (base, base); - trg->internal_set_property (prop, prev); - } - else - prev = trg->internal_get_property (prop); - - if (!scm_is_pair (prev)) - { - programming_error ("Grob definition should be cons."); - return ; - } + /* + Don't mess with MIDI. + */ + if (!where) + return; - SCM prev_alist = scm_car (prev); - - if (scm_is_pair (prev_alist) || prev_alist == SCM_EOL) - { - bool ok = type_check_assignment (eltprop, val, ly_symbol2scm ("backend-type?")); + 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); + } - /* - tack onto alist: - */ - if (ok) - scm_set_car_x (prev, scm_acons (eltprop, val, prev_alist)); - } - else - { - // warning here. - } + if (!scm_is_pair (current_context_val)) + { + programming_error ("Grob definition should be cons"); + return; } - else if (trg->where_defined (prop) == trg) + + 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))) { - SCM prev = trg->internal_get_property (prop); - SCM prev_alist = scm_car (prev); - SCM daddy = scm_cdr (prev); - - SCM new_alist = SCM_EOL; - SCM *tail = &new_alist; - - while (prev_alist != daddy) - { - if (ly_c_equal_p (scm_caar (prev_alist), eltprop)) - { - prev_alist = scm_cdr (prev_alist); - break ; - } - - - *tail = scm_cons (scm_car (prev_alist), SCM_EOL); - tail = SCM_CDRLOC (*tail); - prev_alist = scm_cdr (prev_alist); - } + ok = type_check_assignment (symbol, new_value, ly_symbol2scm ("backend-type?")); - if (new_alist == SCM_EOL && prev_alist == daddy) - trg->unset_property (prop); - else + /* + tack onto alist. We can use set_car, since + updated_grob_properties() in child contexts will check + for changes in the car. + */ + if (ok) { - *tail = prev_alist; - trg->internal_set_property (prop, scm_cons (new_alist, daddy)); + scm_set_car_x (current_context_val, target_alist); } } + else + { + execute_general_pushpop_property (context, + context_property, + scm_cdr (grob_property_path), + target_alist + ); + } } - else + else if (context->where_defined (context_property, ¤t_context_val) == context) { - warning ("Need symbol arguments for \\override and \\revert"); - if (do_internal_type_checking_global) - assert (false); + SCM current_value = 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); + + if (new_alist == daddy) + context->unset_property (context_property); + else + context->internal_set_property (context_property, scm_cons (new_alist, daddy)); } } +void +execute_pushpop_property (Context *context, + SCM context_property, + SCM grob_property, + SCM new_value + ) +{ + general_pushpop_property (context, context_property, + 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) { @@ -128,41 +202,45 @@ apply_property_operations (Context *tg, SCM pre_init_ops) { SCM entry = scm_car (s); SCM type = scm_car (entry); - entry = scm_cdr (entry); - - if (type == ly_symbol2scm ("push") || type == ly_symbol2scm ("poppush")) - { - SCM val = scm_cddr (entry); - val = scm_is_pair (val) ? scm_car (val) : SCM_UNDEFINED; + entry = scm_cdr (entry); - execute_pushpop_property (tg, scm_car (entry), scm_cadr (entry), val); + 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); } - else if (type == ly_symbol2scm ("assign")) + else if (type == ly_symbol2scm ("pop")) { - tg->internal_set_property (scm_car (entry), scm_cadr (entry)); + 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); } + else if (type == ly_symbol2scm ("assign")) + tg->internal_set_property (scm_car (entry), scm_cadr (entry)); } } /* Return the object alist for SYM, checking if its base in enclosing - contexts has changed. The alist is updated if necessary. - */ + contexts has changed. The alist is updated if necessary. +*/ SCM -updated_grob_properties (Context * tg, SCM sym) +updated_grob_properties (Context *tg, SCM sym) { assert (scm_is_symbol (sym)); - - tg = tg->where_defined (sym); + + SCM props; + tg = tg->where_defined (sym, &props); if (!tg) return SCM_EOL; - + SCM daddy_props = (tg->get_parent_context ()) ? updated_grob_properties (tg->get_parent_context (), sym) : SCM_EOL; - - SCM props = tg->internal_get_property (sym); if (!scm_is_pair (props)) { @@ -172,21 +250,19 @@ updated_grob_properties (Context * tg, SCM sym) SCM based_on = scm_cdr (props); if (based_on == daddy_props) - { - return scm_car (props); - } + return scm_car (props); else { SCM copy = daddy_props; SCM *tail = © SCM p = scm_car (props); - while (p != based_on) + while (p != based_on) { *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); @@ -194,30 +270,50 @@ updated_grob_properties (Context * tg, SCM sym) } } -Item * -make_item_from_properties (Engraver *tr, SCM x, SCM cause, const char * name) +Grob * +make_grob_from_properties (Engraver *tr, SCM symbol, SCM cause, char const *name) { Context *context = tr->context (); - - SCM props = updated_grob_properties (context, x); - Object_key const*key = context->get_grob_key (name); - Item *it = new Item (props, key); + SCM props = updated_grob_properties (context, symbol); - dynamic_cast(tr)->announce_grob (it, cause); + Object_key const *key = context->get_grob_key (name); + Grob *grob = 0; - return it; -} + SCM handle = scm_sloppy_assq (ly_symbol2scm ("meta"), props); + SCM klass = scm_cdr (scm_sloppy_assq (ly_symbol2scm ("class"), scm_cdr (handle))); -Spanner* -make_spanner_from_properties (Engraver *tr, SCM x, SCM cause, const char *name) -{ - Context *context = tr->context (); + 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); - SCM props = updated_grob_properties (context, x); - Spanner *it = new Spanner (props, context->get_grob_key (name)); + assert (grob); + dynamic_cast (tr)->announce_grob (grob, cause); - dynamic_cast(tr)->announce_grob (it, 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; +}