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));
90 Grob::internal_set_property (SCM sym, SCM v)
92 internal_set_value_on_alist (&mutable_property_alist_,
99 Grob::internal_set_value_on_alist (SCM *alist, SCM sym, SCM v)
101 /* Perhaps we simply do the assq_set, but what the heck. */
105 if (do_internal_type_checking_global)
107 if (!ly_is_procedure (v)
108 && !is_simple_closure (v)
109 && v != ly_symbol2scm ("calculation-in-progress"))
110 type_check_assignment (sym, v, ly_symbol2scm ("backend-type?"));
112 check_interfaces_for_property (this, sym);
115 *alist = scm_assq_set_x (*alist, sym, v);
119 Grob::internal_get_property_data (SCM sym) const
122 if (profile_property_accesses)
123 note_property_access (&grob_property_lookup_table, sym);
126 SCM handle = scm_sloppy_assq (sym, mutable_property_alist_);
127 if (handle != SCM_BOOL_F)
128 return scm_cdr (handle);
130 handle = scm_sloppy_assq (sym, immutable_property_alist_);
132 if (do_internal_type_checking_global && scm_is_pair (handle))
134 SCM val = scm_cdr (handle);
135 if (!ly_is_procedure (val) && !is_simple_closure (val))
136 type_check_assignment (sym, val, ly_symbol2scm ("backend-type?"));
138 check_interfaces_for_property (this, sym);
141 return (handle == SCM_BOOL_F) ? SCM_EOL : scm_cdr (handle);
145 Grob::internal_get_property (SCM sym) const
147 SCM val = get_property_data (sym);
150 if (val == ly_symbol2scm ("calculation-in-progress"))
151 programming_error (_f ("cyclic dependency: calculation-in-progress encountered for #'%s (%s)",
152 ly_symbol2string (sym).c_str (),
156 if (ly_is_procedure (val)
157 || is_simple_closure (val))
159 Grob *me = ((Grob*)this);
160 val = me->try_callback_on_alist (&me->mutable_property_alist_, sym, val);
167 #include "protected-scm.hh"
169 Protected_scm grob_property_callback_stack = SCM_EOL;
170 bool debug_property_callbacks = 0;
174 Grob::try_callback_on_alist (SCM *alist, SCM sym, SCM proc)
176 SCM marker = ly_symbol2scm ("calculation-in-progress");
178 need to put a value in SYM to ensure that we don't get a
181 *alist = scm_assq_set_x (*alist, sym, marker);
184 if (debug_property_callbacks)
185 grob_property_callback_stack = scm_acons (sym, proc, grob_property_callback_stack);
189 if (ly_is_procedure (proc))
190 value = scm_call_1 (proc, self_scm ());
191 else if (is_simple_closure (proc))
193 value = evaluate_with_simple_closure (self_scm (),
194 simple_closure_expression (proc),
199 if (debug_property_callbacks)
200 grob_property_callback_stack = scm_cdr (grob_property_callback_stack);
204 If the function returns SCM_UNSPECIFIED, we assume the
205 property has been set with an explicit set_property ()
208 if (value == SCM_UNSPECIFIED)
210 value = get_property_data (sym);
211 assert (value == SCM_EOL || value == marker);
213 *alist = scm_assq_remove_x (*alist, marker);
216 internal_set_value_on_alist (alist, sym, value);
222 Grob::internal_set_object (SCM s, SCM v)
224 /* Perhaps we simply do the assq_set, but what the heck. */
228 object_alist_ = scm_assq_set_x (object_alist_, s, v);
232 Grob::internal_del_property (SCM sym)
234 mutable_property_alist_ = scm_assq_remove_x (mutable_property_alist_, sym);
238 Grob::internal_get_object (SCM sym) const
240 if (profile_property_accesses)
241 note_property_access (&grob_property_lookup_table, sym);
243 SCM s = scm_sloppy_assq (sym, object_alist_);
247 SCM val = scm_cdr (s);
248 if (ly_is_procedure (val)
249 || is_simple_closure (val))
251 Grob *me = ((Grob*)this);
252 val = me->try_callback_on_alist (&me->object_alist_, sym, val);
262 Grob::is_live () const
264 return scm_is_pair (immutable_property_alist_);
268 Grob::internal_has_interface (SCM k)
270 return scm_c_memq (k, interfaces_) != SCM_BOOL_F;
274 call_pure_function (SCM unpure, SCM args, int start, int end)
276 SCM scm_call_pure_function = ly_lily_module_constant ("call-pure-function");
278 return scm_apply_0 (scm_call_pure_function,
279 scm_list_4 (unpure, args, scm_from_int (start), scm_from_int (end)));
284 PROP_PATH should be big-to-small ordering
287 nested_property_alist (SCM alist, SCM prop_path, SCM value)
289 SCM new_value = SCM_BOOL_F;
290 if (scm_is_pair (scm_cdr (prop_path)))
292 SCM sub_alist = ly_assoc_get (scm_car (prop_path), alist, SCM_EOL);
293 new_value = nested_property_alist (sub_alist, scm_cdr (prop_path), value);
300 return scm_acons (scm_car (prop_path), new_value, alist);
305 set_nested_property (Grob *me, SCM big_to_small, SCM value)
307 SCM alist = me->get_property (scm_car (big_to_small));
309 alist = nested_property_alist (alist, scm_cdr (big_to_small), value);
311 me->set_property (scm_car (big_to_small),