2 context-property.cc -- implement manipulation of immutable Grob
5 source file of the GNU LilyPond music typesetter
7 (c) 2004--2006 Han-Wen Nienhuys <hanwen@xs4all.nl>
11 #include "engraver.hh"
12 #include "international.hh"
15 #include "paper-column.hh"
16 #include "simple-closure.hh"
21 lookup_nested_property (SCM alist
,
22 SCM grob_property_path
)
24 if (scm_is_pair (grob_property_path
))
26 SCM sym
= scm_car (grob_property_path
);
27 SCM handle
= scm_assq (sym
, alist
);
29 if (handle
== SCM_BOOL_F
)
32 return lookup_nested_property (scm_cdr (handle
),
33 scm_cdr (grob_property_path
));
40 copy ALIST leaving out SYMBOL. Copying stops at ALIST_END
43 evict_from_alist (SCM symbol
,
47 SCM new_alist
= SCM_EOL
;
48 SCM
*tail
= &new_alist
;
50 while (alist
!= alist_end
)
52 if (ly_is_equal (scm_caar (alist
), symbol
))
54 alist
= scm_cdr (alist
);
58 *tail
= scm_cons (scm_car (alist
), SCM_EOL
);
59 tail
= SCM_CDRLOC (*tail
);
60 alist
= scm_cdr (alist
);
68 general_pushpop_property (Context
*context
,
70 SCM grob_property_path
,
74 if (!scm_is_symbol (context_property
)
75 || !scm_is_symbol (scm_car (grob_property_path
)))
77 warning (_ ("need symbol arguments for \\override and \\revert"));
78 if (do_internal_type_checking_global
)
82 execute_general_pushpop_property (context
, context_property
,
83 grob_property_path
, new_value
);
89 Grob descriptions (ie. alists with layout properties) are
90 represented as a (ALIST . BASED-ON) pair, where BASED-ON is the
91 alist defined in a parent context. BASED-ON should always be a tail
94 Push or pop (depending on value of VAL) a single entry entry from a
95 translator property list by name of PROP. GROB_PROPERTY_PATH
96 indicates nested alists, eg. '(beamed-stem-lengths details)
100 execute_general_pushpop_property (Context
*context
,
101 SCM context_property
,
102 SCM grob_property_path
,
106 SCM current_context_val
= SCM_EOL
;
107 if (new_value
!= SCM_UNDEFINED
)
109 Context
*where
= context
->where_defined (context_property
, ¤t_context_val
);
112 Don't mess with MIDI.
117 if (where
!= context
)
119 SCM base
= updated_grob_properties (context
, context_property
);
120 current_context_val
= scm_cons (base
, base
);
121 context
->set_property (context_property
, current_context_val
);
124 if (!scm_is_pair (current_context_val
))
126 programming_error ("Grob definition should be cons");
130 SCM prev_alist
= scm_car (current_context_val
);
131 SCM symbol
= scm_car (grob_property_path
);
133 = lookup_nested_property (prev_alist
,
134 scm_reverse (scm_cdr (grob_property_path
)));
136 target_alist
= scm_acons (symbol
, new_value
, target_alist
);
139 if (!scm_is_pair (scm_cdr (grob_property_path
)))
141 if (!ly_is_procedure (new_value
)
142 && !is_simple_closure (new_value
))
143 ok
= type_check_assignment (symbol
, new_value
,
144 ly_symbol2scm ("backend-type?"));
147 tack onto alist. We can use set_car, since
148 updated_grob_properties() in child contexts will check
149 for changes in the car.
153 scm_set_car_x (current_context_val
, target_alist
);
158 execute_general_pushpop_property (context
,
160 scm_cdr (grob_property_path
),
165 else if (context
->where_defined (context_property
, ¤t_context_val
) == context
)
167 SCM current_value
= scm_car (current_context_val
);
168 SCM daddy
= scm_cdr (current_context_val
);
170 if (!scm_is_pair (grob_property_path
)
171 || !scm_is_symbol (scm_car (grob_property_path
)))
173 programming_error ("Grob property path should be list of symbols.");
177 SCM symbol
= scm_car (grob_property_path
);
178 SCM new_alist
= evict_from_alist (symbol
, current_value
, daddy
);
180 if (new_alist
== daddy
)
181 context
->unset_property (context_property
);
183 context
->set_property (context_property
, scm_cons (new_alist
, daddy
));
188 execute_pushpop_property (Context
*context
,
189 SCM context_property
,
194 general_pushpop_property (context
, context_property
,
195 scm_list_1 (grob_property
),
200 PRE_INIT_OPS is in the order specified, and hence must be reversed.
203 apply_property_operations (Context
*tg
, SCM pre_init_ops
)
205 SCM correct_order
= scm_reverse (pre_init_ops
);
206 for (SCM s
= correct_order
; scm_is_pair (s
); s
= scm_cdr (s
))
208 SCM entry
= scm_car (s
);
209 SCM type
= scm_car (entry
);
210 entry
= scm_cdr (entry
);
212 if (type
== ly_symbol2scm ("push"))
214 SCM context_prop
= scm_car (entry
);
215 SCM val
= scm_cadr (entry
);
216 SCM grob_prop_path
= scm_cddr (entry
);
217 execute_general_pushpop_property (tg
, context_prop
, grob_prop_path
, val
);
219 else if (type
== ly_symbol2scm ("pop"))
221 SCM context_prop
= scm_car (entry
);
222 SCM val
= SCM_UNDEFINED
;
223 SCM grob_prop_path
= scm_cdr (entry
);
224 execute_general_pushpop_property (tg
, context_prop
, grob_prop_path
, val
);
226 else if (type
== ly_symbol2scm ("assign"))
227 tg
->set_property (scm_car (entry
), scm_cadr (entry
));
232 Return the object alist for SYM, checking if its base in enclosing
233 contexts has changed. The alist is updated if necessary.
236 updated_grob_properties (Context
*tg
, SCM sym
)
238 assert (scm_is_symbol (sym
));
241 tg
= tg
->where_defined (sym
, &props
);
246 = (tg
->get_parent_context ())
247 ? updated_grob_properties (tg
->get_parent_context (), sym
)
250 if (!scm_is_pair (props
))
252 programming_error ("grob props not a pair?");
256 SCM based_on
= scm_cdr (props
);
257 if (based_on
== daddy_props
)
258 return scm_car (props
);
261 SCM copy
= daddy_props
;
263 SCM p
= scm_car (props
);
264 while (p
!= based_on
)
266 *tail
= scm_cons (scm_car (p
), daddy_props
);
267 tail
= SCM_CDRLOC (*tail
);
271 scm_set_car_x (props
, copy
);
272 scm_set_cdr_x (props
, daddy_props
);