2 context-property.cc -- implement manipulation of immutable Grob
5 source file of the GNU LilyPond music typesetter
7 (c) 2004--2007 Han-Wen Nienhuys <hanwen@xs4all.nl>
11 #include "engraver.hh"
12 #include "international.hh"
15 #include "simple-closure.hh"
20 lookup_nested_property (SCM alist,
21 SCM grob_property_path)
23 if (scm_is_pair (grob_property_path))
25 SCM sym = scm_car (grob_property_path);
26 SCM handle = scm_assq (sym, alist);
28 if (handle == SCM_BOOL_F)
31 return lookup_nested_property (scm_cdr (handle),
32 scm_cdr (grob_property_path));
39 copy ALIST leaving out SYMBOL. Copying stops at ALIST_END
42 evict_from_alist (SCM symbol,
46 SCM new_alist = SCM_EOL;
47 SCM *tail = &new_alist;
49 while (alist != alist_end)
51 if (ly_is_equal (scm_caar (alist), symbol))
53 alist = scm_cdr (alist);
57 *tail = scm_cons (scm_car (alist), SCM_EOL);
58 tail = SCM_CDRLOC (*tail);
59 alist = scm_cdr (alist);
67 general_pushpop_property (Context *context,
69 SCM grob_property_path,
73 if (!scm_is_symbol (context_property)
74 || !scm_is_symbol (scm_car (grob_property_path)))
76 warning (_ ("need symbol arguments for \\override and \\revert"));
77 if (do_internal_type_checking_global)
81 execute_general_pushpop_property (context, context_property,
82 grob_property_path, new_value);
88 Grob descriptions (ie. alists with layout properties) are
89 represented as a (ALIST . BASED-ON) pair, where BASED-ON is the
90 alist defined in a parent context. BASED-ON should always be a tail
93 Push or pop (depending on value of VAL) a single entry entry from a
94 translator property list by name of PROP. GROB_PROPERTY_PATH
95 indicates nested alists, eg. '(beamed-stem-lengths details)
99 execute_general_pushpop_property (Context *context,
100 SCM context_property,
101 SCM grob_property_path,
105 SCM current_context_val = SCM_EOL;
106 if (new_value != SCM_UNDEFINED)
108 Context *where = context->where_defined (context_property, ¤t_context_val);
111 Don't mess with MIDI.
116 if (where != context)
118 SCM base = updated_grob_properties (context, context_property);
119 current_context_val = scm_cons (base, base);
120 context->set_property (context_property, current_context_val);
123 if (!scm_is_pair (current_context_val))
125 programming_error ("Grob definition should be cons");
129 SCM prev_alist = scm_car (current_context_val);
130 SCM symbol = scm_car (grob_property_path);
132 = lookup_nested_property (prev_alist,
133 scm_reverse (scm_cdr (grob_property_path)));
135 target_alist = scm_acons (symbol, new_value, target_alist);
138 if (!scm_is_pair (scm_cdr (grob_property_path)))
140 if (!ly_is_procedure (new_value)
141 && !is_simple_closure (new_value))
142 ok = type_check_assignment (symbol, new_value,
143 ly_symbol2scm ("backend-type?"));
146 tack onto alist. We can use set_car, since
147 updated_grob_properties() in child contexts will check
148 for changes in the car.
152 scm_set_car_x (current_context_val, target_alist);
157 execute_general_pushpop_property (context,
159 scm_cdr (grob_property_path),
164 else if (context->where_defined (context_property, ¤t_context_val) == context)
166 SCM current_value = scm_car (current_context_val);
167 SCM daddy = scm_cdr (current_context_val);
169 if (!scm_is_pair (grob_property_path)
170 || !scm_is_symbol (scm_car (grob_property_path)))
172 programming_error ("Grob property path should be list of symbols.");
176 SCM symbol = scm_car (grob_property_path);
177 SCM new_alist = evict_from_alist (symbol, current_value, daddy);
179 if (new_alist == daddy)
180 context->unset_property (context_property);
182 context->set_property (context_property, scm_cons (new_alist, daddy));
187 execute_pushpop_property (Context *context,
188 SCM context_property,
193 general_pushpop_property (context, context_property,
194 scm_list_1 (grob_property),
199 PRE_INIT_OPS is in the order specified, and hence must be reversed.
202 apply_property_operations (Context *tg, SCM pre_init_ops)
204 SCM correct_order = scm_reverse (pre_init_ops);
205 for (SCM s = correct_order; scm_is_pair (s); s = scm_cdr (s))
207 SCM entry = scm_car (s);
208 SCM type = scm_car (entry);
209 entry = scm_cdr (entry);
211 if (type == ly_symbol2scm ("push"))
213 SCM context_prop = scm_car (entry);
214 SCM val = scm_cadr (entry);
215 SCM grob_prop_path = scm_cddr (entry);
216 execute_general_pushpop_property (tg, context_prop, grob_prop_path, val);
218 else if (type == ly_symbol2scm ("pop"))
220 SCM context_prop = scm_car (entry);
221 SCM val = SCM_UNDEFINED;
222 SCM grob_prop_path = scm_cdr (entry);
223 execute_general_pushpop_property (tg, context_prop, grob_prop_path, val);
225 else if (type == ly_symbol2scm ("assign"))
226 tg->set_property (scm_car (entry), scm_cadr (entry));
231 Return the object alist for SYM, checking if its base in enclosing
232 contexts has changed. The alist is updated if necessary.
235 updated_grob_properties (Context *tg, SCM sym)
237 assert (scm_is_symbol (sym));
240 tg = tg->where_defined (sym, &props);
245 = (tg->get_parent_context ())
246 ? updated_grob_properties (tg->get_parent_context (), sym)
249 if (!scm_is_pair (props))
251 programming_error ("grob props not a pair?");
255 SCM based_on = scm_cdr (props);
256 if (based_on == daddy_props)
257 return scm_car (props);
260 SCM copy = daddy_props;
262 SCM p = scm_car (props);
263 while (p != based_on)
265 *tail = scm_cons (scm_car (p), daddy_props);
266 tail = SCM_CDRLOC (*tail);
270 scm_set_car_x (props, copy);
271 scm_set_cdr_x (props, daddy_props);