2 context-property.cc -- implement manipulation of immutable Grob
5 source file of the GNU LilyPond music typesetter
7 (c) 2004--2009 Han-Wen Nienhuys <hanwen@xs4all.nl>
11 #include "engraver.hh"
12 #include "international.hh"
15 #include "simple-closure.hh"
20 like execute_general_pushpop_property(), but typecheck
21 grob_property_path and context_property.
24 general_pushpop_property (Context *context,
26 SCM grob_property_path,
29 if (!scm_is_symbol (context_property)
30 || !scm_is_symbol (scm_car (grob_property_path)))
32 warning (_ ("need symbol arguments for \\override and \\revert"));
33 if (do_internal_type_checking_global)
37 sloppy_general_pushpop_property (context, context_property,
38 grob_property_path, new_value);
43 Grob descriptions (ie. alists with layout properties) are
44 represented as a (ALIST . BASED-ON) pair, where BASED-ON is the
45 alist defined in a parent context. BASED-ON should always be a tail
48 Push or pop (depending on value of VAL) a single entry entry from a
49 translator property list by name of PROP. GROB_PROPERTY_PATH
50 indicates nested alists, eg. '(beamed-stem-lengths details)
54 execute_override_property (Context *context,
56 SCM grob_property_path,
59 SCM current_context_val = SCM_EOL;
61 Context *where = context->where_defined (context_property,
62 ¤t_context_val);
72 SCM base = updated_grob_properties (context, context_property);
73 current_context_val = scm_cons (base, base);
74 context->set_property (context_property, current_context_val);
77 if (!scm_is_pair (current_context_val))
79 programming_error ("Grob definition should be cons");
83 SCM target_alist = scm_car (current_context_val);
85 SCM symbol = scm_car (grob_property_path);
86 if (scm_is_pair (scm_cdr (grob_property_path)))
88 new_value = nested_property_alist (ly_assoc_get (symbol, target_alist,
90 scm_cdr (grob_property_path),
94 /* it's tempting to replace the head of the list if it's the same
95 property. However, we have to keep this info around, in case we have to
98 target_alist = scm_acons (symbol, new_value, target_alist);
101 if (!ly_is_procedure (new_value)
102 && !is_simple_closure (new_value))
103 ok = type_check_assignment (symbol, new_value,
104 ly_symbol2scm ("backend-type?"));
107 tack onto alist. We can use set_car, since
108 updated_grob_properties () in child contexts will check
109 for changes in the car.
113 scm_set_car_x (current_context_val, target_alist);
118 do a pop (indicated by new_value==SCM_UNDEFINED) or push
121 sloppy_general_pushpop_property (Context *context,
122 SCM context_property,
123 SCM grob_property_path,
126 if (new_value == SCM_UNDEFINED)
127 execute_revert_property (context, context_property,
130 execute_override_property (context, context_property,
136 Revert the property given by property_path.
139 execute_revert_property (Context *context,
140 SCM context_property,
141 SCM grob_property_path)
143 SCM current_context_val = SCM_EOL;
144 if (context->where_defined (context_property, ¤t_context_val)
147 SCM current_alist = scm_car (current_context_val);
148 SCM daddy = scm_cdr (current_context_val);
150 if (!scm_is_pair (grob_property_path)
151 || !scm_is_symbol (scm_car (grob_property_path)))
153 programming_error ("Grob property path should be list of symbols.");
157 SCM symbol = scm_car (grob_property_path);
158 if (scm_is_pair (scm_cdr (grob_property_path)))
160 SCM current_sub_alist = ly_assoc_get (symbol, current_alist, SCM_EOL);
162 = nested_property_revert_alist (current_sub_alist,
163 scm_cdr (grob_property_path));
165 if (scm_is_pair (current_alist)
166 && scm_caar (current_alist) == symbol
167 && current_alist != daddy)
168 current_alist = scm_cdr (current_alist);
170 current_alist = scm_acons (symbol, new_val, current_alist);
171 scm_set_car_x (current_context_val, current_alist);
175 SCM new_alist = evict_from_alist (symbol, current_alist, daddy);
177 if (new_alist == daddy)
178 context->unset_property (context_property);
180 context->set_property (context_property,
181 scm_cons (new_alist, daddy));
186 Convenience: a push/pop grob property using a single grob_property
190 execute_pushpop_property (Context *context,
191 SCM context_property,
195 general_pushpop_property (context, context_property,
196 scm_list_1 (grob_property),
201 PRE_INIT_OPS is in the order specified, and hence must be reversed.
204 apply_property_operations (Context *tg, SCM pre_init_ops)
206 SCM correct_order = scm_reverse (pre_init_ops);
207 for (SCM s = correct_order; scm_is_pair (s); s = scm_cdr (s))
209 SCM entry = scm_car (s);
210 SCM type = scm_car (entry);
211 entry = scm_cdr (entry);
213 if (type == ly_symbol2scm ("push"))
215 SCM context_prop = scm_car (entry);
216 SCM val = scm_cadr (entry);
217 SCM grob_prop_path = scm_cddr (entry);
218 sloppy_general_pushpop_property (tg, context_prop, grob_prop_path, val);
220 else if (type == ly_symbol2scm ("pop"))
222 SCM context_prop = scm_car (entry);
223 SCM val = SCM_UNDEFINED;
224 SCM grob_prop_path = scm_cdr (entry);
225 sloppy_general_pushpop_property (tg, context_prop, grob_prop_path, val);
227 else if (type == ly_symbol2scm ("assign"))
228 tg->set_property (scm_car (entry), scm_cadr (entry));
233 Return the object alist for SYM, checking if its base in enclosing
234 contexts has changed. The alist is updated if necessary.
237 updated_grob_properties (Context *tg, SCM sym)
239 assert (scm_is_symbol (sym));
242 tg = tg->where_defined (sym, &props);
247 = (tg->get_parent_context ())
248 ? updated_grob_properties (tg->get_parent_context (), sym)
251 if (!scm_is_pair (props))
253 programming_error ("grob props not a pair?");
257 SCM based_on = scm_cdr (props);
258 if (based_on == daddy_props)
259 return scm_car (props);
262 SCM copy = daddy_props;
264 SCM p = scm_car (props);
265 while (p != based_on)
267 *tail = scm_cons (scm_car (p), daddy_props);
268 tail = SCM_CDRLOC (*tail);
272 scm_set_car_x (props, copy);
273 scm_set_cdr_x (props, daddy_props);