]> git.donarmstrong.com Git - lilypond.git/blob - lily/grob-property.cc
Moving files into input/manual/
[lilypond.git] / lily / grob-property.cc
1 /*
2   Implement storage and manipulation of grob properties.
3 */
4
5 #include <cstring>
6
7 #include "main.hh"
8 #include "input-smob.hh"
9 #include "pointer-group-interface.hh"
10 #include "misc.hh"
11 #include "paper-score.hh"
12 #include "output-def.hh"
13 #include "spanner.hh"
14 #include "item.hh"
15 #include "misc.hh"
16 #include "item.hh"
17 #include "program-option.hh"
18 #include "profile.hh"
19 #include "simple-closure.hh"
20
21 SCM
22 Grob::get_property_alist_chain (SCM def) const
23 {
24   return scm_list_n (mutable_property_alist_,
25                      immutable_property_alist_,
26                      def,
27                      SCM_UNDEFINED);
28 }
29
30
31 extern void check_interfaces_for_property (Grob const *me, SCM sym);
32
33 void
34 Grob::internal_set_property (SCM sym, SCM v)
35 {
36 #ifndef NDEBUG
37   SCM grob_p = ly_lily_module_constant ("ly:grob?");
38   SCM grob_list_p = ly_lily_module_constant ("grob-list?");
39   SCM type = scm_object_property (sym, ly_symbol2scm ("backend-type?"));
40
41   if (type == grob_p
42       || type == grob_list_p
43       || (unsmob_grob (v) && ly_symbol2scm ("cause") != sym))
44     {
45       scm_display (scm_list_2 (sym, type), scm_current_output_port ());
46       assert (0);
47     }
48 #endif
49
50   /* Perhaps we simply do the assq_set, but what the heck. */
51   if (!is_live ())
52     return;
53
54   if (do_internal_type_checking_global)
55     {
56       if (!ly_is_procedure (v)
57           && !is_simple_closure (v)
58           && v != ly_symbol2scm ("calculation-in-progress") 
59           && !type_check_assignment (sym, v, ly_symbol2scm ("backend-type?")))
60         abort ();
61       check_interfaces_for_property (this, sym);
62     }
63
64   mutable_property_alist_ = scm_assq_set_x (mutable_property_alist_, sym, v);
65 }
66
67 //#define PROFILE_PROPERTY_ACCESSES
68 SCM
69 Grob::get_property_data (SCM sym) const
70 {
71 #ifndef NDEBUG
72   if (profile_property_accesses)
73     note_property_access (&grob_property_lookup_table, sym);
74 #endif
75   
76   SCM handle = scm_sloppy_assq (sym, mutable_property_alist_);
77   if (handle != SCM_BOOL_F)
78     return scm_cdr (handle);
79
80   handle = scm_sloppy_assq (sym, immutable_property_alist_);
81
82   if (do_internal_type_checking_global && scm_is_pair (handle))
83     {
84       SCM val = scm_cdr (handle);
85       if (!ly_is_procedure (val)
86           && !is_simple_closure (val)
87           && !type_check_assignment (sym, val, 
88                                   ly_symbol2scm ("backend-type?")))
89         abort ();
90
91       check_interfaces_for_property (this, sym);
92     }
93   
94   return (handle == SCM_BOOL_F) ? SCM_EOL : scm_cdr (handle);
95 }
96
97 SCM
98 Grob::internal_get_property (SCM sym) const
99 {
100   SCM val = get_property_data (sym);
101   if (ly_is_procedure (val)
102       || is_simple_closure (val))
103     {
104       val = ((Grob*)this)->try_callback (sym, val);
105     }
106   
107   return val;
108 }
109
110 #ifndef NDEBUG
111 #include "protected-scm.hh"
112
113 Protected_scm grob_property_callback_stack = SCM_EOL;
114 bool debug_property_callbacks = 0;
115 #endif
116
117 SCM
118 Grob::try_callback (SCM sym, SCM proc)
119 {      
120   SCM marker = ly_symbol2scm ("calculation-in-progress");
121   /*
122     need to put a value in SYM to ensure that we don't get a
123     cyclic call chain.
124   */
125   mutable_property_alist_
126     = scm_assq_set_x (mutable_property_alist_, sym, marker);
127
128 #ifndef NDEBUG
129   if (debug_property_callbacks)
130     grob_property_callback_stack = scm_acons (sym, proc, grob_property_callback_stack);
131 #endif
132
133   SCM value = SCM_EOL;
134   if (ly_is_procedure (proc))
135     value = scm_call_1 (proc, self_scm ());
136   else if (is_simple_closure (proc))
137     {
138       value = evaluate_with_simple_closure (self_scm (),
139                                             simple_closure_expression (proc));
140     }
141 #ifndef NDEBUG
142   if (debug_property_callbacks)
143     grob_property_callback_stack = scm_cdr (grob_property_callback_stack);
144 #endif
145           
146   /*
147     If the function returns SCM_UNSPECIFIED, we assume the
148     property has been set with an explicit set_property()
149     call.
150   */
151   if (value == SCM_UNSPECIFIED)
152     {
153       value = internal_get_property (sym);
154       if (value == marker)
155         mutable_property_alist_ = scm_assq_remove_x (mutable_property_alist_, marker);
156     }
157   else
158     internal_set_property (sym, value);
159           
160   return value;
161 }
162
163 void
164 Grob::internal_set_object (SCM s, SCM v)
165 {
166   /* Perhaps we simply do the assq_set, but what the heck. */
167   if (!is_live ())
168     return;
169
170   object_alist_ = scm_assq_set_x (object_alist_, s, v);
171 }
172
173 void
174 Grob::del_property (SCM sym)
175 {
176   mutable_property_alist_ = scm_assq_remove_x (mutable_property_alist_, sym);
177 }
178
179 SCM
180 Grob::internal_get_object (SCM sym) const
181 {
182 #ifdef PROFILE_PROPERTY_ACCESSES
183   note_property_access (&grob_property_lookup_table, sym);
184 #endif
185
186   SCM s = scm_sloppy_assq (sym, object_alist_);
187
188   return (s == SCM_BOOL_F) ? SCM_EOL : scm_cdr (s);
189 }
190
191 bool
192 Grob::is_live () const
193 {
194   return immutable_property_alist_ != SCM_EOL;
195 }
196
197
198 bool
199 Grob::internal_has_interface (SCM k)
200 {
201   return scm_c_memq (k, interfaces_) != SCM_BOOL_F;
202 }