X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Fcontext-property.cc;h=502fc92f11a3c3ef8902999eb7ad9022744c3825;hb=47db9a3883d726ca53e2133a3b2298f78dd6a32e;hp=880086209a61b0e911d1375d3b607a0358d485e6;hpb=b4d2043223a86826764bc531e684a864c97605fe;p=lilypond.git diff --git a/lily/context-property.cc b/lily/context-property.cc index 880086209a..62e04a2732 100644 --- a/lily/context-property.cc +++ b/lily/context-property.cc @@ -1,115 +1,312 @@ /* - 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--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 "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" -#include "paper-column.hh" + +/* + 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_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); + } + + Grob_property_info (context, context_property).pushpop + (grob_property_path, new_value); +} + +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 +Grob_properties::mark_smob () +{ + scm_gc_mark (alist_); + scm_gc_mark (based_on_); + scm_gc_mark (cooked_); + return cooked_from_; +} + +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 (); +} + + +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; +} + +bool +Grob_property_info::check () +{ + 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) + { + programming_error ("Grob definition expected"); + return false; + } + + // 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 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. */ +SCM +Grob_property_info::push (SCM grob_property_path, SCM new_value) +{ + /* + 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)) + { + // 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; + } + + /* 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 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; +} /* - Push or pop (depending on value of VAL) a single entry (ELTPROP . VAL) - entry from a translator property list by name of PROP + Revert the property given by property_path. */ - void -execute_pushpop_property (Context *trg, - SCM prop, SCM eltprop, SCM val) +Grob_property_info::pop (SCM grob_property_path) { - SCM prev = SCM_EOL; - if (scm_is_symbol (prop) && scm_is_symbol (eltprop)) + 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))) { - if (val != SCM_UNDEFINED) - { - Context *where = trg->where_defined (prop, &prev); - - /* - 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); - } - - if (!scm_is_pair (prev)) - { - programming_error ("Grob definition should be cons"); - 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?")); - - /* - tack onto alist: - */ - if (ok) - scm_set_car_x (prev, scm_acons (eltprop, val, prev_alist)); - } - else - { - // warning here. - } - } - else if (trg->where_defined (prop, &prev) == trg) - { - 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_is_equal (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); - } - - if (new_alist == SCM_EOL && prev_alist == daddy) - trg->unset_property (prop); - else - { - *tail = prev_alist; - trg->internal_set_property (prop, scm_cons (new_alist, daddy)); - } - } + 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)) { - warning (_ ("need symbol arguments for \\override and \\revert")); - if (do_internal_type_checking_global) - assert (false); + 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 grob, + SCM grob_property, + SCM new_value) +{ + Grob_property_info (context, grob).pushpop (scm_list_1 (grob_property), new_value); } /* @@ -118,24 +315,31 @@ execute_pushpop_property (Context *trg, 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") || type == ly_symbol2scm ("poppush")) - { - SCM val = scm_cddr (entry); - val = scm_is_pair (val) ? scm_car (val) : SCM_UNDEFINED; - - 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); + Grob_property_info (tg, context_prop).push (grob_prop_path, val); + } + else if (type == ly_symbol2scm ("pop")) + { + 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->internal_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)); } } @@ -143,96 +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_)); + + Grob_property_info where = find (); - SCM props; - tg = tg->where_defined (sym, &props); - if (!tg) + 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; } -} - -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; + 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_; }