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.")
36 SCM_ASSERT_TYPE(ly_is_procedure (cb), cb, SCM_ARG1, __FUNCTION__,
39 modification_callback = cb;
40 return SCM_UNSPECIFIED;
45 Grob::get_property_alist_chain (SCM def) const
47 return scm_list_n (mutable_property_alist_,
48 immutable_property_alist_,
54 extern void check_interfaces_for_property (Grob const *me, SCM sym);
59 We can't change signatures depending on NDEBUG, since NDEBUG comes
60 over the command line and may be different per .cc file. This
61 should be done through the macro expansion of get_property().
64 Grob::internal_set_property (SCM sym, SCM v, char const *file, int line, char const *fun)
66 SCM grob_p = ly_lily_module_constant ("ly:grob?");
67 SCM grob_list_p = ly_lily_module_constant ("grob-list?");
68 SCM type = scm_object_property (sym, ly_symbol2scm ("backend-type?"));
71 || type == grob_list_p
72 || (unsmob_grob (v) && ly_symbol2scm ("cause") != sym))
74 scm_display (scm_list_2 (sym, type), scm_current_output_port ());
78 internal_set_value_on_alist (&mutable_property_alist_,
82 if (ly_is_procedure (modification_callback))
83 scm_apply_0 (modification_callback,
84 scm_list_n (self_scm (),
85 scm_from_locale_string (file),
87 scm_from_locale_string (fun),
88 sym, v, SCM_UNDEFINED));
94 Grob::internal_set_property (SCM sym, SCM v)
96 internal_set_value_on_alist (&mutable_property_alist_,
103 Grob::internal_set_value_on_alist (SCM *alist, SCM sym, SCM v)
105 /* Perhaps we simply do the assq_set, but what the heck. */
109 if (do_internal_type_checking_global)
111 if (!ly_is_procedure (v)
112 && !is_simple_closure (v)
113 && v != ly_symbol2scm ("calculation-in-progress"))
114 type_check_assignment (sym, v, ly_symbol2scm ("backend-type?"));
116 check_interfaces_for_property (this, sym);
119 *alist = scm_assq_set_x (*alist, sym, v);
123 Grob::internal_get_property_data (SCM sym) const
126 if (profile_property_accesses)
127 note_property_access (&grob_property_lookup_table, sym);
130 SCM handle = scm_sloppy_assq (sym, mutable_property_alist_);
131 if (handle != SCM_BOOL_F)
132 return scm_cdr (handle);
134 handle = scm_sloppy_assq (sym, immutable_property_alist_);
136 if (do_internal_type_checking_global && scm_is_pair (handle))
138 SCM val = scm_cdr (handle);
139 if (!ly_is_procedure (val) && !is_simple_closure (val))
140 type_check_assignment (sym, val, ly_symbol2scm ("backend-type?"));
142 check_interfaces_for_property (this, sym);
145 return (handle == SCM_BOOL_F) ? SCM_EOL : scm_cdr (handle);
149 Grob::internal_get_property (SCM sym) const
151 SCM val = get_property_data (sym);
154 if (val == ly_symbol2scm ("calculation-in-progress"))
155 programming_error (_f ("cyclic dependency: calculation-in-progress encountered for #'%s (%s)",
156 ly_symbol2string (sym).c_str (),
160 if (ly_is_procedure (val)
161 || is_simple_closure (val))
163 Grob *me = ((Grob*)this);
164 val = me->try_callback_on_alist (&me->mutable_property_alist_, sym, val);
171 #include "protected-scm.hh"
173 Protected_scm grob_property_callback_stack = SCM_EOL;
174 bool debug_property_callbacks = 0;
178 Grob::try_callback_on_alist (SCM *alist, SCM sym, SCM proc)
180 SCM marker = ly_symbol2scm ("calculation-in-progress");
182 need to put a value in SYM to ensure that we don't get a
185 *alist = scm_assq_set_x (*alist, sym, marker);
188 if (debug_property_callbacks)
189 grob_property_callback_stack = scm_acons (sym, proc, grob_property_callback_stack);
193 if (ly_is_procedure (proc))
194 value = scm_call_1 (proc, self_scm ());
195 else if (is_simple_closure (proc))
197 value = evaluate_with_simple_closure (self_scm (),
198 simple_closure_expression (proc),
203 if (debug_property_callbacks)
204 grob_property_callback_stack = scm_cdr (grob_property_callback_stack);
208 If the function returns SCM_UNSPECIFIED, we assume the
209 property has been set with an explicit set_property()
212 if (value == SCM_UNSPECIFIED)
214 value = get_property_data (sym);
215 assert (value == SCM_EOL || value == marker);
217 *alist = scm_assq_remove_x (*alist, marker);
220 internal_set_value_on_alist (alist, sym, value);
226 Grob::internal_set_object (SCM s, SCM v)
228 /* Perhaps we simply do the assq_set, but what the heck. */
232 object_alist_ = scm_assq_set_x (object_alist_, s, v);
236 Grob::internal_del_property (SCM sym)
238 mutable_property_alist_ = scm_assq_remove_x (mutable_property_alist_, sym);
242 Grob::internal_get_object (SCM sym) const
244 if (profile_property_accesses)
245 note_property_access (&grob_property_lookup_table, sym);
247 SCM s = scm_sloppy_assq (sym, object_alist_);
251 SCM val = scm_cdr (s);
252 if (ly_is_procedure (val)
253 || is_simple_closure (val))
255 Grob *me = ((Grob*)this);
256 val = me->try_callback_on_alist (&me->object_alist_, sym, val);
266 Grob::is_live () const
268 return scm_is_pair (immutable_property_alist_);
272 Grob::internal_has_interface (SCM k)
274 return scm_c_memq (k, interfaces_) != SCM_BOOL_F;
278 call_pure_function (SCM unpure, SCM args, int start, int end)
280 SCM scm_call_pure_function = ly_lily_module_constant ("call-pure-function");
282 return scm_apply_0 (scm_call_pure_function,
283 scm_list_4 (unpure, args, scm_from_int (start), scm_from_int (end)));