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 if (!scm_is_symbol (context_property)
43 || !scm_is_symbol (scm_car (grob_property_path)))
45 warning (_ ("need symbol arguments for \\override and \\revert"));
46 if (do_internal_type_checking_global)
50 Grob_property_info (context, context_property).pushpop
51 (grob_property_path, new_value);
55 typecheck_grob (SCM symbol, SCM value)
57 if (Unpure_pure_container *upc = unsmob<Unpure_pure_container> (value))
58 return typecheck_grob (symbol, upc->unpure_part ())
59 && typecheck_grob (symbol, upc->pure_part ());
60 return ly_is_procedure (value)
61 || type_check_assignment (symbol, value, ly_symbol2scm ("backend-type?"));
64 class Grob_properties : public Simple_smob<Grob_properties>
67 SCM mark_smob () const;
68 static const char type_p_name_[];
70 friend class Grob_property_info;
71 friend SCM ly_make_grob_properties (SCM);
72 // alist_ may contain unexpanded nested overrides
74 // based_on_ is the cooked_ value from the next higher context that
77 // cooked_ is a version of alist_ where nested overrides have been
80 // cooked_from_ is the value of alist_ from which the expansion has
83 // nested_ is a count of nested overrides in alist_ Or rather: of
84 // entries that must not appear in the cooked list and are
85 // identified by having a "key" that is not a symbol. Temporary
86 // overrides and reverts also meet that description and have a
87 // nominal key of #t/#f and a value of the original cons cell.
90 Grob_properties (SCM alist, SCM based_on) :
91 alist_ (alist), based_on_ (based_on),
92 // if the constructor was called with lists possibly containing
93 // partial overrides, we would need to initialize with based_on in
94 // order to trigger an initial update. But this should never
95 // happen, so we initialize straight with alist.
96 cooked_ (alist), cooked_from_ (alist), nested_ (0) { }
99 const char Grob_properties::type_p_name_[] = "ly:grob-properties?";
102 Grob_properties::mark_smob () const
104 scm_gc_mark (alist_);
105 scm_gc_mark (based_on_);
106 scm_gc_mark (cooked_);
110 LY_DEFINE (ly_make_grob_properties, "ly:make-grob-properties",
111 1, 0, 0, (SCM alist),
112 "This packages the given property list @var{alist} in"
113 " a grob property container stored in a context property"
114 " with the name of a grob.")
116 LY_ASSERT_TYPE (ly_is_list, alist, 1);
117 return Grob_properties (alist, SCM_EOL).smobbed_copy ();
122 Grob_property_info::find ()
126 SCM res = SCM_UNDEFINED;
127 if (Context *c = context_->where_defined (symbol_, &res))
129 return Grob_property_info (c, symbol_, unsmob<Grob_properties> (res));
130 props_ = unsmob<Grob_properties> (res);
135 Grob_property_info::check ()
139 SCM res = SCM_UNDEFINED;
140 if (context_->here_defined (symbol_, &res))
141 props_ = unsmob<Grob_properties> (res);
146 Grob_property_info::create ()
148 // Using scm_hashq_create_handle_x would seem like the one-lookup
149 // way to create a handle if it does not exist yet. However, we
150 // need to check that there is a corresponding grob in this
151 // particular output first, and we have to do this in the global
152 // context. By far the most frequent case will be that a
153 // Grob_properties for this context already exists, so we optimize
154 // for that and only check the global handle when the local
155 // context is pristine.
158 SCM current_context_val = SCM_EOL;
159 Context *g = context_->get_global_context ();
161 return false; // Context is probably dead
164 Don't mess with MIDI.
167 || !g->here_defined (symbol_, ¤t_context_val))
170 Grob_properties *def = unsmob<Grob_properties> (current_context_val);
174 programming_error ("Grob definition expected");
178 // We create the new Grob_properties from the default definition
179 // since this is what we have available right now. It may or may
180 // not be accurate since we don't take into account any
181 // prospective overrides in intermediate contexts. If there are
182 // any, they will be factored in when `updated' is being called.
183 SCM props = Grob_properties (def->alist_, def->alist_).smobbed_copy ();
184 context_->set_property (symbol_, props);
185 props_ = unsmob<Grob_properties> (props);
190 Grob descriptions (ie. alists with layout properties) are
191 represented as a (ALIST . BASED-ON) pair, where BASED-ON is the
192 alist defined in a parent context. BASED-ON should always be a tail
195 Push a single entry from a
196 translator property list by name of PROP. GROB_PROPERTY_PATH
197 indicates nested alists, eg. '(beamed-stem-lengths details)
199 Return value can be passed to matched_pop and will only cancel the
203 Grob_property_info::push (SCM grob_property_path, SCM new_value)
206 Don't mess with MIDI.
211 SCM symbol = scm_car (grob_property_path);
212 SCM rest = scm_cdr (grob_property_path);
213 if (scm_is_pair (rest))
215 // poor man's typechecking
216 if (typecheck_grob (symbol, nested_create_alist (rest, new_value))) {
217 SCM cell = scm_cons (grob_property_path, new_value);
218 props_->alist_ = scm_cons (cell, props_->alist_);
225 /* it's tempting to replace the head of the list if it's the same
226 property. However, we have to keep this info around, in case we have to
230 if (typecheck_grob (symbol, new_value))
232 SCM cell = scm_cons (symbol, new_value);
233 props_->alist_ = scm_cons (cell, props_->alist_);
239 // Used for \once \override, returns a token for matched_pop
241 Grob_property_info::temporary_override (SCM grob_property_path, SCM new_value)
243 SCM cell = push (grob_property_path, new_value);
244 if (!scm_is_pair (cell))
246 if (scm_is_symbol (scm_car (cell)))
248 cell = scm_cons (SCM_BOOL_T, cell);
249 props_->alist_ = scm_cons (cell, scm_cdr (props_->alist_));
253 // Used for \once \revert, returns a token for matched_pop
255 Grob_property_info::temporary_revert (SCM grob_property_path)
260 SCM current_alist = props_->alist_;
261 SCM daddy = props_->based_on_;
264 if (!scm_is_pair (grob_property_path)
265 || !scm_is_symbol (scm_car (grob_property_path)))
267 programming_error ("Grob property path should be list of symbols.");
271 if (scm_is_pair (scm_cdr (grob_property_path)))
273 tail = assoc_tail (grob_property_path, current_alist, daddy);
274 if (scm_is_false (tail))
279 tail = assq_tail (scm_car (grob_property_path), current_alist, daddy);
280 if (scm_is_false (tail))
285 SCM cell = scm_cons (SCM_BOOL_F, scm_car (tail));
286 props_->alist_ = partial_list_copy (current_alist, tail,
287 scm_cons (cell, scm_cdr (tail)));
293 Grob_property_info::matched_pop (SCM cell)
295 if (!scm_is_pair (cell))
299 SCM current_alist = props_->alist_;
300 SCM daddy = props_->based_on_;
301 for (SCM p = current_alist; !scm_is_eq (p, daddy); p = scm_cdr (p))
303 if (scm_is_eq (scm_car (p), cell))
305 SCM key = scm_car (cell);
306 if (scm_is_false (key))
308 // temporary revert, reactivate
309 cell = scm_cdr (cell);
310 if (scm_is_symbol (scm_car (cell)))
312 props_->alist_ = partial_list_copy (current_alist, p,
313 scm_cons (cell, scm_cdr (p)));
316 if (!scm_is_symbol (key))
318 props_->alist_ = partial_list_copy (current_alist, p, scm_cdr (p));
326 Revert the property given by property_path.
329 Grob_property_info::pop (SCM grob_property_path)
334 SCM current_alist = props_->alist_;
335 SCM daddy = props_->based_on_;
337 if (!scm_is_pair (grob_property_path)
338 || !scm_is_symbol (scm_car (grob_property_path)))
340 programming_error ("Grob property path should be list of symbols.");
344 if (scm_is_pair (scm_cdr (grob_property_path)))
346 SCM old_alist = current_alist;
347 current_alist = evict_from_alist (grob_property_path, current_alist, daddy);
348 if (scm_is_eq (old_alist, current_alist))
353 current_alist = evict_from_alist (scm_car (grob_property_path),
354 current_alist, daddy);
356 if (scm_is_eq (current_alist, daddy))
358 assert (props_->nested_ == 0);
360 context_->unset_property (symbol_);
363 props_->alist_ = current_alist;
366 Convenience: a push/pop grob property using a single grob_property
370 execute_pushpop_property (Context *context,
375 Grob_property_info (context, grob).pushpop (scm_list_1 (grob_property), new_value);
379 PRE_INIT_OPS is in the order specified, and hence must be reversed.
382 apply_property_operations (Context *tg, SCM pre_init_ops)
384 for (SCM s = pre_init_ops; scm_is_pair (s); s = scm_cdr (s))
386 SCM entry = scm_car (s);
387 SCM type = scm_car (entry);
388 entry = scm_cdr (entry);
390 if (scm_is_eq (type, ly_symbol2scm ("push")))
392 SCM context_prop = scm_car (entry);
393 SCM val = scm_cadr (entry);
394 SCM grob_prop_path = scm_cddr (entry);
395 Grob_property_info (tg, context_prop).push (grob_prop_path, val);
397 else if (scm_is_eq (type, ly_symbol2scm ("pop")))
399 SCM context_prop = scm_car (entry);
400 SCM grob_prop_path = scm_cdr (entry);
401 Grob_property_info (tg, context_prop).pop (grob_prop_path);
403 else if (scm_is_eq (type, ly_symbol2scm ("assign")))
404 tg->set_property (scm_car (entry), scm_cadr (entry));
405 else if (scm_is_eq (type, ly_symbol2scm ("apply")))
406 scm_apply_1 (scm_car (entry), tg->self_scm (), scm_cdr (entry));
407 else if (scm_is_eq (type, ly_symbol2scm ("unset")))
408 tg->unset_property (scm_car (entry));
413 Return the object alist for SYM, checking if its base in enclosing
414 contexts has changed. The alist is updated if necessary.
416 SCM Grob_property_info::updated ()
418 assert (scm_is_symbol (symbol_));
420 Grob_property_info where = find ();
425 Context *dad = where.context_->get_parent_context ();
428 = dad ? Grob_property_info (dad, symbol_).updated () : SCM_EOL;
430 SCM based_on = where.props_->based_on_;
431 SCM alist = where.props_->alist_;
432 if (!scm_is_eq (based_on, daddy_props))
434 where.props_->based_on_ = daddy_props;
435 alist = partial_list_copy (alist, based_on, daddy_props);
436 where.props_->alist_ = alist;
438 if (scm_is_eq (where.props_->cooked_from_, alist))
439 return where.props_->cooked_;
440 where.props_->cooked_from_ = alist;
441 where.props_->cooked_ = nalist_to_alist (alist, where.props_->nested_);
442 return where.props_->cooked_;