2 Implement storage and manipulation of grob properties.
9 #include "pointer-group-interface.hh"
11 #include "paper-score.hh"
12 #include "output-def.hh"
14 #include "international.hh"
18 #include "program-option.hh"
20 #include "simple-closure.hh"
24 static SCM modification_callback = SCM_EOL;
26 LY_DEFINE (ly_set_grob_modification_callback, "ly:set-grob-modification-callback",
28 "Specify a procedure that will be called every time lilypond modifies "
29 "a grob property. The callback will receive as arguments "
30 "the grob that is being modified, the name of the C++ file in which "
31 "the modification was requested, the line number in the C++ file in "
32 "which the modification was requested, the property to be changed and "
33 "the new value for the property.")
35 LY_ASSERT_TYPE (ly_is_procedure, cb, 1);
37 modification_callback = cb;
38 return SCM_UNSPECIFIED;
43 Grob::get_property_alist_chain (SCM def) const
45 return scm_list_n (mutable_property_alist_,
46 immutable_property_alist_,
52 extern void check_interfaces_for_property (Grob const *me, SCM sym);
57 We can't change signatures depending on NDEBUG, since NDEBUG comes
58 over the command line and may be different per .cc file. This
59 should be done through the macro expansion of get_property ().
62 Grob::internal_set_property (SCM sym, SCM v, char const *file, int line, char const *fun)
64 SCM grob_p = ly_lily_module_constant ("ly:grob?");
65 SCM grob_list_p = ly_lily_module_constant ("grob-list?");
66 SCM type = scm_object_property (sym, ly_symbol2scm ("backend-type?"));
69 || type == grob_list_p
70 || (unsmob_grob (v) && ly_symbol2scm ("cause") != sym))
72 scm_display (scm_list_2 (sym, type), scm_current_output_port ());
76 internal_set_value_on_alist (&mutable_property_alist_,
80 if (ly_is_procedure (modification_callback))
81 scm_apply_0 (modification_callback,
82 scm_list_n (self_scm (),
83 scm_from_locale_string (file),
85 scm_from_locale_string (fun),
86 sym, v, SCM_UNDEFINED));
92 Grob::internal_set_property (SCM sym, SCM v)
94 internal_set_value_on_alist (&mutable_property_alist_,
101 Grob::internal_set_value_on_alist (SCM *alist, SCM sym, SCM v)
103 /* Perhaps we simply do the assq_set, but what the heck. */
107 if (do_internal_type_checking_global)
109 if (!ly_is_procedure (v)
110 && !is_simple_closure (v)
111 && v != ly_symbol2scm ("calculation-in-progress"))
112 type_check_assignment (sym, v, ly_symbol2scm ("backend-type?"));
114 check_interfaces_for_property (this, sym);
117 *alist = scm_assq_set_x (*alist, sym, v);
121 Grob::internal_get_property_data (SCM sym) const
124 if (profile_property_accesses)
125 note_property_access (&grob_property_lookup_table, sym);
128 SCM handle = scm_sloppy_assq (sym, mutable_property_alist_);
129 if (handle != SCM_BOOL_F)
130 return scm_cdr (handle);
132 handle = scm_sloppy_assq (sym, immutable_property_alist_);
134 if (do_internal_type_checking_global && scm_is_pair (handle))
136 SCM val = scm_cdr (handle);
137 if (!ly_is_procedure (val) && !is_simple_closure (val))
138 type_check_assignment (sym, val, ly_symbol2scm ("backend-type?"));
140 check_interfaces_for_property (this, sym);
143 return (handle == SCM_BOOL_F) ? SCM_EOL : scm_cdr (handle);
147 Grob::internal_get_property (SCM sym) const
149 SCM val = get_property_data (sym);
152 if (val == ly_symbol2scm ("calculation-in-progress"))
153 programming_error (_f ("cyclic dependency: calculation-in-progress encountered for #'%s (%s)",
154 ly_symbol2string (sym).c_str (),
158 if (ly_is_procedure (val)
159 || is_simple_closure (val))
161 Grob *me = ((Grob*)this);
162 val = me->try_callback_on_alist (&me->mutable_property_alist_, sym, val);
169 #include "protected-scm.hh"
171 Protected_scm grob_property_callback_stack = SCM_EOL;
172 bool debug_property_callbacks = 0;
176 Grob::try_callback_on_alist (SCM *alist, SCM sym, SCM proc)
178 SCM marker = ly_symbol2scm ("calculation-in-progress");
180 need to put a value in SYM to ensure that we don't get a
183 *alist = scm_assq_set_x (*alist, sym, marker);
186 if (debug_property_callbacks)
187 grob_property_callback_stack = scm_acons (sym, proc, grob_property_callback_stack);
191 if (ly_is_procedure (proc))
192 value = scm_call_1 (proc, self_scm ());
193 else if (is_simple_closure (proc))
195 value = evaluate_with_simple_closure (self_scm (),
196 simple_closure_expression (proc),
201 if (debug_property_callbacks)
202 grob_property_callback_stack = scm_cdr (grob_property_callback_stack);
206 If the function returns SCM_UNSPECIFIED, we assume the
207 property has been set with an explicit set_property ()
210 if (value == SCM_UNSPECIFIED)
212 value = get_property_data (sym);
213 assert (value == SCM_EOL || value == marker);
215 *alist = scm_assq_remove_x (*alist, marker);
218 internal_set_value_on_alist (alist, sym, value);
224 Grob::internal_set_object (SCM s, SCM v)
226 /* Perhaps we simply do the assq_set, but what the heck. */
230 object_alist_ = scm_assq_set_x (object_alist_, s, v);
234 Grob::internal_del_property (SCM sym)
236 mutable_property_alist_ = scm_assq_remove_x (mutable_property_alist_, sym);
240 Grob::internal_get_object (SCM sym) const
242 if (profile_property_accesses)
243 note_property_access (&grob_property_lookup_table, sym);
245 SCM s = scm_sloppy_assq (sym, object_alist_);
249 SCM val = scm_cdr (s);
250 if (ly_is_procedure (val)
251 || is_simple_closure (val))
253 Grob *me = ((Grob*)this);
254 val = me->try_callback_on_alist (&me->object_alist_, sym, val);
264 Grob::is_live () const
266 return scm_is_pair (immutable_property_alist_);
270 Grob::internal_has_interface (SCM k)
272 return scm_c_memq (k, interfaces_) != SCM_BOOL_F;
276 call_pure_function (SCM unpure, SCM args, int start, int end)
278 SCM scm_call_pure_function = ly_lily_module_constant ("call-pure-function");
280 return scm_apply_0 (scm_call_pure_function,
281 scm_list_4 (unpure, args, scm_from_int (start), scm_from_int (end)));
286 PROP_PATH should be big-to-small ordering
289 nested_property_alist (SCM alist, SCM prop_path, SCM value)
291 SCM new_value = SCM_BOOL_F;
292 if (scm_is_pair (scm_cdr (prop_path)))
294 SCM sub_alist = ly_assoc_get (scm_car (prop_path), alist, SCM_EOL);
295 new_value = nested_property_alist (sub_alist, scm_cdr (prop_path), value);
302 return scm_acons (scm_car (prop_path), new_value, alist);
307 set_nested_property (Grob *me, SCM property_path, SCM value)
309 SCM big_to_small = scm_reverse (property_path);
310 SCM alist = me->get_property (scm_car (big_to_small));
312 alist = nested_property_alist (alist, scm_cdr (big_to_small), value);
314 me->set_property (scm_car (big_to_small),