X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Fcontext-property.cc;h=62e04a27323a5b136194c0607954e2b53e35c197;hb=47db9a3883d726ca53e2133a3b2298f78dd6a32e;hp=9496518a235dc46d5a2a64a309927248bc4dbe41;hpb=9e69cb84d6ee5b0a861cd97869b10e3bdf0c833c;p=lilypond.git diff --git a/lily/context-property.cc b/lily/context-property.cc index 9496518a23..62e04a2732 100644 --- a/lily/context-property.cc +++ b/lily/context-property.cc @@ -1,229 +1,345 @@ /* - 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--2015 Han-Wen Nienhuys - (c) 2004--2006 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 "global-context.hh" +#include "grob-properties.hh" #include "international.hh" #include "item.hh" #include "main.hh" #include "simple-closure.hh" +#include "smobs.hh" #include "spanner.hh" +#include "unpure-pure-container.hh" #include "warn.hh" -SCM -lookup_nested_property (SCM alist, - SCM grob_property_path) +/* + like execute_general_pushpop_property(), but typecheck + grob_property_path and context_property. +*/ +void +general_pushpop_property (Context *context, + SCM context_property, + SCM grob_property_path, + SCM new_value) { - if (scm_is_pair (grob_property_path)) + if (!scm_is_symbol (context_property) + || !scm_is_symbol (scm_car (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)); + warning (_ ("need symbol arguments for \\override and \\revert")); + if (do_internal_type_checking_global) + assert (false); } - else - return alist; + + Grob_property_info (context, context_property).pushpop + (grob_property_path, new_value); } -/* - copy ALIST leaving out SYMBOL. Copying stops at ALIST_END -*/ +bool +typecheck_grob (SCM symbol, SCM value) +{ + if (Unpure_pure_container *upc = Unpure_pure_container::unsmob (value)) + return typecheck_grob (symbol, upc->unpure_part ()) + && typecheck_grob (symbol, upc->pure_part ()); + return ly_is_procedure (value) + || Simple_closure::is_smob (value) + || type_check_assignment (symbol, value, ly_symbol2scm ("backend-type?")); +} + +class Grob_properties : public Simple_smob +{ +public: + SCM mark_smob (); + static const char type_p_name_[]; +private: + friend class Grob_property_info; + friend SCM ly_make_grob_properties (SCM); + // alist_ may contain unexpanded nested overrides + SCM alist_; + // based_on_ is the cooked_ value from the next higher context that + // alist_ is based on + SCM based_on_; + // cooked_ is a version of alist_ where nested overrides have been + // expanded + SCM cooked_; + // cooked_from_ is the value of alist_ from which the expansion has + // been done + SCM cooked_from_; + // nested_ is a count of nested overrides in alist_ + int nested_; + + Grob_properties (SCM alist, SCM based_on) : + alist_ (alist), based_on_ (based_on), + // if the constructor was called with lists possibly containing + // partial overrides, we would need to initialize with based_on in + // order to trigger an initial update. But this should never + // happen, so we initialize straight with alist. + cooked_ (alist), cooked_from_ (alist), nested_ (0) { } +}; + +const char Grob_properties::type_p_name_[] = "ly:grob-properties?"; + SCM -evict_from_alist (SCM symbol, - SCM alist, - SCM alist_end) +Grob_properties::mark_smob () { - SCM new_alist = SCM_EOL; - SCM *tail = &new_alist; + scm_gc_mark (alist_); + scm_gc_mark (based_on_); + scm_gc_mark (cooked_); + return cooked_from_; +} - 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); - } +LY_DEFINE (ly_make_grob_properties, "ly:make-grob-properties", + 1, 0, 0, (SCM alist), + "This packages the given property list @var{alist} in" + " a grob property container stored in a context property" + " with the name of a grob.") +{ + LY_ASSERT_TYPE (ly_is_list, alist, 1); + return Grob_properties (alist, SCM_EOL).smobbed_copy (); +} - *tail = alist; - return new_alist; + +Grob_property_info +Grob_property_info::find () +{ + if (props_) + return *this; + SCM res = SCM_UNDEFINED; + if (Context *c = context_->where_defined (symbol_, &res)) + if (c != context_) + return Grob_property_info (c, symbol_, Grob_properties::unsmob (res)); + props_ = Grob_properties::unsmob (res); + return *this; } -void -general_pushpop_property (Context *context, - SCM context_property, - SCM grob_property_path, - SCM new_value - ) +bool +Grob_property_info::check () { - if (!scm_is_symbol (context_property) - || !scm_is_symbol (scm_car (grob_property_path))) + if (props_) + return true; + SCM res = SCM_UNDEFINED; + if (context_->here_defined (symbol_, &res)) + props_ = Grob_properties::unsmob (res); + return props_; +} + +bool +Grob_property_info::create () +{ + // Using scm_hashq_create_handle_x would seem like the one-lookup + // way to create a handle if it does not exist yet. However, we + // need to check that there is a corresponding grob in this + // particular output first, and we have to do this in the global + // context. By far the most frequent case will be that a + // Grob_properties for this context already exists, so we optimize + // for that and only check the global handle when the local + // context is pristine. + if (check ()) + return true; + SCM current_context_val = SCM_EOL; + Context *g = context_->get_global_context (); + if (!g) + return false; // Context is probably dead + + /* + Don't mess with MIDI. + */ + if (g == context_ + || !g->here_defined (symbol_, ¤t_context_val)) + return false; + + Grob_properties *def = Grob_properties::unsmob (current_context_val); + + if (!def) { - warning (_ ("need symbol arguments for \\override and \\revert")); - if (do_internal_type_checking_global) - assert (false); + programming_error ("Grob definition expected"); + return false; } - execute_general_pushpop_property (context, context_property, - grob_property_path, new_value); + // We create the new Grob_properties from the default definition + // since this is what we have available right now. It may or may + // not be accurate since we don't take into account any + // prospective overrides in intermediate contexts. If there are + // any, they will be factored in when `updated' is being called. + SCM props = Grob_properties (def->alist_, def->alist_).smobbed_copy (); + context_->set_property (symbol_, props); + props_ = Grob_properties::unsmob (props); + return props_; } - /* - 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 a single entry from a translator property list by name of PROP. GROB_PROPERTY_PATH indicates nested alists, eg. '(beamed-stem-lengths details) - + + Return value can be passed to matched_pop and will only cancel the + same override then. */ -void -execute_general_pushpop_property (Context *context, - SCM context_property, - SCM grob_property_path, - SCM new_value - ) +SCM +Grob_property_info::push (SCM grob_property_path, SCM new_value) { - SCM current_context_val = SCM_EOL; - if (new_value != SCM_UNDEFINED) + /* + Don't mess with MIDI. + */ + if (!create ()) + return SCM_EOL; + + SCM symbol = scm_car (grob_property_path); + SCM rest = scm_cdr (grob_property_path); + if (scm_is_pair (rest)) { - 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->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 - ); - } + // poor man's typechecking + if (typecheck_grob (symbol, nested_create_alist (rest, new_value))) { + SCM cell = scm_cons (grob_property_path, new_value); + props_->alist_ = scm_cons (cell, props_->alist_); + props_->nested_++; + return cell; + } + return SCM_EOL; } - else if (context->where_defined (context_property, ¤t_context_val) == context) + + /* 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. + */ + + if (typecheck_grob (symbol, new_value)) { - 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->set_property (context_property, scm_cons (new_alist, daddy)); + SCM cell = scm_cons (symbol, new_value); + props_->alist_ = scm_cons (cell, props_->alist_); + return cell; } + return SCM_EOL; } +void +Grob_property_info::matched_pop (SCM cell) +{ + if (!scm_is_pair (cell)) + return; + if (!check ()) + return; + SCM current_alist = props_->alist_; + SCM daddy = props_->based_on_; + for (SCM p = current_alist; !scm_is_eq (p, daddy); p = scm_cdr (p)) + { + if (scm_is_eq (scm_car (p), cell)) + { + if (scm_is_pair (scm_car (cell))) + props_->nested_--; + props_->alist_ = partial_list_copy (current_alist, p, scm_cdr (p)); + return; + } + } + return; +} + +/* + Revert the property given by property_path. +*/ +void +Grob_property_info::pop (SCM grob_property_path) +{ + if (!check ()) + return; + + SCM current_alist = props_->alist_; + SCM daddy = props_->based_on_; + + 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; + } + + if (scm_is_pair (scm_cdr (grob_property_path))) + { + SCM old_alist = current_alist; + current_alist = evict_from_alist (grob_property_path, current_alist, daddy); + if (scm_is_eq (old_alist, current_alist)) + return; + props_->nested_--; + } + else + current_alist = evict_from_alist (scm_car (grob_property_path), + current_alist, daddy); + + if (scm_is_eq (current_alist, daddy)) + { + assert (props_->nested_ == 0); + props_ = 0; + context_->unset_property (symbol_); + return; + } + props_->alist_ = current_alist; +} +/* + 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 grob, + SCM grob_property, + SCM new_value) { - general_pushpop_property (context, context_property, - scm_list_1 (grob_property), - new_value); + Grob_property_info (context, grob).pushpop (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 (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 context_prop = scm_car (entry); + SCM val = scm_cadr (entry); + SCM grob_prop_path = scm_cddr (entry); + Grob_property_info (tg, context_prop).push (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 context_prop = scm_car (entry); + SCM grob_prop_path = scm_cdr (entry); + Grob_property_info (tg, context_prop).pop (grob_prop_path); + } 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)); } } @@ -231,45 +347,31 @@ apply_property_operations (Context *tg, SCM pre_init_ops) Return the object alist for SYM, checking if its base in enclosing contexts has changed. The alist is updated if necessary. */ -SCM -updated_grob_properties (Context *tg, SCM sym) +SCM Grob_property_info::updated () { - assert (scm_is_symbol (sym)); + assert (scm_is_symbol (symbol_)); - SCM props; - tg = tg->where_defined (sym, &props); - if (!tg) + Grob_property_info where = find (); + + if (!where) return SCM_EOL; - SCM daddy_props - = (tg->get_parent_context ()) - ? updated_grob_properties (tg->get_parent_context (), sym) - : SCM_EOL; + Context *dad = where.context_->get_parent_context (); - if (!scm_is_pair (props)) - { - programming_error ("grob props not a pair?"); - return SCM_EOL; - } + SCM daddy_props + = dad ? Grob_property_info (dad, symbol_).updated () : SCM_EOL; - SCM based_on = scm_cdr (props); - if (based_on == daddy_props) - return scm_car (props); - else + SCM based_on = where.props_->based_on_; + SCM alist = where.props_->alist_; + if (!scm_is_eq (based_on, daddy_props)) { - SCM copy = daddy_props; - 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); - } - - scm_set_car_x (props, copy); - scm_set_cdr_x (props, daddy_props); - - return copy; + where.props_->based_on_ = daddy_props; + alist = partial_list_copy (alist, based_on, daddy_props); + where.props_->alist_ = alist; } + if (scm_is_eq (where.props_->cooked_from_, alist)) + return where.props_->cooked_; + where.props_->cooked_from_ = alist; + where.props_->cooked_ = nalist_to_alist (alist, where.props_->nested_); + return where.props_->cooked_; }