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);
152 if (ly_is_procedure (val)
153 || is_simple_closure (val))
155 Grob *me = ((Grob*)this);
156 val = me->try_callback_on_alist (&me->mutable_property_alist_, sym, val);
163 #include "protected-scm.hh"
165 Protected_scm grob_property_callback_stack = SCM_EOL;
166 bool debug_property_callbacks = 0;
170 Grob::try_callback_on_alist (SCM *alist, SCM sym, SCM proc)
172 SCM marker = ly_symbol2scm ("calculation-in-progress");
174 need to put a value in SYM to ensure that we don't get a
177 *alist = scm_assq_set_x (*alist, sym, marker);
180 if (debug_property_callbacks)
181 grob_property_callback_stack = scm_acons (sym, proc, grob_property_callback_stack);
185 if (ly_is_procedure (proc))
186 value = scm_call_1 (proc, self_scm ());
187 else if (is_simple_closure (proc))
189 value = evaluate_with_simple_closure (self_scm (),
190 simple_closure_expression (proc),
195 if (debug_property_callbacks)
196 grob_property_callback_stack = scm_cdr (grob_property_callback_stack);
200 If the function returns SCM_UNSPECIFIED, we assume the
201 property has been set with an explicit set_property()
204 if (value == SCM_UNSPECIFIED)
206 value = internal_get_property (sym);
207 assert (value == SCM_EOL || value == marker);
209 *alist = scm_assq_remove_x (*alist, marker);
212 internal_set_value_on_alist (alist, sym, value);
218 Grob::internal_set_object (SCM s, SCM v)
220 /* Perhaps we simply do the assq_set, but what the heck. */
224 object_alist_ = scm_assq_set_x (object_alist_, s, v);
228 Grob::internal_del_property (SCM sym)
230 mutable_property_alist_ = scm_assq_remove_x (mutable_property_alist_, sym);
234 Grob::internal_get_object (SCM sym) const
236 if (profile_property_accesses)
237 note_property_access (&grob_property_lookup_table, sym);
239 SCM s = scm_sloppy_assq (sym, object_alist_);
243 SCM val = scm_cdr (s);
244 if (ly_is_procedure (val)
245 || is_simple_closure (val))
247 Grob *me = ((Grob*)this);
248 val = me->try_callback_on_alist (&me->object_alist_, sym, val);
258 Grob::is_live () const
260 return scm_is_pair (immutable_property_alist_);
264 Grob::internal_has_interface (SCM k)
266 return scm_c_memq (k, interfaces_) != SCM_BOOL_F;
270 call_pure_function (SCM unpure, SCM args, int start, int end)
272 SCM scm_call_pure_function = ly_lily_module_constant ("call-pure-function");
274 return scm_apply_0 (scm_call_pure_function,
275 scm_list_4 (unpure, args, scm_from_int (start), scm_from_int (end)));