X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Fcontext-property.cc;h=99b16f669b116d3028c738e2532918ae01ae265c;hb=812de25cf07823766143b7407bade88b5bb5e13f;hp=5f2c8c70e5e4adeaeea4c67cc57354b4ac0b1000;hpb=2c1ffb66705c456712ad619a5296f080a7433756;p=lilypond.git diff --git a/lily/context-property.cc b/lily/context-property.cc index 5f2c8c70e5..99b16f669b 100644 --- a/lily/context-property.cc +++ b/lily/context-property.cc @@ -1,7 +1,7 @@ /* This file is part of LilyPond, the GNU music typesetter. - Copyright (C) 2004--2014 Han-Wen Nienhuys + Copyright (C) 2004--2015 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 @@ -55,15 +55,20 @@ general_pushpop_property (Context *context, bool typecheck_grob (SCM symbol, SCM value) { - if (is_unpure_pure_container (value)) - return typecheck_grob (symbol, unpure_pure_container_unpure_part (value)) - && typecheck_grob (symbol, unpure_pure_container_pure_part (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) - || is_simple_closure (value) + || unsmob (value) || type_check_assignment (symbol, value, ly_symbol2scm ("backend-type?")); } -class Grob_properties { +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 @@ -87,30 +92,17 @@ class Grob_properties { // order to trigger an initial update. But this should never // happen, so we initialize straight with alist. cooked_ (alist), cooked_from_ (alist), nested_ (0) { } - DECLARE_SIMPLE_SMOBS (Grob_properties); }; -#include "ly-smobs.icc" -IMPLEMENT_SIMPLE_SMOBS (Grob_properties); -IMPLEMENT_DEFAULT_EQUAL_P (Grob_properties); -IMPLEMENT_TYPE_P (Grob_properties, "ly:grob-properties?"); +const char Grob_properties::type_p_name_[] = "ly:grob-properties?"; SCM -Grob_properties::mark_smob (SCM smob) +Grob_properties::mark_smob () const { - Grob_properties *gp = (Grob_properties *) SCM_SMOB_DATA (smob); - scm_gc_mark (gp->alist_); - scm_gc_mark (gp->based_on_); - scm_gc_mark (gp->cooked_); - return gp->cooked_from_; -} - -int -Grob_properties::print_smob (SCM /*smob*/, SCM port, scm_print_state *) -{ - scm_puts ("#", port); - - return 1; + 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", @@ -132,8 +124,8 @@ Grob_property_info::find () 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 Grob_property_info (c, symbol_, unsmob (res)); + props_ = unsmob (res); return *this; } @@ -144,7 +136,7 @@ Grob_property_info::check () return true; SCM res = SCM_UNDEFINED; if (context_->here_defined (symbol_, &res)) - props_ = Grob_properties::unsmob (res); + props_ = unsmob (res); return props_; } @@ -173,7 +165,7 @@ Grob_property_info::create () || !g->here_defined (symbol_, ¤t_context_val)) return false; - Grob_properties *def = Grob_properties::unsmob (current_context_val); + Grob_properties *def = unsmob (current_context_val); if (!def) { @@ -188,7 +180,7 @@ Grob_property_info::create () // 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); + props_ = unsmob (props); return props_; } @@ -198,18 +190,21 @@ Grob_property_info::create () 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 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 +SCM Grob_property_info::push (SCM grob_property_path, SCM new_value) { /* Don't mess with MIDI. */ if (!create ()) - return; + return SCM_EOL; SCM symbol = scm_car (grob_property_path); SCM rest = scm_cdr (grob_property_path); @@ -217,10 +212,12 @@ Grob_property_info::push (SCM grob_property_path, SCM new_value) { // poor man's typechecking if (typecheck_grob (symbol, nested_create_alist (rest, new_value))) { - props_->alist_ = scm_acons (grob_property_path, new_value, props_->alist_); + SCM cell = scm_cons (grob_property_path, new_value); + props_->alist_ = scm_cons (cell, props_->alist_); props_->nested_++; + return cell; } - return; + return SCM_EOL; } /* it's tempting to replace the head of the list if it's the same @@ -229,7 +226,34 @@ Grob_property_info::push (SCM grob_property_path, SCM new_value) */ if (typecheck_grob (symbol, new_value)) - props_->alist_ = scm_acons (symbol, new_value, props_->alist_); + { + 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; } /* @@ -297,24 +321,24 @@ apply_property_operations (Context *tg, SCM pre_init_ops) SCM type = scm_car (entry); entry = scm_cdr (entry); - if (type == ly_symbol2scm ("push")) + 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 (type == ly_symbol2scm ("pop")) + 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 (type == ly_symbol2scm ("assign")) + else if (scm_is_eq (type, ly_symbol2scm ("assign"))) tg->set_property (scm_car (entry), scm_cadr (entry)); - else if (type == ly_symbol2scm ("apply")) + else if (scm_is_eq (type, ly_symbol2scm ("apply"))) scm_apply_1 (scm_car (entry), tg->self_scm (), scm_cdr (entry)); - else if (type == ly_symbol2scm ("unset")) + else if (scm_is_eq (type, ly_symbol2scm ("unset"))) tg->unset_property (scm_car (entry)); } }