2 This file is part of LilyPond, the GNU music typesetter.
4 Copyright (C) 2004--2015 Han-Wen Nienhuys <hanwen@xs4all.nl>
6 LilyPond is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
11 LilyPond is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
21 #include "engraver.hh"
22 #include "global-context.hh"
23 #include "grob-properties.hh"
24 #include "international.hh"
29 #include "unpure-pure-container.hh"
33 like execute_general_pushpop_property(), but typecheck
34 grob_property_path and context_property.
37 general_pushpop_property (Context *context,
39 SCM grob_property_path,
42 // Numbers may appear, but not in first place
43 if (!scm_is_symbol (context_property)
44 || !scm_is_symbol (scm_car (grob_property_path)))
46 warning (_ ("need symbol argument for \\override and \\revert"));
47 if (do_internal_type_checking_global)
51 Grob_property_info (context, context_property).pushpop
52 (grob_property_path, new_value);
56 typecheck_grob (SCM symbol, SCM value)
58 if (Unpure_pure_container *upc = unsmob<Unpure_pure_container> (value))
59 return typecheck_grob (symbol, upc->unpure_part ())
60 && typecheck_grob (symbol, upc->pure_part ());
61 return ly_is_procedure (value)
62 || type_check_assignment (symbol, value, ly_symbol2scm ("backend-type?"));
65 class Grob_properties : public Simple_smob<Grob_properties>
68 SCM mark_smob () const;
69 static const char type_p_name_[];
71 friend class Grob_property_info;
72 friend SCM ly_make_grob_properties (SCM);
73 // alist_ may contain unexpanded nested overrides
75 // based_on_ is the cooked_ value from the next higher context that
78 // cooked_ is a version of alist_ where nested overrides have been
81 // cooked_from_ is the value of alist_ from which the expansion has
84 // nested_ is a count of nested overrides in alist_ Or rather: of
85 // entries that must not appear in the cooked list and are
86 // identified by having a "key" that is not a symbol. Temporary
87 // overrides and reverts also meet that description and have a
88 // nominal key of #t/#f and a value of the original cons cell.
91 Grob_properties (SCM alist, SCM based_on) :
92 alist_ (alist), based_on_ (based_on),
93 // if the constructor was called with lists possibly containing
94 // partial overrides, we would need to initialize with based_on in
95 // order to trigger an initial update. But this should never
96 // happen, so we initialize straight with alist.
97 cooked_ (alist), cooked_from_ (alist), nested_ (0) { }
100 const char Grob_properties::type_p_name_[] = "ly:grob-properties?";
103 Grob_properties::mark_smob () const
105 scm_gc_mark (alist_);
106 scm_gc_mark (based_on_);
107 scm_gc_mark (cooked_);
111 LY_DEFINE (ly_make_grob_properties, "ly:make-grob-properties",
112 1, 0, 0, (SCM alist),
113 "This packages the given property list @var{alist} in"
114 " a grob property container stored in a context property"
115 " with the name of a grob.")
117 LY_ASSERT_TYPE (ly_is_list, alist, 1);
118 return Grob_properties (alist, SCM_EOL).smobbed_copy ();
123 Grob_property_info::find ()
127 SCM res = SCM_UNDEFINED;
128 if (Context *c = context_->where_defined (symbol_, &res))
130 return Grob_property_info (c, symbol_, unsmob<Grob_properties> (res));
131 props_ = unsmob<Grob_properties> (res);
136 Grob_property_info::check ()
140 SCM res = SCM_UNDEFINED;
141 if (context_->here_defined (symbol_, &res))
142 props_ = unsmob<Grob_properties> (res);
147 Grob_property_info::create ()
149 // Using scm_hashq_create_handle_x would seem like the one-lookup
150 // way to create a handle if it does not exist yet. However, we
151 // need to check that there is a corresponding grob in this
152 // particular output first, and we have to do this in the global
153 // context. By far the most frequent case will be that a
154 // Grob_properties for this context already exists, so we optimize
155 // for that and only check the global handle when the local
156 // context is pristine.
159 SCM current_context_val = SCM_EOL;
160 Context *g = context_->get_global_context ();
162 return false; // Context is probably dead
165 Don't mess with MIDI.
168 || !g->here_defined (symbol_, ¤t_context_val))
171 Grob_properties *def = unsmob<Grob_properties> (current_context_val);
175 programming_error ("Grob definition expected");
179 // We create the new Grob_properties from the default definition
180 // since this is what we have available right now. It may or may
181 // not be accurate since we don't take into account any
182 // prospective overrides in intermediate contexts. If there are
183 // any, they will be factored in when `updated' is being called.
184 SCM props = Grob_properties (def->alist_, def->alist_).smobbed_copy ();
185 context_->set_property (symbol_, props);
186 props_ = unsmob<Grob_properties> (props);
191 Grob descriptions (ie. alists with layout properties) are
192 represented as a (ALIST . BASED-ON) pair, where BASED-ON is the
193 alist defined in a parent context. BASED-ON should always be a tail
196 Push a single entry from a
197 translator property list by name of PROP. GROB_PROPERTY_PATH
198 indicates nested alists, eg. '(beamed-stem-lengths details)
200 Return value can be passed to matched_pop and will only cancel the
204 Grob_property_info::push (SCM grob_property_path, SCM new_value)
207 Don't mess with MIDI.
212 SCM symbol = scm_car (grob_property_path);
213 SCM rest = scm_cdr (grob_property_path);
214 if (scm_is_pair (rest))
216 // poor man's typechecking
217 if (typecheck_grob (symbol, nested_create_alist (rest, new_value))) {
218 SCM cell = scm_cons (grob_property_path, new_value);
219 props_->alist_ = scm_cons (cell, props_->alist_);
226 /* it's tempting to replace the head of the list if it's the same
227 property. However, we have to keep this info around, in case we have to
231 if (typecheck_grob (symbol, new_value))
233 SCM cell = scm_cons (symbol, new_value);
234 props_->alist_ = scm_cons (cell, props_->alist_);
240 // Used for \once \override, returns a token for matched_pop
242 Grob_property_info::temporary_override (SCM grob_property_path, SCM new_value)
244 SCM cell = push (grob_property_path, new_value);
245 if (!scm_is_pair (cell))
247 if (scm_is_symbol (scm_car (cell)))
249 cell = scm_cons (SCM_BOOL_T, cell);
250 props_->alist_ = scm_cons (cell, scm_cdr (props_->alist_));
254 // Used for \once \revert, returns a token for matched_pop
256 Grob_property_info::temporary_revert (SCM grob_property_path)
261 SCM current_alist = props_->alist_;
262 SCM daddy = props_->based_on_;
265 if (!scm_is_pair (grob_property_path)
266 || !scm_is_symbol (scm_car (grob_property_path)))
268 programming_error ("Grob property path should be list of symbols.");
272 if (scm_is_pair (scm_cdr (grob_property_path)))
274 tail = assoc_tail (grob_property_path, current_alist, daddy);
275 if (scm_is_false (tail))
280 tail = assq_tail (scm_car (grob_property_path), current_alist, daddy);
281 if (scm_is_false (tail))
286 SCM cell = scm_cons (SCM_BOOL_F, scm_car (tail));
287 props_->alist_ = partial_list_copy (current_alist, tail,
288 scm_cons (cell, scm_cdr (tail)));
294 Grob_property_info::matched_pop (SCM cell)
296 if (!scm_is_pair (cell))
300 SCM current_alist = props_->alist_;
301 SCM daddy = props_->based_on_;
302 for (SCM p = current_alist; !scm_is_eq (p, daddy); p = scm_cdr (p))
304 if (scm_is_eq (scm_car (p), cell))
306 SCM key = scm_car (cell);
307 if (scm_is_false (key))
309 // temporary revert, reactivate
310 cell = scm_cdr (cell);
311 if (scm_is_symbol (scm_car (cell)))
313 props_->alist_ = partial_list_copy (current_alist, p,
314 scm_cons (cell, scm_cdr (p)));
317 if (!scm_is_symbol (key))
319 props_->alist_ = partial_list_copy (current_alist, p, scm_cdr (p));
327 Revert the property given by property_path.
330 Grob_property_info::pop (SCM grob_property_path)
335 SCM current_alist = props_->alist_;
336 SCM daddy = props_->based_on_;
338 if (!scm_is_pair (grob_property_path)
339 || !scm_is_symbol (scm_car (grob_property_path)))
341 programming_error ("Grob property path should be list of symbols.");
345 if (scm_is_pair (scm_cdr (grob_property_path)))
347 SCM old_alist = current_alist;
348 current_alist = evict_from_alist (grob_property_path, current_alist, daddy);
349 if (scm_is_eq (old_alist, current_alist))
354 current_alist = evict_from_alist (scm_car (grob_property_path),
355 current_alist, daddy);
357 if (scm_is_eq (current_alist, daddy))
359 assert (props_->nested_ == 0);
361 context_->unset_property (symbol_);
364 props_->alist_ = current_alist;
367 Convenience: a push/pop grob property using a single grob_property
371 execute_pushpop_property (Context *context,
376 Grob_property_info (context, grob).pushpop (scm_list_1 (grob_property), new_value);
380 PRE_INIT_OPS is in the order specified, and hence must be reversed.
383 apply_property_operations (Context *tg, SCM pre_init_ops)
385 for (SCM s = pre_init_ops; scm_is_pair (s); s = scm_cdr (s))
387 SCM entry = scm_car (s);
388 SCM type = scm_car (entry);
389 entry = scm_cdr (entry);
391 if (scm_is_eq (type, ly_symbol2scm ("push")))
393 SCM context_prop = scm_car (entry);
394 SCM val = scm_cadr (entry);
395 SCM grob_prop_path = scm_cddr (entry);
396 Grob_property_info (tg, context_prop).push (grob_prop_path, val);
398 else if (scm_is_eq (type, ly_symbol2scm ("pop")))
400 SCM context_prop = scm_car (entry);
401 SCM grob_prop_path = scm_cdr (entry);
402 Grob_property_info (tg, context_prop).pop (grob_prop_path);
404 else if (scm_is_eq (type, ly_symbol2scm ("assign")))
405 tg->set_property (scm_car (entry), scm_cadr (entry));
406 else if (scm_is_eq (type, ly_symbol2scm ("apply")))
407 scm_apply_1 (scm_car (entry), tg->self_scm (), scm_cdr (entry));
408 else if (scm_is_eq (type, ly_symbol2scm ("unset")))
409 tg->unset_property (scm_car (entry));
414 Return the object alist for SYM, checking if its base in enclosing
415 contexts has changed. The alist is updated if necessary.
417 SCM Grob_property_info::updated ()
419 assert (scm_is_symbol (symbol_));
421 Grob_property_info where = find ();
426 Context *dad = where.context_->get_parent_context ();
429 = dad ? Grob_property_info (dad, symbol_).updated () : SCM_EOL;
431 SCM based_on = where.props_->based_on_;
432 SCM alist = where.props_->alist_;
433 if (!scm_is_eq (based_on, daddy_props))
435 where.props_->based_on_ = daddy_props;
436 alist = partial_list_copy (alist, based_on, daddy_props);
437 where.props_->alist_ = alist;
439 if (scm_is_eq (where.props_->cooked_from_, alist))
440 return where.props_->cooked_;
441 where.props_->cooked_from_ = alist;
442 where.props_->cooked_ = nalist_to_alist (alist, where.props_->nested_);
443 return where.props_->cooked_;