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
);