X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Fcontext-property.cc;h=534fced49aacc813db06a76a0d63c4768516fc14;hb=aa2b5b377586a52fcb6b14d4dd464b94f6738560;hp=b5bff1664c1184b0a37918122cc924ba4a1468d6;hpb=ba9f8c7b737b63c29e1a7f6956c7cec69d1180bb;p=lilypond.git diff --git a/lily/context-property.cc b/lily/context-property.cc index b5bff1664c..534fced49a 100644 --- a/lily/context-property.cc +++ b/lily/context-property.cc @@ -1,223 +1,443 @@ /* - 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 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 "smobs.hh" #include "spanner.hh" +#include "unpure-pure-container.hh" #include "warn.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 = unsmob (value)) + return typecheck_grob (symbol, upc->unpure_part ()) + && typecheck_grob (symbol, upc->pure_part ()); + return ly_is_procedure (value) + || type_check_assignment (symbol, value, ly_symbol2scm ("backend-type?")); +} + +class Grob_properties : public Simple_smob +{ +public: + SCM mark_smob () const; + 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_ Or rather: of + // entries that must not appear in the cooked list and are + // identified by having a "key" that is not a symbol. Temporary + // overrides and reverts also meet that description and have a + // nominal key of #t/#f and a value of the original cons cell. + 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 () const +{ + 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_, unsmob (res)); + props_ = unsmob (res); + return *this; +} + +bool +Grob_property_info::check () +{ + if (props_) + return true; + SCM res = SCM_UNDEFINED; + if (context_->here_defined (symbol_, &res)) + props_ = 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 = 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_ = 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 (ELTPROP . VAL) - entry from a translator property list by name of PROP + 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; + } -void -execute_pushpop_property (Context * trg, - SCM prop, SCM eltprop, SCM val) + /* 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; +} + +// Used for \once \override, returns a token for matched_pop +SCM +Grob_property_info::temporary_override (SCM grob_property_path, SCM new_value) +{ + SCM cell = push (grob_property_path, new_value); + if (!scm_is_pair (cell)) + return cell; + if (scm_is_symbol (scm_car (cell))) + props_->nested_++; + cell = scm_cons (SCM_BOOL_T, cell); + props_->alist_ = scm_cons (cell, scm_cdr (props_->alist_)); + return cell; +} + +// Used for \once \revert, returns a token for matched_pop +SCM +Grob_property_info::temporary_revert (SCM grob_property_path) { - if (scm_is_symbol (prop) && scm_is_symbol (eltprop)) + if (!check ()) + return SCM_EOL; + + SCM current_alist = props_->alist_; + SCM daddy = props_->based_on_; + SCM tail = SCM_EOL; + + 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_EOL; + } + + if (scm_is_pair (scm_cdr (grob_property_path))) { - if (val != SCM_UNDEFINED) - { - SCM prev = SCM_EOL; - Context * where = trg->where_defined (prop); - - /* - 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 ; - } - - 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) == trg) - { - 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); - } - - 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)); - } - } + tail = assoc_tail (grob_property_path, current_alist, daddy); + if (scm_is_false (tail)) + return SCM_EOL; } else { - warning ("Need symbol arguments for \\override and \\revert"); - if (do_internal_type_checking_global) - assert (false); + tail = assq_tail (scm_car (grob_property_path), current_alist, daddy); + if (scm_is_false (tail)) + return SCM_EOL; + ++props_->nested_; } + + SCM cell = scm_cons (SCM_BOOL_F, scm_car (tail)); + props_->alist_ = partial_list_copy (current_alist, tail, + scm_cons (cell, scm_cdr (tail))); + return cell; } -/* - PRE_INIT_OPS is in the order specified, and hence must be reversed. - */ + void -apply_property_operations (Context *tg, SCM pre_init_ops) +Grob_property_info::matched_pop (SCM cell) { - SCM correct_order = scm_reverse (pre_init_ops); - for (SCM s = correct_order; scm_is_pair (s); s = scm_cdr (s)) + 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)) { - 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); - } - else if (type == ly_symbol2scm ("assign")) - { - tg->internal_set_property (scm_car (entry), scm_cadr (entry)); - } + if (scm_is_eq (scm_car (p), cell)) + { + SCM key = scm_car (cell); + if (scm_is_false (key)) + { + // temporary revert, reactivate + cell = scm_cdr (cell); + if (scm_is_symbol (scm_car (cell))) + props_->nested_--; + props_->alist_ = partial_list_copy (current_alist, p, + scm_cons (cell, scm_cdr (p))); + return; + } + if (!scm_is_symbol (key)) + props_->nested_--; + props_->alist_ = partial_list_copy (current_alist, p, scm_cdr (p)); + return; + } } + return; } /* - 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) + Revert the property given by property_path. +*/ +void +Grob_property_info::pop (SCM grob_property_path) { - assert (scm_is_symbol (sym)); - - tg = tg->where_defined (sym); - 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 (!check ()) + return; - if (!scm_is_pair (props)) + 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 props not a pair?"); - return SCM_EOL; + programming_error ("Grob property path should be list of symbols."); + return; } - SCM based_on = scm_cdr (props); - if (based_on == daddy_props) + if (scm_is_pair (scm_cdr (grob_property_path))) { - return scm_car (props); + 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)) { - 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; + assert (props_->nested_ == 0); + props_ = 0; + context_->unset_property (symbol_); + return; } + props_->alist_ = current_alist; } - -Item * -make_item_from_properties (Engraver *tr, SCM x, SCM cause, const char * name) +/* + 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) { - 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); + Grob_property_info (context, grob).pushpop (scm_list_1 (grob_property), new_value); +} - dynamic_cast(tr)->announce_grob (it, cause); +/* + PRE_INIT_OPS is in the order specified, and hence must be reversed. +*/ +void +apply_property_operations (Context *tg, SCM pre_init_ops) +{ + 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); - return it; + if (scm_is_eq (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 (scm_is_eq (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 (scm_is_eq (type, ly_symbol2scm ("assign"))) + tg->set_property (scm_car (entry), scm_cadr (entry)); + else if (scm_is_eq (type, ly_symbol2scm ("apply"))) + scm_apply_1 (scm_car (entry), tg->self_scm (), scm_cdr (entry)); + else if (scm_is_eq (type, ly_symbol2scm ("unset"))) + tg->unset_property (scm_car (entry)); + } } -Spanner* -make_spanner_from_properties (Engraver *tr, SCM x, SCM cause, const char *name) +/* + Return the object alist for SYM, checking if its base in enclosing + contexts has changed. The alist is updated if necessary. +*/ +SCM Grob_property_info::updated () { - Context *context = tr->context (); + assert (scm_is_symbol (symbol_)); + + Grob_property_info where = find (); - SCM props = updated_grob_properties (context, x); - Spanner *it = new Spanner (props, context->get_grob_key (name)); + if (!where) + return SCM_EOL; - dynamic_cast(tr)->announce_grob (it, cause); + Context *dad = where.context_->get_parent_context (); - return it; + SCM daddy_props + = dad ? Grob_property_info (dad, symbol_).updated () : SCM_EOL; + + SCM based_on = where.props_->based_on_; + SCM alist = where.props_->alist_; + if (!scm_is_eq (based_on, daddy_props)) + { + 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_; }